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
  val init : 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
  val init : 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 total_count = ref 0
  let miss_count = ref 0
  let init () =
    total_count := 0;
    miss_count := 0

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

  exception Found of t

  let stats () =
    Logger.print Format.err_formatter "Hconsing statistics: %i/%i = %f@\n"
      !miss_count
      !total_count
      ((float_of_int !miss_count) /. (float_of_int !total_count))
(*    let l = WH.fold (fun cell acc -> (Uid.to_int cell.id)::acc) pool [] in
    let l = List.sort compare l in
    Logger.print Format.err_formatter "Hconsing statistics:@\n%a"
      (fun ppf l ->
        Pretty.pp_print_list ~sep:Format.pp_force_newline Format.pp_print_int ppf l) l *)
end