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/trunk/Util/dynamic-array-fn.sml
ViewVC logotype

Annotation of /smlnj-lib/trunk/Util/dynamic-array-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2144 - (view) (download)

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

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