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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 227 - (view) (download)

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

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