WIP on beautyfying the pretty-printing module.

[SXSI/xpathcomp.git] / src / utils.ml

diff --git a/src/utils.ml b/src/utils.ml
index c5547aa..4ea44cb 100644 (file)
--- a/src/utils.ml
+++ b/src/utils.ml
@@ -22,3 +22,58 @@ struct
     loop 0
 end
 ;;
+
+module System =
+struct
+  let status () =
+    let pid = Unix.getpid() in
+    let cin = open_in (Printf.sprintf "/proc/%i/status" pid) in
+    let h = Hashtbl.create 17 in
+    try
+      while true do
+        let s = input_line cin in
+        Scanf.sscanf s "%s@: %s@\n" (fun k v ->
+          Hashtbl.replace h k v)
+      done;
+      (* never reached *)
+      h
+    with
+      End_of_file -> begin
+        close_in cin;
+        h
+      end
+  let get_status s = Hashtbl.find (status()) s
+
+  let pr_mem_status fmt h =
+    Format.fprintf fmt "[";
+    List.iter (fun k ->
+      let v = Hashtbl.find h k in
+      Format.fprintf fmt "%s= %s " k v
+    ) [ "VmStk"; "VmRSS"; "VmPeak" ];
+    Format.fprintf fmt "]"
+
+end
+(*
+let time f ?(count=1) ?(msg="") x =
+  if not !Options.verbose then f x
+  else
+  let rec loop i =
+    Gc.compact();
+    let oldmem = System.status () in
+    let t1 = Unix.gettimeofday () in
+    let r = f x in
+    let t2 = Unix.gettimeofday () in
+    let newmem = System.status () 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;
+    Logger.verbose
+      Format.err_formatter
+      "%fms (before: %a, after: %a)@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem;
+    if i >= count then r
+    else loop (i+1)
+  in
+  loop 1
+  
+;;
+*)