Merge branch 'local-ocamlbuild' into local-trunk
[SXSI/xpathcomp.git] / src / main.ml
diff --git a/src/main.ml b/src/main.ml
new file mode 100644 (file)
index 0000000..3932be6
--- /dev/null
@@ -0,0 +1,160 @@
+(******************************************************************************)
+(*  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 pr_mat v r =
+  let () =
+    Printf.eprintf "Number of nodes in the result set : %i\n%!"
+      (NodeSet.Mat.length r);
+  in
+  if !Options.verbose then Printf.eprintf "Size of result set: %i kb\n"
+    (Ocaml.size_w r);
+  match !Options.output_file with
+    | None -> ()
+    | Some f ->
+      let fd, finish =
+       if f = "-" then Unix.stdout, ignore
+       else
+         Unix.openfile f [ Unix.O_WRONLY; Unix.O_TRUNC; Unix.O_CREAT ] 0o666,
+         Unix.close
+      in
+      let () =
+       time ~msg:"Serializing results"
+         (NodeSet.Mat.iter (fun node -> Tree.print_xml v node fd)) r
+      in
+      Tree.flush v fd;
+      finish fd
+
+let mk_runtime run auto doc arg count print outfile =
+  fun () ->
+    let r = time ~count:1 ~msg:"Execution time" (run auto doc) arg in
+    Printf.eprintf "Number of results: %i\n%!" (count r);
+    match outfile with
+       None -> ()
+      | Some file ->
+       time ~count:1 ~msg:"Serialization time" (print file doc) r
+;;
+
+
+let main v query_string output =
+  Tag.init (Tree.tag_pool v);
+  let query =
+    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%!"
+  end;
+  let auto, bu_info =
+    time ~msg:"Compiling query" (Compile.compile) query
+  in
+  if !Options.verbose then Ata.print Format.err_formatter auto;
+  Gc.set (tuned_gc);
+  let runtime =
+  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
+       mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize None
+      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 !Options.output_file
+
+    | _ ->
+       (* 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%!";
+
+      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  *)
+       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
+       mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize !Options.output_file
+  in
+  runtime ()
+;;
+
+let () = Options.parse_cmdline()
+;;
+
+let document =
+  if Filename.check_suffix !Options.input_file ".srx"
+  then
+    time
+      ~msg:"Loading file"
+      (Tree.load
+        ~sample:!Options.sample_factor
+        ~load_text:true)
+      !Options.input_file
+  else
+    let v =
+      time
+       ~msg:"Parsing document"
+       (Tree.parse_xml_uri)
+       !Options.input_file
+    in
+    let () =
+      if !Options.save_file <> ""
+      then
+       time
+         ~msg:"Writing file to disk"
+         (Tree.save v)
+         !Options.save_file;
+    in
+      v
+in
+  try
+    (*Printexc.record_backtrace true; *)
+    main document !Options.query !Options.output_file;
+    if !Options.verbose then Printf.eprintf "Maximum resident set size: %s\n" (read_procmem());
+    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);
+       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;
+(*     Ptset.Int.stats(); *)
+       exit 2
+
+