Implement VectorSlice

src/basis.mlp

@@ -1,9 +1,9 @@
 MLWorks 2.0
-basis.mlp 306 7
+basis.mlp 308 7
   AboutInfo 2 2
     Version 0 0
     Description 0 0
-  Files 143 0
+  Files 145 0
     basis/bit_flags.sml
     basis/__bit_flags.sml
     basis/__array.sml
@@ -129,6 +129,8 @@ basis.mlp 306 7
     basis/time.sml
     basis/timer.sml
     basis/vector.sml
+    basis/vector_slice.sml
+    basis/__vector_slice.sml
     basis/word.sml
     basis/__generic_sock.sml
     basis/__host_db.sml

src/basis/__array.sml

@@ -98,13 +98,18 @@ structure Array : ARRAY =
     val sub = MLWorks.Internal.Array.sub
     val update = MLWorks.Internal.Array.update
 
+    (* FIXME: inefficient *)
+    fun vector array =
+	MLWorks.Internal.Vector.tabulate(length array, fn i => sub (array, i))
+
     fun extract(array, i, j) =
       let
         val len = check_slice (array,i,j)
       in
         MLWorks.Internal.Vector.tabulate(len, fn n => sub (array, n+i))
       end
 
+
     fun copy {src, si, len, dst, di} =
       let
 	val len = check_slice (src,si,len)

src/basis/__vector_slice.sml

