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 /sml/trunk/src/smlnj-lib/Util/hash2-table-fn.sml
ViewVC logotype

Annotation of /sml/trunk/src/smlnj-lib/Util/hash2-table-fn.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 816 - (view) (download)

1 : monnier 2 (* mono-hash2-table-fn.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 by AT&T Research.
4 :     *
5 :     * Hash tables that are keyed by two keys (in different domains).
6 :     *
7 :     * AUTHOR: John Reppy
8 :     * AT&T Bell Laboratories
9 :     * Murray Hill, NJ 07974
10 :     * jhr@research.att.com
11 :     *)
12 :    
13 :     functor Hash2TableFn (
14 :     structure Key1 : HASH_KEY
15 :     structure Key2 : HASH_KEY
16 :     ) : MONO_HASH2_TABLE = struct
17 :    
18 :     structure Key1 = Key1
19 :     structure Key2 = Key2
20 :    
21 :     structure HTRep = HashTableRep
22 :    
23 :     (* the representation of a double-keyed hash table is two tables
24 :     * that will always hold the same number of items and be the same
25 :     * size.
26 :     *)
27 :     datatype 'a hash_table = TBL of {
28 :     not_found : exn,
29 :     tbl1 : (Key1.hash_key, Key2.hash_key * 'a) HTRep.table ref,
30 :     tbl2 : (Key2.hash_key, Key1.hash_key * 'a) HTRep.table ref,
31 :     n_items : int ref
32 :     }
33 :    
34 :     fun index (i, sz) = Word.toIntX(Word.andb(i, Word.fromInt sz - 0w1))
35 :    
36 :     (* Create a new table; the int is a size hint and the exception
37 :     * is to be raised by find.
38 :     *)
39 :     fun mkTable (n, exn) = TBL{
40 :     not_found = exn,
41 :     tbl1 = ref(HTRep.alloc n),
42 :     tbl2 = ref(HTRep.alloc n),
43 :     n_items = ref 0
44 :     }
45 :    
46 : monnier 8 (* remove all elements from the table *)
47 :     fun clear (TBL{tbl1, tbl2, n_items, ...}) = (
48 :     HTRep.clear(!tbl1); HTRep.clear(!tbl2); n_items := 0)
49 :    
50 : monnier 2 (* Remove an item, returning the item. The table's exception is raised if
51 :     * the item doesn't exist.
52 :     *)
53 :     fun remove (hashVal, sameKey) (arr, not_found, key) = let
54 :     val hash = hashVal key
55 :     val indx = index (hash, Array.length arr)
56 :     fun look HTRep.NIL = raise not_found
57 :     | look (HTRep.B(h, k, v, r)) = if ((hash = h) andalso sameKey(key, k))
58 :     then (v, r)
59 :     else let val (item, r') = look r in (item, HTRep.B(h, k, v, r')) end
60 :     val (item, bucket) = look (Array.sub (arr, indx))
61 :     in
62 :     Array.update (arr, indx, bucket);
63 :     item
64 :     end (* remove *)
65 :     fun delete1 (tbl, not_found, k) =
66 :     remove (Key1.hashVal, Key1.sameKey) (tbl, not_found, k)
67 :     fun delete2 (tbl, not_found, k) =
68 :     remove (Key2.hashVal, Key2.sameKey) (tbl, not_found, k)
69 :    
70 :     fun remove1 (TBL{tbl1, tbl2, n_items, not_found, ...}) k1 = let
71 :     val (k2, item) = delete1 (!tbl1, not_found, k1)
72 :     in
73 :     delete2 (!tbl2, not_found, k2);
74 :     n_items := !n_items - 1;
75 :     item
76 :     end
77 :     fun remove2 (TBL{tbl1, tbl2, n_items, not_found, ...}) k2 = let
78 :     val (k1, item) = delete2 (!tbl2, not_found, k2)
79 :     in
80 :     delete1 (!tbl1, not_found, k1);
81 :     n_items := !n_items - 1;
82 :     item
83 :     end
84 :    
85 :     (* Insert an item. If there is already an item that has either of the two keys,
86 :     * then the old item is discarded (from both tables)
87 :     *)
88 :     fun insert (TBL{tbl1, tbl2, n_items, ...}) (k1, k2, item) = let
89 :     val arr1 = !tbl1 and arr2 = !tbl2
90 :     val sz = Array.length arr1
91 :     val h1 = Key1.hashVal k1 and h2 = Key2.hashVal k2
92 :     val i1 = index(h1, sz) and i2 = index(h2, sz)
93 :     fun look1 HTRep.NIL = (
94 :     Array.update(arr1, i1,
95 :     HTRep.B(h1, k1, (k2, item), Array.sub(arr1, i1)));
96 :     (* we increment the number of items and grow the tables here,
97 :     * but not when inserting into tbl2.
98 :     *)
99 :     n_items := !n_items + 1;
100 :     if (HTRep.growTableIfNeeded (tbl1, !n_items))
101 :     then tbl2 := HTRep.growTable (arr2, Array.length(! tbl1))
102 :     else ();
103 :     HTRep.NIL)
104 :     | look1 (HTRep.B(h1', k1', (k2', v), r)) =
105 :     if ((h1' = h1) andalso Key1.sameKey(k1', k1))
106 :     then (
107 :     if not(Key2.sameKey(k2, k2'))
108 :     then ignore(delete2 (arr2, Fail "insert.look1", k2'))
109 :     else ();
110 :     HTRep.B(h1, k1, (k2, item), r))
111 :     else (case (look1 r)
112 :     of HTRep.NIL => HTRep.NIL
113 :     | rest => HTRep.B(h1', k1', (k2', v), rest)
114 :     (* end case *))
115 :     fun look2 HTRep.NIL = (
116 :     Array.update(arr2, i2,
117 :     HTRep.B(h2, k2, (k1, item), Array.sub(arr2, i2)));
118 :     HTRep.NIL)
119 :     | look2 (HTRep.B(h2', k2', (k1', v), r)) =
120 :     if ((h2' = h2) andalso Key2.sameKey(k2', k2))
121 :     then (
122 :     if not(Key1.sameKey(k1, k1'))
123 :     then ignore(delete1 (arr1, Fail "insert.look2", k1'))
124 :     else ();
125 :     HTRep.B(h2, k2, (k1, item), r))
126 :     else (case (look2 r)
127 :     of HTRep.NIL => HTRep.NIL
128 :     | rest => HTRep.B(h2, k2, (k1, v), rest)
129 :     (* end case *))
130 :     in
131 :     case (look1 (Array.sub (arr1, i1)), look2 (Array.sub (arr2, i2)))
132 :     of (HTRep.NIL, HTRep.NIL) => ()
133 :     | (b1, b2) => (
134 :     (* NOTE: both b1 and b2 should be non-nil, since we should
135 :     * have replaced an item in both tables.
136 :     *)
137 :     Array.update(arr1, i1, b1);
138 :     Array.update(arr2, i2, b2))
139 :     (* end case *)
140 :     end
141 :    
142 : jhr 816 (* return true, if the key is in the domain of the table *)
143 :     fun inDomain (hashVal, sameKey) tbl key = let
144 :     val arr = !tbl
145 :     val hash = hashVal key
146 :     val indx = index (hash, Array.length arr)
147 :     fun look HTRep.NIL = false
148 :     | look (HTRep.B(h, k, v, r)) =
149 :     ((hash = h) andalso sameKey(key, k)) orelse look r
150 :     in
151 :     look (Array.sub (arr, indx))
152 :     end
153 :     fun inDomain1 (TBL{tbl1, ...}) = inDomain (Key1.hashVal, Key1.sameKey) tbl1
154 :     fun inDomain2 (TBL{tbl2, ...}) = inDomain (Key2.hashVal, Key2.sameKey) tbl2
155 :    
156 : monnier 2 (* Look for an item, the table's exception is raised if the item doesn't exist *)
157 :     fun lookup (hashVal, sameKey) (tbl, not_found) key = let
158 :     val arr = !tbl
159 :     val hash = hashVal key
160 :     val indx = index (hash, Array.length arr)
161 :     fun look HTRep.NIL = raise not_found
162 :     | look (HTRep.B(h, k, (_, v), r)) =
163 :     if ((hash = h) andalso sameKey(key, k)) then v else look r
164 :     in
165 :     look (Array.sub (arr, indx))
166 :     end
167 :     fun lookup1 (TBL{tbl1, not_found, ...}) =
168 :     lookup (Key1.hashVal, Key1.sameKey) (tbl1, not_found)
169 :     fun lookup2 (TBL{tbl2, not_found, ...}) =
170 :     lookup (Key2.hashVal, Key2.sameKey) (tbl2, not_found)
171 :    
172 :     (* Look for an item, return NONE if the item doesn't exist *)
173 :     fun find (hashVal, sameKey) table key = let
174 :     val arr = !table
175 :     val sz = Array.length arr
176 :     val hash = hashVal key
177 :     val indx = index (hash, sz)
178 :     fun look HTRep.NIL = NONE
179 :     | look (HTRep.B(h, k, (_, v), r)) = if ((hash = h) andalso sameKey(key, k))
180 :     then SOME v
181 :     else look r
182 :     in
183 :     look (Array.sub (arr, indx))
184 :     end
185 :     fun find1 (TBL{tbl1, ...}) = find (Key1.hashVal, Key1.sameKey) tbl1
186 :     fun find2 (TBL{tbl2, ...}) = find (Key2.hashVal, Key2.sameKey) tbl2
187 :    
188 :     (* Return the number of items in the table *)
189 :     fun numItems (TBL{n_items, ...}) = !n_items
190 :    
191 :     (* Return a list of the items (and their keys) in the table *)
192 :     fun listItems (TBL{tbl1, ...}) =
193 :     HTRep.fold (fn ((_, item), l) => item::l) [] (! tbl1)
194 :     fun listItemsi (TBL{tbl1, ...}) =
195 :     HTRep.foldi (fn (k1, (k2, item), l) => (k1, k2, item)::l) [] (! tbl1)
196 :    
197 :     (* Apply a function to the entries of the table *)
198 :     fun app f (TBL{tbl1, ...}) =
199 :     HTRep.app (fn (_, v) => f v) (! tbl1)
200 :     fun appi f (TBL{tbl1, ...}) =
201 :     HTRep.appi (fn (k1, (k2, v)) => f(k1, k2, v)) (! tbl1)
202 :    
203 :     (* Map a table to a new table that has the same keys *)
204 :     fun map f (TBL{tbl1, tbl2, n_items, not_found}) = let
205 :     val sz = Array.length (! tbl1)
206 :     val newTbl = TBL{
207 :     tbl1 = ref (HTRep.alloc sz),
208 :     tbl2 = ref (HTRep.alloc sz),
209 :     n_items = ref 0,
210 :     not_found = not_found
211 :     }
212 :     fun ins (k1, (k2, v)) = insert newTbl (k1, k2, f v)
213 :     in
214 :     HTRep.appi ins (! tbl1); newTbl
215 :     end
216 :     fun mapi f (TBL{tbl1, tbl2, n_items, not_found}) = let
217 :     val sz = Array.length (! tbl1)
218 :     val newTbl = TBL{
219 :     tbl1 = ref (HTRep.alloc sz),
220 :     tbl2 = ref (HTRep.alloc sz),
221 :     n_items = ref 0,
222 :     not_found = not_found
223 :     }
224 :     fun ins (k1, (k2, v)) = insert newTbl (k1, k2, f(k1, k2, v))
225 :     in
226 :     HTRep.appi ins (! tbl1); newTbl
227 :     end
228 :    
229 :     fun fold f init (TBL{tbl1, ...}) =
230 :     HTRep.fold (fn ((_, v), accum) => f(v, accum)) init (! tbl1)
231 :     fun foldi f init (TBL{tbl1, ...}) =
232 :     HTRep.foldi (fn (k1, (k2, v), accum) => f(k1, k2, v, accum)) init (! tbl1)
233 :    
234 :     (* remove any hash table items that do not satisfy the given
235 :     * predicate.
236 :     *)
237 :     fun filter pred (TBL{tbl1, tbl2, n_items, ...}) = let
238 :     fun ins (k1, (k2, v)) = if (pred v)
239 :     then ()
240 :     else (
241 :     delete1 (!tbl1, Fail "filter", k1);
242 :     delete2 (!tbl2, Fail "filter", k2);
243 :     n_items := !n_items-1)
244 :     in
245 :     HTRep.appi ins (! tbl1)
246 :     end
247 :     fun filteri pred (TBL{tbl1, tbl2, n_items, not_found}) = let
248 :     fun ins (k1, (k2, v)) = if (pred(k1, k2, v))
249 :     then ()
250 :     else (
251 :     delete1 (!tbl1, Fail "filteri", k1);
252 :     delete2 (!tbl2, Fail "filteri", k2);
253 :     n_items := !n_items-1)
254 :     in
255 :     HTRep.appi ins (! tbl1)
256 :     end
257 :    
258 :     (* Create a copy of a hash table *)
259 :     fun copy (TBL{tbl1, tbl2, n_items, not_found}) = TBL{
260 :     tbl1 = ref(HTRep.copy (! tbl1)),
261 :     tbl2 = ref(HTRep.copy (! tbl2)),
262 :     n_items = ref(! n_items),
263 :     not_found = not_found
264 :     }
265 :    
266 :     (* returns a list of the sizes of the various buckets. This is to
267 :     * allow users to gauge the quality of their hashing function.
268 :     *)
269 :     fun bucketSizes (TBL{tbl1, tbl2, ...}) =
270 :     (HTRep.bucketSizes(! tbl1), HTRep.bucketSizes(! tbl2))
271 :    
272 :     end (* MONO_HASH2_TABLE *)

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