Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/benchmarks/todo/format/string-cvt.sml
ViewVC logotype

Annotation of /sml/trunk/benchmarks/todo/format/string-cvt.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 193 - (view) (download)

1 : monnier 193 (* string-cvt.sml
2 :     *
3 :     * COPYRIGHT (c) 1992 by AT&T Bell Laboratories. See COPYRIGHT file for details.
4 :     *
5 :     * Basic routines to convert strings to other primitive types.
6 :     *
7 :     * AUTHOR: John Reppy
8 :     * AT&T Bell Laboratories
9 :     * Murray Hill, NJ 07974
10 :     * jhr@research.att.com
11 :     *)
12 :    
13 :     structure StringCvt : STRING_CVT =
14 :     struct
15 :    
16 :     (* A table for mapping digits to values. Whitespace characters map to
17 :     * 128, "-","~" map to 129, "." maps to 130, and 0-9,A-Z,a-z map to their
18 :     * base-36 value. All others map to 255.
19 :     *)
20 :     val cvtTable = "\
21 :     \\255\255\255\255\255\255\255\255\255\128\128\255\255\255\255\255\
22 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
23 :     \\128\255\255\255\255\255\255\255\255\255\255\255\255\129\130\255\
24 :     \\000\001\002\003\004\005\006\007\008\009\255\255\255\255\255\255\
25 :     \\255\010\011\012\013\014\015\016\017\018\019\020\021\022\023\024\
26 :     \\025\026\027\028\029\030\031\032\033\034\035\255\255\255\255\255\
27 :     \\255\010\011\012\013\014\015\016\017\018\019\020\021\022\023\024\
28 :     \\025\026\027\028\029\030\031\032\033\034\035\255\255\255\129\255\
29 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
30 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
31 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
32 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
33 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
34 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
35 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
36 :     \\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\255\
37 :     \"
38 :    
39 :     fun look (s, i) = (ordof(cvtTable, ordof(s, i))) handle _ => 255
40 :    
41 :     fun eatWS (s, i) = let
42 :     fun f j = if (look(s, j) = 128) then f(j+1) else j
43 :     in
44 :     f i
45 :     end
46 :    
47 :     fun eatNeg (s, indx) = if (look (s, indx) = 129)
48 :     then (true, indx+1)
49 :     else (false, indx)
50 :    
51 :     fun eatDecimalPt (s, indx) = if (look(s, indx) = 130)
52 :     then (true, indx+1)
53 :     else (false, indx)
54 :    
55 :     fun eatE (s, indx) = if (look(s, indx) = 14 (* "e" base-36 *))
56 :     then (true, indx+1)
57 :     else (false, indx)
58 :    
59 :     exception Convert
60 :    
61 :     fun scan10 (s, indx) = let
62 :     fun scan (accum, i) = let
63 :     val d = look(s, i)
64 :     in
65 :     if (d < 10) then scan(10*accum + d, i+1) else (accum, i)
66 :     end
67 :     val (v, indx') = scan (0, indx)
68 :     in
69 :     if (indx = indx') then raise Convert else (v, indx')
70 :     end
71 :    
72 :     fun strToInt (s, indx, base) = let
73 :     val indx = eatWS(s, indx)
74 :     val (isNeg, indx) = eatNeg(s, indx)
75 :     fun scan16 indx = let
76 :     fun scan (accum, i) = let
77 :     val d = look(s, i)
78 :     in
79 :     if (d < 16) then scan(16*accum + d, i+1) else (accum, i)
80 :     end
81 :     (* skip any leading "0x" or "0X" *)
82 :     val indx = if (ordof(s, indx) = 48(*"0"*))
83 :     then let
84 :     val d = look(s, indx+1)
85 :     in
86 :     if (d = 33(* base-36 vlue of "x" *)) then indx+2 else indx
87 :     end
88 :     else indx
89 :     val (v, indx') = scan (0, indx)
90 :     in
91 :     if (indx = indx') then raise Convert else (v, indx')
92 :     end
93 :     fun scanRadix (indx, base) = let
94 :     fun scan (accum, i) = let
95 :     val d = look(s, i)
96 :     in
97 :     if (d < base) then scan(base*accum + d, i+1) else (accum, i)
98 :     end
99 :     val (v, indx') = scan (0, indx)
100 :     in
101 :     if (indx = indx') then raise Convert else (v, indx')
102 :     end
103 :     val (v, indx) = (case base
104 :     of 10 => scan10 (s, indx)
105 :     | 16 => scan16 indx
106 :     | _ => if ((1 < base) andalso (base <= 36))
107 :     then scanRadix (indx, base)
108 :     else raise Convert
109 :     (* end case *))
110 :     in
111 :     if isNeg then (~v, indx) else (v, indx)
112 :     end
113 :     handle Ord => raise Convert
114 :    
115 :     fun oatoi s = #1(strToInt(s, 0, 8))
116 :     fun atoi s = #1(strToInt(s, 0, 10))
117 :     fun xatoi s = #1(strToInt(s, 0, 16))
118 :    
119 :     (* this is like scan10, except that it uses a floating-pt accumulator.
120 :     * It is used when scan10 overflows.
121 :     *)
122 :     fun fscan10 (s, indx) = let
123 :     fun scan (accum, i) = let
124 :     val d = look(s, i)
125 :     in
126 :     if (d < 10) then scan(10.0*accum + (real d), i+1) else (accum, i)
127 :     end
128 :     in
129 :     let val (v, i) = scan10(s, indx) in (real v, i) end
130 :     handle _ => scan (0.0, indx)
131 :     end
132 :    
133 :     local
134 :     val negTbl = #[
135 :     1.0E~0, 1.0E~1, 1.0E~2, 1.0E~3, 1.0E~4,
136 :     1.0E~5, 1.0E~6, 1.0E~7, 1.0E~8, 1.0E~9
137 :     ]
138 :     val posTbl = #[
139 :     1.0E0, 1.0E1, 1.0E2, 1.0E3, 1.0E4, 1.0E5, 1.0E6, 1.0E7, 1.0E8, 1.0E9
140 :     ]
141 :     fun scale (tbl, step10 : real) = let
142 :     fun f (r, 0) = r
143 :     | f (r, exp) = if (exp < 10)
144 :     then (r * Vector.sub(tbl, exp))
145 :     else f (step10 * r, exp-10)
146 :     in
147 :     f
148 :     end
149 :     in
150 :     val scaleUp = scale (posTbl, 1.0E10)
151 :     val scaleDown = scale (negTbl, 1.0E~10)
152 :     end
153 :    
154 :     fun strToReal (s, indx) = let
155 :     val indx = eatWS(s, indx)
156 :     val (isNeg, wholeIndx) = eatNeg(s, indx)
157 :     val (whole, indx) = fscan10(s, wholeIndx)
158 :     val hasWhole = (wholeIndx < indx)
159 :     val (hasDecimal, fracIndx) = eatDecimalPt(s, indx)
160 :     val (num, indx) = if hasDecimal
161 :     then let val (frac, j) = fscan10(s, fracIndx)
162 :     in
163 :     (scaleDown (frac, j-fracIndx) + whole, j)
164 :     end
165 :     else (whole, fracIndx)
166 :     val hasFrac = (fracIndx < indx)
167 :     val num = if (hasWhole orelse hasFrac)
168 :     then if isNeg then ~num else num
169 :     else raise Convert
170 :     val (hasExp, indx) = eatE (s, indx)
171 :     in
172 :     if hasExp
173 :     then let
174 :     val (negExp, expIndx) = eatNeg(s, indx)
175 :     val (exp, indx) = scan10(s, expIndx)
176 :     in
177 :     if (expIndx = indx)
178 :     then raise Convert
179 :     else if negExp
180 :     then (scaleDown(num, exp), indx)
181 :     else (scaleUp(num, exp), indx)
182 :     end
183 :     else if (hasWhole orelse hasFrac)
184 :     then (num, indx)
185 :     else raise Convert
186 :     end
187 :    
188 :     fun atof s = #1(strToReal (s, 0))
189 :    
190 :     fun strToBool (s, indx) = let
191 :     val indx = eatWS (s, indx)
192 :     fun match (prefix, v, indx) = let
193 :     val len = size prefix
194 :     fun f (i, j) =
195 :     if (i = len)
196 :     then (v, indx)
197 :     else if (ordof(prefix, i) = ordof(s, j))
198 :     then f (i+1, j+1)
199 :     else raise Convert
200 :     in
201 :     f (0, indx)
202 :     end
203 :     in
204 :     case (ordof (s, indx))
205 :     of 102 (*"f"*) => match ("alse", false, indx+1)
206 :     | 116 (*"t"*) => match ("rue", true, indx+1)
207 :     | _ => raise Convert
208 :     end
209 :     handle Ord => raise Convert
210 :    
211 :     fun atob s = #1(strToBool (s, 0))
212 :    
213 :     end (* StringCvt *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0