1(*
2    Title:      Standard Basis Library: Vector and Array functor for polymorphic vectors and arrays
3    Copyright   David C.J. Matthews 2005
4
5    This library is free software; you can redistribute it and/or
6    modify it under the terms of the GNU Lesser General Public
7    License as published by the Free Software Foundation; either
8    version 2.1 of the License, or (at your option) any later version.
9    
10    This library is distributed in the hope that it will be useful,
11    but WITHOUT ANY WARRANTY; without even the implied warranty of
12    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
13    Lesser General Public License for more details.
14    
15    You should have received a copy of the GNU Lesser General Public
16    License along with this library; if not, write to the Free Software
17    Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
18*)
19
20(* This is almost identical to the VectorOperations functor but works on polymorphic vectors and arrays.
21   There may be a way to combine the two. *)
22
23functor PolyVectorOperations(
24    type 'a vector
25    val length: 'a vector -> word
26    val unsafeSub: 'a vector * word -> 'a
27    val unsafeSet: 'a vector * word * 'a -> unit (* Array only *)
28):
29    sig
30    val appi : ((int * 'a) -> unit) -> 'a vector -> unit
31    val app : ('a -> unit) -> 'a vector -> unit
32    val foldli : ((int * 'a * 'b) -> 'b) -> 'b -> 'a vector -> 'b
33    val foldri : ((int * 'a * 'b) -> 'b) -> 'b -> 'a vector -> 'b
34    val foldl : (('a * 'b) -> 'b) -> 'b -> 'a vector -> 'b
35    val foldr : (('a * 'b) -> 'b) -> 'b -> 'a vector -> 'b
36    val modifyi : ((int * 'a) -> 'a) -> 'a vector -> unit (* Array only *)
37    val modify : ('a -> 'a) -> 'a vector -> unit (* Array only *)
38    val findi: (int * 'a -> bool) -> 'a vector -> (int * 'a) option
39    val find: ('a -> bool) -> 'a vector -> 'a option
40    val exists: ('a -> bool) -> 'a vector -> bool
41    val all: ('a -> bool) -> 'a vector -> bool
42    val collate: ('a * 'a -> order) -> 'a vector * 'a vector -> order
43    end =
44struct
45        val wordAsInt: word -> int = RunCall.unsafeCast
46        
47        (* Apply a function to each element in turn *)
48        fun appi f vec =
49        let
50            val len = length vec
51            fun doapp j =
52                if j >= len then ()
53                else (f(wordAsInt j, unsafeSub(vec, j)); doapp(j+0w1))
54        in
55            doapp 0w0
56        end
57    
58        fun app f vec =
59        let     
60            val len = length vec
61            fun doapp j = 
62                if j >= len then ()
63                else (f(unsafeSub(vec, j)); doapp(j+0w1))
64        in
65            doapp 0w0
66        end
67        
68        (* Fold a function over a array. *)
69        (* foldl - increasing index *)
70        fun foldl f init vec =
71        let
72            val len = length vec
73            fun dofold j acc = 
74                if j >= len then acc
75                else dofold (j+0w1) (f (unsafeSub(vec, j), acc))
76        in
77            dofold 0w0 init
78        end
79    
80        fun foldli f init vec =
81        let 
82            val len = length vec
83            fun dofold j acc = 
84                if j >= len then acc
85                else dofold (j+0w1) (f (wordAsInt j, unsafeSub(vec, j), acc))
86        in
87            dofold 0w0 init
88        end
89    
90        (* foldr - decreasing index *)
91        fun foldr f init vec =
92        let
93            val len = length vec
94            fun dofold j acc = 
95                if j = 0w0 then acc
96                else dofold (j-0w1) (f (unsafeSub(vec, j-0w1), acc))
97        in
98            dofold len init
99        end
100        
101        fun foldri f init vec =
102        let
103            val len = length vec
104            fun dofold j acc = 
105                if j = 0w0 then acc
106                else dofold (j-0w1) (f (wordAsInt(j-0w1), unsafeSub(vec, j-0w1), acc))
107        in
108            dofold len init
109        end
110        
111        (* Apply a function to each element in turn and update the array with the
112           new values. *)
113        fun modifyi f vec =
114        let                     
115            val len = length vec
116            fun doupdate j =
117                if j >= len then ()
118                else (unsafeSet(vec, j, f(wordAsInt j, unsafeSub(vec, j)));
119                      doupdate(j+0w1))
120        in
121            doupdate 0w0
122        end
123    
124        fun modify f vec =
125        let
126            val len = length vec
127            fun doupdate j = 
128                if j >= len then ()
129                else (unsafeSet(vec, j, f(unsafeSub(vec, j))); doupdate(j+0w1))
130        in
131            doupdate 0w0
132        end
133
134        (* Find a character that matches the predicate. *)
135        fun findi pred vec =
136        let 
137            val len = length vec
138            fun dofind j = 
139                if j >= len then NONE
140                else
141                let
142                    val v = unsafeSub(vec, j)
143                in
144                    if pred(wordAsInt j, v)
145                    then SOME (wordAsInt j, v)
146                    else dofind (j+0w1)
147                end
148        in
149            dofind 0w0
150        end
151        
152        fun find pred vec =
153        let
154            val len = length vec
155            fun dofind j = 
156                if j >= len then NONE
157                else
158                let
159                    val v = unsafeSub(vec, j)
160                in
161                    if pred v
162                    then SOME v
163                    else dofind (j+0w1)
164                end
165        in
166            dofind 0w0
167        end
168
169        fun exists f arr = Option.isSome(find f arr)
170        
171        fun all pred arr = not (exists (not o pred) arr)
172
173        fun collate cmp (vec1, vec2) =
174        let 
175            val len1 = length vec1 and len2 = length vec2
176            (* Keep comparing items until either we come to the end of one of the arrays or
177               we find a mismatch. *)
178            fun dotest j =
179                if j >= len1 then if len1 = len2 then EQUAL else (* j < len2 *) LESS
180                else if j >= len2 then (* But j < len1, so a1 is longer *) GREATER
181                else case cmp(unsafeSub(vec1, j), unsafeSub(vec2, j)) of
182                    LESS => LESS
183                |   GREATER => GREATER
184                |   EQUAL => dotest (j+0w1)
185        in
186            dotest 0w0
187        end
188end;
189