basis-library/integer/int.sml

   1 (* Copyright (C) 1999-2006 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 functor Integer (I: PRIM_INTEGER): INTEGER_EXTRA =
  10 struct
  11
  12 open I
  13 type t = int
  14
  15 val precision': Int.int = Primitive.Int32.zextdToInt sizeInBits
  16 val precision: Int.int option = SOME precision'
  17 val sizeInBitsWord = Primitive.Word32.zextdToWord sizeInBitsWord
  18
  19 val maxInt: int option = SOME maxInt'
  20 val minInt: int option = SOME minInt'
  21
  22 val sign: int -> Int.int =
  23   fn i => if i = zero
  24             then (0: Int.int)
  25           else if i < zero
  26             then (~1: Int.int)
  27           else (1: Int.int)
  28
  29 fun sameSign (x, y) = sign x = sign y
  30
  31 fun << (i, n) =
  32    if Word.>= (n, sizeInBitsWord)
  33       then zero
  34       else I.<<? (i, Primitive.Word32.zextdFromWord n)
  35 fun >> (i, n) =
  36    if Word.>= (n, sizeInBitsWord)
  37       then zero
  38       else I.>>? (i, Primitive.Word32.zextdFromWord n)
  39 fun ~>> (i, n) =
  40    if Word.< (n, sizeInBitsWord)
  41       then I.~>>? (i, Primitive.Word32.zextdFromWord n)
  42       else I.~>>? (i, Primitive.Word32.- (I.sizeInBitsWord, 0w1))
  43 fun rol (i, n) = I.rolUnsafe (i, Primitive.Word32.zextdFromWord n)
  44 fun ror (i, n) = I.rorUnsafe (i, Primitive.Word32.zextdFromWord n)
  45
  46 val fromInt = I.schckFromInt
  47 val toInt = I.schckToInt
  48
  49 val fromLargeInt = I.schckFromLargeInt
  50 val toLargeInt = I.schckToLargeInt
  51 val fromLarge = fromLargeInt
  52 val toLarge = toLargeInt
  53
  54 (* fmt constructs a string to represent the integer by building it into a
  55  * statically allocated buffer.  For the most part, this is a textbook
  56  * algorithm: loop starting at the end of the buffer; we use rem to
  57  * extract the next digit to put into the buffer; and we use quot to
  58  * figure out the part of the integer that we haven't yet formatted.
  59  * However, this function uses the negative absolute value of the input
  60  * number, which allows it to take into account minInt without any
  61  * special-casing.  This requires the rem function to behave in a very
  62  * specific way, or else things will go terribly wrong.  This may be a
  63  * concern when porting to platforms where the division hardware has a
  64  * different interpretation than SML about what happens when doing
  65  * division of negative numbers.
  66  *)
  67 local
  68    (* Allocate a buffer large enough to hold any formatted integer in any radix.
  69     * The most that will be required is for minInt in binary.
  70     *)
  71    val maxNumDigits = Int.+ (precision', 1)
  72    val oneBuf = One.make (fn () => CharArray.array (maxNumDigits, #"\000"))
  73 in
  74    fun fmt radix (n: int): string =
  75       One.use
  76       (oneBuf, fn buf =>
  77       let
  78          val radix = fromInt (StringCvt.radixToInt radix)
  79          fun loop (q, i: Int.int) =
  80             let
  81                val _ =
  82                   CharArray.update
  83                   (buf, i, StringCvt.digitToChar (toInt (~? (rem (q, radix)))))
  84                val q = quot (q, radix)
  85             in
  86                if q = zero
  87                   then
  88                      let
  89                         val start =
  90                            if n < zero
  91                               then
  92                                  let
  93                                     val i = Int.- (i, 1)
  94                                     val () = CharArray.update (buf, i, #"~")
  95                                  in
  96                                     i
  97                                  end
  98                            else i
  99                      in
 100                         CharArraySlice.vector
 101                         (CharArraySlice.slice (buf, start, NONE))
 102                      end
 103                else loop (q, Int.- (i, 1))
 104             end
 105       in
 106          loop (if n < zero then n else ~? n, Int.- (maxNumDigits, 1))
 107       end)
 108 end
 109
 110 val toString = fmt StringCvt.DEC
 111
 112 fun scan radix reader s =
 113    let
 114       (* Works with the negative of the number so that minInt can be scanned. *)
 115       val s = StringCvt.skipWS reader s
 116       fun charToDigit c =
 117          case StringCvt.charToDigit radix c of
 118             NONE => NONE
 119           | SOME n => SOME (fromInt n)
 120       val radixInt = fromInt (StringCvt.radixToInt radix)
 121       fun finishNum (s, n) =
 122          case reader s of
 123             NONE => SOME (n, s)
 124           | SOME (c, s') =>
 125                case charToDigit c of
 126                   NONE => SOME (n, s)
 127                 | SOME n' => finishNum (s', n * radixInt - n')
 128       fun num s =
 129          case (reader s, radix) of
 130             (NONE, _) => NONE
 131           | (SOME (#"0", s), StringCvt.HEX) =>
 132                (case reader s of
 133                    NONE => SOME (zero, s)
 134                  | SOME (c, s') =>
 135                       if c = #"x" orelse c = #"X" then
 136                          case reader s' of
 137                             NONE => SOME (zero, s)
 138                           | SOME (c, s') =>
 139                                case charToDigit c of
 140                                   NONE => SOME (zero, s)
 141                                 | SOME n => finishNum (s', ~? n)
 142                       else
 143                          case charToDigit c of
 144                             NONE => SOME (zero, s)
 145                           | SOME n => finishNum (s', ~? n))
 146           | (SOME (c, s), _) =>
 147                case charToDigit c of
 148                   NONE => NONE
 149                 | SOME n => finishNum (s, ~? n)
 150     fun negate s =
 151        case num s of
 152           NONE => NONE
 153         | SOME (n, s) => SOME (~ n, s)
 154   in
 155      case reader s of
 156         NONE => NONE
 157       | SOME (c, s') =>
 158            case c of
 159               #"~" => num s'
 160             | #"-" => num s'
 161             | #"+" => negate s'
 162             | _ => negate s
 163   end
 164
 165 val fromString = StringCvt.scanString (scan StringCvt.DEC)
 166
 167 end
 168
 169 structure Int8 = Integer (Primitive.Int8)
 170 structure Int16 = Integer (Primitive.Int16)
 171 structure Int32 = Integer (Primitive.Int32)
 172 structure Int64 = Integer (Primitive.Int64)