Fixed caching bugs in ata.ml

[SXSI/xpathcomp.git] / main.ml

diff --git a/main.ml b/main.ml
index 2f12d19..ee14b34 100644 (file)
--- a/main.ml
+++ b/main.ml
@@ -13,13 +13,34 @@ let enabled_gc = Gc.get()
 let disabled_gc = { Gc.get() with
                      Gc.max_overhead = 1000000; 
                      Gc.space_overhead = 100 }
-
-
-
-
+let hash x = 131*x/(x-1+1)
+let test_loop tree tag =
+  let t' = Tree.tagged_desc tree tag  Tree.root in
+  let f = Hashtbl.create 4096
+  in
+  let jump t _ =  Tree.tagged_foll_ctx tree tag t Tree.root in
+  let g t ctx = 
+    if t == Tree.nil then 0
+    else 1+ ((Hashtbl.find f (hash 101)) (jump t ctx) ctx)
+  in
+  Hashtbl.add f (hash 101) g;
+  (Hashtbl.find f (hash 101)) t' Tree.root
+let test_loop2 tree tag =
+  let t' = Tree.tagged_desc tree tag  Tree.root in
+  let f = Hashtbl.create 4096
+  in
+  let jump t _ =  Tree.tagged_foll_ctx tree tag t Tree.root in
+  let rec g t ctx = 
+    if t == Tree.nil then 0
+    else 1+ (match (Hashtbl.find f (hash 101)) with
+               `Foo ->g (jump t ctx) ctx
+           ) 
+  in
+  Hashtbl.add f (hash 101) `Foo;
+  g t' Tree.root
 
 let main v query_string output =
-  
+ 
     let _ = Tag.init (Tree.tag_pool v) in
       Printf.eprintf "Parsing query : ";    
       let query = try
@@ -28,36 +49,42 @@ let main v query_string output =
       with
          Ulexer.Loc.Exc_located ((x,y),e) -> Printf.eprintf "character %i-%i %s\n" x y (Printexc.to_string e);exit 1
       in
-       XPath.Ast.print Format.err_formatter query;
-       Format.fprintf Format.err_formatter "\n%!";
-       Printf.eprintf "Compiling query : ";
-       let auto,ltags,contains = time (XPath.Compile.compile ~querystring:query_string) query in 
-       let _ = Ata.dump Format.err_formatter auto in
-       let _ = Printf.eprintf "%!" in
-       let jump_to = 
-         match contains with
-             None -> (max_int,`NOTHING)
-           | Some s -> 
-               let r = Tree.count v s 
-               in
-                 Printf.eprintf "%i documents in the TextCollection\n" (Tree.text_size v);
-                 Printf.eprintf "Global count is %i, using " r;
-                 if r < !Options.tc_threshold then begin                 
-                   Printf.eprintf "TextCollection contains\nCalling global contains : ";
-                   time (Tree.init_contains v) s;
-                 end
-                 else begin
-                   Printf.eprintf "Naive contains\nCalling global contains : ";
-                   time (Tree.init_naive_contains v) s
-                 end;(r,`CONTAINS(s))
-       in
-       let test_list = jump_to in
-       (*
+      let _ = Printf.eprintf "Timing //keyword :" in
+      let r = time (test_loop v) (Tag.tag "keyword") in
+      let _ = Printf.eprintf "Count is %i\n%!" r in
+      let _ = Printf.eprintf "Timing //keyword 2:" in
+      let r = time (test_loop2 v) (Tag.tag "keyword") in
+      let _ = Printf.eprintf "Count is %i\n%!" r in
+      XPath.Ast.print Format.err_formatter query;
+      Format.fprintf Format.err_formatter "\n%!";
+      Printf.eprintf "Compiling query : ";
+      let auto,ltags,contains = time (XPath.Compile.compile ~querystring:query_string) query in 
+      let _ = Ata.dump Format.err_formatter auto in
+      let _ = Printf.eprintf "%!" in
+      let jump_to = 
+       match contains with
+          None -> (max_int,`NOTHING)
+         | Some s -> 
+             let r = Tree.count v s 
+             in
+             Printf.eprintf "%i documents in the TextCollection\n" (Tree.text_size v);
+             Printf.eprintf "Global count is %i, using " r;
+             if r < !Options.tc_threshold then begin             
+               Printf.eprintf "TextCollection contains\nCalling global contains : ";
+               time (Tree.init_contains v) s;
+             end
+             else begin
+               Printf.eprintf "Naive contains\nCalling global contains : ";
+               time (Tree.init_naive_contains v) s
+             end;(r,`CONTAINS(s))
+      in
+      let test_list = jump_to in
+      (*
        let test_list = 
-         if (!Options.backward) then begin
-           Printf.eprintf "Finding min occurences : ";
-           time 
-             ( List.fold_left (fun ((min_occ,kind)as acc)  (tag,_) ->
+       if (!Options.backward) then begin
+       Printf.eprintf "Finding min occurences : ";
+       time 
+       ( List.fold_left (fun ((min_occ,kind)as acc)  (tag,_) ->
                              let numtags = Tree.subtree_tags v tag Tree.root in
                                if  ((numtags < min_occ) && numtags >= 2)
                                then (numtags,`TAG(tag))
@@ -78,7 +105,7 @@ let main v query_string output =
          begin
            let _ = Gc.full_major();Gc.compact() in
            let _ = Printf.eprintf "%!" in
-             (*            let _ = Gc.set (disabled_gc) in  *)
+           let _ = Gc.set (disabled_gc) in
              if !Options.backward && ((snd test_list) != `NOTHING )then 
                
                let r = time (bottom_up_count auto v )(snd test_list)  in