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 2 - (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 :     (* Remove an item, returning the item. The table's exception is raised if
47 :     * the item doesn't exist.
48 :     *)
49 :     fun remove (hashVal, sameKey) (arr, not_found, key) = let
50 :     val hash = hashVal key
51 :     val indx = index (hash, Array.length arr)
52 :     fun look HTRep.NIL = raise not_found
53 :     | look (HTRep.B(h, k, v, r)) = if ((hash = h) andalso sameKey(key, k))
54 :     then (v, r)
55 :     else let val (item, r') = look r in (item, HTRep.B(h, k, v, r')) end
56 :     val (item, bucket) = look (Array.sub (arr, indx))
57 :     in
58 :     Array.update (arr, indx, bucket);
59 :     item
60 :     end (* remove *)
61 :     fun delete1 (tbl, not_found, k) =
62 :     remove (Key1.hashVal, Key1.sameKey) (tbl, not_found, k)
63 :     fun delete2 (tbl, not_found, k) =
64 :     remove (Key2.hashVal, Key2.sameKey) (tbl, not_found, k)
65 :    
66 :     fun remove1 (TBL{tbl1, tbl2, n_items, not_found, ...}) k1 = let
67 :     val (k2, item) = delete1 (!tbl1, not_found, k1)
68 :     in
69 :     delete2 (!tbl2, not_found, k2);
70 :     n_items := !n_items - 1;
71 :     item
72 :     end
73 :     fun remove2 (TBL{tbl1, tbl2, n_items, not_found, ...}) k2 = let
74 :     val (k1, item) = delete2 (!tbl2, not_found, k2)
75 :     in
76 :     delete1 (!tbl1, not_found, k1);
77 :     n_items := !n_items - 1;
78 :     item
79 :     end
80 :    
81 :     (* Insert an item. If there is already an item that has either of the two keys,
82 :     * then the old item is discarded (from both tables)
83 :     *)
84 :     fun insert (TBL{tbl1, tbl2, n_items, ...}) (k1, k2, item) = let
85 :     val arr1 = !tbl1 and arr2 = !tbl2
86 :     val sz = Array.length arr1
87 :     val h1 = Key1.hashVal k1 and h2 = Key2.hashVal k2
88 :     val i1 = index(h1, sz) and i2 = index(h2, sz)
89 :     fun look1 HTRep.NIL = (
90 :     Array.update(arr1, i1,
91 :     HTRep.B(h1, k1, (k2, item), Array.sub(arr1, i1)));
92 :     (* we increment the number of items and grow the tables here,
93 :     * but not when inserting into tbl2.
94 :     *)
95 :     n_items := !n_items + 1;
96 :     if (HTRep.growTableIfNeeded (tbl1, !n_items))
97 :     then tbl2 := HTRep.growTable (arr2, Array.length(! tbl1))
98 :     else ();
99 :     HTRep.NIL)
100 :     | look1 (HTRep.B(h1', k1', (k2', v), r)) =
101 :     if ((h1' = h1) andalso Key1.sameKey(k1', k1))
102 :     then (
103 :     if not(Key2.sameKey(k2, k2'))
104 :     then ignore(delete2 (arr2, Fail "insert.look1", k2'))
105 :     else ();
106 :     HTRep.B(h1, k1, (k2, item), r))
107 :     else (case (look1 r)
108 :     of HTRep.NIL => HTRep.NIL
109 :     | rest => HTRep.B(h1', k1', (k2', v), rest)
110 :     (* end case *))
111 :     fun look2 HTRep.NIL = (
112 :     Array.update(arr2, i2,
113 :     HTRep.B(h2, k2, (k1, item), Array.sub(arr2, i2)));
114 :     HTRep.NIL)
115 :     | look2 (HTRep.B(h2', k2', (k1', v), r)) =
116 :     if ((h2' = h2) andalso Key2.sameKey(k2', k2))
117 :     then (
118 :     if not(Key1.sameKey(k1, k1'))
119 :     then ignore(delete1 (arr1, Fail "insert.look2", k1'))
120 :     else ();
121 :     HTRep.B(h2, k2, (k1, item), r))
122 :     else (case (look2 r)
123 :     of HTRep.NIL => HTRep.NIL
124 :     | rest => HTRep.B(h2, k2, (k1, v), rest)
125 :     (* end case *))
126 :     in
127 :     case (look1 (Array.sub (arr1, i1)), look2 (Array.sub (arr2, i2)))
128 :     of (HTRep.NIL, HTRep.NIL) => ()
129 :     | (b1, b2) => (
130 :     (* NOTE: both b1 and b2 should be non-nil, since we should
131 :     * have replaced an item in both tables.
132 :     *)
133 :     Array.update(arr1, i1, b1);
134 :     Array.update(arr2, i2, b2))
135 :     (* end case *)
136 :     end
137 :    
138 :     (* Look for an item, the table's exception is raised if the item doesn't exist *)
139 :     fun lookup (hashVal, sameKey) (tbl, not_found) key = let
140 :     val arr = !tbl
141 :     val hash = hashVal key
142 :     val indx = index (hash, Array.length arr)
143 :     fun look HTRep.NIL = raise not_found
144 :     | look (HTRep.B(h, k, (_, v), r)) =
145 :     if ((hash = h) andalso sameKey(key, k)) then v else look r
146 :     in
147 :     look (Array.sub (arr, indx))
148 :     end
149 :     fun lookup1 (TBL{tbl1, not_found, ...}) =
150 :     lookup (Key1.hashVal, Key1.sameKey) (tbl1, not_found)
151 :     fun lookup2 (TBL{tbl2, not_found, ...}) =
152 :     lookup (Key2.hashVal, Key2.sameKey) (tbl2, not_found)
153 :    
154 :     (* Look for an item, return NONE if the item doesn't exist *)
155 :     fun find (hashVal, sameKey) table key = let
156 :     val arr = !table
157 :     val sz = Array.length arr
158 :     val hash = hashVal key
159 :     val indx = index (hash, sz)
160 :     fun look HTRep.NIL = NONE
161 :     | look (HTRep.B(h, k, (_, v), r)) = if ((hash = h) andalso sameKey(key, k))
162 :     then SOME v
163 :     else look r
164 :     in
165 :     look (Array.sub (arr, indx))
166 :     end
167 :     fun find1 (TBL{tbl1, ...}) = find (Key1.hashVal, Key1.sameKey) tbl1
168 :     fun find2 (TBL{tbl2, ...}) = find (Key2.hashVal, Key2.sameKey) tbl2
169 :    
170 :     (* Return the number of items in the table *)
171 :     fun numItems (TBL{n_items, ...}) = !n_items
172 :    
173 :     (* Return a list of the items (and their keys) in the table *)
174 :     fun listItems (TBL{tbl1, ...}) =
175 :     HTRep.fold (fn ((_, item), l) => item::l) [] (! tbl1)
176 :     fun listItemsi (TBL{tbl1, ...}) =
177 :     HTRep.foldi (fn (k1, (k2, item), l) => (k1, k2, item)::l) [] (! tbl1)
178 :    
179 :     (* Apply a function to the entries of the table *)
180 :     fun app f (TBL{tbl1, ...}) =
181 :     HTRep.app (fn (_, v) => f v) (! tbl1)
182 :     fun appi f (TBL{tbl1, ...}) =
183 :     HTRep.appi (fn (k1, (k2, v)) => f(k1, k2, v)) (! tbl1)
184 :    
185 :     (* Map a table to a new table that has the same keys *)
186 :     fun map f (TBL{tbl1, tbl2, n_items, not_found}) = let
187 :     val sz = Array.length (! tbl1)
188 :     val newTbl = TBL{
189 :     tbl1 = ref (HTRep.alloc sz),
190 :     tbl2 = ref (HTRep.alloc sz),
191 :     n_items = ref 0,
192 :     not_found = not_found
193 :     }
194 :     fun ins (k1, (k2, v)) = insert newTbl (k1, k2, f v)
195 :     in
196 :     HTRep.appi ins (! tbl1); newTbl
197 :     end
198 :     fun mapi f (TBL{tbl1, tbl2, n_items, not_found}) = let
199 :     val sz = Array.length (! tbl1)
200 :     val newTbl = TBL{
201 :     tbl1 = ref (HTRep.alloc sz),
202 :     tbl2 = ref (HTRep.alloc sz),
203 :     n_items = ref 0,
204 :     not_found = not_found
205 :     }
206 :     fun ins (k1, (k2, v)) = insert newTbl (k1, k2, f(k1, k2, v))
207 :     in
208 :     HTRep.appi ins (! tbl1); newTbl
209 :     end
210 :    
211 :     fun fold f init (TBL{tbl1, ...}) =
212 :     HTRep.fold (fn ((_, v), accum) => f(v, accum)) init (! tbl1)
213 :     fun foldi f init (TBL{tbl1, ...}) =
214 :     HTRep.foldi (fn (k1, (k2, v), accum) => f(k1, k2, v, accum)) init (! tbl1)
215 :    
216 :     (* remove any hash table items that do not satisfy the given
217 :     * predicate.
218 :     *)
219 :     fun filter pred (TBL{tbl1, tbl2, n_items, ...}) = let
220 :     fun ins (k1, (k2, v)) = if (pred v)
221 :     then ()
222 :     else (
223 :     delete1 (!tbl1, Fail "filter", k1);
224 :     delete2 (!tbl2, Fail "filter", k2);
225 :     n_items := !n_items-1)
226 :     in
227 :     HTRep.appi ins (! tbl1)
228 :     end
229 :     fun filteri pred (TBL{tbl1, tbl2, n_items, not_found}) = let
230 :     fun ins (k1, (k2, v)) = if (pred(k1, k2, v))
231 :     then ()
232 :     else (
233 :     delete1 (!tbl1, Fail "filteri", k1);
234 :     delete2 (!tbl2, Fail "filteri", k2);
235 :     n_items := !n_items-1)
236 :     in
237 :     HTRep.appi ins (! tbl1)
238 :     end
239 :    
240 :     (* Create a copy of a hash table *)
241 :     fun copy (TBL{tbl1, tbl2, n_items, not_found}) = TBL{
242 :     tbl1 = ref(HTRep.copy (! tbl1)),
243 :     tbl2 = ref(HTRep.copy (! tbl2)),
244 :     n_items = ref(! n_items),
245 :     not_found = not_found
246 :     }
247 :    
248 :     (* returns a list of the sizes of the various buckets. This is to
249 :     * allow users to gauge the quality of their hashing function.
250 :     *)
251 :     fun bucketSizes (TBL{tbl1, tbl2, ...}) =
252 :     (HTRep.bucketSizes(! tbl1), HTRep.bucketSizes(! tbl2))
253 :    
254 :     end (* MONO_HASH2_TABLE *)

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