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

Annotation of /sml/trunk/system/Basis/Implementation/char-array.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 416 - (view) (download)
Original Path: sml/trunk/src/system/Basis/Implementation/char-array.sml

1 : monnier 416 (* char-array.sml
2 :     *
3 :     * COPYRIGHT (c) 1994 AT&T Bell Labs.
4 :     *
5 :     *)
6 :    
7 :     structure CharArray : MONO_ARRAY =
8 :     struct
9 :     structure String = StringImp
10 :     structure A = InlineT.CharArray
11 :     val (op <) = InlineT.DfltInt.<
12 :     val (op >=) = InlineT.DfltInt.>=
13 :     val (op +) = InlineT.DfltInt.+
14 :    
15 :     (* unchecked access operations *)
16 :     val unsafeUpdate = A.update
17 :     val unsafeSub = A.sub
18 :     val vecUpdate = InlineT.CharVector.update
19 :     val vecSub = InlineT.CharVector.sub
20 :    
21 :     type elem = char
22 :     type vector = string
23 :     type array = A.array
24 :    
25 :     val maxLen = Core.max_length
26 :    
27 :     fun array (0, c) = A.newArray0()
28 :     | array (len, c) = if (InlineT.DfltInt.ltu(maxLen, len))
29 :     then raise General.Size
30 :     else let
31 :     val arr = A.create len
32 :     fun init i = if (i < len)
33 :     then (unsafeUpdate(arr, i, c); init(i+1))
34 :     else ()
35 :     in
36 :     init 0; arr
37 :     end
38 :    
39 :     fun tabulate (0, _) = A.newArray0()
40 :     | tabulate (len, f) = if (InlineT.DfltInt.ltu(maxLen, len))
41 :     then raise General.Size
42 :     else let
43 :     val arr = A.create len
44 :     fun init i = if (i < len)
45 :     then (unsafeUpdate(arr, i, f i); init(i+1))
46 :     else ()
47 :     in
48 :     init 0; arr
49 :     end
50 :    
51 :     fun fromList [] = A.newArray0()
52 :     | fromList l = let
53 :     fun length ([], n) = n
54 :     | length (_::r, n) = length (r, n+1)
55 :     val len = length (l, 0)
56 :     val _ = if (maxLen < len) then raise General.Size else ()
57 :     val arr = A.create len
58 :     fun init ([], _) = ()
59 :     | init (c::r, i) = (unsafeUpdate(arr, i, c); init(r, i+1))
60 :     in
61 :     init (l, 0); arr
62 :     end
63 :    
64 :     val length : array -> int = InlineT.CharArray.length
65 :     val sub : (array * int) -> elem = InlineT.CharArray.chkSub
66 :     val update : (array * int * elem) -> unit
67 :     = InlineT.CharArray.chkUpdate
68 :    
69 :     fun extract (arr, base, optLen) = let
70 :     val len = length arr
71 :     fun newVec n = let
72 :     val newV = Assembly.A.create_s n
73 :     fun fill i = if (i < n)
74 :     then (vecUpdate(newV, i, unsafeSub(arr, base+i)); fill(i+1))
75 :     else ()
76 :     in
77 :     fill 0; newV
78 :     end
79 :     in
80 :     case (base, optLen)
81 :     of (0, NONE) => if (0 < len) then newVec len else ""
82 :     | (_, SOME 0) => if ((base < 0) orelse (len < base))
83 :     then raise General.Subscript
84 :     else ""
85 :     | (_, SOME 1) => String.str(sub(arr, base))
86 :     | (_, NONE) => if ((base < 0) orelse (len < base))
87 :     then raise General.Subscript
88 :     else if (len = base)
89 :     then ""
90 :     else newVec (len - base)
91 :     | (_, SOME n) =>
92 :     if ((base < 0) orelse (n < 0) orelse (len < (base+n)))
93 :     then raise General.Subscript
94 :     else newVec n
95 :     end
96 :    
97 :     fun copy {src, si, len, dst, di} = let
98 :     val (sstop, dstop) = let
99 :     val srcLen = length src
100 :     in
101 :     case len
102 :     of NONE => if ((si < 0) orelse (srcLen < si))
103 :     then raise Subscript
104 :     else (srcLen, di+srcLen-si)
105 :     | (SOME n) => if ((n < 0) orelse (si < 0) orelse (srcLen < si+n))
106 :     then raise Subscript
107 :     else (si+n, di+n)
108 :     (* end case *)
109 :     end
110 :     fun copyUp (j, k) = if (j < sstop)
111 :     then (
112 :     unsafeUpdate(dst, k, unsafeSub(src, j));
113 :     copyUp (j+1, k+1))
114 :     else ()
115 :     fun copyDown (j, k) = if (si <= j)
116 :     then (
117 :     unsafeUpdate(dst, k, unsafeSub(src, j));
118 :     copyDown (j-1, k-1))
119 :     else ()
120 :     in
121 :     if (di < 0) orelse (length dst < dstop)
122 :     then raise Subscript
123 :     else if (si < di)
124 :     then copyDown (sstop-1, dstop-1)
125 :     else copyUp (si, di)
126 :     end
127 :    
128 :     fun copyVec {src, si, len, dst, di} = let
129 :     val (sstop, dstop) = let
130 :     val srcLen = String.size src
131 :     in
132 :     case len
133 :     of NONE => if ((si < 0) orelse (srcLen < si))
134 :     then raise Subscript
135 :     else (srcLen, di+srcLen-si)
136 :     | (SOME n) => if ((n < 0) orelse (si < 0) orelse (srcLen < si+n))
137 :     then raise Subscript
138 :     else (si+n, di+n)
139 :     (* end case *)
140 :     end
141 :     fun copyUp (j, k) = if (j < sstop)
142 :     then (unsafeUpdate(dst, k, vecSub(src, j)); copyUp (j+1, k+1))
143 :     else ()
144 :     in
145 :     if ((di < 0) orelse (length dst < dstop))
146 :     then raise Subscript
147 :     else copyUp (si, di)
148 :     end
149 :    
150 :     fun app f arr = let
151 :     val len = length arr
152 :     fun app i = if (i < len)
153 :     then (f (unsafeSub(arr, i)); app(i+1))
154 :     else ()
155 :     in
156 :     app 0
157 :     end
158 :    
159 :     fun foldl f init arr = let
160 :     val len = length arr
161 :     fun fold (i, accum) = if (i < len)
162 :     then fold (i+1, f (unsafeSub(arr, i), accum))
163 :     else accum
164 :     in
165 :     fold (0, init)
166 :     end
167 :    
168 :     fun foldr f init arr = let
169 :     fun fold (i, accum) = if (i >= 0)
170 :     then fold (i-1, f (unsafeSub(arr, i), accum))
171 :     else accum
172 :     in
173 :     fold (length arr - 1, init)
174 :     end
175 :    
176 :     fun modify f arr = let
177 :     val len = length arr
178 :     fun modify' i = if (i < len)
179 :     then (
180 :     unsafeUpdate(arr, i, f (unsafeSub(arr, i)));
181 :     modify'(i+1))
182 :     else ()
183 :     in
184 :     modify' 0
185 :     end
186 :    
187 :     fun chkSlice (arr, i, NONE) = let val len = length arr
188 :     in
189 :     if (InlineT.DfltInt.ltu(len, i))
190 :     then raise Subscript
191 :     else (arr, i, len)
192 :     end
193 :     | chkSlice (arr, i, SOME n) = let val len = length arr
194 :     in
195 :     if ((0 <= i) andalso (0 <= n) andalso (i+n <= len))
196 :     then (arr, i, i+n)
197 :     else raise Subscript
198 :     end
199 :    
200 :     fun appi f slice = let
201 :     val (arr, start, stop) = chkSlice slice
202 :     fun app i = if (i < stop)
203 :     then (f (i, unsafeSub(arr, i)); app(i+1))
204 :     else ()
205 :     in
206 :     app start
207 :     end
208 :    
209 :     fun foldli f init slice = let
210 :     val (arr, start, stop) = chkSlice slice
211 :     fun fold (i, accum) = if (i < stop)
212 :     then fold (i+1, f (i, unsafeSub(arr, i), accum))
213 :     else accum
214 :     in
215 :     fold (start, init)
216 :     end
217 :    
218 :     fun foldri f init slice = let
219 :     val (arr, start, stop) = chkSlice slice
220 :     fun fold (i, accum) = if (i >= start)
221 :     then fold (i-1, f (i, unsafeSub(arr, i), accum))
222 :     else accum
223 :     in
224 :     fold (stop - 1, init)
225 :     end
226 :    
227 :     fun modifyi f slice = let
228 :     val (arr, start, stop) = chkSlice slice
229 :     fun modify' i = if (i < stop)
230 :     then (
231 :     unsafeUpdate(arr, i, f (i, unsafeSub(arr, i)));
232 :     modify'(i+1))
233 :     else ()
234 :     in
235 :     modify' start
236 :     end
237 :    
238 :     end (* CharArray *)
239 :    
240 :    

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