| 1 | (* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh |
| 2 | * Jagannathan, and Stephen Weeks. |
| 3 | * |
| 4 | * MLton is released under a BSD-style license. |
| 5 | * See the file MLton-LICENSE for details. |
| 6 | *) |
| 7 | |
| 8 | functor ResizableArray (): RESIZABLE_ARRAY = |
| 9 | struct |
| 10 | |
| 11 | structure Array = Array |
| 12 | |
| 13 | structure A' = |
| 14 | struct |
| 15 | datatype 'a t = T of {array: 'a option Array.t ref, |
| 16 | length: int ref} |
| 17 | |
| 18 | fun getArray (T {array, ...}) = !array |
| 19 | fun lengthRef (T {length, ...}) = length |
| 20 | fun length a = ! (lengthRef a) |
| 21 | val shape = length |
| 22 | |
| 23 | fun maxLength a = Array.length (getArray a) |
| 24 | fun minLength a = Int.quot (maxLength a, 4) |
| 25 | |
| 26 | fun invariant a = |
| 27 | maxLength a >= 1 |
| 28 | andalso minLength a <= length a |
| 29 | andalso length a <= maxLength a |
| 30 | |
| 31 | fun incLength a = Int.inc (lengthRef a) |
| 32 | fun decLength a = Int.dec (lengthRef a) |
| 33 | fun maxIndex a = length a - 1 |
| 34 | |
| 35 | exception New = Array.New |
| 36 | |
| 37 | fun empty () = |
| 38 | T {array = ref (Array.new (1, NONE)), |
| 39 | length = ref 0} |
| 40 | |
| 41 | fun new (s, x) = |
| 42 | if s = 0 then empty () |
| 43 | else T {array = ref (Array.new (1, SOME x)), |
| 44 | length = ref s} |
| 45 | val array = new |
| 46 | |
| 47 | fun tabulate (s, f) = |
| 48 | if s = 0 then empty () |
| 49 | else T {array = ref (Array.tabulate (s, fn i => SOME (f i))), |
| 50 | length = ref s} |
| 51 | |
| 52 | fun subSafe (a, i) = |
| 53 | case Array.sub (getArray a, i) of |
| 54 | SOME x => x |
| 55 | | NONE => Error.bug "ResizableArray.subSafe" |
| 56 | |
| 57 | fun sub (a, i) = |
| 58 | if i < length a then subSafe (a, i) |
| 59 | else Error.bug "ResizableArray.sub" |
| 60 | |
| 61 | fun updateSafe (a, i, x) = |
| 62 | Array.update (getArray a, i, SOME x) |
| 63 | |
| 64 | fun update (a, i, x) = |
| 65 | if i < length a then updateSafe (a, i, x) |
| 66 | else Error.bug "ResizableArray.update" |
| 67 | |
| 68 | fun fromList l = |
| 69 | let val a = Array.fromList (List.map (l, SOME)) |
| 70 | in T {array = ref a, |
| 71 | length = ref (Array.length a)} |
| 72 | end |
| 73 | end |
| 74 | |
| 75 | structure A'' = |
| 76 | Array (open A' |
| 77 | val unsafeSub = sub |
| 78 | val unsafeUpdate = update |
| 79 | val unfoldi: int * 'a * (int * 'a -> 'b * 'a) -> 'b t * 'a = |
| 80 | fn (n, ac, f) => |
| 81 | let |
| 82 | val (arr, z) = |
| 83 | Array.unfoldi (n, ac, fn (i, a) => |
| 84 | let |
| 85 | val (b, a') = f (i, a) |
| 86 | in (SOME b, a') |
| 87 | end) |
| 88 | in |
| 89 | (T {array = ref arr, |
| 90 | length = ref n}, |
| 91 | z) |
| 92 | end) |
| 93 | |
| 94 | open A' A'' |
| 95 | |
| 96 | fun subOption (a, i) = |
| 97 | if i < length a |
| 98 | then Array.sub (getArray a, i) |
| 99 | else NONE |
| 100 | |
| 101 | fun grow (a as T {array, ...}) = |
| 102 | array := Array.tabulate (maxLength a * 2, |
| 103 | fn i => subOption (a, i)) |
| 104 | |
| 105 | fun shrink (a as T {array, ...}) = |
| 106 | array := Array.tabulate (maxLength a div 2, |
| 107 | fn i => subOption (a, i)) |
| 108 | |
| 109 | fun addToEnd (a, x) = |
| 110 | (if length a = maxLength a then grow a else () |
| 111 | ; updateSafe (a, length a, x) |
| 112 | ; incLength a) |
| 113 | |
| 114 | fun deleteLast a = |
| 115 | if length a = 0 |
| 116 | then Error.bug "ResizableArray.deleteLast" |
| 117 | else let val x = subSafe (a, maxIndex a) |
| 118 | in (if length a = minLength a then shrink a else () |
| 119 | ; decLength a |
| 120 | ; x) |
| 121 | end |
| 122 | |
| 123 | end |
| 124 | |
| 125 | structure ResizableArray = ResizableArray () |