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/eXene/lib/util/hash-util.sml
ViewVC logotype

Annotation of /sml/trunk/src/eXene/lib/util/hash-util.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 2 - (view) (download)

1 : monnier 2 (* hash-util.sml
2 :     *
3 :     * COPYRIGHT (c) 1990,1991 by John H. Reppy. See COPYRIGHT file for details.
4 :     * COPYRIGHT 1989 by AT&T Bell Laboratories
5 :     *
6 :     * These are generic routines for supporting hash-tables of various
7 :     * kinds in the CX system. Since the hash table use mutable state, they
8 :     * should be isolated inside server threads. Some of this code was
9 :     * lifted from SML/NJ.
10 :     *)
11 :    
12 :     signature HASH_UTIL =
13 :     sig
14 :    
15 :     exception NotFound
16 :    
17 :     (* a generic hash table mapping unique integer keys to values *)
18 :     type 'a int_map_t
19 :     (* create a new table *)
20 :     val newIntMap : unit -> '1a int_map_t
21 :     (* insert an item *)
22 :     val insertInt : '2a int_map_t -> (int * '2a) -> unit
23 :     (* find an item, the exception NotFound is raised if the item doesn't exist *)
24 :     val findInt : 'a int_map_t -> int -> 'a
25 :     (* remove an item, returning the item *)
26 :     val removeInt : 'a int_map_t -> int -> 'a
27 :     (* return a list of the items in the table *)
28 :     val listInts : 'a int_map_t -> 'a list
29 :    
30 :     (* a generic hash table mapping string keys to values *)
31 :     type 'a name_map_t
32 :     (* create a new table *)
33 :     val newNameMap : unit -> '1a name_map_t
34 :     (* insert an item *)
35 :     val insertName : '2a name_map_t -> (string * '2a) -> unit
36 :     (* find an item, the exception NotFound is raised if the item doesn't exist *)
37 :     val findName : 'a name_map_t -> string -> 'a
38 :     (* remove an item *)
39 :     val removeName : 'a name_map_t -> string -> 'a
40 :     (* return a list of the items in the table *)
41 :     val listNames : 'a name_map_t -> 'a list
42 :    
43 :     end (* signature HASH_UTIL *)
44 :    
45 :     structure HashUtil : HASH_UTIL =
46 :     struct
47 :    
48 :     exception NotFound
49 :    
50 :     local
51 :     (* a string hash function *)
52 :     fun hashString str = let
53 :     val prime = 8388593 (* largest prime less than 2^23 *)
54 :     val base = 128
55 :     val l = String.size str
56 :     in
57 :     case l
58 :     of 0 => 0
59 :     | 1 => ord str
60 :     | 2 => ordof(str,0) + base * ordof(str,1)
61 :     | 3 => ordof(str,0) + base * (ordof(str,1) + base * ordof(str,2))
62 :     | _ => let
63 :     fun loop (0,n) = n
64 :     | loop (i,n) = let
65 :     val i = i-1
66 :     val n' = (base * n + ordof(str,i))
67 :     in
68 :     loop (i, (n' - prime * (n' quot prime)))
69 :     end
70 :     in
71 :     loop (l,0)
72 :     end
73 :     end (* hashString *)
74 :    
75 :     datatype ('a, 'b) bucket_t
76 :     = NIL
77 :     | B of ('b * 'a * ('a, 'b) bucket_t)
78 :    
79 :     type ('a, 'b) map_t = {
80 :     table : ('a, 'b) bucket_t array ref,
81 :     elems : int ref
82 :     }
83 :    
84 :     (* generic routines on maps *)
85 :     fun newMap () = {table = ref (Array.array(32, NIL)), elems = ref 0}
86 :     fun hash (i, sz) = Bits.andb(i, sz-1)
87 :    
88 :     (* conditionally grow a map *)
89 :     fun mapGrow (keyIndx, {table, elems}) = let
90 :     val arr = !table
91 :     val sz = Array.length arr
92 :     val newSz = sz+sz
93 :     val newArr = Array.array (newSz,NIL)
94 :     fun copy NIL = ()
95 :     | copy (B(key, v, rest)) = let
96 :     val indx = hash(keyIndx key, newSz)
97 :     in
98 :     Array.update(newArr, indx, B(key, v, Array.sub(newArr, indx)));
99 :     copy rest
100 :     end
101 :     fun bucket n = (copy(Array.sub(arr, n)); bucket(n+1))
102 :     in
103 :     if (!elems >= sz)
104 :     then (
105 :     (bucket 0) handle Array.Subscript => ();
106 :     table := newArr)
107 :     else ()
108 :     end
109 :    
110 :     (* insert a (key, value) pair into a map (assuming size is okay) *)
111 :     fun mapInsert (mkKey, keyIndx, keyEq) = let
112 :     fun insert ({table, elems}, realKey, v) = let
113 :     val key = mkKey realKey
114 :     val arr = !table
115 :     val sz = Array.length arr
116 :     val indx = hash(keyIndx key, sz)
117 :     fun look NIL = (
118 :     Array.update(arr, indx, B(key, v, Array.sub(arr, indx)));
119 :     elems := !elems + 1)
120 :     | look (B(k, _, r)) = if keyEq(key, k) then () else look r
121 :     in
122 :     look (Array.sub (arr, indx))
123 :     end
124 :     in
125 :     insert
126 :     end
127 :    
128 :     fun mapRemove (mkKey, keyIndx, keyEq) = let
129 :     fun remove {table, elems} key = let
130 :     val key = mkKey key
131 :     fun look NIL = raise NotFound
132 :     | look (B(k, v, r)) = if keyEq(key, k)
133 :     then (v, r)
134 :     else let val (removedVal, rest) = look r
135 :     in
136 :     (removedVal, B(k, v, rest))
137 :     end
138 :     val arr = !table
139 :     val indx = hash (keyIndx key, Array.length arr)
140 :     val (removedVal, rest) = look (Array.sub(arr, indx))
141 :     in
142 :     Array.update (arr, indx, rest);
143 :     elems := !elems - 1;
144 :     removedVal
145 :     end
146 :     in
147 :     remove
148 :     end (* mapRemove *)
149 :    
150 :     fun mapList {table = ref tbl, elems} = let
151 :     fun f (_, l, 0) = l
152 :     | f (~1, l, _) = l
153 :     | f (i, l, n) = let
154 :     fun g (NIL, l, n) = f (i-1, l, n)
155 :     | g (B(_, x, r), l, n) = g(r, x::l, n-1)
156 :     in
157 :     g (Array.sub(tbl, i), l, n)
158 :     end
159 :     in
160 :     f ((Array.length tbl) - 1, [], !elems)
161 :     end (* list *)
162 :    
163 :     fun f o g = (fn x => f(g x)) (* for inlining *)
164 :    
165 :     fun intTblIndx i = i
166 :     val intTblEq = ((op =) : (int * int) -> bool)
167 :     val mkIntKey = intTblIndx
168 :    
169 :     fun nameTblIndx (i, _) = i
170 :     fun nameTblEq ((i1:int, s1:string), (i2, s2)) = ((i1 = i2) andalso (s1 = s2))
171 :     fun mkNameKey s = (hashString s, s)
172 :     in
173 :    
174 :     datatype 'a int_map_t = INT_MAP of ('a, int) map_t
175 :     datatype 'a name_map_t = NAME_MAP of ('a, (int * string)) map_t
176 :    
177 :     fun projIntMap (INT_MAP tbl) = tbl
178 :     fun projNameMap (NAME_MAP tbl) = tbl
179 :    
180 :     fun newIntMap () = INT_MAP(newMap())
181 :     fun newNameMap () = NAME_MAP(newMap())
182 :    
183 :     val insertInt = let
184 :     val insert = mapInsert (mkIntKey, intTblIndx, intTblEq)
185 :     fun doit (INT_MAP tbl) (key, v) = (
186 :     mapGrow(intTblIndx, tbl); insert (tbl, key, v))
187 :     in
188 :     doit
189 :     end
190 :     val insertName = let
191 :     val insert = mapInsert (mkNameKey, nameTblIndx, nameTblEq)
192 :     fun doit (NAME_MAP tbl) (key, v) = (
193 :     mapGrow(nameTblIndx, tbl); insert (tbl, key, v))
194 :     in
195 :     doit
196 :     end
197 :    
198 :     val removeInt = (mapRemove (mkIntKey, intTblIndx, intTblEq)) o projIntMap
199 :     val removeName = (mapRemove (mkNameKey, nameTblIndx, nameTblEq)) o projNameMap
200 :    
201 :     fun listInts (INT_MAP m) = mapList m
202 :     fun listNames (NAME_MAP m) = mapList m
203 :    
204 :     (** The find functions could also be generic, but they are the most used, so it
205 :     ** is good to make them fast (instead of trusting in the optimizer).
206 :     **)
207 :     fun findInt (INT_MAP{table, elems}) key = let
208 :     fun look NIL = raise NotFound
209 :     | look (B(i, v, rest)) = if (key <> i) then (look rest) else v
210 :     val arr = !table
211 :     in
212 :     look (Array.sub (arr, hash (key, Array.length arr)))
213 :     end (* find *)
214 :    
215 :     fun findName (NAME_MAP{table, elems}) key = let
216 :     val h = hashString key
217 :     fun look NIL = raise NotFound
218 :     | look (B((i, s), v, rest)) =
219 :     if ((h <> i) orelse (key <> s)) then (look rest) else v
220 :     val arr = !table
221 :     in
222 :     look (Array.sub (arr, hash (h, Array.length arr)))
223 :     end (* find *)
224 :    
225 :     end (* local *)
226 :     end (* structure HashUtil *)

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