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
DEFINE D_IF_(e1,e2) = e1
DEFINE D_TRACE_(e) = e
-
ELSE
DEFINE D_IGNORE_(e1,e2) = (e2)
DEFINE D_IF_(e1,e2) = e2
--- /dev/null
+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
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" ];
+open Utils
+open Format
+
let index_empty_texts = ref false
let sample_factor = ref 64
let disable_text_collection = ref false
let usage_msg = Printf.sprintf "%s [options] <input.{xml|srx}> 'query' [output]" Sys.argv.(0)
-
let pos = ref 0
let anon_fun =
fun s -> match !pos with
| 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)";
" choose text index type";
"-v", Arg.Set(verbose), " verbose mode"; ] @
-IFDEF TRACE
+IFNDEF NTRACE
THEN [
"-trace-file", Arg.Set_string(trace_file),
- "<trace_file> save the full trace in dot format in <trace_file>"
+ "<trace_file> save the full trace in dot format in <trace_file>";
+ "-trace", Arg.String (set_tracer),
+ "<tracer1:l1,...,tracern:ln> enable tracing with the specified level. Valid tracers are: "
+ ^ (pretty_tracers ())
]
ELSE []
END
INCLUDE "debug.ml"
+INCLUDE "trace.ml"
INCLUDE "utils.ml"
open Format
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
--- /dev/null
+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
--- /dev/null
+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
--- /dev/null
+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
+;;