states : StateSet.t;
init : StateSet.t;
last : State.t;
-
- (* Transitions of the Alternating automaton *)
+ (* Transitions of the Alternating automaton *)
trans : (State.t, (TagSet.t * Transition.t) list) Hashtbl.t;
marking_states : StateSet.t;
topdown_marking_states : StateSet.t;
bottom_states : StateSet.t;
true_states : StateSet.t
- }
+}
let print ppf a =
fprintf ppf
- "Automaton (%i) :
-States %a
-Initial states: %a
-Marking states: %a
-Topdown marking states: %a
-Bottom states: %a
-True states: %a
-Alternating transitions\n"
+ "Automaton (%i) :@\n\
+ States %a@\n\
+ Initial states: %a@\n\
+ Marking states: %a@\n\
+ Topdown marking states: %a@\n\
+ Bottom states: %a@\n\
+ True states: %a@\n\
+ Alternating transitions:@\n"
a.id
StateSet.print a.states
StateSet.print a.init
StateSet.print a.true_states;
let trs =
Hashtbl.fold
- (fun _ t acc ->
- List.fold_left (fun acc (_, tr) -> tr::acc) acc t) a.trans []
+ (fun _ t acc -> List.fold_left (fun acc (_, tr) -> tr::acc) acc t)
+ a.trans
+ []
in
let sorted_trs = List.stable_sort Transition.compare trs in
let strings = Transition.format_list sorted_trs in
match strings with
- [] -> ()
- | line::_ ->
+ | [] -> ()
+ | line::_ ->
let sline = Pretty.line (Pretty.length line) in
- fprintf ppf "%s\n%!" sline;
- List.iter (fun s -> fprintf ppf "%s\n%!" s) strings;
- fprintf ppf "%s\n%!" sline
+ fprintf ppf "%s@\n" sline;
+ List.iter (fun s -> fprintf ppf "%s@\n" s) strings;
+ fprintf ppf "%s@\n" sline
type jump_kind =
exception Found of t
let stats () =
- Printf.eprintf "Hconsing statistics";
let l = WH.fold (fun cell acc -> (Uid.to_int cell.id)::acc) pool [] in
let l = List.sort compare l in
- List.iter (fun id -> Printf.eprintf "%i\n" id) l
+ Logger.print Format.err_formatter "Hconsing statistics:@\n%a"
+ (fun ppf l ->
+ Pretty.pp_print_list ~sep:Format.pp_force_newline Format.pp_print_int ppf l) l
end
if !Options.do_perf then start_perf ();
let r = time ~count:1 ~msg:"Execution time" (run auto doc) arg in
if !Options.do_perf then stop_perf ();
- Printf.eprintf "Number of results: %i\n%!" (count r);
+ Logger.print Format.err_formatter "Number of results: %i@\n" (count r);
match outfile with
None -> ()
| Some file ->
time ~msg:"Parsing query" XPath.parse query_string
in
if !Options.verbose then begin
- Printf.eprintf "Parsed query:\n%!";
- XPath.Ast.print Format.err_formatter query;
- Format.fprintf Format.err_formatter "\n%!"
+ Logger.print Format.err_formatter "Parsed query:@\n%a@\n"
+ XPath.Ast.print query;
end;
let auto, bu_info =
- time ~msg:"Compiling query" (Compile.compile) query
+ time ~msg:"Compiling query" Compile.compile query
in
if !Options.verbose then Ata.print Format.err_formatter auto;
Gc.full_major();
match !Options.bottom_up, bu_info with
| true, Some [ (query, pattern) ] ->
- (* let nodes =
- time
- ~count:1 ~msg:"Computing full text query"
- (Tree.full_text_query query v) pattern
- in
- let nodes = Array.to_list nodes in *)
if !Options.count_only then
let module R = ResJIT.Count in
let module M = Runtime.Make(R) in
(* run the query top_down *)
if !Options.bottom_up then
- Printf.eprintf "Cannot run the query in bottom-up mode, using top-down evaluator\n%!";
-
+ Logger.print 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
- (* mk_runtime run auto doc arg count print outfile *)
- if !Options.twopass then
+ 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
g
in
begin
- (* Todo Factorise with main *)
+ (* TODO Factorise with main *)
Tag.init (Grammar2.tag_operations g);
let query =
time ~msg:"Parsing query" XPath.parse !Options.query
v
in
main document !Options.query !Options.output_file;
- if !Options.verbose then Printf.eprintf "Maximum resident set size: %s\n" (read_procmem());
+ if !Options.verbose then
+ Logger.print Format.err_formatter "Maximum resident set size: %s @\n" (read_procmem());
Gc.full_major();
Profile.summary Format.err_formatter
with
| Ulexer.Loc.Exc_located ((x,y),e) ->
- Printf.eprintf "character %i-%i %s\n" x y (Printexc.to_string e);
+ Logger.print Format.err_formatter "character %i-%i %s@\n" x y (Printexc.to_string e);
exit 1
| e ->
- output_string stderr "\n";
- flush stderr;
- Printexc.print_backtrace stderr;
- Printf.eprintf "FATAL ERROR: %s\n%!" (Printexc.to_string e);
- output_string stderr "\n";
- flush stderr;
+ Logger.print Format.err_formatter "BACKTRACE: %s@\n@?" (Printexc.get_backtrace());
+ Logger.print Format.err_formatter "FATAL ERROR: %s@\n@?" (Printexc.to_string e);
exit 2
let show_stats a =
let count = ref 0 in
Cache.Lvl3.iteri (fun _ _ _ _ b -> if not b then incr count) a;
- eprintf "%!L3JIT: %i used entries\n%!" !count
+ Logger.print err_formatter "@?L3JIT: %i used entries@\n@?" !count
let create () =
let v = Cache.Lvl3.create 1024 dummy in
if !Options.verbose then at_exit (fun () -> show_stats v);
(*** Bottom-up evaluation function **)
- let ns_print fmt t =
- Format.fprintf fmt "{ ";
- U.NS.iter begin fun node ->
- Format.fprintf fmt "%a " Node.print node;
- end t;
- Format.fprintf fmt "}"
-
- let slot_print fmt t =
- Array.iteri begin fun state ns ->
- Format.eprintf "%a -> %a\n" State.print state ns_print ns;
- end t
-
-
let eval_trans auto tree parent res1 res2 = assert false
let rec uniq = function
INCLUDE "debug.ml"
INCLUDE "utils.ml"
-
external init_lib : unit -> unit = "sxsi_cpp_init"
exception CPlusPlusError of string
type tree
-
external register_tag : tree -> string -> Tag.t = "caml_xml_tree_register_tag"
external tag_name : tree -> Tag.t -> string = "caml_xml_tree_get_tag_name"
(fun parser_ ->
incr event_counter;
if !event_counter land 0xffffff == 0 then
- Printf.eprintf "Current position: %i\n%!" (Expat.get_current_byte_index parser_))
+ Logger.print Format.err_formatter "Current position: %i@\n@?" (Expat.get_current_byte_index parser_))
+
let do_text b t =
if Buffer.length t > 0 then begin
let finalize () =
do_text build buf;
close_tag build "";
- Printf.eprintf "Finished Parsing\n%!";
- Printf.eprintf "Started Index construction\n%!";
+ Logger.print Format.err_formatter "Finished parsing@\n";
+ Logger.print Format.err_formatter "Starting index construction@\n";
let r = close_document build in
- Printf.eprintf "Finished Index construction\n%!";
+ Logger.print Format.err_formatter "Finished index construction@\n";
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);
- Printf.eprintf "Started Parsing\n%!";
+ Logger.print Format.err_formatter "Started parsing@\n";
open_document build !Options.index_empty_texts !Options.sample_factor
!Options.disable_text_collection !Options.text_index_type;
open_tag build "";
open Format
let dump_tag_table t =
- eprintf "Child tags:\n%!";
- Array.iteri
- (fun tag set -> eprintf "%s: %a\n%!"
- (Tag.to_string tag) TagSet.print (TagSet.inj_positive set))
- t.children;
- eprintf "-----------------------------\n%!";
- eprintf "Descendant tags:\n%!";
- Array.iteri
- (fun tag set -> eprintf "%s: %a\n%!"
- (Tag.to_string tag) TagSet.print (TagSet.inj_positive set))
- t.descendants;
- eprintf "-----------------------------\n%!";
- eprintf "Sibling tags:\n%!";
- Array.iteri
- (fun tag set -> eprintf "%s: %a\n%!"
- (Tag.to_string tag) TagSet.print (TagSet.inj_positive set))
- t.siblings;
- eprintf "-----------------------------\n%!";
- eprintf "Following tags:\n%!";
- Array.iteri
- (fun tag set -> eprintf "%s: %a\n%!"
- (Tag.to_string tag) TagSet.print (TagSet.inj_positive set))
- t.followings;
- eprintf "-----------------------------\n%!"
-
+ let tag = ref 0 in
+ let printer ppf set =
+ Logger.print ppf "%s: %a"
+ (Tag.to_string !tag) TagSet.print (TagSet.inj_positive set);
+ incr tag
+ in
+ let set_printer msg set =
+ tag := 0;
+ Logger.print err_formatter "%s :@\n" msg;
+ Pretty.pp_print_array ~sep:pp_force_newline printer err_formatter set;
+ Logger.print err_formatter "-----------------------------@\n";
+ in
+ set_printer "Child tags" t.children;
+ set_printer "Descendant tags" t.descendants;
+ set_printer "Sibling tags" t.siblings;
+ set_printer "Following tags" t.followings
external tree_subtree_tags : tree -> [`Tree] Node.t -> Tag.t -> int = "caml_xml_tree_subtree_tags" "noalloc"
let subtree_tags t n tag = tree_subtree_tags t.doc n tag
in
let a,b = loop true root 0 0 0
in
- Printf.eprintf "Average depth: %f, number of leaves %i\n%!" ((float_of_int a)/. (float_of_int b)) b
+ Logger.print err_formatter "Average depth: %f, number of leaves %i@\n@?" ((float_of_int a)/. (float_of_int b)) b
;;
module TagS =
let is_root t = t == root
let node_of_t t =
- eprintf "Initializing tag structure\n%!";
+ Logger.print err_formatter "Initializing tag structure@\n";
let _ = Tag.init (mk_tag_ops t) in
- eprintf "Starting tag table construction\n%!";
+ Logger.print err_formatter "Starting tag table construction@\n";
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
let pos fd =
Unix.lseek fd 0 Unix.SEEK_CUR
-let pr_pos fd = Printf.eprintf "At position %i\n%!" (pos fd)
+let pr_pos fd = Logger.print err_formatter "At position %i@\n" (pos fd)
let write fd s =
let sl = String.length s in
in
let bv = results.bv in
memo := begin fun _ n ->
- let b =
- bit_vector_unsafe_get bv (Node.to_int n)
- in
- D_TRACE_(Printf.eprintf "Result of memoized call to query %s is %b for node %i\n" s b (Node.to_int n));
- b
+ bit_vector_unsafe_get bv (Node.to_int n)
end;
- let b = bit_vector_unsafe_get bv (Node.to_int node) in
- D_TRACE_(Printf.eprintf "Result is %b for node %i\n" b (Node.to_int node));
- b
+ bit_vector_unsafe_get bv (Node.to_int node)
end;
Predicate.make memo
projects / SXSI / xpathcomp.git / commitdiff