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 | structure StringCvt: STRING_CVT_EXTRA = | |
10 | struct | |
11 | open Reader | |
12 | ||
13 | val wordFromInt = Word.sextdFromInt | |
14 | ||
15 | datatype radix = BIN | OCT | DEC | HEX | |
16 | ||
17 | val radixToInt: radix -> int = | |
18 | fn BIN => 2 | |
19 | | OCT => 8 | |
20 | | DEC => 10 | |
21 | | HEX => 16 | |
22 | val radixToWord: radix -> word = wordFromInt o radixToInt | |
23 | ||
24 | datatype realfmt = | |
25 | SCI of int option | |
26 | | FIX of int option | |
27 | | GEN of int option | |
28 | | EXACT | |
29 | ||
30 | type ('a, 'b) reader = 'b -> ('a * 'b) option | |
31 | ||
32 | open Int | |
33 | ||
34 | local | |
35 | fun pad f (c: char) i s = | |
36 | let | |
37 | val n = String.size s | |
38 | in | |
39 | if n >= i | |
40 | then s | |
41 | else f (s, String.vector (i -? n, c)) | |
42 | end | |
43 | in | |
44 | val padLeft = pad (fn (s, pad) => String.^ (pad, s)) | |
45 | val padRight = pad String.^ | |
46 | end | |
47 | ||
48 | fun splitl p f src = | |
49 | let fun done chars = String.implode (rev chars) | |
50 | fun loop (src, chars) = | |
51 | case f src of | |
52 | NONE => (done chars, src) | |
53 | | SOME (c, src') => | |
54 | if p c | |
55 | then loop (src', c :: chars) | |
56 | else (done chars, src) | |
57 | in loop (src, []) | |
58 | end | |
59 | ||
60 | fun takel p f s = #1 (splitl p f s) | |
61 | fun dropl p f s = #2 (splitl p f s) | |
62 | ||
63 | type cs = int | |
64 | ||
65 | fun stringReader (s: string): (char, cs) reader = | |
66 | fn i => if i >= String.size s | |
67 | then NONE | |
68 | else SOME (String.sub (s, i), i + 1) | |
69 | ||
70 | fun 'a scanString (f: ((char, cs) reader -> ('a, cs) reader)) (s: string) | |
71 | : 'a option = | |
72 | case f (stringReader s) 0 of | |
73 | NONE => NONE | |
74 | | SOME (a, _) => SOME a | |
75 | ||
76 | local | |
77 | fun memoize (f: char -> 'a): char -> 'a = | |
78 | let val a = Array.tabulate (Char.numChars, f o Char.chrUnsafe) | |
79 | in fn c => Array.sub (a, Char.ord c) | |
80 | end | |
81 | ||
82 | fun range (add: int, cmin: char, cmax: char): char -> int option = | |
83 | let val min = Char.ord cmin | |
84 | in fn c => if Char.<= (cmin, c) andalso Char.<= (c, cmax) | |
85 | then SOME (add +? Char.ord c -? min) | |
86 | else NONE | |
87 | end | |
88 | ||
89 | fun 'a combine (ds: (char -> 'a option) list): char -> 'a option = | |
90 | memoize | |
91 | (fn c => | |
92 | let | |
93 | val rec loop = | |
94 | fn [] => NONE | |
95 | | d :: ds => | |
96 | case d c of | |
97 | NONE => loop ds | |
98 | | z => z | |
99 | in loop ds | |
100 | end) | |
101 | ||
102 | val bin = memoize (range (0, #"0", #"1")) | |
103 | val oct = memoize (range (0, #"0", #"7")) | |
104 | val dec = memoize (range (0, #"0", #"9")) | |
105 | val hex = combine [range (0, #"0", #"9"), | |
106 | range (10, #"a", #"f"), | |
107 | range (10, #"A", #"F")] | |
108 | ||
109 | fun isSpace c = (c = #" " orelse c = #"\t" orelse c = #"\r" orelse | |
110 | c = #"\n" orelse c = #"\v" orelse c = #"\f") | |
111 | in | |
112 | val isSpace = memoize isSpace | |
113 | fun skipWS x = dropl isSpace x | |
114 | ||
115 | fun charToDigit (radix: radix): char -> int option = | |
116 | case radix of | |
117 | BIN => bin | |
118 | | OCT => oct | |
119 | | DEC => dec | |
120 | | HEX => hex | |
121 | end | |
122 | ||
123 | fun charToWDigit radix = (Option.map wordFromInt) o (charToDigit radix) | |
124 | ||
125 | fun digits (radix, max, accum) reader state = | |
126 | let | |
127 | val r = radixToInt radix | |
128 | fun loop (max, accum, state) = | |
129 | let fun done () = SOME (accum, state) | |
130 | in if max <= 0 | |
131 | then done () | |
132 | else | |
133 | case reader state of | |
134 | NONE => done () | |
135 | | SOME (c, state) => | |
136 | case charToDigit radix c of | |
137 | NONE => done () | |
138 | | SOME n => loop (max - 1, n + accum * r, state) | |
139 | end | |
140 | in loop (max, accum, state) | |
141 | end | |
142 | ||
143 | fun digitsPlus (radix, max) reader state = | |
144 | case reader state of | |
145 | NONE => NONE | |
146 | | SOME (c, state) => | |
147 | case charToDigit radix c of | |
148 | NONE => NONE | |
149 | | SOME n => digits (radix, max -? 1, n) reader state | |
150 | ||
151 | fun digitsExact (radix, num) reader state = | |
152 | let val r = radixToInt radix | |
153 | fun loop (num, accum, state) = | |
154 | if num <= 0 | |
155 | then SOME (accum, state) | |
156 | else | |
157 | case reader state of | |
158 | NONE => NONE | |
159 | | SOME (c, state) => | |
160 | case charToDigit radix c of | |
161 | NONE => NONE | |
162 | | SOME n => loop (num - 1, n + accum * r, state) | |
163 | in loop (num, 0, state) | |
164 | end | |
165 | ||
166 | fun digits radix reader state = | |
167 | let | |
168 | val r = radixToInt radix | |
169 | fun loop (accum, state) = | |
170 | case reader state of | |
171 | NONE => SOME (accum, state) | |
172 | | SOME (c, state') => | |
173 | case charToDigit radix c of | |
174 | NONE => SOME (accum, state) | |
175 | | SOME n => loop (n + accum * r, state') | |
176 | in case reader state of | |
177 | NONE => NONE | |
178 | | SOME (c, state) => | |
179 | case charToDigit radix c of | |
180 | NONE => NONE | |
181 | | SOME n => loop (n, state) | |
182 | end | |
183 | ||
184 | fun wdigits radix reader state = | |
185 | let | |
186 | val op + = Word.+ | |
187 | val op * = Word.* | |
188 | val r = radixToWord radix | |
189 | fun loop (accum, state) = | |
190 | case reader state of | |
191 | NONE => SOME (accum, state) | |
192 | | SOME (c, state') => | |
193 | case charToWDigit radix c of | |
194 | NONE => SOME (accum, state) | |
195 | | SOME n => loop (n + accum * r, state') | |
196 | in case reader state of | |
197 | NONE => NONE | |
198 | | SOME (c, state) => | |
199 | case charToWDigit radix c of | |
200 | NONE => NONE | |
201 | | SOME n => loop (n, state) | |
202 | end | |
203 | ||
204 | fun digitToChar (n: int): char = String.sub ("0123456789ABCDEF", n) | |
205 | end |