basis-library/integer/embed-int.sml

   1 (* Copyright (C) 2004-2006 Henry Cejtin, Matthew Fluet, Suresh
   2  *    Jagannathan, and Stephen Weeks.
   3  *
   4  * MLton is released under a BSD-style license.
   5  * See the file MLton-LICENSE for details.
   6  *)
   7
   8 signature EMBED_INT =
   9    sig
  10       eqtype int
  11       type big
  12
  13       val fromBigUnsafe: big -> int
  14       val sizeInBits: Int32.int
  15       val toBig: int -> big
  16    end
  17
  18 functor EmbedInt (structure Big: INTEGER_EXTRA
  19                   structure Small: EMBED_INT where type big = Big.int): INTEGER =
  20    struct
  21       structure Small =
  22          struct
  23             open Small
  24             val precision': Int.int = Int32.toInt sizeInBits
  25          end
  26
  27       val () = if Int.< (Small.precision', Big.precision') then ()
  28                else raise Fail "EmbedWord"
  29
  30       open Small
  31
  32       val shift = Word.fromInt (Int.- (Big.precision', precision'))
  33
  34       val extend: Big.int -> Big.int =
  35          fn i => Big.~>> (Big.<< (i, shift), shift)
  36
  37       val toBig: Small.int -> Big.int = extend o Small.toBig
  38
  39       val precision = SOME precision'
  40
  41       val maxIntBig = Big.>> (Big.fromInt ~1, Word.+ (shift, 0w1))
  42
  43       val minIntBig = Big.- (Big.~ maxIntBig, Big.fromInt 1)
  44
  45       val mask = Big.>> (Big.fromInt ~1, shift)
  46
  47       fun fromBig (i: Big.int): int =
  48          let
  49             val i' = Big.andb (i, mask)
  50          in
  51             if i = extend i'
  52                then fromBigUnsafe i'
  53             else raise Overflow
  54          end
  55
  56       val maxInt = SOME (fromBig maxIntBig)
  57
  58       val minInt = SOME (fromBig minIntBig)
  59
  60       local
  61          val make: (Big.int * Big.int -> Big.int) -> (int * int -> int) =
  62             fn f => fn (x, y) => fromBig (f (toBig x, toBig y))
  63       in
  64          val op * = make Big.*
  65          val op + = make Big.+
  66          val op - = make Big.-
  67          val op div = make Big.div
  68          val op mod = make Big.mod
  69          val quot = make Big.quot
  70          val rem = make Big.rem
  71       end
  72
  73       local
  74          val make: (Big.int * Big.int -> 'a) -> (int * int -> 'a) =
  75             fn f => fn (x, y) => f (toBig x, toBig y)
  76       in
  77          val op < = make Big.<
  78          val op <= = make Big.<=
  79          val op > = make Big.>
  80          val op >= = make Big.>=
  81          val compare = make Big.compare
  82       end
  83
  84       val fromInt = fromBig o Big.fromInt
  85
  86       val toInt = Big.toInt o toBig
  87
  88       local
  89          val make: (Big.int -> Big.int) -> (int -> int) =
  90             fn f => fn x => fromBig (f (toBig x))
  91       in
  92          val ~ = make Big.~
  93          val abs = make Big.abs
  94       end
  95
  96       fun fmt r i = Big.fmt r (toBig i)
  97
  98       val fromLarge = fromBig o Big.fromLarge
  99
 100       fun fromString s = Option.map fromBig (Big.fromString s)
 101
 102       fun max (i, j) = if i >= j then i else j
 103
 104       fun min (i, j) = if i <= j then i else j
 105
 106       fun scan r reader state =
 107          Option.map
 108          (fn (i, state) => (fromBig i, state))
 109          (Big.scan r reader state)
 110
 111       val sign = Big.sign o toBig
 112
 113       fun sameSign (x, y) = sign x = sign y
 114
 115       val toLarge = Big.toLarge o toBig
 116
 117       val toString = Big.toString o toBig
 118    end
 119
 120 functor Embed8 (Small: EMBED_INT where type big = Int8.int): INTEGER =
 121    EmbedInt (structure Big = Int8
 122              structure Small = Small)
 123
 124 functor Embed16 (Small: EMBED_INT where type big = Int16.int): INTEGER =
 125    EmbedInt (structure Big = Int16
 126              structure Small = Small)
 127
 128 functor Embed32 (Small: EMBED_INT where type big = Int32.int): INTEGER =
 129    EmbedInt (structure Big = Int32
 130              structure Small = Small)
 131
 132 structure Int1 = Embed8 (Primitive.Int1)
 133 structure Int2 = Embed8 (Primitive.Int2)
 134 structure Int3 = Embed8 (Primitive.Int3)
 135 structure Int4 = Embed8 (Primitive.Int4)
 136 structure Int5 = Embed8 (Primitive.Int5)
 137 structure Int6 = Embed8 (Primitive.Int6)
 138 structure Int7 = Embed8 (Primitive.Int7)
 139 structure Int9 = Embed16 (Primitive.Int9)
 140 structure Int10 = Embed16 (Primitive.Int10)
 141 structure Int11 = Embed16 (Primitive.Int11)
 142 structure Int12 = Embed16 (Primitive.Int12)
 143 structure Int13 = Embed16 (Primitive.Int13)
 144 structure Int14 = Embed16 (Primitive.Int14)
 145 structure Int15 = Embed16 (Primitive.Int15)
 146 structure Int17 = Embed32 (Primitive.Int17)
 147 structure Int18 = Embed32 (Primitive.Int18)
 148 structure Int19 = Embed32 (Primitive.Int19)
 149 structure Int20 = Embed32 (Primitive.Int20)
 150 structure Int21 = Embed32 (Primitive.Int21)
 151 structure Int22 = Embed32 (Primitive.Int22)
 152 structure Int23 = Embed32 (Primitive.Int23)
 153 structure Int24 = Embed32 (Primitive.Int24)
 154 structure Int25 = Embed32 (Primitive.Int25)
 155 structure Int26 = Embed32 (Primitive.Int26)
 156 structure Int27 = Embed32 (Primitive.Int27)
 157 structure Int28 = Embed32 (Primitive.Int28)
 158 structure Int29 = Embed32 (Primitive.Int29)
 159 structure Int30 = Embed32 (Primitive.Int30)
 160 structure Int31 = Embed32 (Primitive.Int31)