From b146572b9707292dbc1eacf5fb67d84271cafbba Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Mon, 22 Oct 2012 17:56:30 +0200 Subject: [PATCH] Change the structure of log messages. Add a new Logger.start_msg/Logger.msg/Logger.end_msg to have more controle about box/opening/closing. --- src/ata.ml | 4 ++-- src/logger.ml | 10 +++++++++- src/logger.mli | 4 ++++ src/main.ml | 21 +++++++++++++++------ src/profile.ml | 7 +++++-- src/runtime.ml | 11 +++++++++-- src/utils.ml | 18 ++++++++++-------- 7 files changed, 54 insertions(+), 21 deletions(-) diff --git a/src/ata.ml b/src/ata.ml index 591fab1..272e8e0 100644 --- a/src/ata.ml +++ b/src/ata.ml @@ -19,7 +19,7 @@ type t = { let print ppf a = fprintf ppf - "Automaton (%i) :@\n\ + "Unique ID: %i@\n\ States %a@\n\ Initial states: %a@\n\ Marking states: %a@\n\ @@ -48,7 +48,7 @@ let print ppf a = let sline = Pretty.line (Pretty.length line) in fprintf ppf "%s@\n" sline; List.iter (fun s -> fprintf ppf "%s@\n" s) strings; - fprintf ppf "%s@\n" sline + fprintf ppf "%s" sline type jump_kind = diff --git a/src/logger.ml b/src/logger.ml index 2f6e6c7..05fbc83 100644 --- a/src/logger.ml +++ b/src/logger.ml @@ -44,7 +44,15 @@ let print ppf fmt = let _verbose = ref false let set_verbose b = _verbose := b -let verbose ppf fmt = +let msg ppf fmt = if !_verbose then fprintf ppf fmt else ifprintf ppf fmt + +let start_msg ppf s = + msg ppf "@[%s" s + +let end_msg ppf s = + msg ppf "@]%s@?" s + +let verbose a b = msg a b diff --git a/src/logger.mli b/src/logger.mli index 1ee96d5..15b28e9 100644 --- a/src/logger.mli +++ b/src/logger.mli @@ -13,3 +13,7 @@ val available : unit -> string list val set_verbose : bool -> unit val verbose : Format.formatter -> ('a, Format.formatter, unit) format -> 'a + +val start_msg : Format.formatter -> string -> unit +val end_msg : Format.formatter -> string -> unit +val msg : Format.formatter -> ('a, Format.formatter, unit) format -> 'a diff --git a/src/main.ml b/src/main.ml index 909a0b8..69bd091 100644 --- a/src/main.ml +++ b/src/main.ml @@ -24,7 +24,9 @@ let mk_runtime run auto doc arg count print outfile = if !Config.do_perf then start_perf (); let r = Utils.time ~count:!Config.repeat ~msg:"Execution time" (run auto doc) arg in if !Config.do_perf then stop_perf (); - Logger.verbose Format.err_formatter "Number of results: %i@\n" (count r); + Logger.start_msg Format.err_formatter "[Debug] Number of results: "; + Logger.msg Format.err_formatter "%i" (count r); + Logger.end_msg Format.err_formatter "\n"; match outfile with None -> () | Some file -> @@ -37,12 +39,17 @@ let main v query_string output = let query = Utils.time ~msg:"Parsing query" XPath.parse query_string in - Logger.verbose Format.err_formatter "Parsed query:%a@\n" - XPath.Ast.print query; + Logger.start_msg Format.err_formatter "[Debug]"; + Logger.msg Format.err_formatter " Parsed query: @\n @[ {"; + Logger.msg Format.err_formatter " %a }@]" XPath.Ast.print query; + Logger.end_msg Format.err_formatter "\n\n"; let auto, bu_info = Utils.time ~msg:"Compiling query" Compile.compile query in - if !Config.verbose then Ata.print Format.err_formatter auto; + Logger.start_msg Format.err_formatter "[Debug] Automaton: "; + Logger.msg Format.err_formatter "@\n @["; + Logger.msg Format.err_formatter "%a" Ata.print auto; + Logger.end_msg Format.err_formatter "\n\n"; Gc.full_major(); Gc.compact(); Gc.set (tuned_gc); @@ -111,9 +118,11 @@ let _ = v in main document !Config.query !Config.output_file; - Logger.verbose Format.err_formatter "Maximum resident set size: %s @\n" (read_procmem()); - Gc.full_major(); +IFDEF PROFILE + THEN Profile.summary Format.err_formatter + ELSE () +END with | Ulexer.Loc.Exc_located ((x,y),e) -> Logger.print Format.err_formatter "character %i-%i %s@\n" x y (Printexc.to_string e); diff --git a/src/profile.ml b/src/profile.ml index c43dda6..a0be76b 100644 --- a/src/profile.ml +++ b/src/profile.ml @@ -1,11 +1,14 @@ let table = Hashtbl.create 103 let summary fmt = + Logger.start_msg fmt "[Stats] Function profiling:"; + Logger.msg fmt "@\n @["; Hashtbl.iter (fun (m, f) d -> let c, tl = !d in let tspent = List.fold_left (fun acc e -> e +. acc) 0. tl in - Format.fprintf fmt "%s: %s = called %i times, total: %fms, average: %fms\n" + Logger.msg fmt "%s: %s = called %i times, total: %fms, average: %fms@\n" m f c tspent (tspent /. (float_of_int c))) table; - Format.fprintf fmt "%!" + Logger.end_msg Format.err_formatter "\n\n" + diff --git a/src/runtime.ml b/src/runtime.ml index 7d1e79f..669fb4a 100644 --- a/src/runtime.ml +++ b/src/runtime.ml @@ -73,10 +73,17 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t = let show_stats a = let count = ref 0 in Cache.Lvl3.iteri (fun _ _ _ _ b -> if not b then incr count) a; - Logger.print err_formatter "@?L3JIT: %i used entries@\n@?" !count + Logger.start_msg err_formatter "[Debug] L3JIT used: "; + Logger.msg err_formatter "%i enttries" !count; + Logger.end_msg err_formatter "\n\n" + + let _has_exit = ref false let create () = let v = Cache.Lvl3.create 1024 dummy in - if !Config.verbose then at_exit (fun () -> show_stats v); + if !Config.verbose && not !_has_exit then begin + _has_exit := true; + at_exit (fun () -> show_stats v); + end; v let find t tlist s1 s2 = diff --git a/src/utils.ml b/src/utils.ml index 0efe748..7e3bb4b 100644 --- a/src/utils.ml +++ b/src/utils.ml @@ -82,15 +82,16 @@ module Timing = om, nm)) (infinity, 0., 0., 0, h, h) l in - Logger.verbose fmt "@[%s%s: @[[" sub msg; + Logger.start_msg fmt "[Stats] "; + Logger.msg fmt "%s %s:@\n @[[" sub msg; begin if len <= 1 then - Logger.verbose fmt + Logger.msg fmt "@\n\ -| Time : %fms@\n" +| Time: %fms@\n" tmin else - Logger.verbose fmt + Logger.msg fmt "@\n\ | Number of runs: %i@\n\ | Average time: %fms@\n\ @@ -102,11 +103,12 @@ module Timing = tmax end; - Logger.verbose fmt + Logger.msg fmt "| Memory before: %a@\n\ -| Memory after: %a@\n]@]@]@\n@?" +| Memory after: %a@\n]@]" System.pr_mem_status memo - System.pr_mem_status memn + System.pr_mem_status memn; + Logger.end_msg fmt "\n\n" let time f ?(count=1) ?(msg="") x = @@ -137,7 +139,7 @@ let time f ?(count=1) ?(msg="") x = Queue.clear _t_queue; List.iter (fun msg' -> let sub = - if msg' <> msg then "> " else "= " + if msg' <> msg then "+" else "=" in display_result Format.err_formatter msg' sub (get_timing msg')) pr_stack; end; -- 2.17.1