X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fhcons.ml;h=daa62a0041e5e273d9872b9e061d5a74ada6c3ef;hb=35b9abd60699383b0cebf25e905049d3d7027271;hp=5a7ad1438df90ea1c2d565e8457e466a61b3cf5e;hpb=689b47b109dc54a78008f589f2c55f98672ab61d;p=SXSI%2Fxpathcomp.git

diff --git a/src/hcons.ml b/src/hcons.ml
index 5a7ad14..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,30 +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 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