X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Futils.ml;h=7e3bb4bb11d40a86829a70fce3f4378420627b36;hb=refs%2Fheads%2Fmaster;hp=4ea44cb854fd0d4b11ff528ced4df05e2be0e5e7;hpb=28e780c2b3b259a8696a44be932572b91f69583c;p=SXSI%2Fxpathcomp.git diff --git a/src/utils.ml b/src/utils.ml index 4ea44cb..7e3bb4b 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -48,32 +48,103 @@ struct Format.fprintf fmt "["; List.iter (fun k -> let v = Hashtbl.find h k in - Format.fprintf fmt "%s= %s " k v + Format.fprintf fmt "%s: %s " k v ) [ "VmStk"; "VmRSS"; "VmPeak" ]; Format.fprintf fmt "]" 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.start_msg fmt "[Stats] "; + Logger.msg fmt "%s %s:@\n @[[" sub msg; + begin + if len <= 1 then + Logger.msg fmt + "@\n\ +| Time: %fms@\n" + tmin + else + Logger.msg 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.msg fmt +"| Memory before: %a@\n\ +| Memory after: %a@\n]@]" + System.pr_mem_status memo + System.pr_mem_status memn; + Logger.end_msg fmt "\n\n" + + let time f ?(count=1) ?(msg="") x = - if not !Options.verbose then f 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; - Logger.verbose - Format.err_formatter - "%fms (before: %a, after: %a)@\n" t System.pr_mem_status oldmem System.pr_mem_status newmem; + 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