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/Init/substring.sml
ViewVC logotype

Annotation of /sml/trunk/src/system/Init/substring.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 499 - (view) (download)

1 : monnier 416 (* substring.sml
2 :     *
3 :     * COPYRIGHT (c) 1995 AT&T Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 : monnier 429 local
8 :     infix 7 * / mod div
9 :     infix 6 ^ + -
10 :     infix 3 := o
11 :     infix 4 > < >= <= = <>
12 :     infixr 5 :: @
13 :     infix 0 before
14 :    
15 :     open PrimTypes
16 :     in
17 : monnier 416 structure Substring :> SUBSTRING
18 :     where type char = PrimTypes.char
19 :     where type string = PrimTypes.string
20 :     = struct
21 :    
22 :     open PrePervasive
23 :    
24 :     structure W = InlineT.DfltWord
25 :    
26 :     val op + = InlineT.DfltInt.+
27 :     val op - = InlineT.DfltInt.-
28 :     val op < = InlineT.DfltInt.<
29 :     val op <= = InlineT.DfltInt.<=
30 :     val op > = InlineT.DfltInt.>
31 :     val op >= = InlineT.DfltInt.>=
32 : monnier 498 (* val op = = InlineT.= *)
33 : monnier 416 val unsafeSub = InlineT.CharVector.sub
34 :     val stringSize = InlineT.CharVector.length
35 :    
36 :     (* list reverse *)
37 :     fun rev ([], l) = l
38 :     | rev (x::r, l) = rev (r, x::l)
39 :    
40 :     type char = PrimTypes.char
41 :     type string = PrimTypes.string
42 :     datatype substring = SS of (string * int * int)
43 :    
44 :     fun base (SS arg) = arg
45 :    
46 :     fun string (SS arg) = PreString.unsafeSubstring arg
47 :    
48 :     (* NOTE: we use words to check the right bound so as to avoid
49 :     * raising overflow.
50 :     *)
51 :     fun substring (s, i, n) =
52 :     if ((i < 0) orelse (n < 0)
53 :     orelse W.<(W.fromInt(stringSize s), W.+(W.fromInt i, W.fromInt n)))
54 :     then raise Core.Subscript
55 :     else SS(s, i, n)
56 :     fun extract (s, i, NONE) = let
57 :     val len = stringSize s
58 :     in
59 :     if ((0 <= i) andalso (i <= len))
60 :     then SS(s, i, len - i)
61 :     else raise Core.Subscript
62 :     end
63 :     | extract (s, i, SOME n) = substring(s, i, n)
64 :     fun all s = SS(s, 0, stringSize s)
65 :    
66 :     fun isEmpty (SS(_, _, 0)) = true
67 :     | isEmpty _ = false
68 :    
69 :     fun getc (SS(s, i, 0)) = NONE
70 :     | getc (SS(s, i, n)) = SOME(unsafeSub(s, i), SS(s, i+1, n-1))
71 :     fun first (SS(s, i, 0)) = NONE
72 :     | first (SS(s, i, n)) = SOME(unsafeSub(s, i))
73 :     fun triml k (SS(s, i, n)) =
74 :     if (k < 0) then raise Core.Subscript
75 :     else if (k >= n) then SS(s, i+n, 0)
76 :     else SS(s, i+k, n-k)
77 :     fun trimr k (SS(s, i, n)) =
78 :     if (k < 0) then raise Core.Subscript
79 :     else if (k >= n) then SS(s, i, 0)
80 :     else SS(s, i, n-k)
81 :    
82 :     fun sub (SS(s, i, n), j) =
83 :     if (InlineT.DfltInt.geu(j, n))
84 :     then raise Core.Subscript
85 :     else unsafeSub(s, i+j)
86 :     fun size (SS(_, _, n)) = n
87 :     fun slice (SS(s, i, n), j, NONE) =
88 :     if ((0 <= j) andalso (j <= n))
89 :     then SS(s, i+j, n-j)
90 :     else raise Core.Subscript
91 :     | slice (SS(s, i, n), j, SOME m) =
92 :     (* NOTE: we use words to check the right bound so as to avoid
93 :     * raising overflow.
94 :     *)
95 :     if ((j < 0) orelse (m < 0)
96 :     orelse W.<(W.fromInt n, W.+(W.fromInt j, W.fromInt m)))
97 :     then raise Core.Subscript
98 :     else SS(s, i+j, m)
99 :     (* concatenate a list of substrings together *)
100 :     fun concat ssl = let
101 :     fun length (len, sl, []) = (len, sl)
102 :     | length (len, sl, (SS(s, i, n)::rest)) =
103 :     length(len+n, PreString.unsafeSubstring(s, i, n)::sl, rest)
104 :     in
105 :     PreString.revConcat (length (0, [], ssl))
106 :     end
107 :    
108 :     (* explode a substring into a list of characters *)
109 :     fun explode (SS(s, i, n)) = let
110 :     fun f(l, j) = if (j < i)
111 :     then l
112 :     else f(unsafeSub(s, j) :: l, j-1)
113 :     in
114 :     f(nil, (i + n) - 1)
115 :     end
116 :    
117 :     (* Substring comparisons *)
118 :     fun isPrefix s1 (SS(s2, i2, n2)) = PreString.isPrefix (s1, s2, i2, n2)
119 :     fun compare (SS(s1, i1, n1), SS(s2, i2, n2)) =
120 :     PreString.cmp (s1, i1, n1, s2, i2, n2)
121 :     fun collate cmpFn (SS(s1, i1, n1), SS(s2, i2, n2)) =
122 :     PreString.collate cmpFn (s1, i1, n1, s2, i2, n2)
123 :    
124 :     fun splitAt (SS(s, i, n), k) =
125 :     if (InlineT.DfltInt.ltu(n, k))
126 :     then raise Core.Subscript
127 :     else (SS(s, i, k), SS(s, i+k, n-k))
128 :    
129 :     local
130 :     fun scanl chop pred (SS(s, i, n)) = let
131 :     val stop = i+n
132 :     fun scan j = if ((j <> stop) andalso pred(unsafeSub(s, j)))
133 :     then scan(j+1)
134 :     else j
135 :     in
136 :     chop (s, i, n, scan i - i)
137 :     end
138 :     fun scanr chop pred (SS(s, i, n)) = let
139 :     val stop = i-1
140 :     fun scan j = if ((j <> stop) andalso pred(unsafeSub(s, j)))
141 :     then scan(j-1)
142 :     else j
143 :     in
144 :     chop (s, i, n, (scan (i+n-1) - i) + 1)
145 :     end
146 :     in
147 :     val splitl = scanl (fn (s, i, n, k) => (SS(s, i, k), SS(s, i+k, n-k)))
148 :     val splitr = scanr (fn (s, i, n, k) => (SS(s, i, k), SS(s, i+k, n-k)))
149 :     val dropl = scanl (fn (s, i, n, k) => SS(s, i+k, n-k))
150 :     val dropr = scanr (fn (s, i, n, k) => SS(s, i, k))
151 :     val takel = scanl (fn (s, i, n, k) => SS(s, i, k))
152 :     val taker = scanr (fn (s, i, n, k) => SS(s, i+k, n-k))
153 :     end (* local *)
154 :    
155 :     (* find the position of the first occurrence of s in the substring.
156 :     * NOTE: some day we might want to implement KMP matching for this
157 :     *)
158 :     fun position s (SS (s', i, n)) = let
159 :     val len = stringSize s
160 :     fun eq (j, k) = (j >= len) orelse
161 :     ((unsafeSub(s, j) = unsafeSub(s', k)) andalso eq (j+1, k+1))
162 :     val stop = i+n-len
163 :     fun cmp k =
164 :     if (k > stop) then i+n (* failure *)
165 :     else if eq(0, k) then k
166 :     else cmp(k+1)
167 :     val indx = cmp i
168 :     in
169 :     (SS(s', i, indx-i), SS(s', indx, i+n-indx))
170 :     end
171 :    
172 :     fun span (SS(s1, i1, n1), SS(s2, i2, n2)) =
173 :     if ((s1 = s2) andalso (i1 <= i2+n2))
174 :     then SS(s1, i1, (i2+n2)-i1)
175 :     else raise Span
176 :    
177 :     fun translate tr (SS(s, i, n)) =
178 :     PreString.translate (tr, s, i, n)
179 :    
180 :     fun tokens isDelim (SS(s, i, n)) = let
181 :     val stop = i+n
182 :     fun substr (i, j, l) =
183 :     if (i = j) then l else SS(s, i, j-i)::l
184 :     fun scanTok (i, j, toks) = if (j < stop)
185 :     then if (isDelim (unsafeSub (s, j)))
186 :     then skipSep(j+1, substr(i, j, toks))
187 :     else scanTok (i, j+1, toks)
188 :     else substr(i, j, toks)
189 :     and skipSep (j, toks) = if (j < stop)
190 :     then if (isDelim (unsafeSub (s, j)))
191 :     then skipSep(j+1, toks)
192 :     else scanTok(j, j+1, toks)
193 :     else toks
194 :     in
195 :     rev (scanTok (i, i, []), [])
196 :     end
197 :     fun fields isDelim (SS(s, i, n)) = let
198 :     val stop = i+n
199 :     fun substr (i, j, l) = SS(s, i, j-i)::l
200 :     fun scanTok (i, j, toks) = if (j < stop)
201 :     then if (isDelim (unsafeSub (s, j)))
202 :     then scanTok (j+1, j+1, substr(i, j, toks))
203 :     else scanTok (i, j+1, toks)
204 :     else substr(i, j, toks)
205 :     in
206 :     rev (scanTok (i, i, []), [])
207 :     end
208 :    
209 :     fun foldl f init (SS(s, i, n)) = let
210 :     val stop = i+n
211 :     fun iter (j, accum) = if (j < stop)
212 :     then iter (j+1, f (unsafeSub(s, j), accum))
213 :     else accum
214 :     in
215 :     iter (i, init)
216 :     end
217 :     fun foldr f init (SS(s, i, n)) = let
218 :     fun iter (j, accum) = if (j >= i)
219 :     then iter (j-1, f (unsafeSub(s, j), accum))
220 :     else accum
221 :     in
222 :     iter (i+n-1, init)
223 :     end
224 :     fun app f (SS(s, i, n)) = let
225 :     val stop = i+n
226 :     fun iter j = if (j < stop)
227 :     then (f (unsafeSub(s, j)); iter (j+1))
228 :     else ()
229 :     in
230 :     iter i
231 :     end
232 :    
233 : monnier 429 end
234 :     end
235 : monnier 416

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