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/branches/SMLNJ/src/MLRISC/library/hashMap.sml
ViewVC logotype

Annotation of /sml/branches/SMLNJ/src/MLRISC/library/hashMap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 411 - (view) (download)

1 : monnier 411 (*
2 :     * map datatype that uses hashing.
3 :     *
4 :     * -- allen
5 :     *)
6 :    
7 : monnier 245 structure HashMap :> HASH_MAP =
8 :     struct
9 :    
10 :     structure A = Array
11 :    
12 :     datatype 'a tree = NODE of 'a * 'a tree * 'a tree | EMPTY
13 :    
14 :     datatype ('a,'b) map =
15 :     MAP of
16 :     { table : ('a * 'b) tree Array.array ref,
17 :     size : int ref,
18 :     order : 'a * 'a -> order,
19 :     hash : 'a -> int,
20 :     exn : exn
21 :     }
22 :    
23 :     fun create { order, hash, exn } N =
24 :     let val N = if N <= 10 then 10 else N
25 :     in
26 :     MAP { table = ref(Array.array(N,EMPTY)),
27 :     size = ref 0,
28 :     order = order,
29 :     hash = hash,
30 :     exn = exn
31 :     }
32 :     end
33 :    
34 :     fun size (MAP { size, ... }) = !size
35 :    
36 :     fun bucketSize (MAP { table, ... }) = Array.length (!table)
37 :    
38 :     fun isEmpty (MAP { size, ... }) = !size = 0
39 :    
40 :     fun clear (MAP { size, table, ... }) =
41 :     (table := A.array(A.length(!table),EMPTY); size := 0)
42 :    
43 :     and insert (m as MAP { size, table = ref T, order, hash, exn,...})
44 :     (e as (x,y)) =
45 :     let val pos = hash x mod A.length T
46 :     fun ins EMPTY = (size := !size + 1; NODE(e,EMPTY,EMPTY))
47 :     | ins (NODE(e' as (x',y'),l,r)) =
48 :     case order(x,x') of
49 :     LESS => NODE(e',ins l,r)
50 :     | EQUAL => NODE(e,l,r)
51 :     | GREATER => NODE(e',l,ins r)
52 :     in A.update(T,pos,ins(A.sub(T,pos)));
53 :     if !size > 6 * A.length T then
54 :     grow m
55 :     else ()
56 :     end
57 :    
58 :     and grow (MAP { size, table = table as ref T, order, hash, exn, ... }) =
59 :     let val m2 as
60 :     MAP{table = ref T',...} = create{ order=order, hash=hash, exn=exn }
61 :     (!size * 2 + 10) (* : ('a,'b) map *)
62 :     val ins = insert m2
63 :     fun loop EMPTY = ()
64 :     | loop (NODE(e,l,r)) = (ins e; loop l; loop r)
65 :     in A.app loop T; table := T'
66 :     end
67 :    
68 :     and update (m as MAP { size, table = ref T, order, hash, exn,...})
69 :     (e as (x,y), f) =
70 :     let val pos = hash x mod A.length T
71 :     fun ins EMPTY = (size := !size + 1; NODE(e,EMPTY,EMPTY))
72 :     | ins (NODE(e' as (x',y'),l,r)) =
73 :     case order(x,x') of
74 :     LESS => NODE(e',ins l,r)
75 :     | EQUAL => NODE((x',f y'),l,r)
76 :     | GREATER => NODE(e',l,ins r)
77 :     in A.update(T,pos,ins(A.sub(T,pos)));
78 :     if !size > 6 * A.length T then
79 :     grow m
80 :     else ()
81 :     end
82 :    
83 :     fun remove (MAP { size, table = ref T, order, hash, exn,...}) x =
84 :     let val pos = hash x mod A.length T
85 :     fun del EMPTY = EMPTY
86 :     | del (NODE(e' as (x',_),l,r)) =
87 :     case order(x,x') of
88 :     LESS => NODE(e',del l,r)
89 :     | EQUAL => (size := !size - 1;
90 :     case (l,r) of
91 :     (EMPTY,r) => r
92 :     | (l,EMPTY) => l
93 :     | _ => let val (leftmost,r') = delLeftMost r
94 :     in NODE(leftmost,l,r')
95 :     end
96 :     )
97 :     | GREATER => NODE(e',l,del r)
98 :     and delLeftMost EMPTY = raise exn
99 :     | delLeftMost (NODE(e,EMPTY,r)) = (e,r)
100 :     | delLeftMost (NODE(e,l,r)) =
101 :     let val (e',r') = delLeftMost r
102 :     in (e',NODE(e,l,r'))
103 :     end
104 :    
105 :     in A.update(T,pos,del(A.sub(T,pos)))
106 :     end
107 :    
108 :     fun lookup (MAP { table = ref T, order, hash, exn, ... }) x =
109 :     let val pos = hash x mod A.length T
110 :     fun look EMPTY = raise exn
111 :     | look (NODE(e' as (x',y'),l,r)) =
112 :     case order(x,x') of
113 :     LESS => look l
114 :     | EQUAL => y'
115 :     | GREATER => look r
116 :     in look (A.sub(T,pos))
117 :     end
118 :    
119 :     fun lookupOrElse m default x = lookup m x handle _ => default
120 :    
121 :     fun contains (MAP { table = ref T, order, hash, ... }) x =
122 :     let val pos = hash x mod A.length T
123 :     fun find EMPTY = false
124 :     | find (NODE(e' as (x',y'),l,r)) =
125 :     case order(x,x') of
126 :     LESS => find l
127 :     | EQUAL => true
128 :     | GREATER => find r
129 :     in find(A.sub(T,pos))
130 :     end
131 :    
132 :     fun fold f x =
133 :     fn (MAP { table = ref T, ... }) =>
134 :     let fun collect (EMPTY,L) = L
135 :     | collect (NODE(e,l,r),L) = collect(l,collect(r,f(e,L)))
136 :     in A.foldl (fn (t,l) => collect(t,l)) x T
137 :     end
138 :    
139 :     fun app f =
140 :     fn (MAP { table = ref T, ... }) =>
141 :     let fun appTree EMPTY = ()
142 :     | appTree (NODE(e,l,r)) = (f e; appTree l; appTree r)
143 :     in A.app appTree T
144 :     end
145 :    
146 :     fun toList map = fold (op::) [] map
147 :    
148 :     fun toString (f,g) map =
149 :     "{" ^ fold (fn ((x,y),"") => "(" ^ f x ^ ", " ^ g y ^ ")"
150 :     | ((x,y),l) => "(" ^ f x ^ ", " ^ g y ^ "), " ^ l
151 :     ) "" map ^ "}"
152 :    
153 :     end
154 :    

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