Adding a statistic function on hashconsing tables.

4 files changed, 40 insertions, 0 deletions

diff --git a/lib/hashcons.ml b/lib/hashcons.ml
index 752e2634a6..46ba0b6285 100644
--- a/lib/hashcons.ml
+++ b/lib/hashcons.ml
@@ -43,6 +43,7 @@ module type S =
     type table
     val generate : u -> table
     val hcons : table -> t -> t
+    val stats : table -> Hashset.statistics
   end
 
 module Make (X : HashconsedType) : (S with type t = X.t and type u = X.u) =
@@ -67,6 +68,8 @@ module Make (X : HashconsedType) : (S with type t = X.t and type u = X.u) =
       let y = X.hashcons u x in
       Htbl.repr (X.hash y) y tab
 
+    let stats (tab, _) = Htbl.stats tab
+
   end
 
 (* A few usefull wrappers:
diff --git a/lib/hashcons.mli b/lib/hashcons.mli
index 60a9ee01c1..8d0adc3fd6 100644
--- a/lib/hashcons.mli
+++ b/lib/hashcons.mli
@@ -56,6 +56,8 @@ module type S =
     (** This create a hashtable of the hashconsed objects. *)
     val hcons : table -> t -> t
     (** Perform the hashconsing of the given object within the table. *)
+    val stats : table -> Hashset.statistics
+    (** Recover statistics of the hashconsing table. *)
   end
 
 module Make (X : HashconsedType) : (S with type t = X.t and type u = X.u)
diff --git a/lib/hashset.ml b/lib/hashset.ml
index 6bec81c756..1ca6cc6418 100644
--- a/lib/hashset.ml
+++ b/lib/hashset.ml
@@ -19,12 +19,20 @@ module type EqType = sig
   val equal : t -> t -> bool
 end
 
+type statistics = {
+  num_bindings: int;
+  num_buckets: int;
+  max_bucket_length: int;
+  bucket_histogram: int array
+}
+
 module type S = sig
   type elt
   type t
   val create : int -> t
   val clear : t -> unit
   val repr : int -> elt -> t -> elt
+  val stats : t -> statistics
 end
 
 module Make (E : EqType) =
@@ -185,6 +193,24 @@ module Make (E : EqType) =
     let ifnotfound index = add_aux t Weak.set (Some d) h index; d in
     find_or h t d ifnotfound
 
+  let stats t =
+    let fold accu bucket = max (count_bucket 0 bucket 0) accu in
+    let max_length = Array.fold_left fold 0 t.table in
+    let histogram = Array.make (max_length + 1) 0 in
+    let iter bucket =
+      let len = count_bucket 0 bucket 0 in
+      histogram.(len) <- succ histogram.(len)
+    in
+    let () = Array.iter iter t.table in
+    let fold (num, len, i) k = (num + k * i, len + k, succ i) in
+    let (num, len, _) = Array.fold_left fold (0, 0, 0) histogram in
+    {
+      num_bindings = num;
+      num_buckets = len;
+      max_bucket_length = Array.length histogram;
+      bucket_histogram = histogram;
+    }
+
 end
 
 module Combine = struct
diff --git a/lib/hashset.mli b/lib/hashset.mli
index 537f3418e4..a455eec662 100644
--- a/lib/hashset.mli
+++ b/lib/hashset.mli
@@ -19,6 +19,13 @@ module type EqType = sig
   val equal : t -> t -> bool
 end
 
+type statistics = {
+  num_bindings: int;
+  num_buckets: int;
+  max_bucket_length: int;
+  bucket_histogram: int array
+}
+
 module type S = sig
   type elt
   (** Type of hashsets elements. *)
@@ -34,6 +41,8 @@ module type S = sig
       specific representation that is stored in [set]. Otherwise,
       [constr] is stored in [set] and will be used as the canonical
       representation of this value in the future. *)
+  val stats : t -> statistics
+  (** Recover statistics on the table. *)
 end
 
 module Make (E : EqType) : S with type elt = E.t