lib/stubs/basis-stubs-for-smlnj/int-inf.sml

   1 (* Copyright (C) 2009 Matthew Fluet.
   2  * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
   3  *    Jagannathan, and Stephen Weeks.
   4  * Copyright (C) 1997-2000 NEC Research Institute.
   5  *
   6  * MLton is released under a BSD-style license.
   7  * See the file MLton-LICENSE for details.
   8  *)
   9
  10 functor FixIntInf(PIntInf: sig include INT_INF end) : INT_INF =
  11    struct
  12       open PIntInf
  13       local
  14          structure FIntInf = FixInt(struct open PIntInf end)
  15       in
  16          open FIntInf
  17       end
  18
  19       (* SML/NJ doesn't properly shift IntInf.int values. *)
  20       local
  21          fun pow2 w =
  22             if w = 0wx0
  23                then 1
  24             else
  25                let
  26                   val p = pow2 (Pervasive.Word.>> (w, 0wx1))
  27                   val pp = p * p
  28                in
  29                   if 0wx1 = Pervasive.Word.andb (0wx1, w)
  30                      then 2 * pp
  31                   else pp
  32                end
  33       in
  34          val ~>> = fn (a, b) => a div (pow2 b)
  35       end
  36    end
  37
  38 structure IntInf = FixIntInf(struct open Pervasive.IntInf end)