+ let equal (s1,s2) (t1,t2) = (s2 == t2) && Ptset.equal s1 t1
+ let hash = k_hash
+end
+
+module HTagSet =
+struct
+ type key = Ptset.t*Tag.t
+ let equal (s1,s2) (t1,t2) = (s2 == t2) && Ptset.equal s1 t1
+ let hash (s,t) = ((Ptset.hash s)) lsl 31 lxor (Tag.hash t)
+
+type 'a t =
+ { mutable size: int; (* number of elements *)
+ mutable data: (key,'a) bucketlist array } (* the buckets *)
+
+and ('a, 'b) bucketlist =
+ Empty
+ | Cons of 'a * 'b * ('a, 'b) bucketlist
+
+let create initial_size =
+ let s = min (max 1 initial_size) Sys.max_array_length in
+ { size = 0; data = Array.make s Empty }
+
+let clear h =
+ for i = 0 to Array.length h.data - 1 do
+ h.data.(i) <- Empty
+ done;
+ h.size <- 0
+
+let copy h =
+ { size = h.size;
+ data = Array.copy h.data }
+
+let length h = h.size
+
+let resize 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 = (hash 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
+
+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;
+ h.size <- succ h.size;
+ if h.size > Array.length h.data lsl 1 then resize h
+
+let remove h key =
+ let rec remove_bucket = function
+ Empty ->
+ Empty
+ | Cons(k, i, next) ->
+ if equal k key
+ then begin h.size <- pred h.size; next end
+ 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 rec find_rec key = function
+ Empty ->
+ raise Not_found
+ | Cons(k, d, rest) ->
+ if equal key k then d else find_rec key rest
+
+let find h key =
+ match h.data.((hash key) mod (Array.length h.data)) with
+ Empty -> raise Not_found
+ | Cons(k1, d1, rest1) ->
+ if equal key k1 then d1 else
+ match rest1 with
+ Empty -> raise Not_found
+ | Cons(k2, d2, rest2) ->
+ if equal key k2 then d2 else
+ match rest2 with
+ Empty -> raise Not_found
+ | Cons(k3, d3, rest3) ->
+ if equal key k3 then d3 else find_rec key rest3
+
+let find_all h key =
+ let rec find_in_bucket = function
+ Empty ->
+ []
+ | Cons(k, d, rest) ->
+ if equal 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 replace h key info =
+ let rec replace_bucket = function
+ Empty ->
+ raise Not_found
+ | Cons(k, i, next) ->
+ if equal k key
+ then Cons(k, info, next)
+ else Cons(k, i, replace_bucket next) in
+ let i = (hash key) mod (Array.length h.data) in
+ let l = h.data.(i) in
+ try
+ h.data.(i) <- replace_bucket l
+ with Not_found ->
+ h.data.(i) <- Cons(key, info, l);
+ h.size <- succ h.size;
+ if h.size > Array.length h.data lsl 1 then resize h
+
+let mem h key =
+ let rec mem_in_bucket = function
+ | Empty ->
+ false
+ | Cons(k, d, rest) ->
+ equal 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
+
+let fold f h init =
+ let rec do_bucket b accu =
+ match b with
+ Empty ->
+ accu
+ | Cons(k, d, rest) ->
+ do_bucket rest (f k d accu) in
+ let d = h.data in
+ let accu = ref init in
+ for i = 0 to Array.length d - 1 do
+ accu := do_bucket d.(i) !accu
+ done;
+ !accu
+
+