src/main.ml

   1 (******************************************************************************)
   2 (*  SXSI : XPath evaluator                                                    *)
   3 (*  Kim Nguyen (Kim.Nguyen@nicta.com.au)                                      *)
   4 (*  Copyright NICTA 2008                                                      *)
   5 (*  Distributed under the terms of the LGPL (see LICENCE)                     *)
   6 (******************************************************************************)
   7 INCLUDE "utils.ml"
   8
   9 open Ata
  10
  11 let () = init_timer();;
  12
  13
  14 let default_gc = Gc.get()
  15 let tuned_gc = { default_gc with
  16                    Gc.minor_heap_size = 32*1024*1024;
  17                    Gc.major_heap_increment = 8*1024*1024;
  18                    Gc.max_overhead = 1000000;
  19                    Gc.space_overhead = 100;
  20                }
  21
  22
  23
  24 let pr_mat v r =
  25   let () =
  26     Printf.eprintf "Number of nodes in the result set : %i\n%!"
  27       (NodeSet.Mat.length r);
  28   in
  29   if !Options.verbose then Printf.eprintf "Size of result set: %i kb\n"
  30     (Ocaml.size_w r);
  31   match !Options.output_file with
  32     | None -> ()
  33     | Some f ->
  34       let fd, finish =
  35         if f = "-" then Unix.stdout, ignore
  36         else
  37           Unix.openfile f [ Unix.O_WRONLY; Unix.O_TRUNC; Unix.O_CREAT ] 0o666,
  38           Unix.close
  39       in
  40       let () =
  41         time ~msg:"Serializing results"
  42           (NodeSet.Mat.iter (fun node -> Tree.print_xml v node fd)) r
  43       in
  44       Tree.flush v fd;
  45       finish fd
  46
  47 let mk_runtime run auto doc arg count print outfile =
  48   fun () ->
  49     let r = time ~count:1 ~msg:"Execution time" (run auto doc) arg in
  50     Printf.eprintf "Number of results: %i\n%!" (count r);
  51     match outfile with
  52         None -> ()
  53       | Some file ->
  54         time ~count:1 ~msg:"Serialization time" (print file doc) r
  55 ;;
  56
  57
  58 let main v query_string output =
  59   Tag.init (Tree.tag_pool v);
  60   let query =
  61     time ~msg:"Parsing query" XPath.parse query_string
  62   in
  63   if !Options.verbose then begin
  64     Printf.eprintf "Parsed query:\n%!";
  65     XPath.Ast.print Format.err_formatter query;
  66     Format.fprintf Format.err_formatter "\n%!"
  67   end;
  68   let auto, bu_info =
  69     time ~msg:"Compiling query" (Compile.compile) query
  70   in
  71   if !Options.verbose then Ata.print Format.err_formatter auto;
  72   Gc.set (tuned_gc);
  73   let runtime =
  74   match !Options.bottom_up, bu_info with
  75
  76     | true, Some [ (query, pattern) ] ->
  77       (* let nodes =
  78         time
  79           ~count:1 ~msg:"Computing full text query"
  80           (Tree.full_text_query query v) pattern
  81       in
  82       let nodes = Array.to_list nodes in *)
  83       if !Options.count_only then
  84         let module R = ResJIT.Count in
  85         let module M = Runtime.Make(R) in
  86         mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize None
  87       else
  88         let module R = ResJIT.Mat in
  89         let module M = Runtime.Make(R) in
  90         mk_runtime M.bottom_up_run auto v (query, pattern) R.NS.length R.NS.serialize !Options.output_file
  91
  92     | _ ->
  93         (* run the query top_down *)
  94
  95       if !Options.bottom_up then
  96         Printf.eprintf "Cannot run the query in bottom-up mode, using top-down evaluator\n%!";
  97
  98       if !Options.count_only then
  99         let module R = ResJIT.Count in
 100         let module M = Runtime.Make(R) in
 101         (* mk_runtime run auto doc arg count print outfile  *)
 102         mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize None
 103       else
 104         let module R = ResJIT.Mat in
 105         let module M = Runtime.Make(R) in
 106         mk_runtime M.top_down_run auto v Tree.root R.NS.length R.NS.serialize !Options.output_file
 107   in
 108   runtime ()
 109 ;;
 110
 111 let () = Options.parse_cmdline()
 112 ;;
 113
 114 let document =
 115   if Filename.check_suffix !Options.input_file ".srx"
 116   then
 117     time
 118       ~msg:"Loading file"
 119       (Tree.load
 120          ~sample:!Options.sample_factor
 121          ~load_text:true)
 122       !Options.input_file
 123   else
 124     let v =
 125       time
 126         ~msg:"Parsing document"
 127         (Tree.parse_xml_uri)
 128         !Options.input_file
 129     in
 130     let () =
 131       if !Options.save_file <> ""
 132       then
 133         time
 134           ~msg:"Writing file to disk"
 135           (Tree.save v)
 136           !Options.save_file;
 137     in
 138       v
 139 in
 140   try
 141     (*Printexc.record_backtrace true; *)
 142     main document !Options.query !Options.output_file;
 143     if !Options.verbose then Printf.eprintf "Maximum resident set size: %s\n" (read_procmem());
 144     Profile.summary Format.err_formatter
 145   with
 146     | Ulexer.Loc.Exc_located ((x,y),e) ->
 147         Printf.eprintf "character %i-%i %s\n" x y (Printexc.to_string e);
 148         exit 1
 149
 150     | e ->
 151         output_string stderr "\n";
 152         flush stderr;
 153         Printexc.print_backtrace stderr;
 154         Printf.eprintf "FATAL ERROR: %s\n%!" (Printexc.to_string e);
 155         output_string stderr "\n";
 156         flush stderr;
 157 (*      Ptset.Int.stats(); *)
 158         exit 2
 159
 160