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
   8 open Ata
   9 INCLUDE "utils.ml"
  10 let () = init_timer();;
  11
  12 let default_gc = Gc.get()
  13 let tuned_gc = { Gc.get() with
  14                    Gc.minor_heap_size = 4*1024*1024;
  15                    Gc.major_heap_increment = 1024*1024;
  16                    Gc.max_overhead = 1000000;
  17                   }
  18 let hash x = 131*x/(x-1+1)
  19
  20 let test_loop tree tag =
  21   let t' = Tree.tagged_descendant tree tag  Tree.root in
  22   let f = Hashtbl.create 4096
  23   in
  24   let jump t _ =  Tree.tagged_following_below tree tag t Tree.root in
  25   let g t ctx =
  26     if t == Tree.nil then 0
  27     else 1+ ((Hashtbl.find f (hash 101)) (jump t ctx) ctx)
  28   in
  29   Hashtbl.add f (hash 101) g;
  30   (Hashtbl.find f (hash 101)) t' Tree.root
  31
  32 let test_full tree =
  33   let root = Tree.root in
  34   let fin = Tree.closing tree root in
  35   let rec loop t = if t <= fin then
  36   let tag = Tree.tag tree t in
  37 (*  let _ = Tag.to_string tag in *)
  38   if tag == Tag.pcdata then (ignore (Tree.get_text tree t));
  39   let t = (Obj.magic ((Obj.magic t) + 1)) in
  40   loop t
  41   in
  42   loop root
  43
  44
  45 let test_loop2 tree tag =
  46   let t' = Tree.tagged_descendant tree tag  Tree.root in
  47   let f = Hashtbl.create 4096
  48   in
  49   let jump t _ =  Tree.tagged_following_below tree tag t Tree.root in
  50   let rec g t ctx =
  51     if t == Tree.nil then 0
  52     else 1+ (match (Hashtbl.find f (hash 101)) with
  53                 `Foo ->g (jump t ctx) ctx
  54             )
  55   in
  56   Hashtbl.add f (hash 101) `Foo;
  57   g t' Tree.root
  58
  59 let test_text doc =
  60   let _ = Printf.eprintf "Contains(bree)" in
  61   let _ = time (Tree.test_contains doc) "bree" in
  62   let _ = Printf.eprintf "Contains(brain)" in
  63   let _ = time (Tree.test_contains doc) "brain" in
  64   let _ = Printf.eprintf "Contains(brain)" in
  65   let i = time (Tree.test_contains doc) "brain" in
  66   let _ = Printf.eprintf "%i\nContains(Australia)" i in
  67   let i = time (Tree.test_contains doc) "AUSTRALIA" in
  68   let _ = Printf.eprintf "%i\n Contains(1930)" i in
  69   let i = time (Tree.test_contains doc) "1930" in
  70   let _ = Printf.eprintf "%i\n startswith(bar)" i in
  71   let i = time (Tree.test_prefix doc) "bar" in
  72   let _ = Printf.eprintf "%i\n endswith(LAND)" i in
  73   let i = time (Tree.test_suffix doc) "LAND" in
  74   let _ = Printf.eprintf "%i\n =(2001)" i in
  75   let i = time (Tree.test_equals doc) "2001" in
  76   let _ = Printf.eprintf "%i\n =(Nguyen)" i in
  77   let i = time (Tree.test_equals doc) "Nguyen" in
  78   Printf.eprintf "%i\n" i ;
  79   ()
  80
  81 type pointers
  82 type order = PREORDER | INORDER | POSTORDER
  83 external build_pointers : Tree.t -> order -> pointers = "caml_build_pointers"
  84 external iter_pointers : pointers -> int = "caml_iter_pointers"
  85 external free_pointers : pointers -> unit = "caml_free_pointers"
  86
  87
  88 let main v query_string output =
  89
  90     let _ = Tag.init (Tree.tag_pool v) in
  91       Printf.eprintf "Parsing query : ";
  92       let query = try
  93         time
  94           XPath.Parser.parse_string query_string
  95       with
  96           Ulexer.Loc.Exc_located ((x,y),e) -> Printf.eprintf "character %i-%i %s\n" x y (Printexc.to_string e);exit 1
  97       in
  98       let _ = Printf.eprintf "Number of nodes %i\n%!" (Tree.size v) in
  99 (*      let _ = test_text v in *)
 100 (*      let _ = Tree.stats v in *)
 101       let _ = Printf.eprintf "\nTiming first_child/next_sibling on sxsi %!" in
 102       let c = time (Tree.benchmark_fcns)  v in
 103       let _ = Printf.eprintf "Traversed %i nodes\n" c in
 104       let _ = Printf.eprintf "\nTiming first_element/next_element on sxsi %!" in
 105       let c = time (Tree.benchmark_fene)  v in
 106       let _ = Printf.eprintf "Traversed %i nodes\n" c in
 107       let _ = Printf.eprintf "\nTiming last_child/prev_sibling on sxsi %!" in
 108       let _ = time (Tree.benchmark_lcps)  v in
 109       let tag = "keyword" in
 110       let _ = Printf.eprintf "\nTiming jump to <%s> on sxsi %!" tag in
 111       let _ = time (Tree.benchmark_jump v) (Tag.tag tag)  in
 112   (*    let _ = Printf.eprintf "\nTiming pointer allocation (preorder) %!" in
 113       let pointers = time (build_pointers v) PREORDER  in
 114       let _ = Printf.eprintf "\nTiming pointer iteration %!" in
 115       let i = time (iter_pointers) pointers  in
 116       let _ = Printf.eprintf "Traversed %i pointers\nTiming pointer deallocation %!" i in
 117       let _  = time (free_pointers) pointers  in
 118
 119
 120       let _ = Printf.eprintf "\nTiming pointer allocation (inorder) %!" in
 121       let pointers = time (build_pointers v) INORDER  in
 122       let _ = Printf.eprintf "\nTiming pointer iteration %!" in
 123       let i = time (iter_pointers) pointers  in
 124       let _ = Printf.eprintf "Traversed %i pointers\nTiming pointer deallocation %!" i in
 125       let _  = time (free_pointers) pointers  in
 126
 127       let _ = Printf.eprintf "\nTiming pointer allocation (postorder) %!" in
 128       let pointers = time (build_pointers v) POSTORDER  in
 129       let _ = Printf.eprintf "\nTiming pointer iteration %!" in
 130       let i = time (iter_pointers) pointers  in
 131       let _ = Printf.eprintf "Traversed %i pointers\nTiming pointer deallocation %!" i in
 132       let _  = time (free_pointers) pointers  in *)
 133
 134       let _ = Printf.eprintf "\nTiming iterative_traversal on sxsi %!" in
 135       let c = time (Tree.benchmark_iter)  v in
 136       let _ = Printf.eprintf "Traversed %i nodes\n" c in
 137
 138
 139
 140
 141
 142
 143 (*      let _ = Printf.eprintf "Timing //keyword :" in
 144       let r = time (test_loop v) (Tag.tag "keyword") in
 145       let _ = Printf.eprintf "Count is %i\n%!" r in
 146       let _ = Printf.eprintf "Timing //keyword 2:" in
 147       let r = time (test_loop2 v) (Tag.tag "keyword") in
 148       let _ = Printf.eprintf "Count is %i\n%!" r in
 149       let _ = Printf.eprintf "Timing //node() :" in
 150       let _ = time (test_full)  v in      *)
 151       XPath.Ast.print Format.err_formatter query;
 152       Format.fprintf Format.err_formatter "\n%!";
 153       Printf.eprintf "Compiling query : ";
 154       let auto,ltags,contains = time (XPath.Compile.compile ~querystring:query_string) query in
 155       let _ = Ata.dump Format.err_formatter auto in
 156       let _ = Printf.eprintf "%!" in
 157       let jump_to =
 158         match contains with
 159            None -> (max_int,`NOTHING)
 160           | Some ((op,s)) ->
 161               let r = Tree.count v s
 162               in
 163               Printf.eprintf "%i documents in the TextCollection\n" (Tree.text_size v);
 164               Printf.eprintf "Global count is %i, using " r;
 165               if r < !Options.tc_threshold then begin
 166                 Printf.eprintf "TextCollection contains\nCalling global contains : ";
 167                 time (Tree.init_textfun op v) s;
 168               end
 169               else begin
 170                 Printf.eprintf "Naive contains\nCalling global contains : ";
 171                 time (Tree.init_naive_contains v) s
 172               end;(r,`CONTAINS(s))
 173       in
 174       let test_list = jump_to in
 175       (*
 176         let test_list =
 177         if (!Options.backward) then begin
 178         Printf.eprintf "Finding min occurences : ";
 179         time
 180         ( List.fold_left (fun ((min_occ,kind)as acc)  (tag,_) ->
 181                               let numtags = Tree.subtree_tags v tag Tree.root in
 182                                 if  ((numtags < min_occ) && numtags >= 2)
 183                                 then (numtags,`TAG(tag))
 184                                 else acc) jump_to) ltags
 185           end
 186           else (max_int,`NOTHING)
 187         in*)
 188         let _ = if (snd test_list) != `NOTHING then
 189           let occ,s1,s2 = match test_list with
 190             | (x,`TAG (tag)) -> (x, "tag", (Tag.to_string tag))
 191             | (x,`CONTAINS(s)) -> (x, "contains()", s)
 192             | _ -> assert false
 193           in
 194             Printf.eprintf "Will jump to %s %s occuring %i time\n%!" s1 s2 occ
 195         in
 196           Printf.eprintf "Execution time %s : "
 197             (if !Options.count_only then "(counting only)" else if !Options.backward then "(bottomup)" else "");
 198           begin
 199             let _ = Gc.full_major();Gc.compact() in
 200             let _ = Printf.eprintf "%!" in
 201             let _ = Gc.set (tuned_gc) in
 202               if !Options.backward && ((snd test_list) != `NOTHING )then
 203                 if !Options.count_only then
 204                 let r = time_mem (bottom_up_count auto v )(snd test_list)  in
 205                 let _ = Printf.eprintf "Number of nodes in the result set : %i\n%!" r
 206                 in ()
 207                 else begin
 208                 let r = time_mem (bottom_up auto v )(snd test_list)  in
 209                 let _ = Printf.eprintf "Number of nodes in the result set : %i\n%!" (IdSet.length r)
 210                 in
 211                   match output with
 212
 213                     | None -> ()
 214                     | Some f ->
 215                         Printf.eprintf "Serializing results : ";
 216                         time( fun () ->
 217                                 (*let oc = open_out f in *)
 218                                 let oc = Unix.openfile f [ Unix.O_WRONLY;Unix.O_TRUNC;Unix.O_CREAT] 0o644 in
 219                                 (*output_string oc "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";*)
 220                                 IdSet.iter (fun t ->
 221                                               Tree.print_xml_fast3 v t oc;
 222                                               (*output_char oc '\n'; *)
 223                                            ) r) ();
 224                 end
 225
 226               else
 227                 let _ =
 228                   if !Options.backward then Printf.eprintf "WARNING: couldn't find a jumping point, running top-down\n"
 229                 in
 230                 if !Options.count_only then
 231                   let r = time ~count:5 ( top_down_count1 auto ) v in
 232                   let _ = Printf.eprintf "Number of nodes in the result set : %i\n%!" r
 233                   in ()
 234                 else
 235                 let module GR = Ata(*.Test(struct let doc = v end) *) in
 236                   let result = time ~count:5 (GR.top_down1 auto) v in
 237                   let _ = Printf.eprintf "Counting results " in
 238                   let rcount = time (IdSet.length) result in
 239                     Printf.eprintf "Number of nodes in the result set : %i\n" rcount;
 240                     Printf.eprintf "\n%!";
 241                     begin
 242                       match output with
 243                         | None -> ()
 244                         | Some f ->
 245                             Printf.eprintf "Serializing results : ";
 246                             let oc =
 247                               Unix.openfile f [ Unix.O_WRONLY;Unix.O_TRUNC;Unix.O_CREAT] 0o644
 248                             in
 249                             time(
 250                               IdSet.iter (
 251                                 fun t ->
 252
 253                                   Tree.print_xml_fast3 v t oc;
 254
 255                               )) result ;
 256  end;
 257           end;
 258           Printf.eprintf "Total running time : %fms\n%!" (total_time())
 259 ;;
 260
 261 Options.parse_cmdline();;
 262
 263 let v =
 264   if (Filename.check_suffix !Options.input_file ".srx")
 265   then
 266     begin
 267       Printf.eprintf "Loading from file : ";
 268       time (Tree.load  ~sample:!Options.sample_factor ~load_text:(not !Options.count_only))
 269         !Options.input_file;
 270         end
 271   else
 272     let v =
 273       time (fun () -> let v = Tree.parse_xml_uri !Options.input_file;
 274             in Printf.eprintf "Parsing document : %!";v
 275            ) ()
 276     in
 277       if !Options.save_file <> ""
 278       then begin
 279         Printf.eprintf "Writing file to disk : ";
 280         time (Tree.save v) !Options.save_file;
 281       end;
 282       v
 283 in
 284   main v !Options.query !Options.output_file;;
 285
 286
 287