| 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. |
| 7 | * |
| 8 | * MLton is released under a BSD-style license. |
| 9 | * See the file MLton-LICENSE for details. |
| 10 | *) |
| 11 | |
| 12 | functor PrimSequence (S: sig |
| 13 | type 'a sequence |
| 14 | type 'a elt |
| 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 |
| 18 | val isMutable: bool |
| 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 = |
| 27 | struct |
| 28 | structure Array = Primitive.Array |
| 29 | |
| 30 | val op +? = SeqIndex.+? |
| 31 | val op + = SeqIndex.+ |
| 32 | val op -? = SeqIndex.-? |
| 33 | val op < = SeqIndex.< |
| 34 | val op <= = SeqIndex.<= |
| 35 | 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) |
| 42 | |
| 43 | type 'a sequence = 'a S.sequence |
| 44 | type 'a elt = 'a S.elt |
| 45 | |
| 46 | local |
| 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) |
| 50 | then fromInt maxInt' |
| 51 | else SeqIndex.maxInt' |
| 52 | structure S = |
| 53 | Int_ChooseInt |
| 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') |
| 68 | in |
| 69 | val maxLen = S.f |
| 70 | end |
| 71 | |
| 72 | fun length s = S.length s |
| 73 | |
| 74 | fun unsafeArrayAlloc n = Array.allocUnsafe n |
| 75 | fun arrayAlloc n = |
| 76 | if Primitive.Controls.safe |
| 77 | andalso gtu (n, maxLen) |
| 78 | then raise Size |
| 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 |
| 85 | fun create n = |
| 86 | let |
| 87 | val a = arrayAlloc n |
| 88 | val subLim : SeqIndex.t ref = ref 0 |
| 89 | fun sub i = |
| 90 | if Primitive.Controls.safe andalso geu (i, !subLim) then |
| 91 | raise Subscript |
| 92 | else |
| 93 | Array.subUnsafe (a, i) |
| 94 | val updateLim : SeqIndex.t ref = ref 0 |
| 95 | fun update (i, x) = |
| 96 | if Primitive.Controls.safe andalso geu (i, !updateLim) then |
| 97 | if i = !updateLim andalso i < n then |
| 98 | (Array.updateUnsafe (a, i, x); |
| 99 | subLim := i + 1; |
| 100 | updateLim := i + 1) |
| 101 | else |
| 102 | raise Subscript |
| 103 | else |
| 104 | Array.updateUnsafe (a, i, x) |
| 105 | val gotIt = ref false |
| 106 | fun done () = |
| 107 | if !gotIt then |
| 108 | raise CreateAlreadyGotVector |
| 109 | else |
| 110 | if n = !updateLim then |
| 111 | (gotIt := true; |
| 112 | updateLim := 0; |
| 113 | S.fromArray a) |
| 114 | else |
| 115 | raise CreateVectorNotFull |
| 116 | in |
| 117 | {done = done, |
| 118 | sub = sub, |
| 119 | update = update} |
| 120 | end |
| 121 | |
| 122 | fun unfoldi (n, b, f) = |
| 123 | let |
| 124 | val a = arrayAlloc n |
| 125 | fun loop (i, b) = |
| 126 | if i >= n |
| 127 | then b |
| 128 | else |
| 129 | let |
| 130 | val (x, b) = f (i, b) |
| 131 | val () = Array.updateUnsafe (a, i, x) |
| 132 | in |
| 133 | loop (i +? 1, b) |
| 134 | end |
| 135 | val b = loop (0, b) |
| 136 | in |
| 137 | (S.fromArray a, b) |
| 138 | end |
| 139 | |
| 140 | fun unfold (n, b, f) = unfoldi (n, b, f o #2) |
| 141 | |
| 142 | fun tabulate (n, f) = |
| 143 | #1 (unfoldi (n, (), fn (i, ()) => (f i, ()))) |
| 144 | |
| 145 | fun new (n, x) = tabulate (n, fn _ => x) |
| 146 | |
| 147 | structure Slice = |
| 148 | struct |
| 149 | type 'a sequence = 'a sequence |
| 150 | type 'a elt = 'a elt |
| 151 | datatype 'a t = T of {seq: 'a sequence, |
| 152 | start: SeqIndex.int, len: SeqIndex.int} |
| 153 | type 'a slice = 'a t |
| 154 | |
| 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) |
| 160 | then raise Subscript |
| 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) |
| 166 | then raise Subscript |
| 167 | else unsafeUpdate (sl, i, x) |
| 168 | fun uninitIsNop (T {seq, ...}) = |
| 169 | S.uninitIsNop 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) |
| 174 | then raise Subscript |
| 175 | else unsafeUninit (sl, i) |
| 176 | local |
| 177 | fun smallCopy {dst: 'a elt array, di: SeqIndex.int, |
| 178 | src: 'a sequence, si: SeqIndex.int, |
| 179 | len: SeqIndex.int, |
| 180 | overlap: unit -> bool} = |
| 181 | let |
| 182 | fun move i = Array.updateUnsafe (dst, di +? i, S.subUnsafe (src, si +? i)) |
| 183 | val len = len -? 1 |
| 184 | in |
| 185 | if overlap () |
| 186 | then let |
| 187 | fun loop i = |
| 188 | if i < 0 |
| 189 | then () |
| 190 | else (move i; loop (i -? 1)) |
| 191 | in |
| 192 | loop len |
| 193 | end |
| 194 | else let |
| 195 | fun loop i = |
| 196 | if i > len |
| 197 | then () |
| 198 | else (move i; loop (i +? 1)) |
| 199 | in |
| 200 | loop 0 |
| 201 | end |
| 202 | end |
| 203 | val smallCopyLimit = 5 |
| 204 | fun maybeSmallCopy {dst: 'a elt array, di: SeqIndex.int, |
| 205 | src: 'a sequence, si: SeqIndex.int, |
| 206 | len: SeqIndex.int, |
| 207 | overlap: unit -> bool} = |
| 208 | if len < smallCopyLimit |
| 209 | then smallCopy {dst = dst, di = di, |
| 210 | src = src, si = si, |
| 211 | len = len, |
| 212 | overlap = overlap} |
| 213 | else S.copyUnsafe (dst, di, src, si, len) |
| 214 | in |
| 215 | fun unsafeCopy {dst: 'a elt array, di: SeqIndex.int, |
| 216 | src = T {seq = src, start = si, len}} = |
| 217 | maybeSmallCopy {dst = dst, di = di, |
| 218 | src = src, si = si, |
| 219 | len = len, |
| 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)) |
| 226 | then raise Subscript |
| 227 | else let |
| 228 | fun overlap () = |
| 229 | S.sameArray (dst, src) |
| 230 | andalso si < di |
| 231 | andalso di <= si +? len |
| 232 | in |
| 233 | maybeSmallCopy {dst = dst, di = di, |
| 234 | src = src, si = si, |
| 235 | len = len, |
| 236 | overlap = overlap} |
| 237 | end |
| 238 | end |
| 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') = |
| 242 | T {seq = seq, |
| 243 | start = start +? start', |
| 244 | len = (case len' of |
| 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') = |
| 250 | case len' of |
| 251 | NONE => |
| 252 | if Primitive.Controls.safe |
| 253 | andalso gtu (start', len) |
| 254 | then raise Subscript |
| 255 | else T {seq = seq, |
| 256 | start = start +? start', |
| 257 | len = len -? start'} |
| 258 | | SOME len' => |
| 259 | if Primitive.Controls.safe |
| 260 | andalso (gtu (start', len) |
| 261 | orelse gtu (len', len -? start')) |
| 262 | then raise Subscript |
| 263 | else T {seq = seq, |
| 264 | start = start +? start', |
| 265 | len = len'} |
| 266 | fun slice (seq: 'a sequence, start, len) = |
| 267 | subslice (full seq, start, len) |
| 268 | fun base (T {seq, start, len}) = |
| 269 | (seq, start, len) |
| 270 | fun isEmpty sl = length sl = 0 |
| 271 | fun getItem (sl as T {seq, start, len}) = |
| 272 | if isEmpty sl |
| 273 | then NONE |
| 274 | else SOME (S.subUnsafe (seq, start), |
| 275 | T {seq = seq, |
| 276 | start = start +? 1, |
| 277 | len = len -? 1}) |
| 278 | fun foldli f b (T {seq, start, len}) = |
| 279 | let |
| 280 | val min = start |
| 281 | val len = len -? 1 |
| 282 | val max = start +? len |
| 283 | fun loop (i, b) = |
| 284 | if i > max then b |
| 285 | else loop (i +? 1, f (i -? min, S.subUnsafe (seq, i), b)) |
| 286 | in loop (min, b) |
| 287 | end |
| 288 | fun foldri f b (T {seq, start, len}) = |
| 289 | let |
| 290 | val min = start |
| 291 | val len = len -? 1 |
| 292 | val max = start +? len |
| 293 | fun loop (i, b) = |
| 294 | if i < min then b |
| 295 | else loop (i -? 1, f (i -? min, S.subUnsafe (seq, i), b)) |
| 296 | in loop (max, b) |
| 297 | end |
| 298 | local |
| 299 | fun make foldi f b sl = foldi (fn (_, x, b) => f (x, b)) b sl |
| 300 | in |
| 301 | fun foldl f = make foldli f |
| 302 | fun foldr f = make foldri f |
| 303 | end |
| 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}) = |
| 310 | let |
| 311 | val min = start |
| 312 | val len = len -? 1 |
| 313 | val max = start +? len |
| 314 | fun loop i = |
| 315 | if i > max |
| 316 | then NONE |
| 317 | else let val z = (i -? min, S.subUnsafe (seq, i)) |
| 318 | in if p z |
| 319 | then SOME z |
| 320 | else loop (i +? 1) |
| 321 | end |
| 322 | in loop min |
| 323 | end |
| 324 | fun find p sl = |
| 325 | case findi (p o #2) sl of |
| 326 | NONE => NONE |
| 327 | | SOME (_, x) => SOME x |
| 328 | fun existsi p sl = |
| 329 | case findi p sl of |
| 330 | NONE => false |
| 331 | | SOME _ => true |
| 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}) = |
| 337 | let |
| 338 | val min1 = start1 |
| 339 | val min2 = start2 |
| 340 | val max1 = start1 +? len1 |
| 341 | val max2 = start2 +? len2 |
| 342 | fun loop (i, j) = |
| 343 | case (i >= max1, j >= max2) of |
| 344 | (true, true) => EQUAL |
| 345 | | (true, false) => LESS |
| 346 | | (false, true) => GREATER |
| 347 | | (false, false) => |
| 348 | (case cmp (S.subUnsafe (seq1, i), |
| 349 | S.subUnsafe (seq2, j)) of |
| 350 | EQUAL => loop (i +? 1, j +? 1) |
| 351 | | ans => ans) |
| 352 | in loop (min1, min2) |
| 353 | end |
| 354 | fun sequence (sl as T {seq, start, len}): 'a sequence = |
| 355 | if S.isMutable orelse (start <> 0 orelse len <> S.length seq) |
| 356 | then let |
| 357 | val a = arrayAlloc len |
| 358 | in |
| 359 | S.copyUnsafe (a, 0, seq, start, len) |
| 360 | ; S.fromArray a |
| 361 | end |
| 362 | else seq |
| 363 | fun append (sl1: 'a slice, sl2: 'a slice): 'a sequence = |
| 364 | if length sl1 = 0 |
| 365 | then sequence sl2 |
| 366 | else if length sl2 = 0 |
| 367 | then sequence sl1 |
| 368 | else |
| 369 | let |
| 370 | val (seq1, start1, len1) = base sl1 |
| 371 | val (seq2, start2, len2) = base sl2 |
| 372 | val n = len1 +? len2 |
| 373 | val a = arrayAlloc n |
| 374 | in |
| 375 | S.copyUnsafe (a, 0, seq1, start1, len1) |
| 376 | ; S.copyUnsafe (a, len1, seq2, start2, len2) |
| 377 | ; S.fromArray a |
| 378 | end |
| 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}) = |
| 383 | let |
| 384 | val stop = start +? len |
| 385 | fun loop i = |
| 386 | if i >= stop |
| 387 | then i |
| 388 | else if f (S.subUnsafe (seq, i)) |
| 389 | then loop (i +? 1) |
| 390 | else i |
| 391 | in split (sl, loop start) |
| 392 | end |
| 393 | fun splitr f (sl as T {seq, start, len}) = |
| 394 | let |
| 395 | fun loop i = |
| 396 | if i < start |
| 397 | then start |
| 398 | else if f (S.subUnsafe (seq, i)) |
| 399 | then loop (i -? 1) |
| 400 | else i +? 1 |
| 401 | in split (sl, loop (start +? len -? 1)) |
| 402 | end |
| 403 | fun splitAt (T {seq, start, len}, i) = |
| 404 | if Primitive.Controls.safe andalso gtu (i, len) |
| 405 | then raise Subscript |
| 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) |
| 413 | (seq': 'a sequence) |
| 414 | (sl as T {seq, start, len}) = |
| 415 | let |
| 416 | val len' = S.length seq' |
| 417 | val max = start +? len -? len' +? 1 |
| 418 | (* loop returns the index of the front of the suffix. *) |
| 419 | fun loop i = |
| 420 | if i >= max |
| 421 | then start +? len |
| 422 | else let |
| 423 | fun loop' j = |
| 424 | if j >= len' |
| 425 | then i |
| 426 | else if eq (S.subUnsafe (seq, i +? j), |
| 427 | S.subUnsafe (seq', j)) |
| 428 | then loop' (j +? 1) |
| 429 | else loop (i +? 1) |
| 430 | in loop' 0 |
| 431 | end |
| 432 | in split (sl, loop start) |
| 433 | end |
| 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) |
| 439 | then raise Span |
| 440 | else unsafeSlice (seq, start, SOME ((start' +? len') -? start)) |
| 441 | end |
| 442 | |
| 443 | local |
| 444 | fun make f seq = f (Slice.full seq) |
| 445 | fun make2 f (seq1, seq2) = f (Slice.full seq1, Slice.full seq2) |
| 446 | in |
| 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 |
| 473 | end |
| 474 | |
| 475 | end |
| 476 | |
| 477 | structure Primitive = struct |
| 478 | open Primitive |
| 479 | |
| 480 | structure Array = |
| 481 | struct |
| 482 | local |
| 483 | structure P = PrimSequence (type 'a sequence = 'a array |
| 484 | type 'a elt = 'a |
| 485 | val sameArray = op = |
| 486 | val copyUnsafe = Primitive.Array.copyArrayUnsafe |
| 487 | val fromArray = fn a => a |
| 488 | val isMutable = true |
| 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) |
| 494 | in |
| 495 | open P |
| 496 | type 'a array = 'a array |
| 497 | structure Slice = |
| 498 | struct |
| 499 | open Slice |
| 500 | fun vector sl = |
| 501 | let |
| 502 | val a = unsafeAlloc (length sl) |
| 503 | val () = unsafeCopy {dst = a, di = 0, src = sl} |
| 504 | in |
| 505 | Vector.fromArrayUnsafe a |
| 506 | end |
| 507 | fun modifyi f sl = |
| 508 | appi (fn (i, x) => unsafeUpdate (sl, i, f (i, x))) sl |
| 509 | fun modify f sl = modifyi (fn (_, x) => f x) sl |
| 510 | end |
| 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) |
| 514 | end |
| 515 | structure Raw = |
| 516 | struct |
| 517 | type 'a rawarr = 'a Primitive.Array.Raw.rawarr |
| 518 | |
| 519 | val length = Primitive.Array.Raw.length |
| 520 | |
| 521 | val unsafeAlloc = Primitive.Array.Raw.allocUnsafe |
| 522 | fun alloc n = |
| 523 | if Primitive.Controls.safe |
| 524 | andalso SeqIndex.gtu (n, maxLen) |
| 525 | then raise Size |
| 526 | else unsafeAlloc n |
| 527 | |
| 528 | val unsafeToArray = Primitive.Array.Raw.toArrayUnsafe |
| 529 | |
| 530 | val uninitIsNop = Primitive.Array.Raw.uninitIsNop |
| 531 | val unsafeUninit = Primitive.Array.Raw.uninitUnsafe |
| 532 | fun uninit (a, i) = |
| 533 | if Primitive.Controls.safe andalso SeqIndex.geu (i, length a) |
| 534 | then raise Subscript |
| 535 | else unsafeUninit (a, i) |
| 536 | |
| 537 | end |
| 538 | end |
| 539 | |
| 540 | structure Vector = |
| 541 | struct |
| 542 | local |
| 543 | exception Vector_uninitIsNop |
| 544 | exception Vector_uninitUnsafe |
| 545 | exception Vector_updateUnsafe |
| 546 | structure P = PrimSequence (type 'a sequence = 'a vector |
| 547 | type 'a elt = 'a |
| 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) |
| 560 | in |
| 561 | open P |
| 562 | type 'a vector = 'a vector |
| 563 | fun updateVector (v, i, x) = |
| 564 | if Primitive.Controls.safe andalso SeqIndex.geu (i, length v) |
| 565 | then raise Subscript |
| 566 | else let |
| 567 | val a = Array.unsafeAlloc (length v) |
| 568 | val () = copy {dst = a, di = 0, src = v} |
| 569 | val () = Array.unsafeUpdate (a, i, x) |
| 570 | in |
| 571 | unsafeFromArray a |
| 572 | end |
| 573 | end |
| 574 | end |
| 575 | |
| 576 | end |
| 577 | |
| 578 | structure Array = |
| 579 | struct |
| 580 | type 'a array = 'a array |
| 581 | end |
| 582 | structure Vector = |
| 583 | struct |
| 584 | type 'a vector = 'a vector |
| 585 | end |