X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Futils.ml;h=0efe748ef208147fb23dddcfa6e34cbbb8d35c4b;hb=96e2e786eb8c229d9aa4676a7067fd2f0d2e4da9;hp=8cab636c13c5b9738641792730983e2c9e761d89;hpb=1e6a2cc1fe6d69d45a4605aaf2ee6821a610a231;p=SXSI%2Fxpathcomp.git

diff --git a/src/utils.ml b/src/utils.ml
index 8cab636..0efe748 100644
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -54,27 +54,95 @@ struct
 
 end
 
+module Timing =
+  struct
+    let _timings = Hashtbl.create 43
+    let _t_queue = Queue.create ()
+
+    let get_timing s =
+      try
+        Hashtbl.find _timings s
+      with
+        Not_found -> []
+
+    let set_timing s v =
+      Hashtbl.replace _timings s v
+
+
+    let display_result fmt msg sub l =
+      let h = Hashtbl.create 0 in
+      let tmin, tmax, ttotal, len, memo, memn =
+        List.fold_left (fun
+        (atmin, atmax, attotal, alen, _, _)
+        (t, om, nm) ->
+          (min t atmin,
+           max atmax t,
+           attotal +. t,
+           alen + 1,
+           om, nm))
+          (infinity, 0., 0., 0, h, h) l
+      in
+      Logger.verbose fmt "@[%s%s: @[<v 0>[" sub msg;
+      begin
+        if len <= 1 then
+        Logger.verbose fmt
+          "@\n\
+| Time        :   %fms@\n"
+          tmin
+      else
+        Logger.verbose fmt
+          "@\n\
+| Number of runs: %i@\n\
+| Average time:   %fms@\n\
+| Minimum time:   %fms@\n\
+| Maximum time:   %fms@\n"
+          len
+          (ttotal /. (float_of_int len))
+          tmin
+          tmax
+
+      end;
+      Logger.verbose fmt
+"| Memory before:  %a@\n\
+| Memory after:   %a@\n]@]@]@\n@?"
+        System.pr_mem_status memo
+        System.pr_mem_status memn
+
+
 let time f ?(count=1) ?(msg="") x =
   if not !Config.verbose then f x
   else
   let rec loop i =
-    Gc.compact();
     let oldmem = System.status () in
     let t1 = Unix.gettimeofday () in
+    set_timing msg ((t1, oldmem, oldmem)::(get_timing msg));
     let r = f x in
     let t2 = Unix.gettimeofday () in
     let newmem = System.status () in
+    let t1, oldmem, l =
+      match get_timing msg with
+        (a, b, _) :: l -> a,b,l
+      | _ -> assert false
+    in
     let t = (1000. *. (t2 -. t1)) in
-    Logger.verbose Format.err_formatter "@[%s: [" msg;
-    if (count != 1) then Logger.verbose Format.err_formatter "run %i/%i,  "  i count;
-    begin
-      Format.pp_open_vbox Format.err_formatter (2 + String.length msg);
-      Logger.verbose
-        Format.err_formatter
-        "@\n| Time: %fms@\n| Memory before: %a@\n| Memory after:  %a@\n]@]@]@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem;
-    end;
+    set_timing msg ((t, oldmem, newmem)::l);
     if i >= count then r
     else loop (i+1)
   in
-  loop 1
-;;
+  Queue.push msg _t_queue;
+  let r = loop 1 in
+  begin
+    if (Queue.peek _t_queue) = msg then
+    let pr_stack = Queue.fold (fun a e -> e::a)  [] _t_queue in
+    Queue.clear _t_queue;
+    List.iter (fun msg' ->
+      let sub =
+        if msg' <> msg then "> " else "= "
+      in
+      display_result Format.err_formatter msg' sub (get_timing msg')) pr_stack;
+  end;
+  r
+
+
+  end
+let time = Timing.time