@@ -0,0 +1,178 @@
+(* __vector_slice.sml --- Standard ML Basis Library VectorSlice structure
+ *
+ * This code has been placed in the public domain.
+ *)
+
+require "vector_slice";
+require "__vector";
+require "__array";
+
+structure VectorSlice :> VECTOR_SLICE = struct
+
+    datatype 'a slice = Slice of {vector : 'a Vector.vector,
+				  start : int,
+				  stop : int}
+
+    fun length (Slice {start, stop, ...}) = stop - start
+
+    (* FIXME: maybe use some unsafe accessor instead of Vector.sub *)
+    fun sub (Slice {vector, start, stop}, i) =
+	let
+	    val j = start + i
+	in
+	    if start <= j andalso j < stop then Vector.sub (vector, j)
+	    else raise Subscript
+	end
+
+    fun full vec = Slice {vector = vec, start = 0, stop = Vector.length vec}
+
+    fun slice (vec, start, size) =
+	let
+	    val len = Vector.length vec
+	    val stop = case size of
+			   NONE => len
+			 | SOME l => start + l
+	in
+	    if 0 <= start andalso start <= stop andalso stop <= len
+	    then Slice {vector = vec, start = start, stop = stop}
+	    else raise Subscript
+	end
+
+    fun subslice (Slice {vector, start, stop}, i, size) =
+	let
+	    val start' = start + i
+	    val stop' = case size of
+			    NONE => stop
+			  | SOME l => start' + l
+	in
+	    if start <= start' andalso start' <= stop' andalso stop' <= stop
+	    then Slice {vector = vector, start = start', stop = stop'}
+	    else raise Subscript
+	end
+
+    fun base (Slice {vector, start, stop}) = (vector, start, stop - start)
+
+    (* FIXME: seems inefficient *)
+    fun vector (Slice {vector, start, stop}) =
+	Vector.tabulate (stop - start, fn i => Vector.sub (vector, start + i))
+
+    fun appi (f:(int * 'a) -> unit) (Slice {vector, start, stop}) =
+	let fun loop i =
+		if i = stop then ()
+		else (f (i - start, (Vector.sub (vector, i)));
+		      loop (i + 1))
+	in loop start end
+
+    fun app (f:'a -> unit) (Slice {vector, start, stop}) =
+	let fun loop i =
+		if i = stop then ()
+		else (f (Vector.sub (vector, i));
+		      loop (i + 1))
+	in loop start end
+
+    fun concat [] = Vector.concat []
+      | concat [s] = vector s
+      | concat l =
+	let
+	    fun len (slice, (len, elt)) =
+		let val l = length slice
+		in (len + l, case elt of
+				 NONE => if l = 0 then NONE
+					 else SOME (sub (slice, 0))
+			       | x => x)
+		end
+	    fun copy (slice, (array, start)) =
+		(appi (fn (i, x) => Array.update (array, start + i, x))
+		      slice;
+		 (array, start + length slice))
+	in
+	    case foldl len (0, NONE) l of
+	       (_, NONE) => Vector.concat []
+	     | (len, SOME elt) =>
+	       let val (array, _) = foldl copy (Array.array (len, elt), 0) l
+	       in Array.vector array end
+	end
+
+    fun isEmpty (Slice {start, stop, ...}) = start = stop
+
+    fun getItem (Slice {vector, start, stop}) =
+	if start = stop then NONE
+	else SOME (Vector.sub (vector, start),
+		   Slice {vector = vector, start = start + 1, stop = stop})
+
+    fun mapi f (Slice {vector, start, stop}) =
+	Vector.tabulate (stop - start,
+			 fn i => f (i, Vector.sub (vector, start + i)))
+
+    fun map f (Slice {vector, start, stop}) =
+	Vector.tabulate (stop - start,
+			 fn i => f (Vector.sub (vector, start + i)))
+
+    fun foldli f init (Slice {vector, start, stop}) =
+	let fun loop i state =
+		if i = stop then state
+		else loop (i + 1)
+			  (f (i - start, Vector.sub (vector, i), state))
+	in loop start init end
+
+    fun foldl f init (Slice {vector, start, stop}) =
+	let fun loop i state =
+		if i = stop then state
+		else loop (i + 1) (f (Vector.sub (vector, i), state))
+	in loop start init end
+
+    fun foldri f init (Slice {vector, start, stop}) =
+	let fun loop i state =
+		if i < start then state
+		else loop (i - 1)
+			  (f (i - start, Vector.sub (vector, i), state))
+	in loop (stop - 1) init end
+
+    fun foldr f init (Slice {vector, start, stop}) =
+	let fun loop i state =
+		if i < start then state
+		else loop (i - 1) (f (Vector.sub (vector, i), state))
+	in loop (stop - 1) init end
+
+    fun findi f (Slice {vector, start, stop}) =
+	let fun loop i =
+		if i = stop then NONE
+		else let val x = Vector.sub (vector, i)
+		     in
+			 if f (i, x) then SOME (i, x)
+			 else loop (i + 1)
+		     end
+	in loop 0 end
+
+    fun find f (Slice {vector, start, stop}) =
+	let fun loop i =
+		if i = stop then NONE
+		else let val x = Vector.sub (vector, i)
+		     in
+			 if f x then SOME x
+			 else loop (i + 1)
+		     end
+	in loop 0 end
+
+    fun exists f (Slice {vector, start, stop}) =
+	let fun loop i =
+		i < stop andalso f (Vector.sub (vector, i)) orelse loop (i + 1)
+	in loop 0 end
+
+    fun all f (Slice {vector, start, stop}) =
+	let fun loop i =
+		i = stop orelse f (Vector.sub (vector, i)) andalso loop (i + 1)
+	in loop 0 end
+
+    fun collate f (Slice {vector = v1, start = s1, stop = e1},
+		   Slice {vector = v2, start = s2, stop = e2}) =
+	let fun loop i1 i2 =
+		if i1 = e1 then (if i2 = e2 then EQUAL else LESS)
+		else if i2 = e2 then GREATER
+		else case f (Vector.sub (v1, i1),
+			     Vector.sub (v2, i2)) of
+			 EQUAL => loop (i1 + 1) (i2 + 1)
+		       | x => x
+	in loop s1 s2 end
+
+end

src/basis/array.sml

@@ -70,6 +70,7 @@ signature ARRAY =
 
     val update : ('a array * int * 'a) -> unit
 
+    val vector : 'a array -> 'a vector
     val extract : ('a array * int * int option) -> 'a vector
 
     val copy : {src : 'a array, si : int, len : int option, dst : 'a array, di : int} -> unit

src/basis/require_all.sml

@@ -263,6 +263,8 @@ require "__large_word";
 require "__array";
 require "__vector";
 require "__array2";
+require "vector_slice";
+require "__vector_slice";
 require "sml90";
 require "__sml90";
 require "command_line";
@@ -311,6 +313,7 @@ signature STRING=STRING
 signature SUBSTRING=SUBSTRING
 signature TIMER=TIMER
 signature VECTOR=VECTOR
+signature VECTOR_SLICE=VECTOR_SLICE
 signature BIN_IO=BIN_IO
 signature TEXT_IO=TEXT_IO
 signature TEXT_STREAM_IO=TEXT_STREAM_IO
@@ -361,6 +364,7 @@ structure TextPrimIO=TextPrimIO
 structure Time=Time
 structure Timer=Timer
 structure Vector=Vector
+structure VectorSlice=VectorSlice
 structure Word=Word
 structure Word8=Word8
 structure Word16=Word16

src/basis/vector_slice.sml

@@ -0,0 +1,33 @@
+(* vector_slice.sml --- Standard ML Basis Library VECTOR_SLICE signature
+ *
+ * This code has been placed in the public domain.
+ *)
+
+require "__vector";
+
+signature VECTOR_SLICE = sig
+      type 'a slice
+      val length : 'a slice -> int
+      val sub : 'a slice * int -> 'a
+      val full : 'a Vector.vector -> 'a slice
+      val slice : 'a Vector.vector * int * int option -> 'a slice
+      val subslice : 'a slice * int * int option -> 'a slice
+      val base : 'a slice -> 'a Vector.vector * int * int
+      val vector : 'a slice -> 'a Vector.vector
+      val concat : 'a slice list -> 'a Vector.vector
+      val isEmpty : 'a slice -> bool
+      val getItem : 'a slice -> ('a * 'a slice) option
+      val appi : (int * 'a -> unit) -> 'a slice -> unit
+      val app  : ('a -> unit) -> 'a slice -> unit
+      val mapi : (int * 'a -> 'b) -> 'a slice -> 'b Vector.vector
+      val map  : ('a -> 'b) -> 'a slice -> 'b Vector.vector
+      val foldli : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+      val foldri : (int * 'a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+      val foldl  : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+      val foldr  : ('a * 'b -> 'b) -> 'b -> 'a slice -> 'b
+      val findi : (int * 'a -> bool) -> 'a slice -> (int * 'a) option
+      val find  : ('a -> bool) -> 'a slice -> 'a option
+      val exists : ('a -> bool) -> 'a slice -> bool
+      val all : ('a -> bool) -> 'a slice -> bool
+      val collate : ('a * 'a -> order) -> 'a slice * 'a slice -> order
+  end

src/images/GNUmake

@@ -695,6 +695,8 @@ BASIS1 =	basis/__pre_basis \
 		basis/__vector \
 		basis/array2 \
 		basis/__array2 \
+		basis/vector_slice \
+		basis/__vector_slice \
 		basis/bool \
 		basis/__bool \
 		basis/math \