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/branches/FLINT/src/compiler/PervEnv/Basis/char.sml
ViewVC logotype

Annotation of /sml/branches/FLINT/src/compiler/PervEnv/Basis/char.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)

1 : monnier 245 (* char.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     structure Char : sig
8 :     include CHAR
9 :     val scanC : (char, 'a) StringCvt.reader -> (char, 'a) StringCvt.reader
10 :     (* internal scanning function for C-style escape sequences *)
11 :     end = struct
12 :    
13 :     structure C = InlineT.Char
14 :    
15 :     val op + = InlineT.DfltInt.+
16 :     val op - = InlineT.DfltInt.-
17 :     val op * = InlineT.DfltInt.*
18 :    
19 :     val itoc : int -> char = InlineT.cast
20 :     val ctoi : char -> int = InlineT.cast
21 :    
22 :     type char = PrimTypes.char
23 :     type string = PrimTypes.string
24 :    
25 :     val minChar : char = C.chr 0
26 :     val maxChar : char = C.chr C.maxOrd
27 :     val maxOrd = C.maxOrd
28 :    
29 :     fun pred (c : char) : char = let
30 :     val c' = (ctoi c - 1)
31 :     in
32 :     if InlineT.DfltInt.< (c', 0) then raise General.Chr else (itoc c')
33 :     end
34 :     fun succ (c : char) : char = let
35 :     val c' = (ctoi c + 1)
36 :     in
37 :     if InlineT.DfltInt.< (maxOrd, c') then raise General.Chr else (itoc c')
38 :     end
39 :    
40 :     val chr = C.chr
41 :     val ord = C.ord
42 :    
43 :     val (op <) = C.<
44 :     val (op <=) = C.<=
45 :     val (op >) = C.>
46 :     val (op >=) = C.>=
47 :    
48 :     fun compare (c1 : char, c2 : char) =
49 :     if (c1 = c2) then EQUAL
50 :     else if (c1 < c2) then LESS
51 :     else GREATER
52 :    
53 :     (* testing character membership *)
54 :     local
55 :     fun mkArray (s, sLen) = let
56 :     val cv = Assembly.A.create_s(maxOrd+1)
57 :     fun init i = if InlineT.DfltInt.<= (i, maxOrd)
58 :     then (InlineT.CharVector.update(cv, i, #"\000"); init(i+1))
59 :     else ()
60 :     fun ins i = if InlineT.DfltInt.< (i, sLen)
61 :     then (
62 :     InlineT.CharVector.update (
63 :     cv, ord(InlineT.CharVector.sub(s, i)), #"\001");
64 :     ins(i+1))
65 :     else ()
66 :     in
67 :     init 0; ins 0; cv
68 :     end
69 :     in
70 :     fun contains "" = (fn c => false)
71 :     | contains s = let val sLen = InlineT.CharVector.length s
72 :     in
73 :     if (sLen = 1)
74 :     then let val c' = InlineT.CharVector.sub(s, 0)
75 :     in fn c => (c = c') end
76 :     else let val cv = mkArray (s, sLen)
77 :     in fn c => (InlineT.CharVector.sub(cv, ord c) <> #"\000") end
78 :     end
79 :     fun notContains "" = (fn c => true)
80 :     | notContains s = let val sLen = InlineT.CharVector.length s
81 :     in
82 :     if (sLen = 1)
83 :     then let val c' = InlineT.CharVector.sub(s, 0)
84 :     in fn c => (c <> c') end
85 :     else let val cv = mkArray (s, sLen)
86 :     in fn c => (InlineT.CharVector.sub(cv, ord c) = #"\000") end
87 :     end
88 :     end (* local *)
89 :    
90 :     (* For each character code we have an 8-bit vector, which is interpreted
91 :     * as follows:
92 :     * 0x01 == set for upper-case letters
93 :     * 0x02 == set for lower-case letters
94 :     * 0x04 == set for digits
95 :     * 0x08 == set for white space characters
96 :     * 0x10 == set for punctuation characters
97 :     * 0x20 == set for control characters
98 :     * 0x40 == set for hexadecimal characters
99 :     * 0x80 == set for SPACE
100 :     *)
101 :     val ctypeTbl = "\
102 :     \\032\032\032\032\032\032\032\032\032\040\040\040\040\040\032\032\
103 :     \\032\032\032\032\032\032\032\032\032\032\032\032\032\032\032\032\
104 :     \\136\016\016\016\016\016\016\016\016\016\016\016\016\016\016\016\
105 :     \\068\068\068\068\068\068\068\068\068\068\016\016\016\016\016\016\
106 :     \\016\065\065\065\065\065\065\001\001\001\001\001\001\001\001\001\
107 :     \\001\001\001\001\001\001\001\001\001\001\001\016\016\016\016\016\
108 :     \\016\066\066\066\066\066\066\002\002\002\002\002\002\002\002\002\
109 :     \\002\002\002\002\002\002\002\002\002\002\002\016\016\016\016\032\
110 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
111 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
112 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
113 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
114 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
115 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
116 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
117 :     \\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
118 :     \"
119 :     fun inSet (c, s) = let
120 :     val m = ord(InlineT.CharVector.sub(ctypeTbl, ord c))
121 :     in
122 :     (InlineT.DfltInt.andb(m, s) <> 0)
123 :     end
124 :    
125 :     (* predicates on integer coding of Ascii values *)
126 :     fun isAlpha c = inSet(c, 0x03)
127 :     fun isUpper c = inSet(c, 0x01)
128 :     fun isLower c = inSet(c, 0x02)
129 :     fun isDigit c = inSet(c, 0x04)
130 :     fun isHexDigit c = inSet(c, 0x40)
131 :     fun isAlphaNum c = inSet(c, 0x07)
132 :     fun isSpace c = inSet(c, 0x08)
133 :     fun isPunct c = inSet(c, 0x10)
134 :     fun isGraph c = inSet(c, 0x17)
135 :     fun isPrint c = inSet(c, 0x97)
136 :     fun isCntrl c = inSet(c, 0x20)
137 :     fun isAscii c = InlineT.DfltInt.< (ord c, 128)
138 :    
139 :     val offset = ctoi #"a" - ctoi #"A"
140 :     fun toUpper c = if (isLower c) then itoc(ctoi c - offset) else c
141 :     fun toLower c = if (isUpper c) then itoc(ctoi c + offset) else c
142 :    
143 :     fun scanDigits isDigit getc n strm = let
144 :     fun scan (strm, 0, l) = (List.rev l, strm)
145 :     | scan (strm, i, l) = (case getc strm
146 :     of NONE => (List.rev l, strm)
147 :     | SOME(c, strm') => if isDigit c
148 :     then scan (strm', i-1, c::l)
149 :     else (List.rev l, strm)
150 :     (* end case *))
151 :     in
152 :     scan (strm, n, [])
153 :     end
154 :    
155 :     fun chkDigits radix (l, strm) = let
156 :     fun next (x::r) = SOME(x, r)
157 :     | next [] = NONE
158 :     in
159 :     case (NumScan.scanInt radix next l)
160 :     of NONE => NONE
161 :     | SOME(i, _) => if InlineT.Int32.<(i, 256)
162 :     then SOME(chr(InlineT.Int32.toInt i), strm)
163 :     else NONE
164 :     (* end case *)
165 :     end
166 :    
167 :     (* conversions between characters and printable representations *)
168 :     fun scan getc = let
169 :     fun scan' rep = let
170 :     fun get2 rep = (case (getc rep)
171 :     of (SOME(c1, rep')) => (case (getc rep')
172 :     of (SOME(c2, rep'')) => SOME(c1, c2, rep'')
173 :     | _ => NONE
174 :     (* end case *))
175 :     | _ => NONE
176 :     (* end case *))
177 :     in
178 :     case (getc rep)
179 :     of NONE => NONE
180 :     | (SOME(#"\\", rep')) => (case (getc rep')
181 :     of NONE => NONE
182 :     | (SOME(#"\\", rep'')) => (SOME(#"\\", rep''))
183 :     | (SOME(#"\"", rep'')) => (SOME(#"\"", rep''))
184 :     | (SOME(#"a", rep'')) => (SOME(#"\a", rep''))
185 :     | (SOME(#"b", rep'')) => (SOME(#"\b", rep''))
186 :     | (SOME(#"t", rep'')) => (SOME(#"\t", rep''))
187 :     | (SOME(#"n", rep'')) => (SOME(#"\n", rep''))
188 :     | (SOME(#"v", rep'')) => (SOME(#"\v", rep''))
189 :     | (SOME(#"f", rep'')) => (SOME(#"\f", rep''))
190 :     | (SOME(#"r", rep'')) => (SOME(#"\r", rep''))
191 :     | (SOME(#"^", rep'')) => (case (getc rep'')
192 :     of NONE => NONE
193 :     | (SOME(c, rep''')) =>
194 :     if ((#"@" <= c) andalso (c <= #"_"))
195 :     then SOME(chr(ord c - ord #"@"), rep''')
196 :     else NONE
197 :     (* end case *))
198 :     | (SOME(d1, rep'')) =>
199 :     if (isDigit d1)
200 :     then (case (get2 rep'')
201 :     of SOME(d2, d3, rep''') => let
202 :     fun cvt d = (ord d - ord #"0")
203 :     in
204 :     if (isDigit d2 andalso isDigit d3)
205 :     then let
206 :     val n = 100*(cvt d1) + 10*(cvt d2) + (cvt d3)
207 :     in
208 :     if InlineT.DfltInt.<(n, 256)
209 :     then SOME(chr n, rep''')
210 :     else NONE
211 :     end
212 :     else NONE
213 :     end
214 :     | NONE => NONE
215 :     (* end case *))
216 :     else if (isSpace d1)
217 :     then let (* skip over \<ws>+\ *)
218 :     fun skipWS strm = (case (getc strm)
219 :     of NONE => NONE
220 :     | (SOME(#"\\", strm')) => scan' strm'
221 :     | (SOME(c, strm')) => if (isSpace c)
222 :     then skipWS strm'
223 :     else NONE
224 :     (* end case *))
225 :     in
226 :     skipWS rep''
227 :     end
228 :     else NONE
229 :     (* end case *))
230 :     | (SOME(#"\"", rep')) => NONE (* " *)
231 :     | (SOME(c, rep')) =>
232 :     if (isPrint c) then (SOME(c, rep')) else NONE
233 :     (* end case *)
234 :     end
235 :     in
236 :     scan'
237 :     end
238 :    
239 :     val fromString = StringCvt.scanString scan
240 :    
241 :     val itoa = (NumFormat.fmtInt StringCvt.DEC) o InlineT.Int32.fromInt
242 :    
243 :     fun toString #"\a" = "\\a"
244 :     | toString #"\b" = "\\b"
245 :     | toString #"\t" = "\\t"
246 :     | toString #"\n" = "\\n"
247 :     | toString #"\v" = "\\v"
248 :     | toString #"\f" = "\\f"
249 :     | toString #"\r" = "\\r"
250 :     | toString #"\"" = "\\\""
251 :     | toString #"\\" = "\\\\"
252 :     | toString c =
253 :     if (isPrint c)
254 :     then InlineT.PolyVector.sub (PreString.chars, ord c)
255 :     (** NOTE: we should probably recognize the control characters **)
256 :     else let
257 :     val c' = ord c
258 :     in
259 :     if InlineT.DfltInt.>(c', 32)
260 :     then PreString.concat2("\\", itoa c')
261 :     else PreString.concat2("\\^",
262 :     InlineT.PolyVector.sub (PreString.chars, c'+64))
263 :     end
264 :    
265 :     (* scanning function for C escape sequences *)
266 :     fun scanC getc = let
267 :     fun isOctDigit d = (#"0" <= d) andalso (d <= #"7")
268 :     fun scan strm = (case getc strm
269 :     of NONE => NONE
270 :     | SOME(#"\\", strm') => (case getc strm'
271 :     of NONE => NONE
272 :     | (SOME(#"a", strm'')) => SOME(#"\a", strm'')
273 :     | (SOME(#"b", strm'')) => SOME(#"\b", strm'')
274 :     | (SOME(#"t", strm'')) => SOME(#"\t", strm'')
275 :     | (SOME(#"n", strm'')) => SOME(#"\n", strm'')
276 :     | (SOME(#"v", strm'')) => SOME(#"\v", strm'')
277 :     | (SOME(#"f", strm'')) => SOME(#"\f", strm'')
278 :     | (SOME(#"r", strm'')) => SOME(#"\r", strm'')
279 :     | (SOME(#"\\", strm'')) => SOME(#"\\", strm'')
280 :     | (SOME(#"\"", strm'')) => SOME(#"\"", strm'')
281 :     | (SOME(#"'", strm'')) => SOME(#"'", strm'')
282 :     | (SOME(#"?", strm'')) => SOME(#"?", strm'')
283 :     | (SOME(#"x", strm'')) => (* hex escape code *)
284 :     chkDigits StringCvt.HEX
285 :     (scanDigits isHexDigit getc ~1 strm'')
286 :     | _ => (* should be octal escape code *)
287 :     chkDigits StringCvt.OCT
288 :     (scanDigits isOctDigit getc 3 strm')
289 :     (* end case *))
290 :     (** NOT SURE ABOUT THE FOLLOWING TWO CASES:
291 :     | (SOME(#"\"", strm'')) => NONE (* error --- not escaped *)
292 :     | (SOME(#"\'", strm'')) => NONE (* error --- not escaped *)
293 :     **)
294 :     | (SOME(c, strm'')) =>
295 :     if (isPrint c) then SOME(c, strm'') else NONE
296 :     (* end case *))
297 :     in
298 :     scan
299 :     end
300 :    
301 :     val fromCString = StringCvt.scanString scanC
302 :    
303 :     fun toCString #"\a" = "\\a"
304 :     | toCString #"\b" = "\\b"
305 :     | toCString #"\t" = "\\t"
306 :     | toCString #"\n" = "\\n"
307 :     | toCString #"\v" = "\\v"
308 :     | toCString #"\f" = "\\f"
309 :     | toCString #"\r" = "\\r"
310 :     | toCString #"\"" = "\\\""
311 :     | toCString #"\\" = "\\\\"
312 :     | toCString #"?" = "\\?"
313 :     | toCString #"'" = "\\'"
314 :     | toCString #"\000" = "\\0"
315 :     | toCString c = if (isPrint c)
316 :     then InlineT.PolyVector.sub (PreString.chars, ord c)
317 :     else let
318 :     val i = InlineT.Int32.fromInt(ord c)
319 :     val prefix = if InlineT.Int32.<(i, 8)
320 :     then "\\00"
321 :     else if InlineT.Int32.<(i, 64)
322 :     then "\\0"
323 :     else "\\"
324 :     in
325 :     PreString.concat2(prefix, NumFormat.fmtInt StringCvt.OCT i)
326 :     end
327 :    
328 :     end (* Char *)
329 :    
330 :    
331 :     (*
332 :     * $Log: char.sml,v $
333 :     * Revision 1.1.1.1 1998/04/08 18:40:04 george
334 :     * Version 110.5
335 :     *
336 :     *)

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