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