(******************************************************************************) (* SXSI : XPath evaluator *) (* Kim Nguyen (Kim.Nguyen@nicta.com.au) *) (* Copyright NICTA 2008 *) (* Distributed under the terms of the LGPL (see LICENCE) *) (******************************************************************************) INCLUDE "utils.ml" open Ata let () = init_timer();; let default_gc = Gc.get() let tuned_gc = { default_gc with Gc.minor_heap_size = 32*1024*1024; Gc.major_heap_increment = 8*1024*1024; Gc.max_overhead = 1000000; Gc.space_overhead = 100; } let mk_runtime run auto doc arg count print outfile = fun () -> if !Config.do_perf then start_perf (); let r = Utils.time ~count:!Config.repeat ~msg:"Execution time" (run auto doc) arg in if !Config.do_perf then stop_perf (); Logger.start_msg Format.err_formatter "[Debug] Number of results: "; Logger.msg Format.err_formatter "%i" (count r); Logger.end_msg Format.err_formatter "\n"; match outfile with None -> () | Some file -> Utils.time ~count:1 ~msg:"Serialization time" (print file !Config.no_wrap_results doc) r ;; let main v query_string output = Tag.init (Tree.tag_operations v); if !Config.docstats then Tree.stats v; let query = Utils.time ~msg:"Parsing query" XPath.parse query_string in Logger.start_msg Format.err_formatter "[Debug]"; Logger.msg Format.err_formatter " Parsed query: @\n @[ {"; Logger.msg Format.err_formatter " %a }@]" XPath.Ast.print query; Logger.end_msg Format.err_formatter "\n\n"; let auto, bu_info = Utils.time ~msg:"Compiling query" Compile.compile query in Logger.start_msg Format.err_formatter "[Debug] Automaton: "; Logger.msg Format.err_formatter "@\n @["; Logger.msg Format.err_formatter "%a" Ata.print auto; Logger.end_msg Format.err_formatter "\n\n"; Gc.full_major(); Gc.compact(); Gc.set (tuned_gc); let runtime = match !Config.bottom_up, bu_info with | true, Some [ (query, pattern) ] -> if !Config.count_only then let module R = ResJIT.Count in let module M = Runtime.Make(R) in mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize !Config.output_file else let module R = ResJIT.Mat in let module M = Runtime.Make(R) in mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize !Config.output_file | _ -> (* run the query top_down *) if !Config.bottom_up then Logger.verbose Format.err_formatter "Cannot run the query in bottom-up mode, using top-down evaluator@\n@?"; if !Config.count_only then let module R = ResJIT.Count in let module M = Runtime.Make(R) in if !Config.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 !Config.output_file else let module R = ResJIT.Mat in let module M = Runtime.Make(R) in mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize !Config.output_file in runtime () ;; let () = Options.parse_cmdline() ;; let _ = try Printexc.record_backtrace true; let document = if Filename.check_suffix !Config.input_file ".srx" then Utils.time ~msg:"Loading Index file" (Tree.load ~sample:!Config.sample_factor ~load_text:(not !Config.disable_text_collection)) !Config.input_file else let v = Utils.time ~msg:"Loading XML file" (Tree.parse_xml_uri) !Config.input_file in let () = if !Config.save_file <> "" then Utils.time ~msg:"Writing file to disk" (Tree.save v) !Config.save_file; in v in main document !Config.query !Config.output_file; IFDEF PROFILE THEN Profile.summary Format.err_formatter ELSE () END with | Ulexer.Loc.Exc_located ((x,y),e) -> Logger.print Format.err_formatter "character %i-%i %s@\n" x y (Printexc.to_string e); exit 1 | e -> 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