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

Annotation of /sml/trunk/src/MLRISC/library/hashMap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 245 - (view) (download)
Original Path: sml/branches/SMLNJ/src/MLRISC/library/hashMap.sml

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

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