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 "debug.ml"
   8
   9 open Ata
  10
  11 let l = ref [] ;;
  12 let time f x =
  13   let t1 = Unix.gettimeofday () in
  14   let r = f x in
  15   let t2 = Unix.gettimeofday () in
  16   let t = (1000. *.(t2 -. t1)) in
  17     l:= t::!l;
  18     Printf.eprintf "  %fms\n%!" t ;
  19     r
  20 ;;
  21 let total_time () =  List.fold_left (+.) 0. !l;;
  22 let enabled_gc = Gc.get()
  23 let disabled_gc = { Gc.get() with
  24                       Gc.max_overhead = 1000000;
  25                       Gc.space_overhead = 100 }
  26
  27 let main v query output =
  28     let _ = Tag.init (Tree.tag_pool v) in
  29       Printf.eprintf "Parsing query : ";
  30       let query = try
  31         time
  32           XPath.Parser.parse_string query
  33       with
  34           Ulexer.Loc.Exc_located ((x,y),e) -> Printf.eprintf "character %i-%i %s\n" x y (Printexc.to_string e);exit 1
  35       in
  36         XPath.Ast.print Format.err_formatter query;
  37         Format.fprintf Format.err_formatter "\n%!";
  38 (*      Printf.eprintf "Dummy iteration : ";
  39         time (fill_hashtag) v;
  40         Printf.eprintf "Dummy iteration (tag access cached) : ";
  41         time (fill_hashtag) v;
  42 *)
  43         Printf.eprintf "Compiling query : ";
  44         let auto,ltags,contains = time XPath.Compile.compile  query in
  45         let _ = Ata.dump Format.err_formatter auto in
  46         let _ = Printf.eprintf "%!" in
  47         let _ = match contains with
  48             None -> ()
  49           | Some s ->
  50               let r = Tree.count v s
  51               in
  52                 Printf.eprintf "Global count is %i, using " r;
  53                 if r < !Options.tc_threshold then begin
  54                   Printf.eprintf "TextCollection contains\nCalling global contains : ";
  55                   time (Tree.init_contains v) s
  56                 end
  57                 else begin
  58                   Printf.eprintf "Naive contains\nCalling global contains : ";
  59                   time (Tree.init_naive_contains v) s
  60                 end
  61         in
  62           Printf.eprintf "Execution time %s : " (if !Options.count_only then "(counting only)" else "");
  63           begin
  64             let _ = Gc.full_major();Gc.compact() in
  65             let _ = Gc.set (disabled_gc) in
  66             if !Options.count_only then
  67               let r = time ( run_count auto  )v in
  68               let _ = Printf.eprintf "Number of nodes in the result set : %i\n%!" r
  69               in ()
  70             else
  71
  72               let result,rcount = time (if !Options.time then run_time auto else run auto) v in
  73                 Printf.eprintf "Number of nodes in the result set : %i\n" rcount;
  74                 Printf.eprintf "\n%!";
  75               begin
  76                 match output with
  77                   | None -> ()
  78                   | Some f ->
  79                       Printf.eprintf "Serializing results : ";
  80                       time( fun () ->
  81                               let oc = open_out f in
  82                                 output_string oc "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
  83                                 TS.iter (fun t -> output_string oc "----------\n";
  84                                            Tree.print_xml_fast oc t;
  85                                            output_char oc '\n') result) ();
  86               end;
  87           end;
  88           let _ = Gc.set enabled_gc in
  89 (*        let _ = Ata.dump Format.err_formatter auto in *)
  90           Printf.eprintf "Total running time : %fms\n%!" (total_time())
  91 ;;
  92
  93 Options.parse_cmdline();;
  94
  95 let v =
  96   if (Filename.check_suffix !Options.input_file ".srx")
  97   then
  98     begin
  99       Printf.eprintf "Loading from file : ";
 100       time (Tree.load  ~sample:!Options.sample_factor )
 101         (Filename.chop_suffix !Options.input_file ".srx");
 102     end
 103   else
 104     let v =
 105       time (fun () -> let v = Tree.parse_xml_uri !Options.input_file;
 106             in Printf.eprintf "Parsing document : %!";v
 107            ) ()
 108     in
 109       if !Options.save_file <> ""
 110       then begin
 111         Printf.eprintf "Writing file to disk : ";
 112         time (Tree.save v) !Options.save_file;
 113       end;
 114       v
 115 in
 116   main v !Options.query !Options.output_file;;
 117
 118 IFDEF DEBUG
 119 THEN
 120 Printf.eprintf "\n=================================================\nDEBUGGING\n%!";
 121
 122 Tree.DEBUGTREE.print_stats Format.err_formatter;;
 123 Gc.full_major()
 124 ENDIF