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/branches/FLINT/src/compiler/PervEnv/Basis/array2.sml
ViewVC logotype

Annotation of /sml/branches/FLINT/src/compiler/PervEnv/Basis/array2.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 143 - (view) (download)

1 : monnier 89 (* array2.sml
2 :     *
3 :     * COPYRIGHT (c) 1997 AT&T Research.
4 :     *)
5 :    
6 :     structure Array2 :> ARRAY2 =
7 :     struct
8 :    
9 :     val ltu = InlineT.DfltInt.ltu
10 :     val unsafeUpdate = InlineT.PolyArray.update
11 :     val unsafeSub = InlineT.PolyArray.sub
12 :    
13 :     structure A = Array
14 :    
15 :     type 'a array = {
16 :     data : 'a A.array, nrows : int, ncols : int
17 :     }
18 :    
19 :     type 'a region = {
20 :     base : 'a array,
21 :     row : int, col : int,
22 :     nrows : int option, ncols : int option
23 :     }
24 :    
25 :     datatype traversal = RowMajor | ColMajor
26 :    
27 :     val mkArray = InlineT.PolyArray.array
28 :    
29 :     (* compute the index of an array element *)
30 :     fun unsafeIndex ({nrows, ncols, ...} : 'a array, i, j) = (i*ncols + j)
31 :     fun index (arr, i, j) =
32 :     if (ltu(i, #nrows arr) andalso ltu(j, #ncols arr))
33 :     then unsafeIndex (arr, i, j)
34 :     else raise General.Subscript
35 :    
36 :     fun chkSize (nrows, ncols) =
37 :     if (nrows < 0) orelse (ncols < 0)
38 :     then raise General.Size
39 :     else let
40 :     val n = nrows*ncols handle Overflow => raise General.Size
41 :     in
42 :     if (Core.max_length < n) then raise General.Size else n
43 :     end
44 :    
45 :     fun array (nrows, ncols, v) = (case chkSize (nrows, ncols)
46 :     of 0 => {data = Assembly.array0, nrows = 0, ncols = 0}
47 :     | n => {data = mkArray (n, v), nrows = nrows, ncols = ncols}
48 :     (* end case *))
49 :     fun fromList [] = {data = Assembly.array0, nrows = 0, ncols = 0}
50 :     | fromList (row1 :: rest) = let
51 :     val ncols = List.length row1
52 :     fun chk ([], nrows, l) = (nrows, l)
53 :     | chk (row::rest, nrows, l) = let
54 :     fun chkRow ([], n, revCol) = (
55 :     if (n <> ncols) then raise General.Size else ();
56 :     List.revAppend (revCol, l))
57 :     | chkRow (x::r, n, revCol) = chkRow (r, n+1, x::revCol)
58 :     in
59 :     chk (rest, nrows+1, chkRow(row, 0, []))
60 :     end
61 :     val (nrows, flatList) = chk (rest, 1, [])
62 :     in
63 :     { data = Array.fromList(List.@(row1, flatList)),
64 :     nrows = nrows, ncols = ncols
65 :     }
66 :     end
67 :     fun tabulateRM (nrows, ncols, f) = (case chkSize (nrows, ncols)
68 :     of 0 => {data = Assembly.array0, nrows = nrows, ncols = ncols}
69 :     | n => let
70 :     val arr = mkArray (n, f(0, 0))
71 :     fun lp1 (i, j, k) = if (i < nrows)
72 :     then lp2 (i, 0, k)
73 :     else ()
74 :     and lp2 (i, j, k) = if (j < ncols)
75 :     then (
76 :     unsafeUpdate(arr, k, f(i, j));
77 :     lp2 (i, j+1, k+1))
78 :     else lp1 (i+1, 0, k)
79 :     in
80 :     lp2 (0, 1, 1); (* we've already done (0, 0) *)
81 :     {data = arr, nrows = nrows, ncols = ncols}
82 :     end
83 :     (* end case *))
84 :     fun tabulateCM (nrows, ncols, f) = (case chkSize (nrows, ncols)
85 :     of 0 => {data = Assembly.array0, nrows = nrows, ncols = ncols}
86 :     | n => let
87 :     val arr = mkArray (n, f(0, 0))
88 :     val delta = n - 1
89 :     fun lp1 (i, j, k) = if (j < ncols)
90 :     then lp2 (0, j, k)
91 :     else ()
92 :     and lp2 (i, j, k) = if (i < nrows)
93 :     then (
94 :     unsafeUpdate(arr, k, f(i, j));
95 :     lp2 (i+1, j, k+ncols))
96 :     else lp1 (0, j+1, k-delta)
97 :     in
98 :     lp2 (1, 0, ncols); (* we've already done (0, 0) *)
99 :     {data = arr, nrows = nrows, ncols = ncols}
100 :     end
101 :     (* end case *))
102 :     fun tabulate RowMajor = tabulateRM
103 :     | tabulate ColMajor = tabulateCM
104 :     fun sub (a, i, j) = unsafeSub(#data a, index(a, i, j))
105 :     fun update (a, i, j, v) = unsafeUpdate(#data a, index(a, i, j), v)
106 :     fun dimensions {data, nrows, ncols} = (nrows, ncols)
107 :     fun nCols (arr : 'a array) = #ncols arr
108 :     fun nRows (arr : 'a array) = #nrows arr
109 :     fun row ({data, nrows, ncols}, i) = let
110 :     val stop = i*ncols
111 :     fun mkVec (j, l) =
112 :     if (j < stop)
113 :     then Vector.fromList l
114 :     else mkVec(j-1, A.sub(data, j)::l)
115 :     in
116 :     if ltu(nrows, i)
117 :     then raise General.Subscript
118 : monnier 143 else mkVec (stop+ncols-1, [])
119 : monnier 89 end
120 :     fun column ({data, nrows, ncols}, j) = let
121 :     fun mkVec (i, l) =
122 :     if (i < 0)
123 :     then Vector.fromList l
124 :     else mkVec(i-ncols, A.sub(data, i)::l)
125 :     in
126 :     if ltu(ncols, j)
127 :     then raise General.Subscript
128 :     else mkVec ((A.length data - ncols) + j, [])
129 :     end
130 :    
131 :     datatype index = DONE | INDX of {i:int, r:int, c:int}
132 :    
133 :     fun chkRegion {base={data, nrows, ncols}, row, col, nrows=nr, ncols=nc} = let
134 :     fun chk (start, n, NONE) =
135 :     if ((start < 0) orelse (n < start))
136 :     then raise General.Subscript
137 :     else n-start
138 :     | chk (start, n, SOME len) =
139 :     if ((start < 0) orelse (len < 0) orelse (n < start+len))
140 :     then raise General.Subscript
141 :     else len
142 :     val nr = chk (row, nrows, nr)
143 :     val nc = chk (col, ncols, nc)
144 :     in
145 :     {data = data, i = (row*ncols + col), r=row, c=col, nr=nr, nc=nc}
146 :     end
147 :    
148 :     fun copy {src : 'a region, dst, dst_row, dst_col} =
149 :     raise Fail "Array2.copy unimplemented"
150 :    
151 :     (* this function generates a stream of indeces for the given region in
152 :     * row-major order.
153 :     *)
154 :     fun iterateRM arg = let
155 :     val {data, i, r, c, nr, nc} = chkRegion arg
156 :     val ii = ref i and ri = ref r and ci = ref c
157 :     fun mkIndx (r, c) = let val i = !ii
158 :     in
159 :     ii := i+1;
160 :     INDX{i=i, c=c, r=r}
161 :     end
162 :     fun iter () = let
163 :     val r = !ri and c = !ci
164 :     in
165 :     if (c < nc)
166 :     then (ci := c+1; mkIndx(r, c))
167 :     else if (r+1 < nr)
168 :     then (ci := 0; ri := r+1; iter())
169 :     else DONE
170 :     end
171 :     in
172 :     (data, iter)
173 :     end
174 :    
175 :     (* this function generates a stream of indeces for the given region in
176 :     * col-major order.
177 :     *)
178 :     fun iterateCM (arg as {base={ncols, ...}, ...}) = let
179 :     val {data, i, r, c, nr, nc} = chkRegion arg
180 :     val delta = (nr*ncols) - 1
181 :     val ii = ref i and ri = ref r and ci = ref c
182 :     fun mkIndx (r, c) = let val i = !ii
183 :     in
184 :     ii := i+ncols;
185 :     INDX{i=i, c=c, r=r}
186 :     end
187 :     fun iter () = let
188 :     val r = !ri and c = !ci
189 :     in
190 :     if (r < nr)
191 :     then (ri := r+1; mkIndx(r, c))
192 :     else if (c+1 < nc)
193 :     then (ii := !ii-delta; ri := 0; ci := c+1; iter())
194 :     else DONE
195 :     end
196 :     in
197 :     (data, iter)
198 :     end
199 :    
200 :     fun appi order f region = let
201 :     val (data, iter) = (case order
202 :     of RowMajor => iterateRM region
203 :     | ColMajor => iterateCM region
204 :     (* end case *))
205 :     fun app () = (case iter()
206 :     of DONE => ()
207 :     | INDX{i, r, c} => (f(r, c, unsafeSub(data, i)); app())
208 :     (* end case *))
209 :     in
210 :     app ()
211 :     end
212 :    
213 :     fun appRM f {data, ncols, nrows} = A.app f data
214 :     fun appCM f {data, ncols, nrows} = let
215 :     val delta = A.length data - 1
216 :     fun appf (i, k) = if (i < nrows)
217 :     then (f(unsafeSub(data, k)); appf(i+1, k+ncols))
218 :     else let
219 :     val k = k-delta
220 :     in
221 :     if (k < ncols) then appf (0, k) else ()
222 :     end
223 :     in
224 :     appf (0, 0)
225 :     end
226 :     fun app RowMajor = appRM
227 :     | app ColMajor = appCM
228 :    
229 :     fun modifyi order f region = let
230 :     val (data, iter) = (case order
231 :     of RowMajor => iterateRM region
232 :     | ColMajor => iterateCM region
233 :     (* end case *))
234 :     fun modify () = (case iter()
235 :     of DONE => ()
236 :     | INDX{i, r, c} => (
237 :     unsafeUpdate (data, i, f(r, c, unsafeSub(data, i)));
238 :     modify())
239 :     (* end case *))
240 :     in
241 :     modify ()
242 :     end
243 :    
244 :     fun modifyRM f {data, ncols, nrows} = A.modify f data
245 :     fun modifyCM f {data, ncols, nrows} = let
246 :     val delta = A.length data - 1
247 :     fun modf (i, k) = if (i < nrows)
248 :     then (unsafeUpdate(data, k, f(unsafeSub(data, k))); modf(i+1, k+ncols))
249 :     else let
250 :     val k = k-delta
251 :     in
252 :     if (k < ncols) then modf (0, k) else ()
253 :     end
254 :     in
255 :     modf (0, 0)
256 :     end
257 :     fun modify RowMajor = modifyRM
258 :     | modify ColMajor = modifyCM
259 :    
260 :     fun foldi order f init region = let
261 :     val (data, iter) = (case order
262 :     of RowMajor => iterateRM region
263 :     | ColMajor => iterateCM region
264 :     (* end case *))
265 :     fun fold accum = (case iter()
266 :     of DONE => accum
267 :     | INDX{i, r, c} => fold(f(r, c, unsafeSub(data, i), accum))
268 :     (* end case *))
269 :     in
270 :     fold init
271 :     end
272 :    
273 :     fun foldRM f init {data, ncols, nrows} = A.foldl f init data
274 :     fun foldCM f init {data, ncols, nrows} = let
275 :     val delta = A.length data - 1
276 :     fun foldf (i, k, accum) = if (i < nrows)
277 :     then foldf (i+1, k+ncols, f(unsafeSub(data, k), accum))
278 :     else let
279 :     val k = k-delta
280 :     in
281 :     if (k < ncols) then foldf (0, k, accum) else accum
282 :     end
283 :     in
284 :     foldf (0, 0, init)
285 :     end
286 :     fun fold RowMajor = foldRM
287 :     | fold ColMajor = foldCM
288 :    
289 :     end
290 :    

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