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