Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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) |