Commit | Line | Data |
---|---|---|
7f918cf1 CE |
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 () |