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
+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
+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
+ 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 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)
+ 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
- WH.add pool cell;cell
+ 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 () =
- let l = WH.fold (fun cell acc -> (Uid.to_int cell.id)::acc) pool [] in
+ 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
+ (fun ppf l ->
+ Pretty.pp_print_list ~sep:Format.pp_force_newline Format.pp_print_int ppf l) l *)
end