basis-library/integer/num0.sml

   1 (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  * Copyright (C) 1997-2000 NEC Research Institute.
   4  *
   5  * MLton is released under a BSD-style license.
   6  * See the file MLton-LICENSE for details.
   7  *)
   8
   9 signature MKNUM0_ARG =
  10    sig
  11       structure Int: PRIM_INTEGER
  12       structure Word: PRIM_WORD
  13       val idFromIntToWord: Int.int -> Word.word
  14       val idFromWordToInt: Word.word -> Int.int
  15    end
  16 signature PRIM_INTEGER =
  17    sig
  18       include PRIM_INTEGER
  19
  20       val maxInt': int
  21       val minInt': int
  22       val maxInt: int option
  23       val minInt: int option
  24
  25       val zero: int
  26       val one: int
  27
  28       val abs: int -> int
  29       val div: int * int -> int
  30       val mod: int * int -> int
  31       val quot: int * int -> int
  32       val rem: int * int -> int
  33
  34       val ltu: int * int -> bool
  35       val leu: int * int -> bool
  36       val gtu: int * int -> bool
  37       val geu: int * int -> bool
  38
  39       val andb : int * int -> int
  40       val <<? : int * Primitive.Word32.word -> int
  41       val notb : int -> int
  42       val orb : int * int -> int
  43       val rolUnsafe : int * Primitive.Word32.word -> int
  44       val rorUnsafe : int * Primitive.Word32.word -> int
  45       val ~>>? : int * Primitive.Word32.word -> int
  46       val >>? : int * Primitive.Word32.word -> int
  47       val xorb : int * int -> int
  48
  49       val power: {base:int, exp: int} -> int
  50       val log2: int -> Primitive.Int32.int
  51       val log2Word: int -> Primitive.Word32.word
  52    end
  53 signature PRIM_WORD =
  54    sig
  55       include PRIM_WORD
  56
  57       val zero: word
  58       val one: word
  59
  60       val maxWord': word
  61
  62       val div: word * word -> word
  63       val mod: word * word -> word
  64
  65       val log2: word -> Primitive.Int32.int
  66       val log2Word: word -> Primitive.Word32.word
  67    end
  68
  69 functor MkNum0 (S: MKNUM0_ARG): sig
  70                                    structure Int: PRIM_INTEGER
  71                                    structure Word: PRIM_WORD
  72                                 end =
  73    struct
  74       open S
  75
  76       val _ =
  77          if Int.sizeInBits <> Word.sizeInBits
  78             orelse Int.sizeInBitsWord <> Word.sizeInBitsWord
  79             then raise Primitive.Exn.Fail8 "MkNum0: Int.sizeInBits <> Word.sizeInBits"
  80             else ()
  81
  82       structure Word =
  83          struct
  84             open Word
  85
  86             val zero = zextdFromWord32 0w0
  87             val one = zextdFromWord32 0w1
  88
  89             val maxWord' = notb zero
  90
  91             local
  92                fun make f (w, w') =
  93                   if Primitive.Controls.safe andalso w' = zero
  94                      then raise Div
  95                      else f (w, w')
  96             in
  97                val op div = make (op quotUnsafe)
  98                val op mod = make (op remUnsafe)
  99             end
 100
 101             fun log2Word w =
 102                let
 103                   fun loop (n, s, acc) =
 104                      if n = one
 105                         then acc
 106                         else let
 107                                 val (n, acc) =
 108                                    if n >= <<? (one, s)
 109                                       then (>>? (n, s), Primitive.Word32.+ (acc, s))
 110                                       else (n, acc)
 111                              in
 112                                 loop (n, Primitive.Word32.>>? (s, 0w1), acc)
 113                              end
 114                in
 115                   if Primitive.Controls.safe andalso w = zero
 116                      then raise Domain
 117                      else loop (w, Primitive.Word32.>>? (sizeInBitsWord, 0w1), 0w0)
 118                end
 119             fun log2 w = Primitive.IntWordConv.zextdFromWord32ToInt32 (log2Word w)
 120          end
 121
 122       structure Int =
 123          struct
 124             open Int
 125
 126             val zero = zextdFromInt32 0
 127             val one = zextdFromInt32 1
 128
 129             local
 130                fun makeBinop f =
 131                   fn (x: int, y: int) =>
 132                   idFromWordToInt
 133                   (f (idFromIntToWord x, idFromIntToWord y))
 134                fun makeUnop f =
 135                   fn (x: int) =>
 136                   idFromWordToInt
 137                   (f (idFromIntToWord x))
 138                fun makeShop f =
 139                   fn (x: int, w: Primitive.Word32.word) =>
 140                   idFromWordToInt
 141                   (f (idFromIntToWord x, w))
 142             in
 143                val andb = makeBinop Word.andb
 144                val <<? = makeShop Word.<<?
 145                val notb = makeUnop Word.notb
 146                val orb = makeBinop Word.orb
 147                val rolUnsafe = makeShop Word.rolUnsafe
 148                val rorUnsafe = makeShop Word.rorUnsafe
 149                val ~>>? = makeShop Word.~>>?
 150                val >>? = makeShop Word.>>?
 151                val xorb = makeBinop Word.xorb
 152             end
 153             fun log2 i = Word.log2 (idFromIntToWord i)
 154             fun log2Word i = Word.log2Word (idFromIntToWord i)
 155
 156             val minInt' = <<? (one, Primitive.Word32.- (sizeInBitsWord, 0w1))
 157             val maxInt' = >>? (notb zero, 0w1)
 158             val minInt = SOME minInt'
 159             val maxInt = SOME maxInt'
 160
 161             fun abs (x: int) = if x < zero then ~ x else x
 162
 163             fun quot (x, y) =
 164                if Primitive.Controls.safe
 165                   andalso y = zero
 166                   then raise Div
 167                   else if (Primitive.Controls.detectOverflow
 168                            orelse Primitive.Controls.safe)
 169                           andalso x = minInt' andalso y = ~one
 170                           then if Primitive.Controls.detectOverflow
 171                                   then raise Overflow
 172                                   else minInt'
 173                           else quotUnsafe (x, y)
 174
 175             fun rem (x, y) =
 176                if Primitive.Controls.safe
 177                   andalso y = zero
 178                   then raise Div
 179                   else if x = minInt' andalso y = ~one
 180                           then zero
 181                           else remUnsafe (x, y)
 182
 183             fun x div y =
 184                if x >= zero
 185                   then if y > zero
 186                           then quotUnsafe (x, y)
 187                           else if y < zero
 188                                   then if x = zero
 189                                           then zero
 190                                           else quotUnsafe (x -? one, y) -? one
 191                                   else raise Div
 192                   else if y < zero
 193                           then if (Primitive.Controls.detectOverflow
 194                                    orelse Primitive.Controls.safe)
 195                                   andalso x = minInt' andalso y = ~one
 196                                   then if Primitive.Controls.detectOverflow
 197                                           then raise Overflow
 198                                           else minInt'
 199                                   else quotUnsafe (x, y)
 200                           else if y > zero
 201                                   then quotUnsafe (x +? one, y) -? one
 202                                   else raise Div
 203
 204             fun x mod y =
 205                if x >= zero
 206                   then if y > zero
 207                           then remUnsafe (x, y)
 208                           else if y < zero
 209                                   then if x = zero
 210                                           then zero
 211                                           else remUnsafe (x -? one, y) +? (y + one)
 212                                   else raise Div
 213                   else if y < zero
 214                           then if x = minInt' andalso y = ~one
 215                                   then zero
 216                                   else remUnsafe (x, y)
 217                           else if y > zero
 218                                   then remUnsafe (x +? one, y) +? (y -? one)
 219                                   else raise Div
 220
 221             local
 222                structure S =
 223                   UnsignedIntegralComparisons
 224                   (type int = int
 225                    type word = Word.word
 226                    val idFromIntToWord = idFromIntToWord
 227                    val op < = Word.<)
 228             in
 229                open S
 230             end
 231
 232             fun power {base, exp} =
 233                if Primitive.Controls.safe
 234                   andalso exp < zero
 235                   then raise Primitive.Exn.Fail8 "Int.power"
 236                   else let
 237                           fun loop (exp, accum) =
 238                              if exp <= zero
 239                                 then accum
 240                                 else loop (exp - one, base * accum)
 241                        in loop (exp, one)
 242                        end
 243          end
 244
 245    end
 246
 247 structure Primitive = struct
 248 open Primitive
 249
 250 local
 251    structure S =
 252       MkNum0 (structure Int = Int8
 253               structure Word = Word8
 254               val idFromIntToWord = IntWordConv.idFromInt8ToWord8
 255               val idFromWordToInt = IntWordConv.idFromWord8ToInt8)
 256 in
 257    structure Int8 : PRIM_INTEGER = S.Int
 258    structure Word8 : PRIM_WORD = S.Word
 259 end
 260 local
 261    structure S =
 262       MkNum0 (structure Int = Int16
 263               structure Word = Word16
 264               val idFromIntToWord = IntWordConv.idFromInt16ToWord16
 265               val idFromWordToInt = IntWordConv.idFromWord16ToInt16)
 266 in
 267    structure Int16 : PRIM_INTEGER = S.Int
 268    structure Word16 : PRIM_WORD = S.Word
 269 end
 270 local
 271    structure S =
 272       MkNum0 (structure Int = Int32
 273               structure Word = Word32
 274               val idFromIntToWord = IntWordConv.idFromInt32ToWord32
 275               val idFromWordToInt = IntWordConv.idFromWord32ToInt32)
 276 in
 277    structure Int32 : PRIM_INTEGER = S.Int
 278    structure Word32 : PRIM_WORD = S.Word
 279 end
 280 local
 281    structure S =
 282       MkNum0 (structure Int = Int64
 283               structure Word = Word64
 284               val idFromIntToWord = IntWordConv.idFromInt64ToWord64
 285               val idFromWordToInt = IntWordConv.idFromWord64ToInt64)
 286 in
 287    structure Int64 : PRIM_INTEGER = S.Int
 288    structure Word64 : PRIM_WORD = S.Word
 289 end
 290
 291 end