X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=main.ml;h=b30eff286dd6cd14f69de1f29ae8937fe01ab4c1;hb=3445f7f08f15fe41e0d1bfaaabaacf60cdc10b61;hp=021a18e935bc2b1886aab07cbaec018aa2b65ac5;hpb=04639fe524ee20f7f84c8b08387312d714c9bd56;p=SXSI%2Fxpathcomp.git

diff --git a/main.ml b/main.ml
index 021a18e..b30eff2 100644
--- a/main.ml
+++ b/main.ml
@@ -6,24 +6,41 @@
 (******************************************************************************)
 
 open Ata
+INCLUDE "utils.ml"
+let () = init_timer();;
 
-let l = ref [] ;;
-let time f x =
-  let t1 = Unix.gettimeofday () in
-  let r = f x in
-  let t2 = Unix.gettimeofday () in 
-  let t = (1000. *. (t2 -. t1)) in
-    l:= t::!l;
-    Printf.eprintf "  %fms\n%!" t ;
-    r
-;;
-let total_time () =  List.fold_left (+.) 0. !l;;
 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
@@ -32,41 +49,49 @@ 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 _ = 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))
 				else acc) jump_to) ltags
 	  end
 	  else (max_int,`NOTHING)
-	in
+	in*)
 	let _ = if (snd test_list) != `NOTHING then
 	  let occ,s1,s2 = match test_list with
 	    | (x,`TAG (tag)) -> (x, "tag", (Tag.to_string tag))
@@ -80,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
@@ -120,7 +145,7 @@ let main v query_string output =
 
 Options.parse_cmdline();;
 
-let v = 
+let v =
   if (Filename.check_suffix !Options.input_file ".srx")
   then 
     begin