1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* en Automatique. All rights reserved. This file is distributed *)
(* under the terms of the GNU Library General Public License. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* Hash tables *)
external hash_param : int -> int -> 'a -> int = "hash_univ_param" "noalloc"
let hash x = hash_param 10 100 x
(* We do dynamic hashing, and resize the table and rehash the elements
when buckets become too long. *)
type ('a, 'b) t =
{ mutable max_len: int; (* max length of a bucket *)
mutable data: ('a, 'b) bucketlist array } (* the buckets *)
and ('a, 'b) bucketlist =
Empty
| Cons of 'a * 'b * ('a, 'b) bucketlist
let create initial_size =
let s = if initial_size < 1 then 1 else initial_size in
let s = if s > Sys.max_array_length then Sys.max_array_length else s in
{ max_len = 3; data = Array.make s Empty }
let clear h =
for i = 0 to Array.length h.data - 1 do
h.data.(i) <- Empty
done
let resize hashfun tbl =
let odata = tbl.data in
let osize = Array.length odata in
let nsize = min (2 * osize + 1) Sys.max_array_length in
if nsize <> osize then begin
let ndata = Array.create nsize Empty in
let rec insert_bucket = function
Empty -> ()
| Cons(key, data, rest) ->
insert_bucket rest; (* preserve original order of elements *)
let nidx = (hashfun key) mod nsize in
ndata.(nidx) <- Cons(key, data, ndata.(nidx)) in
for i = 0 to osize - 1 do
insert_bucket odata.(i)
done;
tbl.data <- ndata;
end;
tbl.max_len <- 2 * tbl.max_len
let rec bucket_too_long n bucket =
if n < 0 then true else
match bucket with
Empty -> false
| Cons(_,_,rest) -> bucket_too_long (n - 1) rest
let add h key info =
let i = (hash key) mod (Array.length h.data) in
let bucket = Cons(key, info, h.data.(i)) in
h.data.(i) <- bucket;
if bucket_too_long h.max_len bucket then resize hash h
let remove h key =
let rec remove_bucket = function
Empty ->
Empty
| Cons(k, i, next) ->
if k = key then next else Cons(k, i, remove_bucket next) in
let i = (hash key) mod (Array.length h.data) in
h.data.(i) <- remove_bucket h.data.(i)
let find h key =
match h.data.((hash key) mod (Array.length h.data)) with
Empty -> raise Not_found
| Cons(k1, d1, rest1) ->
if key = k1 then d1 else
match rest1 with
Empty -> raise Not_found
| Cons(k2, d2, rest2) ->
if key = k2 then d2 else
match rest2 with
Empty -> raise Not_found
| Cons(k3, d3, rest3) ->
if key = k3 then d3 else begin
let rec find = function
Empty ->
raise Not_found
| Cons(k, d, rest) ->
if key = k then d else find rest
in find rest3
end
let find_all h key =
let rec find_in_bucket = function
Empty ->
[]
| Cons(k, d, rest) ->
if k = key then d :: find_in_bucket rest else find_in_bucket rest in
find_in_bucket h.data.((hash key) mod (Array.length h.data))
let mem h key =
let rec mem_in_bucket = function
| Empty ->
false
| Cons(k, d, rest) ->
k = key || mem_in_bucket rest in
mem_in_bucket h.data.((hash key) mod (Array.length h.data))
let iter f h =
let rec do_bucket = function
Empty ->
()
| Cons(k, d, rest) ->
f k d; do_bucket rest in
let d = h.data in
for i = 0 to Array.length d - 1 do
do_bucket d.(i)
done
(* Functorial interface *)
module type HashedType =
sig
type t
val equal: t -> t -> bool
val hash: t -> int
end
module type S =
sig
type key
type 'a t
val create: int -> 'a t
val clear: 'a t -> unit
val add: 'a t -> key -> 'a -> unit
val remove: 'a t -> key -> unit
val find: 'a t -> key -> 'a
val find_all: 'a t -> key -> 'a list
val mem : 'a t -> key -> bool
val iter: (key -> 'a -> unit) -> 'a t -> unit
end
module Make(H: HashedType): (S with type key = H.t) =
struct
type key = H.t
type 'a hashtbl = (key, 'a) t
type 'a t = 'a hashtbl
let create = create
let clear = clear
let add h key info =
let i = (H.hash key) mod (Array.length h.data) in
let bucket = Cons(key, info, h.data.(i)) in
h.data.(i) <- bucket;
if bucket_too_long h.max_len bucket then resize H.hash h
let remove h key =
let rec remove_bucket = function
Empty ->
Empty
| Cons(k, i, next) ->
if H.equal k key
then next
else Cons(k, i, remove_bucket next) in
let i = (H.hash key) mod (Array.length h.data) in
h.data.(i) <- remove_bucket h.data.(i)
let find h key =
match h.data.((H.hash key) mod (Array.length h.data)) with
Empty -> raise Not_found
| Cons(k1, d1, rest1) ->
if H.equal key k1 then d1 else
match rest1 with
Empty -> raise Not_found
| Cons(k2, d2, rest2) ->
if H.equal key k2 then d2 else
match rest2 with
Empty -> raise Not_found
| Cons(k3, d3, rest3) ->
if H.equal key k3 then d3 else begin
let rec find = function
Empty ->
raise Not_found
| Cons(k, d, rest) ->
if H.equal key k then d else find rest
in find rest3
end
let find_all h key =
let rec find_in_bucket = function
Empty ->
[]
| Cons(k, d, rest) ->
if H.equal k key
then d :: find_in_bucket rest
else find_in_bucket rest in
find_in_bucket h.data.((H.hash key) mod (Array.length h.data))
let mem h key =
let rec mem_in_bucket = function
| Empty ->
false
| Cons(k, d, rest) ->
H.equal k key || mem_in_bucket rest in
mem_in_bucket h.data.((H.hash key) mod (Array.length h.data))
let iter = iter
end
|
