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/word8-array.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/PervEnv/Basis/word8-array.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 114 - (view) (download)

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

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