Completely silences the output unless -v is given.

diff --git a/include/utils.ml b/include/utils.ml
index a8c865e..4a844f4 100644 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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 (file)
--- 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