[r2005-06-18 06:32:41 by afrisch] Pool of hashed value with no collision

Original author: afrisch
Date: 2005-06-18 06:32:41+00:00

misc/upool.ml

+type 'a typed_int = int
+external int: 'a typed_int -> int = "%identity"
+
+module type S = sig
+  type token
+  type value
+  type t = token typed_int
+  exception Not_unique of value * value
+
+  val dummy: t
+  val mk: value -> t
+  val get: t -> value
+  val compare: t -> t -> int
+  val hash: t -> int
+  val equal: t -> t -> bool
+
+  val extract: unit -> value list
+  val intract: value list -> unit
+end
+
+module HInt = Hashtbl.Make(struct type t = int
+				  let hash x = x
+				  let equal x y = x==y end)
+
+module Make(X : Hashtbl.HashedType) = struct
+  type token
+  type value = X.t
+  type t = token typed_int
+
+  exception Not_unique of value * value
+  let compare (x:int) y = if (x=y) then 0 else if (x < y) then (-1) else 1
+  let hash x = x
+  let equal x y = x==y
+
+  let pool = HInt.create 1024
+  let dummy = max_int
+
+  let mk v =
+    let h = X.hash v in
+    if (h == dummy) then raise (Not_unique (v,v));
+    (try 
+       let v' = HInt.find pool h in 
+       if not (X.equal v v') then raise (Not_unique (v,v'));
+     with Not_found -> HInt.add pool h v);
+    h
+
+  let get h = 
+    assert (h != dummy);
+    HInt.find pool h
+
+  let extract () = HInt.fold (fun _ v accu -> v::accu) pool []
+  let intract = List.iter (fun v -> ignore (mk v))
+end

misc/upool.mli

+type 'a typed_int
+external int: 'a typed_int -> int = "%identity"
+
+module type S = sig
+  type token
+  type value
+  type t = token typed_int
+  exception Not_unique of value * value
+
+  val dummy: t
+  val mk: value -> t
+  val get: t -> value
+  val compare: t -> t -> int
+  val hash: t -> int
+  val equal: t -> t -> bool
+
+  val extract: unit -> value list
+  val intract: value list -> unit
+end
+
+module Make(X : Hashtbl.HashedType) : S with type value = X.t