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
  12 let l = ref [] ;;
  13 let time f x =
  14   let t1 = Unix.gettimeofday () in
  15   let r = f x in
  16   let t2 = Unix.gettimeofday () in
  17   let t = (1000. *.(t2 -. t1)) in
  18     l:= t::!l;
  19     Printf.eprintf "  %fms\n%!" t ;
  20     r
  21 ;;
  22 let total_time () =  List.fold_left (+.) 0. !l;;
  23
  24
  25 let test_slashslash tree k =
  26   let test =
  27     match k with "*" -> TagSet.remove (Tag.tag "") TagSet.star
  28       | s -> TagSet.singleton (Tag.tag k)
  29   in
  30   let attorstring = TagSet.cup TagSet.pcdata TagSet.attribute in
  31   let rec aux t acc =
  32     if Tree.Binary.is_node t
  33     then
  34       let tag = Tree.Binary.tag t in
  35           let l = Tree.Binary.first_child t
  36           and r = Tree.Binary.next_sibling t
  37           in
  38           let acc =
  39             if TagSet.mem tag test
  40             then
  41               TS.append t acc
  42             else
  43               acc
  44           in
  45           let rl = if TagSet.mem tag attorstring then acc else aux l acc
  46           in aux r rl
  47     else
  48       acc
  49   in
  50   let _ = Printf.eprintf "Testing optimal //%s ... " k in
  51   let r = time (aux tree ) TS.empty in
  52   Printf.eprintf "Result set is %i nodes\n%!" (TS.length r)
  53
  54
  55 let test_jump tree k =
  56   let ttag = Tag.tag k in
  57
  58   let rec loop acc tree =
  59     if Tree.Binary.is_node tree
  60     then
  61       let acc = TS.cons tree acc in
  62         loop acc (Tree.Binary.tagged_next tree ttag)
  63     else
  64       acc
  65
  66   in
  67   let _ = Printf.eprintf "Testing jumping for tag %s ... " k in
  68   let r = time (loop TS.empty ) (Tree.Binary.tagged_next tree ttag) in
  69     Printf.eprintf "Result set is %i nodes\n%!" (TS.length r)
  70
  71
  72
  73 let test_traversal tree k =
  74   let ttag = Tag.tag k in
  75   let iid t = if Tree.Binary.is_node t then Tree.Binary.id t else -1 in
  76   let rec aux t =
  77     if Tree.Binary.is_node t
  78     then
  79       let tag = Tree.Binary.tag t in
  80       let l = Tree.Binary.first_child t
  81       and r = Tree.Binary.next_sibling t
  82       in
  83       let _ = Printf.eprintf "Tree with id %i and tag=%s, tagged_desc %s is %i tagged_foll is %i, tagged_next is %i\n%!"
  84         (Tree.Binary.id t) (Tag.to_string tag) (k)
  85         (iid (Tree.Binary.tagged_desc t ttag))
  86         (iid (Tree.Binary.tagged_foll t ttag))
  87         (iid (Tree.Binary.tagged_next t ttag))
  88       in
  89         aux l;
  90         aux r;
  91
  92     else
  93       ()
  94   in
  95     aux tree
  96
  97 let test_count_subtree tree k =
  98   let ttag = Tag.tag k in
  99   let _ = Printf.eprintf "Counting subtrees with tag %s ... %!" k in
 100   let r = time(Tree.Binary.subtree_tags tree) ttag in
 101     Printf.eprintf "%i nodes \n%!" r
 102
 103 let main v query output =
 104     let _ = Tag.init (Tree.Binary.tag_pool v) in
 105       Printf.eprintf "Parsing query : ";
 106       let query = try
 107         time
 108           XPath.Parser.parse_string query
 109       with
 110           Ulexer.Loc.Exc_located ((x,y),e) -> Printf.eprintf "character %i-%i %s\n" x y (Printexc.to_string e);exit 1
 111       in
 112         XPath.Ast.print Format.err_formatter query;
 113         Format.fprintf Format.err_formatter "\n%!";
 114         Printf.eprintf "Compiling query : ";
 115         let auto = time XPath.Compile.compile  query in
 116
 117         let _ = Ata.dump Format.err_formatter auto ;
 118                   Format.fprintf Format.err_formatter "\n%!"
 119         in
 120         let _ = test_count_subtree v "keyword" in
 121         let _ = test_jump v "keyword" in
 122
 123           Printf.eprintf "Execution time : ";
 124           let result = time (BottomUpNew.run auto) v in
 125             Printf.eprintf "Number of nodes in the result set : %i\n" (TS.length result);
 126             begin
 127               match output with
 128                 | None -> ()
 129                 | Some f ->
 130
 131                     Printf.eprintf "Serializing results : ";
 132                     time( fun () ->
 133                             let oc = open_out f in
 134                               output_string oc "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
 135                               TS.iter (fun t -> Tree.Binary.print_xml_fast oc t;
 136                                            output_char oc '\n') result) ();
 137             end;
 138         (*      let _ = Ata.dump Format.err_formatter auto  in
 139                   Format.fprintf Format.err_formatter "\n%!"; *)
 140               Printf.eprintf "Total time : %fms\n%!" (total_time())
 141 ;;
 142
 143
 144 Options.parse_cmdline();;
 145
 146 let v =
 147   if (Filename.check_suffix !Options.input_file ".srx")
 148   then
 149     begin
 150       Printf.eprintf "Loading from file : ";
 151       time (Tree.Binary.load  ~sample:!Options.sample_factor )
 152         (Filename.chop_suffix !Options.input_file ".srx");
 153     end
 154   else
 155     let v =
 156       time (fun () -> let v = Tree.Binary.parse_xml_uri !Options.input_file;
 157             in Printf.eprintf "Parsing document : %!";v
 158            ) ()
 159     in
 160       if !Options.save_file <> ""
 161       then begin
 162         Printf.eprintf "Writing file to disk : ";
 163         time (Tree.Binary.save v) !Options.save_file;
 164       end;
 165       v
 166 in
 167   main v !Options.query !Options.output_file;;
 168
 169 IFDEF DEBUG
 170 THEN
 171 Printf.eprintf "\n=================================================\nDEBUGGING\n%!";
 172
 173 Tree.DEBUGTREE.print_stats Format.err_formatter;;
 174 Gc.full_major()
 175 ENDIF