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 8 - (view) (download)
Original Path: sml/branches/SMLNJ/src/smlnj-lib/Util/hash2-table-fn.sml

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 :     (* Look for an item, the table's exception is raised if the item doesn't exist *)
143 :     fun lookup (hashVal, sameKey) (tbl, not_found) key = let
144 :     val arr = !tbl
145 :     val hash = hashVal key
146 :     val indx = index (hash, Array.length arr)
147 :     fun look HTRep.NIL = raise not_found
148 :     | look (HTRep.B(h, k, (_, v), r)) =
149 :     if ((hash = h) andalso sameKey(key, k)) then v else look r
150 :     in
151 :     look (Array.sub (arr, indx))
152 :     end
153 :     fun lookup1 (TBL{tbl1, not_found, ...}) =
154 :     lookup (Key1.hashVal, Key1.sameKey) (tbl1, not_found)
155 :     fun lookup2 (TBL{tbl2, not_found, ...}) =
156 :     lookup (Key2.hashVal, Key2.sameKey) (tbl2, not_found)
157 :    
158 :     (* Look for an item, return NONE if the item doesn't exist *)
159 :     fun find (hashVal, sameKey) table key = let
160 :     val arr = !table
161 :     val sz = Array.length arr
162 :     val hash = hashVal key
163 :     val indx = index (hash, sz)
164 :     fun look HTRep.NIL = NONE
165 :     | look (HTRep.B(h, k, (_, v), r)) = if ((hash = h) andalso sameKey(key, k))
166 :     then SOME v
167 :     else look r
168 :     in
169 :     look (Array.sub (arr, indx))
170 :     end
171 :     fun find1 (TBL{tbl1, ...}) = find (Key1.hashVal, Key1.sameKey) tbl1
172 :     fun find2 (TBL{tbl2, ...}) = find (Key2.hashVal, Key2.sameKey) tbl2
173 :    
174 :     (* Return the number of items in the table *)
175 :     fun numItems (TBL{n_items, ...}) = !n_items
176 :    
177 :     (* Return a list of the items (and their keys) in the table *)
178 :     fun listItems (TBL{tbl1, ...}) =
179 :     HTRep.fold (fn ((_, item), l) => item::l) [] (! tbl1)
180 :     fun listItemsi (TBL{tbl1, ...}) =
181 :     HTRep.foldi (fn (k1, (k2, item), l) => (k1, k2, item)::l) [] (! tbl1)
182 :    
183 :     (* Apply a function to the entries of the table *)
184 :     fun app f (TBL{tbl1, ...}) =
185 :     HTRep.app (fn (_, v) => f v) (! tbl1)
186 :     fun appi f (TBL{tbl1, ...}) =
187 :     HTRep.appi (fn (k1, (k2, v)) => f(k1, k2, v)) (! tbl1)
188 :    
189 :     (* Map a table to a new table that has the same keys *)
190 :     fun map f (TBL{tbl1, tbl2, n_items, not_found}) = let
191 :     val sz = Array.length (! tbl1)
192 :     val newTbl = TBL{
193 :     tbl1 = ref (HTRep.alloc sz),
194 :     tbl2 = ref (HTRep.alloc sz),
195 :     n_items = ref 0,
196 :     not_found = not_found
197 :     }
198 :     fun ins (k1, (k2, v)) = insert newTbl (k1, k2, f v)
199 :     in
200 :     HTRep.appi ins (! tbl1); newTbl
201 :     end
202 :     fun mapi f (TBL{tbl1, tbl2, n_items, not_found}) = let
203 :     val sz = Array.length (! tbl1)
204 :     val newTbl = TBL{
205 :     tbl1 = ref (HTRep.alloc sz),
206 :     tbl2 = ref (HTRep.alloc sz),
207 :     n_items = ref 0,
208 :     not_found = not_found
209 :     }
210 :     fun ins (k1, (k2, v)) = insert newTbl (k1, k2, f(k1, k2, v))
211 :     in
212 :     HTRep.appi ins (! tbl1); newTbl
213 :     end
214 :    
215 :     fun fold f init (TBL{tbl1, ...}) =
216 :     HTRep.fold (fn ((_, v), accum) => f(v, accum)) init (! tbl1)
217 :     fun foldi f init (TBL{tbl1, ...}) =
218 :     HTRep.foldi (fn (k1, (k2, v), accum) => f(k1, k2, v, accum)) init (! tbl1)
219 :    
220 :     (* remove any hash table items that do not satisfy the given
221 :     * predicate.
222 :     *)
223 :     fun filter pred (TBL{tbl1, tbl2, n_items, ...}) = let
224 :     fun ins (k1, (k2, v)) = if (pred v)
225 :     then ()
226 :     else (
227 :     delete1 (!tbl1, Fail "filter", k1);
228 :     delete2 (!tbl2, Fail "filter", k2);
229 :     n_items := !n_items-1)
230 :     in
231 :     HTRep.appi ins (! tbl1)
232 :     end
233 :     fun filteri pred (TBL{tbl1, tbl2, n_items, not_found}) = let
234 :     fun ins (k1, (k2, v)) = if (pred(k1, k2, v))
235 :     then ()
236 :     else (
237 :     delete1 (!tbl1, Fail "filteri", k1);
238 :     delete2 (!tbl2, Fail "filteri", k2);
239 :     n_items := !n_items-1)
240 :     in
241 :     HTRep.appi ins (! tbl1)
242 :     end
243 :    
244 :     (* Create a copy of a hash table *)
245 :     fun copy (TBL{tbl1, tbl2, n_items, not_found}) = TBL{
246 :     tbl1 = ref(HTRep.copy (! tbl1)),
247 :     tbl2 = ref(HTRep.copy (! tbl2)),
248 :     n_items = ref(! n_items),
249 :     not_found = not_found
250 :     }
251 :    
252 :     (* returns a list of the sizes of the various buckets. This is to
253 :     * allow users to gauge the quality of their hashing function.
254 :     *)
255 :     fun bucketSizes (TBL{tbl1, tbl2, ...}) =
256 :     (HTRep.bucketSizes(! tbl1), HTRep.bucketSizes(! tbl2))
257 :    
258 :     end (* MONO_HASH2_TABLE *)

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