INCLUDE "utils.ml"
module type SA =
  sig
    type data
    type t
    val make : data -> t
    val node : t -> data
    val hash : t -> int
    val uid : t -> Uid.t
    val equal : t -> t -> bool
    val stats : unit -> unit
 end

module type S =
  sig

    type data
    type t = private { id : Uid.t;
		       key : int;
		       node : data }
    val make : data -> t
    val node : t -> data
    val hash : t -> int
    val uid : t -> Uid.t
    val equal : t -> t -> bool
    val stats : unit -> unit
  end

module Make (H : Hashtbl.HashedType) : S with type data = H.t =
struct
  let uid_make,uid_current,uid_set = Uid.make_maker()
  type data = H.t
  type t = { id : Uid.t;
	     key : int;
	     node : data }
  let node t = t.node
  let uid t = t.id
  let hash t = t.key
  let equal t1 t2 = t1 == t2
  module WH = Weak.Make( struct
			   type _t = t
			   type t = _t
			   let hash = hash
			   let equal a b = a == b || H.equal a.node b.node
			 end)
  let pool = WH.create MED_H_SIZE

  exception Found of Uid.t

  let first_free_id () =
    let mx = Uid.to_int (uid_current()) + 1 in
    let a = Array.create mx Uid.dummy in
      WH.iter (fun cell -> a.(Uid.to_int cell.id) <- (Uid.of_int 0)) pool;
      try
	for i = 0 to mx - 1 do
	  if a.(i) == Uid.dummy then raise (Found (Uid.of_int i));
	done;
	uid_make()
      with
	  Found i -> i


  let make x =
    let cell = { id = Uid.dummy; key = H.hash x; node = x } in
      try
	WH.find pool cell
      with
	| Not_found ->
	    let cell = { id = uid_make(); key = H.hash x; node = x } in
	      WH.add pool cell;cell

  exception Found of t

  let stats () =
    Printf.eprintf "Hconsing statistics";
    let l = WH.fold (fun cell acc -> (Uid.to_int cell.id)::acc) pool [] in
    let l = List.sort compare l in
    List.iter (fun id -> Printf.eprintf "%i\n" id) l
end