1 (* Copyright (C
) 2013-2014 Matthew Fluet
.
2 * Copyright (C
) 1999-2007 Henry Cejtin
, Matthew Fluet
, Suresh
3 * Jagannathan
, and Stephen Weeks
.
4 * Copyright (C
) 1997-2000 NEC Research Institute
.
6 * MLton is released under a BSD
-style license
.
7 * See the file MLton
-LICENSE for details
.
10 structure IntInf
: INT_INF_EXTRA
=
15 structure BigWord
= C_MPLimb
16 structure SmallInt
= ObjptrInt
18 structure W
= ObjptrWord
19 structure I
= ObjptrInt
20 structure MPLimb
= C_MPLimb
22 val precision
: Int.int option
= NONE
24 fun sign (arg
: int): Int.int =
25 case compare (arg
, zero
) of
30 fun sameSign (x
, y
) = sign x
= sign y
33 val maxShift32
= Word32
.<< (0wx1
, 0w30
)
34 val maxShift
= Word32
.toWord maxShift32
35 fun make
f (arg
, shift
) =
37 fun body
loop (arg
, shift
) =
38 if Word.<= (shift
, maxShift
)
39 then f (arg
, Word32
.fromWord shift
)
40 else loop (f (arg
, maxShift32
),
41 Word.- (shift
, maxShift
))
42 fun loop (arg
, shift
) = body
loop (arg
, shift
)
44 body
loop (arg
, shift
)
51 val fromInt
= schckFromInt
52 val toInt
= schckToInt
53 val fromLarge
= schckFromLargeInt
54 val toLarge
= schckToLargeInt
59 val binCvt
= mkCvt
{base
= 2, smallCvt
= I
.fmt BIN
}
60 val octCvt
= mkCvt
{base
= 8, smallCvt
= I
.fmt OCT
}
61 val decCvt
= mkCvt
{base
= 10, smallCvt
= I
.fmt DEC
}
62 val hexCvt
= mkCvt
{base
= 16, smallCvt
= I
.fmt HEX
}
70 val toString
= fmt DEC
77 * Given a char
, if it is a digit
in the appropriate base
,
78 * convert it to a
word. Otherwise
, return NONE
.
79 * Note
, both a
-f
and A
-F are accepted
as hexadecimal digits
.
81 fun binDig (ch
: char
): W
.word option
=
90 fun octDig (ch
: char
): W
.word option
=
91 if #
"0" <= ch
andalso ch
<= #
"7"
92 then SOME (W
.fromInt (Int.- (Char.ord ch
,
96 fun decDig (ch
: char
): W
.word option
=
97 if #
"0" <= ch
andalso ch
<= #
"9"
98 then SOME (W
.fromInt (Int.- (Char.ord ch
,
102 fun hexDig (ch
: char
): W
.word option
=
103 if #
"0" <= ch
andalso ch
<= #
"9"
104 then SOME (W
.fromInt (Int.- (Char.ord ch
,
106 else if #
"a" <= ch
andalso ch
<= #
"f"
107 then SOME (W
.fromInt (Int.- (Char.ord ch
,
108 Int.- (Char.ord #
"a", 0xa))))
109 else if #
"A" <= ch
andalso ch
<= #
"F"
110 then SOME (W
.fromInt (Int.- (Char.ord ch
,
111 Int.- (Char.ord #
"A", 0xA))))
116 * Given a digit converter
and a char reader
, return a digit
119 fun toDigR (charToDig
: char
-> W
.word option
,
120 cread
: (char
, 'a
) reader
)
122 : (W
.word * 'a
) option
=
128 | SOME dig
=> SOME (dig
, s
')
131 * A chunk represents the result
of processing some digits
.
132 * more is a
bool indicating
if there might be more digits
.
133 * shift is base raised to the number
-of-digits
-seen power
.
134 * chunk is the value
of the digits seen
.
136 type chunk
= {more
: bool,
140 * Given the base
and a digit reader
,
141 * return a chunk reader
.
143 fun toChunkR (base
: W
.word,
144 dread
: (W
.word, 'a
) reader
)
145 : (chunk
, 'a
) reader
=
147 fun loop
{left
: Int32
.int,
152 if Int32
.<= (left
, 0)
159 NONE
=> ({more
= false,
164 loop
{left
= Int32
.- (left
, 1),
165 shift
= W
.* (base
, shift
),
166 chunk
= W
.+ (W
.* (base
, chunk
), dig
),
168 (* digitsPerChunk
= floor((W
.wordSize
- 3) / (log2 base
)) *)
169 val digitsPerChunk
: Int32
.t
=
170 case (W
.wordSize
, base
) of
179 | _
=> raise (Fail
"IntInf.scan:digitsPerChunk")
180 fun reader (s
: 'a
): (chunk
* 'a
) option
=
183 |
SOME (dig
, next
) =>
184 SOME (loop
{left
= Int32
.- (digitsPerChunk
, 1),
193 * Given a chunk reader
, return an unsigned reader
.
195 fun toUnsR (ckread
: (chunk
, 'a
) reader
): (int, 'a
) reader
=
197 fun loop (more
: bool, acc
: int, s
: 'a
) =
199 then case ckread s
of
201 |
SOME ({more
, shift
, chunk
}, s
') =>
203 ((W
.toLargeInt shift
) * acc
)
204 + (W
.toLargeInt chunk
),
207 fun reader (s
: 'a
): (int * 'a
) option
=
210 |
SOME ({more
, chunk
, ...}, s
') =>
219 * Given a char reader
and an unsigned reader
, return an unsigned
220 * reader that includes skipping the option hex
'0x
'.
222 fun toHexR (cread
: (char
, 'a
) reader
, uread
: (int, 'a
) reader
) s
=
228 NONE
=> SOME (zero
, s1
)
230 if c2
= #
"x" orelse c2
= #
"X" then
232 NONE
=> SOME (zero
, s1
)
238 * Given a char reader
and an unsigned reader
, return a signed
239 * reader
. This includes skipping any initial white space
.
241 fun toSign (cread
: (char
, 'a
) reader
, uread
: (int, 'a
) reader
)
244 fun reader (s
: 'a
): (int * 'a
) option
=
245 let val s
= StringCvt.skipWS cread s
in
258 then case uread s
'' of
260 |
SOME (abs
, s
''') => SOME (~ abs
, s
''')
269 * Base
-specific conversions from char readers to
273 fun reader (base
, dig
)
274 (cread
: (char
, 'a
) reader
)
277 val dread
= toDigR (dig
, cread
)
278 val ckread
= toChunkR (base
, dread
)
279 val uread
= toUnsR ckread
280 val hread
= if base
= 0w16
then toHexR (cread
, uread
) else uread
281 val reader
= toSign (cread
, hread
)
286 fun binReader z
= reader (0w2
, binDig
) z
287 fun octReader z
= reader (0w8
, octDig
) z
288 fun decReader z
= reader (0w10
, decDig
) z
289 fun hexReader z
= reader (0w16
, hexDig
) z
300 val fromString
= StringCvt.scanString (scan
StringCvt.DEC
)
303 fun isEven (n
: Int.int) = Int.andb (n
, 0x1) = 0
305 fun pow (i
: int, j
: Int.int): int =
311 else if i
= negOne
then if isEven j
then one
else negOne
317 fun square (n
: int): int = n
* n
318 (* pow (j
) returns (i ^ j
) *)
319 fun pow (j
: Int.int): int =
320 if Int.<= (j
, 0) then one
321 else if isEven j
then evenPow j
322 else i
* evenPow (Int.- (j
, 1))
323 (* evenPow (j
) returns (i ^ j
), assuming j is even
*)
324 and evenPow (j
: Int.int): int =
325 square (pow (Int.div (j
, 2)))
332 mkLog2
{fromSmall
= fn {smallLog2
} => Int32
.toInt smallLog2
,
333 fromLarge
= fn {numLimbsMinusOne
, mostSigLimbLog2
} =>
334 Int.+ (Int.* (MPLimb
.wordSize
, SeqIndex
.toInt numLimbsMinusOne
),
335 Int32
.toInt mostSigLimbLog2
)}