(***********************************************************************) (* *) (* 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 = 2 * osize + 1 in 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; 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