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 /MLRISC/releases/release-110.84/library/hash-array.sml
ViewVC logotype

Annotation of /MLRISC/releases/release-110.84/library/hash-array.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 4728 - (view) (download)

1 : jhr 4110 (* hash-array.sml
2 :     *
3 :     * COPYRIGHT (c) 2015 The Fellowship of SML/NJ (http://www.smlnj.org)
4 :     * All rights reserved.
5 :     *
6 : monnier 411 * Dynamic (sparse) array that uses hashing
7 :     *
8 :     * -- Allen
9 :     *)
10 :    
11 : jhr 4110 structure HashArray : sig
12 :    
13 :     include ARRAY
14 :    
15 :     val array' : int * (int -> 'a) -> 'a array
16 :     val array'': int * (int -> 'a) -> 'a array
17 :     val clear : 'a array -> unit
18 :     val remove : 'a array * int -> unit
19 :     val dom : 'a array -> int list
20 :     val copy_array : 'a array -> 'a array
21 :    
22 :     end = struct
23 :    
24 : monnier 245 structure A = Array
25 :    
26 :     datatype 'a default = V of 'a | F of int -> 'a | U of int -> 'a
27 :     datatype 'a array =
28 :     ARRAY of (int * 'a) list A.array ref * 'a default * int ref * int ref
29 :    
30 :     type 'a vector = 'a Vector.vector
31 :    
32 :     val maxLen = A.maxLen
33 :    
34 : monnier 429 fun array(n,d) = ARRAY(ref(A.array(16,[])),V d,ref n,ref 0)
35 :     fun array'(n,f) = ARRAY(ref(A.array(16,[])),F f,ref n,ref 0)
36 :     fun array''(n,f) = ARRAY(ref(A.array(16,[])),U f,ref n,ref 0)
37 :     fun clear(ARRAY(r,d,n,c)) = (r := A.array(16,[]); n := 0; c := 0)
38 :    
39 :     fun roundsize n =
40 :     let fun loop i = if i >= n then i else loop(i+i)
41 :     in loop 1 end
42 :    
43 : monnier 245 fun copy_array(ARRAY(ref a,d,ref n,ref c)) =
44 :     let val a' = A.array(n,[])
45 : mblume 1350 val _ = A.copy{src=a,dst=a',di=0}
46 : monnier 245 in ARRAY(ref a',d,ref n,ref c)
47 :     end
48 :    
49 : monnier 429 val itow = Word.fromInt
50 :     val wtoi = Word.toIntX
51 :     fun index(a, i) = wtoi(Word.andb(itow i, itow(Array.length a - 1)))
52 :    
53 : monnier 245 fun tabulate(n,f) =
54 :     let val N = n*n+1
55 : monnier 429 val N = if N < 16 then 16 else roundsize N
56 : monnier 245 val a = A.array(N,[])
57 :     fun ins i =
58 : monnier 429 let val pos = index(a, i)
59 : monnier 245 val x = f i
60 :     in A.update(a,pos,(i,x)::A.sub(a,pos)); x
61 :     end
62 :     fun insert 0 = ins 0
63 :     | insert i = (ins i; insert(i-1))
64 :     in if n < 0 then
65 :     ARRAY(ref a,F(fn _ => raise Subscript),ref 0,ref 0)
66 :     else
67 :     ARRAY(ref a,V(insert(n-1)),ref n,ref n)
68 :     end
69 :    
70 :     fun fromList l =
71 :     let val n = length l
72 :     val N = n*n+1
73 : monnier 429 val N = if N < 16 then 16 else roundsize N
74 : monnier 245 val a = A.array(N,[])
75 :     fun ins(i,x) =
76 : monnier 429 let val pos = index(a,i)
77 : monnier 245 in A.update(a,pos,(i,x)::A.sub(a,pos)); x
78 :     end
79 :     fun insert(i,[]) = F(fn _ => raise Subscript)
80 :     | insert(i,[x]) = V(ins(i,x))
81 :     | insert(i,x::l) = (ins(i,x); insert(i+1,l))
82 :     in ARRAY(ref a,insert(0,l),ref n,ref n)
83 :     end
84 :    
85 :     fun length(ARRAY(_,_,ref n,_)) = n
86 :    
87 :     fun sub(a' as ARRAY(ref a,d,_,_),i) =
88 : monnier 429 let val pos = index(a,i)
89 : monnier 245 fun search [] = (case d of
90 :     V d => d
91 :     | F f => f i
92 :     | U f => let val x = f i
93 :     in update(a',i,x); x end
94 :     )
95 :     | search ((j,x)::l) = if i = j then x else search l
96 :     in search(A.sub(a,pos)) end
97 :    
98 :     and update(a' as ARRAY(ref a,_,n,s as ref size),i,x) =
99 :     let val N = A.length a
100 : monnier 429 val pos = index(a,i)
101 : monnier 245 fun change([],l) =
102 :     if size+size >= N then grow(a',i,x)
103 :     else (s := size + 1; A.update(a,pos,(i,x)::l))
104 :     | change((y as (j,_))::l',l) =
105 :     if j = i then A.update(a,pos,(i,x)::l'@l)
106 :     else change(l',y::l)
107 :     in
108 :     change(A.sub(a,pos),[]);
109 :     if i >= !n then n := i+1 else ()
110 :     end
111 :    
112 :     and grow(ARRAY(a' as ref a,_,_,_),i,x) =
113 :     let val N = A.length a
114 : monnier 429 val N' = N+N
115 : monnier 245 val a'' = A.array(N',[])
116 :     fun insert(i,x) =
117 : monnier 429 let val pos = index(a'',i)
118 : monnier 245 in A.update(a'',pos,(i,x)::A.sub(a'',pos)) end
119 :     in
120 :     A.app (List.app insert) a;
121 :     insert(i,x);
122 :     a' := a''
123 :     end
124 :    
125 :     fun remove(a' as ARRAY(ref a,_,n,s as ref size),i) =
126 :     let val N = A.length a
127 : monnier 429 val pos = index(a,i)
128 : monnier 245 fun change([],_) = ()
129 :     | change((y as (j,_))::l',l) =
130 :     if j = i then (s := size - 1; A.update(a,pos,l'@l))
131 :     else change(l',y::l)
132 :     in change(A.sub(a,pos),[])
133 :     end
134 :    
135 : mblume 1350 (* These seem bogus since they do not run in order *)
136 :     fun appi f (ARRAY(ref a,_,ref n,_)) = A.app (List.app f) a
137 :     fun app f (ARRAY(ref a,_,_,_)) = A.app (List.app (fn (_,x) => f x)) a
138 : monnier 245
139 : mblume 1350 fun copy { src, dst, di } =
140 :     appi (fn (i, x) => update (dst, i, x)) src
141 : monnier 245
142 : mblume 1350 fun copyVec { src, dst, di } =
143 :     Vector.appi (fn (i, x) => update (dst, di + i, x)) src
144 : monnier 245
145 : mblume 1350 (* These seem bogus since they do not run in order *)
146 :     fun foldli f e (ARRAY(ref a,_,_,_)) =
147 :     A.foldl (fn (l, e) => List.foldl (fn ((i,x),e) => f (i,x,e)) e l) e a
148 :     fun foldri f e (ARRAY(ref a,_,_,_)) =
149 :     A.foldr (fn (l, e) => List.foldr (fn ((i,x),e) => f (i,x,e)) e l) e a
150 :    
151 : monnier 245 fun foldl f e (ARRAY(ref a,_,_,_)) =
152 :     A.foldl (fn (l,e) => List.foldl (fn ((_,x),e) => f(x,e)) e l) e a
153 :     fun foldr f e (ARRAY(ref a,_,_,_)) =
154 :     A.foldr (fn (l,e) => List.foldr (fn ((_,x),e) => f(x,e)) e l) e a
155 :    
156 : mblume 1350 fun modifyi f (ARRAY(ref a,_,_,_)) =
157 :     A.modify (List.map (fn (i,x) => (i, f (i, x)))) a
158 :    
159 : monnier 245 fun modify f (ARRAY(ref a,_,_,_)) =
160 :     A.modify (List.map (fn (i,x) => (i,f x))) a
161 :    
162 :     fun dom(ARRAY(ref a,_,_,_)) =
163 :     A.foldl (fn (e,l) => List.foldr (fn ((i,_),l) => i::l) l e) [] a
164 :    
165 : mblume 1350 fun findi p (ARRAY(ref a,_,_,_)) = let
166 :     val len = A.length a
167 :     fun fnd i =
168 :     if i >= len then NONE
169 :     else case List.find p (A.sub (a, i)) of
170 :     NONE => fnd (i + 1)
171 :     | some => some
172 :     in
173 :     fnd 0
174 : monnier 245 end
175 : mblume 1350
176 :     fun find p (ARRAY(ref a,_,_,_)) = let
177 :     val len = A.length a
178 :     fun fnd i =
179 :     if i >= len then NONE
180 :     else case List.find (p o #2) (A.sub (a, i)) of
181 :     NONE => fnd (i + 1)
182 :     | SOME (_, x) => SOME x
183 :     in
184 :     fnd 0
185 :     end
186 :    
187 :     fun exists p arr = isSome (find p arr)
188 :     fun all p arr = not (isSome (find (not o p) arr))
189 :     fun collate _ _ = raise Fail "HashArray.collate unimplemented"
190 :    
191 :     fun vector arr = Vector.fromList (rev (foldl op :: [] arr))
192 : jhr 4110
193 :     (* additional operations from Basis Library proposal 2015-003 *)
194 :     fun toList arr = foldr (op ::) [] arr
195 :    
196 :     fun fromVector v = let
197 :     val n = Vector.length v
198 :     val N = n*n+1
199 :     val N = if N < 16 then 16 else roundsize N
200 :     val a = A.array(N, [])
201 :     fun ins (i, x) = let
202 :     val pos = index(a, i)
203 :     in
204 :     A.update(a, pos, (i,x)::A.sub(a, pos)); x
205 :     end
206 :     fun lp i = if (i < n)
207 :     then (ins (i, Vector.sub(v, i)); lp(i+1))
208 :     else if (i = 0)
209 :     then F(fn _ => raise Subscript)
210 :     else V(Vector.sub(v, i-1))
211 :     in
212 :     ARRAY(ref a, lp 0, ref n, ref n)
213 :     end
214 :    
215 :     val toVector = vector
216 :    
217 : monnier 245 end

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