X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fhcons.ml;h=daa62a0041e5e273d9872b9e061d5a74ada6c3ef;hb=798507d52a5c11a6d852740056464241538fe76a;hp=c0c62e7edde769119f45f5d93f5546724da22d97;hpb=4b52da1a20a4fe031930bb96d2ca46bec06dc529;p=SXSI%2Fxpathcomp.git diff --git a/src/hcons.ml b/src/hcons.ml index c0c62e7..daa62a0 100644 --- a/src/hcons.ml +++ b/src/hcons.ml @@ -1,30 +1,32 @@ 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 @@ -38,42 +40,42 @@ 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 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 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 = { id = uid_make(); key = H.hash x; node = x } 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 () = - Printf.eprintf "Hconsing statistics"; - 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 - List.iter (fun id -> Printf.eprintf "%i\n" id) l + 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