--- /dev/null
+IFNDEF LOG__ML__
+THEN
+DEFINE LOG__ML__
+let __ x =
+ ignore (Format.flush_str_formatter());
+ Format.kfprintf
+ (fun _ -> Format.flush_str_formatter())
+ Format.str_formatter x
+;;
+IFNDEF NLOG
+THEN
+
+DEFINE LOG(t, l, r) =
+ (let __log__t = t in
+ let __log__l = l in
+ if __log__l <= Logger.level __log__t then
+ Logger.log __log__t __log__l (r))
+
+ELSE
+
+DEFINE LOG(t, l, r) = ()
+
+END
+
+
+
+
+END
+++ /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 not (List.mem "trace" !Options.tags) then begin
- pp_macro_options @= [ A "-DNTRACE" ];
+ if not (List.mem "log" !Options.tags) then begin
+ pp_macro_options @= [ A "-DNLOG" ];
end;
if (List.mem "profile" !Options.tags) then begin
pp_macro_options @= [ A "-DPROFILE" ];
INCLUDE "debug.ml"
INCLUDE "utils.ml"
-INCLUDE "trace.ml"
+INCLUDE "log.ml"
open Format
| _ ->
if Ptset.Int.mem Tag.pcdata rel_labels then begin
- TRACE("top-down-approx", 3, __ "Computed rel_labels: %a\n"
+ LOG("top-down-approx", 3, __ "Computed rel_labels: %a\n"
TagSet.print
(TagSet.inj_positive rel_labels));
NODE
merge_trans by_states merge_labels
(List.sort by_states uniq_states_trs)
in
- TRACE(
+ LOG(
"top-down-approx", 2,
let is_pairwise_disjoint l =
List.for_all (fun ((ts, _) as tr) ->
List.fold_left (fun ((tr_acc, l_acc, r_acc) as acc) (ts, tr) ->
let ts = if ts == TagSet.star then TagSet.diff ts attributes else ts
in
- if TagSet.mem tag ts then
+ let b = TagSet.mem tag ts in
+ let () = LOG("transition", 3, __ "Transition: %a, tag=%s, %s\n%!"
+ Transition.print
+ tr
+ (Tag.to_string tag)
+ (if b then "selected" else "not selected"))
+ in
+ if b then
let _, _, _, f = Transition.node tr in
let l, r = Formula.st f in
(Translist.cons tr tr_acc,
-INCLUDE "trace.ml"
let realloc l old_size new_size dummy =
let l' = Array.create new_size dummy in
Format.fprintf fmt "%s" "E")) a.line
let add a i v =
- TRACE("twopass", 2, __ "Before add (%i): %a\n%!" i print a);
if a.offset == ~-1 then a.offset <- i;
let offset = a.offset in
let len = Array.length a.line in
- let () =
if i >= offset && i < offset + len then
a.line.(i - offset) <- v
else
narray.(i - offset) <- v;
a.line <- narray
end
- in
- TRACE("twopass", 2, __ "After add (%i): %a\n%!" i print a)
let find a i =
let offset = a.offset in
let add a i j v =
- TRACE("twopass", 2, __ "Adding %i %i\n%!" i j);
let line = Lvl1.find a i in
if line == a.Lvl1.dummy then
let nline = Lvl1.create 0 line.Lvl1.dummy in
- TRACE("twopass", 2, __ "Reallocating\n%!");
Lvl1.add a i nline;
Lvl1.add nline j v
else
Lvl1.add line j v
+
let find a i j =
let v = Lvl1.find a i in
if v == a.Lvl1.dummy then a.Lvl1.dummy.Lvl1.dummy
INCLUDE "debug.ml"
INCLUDE "utils.ml"
-INCLUDE "trace.ml"
+INCLUDE "log.ml"
open Format
open Ata
let jump_stat_init () = Hashtbl.clear jump_stat_table
let jump_stat j =
let i = try Hashtbl.find jump_stat_table j with Not_found -> 0 in
- Hashtbl.replace jump_stat_table j (i+1)
+ Hashtbl.replace jump_stat_table j (i+1)
let print_jump fmt j =
match j with
- | NOP _ -> fprintf fmt "nop"
- | FIRST_CHILD _ -> fprintf fmt "first_child"
- | NEXT_SIBLING _ -> fprintf fmt "next_sibling"
- | FIRST_ELEMENT _ -> fprintf fmt "first_element"
- | NEXT_ELEMENT _ -> fprintf fmt "next_element"
+ | NOP _ -> fprintf fmt "nop"
+ | FIRST_CHILD _ -> fprintf fmt "first_child"
+ | NEXT_SIBLING _ -> fprintf fmt "next_sibling"
+ | FIRST_ELEMENT _ -> fprintf fmt "first_element"
+ | NEXT_ELEMENT _ -> fprintf fmt "next_element"
- | TAGGED_DESCENDANT (_, tag) -> fprintf fmt "tagged_descendant(%s)" (Tag.to_string tag)
+ | TAGGED_DESCENDANT (_, tag) -> fprintf fmt "tagged_descendant(%s)" (Tag.to_string tag)
- | TAGGED_FOLLOWING (_, tag) -> fprintf fmt "tagged_following(%s)" (Tag.to_string tag)
+ | TAGGED_FOLLOWING (_, tag) -> fprintf fmt "tagged_following(%s)" (Tag.to_string tag)
- | SELECT_DESCENDANT (_, tags, _) -> fprintf fmt "select_descendant(%a)"
- TagSet.print (TagSet.inj_positive tags)
+ | SELECT_DESCENDANT (_, tags, _) -> fprintf fmt "select_descendant(%a)"
+ TagSet.print (TagSet.inj_positive tags)
- | SELECT_FOLLOWING (_, tags, _) -> fprintf fmt "select_following(%a)"
- TagSet.print (TagSet.inj_positive tags)
+ | SELECT_FOLLOWING (_, tags, _) -> fprintf fmt "select_following(%a)"
+ TagSet.print (TagSet.inj_positive tags)
- | TAGGED_CHILD (_, tag) -> fprintf fmt "tagged_child(%s)" (Tag.to_string tag)
+ | TAGGED_CHILD (_, tag) -> fprintf fmt "tagged_child(%s)" (Tag.to_string tag)
- | TAGGED_FOLLOWING_SIBLING (_, tag) ->
- fprintf fmt "tagged_following_sibling(%s)" (Tag.to_string tag)
+ | TAGGED_FOLLOWING_SIBLING (_, tag) ->
+ fprintf fmt "tagged_following_sibling(%s)" (Tag.to_string tag)
- | SELECT_CHILD (_, tags, _) -> fprintf fmt "select_child(%a)"
- TagSet.print (TagSet.inj_positive tags)
+ | SELECT_CHILD (_, tags, _) -> fprintf fmt "select_child(%a)"
+ TagSet.print (TagSet.inj_positive tags)
- | SELECT_FOLLOWING_SIBLING (_, tags, _) -> fprintf fmt "select_following_sibling(%a)"
- TagSet.print (TagSet.inj_positive tags)
+ | SELECT_FOLLOWING_SIBLING (_, tags, _) -> fprintf fmt "select_following_sibling(%a)"
+ TagSet.print (TagSet.inj_positive tags)
- | TAGGED_SUBTREE (_, tag) -> fprintf fmt "tagged_subtree(%s)" (Tag.to_string tag)
- | ELEMENT_SUBTREE (_) -> fprintf fmt "element_subtree"
+ | TAGGED_SUBTREE (_, tag) -> fprintf fmt "tagged_subtree(%s)" (Tag.to_string tag)
+ | ELEMENT_SUBTREE (_) -> fprintf fmt "element_subtree"
let jump_stat_summary fmt =
fprintf fmt "Jump function summary:\n%!";
| RIGHT (tl, j) -> fprintf fmt "RIGHT(\n[%a], %a)" Translist.print tl print_jump j
| BOTH (tl, j1, j2) -> fprintf fmt "BOTH(\n[%a], %a, %a)" Translist.print tl print_jump j1 print_jump j2
(*
-let print_cache fmt d =
+ let print_cache fmt d =
let c = Cache.Lvl2.to_array d in
Array.iteri begin fun tag a ->
- let tagstr = Tag.to_string tag in
- if a != Cache.Lvl2.dummy_line d && tagstr <> "<INVALID TAG>"
- then begin
- fprintf fmt "Entry %s: \n" tagstr;
- Array.iter (fun o -> if o != dummy then begin
- print_opcode fmt o;
- fprintf fmt "\n%!" end) a;
- fprintf fmt "---------------------------\n%!"
- end
+ let tagstr = Tag.to_string tag in
+ if a != Cache.Lvl2.dummy_line d && tagstr <> "<INVALID TAG>"
+ then begin
+ fprintf fmt "Entry %s: \n" tagstr;
+ Array.iter (fun o -> if o != dummy then begin
+ print_opcode fmt o;
+ fprintf fmt "\n%!" end) a;
+ fprintf fmt "---------------------------\n%!"
+ end
end c
*)
let create () = Cache.Lvl2.create 4096 dummy
(*
-let stats fmt c =
+ let stats fmt c =
let d = Cache.Lvl2.to_array c in
let len = Array.fold_left (fun acc a -> Array.length a + acc) 0 d in
let lvl1 = Array.fold_left (fun acc a -> if Array.length a == 0 then acc else acc+1) 0 d in
let lvl2 = Array.fold_left (fun acc a ->
- Array.fold_left (fun acc2 a2 -> if a2 == dummy then acc2 else acc2+1)
- acc a) 0 d
+ Array.fold_left (fun acc2 a2 -> if a2 == dummy then acc2 else acc2+1)
+ acc a) 0 d
in
fprintf fmt "L2JIT Statistics:
-\t%i entries
-\t%i used L1 lines
-\t%i used L2 lines
-\ttable size: %ikb\n"
- len lvl1 lvl2 (Ocaml.size_kb d);
+ \t%i entries
+ \t%i used L1 lines
+ \t%i used L2 lines
+ \ttable size: %ikb\n"
+ len lvl1 lvl2 (Ocaml.size_kb d);
fprintf fmt "%s" "L2JIT Content:\n";
print_cache fmt c
*)
let add t tag set v = Cache.Lvl2.add t (Uid.to_int set.StateSet.Node.id) tag v
-let collect_trans tag ((a_t, a_s1, a_s2) as acc) (labels, tr) =
- if TagSet.mem tag labels
- then
- let _, _, _, f = Transition.node tr in
- let s1, s2 = Formula.st f in
- (Translist.cons tr a_t,
- StateSet.union s1 a_s1,
- StateSet.union s2 a_s2)
- else acc
let has_text l = Ptset.Int.mem Tag.pcdata l
let rec translate_jump tree tag (jkind:Ata.jump_kind) dir s =
let child, desc, sib, fol = Tree.tags tree tag in
- match jkind, dir with
- | NIL, _ -> _nop
- | NODE, DIR_LEFT -> FIRST_CHILD s
- | STAR, DIR_LEFT -> FIRST_ELEMENT s
- | NODE, DIR_RIGHT -> NEXT_SIBLING s
- | STAR, DIR_RIGHT -> NEXT_ELEMENT s
- | JUMP_ONE t, _ ->
- let l_one, l_many, tagged_one, select_one, any, any_notext =
- if dir = DIR_LEFT then
- child, desc, _tagged_child, _select_child,_first_child, _first_element
- else
- sib, fol, _tagged_following_sibling, _select_following_sibling,
- _next_sibling, _next_element
- in
- let labels = Ptset.Int.inter l_one t in
- let c = Ptset.Int.cardinal labels in
- if c == 0 then _nop
- else if Ptset.Int.for_all (fun lab -> not (Ptset.Int.mem lab l_many)) labels then
- translate_jump tree tag (JUMP_MANY(labels)) dir s
- else if c == 1 then tagged_one s (Ptset.Int.choose labels)
- else if c > 5 then if has_text labels then any s else any_notext s
- else select_one s labels
-
- | JUMP_MANY t, _ ->
- let l_many, tagged_many, select_many, any, any_notext =
- if dir == DIR_LEFT then
- desc, _tagged_descendant, _select_descendant,_first_child, _first_element
- else
- fol, _tagged_following, _select_following, _next_sibling, _next_element
- in
- let labels = Ptset.Int.inter l_many t in
- let c = Ptset.Int.cardinal labels in
- if c == 0 then _nop
- else if c == 1 then tagged_many s (Ptset.Int.choose labels)
- else if c > 5 then if has_text labels then any s else any_notext s
- else select_many s labels
-
- | CAPTURE_MANY (t), DIR_LEFT ->
- if Ptset.Int.is_singleton t then TAGGED_SUBTREE(s, Ptset.Int.choose t)
- else if t == Tree.element_tags tree then ELEMENT_SUBTREE s
- else assert false
- | _ -> assert false
+ match jkind, dir with
+ | NIL, _ -> _nop
+ | NODE, DIR_LEFT -> FIRST_CHILD s
+ | STAR, DIR_LEFT -> FIRST_ELEMENT s
+ | NODE, DIR_RIGHT -> NEXT_SIBLING s
+ | STAR, DIR_RIGHT -> NEXT_ELEMENT s
+ | JUMP_ONE t, _ ->
+ let l_one, l_many, tagged_one, select_one, any, any_notext =
+ if dir = DIR_LEFT then
+ child, desc, _tagged_child, _select_child,_first_child, _first_element
+ else
+ sib, fol, _tagged_following_sibling, _select_following_sibling,
+ _next_sibling, _next_element
+ in
+ let labels = Ptset.Int.inter l_one t in
+ let c = Ptset.Int.cardinal labels in
+ if c == 0 then _nop
+ else if Ptset.Int.for_all (fun lab -> not (Ptset.Int.mem lab l_many)) labels then
+ translate_jump tree tag (JUMP_MANY(labels)) dir s
+ else if c == 1 then tagged_one s (Ptset.Int.choose labels)
+ else if c > 5 then if has_text labels then any s else any_notext s
+ else select_one s labels
+
+ | JUMP_MANY t, _ ->
+ let l_many, tagged_many, select_many, any, any_notext =
+ if dir == DIR_LEFT then
+ desc, _tagged_descendant, _select_descendant,_first_child, _first_element
+ else
+ fol, _tagged_following, _select_following, _next_sibling, _next_element
+ in
+ let labels = Ptset.Int.inter l_many t in
+ let c = Ptset.Int.cardinal labels in
+ if c == 0 then _nop
+ else if c == 1 then tagged_many s (Ptset.Int.choose labels)
+ else if c > 5 then if has_text labels then any s else any_notext s
+ else select_many s labels
+
+ | CAPTURE_MANY (t), DIR_LEFT ->
+ if Ptset.Int.is_singleton t then TAGGED_SUBTREE(s, Ptset.Int.choose t)
+ else if t == Tree.element_tags tree then ELEMENT_SUBTREE s
+ else assert false
+ | _ -> assert false
let compute_jump auto tree tag states dir =
if !Options.no_jump then
else
let jkind = Ata.top_down_approx auto states tree in
let jump = translate_jump tree tag jkind dir states in
- TRACE("level2-jit", 2,
- __ "Computed jumps for %s %a %s: %a\n%!"
- (Tag.to_string tag)
- StateSet.print states
- (if dir == DIR_LEFT then "left" else "right")
- print_jump jump
- );
+ LOG("level2-jit", 2,
+ __ "Computed jumps for %s %a %s: %a\n%!"
+ (Tag.to_string tag)
+ StateSet.print states
+ (if dir == DIR_LEFT then "left" else "right")
+ print_jump jump
+ );
jump
let compile cache2 auto tree tag states =
let tr_list, states1, states2 =
- StateSet.fold
- (fun q acc ->
- List.fold_left (collect_trans tag)
- acc
- (Hashtbl.find auto.trans q))
- states
- (Translist.nil, StateSet.empty, StateSet.empty)
+ Ata.get_trans ~attributes:(TagSet.inj_positive (Tree.attribute_tags tree)) auto states tag
in
let op =
let empty_s1 = StateSet.is_empty states1 in
let empty_s2 = StateSet.is_empty states2 in
- if empty_s1 && empty_s2 then RETURN
- else if empty_s1 then
- RIGHT (tr_list,
- compute_jump auto tree tag states2 DIR_RIGHT)
- else if empty_s2 then
- LEFT (tr_list,
- compute_jump auto tree tag states1 DIR_LEFT)
- else
- let j1 = compute_jump auto tree tag states1 DIR_LEFT in
- let j2 = compute_jump auto tree tag states2 DIR_RIGHT in
- BOTH (tr_list, j1, j2);
+ if empty_s1 && empty_s2 then RETURN
+ else if empty_s1 then
+ RIGHT (tr_list,
+ compute_jump auto tree tag states2 DIR_RIGHT)
+ else if empty_s2 then
+ LEFT (tr_list,
+ compute_jump auto tree tag states1 DIR_LEFT)
+ else
+ let j1 = compute_jump auto tree tag states1 DIR_LEFT in
+ let j2 = compute_jump auto tree tag states2 DIR_RIGHT in
+ BOTH (tr_list, j1, j2);
in
let op = match op with
- (*BOTH(_, NOP _, NOP _) | LEFT(_, NOP _) | RIGHT(_, NOP _) -> RETURN() *)
+ (*BOTH(_, NOP _, NOP _) | LEFT(_, NOP _) | RIGHT(_, NOP _) -> RETURN() *)
| BOTH(tr, ((NOP _) as l) , NOP _) -> LEFT (tr, l)
| BOTH(tr, l, NOP _) -> LEFT (tr, l)
| BOTH(tr, NOP _, r) -> RIGHT (tr, r)
| _ -> op
in
- add cache2 tag states op;
- op
+ add cache2 tag states op;
+ op
let get_transitions = function
| CACHE | RETURN -> failwith "get_transitions"
--- /dev/null
+open Format
+
+type t = string
+type level = int
+
+let loggers = [ "top-down-run"; "top-down-approx"; "result-set"; "level2-jit"; "res-jit"; "grammar"; "twopass";"transition" ]
+let active_loggers : (t, int) Hashtbl.t = Hashtbl.create 17
+
+let available () = loggers
+
+let is_logger s = List.mem s loggers
+let level s = try Hashtbl.find active_loggers s with Not_found -> 0
+let is_active s = Hashtbl.mem active_loggers s
+let activate s lvl = if not (is_active s) then Hashtbl.add active_loggers s lvl
+let deactivate s = Hashtbl.remove active_loggers s
+
+let logger_output = ref err_formatter
+let set_output f = logger_output := f
+
+let log t l s =
+ if l <= level t
+ then begin
+ fprintf !logger_output "%s: " t;
+ fprintf !logger_output "%s%!" s
+ end
--- /dev/null
+type t = string
+type level = int
+val is_logger : t -> bool
+val is_active : t -> bool
+val level : t -> level
+val activate : t -> level -> unit
+val deactivate : t -> unit
+val set_output : Format.formatter -> unit
+val log : t -> level -> string -> unit
+
+val available : unit -> string list
let module R = ResJIT.Count in
let module M = Runtime.Make(R) in
(* mk_runtime run auto doc arg count print outfile *)
- mk_runtime M.twopass_top_down_run auto v Tree.root R.NS.length R.NS.serialize None
+ if !Options.twopass then
+ mk_runtime M.twopass_top_down_run auto v Tree.root R.NS.length R.NS.serialize None
+ else
+ mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize None
else
let module R = ResJIT.Mat in
let module M = Runtime.Make(R) in
let verbose = ref false
let text_index_type = ref 0
let do_perf = ref false
-
-(* Only valid if compiled with -DTRACE *)
-let trace_file = ref "trace.dot"
-
+let twopass = ref false
let set_index_type = function
| "default" -> text_index_type := 0
| 2 -> output_file := Some s; incr pos
| _ -> raise (Arg.Bad(s))
-let set_tracer s =
+let set_logger 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
+ if Logger.is_logger tr then Logger.activate tr l
else raise (Arg.Bad (t))
| _ -> raise (Arg.Bad (t))
) (String.explode s ',')
-let pretty_tracers () =
+let pretty_loggers () =
ignore(flush_str_formatter());
Pretty.print_list
~sep:", "
(fun f s -> fprintf f "%s" s)
str_formatter
- (Tracer.available ());
+ (Logger.available ());
flush_str_formatter ()
let spec = Arg.align
[ "-c", Arg.Set(count_only),
" counting only (don't materialize the result set)";
+ "-two", Arg.Set(twopass),
+ " Use twopass algorithm";
+
"-f", Arg.Set_int(sample_factor),
"<n> sample factor [default=64]";
"-v", Arg.Set(verbose), " verbose mode"; ] @
IFNDEF NTRACE
THEN [
- "-trace-file", Arg.Set_string(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 ())
+ "-log", Arg.String (set_tracer),
+ "<logger1:l1,...,loggern:ln> enable logging with the specified level. Valid loggers are: "
+ ^ (pretty_loggers ())
]
ELSE []
END
val verbose : bool ref
val text_index_type : int ref
val do_perf : bool ref
+val twopass : bool ref
INCLUDE "debug.ml"
INCLUDE "utils.ml"
-INCLUDE "trace.ml"
+INCLUDE "log.ml"
open Format
(match code with
| Nil -> ()
| Cons(dst, opcode, code1) ->
- TRACE("res-jit", 3, __ " %a := %a\n%!"
+ LOG("res-jit", 3, __ " %a := %a\n%!"
State.print dst print_opcode opcode;
);
exec_code slot slot1 slot2 t dst opcode;
match code1 with
| Nil -> ()
| Cons(dst, opcode, code1) ->
- TRACE("res-jit", 3, __ " %a := %a\n%!"
+ LOG("res-jit", 3, __ " %a := %a\n%!"
State.print dst print_opcode opcode;
);
exec_code slot slot1 slot2 t dst opcode;
end)
DEFINE EXEC_TEMPLATE =
-(* (TRACE("res-jit", 3, __ "Node %i:\n" (Node.to_int t));
- TRACE("res-jit", 3, __ " LEFT : %a\n" pr_slot slot1);
- TRACE("res-jit", 3, __ " RIGHT : %a\n" pr_slot slot2); *)
+ (LOG("res-jit", 3, __ "Node %i:\n" (Node.to_int t));
+ LOG("res-jit", 3, __ " LEFT : %a\n" print slot1);
+ LOG("res-jit", 3, __ " RIGHT : %a\n" print slot2);
exec slot slot1 slot2 t code;
-(* TRACE("res-jit", 3, __ " RES : %a\n\n%!" pr_slot slot))*)
+ LOG("res-jit", 3, __ " RES : %a\n\n%!" print slot))
module type S =
INCLUDE "debug.ml"
-INCLUDE "trace.ml"
+INCLUDE "log.ml"
INCLUDE "utils.ml"
open Format
let eval_trans auto s1 s2 trans =
- TRACE("top-down-run", 2, __ "Evaluating transition list:\n%!");
- TRACE("top-down-run", 2, __ "%a\n%!" Translist.print trans);
+ LOG("top-down-run", 2, __ "Evaluating transition list:\n%!");
+ LOG("top-down-run", 2, __ "%a\n%!" Translist.print trans);
Translist.fold
(fun t ((a_st, a_op, a_todo) as acc)->
let q, _, m, f = Transition.node t in
let cache_apply cache auto tlist s1 s2 =
let f = gen_code auto tlist s1 s2 in
- TRACE("grammar", 2, __ "Inserting: %i, %a, %a\n%!"
+ LOG("grammar", 2, __ "Inserting: %i, %a, %a\n%!"
(Uid.to_int tlist.Translist.Node.id) StateSet.print s1 StateSet.print s2);
add cache tlist s1 s2 f; f
end
DEFINE LOOP (t, states, ctx) = (
let _t = t in
- TRACE("top-down-run", 3,
+ LOG("top-down-run", 3,
__ "Entering node %i with loop (tag %s, context %i) with states %a\n%!"
(Node.to_int _t)
(Tag.to_string (Tree.tag tree _t))
DEFINE LOOP_TAG (t, states, tag, ctx) = (
let _t = (t) in (* to avoid duplicating expression t *)
- TRACE("top-down-run", 3,
+ LOG("top-down-run", 3,
__ "Entering node %i with loop_tag (tag %s, context %i) with states %a\n%!"
(Node.to_int _t)
(Tag.to_string (tag))
match opcode with
| L2JIT.RETURN -> nil_res
| L2JIT.CACHE ->
- eprintf "New configuration\n%!";
+ LOG("top-down-run", 3,
+ __ "Top-down cache miss for configuration %s %a\n%!"
+ (Tag.to_string tag) StateSet.print states);
let opcode = L2JIT.compile cache2 auto tree tag states in
l2jit_dispatch t tag states ctx opcode
l3jit_dispatch tr_list res1 res2 t slot1 slot2
and l2jit_dispatch_instr t ctx instr =
- match instr with
+ match instr with
| L2JIT.NOP () -> nil_res
| L2JIT.FIRST_CHILD s -> LOOP ((Tree.first_child tree t), s, ctx)
| L2JIT.NEXT_SIBLING s -> LOOP ((Tree.next_sibling tree t), s, ctx)
in
let lambda = ref 0 in
let rec start_loop idx states =
- TRACE("grammar", 2, __ "Node %i\n%!" (Node.to_int idx));
+ LOG("grammar", 2, __ "Node %i\n%!" (Node.to_int idx));
if states == dummy_set then nil_res else
if idx < Node.null then nil_res
else begin
let set a i v =
- TRACE("twopass", 2, __ "Setting node %i to state %a\n%!"
+ LOG("twopass", 2, __ "Setting node %i to state %a\n%!"
i StateSet.print v);
a.(i) <- v
auto.bottom_states
else
let tag = Tree.tag tree t in
- TRACE("twopass", 2, __ "Traversing node %i (tag %s) in states %a\n%!" (Node.to_int t) (Tag.to_string tag)
+ LOG("twopass", 2, __ "Traversing node %i (tag %s) in states %a\n%!" (Node.to_int t) (Tag.to_string tag)
StateSet.print states
);
let trans, lstates, rstates =
c
else c
in
- TRACE("twopass", 2, __ "\nTransitions are:\n%!");
- TRACE("twopass", 2, __ "\nTransitions are:\n%a\n%!"
+ LOG("twopass", 2, __ "\nTransitions are:\n%!");
+ LOG("twopass", 2, __ "\nTransitions are:\n%a\n%!"
Translist.print trans
);
let s1 = loop (Tree.first_child tree t) lstates ctx
(Uid.to_int trans.Translist.Node.id) c;c
else c
in
- TRACE("twopass", 2, __ "Evaluating node %i (tag %s).\n%!States=%a\n%!"
+ LOG("twopass", 2, __ "Evaluating node %i (tag %s).\n%!States=%a\n%!"
(Node.to_int t)
(Tag.to_string tag)
StateSet.print states
);
- TRACE("twopass", 2, __ "Translist=%a\nLeft=%a\nRight=%a\nMark=%s\n\n%!"
+ LOG("twopass", 2, __ "Translist=%a\nLeft=%a\nRight=%a\nMark=%s\n\n%!"
Translist.print trans
StateSet.print s1
StateSet.print s2
let twopass_top_down_run auto tree root =
let len = Node.to_int (Tree.closing tree root) + 1 in
- TRACE("twopass", 2, __ "Creating array of size: %i\n%!" len);
+ LOG("twopass", 2, __ "Creating array of size: %i\n%!" len);
let states_array = Array.make len StateSet.empty in
let _, cache =
twopass_top_down states_array auto tree root auto.init Tree.nil
+++ /dev/null
-open Format
-
-type tracer = string
-type level = int
-
-let tracers = [ "top-down-run"; "top-down-approx"; "result-set"; "level2-jit"; "res-jit"; "grammar"; "twopass" ]
-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
projects / SXSI / xpathcomp.git / commitdiff