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
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
|
(* real64-array.sml
*
* COPYRIGHT (c) 2015 The Fellowship of SML/NJ (http://www.smlnj.org)
* All rights reserved.
*)
structure Real64Array : MONO_ARRAY =
struct
(* fast add/subtract avoiding the overflow test *)
infix -- ++
fun x -- y = InlineT.Word31.copyt_int31 (InlineT.Word31.copyf_int31 x -
InlineT.Word31.copyf_int31 y)
fun x ++ y = InlineT.Word31.copyt_int31 (InlineT.Word31.copyf_int31 x +
InlineT.Word31.copyf_int31 y)
(* unchecked access operations *)
val uupd = InlineT.Real64Array.update
val usub = InlineT.Real64Array.sub
(* val vecUpdate = InlineT.Real64Vector.update*) (** not yet **)
val vusub = InlineT.Real64Vector.sub
val vlength = InlineT.Real64Vector.length
type array = Assembly.A.real64array
type elem = Real64.real
type vector = Real64Vector.vector
val maxLen = Core.max_length
fun array (0, _) = InlineT.Real64Array.newArray0()
| array (len, v) = if (InlineT.DfltInt.ltu(maxLen, len))
then raise General.Size
else let
val arr = Assembly.A.create_r len
fun init i = if (i < len)
then (uupd(arr, i, v); init(i+1))
else ()
in
init 0; arr
end
fun tabulate (0, _) = InlineT.Real64Array.newArray0()
| tabulate (len, f) = if (InlineT.DfltInt.ltu(maxLen, len))
then raise General.Size
else let
val arr = Assembly.A.create_r len
fun init i = if (i < len)
then (uupd(arr, i, f i); init(i+1))
else ()
in
init 0; arr
end
fun fromList [] = InlineT.Real64Array.newArray0()
| fromList l = let
fun length ([], n) = n
| length (_::r, n) = length (r, n+1)
val len = length (l, 0)
val _ = if (maxLen < len) then raise General.Size else ()
val arr = Assembly.A.create_r len
fun init ([], _) = ()
| init (c::r, i) = (uupd(arr, i, c); init(r, i+1))
in
init (l, 0); arr
end
val length = InlineT.Real64Array.length
val sub = InlineT.Real64Array.chkSub
val update = InlineT.Real64Array.chkUpdate
fun vector a = Real64Vector.tabulate (length a, fn i => usub (a, i))
fun copy { src, dst, di } = let
val sl = length src
val de = sl + di
fun copyDn (s, d) =
if s < 0 then () else (uupd (dst, d, usub (src, s));
copyDn (s -- 1, d -- 1))
in
if di < 0 orelse de > length dst then raise Subscript
else copyDn (sl -- 1, de -- 1)
end
fun copyVec { src, dst, di } = let
val sl = vlength src
val de = sl + di
fun copyDn (s, d) =
if s < 0 then () else (uupd (dst, d, vusub (src, s));
copyDn (s -- 1, d -- 1))
in
if di < 0 orelse de > length dst then raise Subscript
else copyDn (sl -- 1, de -- 1)
end
fun appi f arr = let
val len = length arr
fun app i =
if i >= len then () else (f (i, usub (arr, i)); app (i ++ 1))
in
app 0
end
fun app f arr = let
val len = length arr
fun app i =
if i >= len then () else (f (usub (arr, i)); app (i ++ 1))
in
app 0
end
fun modifyi f arr = let
val len = length arr
fun mdf i =
if i >= len then ()
else (uupd (arr, i, f (i, usub (arr, i))); mdf (i ++ 1))
in
mdf 0
end
fun modify f arr = let
val len = length arr
fun mdf i =
if i >= len then ()
else (uupd (arr, i, f (usub (arr, i))); mdf (i ++ 1))
in
mdf 0
end
fun foldli f init arr = let
val len = length arr
fun fold (i, a) =
if i >= len then a else fold (i ++ 1, f (i, usub (arr, i), a))
in
fold (0, init)
end
fun foldl f init arr = let
val len = length arr
fun fold (i, a) =
if i >= len then a else fold (i ++ 1, f (usub (arr, i), a))
in
fold (0, init)
end
fun foldri f init arr = let
fun fold (i, a) =
if i < 0 then a else fold (i -- 1, f (i, usub (arr, i), a))
in
fold (length arr -- 1, init)
end
fun foldr f init arr = let
fun fold (i, a) =
if i < 0 then a else fold (i -- 1, f (usub (arr, i), a))
in
fold (length arr -- 1, init)
end
fun findi p arr = let
val len = length arr
fun fnd i =
if i >= len then NONE
else let val x = usub (arr, i)
in
if p (i, x) then SOME (i, x) else fnd (i ++ 1)
end
in
fnd 0
end
fun find p arr = let
val len = length arr
fun fnd i =
if i >= len then NONE
else let val x = usub (arr, i)
in
if p x then SOME x else fnd (i ++ 1)
end
in
fnd 0
end
fun exists p arr = let
val len = length arr
fun ex i = i < len andalso (p (usub (arr, i)) orelse ex (i ++ 1))
in
ex 0
end
fun all p arr = let
val len = length arr
fun al i = i >= len orelse (p (usub (arr, i)) andalso al (i ++ 1))
in
al 0
end
fun collate c (a1, a2) = let
val l1 = length a1
val l2 = length a2
val l12 = InlineT.Int31.min (l1, l2)
fun col i =
if i >= l12 then IntImp.compare (l1, l2)
else case c (usub (a1, i), usub (a2, i)) of
EQUAL => col (i ++ 1)
| unequal => unequal
in
col 0
end
(* added for Basis Library proposal 2015-003 *)
fun toList arr = foldr op :: [] arr
fun fromVector v = let
val n = vlength v
in
if (n = 0)
then InlineT.Real64Array.newArray0()
else let
val arr = Assembly.A.create_r n
fun fill i = if (i < n)
then (uupd(arr, i, vusub(v, i)); fill(i ++ 1))
else arr
in
fill 0
end
end
val toVector = vector
end (* structure Real64Array *)
|
