Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /smlnj-lib/branches/rt-transition/Util/dynamic-array-fn.sml
ViewVC logotype

Annotation of /smlnj-lib/branches/rt-transition/Util/dynamic-array-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4070 - (view) (download)

1 : monnier 2 (* dynamic-array-fn.sml
2 :     *
3 : jhr 3736 * COPYRIGHT (c) 2009 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 : monnier 2 *
6 : jhr 3736 * Monomorphic arrays of unbounded length
7 : monnier 2 *)
8 :    
9 :     functor DynamicArrayFn (A : MONO_ARRAY) : MONO_DYNAMIC_ARRAY =
10 :     struct
11 :    
12 :     type elem = A.elem
13 : jhr 4070
14 :     (* BLOCK(arr, dflt, bnd):
15 :     * arr - current data store; is at least !bnd+1 elements
16 :     * dflt - default value
17 :     * bnd - values at !bnd and above are default for reading
18 :     *)
19 : monnier 2 datatype array = BLOCK of A.array ref * elem * int ref
20 :    
21 :     exception Subscript = General.Subscript
22 :     exception Size = General.Size
23 :    
24 :     fun array (sz, dflt) = BLOCK(ref (A.array (sz, dflt)), dflt, ref (~1))
25 :    
26 :     (* fromList (l, v) creates an array using the list of values l
27 :     * plus the default value v.
28 :     * NOTE: Once MONO_ARRAY includes arrayoflist, this will become trivial.
29 :     *)
30 :     fun fromList (initList, dflt) = let
31 : jhr 4070 val arr = A.fromList initList
32 : monnier 2 in
33 : jhr 4070 BLOCK(ref arr, dflt, ref(A.length arr - 1))
34 : monnier 2 end
35 :    
36 :     (* tabulate (sz,fill,dflt) acts like Array.tabulate, plus
37 :     * stores default value dflt. Raises Size if sz < 0.
38 :     *)
39 :     fun tabulate (sz, fillFn, dflt) =
40 : jhr 4070 BLOCK(ref(A.tabulate(sz, fillFn)), dflt, ref(sz-1))
41 : monnier 2
42 : jhr 4070 fun subArray (BLOCK(arr, dflt, bnd), lo, hi) = let
43 : monnier 2 val arrval = !arr
44 :     val bnd = !bnd
45 : jhr 4070 fun copy i = A.sub(arrval, i+lo)
46 : monnier 2 in
47 :     if hi <= bnd
48 : jhr 4070 then BLOCK(ref(A.tabulate(hi-lo, copy)), dflt, ref(hi-lo))
49 : monnier 2 else if lo <= bnd
50 : jhr 4070 then BLOCK(ref(A.tabulate(bnd-lo, copy)), dflt, ref(bnd-lo))
51 : monnier 2 else
52 :     array(0,dflt)
53 :     end
54 :    
55 : jhr 4070 fun default (BLOCK(_, dflt, _)) = dflt
56 : monnier 2
57 : jhr 4070 fun sub (BLOCK(arr, dflt, _), idx) = (A.sub(!arr, idx))
58 : monnier 2 handle Subscript => if idx < 0 then raise Subscript else dflt
59 :    
60 : jhr 4070 fun bound (BLOCK(_, _, bnd)) = (!bnd)
61 : monnier 2
62 : jhr 3736 fun expand (arr,oldlen,newlen,dflt) = let
63 : monnier 2 fun fillfn i = if i < oldlen then A.sub(arr,i) else dflt
64 :     in
65 :     A.tabulate(newlen, fillfn)
66 :     end
67 :    
68 : jhr 4070 fun update (BLOCK(arr, dflt, bnd), idx, v) = let
69 : monnier 2 val len = A.length (!arr)
70 :     in
71 :     if idx >= len
72 : jhr 4070 then arr := expand(!arr, len, Int.max(len+len, idx+1), dflt)
73 : monnier 2 else ();
74 :     A.update(!arr,idx,v);
75 :     if idx > !bnd then bnd := idx else ()
76 :     end
77 :    
78 : jhr 4070 fun truncate (a as BLOCK(arr, dflt, bndref), sz) = let
79 : monnier 2 val bnd = !bndref
80 :     val newbnd = sz - 1
81 :     val arr_val = !arr
82 :     val array_sz = A.length arr_val
83 :     fun fillDflt (i,stop) =
84 :     if i = stop then ()
85 :     else (A.update(arr_val,i,dflt);fillDflt(i-1,stop))
86 :     in
87 :     if newbnd < 0 then (bndref := ~1;arr := A.array(0,dflt))
88 :     else if newbnd >= bnd then ()
89 :     else if 3 * sz < array_sz then let
90 :     val BLOCK(arr',_,bnd') = subArray(a,0,newbnd)
91 :     in
92 :     (bndref := !bnd'; arr := !arr')
93 :     end
94 :     else fillDflt(bnd,newbnd)
95 :     end
96 :    
97 :     end (* DynamicArrayFn *)
98 :    

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0