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