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 132 - (view) (download)
Original Path: sml/branches/FLINT/src/compiler/PervEnv/Basis/substring.sml

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

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