From 43906e89a76c67491e2a567990980df787036088 Mon Sep 17 00:00:00 2001 From: kim Date: Sun, 5 Feb 2012 18:54:18 +0000 Subject: [PATCH] Add tracing infrastructure. Adds the tracing instruction: TRACE(t, l, __ format arg1 arg2 ... argn) where t is a tracer (that can be enabled on the command line) and l is a level. Any TRACE whose level is below the one specified on the command line for the tracer is printed. The project is built without -trace, the TRACE() command is a noop. git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@1194 3cdefd35-fc62-479d-8e8d-bae585ffb9ca --- include/debug.ml | 1 - include/trace.ml | 27 +++++++++++++++++++++++++++ myocamlbuild.ml | 4 ++-- src/options.ml | 32 +++++++++++++++++++++++++++++--- src/runtime.ml | 7 +++++++ src/tracer.ml | 25 +++++++++++++++++++++++++ src/tracer.mli | 11 +++++++++++ src/utils.ml | 24 ++++++++++++++++++++++++ 8 files changed, 125 insertions(+), 6 deletions(-) create mode 100644 include/trace.ml create mode 100644 src/tracer.ml create mode 100644 src/tracer.mli create mode 100644 src/utils.ml diff --git a/include/debug.ml b/include/debug.ml index e3694ab..09fd43f 100644 --- a/include/debug.ml +++ b/include/debug.ml @@ -21,7 +21,6 @@ DEFINE D_IGNORE_(e1,e2) = (let () = e1 in ();e2) DEFINE D_IF_(e1,e2) = e1 DEFINE D_TRACE_(e) = e - ELSE DEFINE D_IGNORE_(e1,e2) = (e2) DEFINE D_IF_(e1,e2) = e2 diff --git a/include/trace.ml b/include/trace.ml new file mode 100644 index 0000000..21e3a95 --- /dev/null +++ b/include/trace.ml @@ -0,0 +1,27 @@ +IFNDEF TRACE__ML__ +THEN +DEFINE TRACE__ML__ + +let __ x = + ignore (Format.flush_str_formatter()); + Format.kfprintf + (fun _ -> Format.flush_str_formatter()) + Format.str_formatter x +;; +IFNDEF NTRACE +THEN + +DEFINE TRACE(t, l, r) = + (if l <= Tracer.level t then + Tracer.trace t l (r)) + +ELSE + +DEFINE TRACE(t, l, r) = () + +END + + + + +END diff --git a/myocamlbuild.ml b/myocamlbuild.ml index bbe7fc0..3e14dfa 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -106,8 +106,8 @@ let () = dispatch begin Options.ocamldoc := ocamlfind (A"ocamldoc"); Options.ocamlmktop := ocamlfind (A"ocamlmktop"); - if (List.mem "trace" !Options.tags) then begin - pp_macro_options @= [ A "-DTRACE" ]; + if not (List.mem "trace" !Options.tags) then begin + pp_macro_options @= [ A "-DNTRACE" ]; end; if (List.mem "profile" !Options.tags) then begin pp_macro_options @= [ A "-DPROFILE" ]; diff --git a/src/options.ml b/src/options.ml index d72763e..70d702d 100644 --- a/src/options.ml +++ b/src/options.ml @@ -1,3 +1,6 @@ +open Utils +open Format + let index_empty_texts = ref false let sample_factor = ref 64 let disable_text_collection = ref false @@ -27,7 +30,6 @@ let set_index_type = function let usage_msg = Printf.sprintf "%s [options] 'query' [output]" Sys.argv.(0) - let pos = ref 0 let anon_fun = fun s -> match !pos with @@ -36,6 +38,27 @@ let anon_fun = | 2 -> output_file := Some s; incr pos | _ -> raise (Arg.Bad(s)) +let set_tracer s = + List.iter (fun t -> + if t = "" then () + else + match String.explode t ':' with + [ tr; lvl ] -> + let l = try int_of_string lvl with _ -> raise (Arg.Bad (lvl)) in + if Tracer.is_tracer tr then Tracer.activate tr l + else raise (Arg.Bad (t)) + | _ -> raise (Arg.Bad (t)) + ) (String.explode s ',') + +let pretty_tracers () = + ignore(flush_str_formatter()); + Pretty.print_list + ~sep:", " + (fun f s -> fprintf f "%s" s) + str_formatter + (Tracer.available ()); + flush_str_formatter () + let spec = Arg.align [ "-c", Arg.Set(count_only), " counting only (don't materialize the result set)"; @@ -63,10 +86,13 @@ let spec = Arg.align " choose text index type"; "-v", Arg.Set(verbose), " verbose mode"; ] @ -IFDEF TRACE +IFNDEF NTRACE THEN [ "-trace-file", Arg.Set_string(trace_file), - " save the full trace in dot format in " + " save the full trace in dot format in "; + "-trace", Arg.String (set_tracer), + " enable tracing with the specified level. Valid tracers are: " + ^ (pretty_tracers ()) ] ELSE [] END diff --git a/src/runtime.ml b/src/runtime.ml index e32812b..d74c26a 100644 --- a/src/runtime.ml +++ b/src/runtime.ml @@ -1,4 +1,5 @@ INCLUDE "debug.ml" +INCLUDE "trace.ml" INCLUDE "utils.ml" open Format @@ -189,6 +190,12 @@ module Make (U : ResJIT.S) : S with type result_set = U.NS.t = DEFINE LOOP (t, states, ctx) = ( let _t = (t) in + TRACE("top-down-run", 3, + __ "Entering node %i (tag %s, context %i) with states %a\n%!" + (Node.to_int _t) + (Tag.to_string (Tree.tag tree _t)) + (Node.to_int (ctx)) + (StateSet.print) (states)); if _t == Tree.nil then nil_res else let tag = Tree.tag tree _t in diff --git a/src/tracer.ml b/src/tracer.ml new file mode 100644 index 0000000..eae76a5 --- /dev/null +++ b/src/tracer.ml @@ -0,0 +1,25 @@ +open Format + +type tracer = string +type level = int + +let tracers = [ "top-down-run"; "top-down-approx"; "result-set" ] +let active_tracers : (tracer, int) Hashtbl.t = Hashtbl.create 17 + +let available () = tracers + +let is_tracer s = List.mem s tracers +let level s = try Hashtbl.find active_tracers s with Not_found -> 0 +let is_active s = Hashtbl.mem active_tracers s +let activate s lvl = if not (is_active s) then Hashtbl.add active_tracers s lvl +let deactivate s = Hashtbl.remove active_tracers s + +let tracer_output = ref err_formatter +let set_output f = tracer_output := f + +let trace t l s = + if l <= level t + then begin + fprintf !tracer_output "%s: " t; + fprintf !tracer_output "%s" s + end diff --git a/src/tracer.mli b/src/tracer.mli new file mode 100644 index 0000000..99c078b --- /dev/null +++ b/src/tracer.mli @@ -0,0 +1,11 @@ +type tracer = string +type level = int +val is_tracer : tracer -> bool +val is_active : tracer -> bool +val level : tracer -> level +val activate : tracer -> level -> unit +val deactivate : tracer -> unit +val set_output : Format.formatter -> unit +val trace : tracer -> level -> string -> unit + +val available : unit -> string list diff --git a/src/utils.ml b/src/utils.ml new file mode 100644 index 0000000..c5547aa --- /dev/null +++ b/src/utils.ml @@ -0,0 +1,24 @@ +module String = +struct + include String + + let explode s sep = + let len = length s in + let buff = Buffer.create 40 in + let rec loop i = + if i >= len then + [ Buffer.contents buff ] + else + let c = s.[i] in + if c == sep then + let ss = Buffer.contents buff in + Buffer.clear buff; + ss :: loop (i+1) + else begin + Buffer.add_char buff c; + loop (i+1); + end + in + loop 0 +end +;; -- 2.17.1