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/compiler/PervEnv/Basis/substring.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Basis/substring.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 89 - (view) (download)

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

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