From e55eb5e1ceafa840dc1d137d7fae5fb06eac3875 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Fri, 19 Oct 2012 20:20:52 +0200 Subject: [PATCH] Completely silences the output unless -v is given. --- include/utils.ml | 15 ++++++++------- src/l2JIT.ml | 2 +- src/logger.ml | 19 ++++++++++++++++++- src/logger.mli | 2 ++ src/main.ml | 13 +++++-------- src/options.ml | 3 ++- src/tree.ml | 17 ++++++----------- 7 files changed, 42 insertions(+), 29 deletions(-) diff --git a/include/utils.ml b/include/utils.ml index a8c865e..4a844f4 100644 --- a/include/utils.ml +++ b/include/utils.ml @@ -64,9 +64,9 @@ let time_mem f x = let t2 = Unix.gettimeofday () in let t = (1000. *. (t2 -. t1)) in l:= t::!l; - Logger.print Format.err_formatter " %fms@\n%!" t ; - Logger.print Format.err_formatter "Mem use before: %s@\n%!" s1; - Logger.print Format.err_formatter "Final Mem: %s@\n@\n@\n%!" s2; + Logger.verbose Format.err_formatter " %fms@\n%!" t ; + Logger.verbose Format.err_formatter "Mem use before: %s@\n%!" s1; + Logger.verbose Format.err_formatter "Final Mem: %s@\n@\n@\n%!" s2; r ;; @@ -103,6 +103,8 @@ let stop_perf () = Unix.kill !pid Sys.sigint let time f ?(count=1) ?(msg="") x = + if not !Options.verbose then f x + else let rec loop i = Gc.compact(); let oldstack = read_procmem () in @@ -110,14 +112,13 @@ let time f ?(count=1) ?(msg="") x = let r = f x in let t2 = Unix.gettimeofday () in let t = (1000. *. (t2 -. t1)) in - Logger.print Format.err_formatter "%s: " msg; - if (count != 1) then Logger.print Format.err_formatter "run %i/%i, " i count; - Logger.print Format.err_formatter "%fms (stack size: before=%s, after=%s)@\n" t oldstack (read_procmem()); + 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 (stack size: before=%s, after=%s)@\n" t oldstack (read_procmem()); if i >= count then (l:= t::!l;r) else loop (i+1) in let r = loop 1 in - (*Logger.print Format.err_formatter "@\n"; *) r ;; let total_time () = List.fold_left (+.) 0. !l;; diff --git a/src/l2JIT.ml b/src/l2JIT.ml index a1f1ac4..8e623e0 100644 --- a/src/l2JIT.ml +++ b/src/l2JIT.ml @@ -208,7 +208,7 @@ let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s = | _ -> assert false let count = ref 0 -let () = at_exit (fun () -> Printf.eprintf "Compute jump called %i times\n" !count) +let () = at_exit (fun () -> Logger.verbose Format.err_formatter "Compute jump called %i times\n" !count) module Memo = Hashtbl.Make(struct type t = Tag.t * StateSet.t * dir let equal (a,b,c) (d,e,f) = a == d && b == e && c == f diff --git a/src/logger.ml b/src/logger.ml index 7796b73..c213b43 100644 --- a/src/logger.ml +++ b/src/logger.ml @@ -3,7 +3,9 @@ open Format type t = string type level = int -let loggers = [ "top-down-run"; +let loggers = [ "parsing"; + "indexing"; + "top-down-run"; "top-down-approx"; "result-set"; "level2-jit"; @@ -43,3 +45,18 @@ let print ppf fmt = pp_close_box ppf (); fprintf ppf "@?") ppf fmt + +let _verbose = ref false +let set_verbose b = _verbose := b +let verbose ppf fmt = + if !_verbose then begin + pp_open_hovbox ppf 0; + kfprintf (fun _ -> + pp_close_box ppf (); + fprintf ppf "@?") + ppf fmt + end else + ikfprintf (fun _ -> + pp_close_box ppf (); + fprintf ppf "@?") + ppf fmt diff --git a/src/logger.mli b/src/logger.mli index 4f2dd5c..1ee96d5 100644 --- a/src/logger.mli +++ b/src/logger.mli @@ -11,3 +11,5 @@ val log : t -> level -> ('a, Format.formatter, unit) format -> 'a val print : Format.formatter -> ('a, Format.formatter, unit) format -> 'a val available : unit -> string list +val set_verbose : bool -> unit +val verbose : Format.formatter -> ('a, Format.formatter, unit) format -> 'a diff --git a/src/main.ml b/src/main.ml index 2534d01..96e835e 100644 --- a/src/main.ml +++ b/src/main.ml @@ -24,7 +24,7 @@ let mk_runtime run auto doc arg count print outfile = if !Options.do_perf then start_perf (); let r = time ~count:!Options.repeat ~msg:"Execution time" (run auto doc) arg in if !Options.do_perf then stop_perf (); - Logger.print Format.err_formatter "Number of results: %i@\n" (count r); + Logger.verbose Format.err_formatter "Number of results: %i@\n" (count r); match outfile with None -> () | Some file -> @@ -37,10 +37,8 @@ let main v query_string output = let query = time ~msg:"Parsing query" XPath.parse query_string in - if !Options.verbose then begin - Logger.print Format.err_formatter "Parsed query:@\n%a@\n" - XPath.Ast.print query; - end; + Logger.verbose Format.err_formatter "Parsed query:%a@\n" + XPath.Ast.print query; let auto, bu_info = time ~msg:"Compiling query" Compile.compile query in @@ -65,7 +63,7 @@ let main v query_string output = (* run the query top_down *) if !Options.bottom_up then - Logger.print Format.err_formatter "Cannot run the query in bottom-up mode, using top-down evaluator@\n@?"; + Logger.verbose Format.err_formatter "Cannot run the query in bottom-up mode, using top-down evaluator@\n@?"; if !Options.count_only then let module R = ResJIT.Count in let module M = Runtime.Make(R) in @@ -113,8 +111,7 @@ let _ = v in main document !Options.query !Options.output_file; - if !Options.verbose then - Logger.print Format.err_formatter "Maximum resident set size: %s @\n" (read_procmem()); + Logger.verbose Format.err_formatter "Maximum resident set size: %s @\n" (read_procmem()); Gc.full_major(); Profile.summary Format.err_formatter with diff --git a/src/options.ml b/src/options.ml index 1975212..6dfaaef 100644 --- a/src/options.ml +++ b/src/options.ml @@ -113,7 +113,8 @@ let parse_cmdline() = let _ = Arg.parse spec anon_fun usage_msg in if (!pos > 3 || !pos < 2) - then begin Arg.usage spec usage_msg; exit 1 end + then begin Arg.usage spec usage_msg; exit 1 end; + Logger.set_verbose !verbose diff --git a/src/tree.ml b/src/tree.ml index f73e347..84de829 100644 --- a/src/tree.ml +++ b/src/tree.ml @@ -123,16 +123,16 @@ struct let finalize () = do_text build buf; close_tag build ""; - Logger.print Format.err_formatter "Finished parsing@\n"; - Logger.print Format.err_formatter "Starting index construction@\n"; + LOG ( __ "parsing" 2 "%s\n" "Finished parsing"); + LOG ( __ "indexing" 2 "%s\n" "Starting index construction"); let r = close_document build in - Logger.print Format.err_formatter "Finished index construction@\n"; + LOG ( __ "indexing" 2 "%s\n" "Finished index construction"); r in Expat.set_start_element_handler parser_ (start_element_handler parser_ build buf); Expat.set_end_element_handler parser_ (end_element_handler parser_ build buf); Expat.set_character_data_handler parser_ (character_data_handler parser_ build buf); - Logger.print Format.err_formatter "Started parsing@\n"; + LOG ( __ "parsing" 2 "%s\n" "Started parsing"); open_document build !Options.sample_factor !Options.disable_text_collection !Options.text_index_type; open_tag build ""; parser_, finalize @@ -540,9 +540,9 @@ let is_node t = t != nil let is_root t = t == root let node_of_t t = - Logger.print err_formatter "Initializing tag structure@\n"; + LOG ( __ "indexing" 2 "%s\n" "Initializing tag structure"); let _ = Tag.init (mk_tag_ops t) in - Logger.print err_formatter "Starting tag table construction@\n"; + LOG ( __ "indexing" 2 "%s\n" "Starting tag table construction"); let f, n, c, d = time collect_labels t ~msg:"Building tag relationship table" in let c = Array.map TagS.to_ptset c in let n = Array.map TagS.to_ptset n in @@ -804,11 +804,6 @@ Largest tag id: %i@\n@?" (Ptset.Int.cardinal alltags) (Ptset.Int.max_elt alltags) -(* - Logger.print err_formatter "Average depth: %f, number of leaves %i@\n@?" ((float_of_int a)/. (float_of_int b)) b -;; - -*) type tree_pointer = tree let get_tree_pointer x = x.doc -- 2.17.1