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/src/system/Basis/Implementation/string.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Basis/Implementation/string.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 498 - (view) (download)
Original Path: sml/branches/SMLNJ/src/system/Basis/Implementation/string.sml

1 : monnier 416 (* string.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     structure StringImp : STRING =
8 :     struct
9 :     val op + = InlineT.DfltInt.+
10 :     val op - = InlineT.DfltInt.-
11 :     val op < = InlineT.DfltInt.<
12 :     val op <= = InlineT.DfltInt.<=
13 :     val op > = InlineT.DfltInt.>
14 :     val op >= = InlineT.DfltInt.>=
15 : monnier 498 (* val op = = InlineT.= *)
16 : monnier 416 val unsafeSub = InlineT.CharVector.sub
17 :     val unsafeUpdate = InlineT.CharVector.update
18 :    
19 :     (* list reverse *)
20 :     fun rev ([], l) = l
21 :     | rev (x::r, l) = rev (r, x::l)
22 :    
23 :     type char = char
24 :     type string = string
25 :    
26 :     val maxSize = Core.max_length
27 :    
28 :     (* the length of a string *)
29 :     val size = InlineT.CharVector.length
30 :    
31 :     val unsafeCreate = Assembly.A.create_s
32 :    
33 :     (* allocate an uninitialized string of given length *)
34 :     fun create n = if (InlineT.DfltInt.ltu(maxSize, n))
35 :     then raise General.Size
36 :     else Assembly.A.create_s n
37 :    
38 :     (* convert a character into a single character string *)
39 :     fun str (c : Char.char) : string =
40 :     InlineT.PolyVector.sub(PreString.chars, InlineT.cast c)
41 :    
42 :     (* get a character from a string *)
43 :     val sub : (string * int) -> char = InlineT.CharVector.chkSub
44 :    
45 :     (* Return the n-character substring of s starting at position i.
46 :     * NOTE: we use words to check the right bound so as to avoid
47 :     * raising overflow.
48 :     *)
49 :     local
50 :     structure W = InlineT.DfltWord
51 :     in
52 :     fun substring (s, i, n) =
53 :     if ((i < 0) orelse (n < 0)
54 :     orelse W.<(W.fromInt(size s), W.+(W.fromInt i, W.fromInt n)))
55 :     then raise General.Subscript
56 :     else PreString.unsafeSubstring (s, i, n)
57 :     end (* local *)
58 :    
59 :     fun extract (v, base, optLen) = let
60 :     val len = size v
61 :     fun newVec n = let
62 :     val newV = Assembly.A.create_s n
63 :     fun fill i = if (i < n)
64 :     then (unsafeUpdate(newV, i, unsafeSub(v, base+i)); fill(i+1))
65 :     else ()
66 :     in
67 :     fill 0; newV
68 :     end
69 :     in
70 :     case (base, optLen)
71 :     of (0, NONE) => v
72 :     | (_, SOME 0) => if ((base < 0) orelse (len < base))
73 :     then raise General.Subscript
74 :     else ""
75 :     | (_, NONE) => if ((base < 0) orelse (len < base))
76 :     then raise General.Subscript
77 :     else if (base = len)
78 :     then ""
79 :     else newVec (len - base)
80 :     | (_, SOME 1) =>
81 :     if ((base < 0) orelse (len < base+1))
82 :     then raise General.Subscript
83 :     else str(unsafeSub(v, base))
84 :     | (_, SOME n) =>
85 :     if ((base < 0) orelse (n < 0) orelse (len < (base+n)))
86 :     then raise General.Subscript
87 :     else newVec n
88 :     (* end case *)
89 :     end
90 :    
91 :     fun op ^ ("", s) = s
92 :     | op ^ (s, "") = s
93 :     | op ^ (x, y) = PreString.concat2 (x, y)
94 :    
95 :     (* concatenate a list of strings together *)
96 :     fun concat [s] = s
97 :     | concat (sl : string list) = let
98 :     fun length (i, []) = i
99 :     | length (i, s::rest) = length(i+size s, rest)
100 :     in
101 :     case length(0, sl)
102 :     of 0 => ""
103 :     | 1 => let
104 :     fun find ("" :: r) = find r
105 :     | find (s :: _) = s
106 :     | find _ = "" (** impossible **)
107 :     in
108 :     find sl
109 :     end
110 :     | totLen => let
111 :     val ss = create totLen
112 :     fun copy ([], _) = ()
113 :     | copy (s::r, i) = let
114 :     val len = size s
115 :     fun copy' j = if (j = len)
116 :     then ()
117 :     else (
118 :     unsafeUpdate(ss, i+j, unsafeSub(s, j));
119 :     copy'(j+1))
120 :     in
121 :     copy' 0;
122 :     copy (r, i+len)
123 :     end
124 :     in
125 :     copy (sl, 0); ss
126 :     end
127 :     (* end case *)
128 :     end (* concat *)
129 :    
130 :     (* implode a list of characters into a string *)
131 :     fun implode [] = ""
132 :     | implode cl = let
133 :     fun length ([], n) = n
134 :     | length (_::r, n) = length (r, n+1)
135 :     in
136 :     PreString.implode (length (cl, 0), cl)
137 :     end
138 :    
139 :     (* explode a string into a list of characters *)
140 :     fun explode s = let
141 :     fun f(l, ~1) = l
142 :     | f(l, i) = f(unsafeSub(s, i) :: l, i-1)
143 :     in
144 :     f(nil, size s - 1)
145 :     end
146 :    
147 :     fun map f vec = (case (size vec)
148 :     of 0 => ""
149 :     | len => let
150 :     val newVec = Assembly.A.create_s len
151 :     fun mapf i = if (i < len)
152 :     then (unsafeUpdate(newVec, i, f(unsafeSub(vec, i))); mapf(i+1))
153 :     else ()
154 :     in
155 :     mapf 0; newVec
156 :     end
157 :     (* end case *))
158 :    
159 :     (* map a translation function across the characters of a string *)
160 :     fun translate tr s = PreString.translate (tr, s, 0, size s)
161 :    
162 :     (* tokenize a string using the given predicate to define the delimiter
163 :     * characters.
164 :     *)
165 :     fun tokens isDelim s = let
166 :     val n = size s
167 :     fun substr (i, j, l) = if (i = j)
168 :     then l
169 :     else PreString.unsafeSubstring(s, i, j-i)::l
170 :     fun scanTok (i, j, toks) = if (j < n)
171 :     then if (isDelim (unsafeSub (s, j)))
172 :     then skipSep(j+1, substr(i, j, toks))
173 :     else scanTok (i, j+1, toks)
174 :     else substr(i, j, toks)
175 :     and skipSep (j, toks) = if (j < n)
176 :     then if (isDelim (unsafeSub (s, j)))
177 :     then skipSep(j+1, toks)
178 :     else scanTok(j, j+1, toks)
179 :     else toks
180 :     in
181 :     rev (scanTok (0, 0, []), [])
182 :     end
183 :     fun fields isDelim s = let
184 :     val n = size s
185 :     fun substr (i, j, l) = PreString.unsafeSubstring(s, i, j-i)::l
186 :     fun scanTok (i, j, toks) = if (j < n)
187 :     then if (isDelim (unsafeSub (s, j)))
188 :     then scanTok (j+1, j+1, substr(i, j, toks))
189 :     else scanTok (i, j+1, toks)
190 :     else substr(i, j, toks)
191 :     in
192 :     rev (scanTok (0, 0, []), [])
193 :     end
194 :    
195 :     (* String comparisons *)
196 :     fun isPrefix s1 s2 = PreString.isPrefix (s1, s2, 0, size s2)
197 :     fun compare (a, b) = PreString.cmp (a, 0, size a, b, 0, size b)
198 :     fun collate cmpFn (a, b) = PreString.collate cmpFn (a, 0, size a, b, 0, size b)
199 :    
200 :     (* String greater or equal *)
201 :     fun sgtr (a, b) = let
202 :     val al = size a and bl = size b
203 :     val n = if (al < bl) then al else bl
204 :     fun cmp i = if (i = n)
205 :     then (al > bl)
206 :     else let
207 :     val ai = unsafeSub(a,i)
208 :     val bi = unsafeSub(b,i)
209 :     in
210 :     Char.>(ai, bi) orelse ((ai = bi) andalso cmp(i+1))
211 :     end
212 :     in
213 :     cmp 0
214 :     end
215 :    
216 :     fun op <= (a,b) = if sgtr(a,b) then false else true
217 :     fun op < (a,b) = sgtr(b,a)
218 :     fun op >= (a,b) = b <= a
219 :     val op > = sgtr
220 :    
221 :     fun fromString' scanChar s = let
222 :     val len = size s
223 :     fun getc i = if InlineT.DfltInt.<(i, len)
224 :     then SOME(unsafeSub(s, i), i+1)
225 :     else NONE
226 :     val scanChar = scanChar getc
227 :     fun accum (i, chars) = (case (scanChar i)
228 :     of NONE => if InlineT.DfltInt.<(i, len)
229 :     then NONE (* bad format *)
230 :     else SOME(implode(List.rev chars))
231 :     | (SOME(c, i')) => accum(i', c::chars)
232 :     (* end case *))
233 :     in
234 :     accum (0, [])
235 :     end
236 :    
237 :     val fromString = fromString' Char.scan
238 :     val toString = translate Char.toString
239 :    
240 :     val fromCString = fromString' Char.scanC
241 :     val toCString = translate Char.toCString
242 :    
243 :     end (* structure String *)
244 :    
245 :    

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