1 (* Copyright (C
) 2015,2017 Matthew Fluet
.
2 * Copyright (C
) 2014 Rob Simmons
.
3 * Copyright (C
) 2013 Matthew Fluet
.
4 * Copyright (C
) 1999-2008 Henry Cejtin
, Matthew Fluet
, Suresh
5 * Jagannathan
, and Stephen Weeks
.
6 * Copyright (C
) 1997-2000 NEC Research Institute
.
8 * MLton is released under a BSD
-style license
.
9 * See the file MLton
-LICENSE for details
.
12 functor PrimSequence (S
: sig
15 val copyUnsafe
: 'a elt array
* SeqIndex
.int * 'a sequence
* SeqIndex
.int * SeqIndex
.int -> unit
16 (* fromArray should be constant time
. *)
17 val fromArray
: 'a elt array
-> 'a sequence
19 val length
: 'a sequence
-> SeqIndex
.int
20 val sameArray
: 'a elt array
* 'a sequence
-> bool
21 val subUnsafe
: 'a sequence
* SeqIndex
.int -> 'a elt
22 val uninitIsNop
: 'a sequence
-> bool
23 val uninitUnsafe
: 'a sequence
* SeqIndex
.int -> unit
24 val updateUnsafe
: 'a sequence
* SeqIndex
.int * 'a elt
-> unit
25 end) :> PRIM_SEQUENCE
where type 'a sequence
= 'a S
.sequence
26 where type 'a elt
= 'a S
.elt
=
28 structure Array
= Primitive
.Array
30 val op +?
= SeqIndex
.+?
32 val op -?
= SeqIndex
.-?
34 val op <= = SeqIndex
.<=
36 val op >= = SeqIndex
.>=
37 val gtu
= SeqIndex
.gtu
38 val geu
= SeqIndex
.geu
39 val ! = Primitive
.Ref
.deref
40 val op := = Primitive
.Ref
.assign
41 fun (f
o g
) x
= f (g x
)
43 type 'a sequence
= 'a S
.sequence
44 type 'a elt
= 'a S
.elt
47 fun valOf x
: Primitive
.Int32
.int = case x
of SOME y
=> y | NONE
=> 0
48 fun doit (precision
, fromInt
, maxInt
') =
49 if Primitive
.Int32
.>= (valOf SeqIndex
.precision
, precision
)
54 (type 'a t
= SeqIndex
.int
55 val fInt8
= doit (valOf Primitive
.Int8
.precision
,
56 SeqIndex
.schckFromInt8
,
57 Primitive
.Int8
.maxInt
')
58 val fInt16
= doit (valOf Primitive
.Int16
.precision
,
59 SeqIndex
.schckFromInt16
,
60 Primitive
.Int16
.maxInt
')
61 val fInt32
= doit (valOf Primitive
.Int32
.precision
,
62 SeqIndex
.schckFromInt32
,
63 Primitive
.Int32
.maxInt
')
64 val fInt64
= doit (valOf Primitive
.Int64
.precision
,
65 SeqIndex
.schckFromInt64
,
66 Primitive
.Int64
.maxInt
')
67 val fIntInf
= SeqIndex
.maxInt
')
72 fun length s
= S
.length s
74 fun unsafeArrayAlloc n
= Array
.allocUnsafe n
76 if Primitive
.Controls
.safe
77 andalso gtu (n
, maxLen
)
79 else unsafeArrayAlloc n
80 fun unsafeAlloc n
= S
.fromArray (unsafeArrayAlloc n
)
81 fun alloc n
= S
.fromArray (arrayAlloc n
)
82 val unsafeFromArray
= S
.fromArray
83 exception CreateAlreadyGotVector
84 exception CreateVectorNotFull
88 val subLim
: SeqIndex
.t ref
= ref
0
90 if Primitive
.Controls
.safe
andalso geu (i
, !subLim
) then
93 Array
.subUnsafe (a
, i
)
94 val updateLim
: SeqIndex
.t ref
= ref
0
96 if Primitive
.Controls
.safe
andalso geu (i
, !updateLim
) then
97 if i
= !updateLim
andalso i
< n
then
98 (Array
.updateUnsafe (a
, i
, x
);
104 Array
.updateUnsafe (a
, i
, x
)
105 val gotIt
= ref
false
108 raise CreateAlreadyGotVector
110 if n
= !updateLim
then
115 raise CreateVectorNotFull
122 fun unfoldi (n
, b
, f
) =
130 val (x
, b
) = f (i
, b
)
131 val () = Array
.updateUnsafe (a
, i
, x
)
140 fun unfold (n
, b
, f
) = unfoldi (n
, b
, f
o #
2)
142 fun tabulate (n
, f
) =
143 #
1 (unfoldi (n
, (), fn (i
, ()) => (f i
, ())))
145 fun new (n
, x
) = tabulate (n
, fn _
=> x
)
149 type 'a sequence
= 'a sequence
151 datatype 'a t
= T
of {seq
: 'a sequence
,
152 start
: SeqIndex
.int, len
: SeqIndex
.int}
155 fun length (T
{len
, ...}) = len
156 fun unsafeSub (T
{seq
, start
, ...}, i
) =
157 S
.subUnsafe (seq
, start
+? i
)
158 fun sub (sl
as T
{len
, ...}, i
) =
159 if Primitive
.Controls
.safe
andalso geu (i
, len
)
161 else unsafeSub (sl
, i
)
162 fun unsafeUpdate (T
{seq
, start
, ...}, i
, x
) =
163 S
.updateUnsafe (seq
, start
+? i
, x
)
164 fun update (sl
as T
{len
, ...}, i
, x
) =
165 if Primitive
.Controls
.safe
andalso geu (i
, len
)
167 else unsafeUpdate (sl
, i
, x
)
168 fun uninitIsNop (T
{seq
, ...}) =
170 fun unsafeUninit (T
{seq
, start
, ...}, i
) =
171 S
.uninitUnsafe (seq
, start
+? i
)
172 fun uninit (sl
as T
{len
, ...}, i
) =
173 if Primitive
.Controls
.safe
andalso geu (i
, len
)
175 else unsafeUninit (sl
, i
)
177 fun smallCopy
{dst
: 'a elt array
, di
: SeqIndex
.int,
178 src
: 'a sequence
, si
: SeqIndex
.int,
180 overlap
: unit
-> bool} =
182 fun move i
= Array
.updateUnsafe (dst
, di
+? i
, S
.subUnsafe (src
, si
+? i
))
190 else (move i
; loop (i
-?
1))
198 else (move i
; loop (i
+?
1))
203 val smallCopyLimit
= 5
204 fun maybeSmallCopy
{dst
: 'a elt array
, di
: SeqIndex
.int,
205 src
: 'a sequence
, si
: SeqIndex
.int,
207 overlap
: unit
-> bool} =
208 if len
< smallCopyLimit
209 then smallCopy
{dst
= dst
, di
= di
,
213 else S
.copyUnsafe (dst
, di
, src
, si
, len
)
215 fun unsafeCopy
{dst
: 'a elt array
, di
: SeqIndex
.int,
216 src
= T
{seq
= src
, start
= si
, len
}} =
217 maybeSmallCopy
{dst
= dst
, di
= di
,
220 overlap
= fn () => false}
221 fun copy
{dst
: 'a elt array
, di
: SeqIndex
.int,
222 src
= T
{seq
= src
, start
= si
, len
}} =
223 if Primitive
.Controls
.safe
224 andalso (gtu (di
, Array
.length dst
)
225 orelse gtu (di
+? len
, Array
.length dst
))
229 S
.sameArray (dst
, src
)
231 andalso di
<= si
+? len
233 maybeSmallCopy
{dst
= dst
, di
= di
,
239 fun full (seq
: 'a sequence
) : 'a slice
=
240 T
{seq
= seq
, start
= 0, len
= S
.length seq
}
241 fun unsafeSubslice (T
{seq
, start
, len
}, start
', len
') =
243 start
= start
+? start
',
245 NONE
=> len
-? start
'
246 | SOME len
' => len
')}
247 fun unsafeSlice (seq
, start
, len
) =
248 unsafeSubslice (full seq
, start
, len
)
249 fun subslice (T
{seq
, start
, len
}, start
', len
') =
252 if Primitive
.Controls
.safe
253 andalso gtu (start
', len
)
256 start
= start
+? start
',
259 if Primitive
.Controls
.safe
260 andalso (gtu (start
', len
)
261 orelse gtu (len
', len
-? start
'))
264 start
= start
+? start
',
266 fun slice (seq
: 'a sequence
, start
, len
) =
267 subslice (full seq
, start
, len
)
268 fun base (T
{seq
, start
, len
}) =
270 fun isEmpty sl
= length sl
= 0
271 fun getItem (sl
as T
{seq
, start
, len
}) =
274 else SOME (S
.subUnsafe (seq
, start
),
278 fun foldli f
b (T
{seq
, start
, len
}) =
282 val max
= start
+? len
285 else loop (i
+?
1, f (i
-? min
, S
.subUnsafe (seq
, i
), b
))
288 fun foldri f
b (T
{seq
, start
, len
}) =
292 val max
= start
+? len
295 else loop (i
-?
1, f (i
-? min
, S
.subUnsafe (seq
, i
), b
))
299 fun make foldi f b sl
= foldi (fn (_
, x
, b
) => f (x
, b
)) b sl
301 fun foldl f
= make foldli f
302 fun foldr f
= make foldri f
304 fun appi f sl
= foldli (fn (i
, x
, ()) => f (i
, x
)) () sl
305 fun app f sl
= appi (f
o #
2) sl
306 fun mapi
f (T
{seq
, start
, len
}) =
307 tabulate (len
, fn i
=> f (i
, S
.subUnsafe (seq
, start
+? i
)))
308 fun map f sl
= mapi (f
o #
2) sl
309 fun findi
p (T
{seq
, start
, len
}) =
313 val max
= start
+? len
317 else let val z
= (i
-? min
, S
.subUnsafe (seq
, i
))
325 case findi (p
o #
2) sl
of
327 |
SOME (_
, x
) => SOME x
332 fun exists p sl
= existsi (p
o #
2) sl
333 fun alli p sl
= not (existsi (not
o p
) sl
)
334 fun all p sl
= alli (p
o #
2) sl
335 fun collate
cmp (T
{seq
= seq1
, start
= start1
, len
= len1
},
336 T
{seq
= seq2
, start
= start2
, len
= len2
}) =
340 val max1
= start1
+? len1
341 val max2
= start2
+? len2
343 case (i
>= max1
, j
>= max2
) of
344 (true, true) => EQUAL
345 |
(true, false) => LESS
346 |
(false, true) => GREATER
348 (case cmp (S
.subUnsafe (seq1
, i
),
349 S
.subUnsafe (seq2
, j
)) of
350 EQUAL
=> loop (i
+?
1, j
+?
1)
354 fun sequence (sl
as T
{seq
, start
, len
}): 'a sequence
=
355 if S
.isMutable
orelse (start
<> 0 orelse len
<> S
.length seq
)
357 val a
= arrayAlloc len
359 S
.copyUnsafe (a
, 0, seq
, start
, len
)
363 fun append (sl1
: 'a slice
, sl2
: 'a slice
): 'a sequence
=
366 else if length sl2
= 0
370 val (seq1
, start1
, len1
) = base sl1
371 val (seq2
, start2
, len2
) = base sl2
375 S
.copyUnsafe (a
, 0, seq1
, start1
, len1
)
376 ; S
.copyUnsafe (a
, len1
, seq2
, start2
, len2
)
379 fun split (T
{seq
, start
, len
}, i
) =
380 (unsafeSlice (seq
, start
, SOME (i
-? start
)),
381 unsafeSlice (seq
, i
, SOME (len
-?
(i
-? start
))))
382 fun splitl
f (sl
as T
{seq
, start
, len
}) =
384 val stop
= start
+? len
388 else if f (S
.subUnsafe (seq
, i
))
391 in split (sl
, loop start
)
393 fun splitr
f (sl
as T
{seq
, start
, len
}) =
398 else if f (S
.subUnsafe (seq
, i
))
401 in split (sl
, loop (start
+? len
-?
1))
403 fun splitAt (T
{seq
, start
, len
}, i
) =
404 if Primitive
.Controls
.safe
andalso gtu (i
, len
)
406 else (unsafeSlice (seq
, start
, SOME i
),
407 unsafeSlice (seq
, start
+? i
, SOME (len
-? i
)))
408 fun dropl p s
= #
2 (splitl p s
)
409 fun dropr p s
= #
1 (splitr p s
)
410 fun takel p s
= #
1 (splitl p s
)
411 fun taker p s
= #
2 (splitr p s
)
412 fun position (eq
: 'a elt
* 'a elt
-> bool)
414 (sl
as T
{seq
, start
, len
}) =
416 val len
' = S
.length seq
'
417 val max
= start
+? len
-? len
' +?
1
418 (* loop returns the index
of the front
of the suffix
. *)
426 else if eq (S
.subUnsafe (seq
, i
+? j
),
427 S
.subUnsafe (seq
', j
))
432 in split (sl
, loop start
)
434 fun span (eq
: 'a sequence
* 'a sequence
-> bool)
435 (T
{seq
, start
, ...},
436 T
{seq
= seq
', start
= start
', len
= len
'}) =
437 if Primitive
.Controls
.safe
andalso
438 (not (eq (seq
, seq
')) orelse start
' +? len
' < start
)
440 else unsafeSlice (seq
, start
, SOME ((start
' +? len
') -? start
))
444 fun make f seq
= f (Slice
.full seq
)
445 fun make2
f (seq1
, seq2
) = f (Slice
.full seq1
, Slice
.full seq2
)
447 fun sub (seq
, i
) = Slice
.sub (Slice
.full seq
, i
)
448 fun unsafeSub (seq
, i
) = Slice
.unsafeSub (Slice
.full seq
, i
)
449 fun update (seq
, i
, x
) = Slice
.update (Slice
.full seq
, i
, x
)
450 fun unsafeUpdate (seq
, i
, x
) = Slice
.unsafeUpdate (Slice
.full seq
, i
, x
)
451 fun uninitIsNop seq
= Slice
.uninitIsNop (Slice
.full seq
)
452 fun uninit (seq
, i
) = Slice
.uninit (Slice
.full seq
, i
)
453 fun unsafeUninit (seq
, i
) = Slice
.unsafeUninit (Slice
.full seq
, i
)
454 fun copy
{dst
, di
, src
} = Slice
.copy
{dst
= dst
, di
= di
, src
= Slice
.full src
}
455 fun unsafeCopy
{dst
, di
, src
} = Slice
.unsafeCopy
{dst
= dst
, di
= di
, src
= Slice
.full src
}
456 fun appi f
= make (Slice
.appi f
)
457 fun app f
= make (Slice
.app f
)
458 fun mapi f
= make (Slice
.mapi f
)
459 fun map f
= make (Slice
.map f
)
460 fun foldli f b
= make (Slice
.foldli f b
)
461 fun foldl f b
= make (Slice
.foldl f b
)
462 fun foldri f b
= make (Slice
.foldri f b
)
463 fun foldr f b
= make (Slice
.foldr f b
)
464 fun findi p
= make (Slice
.findi p
)
465 fun find p
= make (Slice
.find p
)
466 fun existsi p
= make (Slice
.existsi p
)
467 fun exists p
= make (Slice
.exists p
)
468 fun alli p
= make (Slice
.alli p
)
469 fun all p
= make (Slice
.all p
)
470 fun collate cmp
= make2 (Slice
.collate cmp
)
471 fun append seqs
= make2 Slice
.append seqs
472 fun duplicate seq
= make Slice
.sequence seq
477 structure Primitive
= struct
483 structure P
= PrimSequence (type 'a sequence
= 'a array
486 val copyUnsafe
= Primitive
.Array
.copyArrayUnsafe
487 val fromArray
= fn a
=> a
489 val length
= Primitive
.Array
.length
490 val subUnsafe
= Primitive
.Array
.subUnsafe
491 val uninitIsNop
= Primitive
.Array
.uninitIsNop
492 val uninitUnsafe
= Primitive
.Array
.uninitUnsafe
493 val updateUnsafe
= Primitive
.Array
.updateUnsafe
)
496 type 'a array
= 'a array
502 val a
= unsafeAlloc (length sl
)
503 val () = unsafeCopy
{dst
= a
, di
= 0, src
= sl
}
505 Vector.fromArrayUnsafe a
508 appi (fn (i
, x
) => unsafeUpdate (sl
, i
, f (i
, x
))) sl
509 fun modify f sl
= modifyi (fn (_
, x
) => f x
) sl
511 fun vector s
= Slice
.vector (Slice
.full s
)
512 fun modifyi f s
= Slice
.modifyi
f (Slice
.full s
)
513 fun modify f s
= Slice
.modify
f (Slice
.full s
)
517 type 'a rawarr
= 'a Primitive
.Array
.Raw
.rawarr
519 val length
= Primitive
.Array
.Raw
.length
521 val unsafeAlloc
= Primitive
.Array
.Raw
.allocUnsafe
523 if Primitive
.Controls
.safe
524 andalso SeqIndex
.gtu (n
, maxLen
)
528 val unsafeToArray
= Primitive
.Array
.Raw
.toArrayUnsafe
530 val uninitIsNop
= Primitive
.Array
.Raw
.uninitIsNop
531 val unsafeUninit
= Primitive
.Array
.Raw
.uninitUnsafe
533 if Primitive
.Controls
.safe
andalso SeqIndex
.geu (i
, length a
)
535 else unsafeUninit (a
, i
)
543 exception Vector_uninitIsNop
544 exception Vector_uninitUnsafe
545 exception Vector_updateUnsafe
546 structure P
= PrimSequence (type 'a sequence
= 'a vector
548 val copyUnsafe
= Primitive
.Array
.copyVectorUnsafe
549 val fromArray
= Primitive
.Vector.fromArrayUnsafe
550 val isMutable
= false
551 val length
= Vector.length
552 val sameArray
= fn _
=> false
553 val subUnsafe
= Primitive
.Vector.subUnsafe
554 val uninitIsNop
= fn _
=>
555 raise Vector_uninitIsNop
556 val uninitUnsafe
= fn _
=>
557 raise Vector_uninitUnsafe
558 val updateUnsafe
= fn _
=>
559 raise Vector_updateUnsafe
)
562 type 'a vector
= 'a vector
563 fun updateVector (v
, i
, x
) =
564 if Primitive
.Controls
.safe
andalso SeqIndex
.geu (i
, length v
)
567 val a
= Array
.unsafeAlloc (length v
)
568 val () = copy
{dst
= a
, di
= 0, src
= v
}
569 val () = Array
.unsafeUpdate (a
, i
, x
)
580 type 'a array
= 'a array
584 type 'a vector
= 'a vector