Annotation of /sml/branches/idlbasis-devel/src/system/Basis/Implementation/vector-slice.sml

Parent Directory | Revision Log

---

Revision 866 - (view) (download)

1 :	dbm	850	(* vector-slice.sml
2 :			*
3 :			* COPYRIGHT (c) 2000 Bell Labs, Lucent Technologies.
4 :			*
5 :			* extracted from array-slice.mldoc (v. 1.0; 2000-06-20)
6 :			*)
7 :
8 :
9 :			structure VectorSlice : VECTOR_SLICE =
10 :			struct
11 :
12 :			structure V = InlineT.PolyVector
13 :			val (op +) = InlineT.DfltInt.+
14 :			val (op -) = InlineT.DfltInt.-
15 :			val (op <) = InlineT.DfltInt.<
16 :			val (op >=) = InlineT.DfltInt.>=
17 :			val sub' = V.sub
18 :			val geu = InlineT.DfltInt.geu
19 :
20 :			datatype 'a slice = SL of {base: 'a vector, start: int, stop: int}
21 :			(* invariants:
22 :			* 0<=start<=stop<=length base
23 :			*)
24 :
25 :			(* -- alternate representation with start and length
26 :			datatype 'a slice = SL of {base: 'a vector, start: int, length: int}
27 :			(* invariants:
28 :			* 0<=start,length; start<length base; start+length <= length base *)
29 :			*)
30 :
31 :			(* val length : 'a slice -> int *)
32 :			fun length(SL{start,stop,...}) = stop - start
33 :			(* fun length(SL{length,...}) = n *)
34 :
35 :			(* val sub : 'a slice * int -> 'a *)
36 :			(* sub(s,j) valid if 0<=j<stop-start, otherwise raises Subscript *)
37 :			fun sub (SL{base, start, stop}, j) =
38 :			let val j' = start+j
39 :			in if geu(j', stop) (* checks for j' >= 0 *)
40 :			then raise Core.Subscript
41 :			else sub'(base, j')
42 :			end
43 :
44 :			(* val slice : 'a Vector.vector * int * int option -> 'a slice *)
45 :			fun slice (base,start,lenOp) =
46 :			let val blen = V.length base
47 :			in if geu(start, blen) (* checks start >= 0 *)
48 :			then raise Core.Subscript
49 :			else case lenOp
50 :			of NONE => SL{base=base,start=start,stop=blen}
51 :			| SOME n =>
52 :			if geu(n, blen-start) (* checks n >= 0 *)
53 :			then raise Core.Subscript
54 :			else SL{base=base,start=start,stop=start+n}
55 :			end
56 :
57 :			(* val full : 'a Vector.vector -> 'a slice *)
58 :			fun full base = SL{base=base,start=0,stop=V.length base}
59 :	blume	866	(*
60 :	dbm	850	let val blen = V.length base
61 :			in if geu(start, blen) (* checks start >= 0 *)
62 :			then raise Core.Subscript
63 :			else case lenOp
64 :			of NONE => SL{base=base,start=start,stop=blen}
65 :			| SOME n =>
66 :			if geu(n, blen-start) (* checks n >= 0 *)
67 :			then raise Core.Subscript
68 :			else SL{base=base,start=start,stop=start+n}
69 :			end
70 :	blume	866	*)
71 :	dbm	850
72 :			(* val subslice : 'a slice * int * int option -> 'a slice *)
73 :			fun subslice (SL{base, start, stop}, i, sz) =
74 :			if geu(i, stop-start) (* checks start >= 0 *)
75 :			then raise Core.Subscript
76 :			else case sz
77 :			of NONE => SL{base=base,start=start+i,stop=stop}
78 :			| SOME n =>
79 :			if geu(n, stop-start-i) (* checks n >= 0 *)
80 :			then raise Core.Subscript
81 :			else SL{base=base,start=start+i,stop=start+i+n}
82 :
83 :			(* val base : 'a slice -> 'a Vector.vector * int * int *)
84 :			fun base (SL{base,start,stop}) = (base,start,stop-start)
85 :
86 :			(* val vector : 'a slice -> 'a Vector.vector *)
87 :			fun vector (SL{base,start,stop}) =
88 :	blume	866	Vector.tabulate(stop-start,fn n => sub'(base,n+start))
89 :	dbm	850
90 :			(* utility functions *)
91 :			fun checkLen n =
92 :			if InlineT.DfltInt.ltu(Vector.maxLen, n)
93 :			then raise General.Size
94 :			else ()
95 :
96 :			fun rev ([], l) = l
97 :			| rev (x::r, l) = rev (r, x::l)
98 :
99 :			(* val concat : 'a slice list -> 'a Vector.vector *)
100 :			fun concat [v] = vector v
101 :			| concat vl = let
102 :			(* get the total length and flatten the list *)
103 :			fun len ([], n, l) = (checkLen n; (n, rev(l, [])))
104 :			| len (SL{base,start,stop}::r, n, l) = let
105 :			val n' = stop - start
106 :			fun explode (i, l) = if (i < stop)
107 :			then explode(i+1, sub'(base, i)::l)
108 :			else l
109 :			in
110 :			len (r, n + n', explode(start, l))
111 :			end
112 :			in
113 :			case len (vl, 0, [])
114 :			of (0, _) => Assembly.vector0
115 :			| (n, l) => Assembly.A.create_v(n, l)
116 :			(* end case *)
117 :			end
118 :
119 :			(* val isEmpty : 'a slice -> bool *)
120 :			fun isEmpty (SL{base,start,stop}) = stop<=start
121 :
122 :			(* val getItem : 'a slice -> ('a * 'a slice) option *)
123 :			fun getItem (SL{base,start,stop}) =
124 :			if stop<=start then NONE
125 :	blume	866	else SOME(sub'(base, start), SL{base=base,start=start+1,stop=stop})
126 :	dbm	850
127 :			(* val appi : (int * 'a -> unit) -> 'a slice -> unit *)
128 :			fun appi f (SL{base,start,stop}) =
129 :			let fun app i = if (i < stop)
130 :			then (f (i, sub'(base, i)); app(i+1))
131 :			else ()
132 :			in app start
133 :			end
134 :
135 :			(* val app : ('a -> unit) -> 'a slice -> unit *)
136 :	blume	866	fun app f (SL{base,start,stop}) =
137 :	dbm	850	let fun app i = if (i < stop)
138 :			then (f (sub'(base, i)); app(i+1))
139 :			else ()
140 :			in app start
141 :			end
142 :
143 :			(* val mapi : (int * 'a -> 'b) -> 'a slice -> 'b vector *)
144 :	blume	859	fun mapi f (SL{base,start,stop}) =
145 :	dbm	850	let val len = stop - start
146 :			fun mapf (i, l) = if (i < stop)
147 :			then mapf (i+1, f (i, sub'(base, i)) :: l)
148 :			else Assembly.A.create_v(len, rev(l, []))
149 :			in if (len > 0)
150 :			then mapf (start, [])
151 :			else Assembly.vector0
152 :			end
153 :
154 :			(* val map : ('a -> 'b) -> 'a slice -> 'b vector *)
155 :	blume	859	fun map f (SL{base,start,stop}) =
156 :	dbm	850	let val len = stop - start
157 :			fun mapf (i, l) = if (i < stop)
158 :			then mapf (i+1, f (sub'(base, i)) :: l)
159 :			else Assembly.A.create_v(len, rev(l, []))
160 :			in
161 :			if (len > 0)
162 :			then mapf (start, [])
163 :			else Assembly.vector0
164 :			end
165 :
166 :			(* val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b *)
167 :			fun foldli f init (SL{base,start,stop}) =
168 :			let fun fold (i, accum) = if (i < stop)
169 :			then fold (i+1, f (i, sub'(base, i), accum))
170 :			else accum
171 :			in fold (start, init)
172 :			end
173 :
174 :			(* val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b *)
175 :			fun foldri f init (SL{base,start,stop}) =
176 :			let fun fold (i, accum) = if (i >= start)
177 :			then fold (i-1, f (i, sub'(base, i), accum))
178 :			else accum
179 :			in fold (stop - 1, init)
180 :			end
181 :
182 :			(* val foldl : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b *)
183 :			fun foldl f init (SL{base,start,stop}) =
184 :			let fun fold (i, accum) = if (i < stop)
185 :			then fold (i+1, f (sub'(base, i), accum))
186 :			else accum
187 :			in fold (start, init)
188 :			end
189 :
190 :			(* val foldr : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b *)
191 :			fun foldr f init (SL{base,start,stop}) =
192 :			let fun fold (i, accum) = if (i >= start)
193 :			then fold (i-1, f (sub'(base, i), accum))
194 :			else accum
195 :			in fold (stop - 1, init)
196 :			end
197 :
198 :			(* val findi : (int * 'a -> bool) -> 'a slice -> (int * 'a) option *)
199 :			fun findi f (SL{base,start,stop}) =
200 :			let fun findi' i =
201 :			if (i < stop)
202 :			then let val item = (i,sub'(base, i))
203 :			in if f(item)
204 :			then SOME item
205 :			else findi' (i+1)
206 :			end
207 :			else NONE
208 :			in findi' start
209 :			end
210 :
211 :			(* val find : ('a -> bool) -> 'a slice -> 'a option *)
212 :			fun find f (SL{base,start,stop}) =
213 :			let fun find' i =
214 :			if (i < stop)
215 :			then let val item = sub'(base, i)
216 :			in if f item
217 :			then SOME(item)
218 :	blume	866	else find' (i+1)
219 :	dbm	850	end
220 :			else NONE
221 :			in find' start
222 :			end
223 :
224 :			(* val exists : ('a -> bool) -> 'a slice -> bool *)
225 :			fun exists f (SL{base,start,stop}) =
226 :			let fun exists' i =
227 :			if (i < stop)
228 :			then if f(sub'(base, i))
229 :			then true
230 :			else exists' (i+1)
231 :			else false
232 :			in exists' start
233 :			end
234 :
235 :			(* val all : ('a -> bool) -> 'a slice -> bool *)
236 :			fun all f (SL{base,start,stop}) =
237 :			let fun all' i =
238 :			if (i < stop)
239 :			then if f(sub'(base, i))
240 :			then all' (i+1)
241 :			else false
242 :			else true
243 :			in all' start
244 :			end
245 :
246 :			(* val collate : ('a * 'a -> order) -> 'a slice * 'a slice -> order *)
247 :			fun collate comp (SL{base,start,stop},SL{base=base',start=start',stop=stop'}) =
248 :			let fun cmp (i,i') =
249 :			if (i < stop)
250 :			then if (i' >= stop') then GREATER
251 :	blume	859	else case comp(sub'(base, i),
252 :	dbm	850	sub'(base', i'))
253 :			of EQUAL => cmp(i+1,i'+1)
254 :			| x => x
255 :			else if (i' < stop') then LESS
256 :			else EQUAL
257 :			in cmp(start,start')
258 :			end
259 :
260 :			(* val copyVec : {src : 'a VectorSlice.slice, dst : 'a Array.array, di : int}
261 :			-> unit *)
262 :			(* DBM: this operation does not involve array slices, so belongs here in
263 :			* VectorSlice, or as John suggests, in Array.
264 :			fun copyVec {src,dst,di} =
265 :			if di < 0 orelse
266 :			di + length src > V.length dst
267 :			then raise Core.Subscript
268 :			else appi(fn (i,x) => V.update(dst,di+i,x)) src
269 :			*)
270 :
271 :			end (* structure VectorSlice *)

---

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