Merge from branch stable-succint-refactor
authorkim <kim@3cdefd35-fc62-479d-8e8d-bae585ffb9ca>
Mon, 2 Mar 2009 02:04:50 +0000 (02:04 +0000)
committerkim <kim@3cdefd35-fc62-479d-8e8d-bae585ffb9ca>
Mon, 2 Mar 2009 02:04:50 +0000 (02:04 +0000)
git-svn-id: svn+ssh://idea.nguyen.vg/svn/sxsi/trunk/xpathcomp@194 3cdefd35-fc62-479d-8e8d-bae585ffb9ca

Makefile
ata.ml
main.ml
ptset.ml
tree.ml

index 41ac259..ab38c4b 100644 (file)
--- a/Makefile
+++ b/Makefile
@@ -43,7 +43,7 @@ OCAMLOPT = ocamlopt -g -cc "$(CXX)"
 SYNT_DEBUG = -ppopt -DDEBUG
 else
 CXX = g++  
-OCAMLOPT = ocamlopt -cc "$(CXX)" -ccopt -O3 -ccopt -std=c++0x -noassert -inline 1000
+OCAMLOPT = ocamlopt -S -cc "$(CXX)" -ccopt -O3 -ccopt -std=c++0x -noassert -inline 1000
 endif
 ifeq ($(PROFILE), true)
 SYNT_PROF = $(SYNT_DEBUG) -ppopt -DPROFILE
@@ -74,6 +74,7 @@ main: libcamlshredder.a  $(MLOBJS)
 .cpp.o:
        @echo [CPP] $@
        $(HIDE) $(CXX) $(CXXINCLUDES) -c $(CXXFLAGS)  $<
+
 .ml.cmx:
        @echo [OCAMLOPT] $@
        $(HIDE) $(OCAMLFIND) $(OCAMLOPT) -package "$(OCAMLPACKAGES)"  $(SYNTAX) -c $<
diff --git a/ata.ml b/ata.ml
index d065b16..a9dbf22 100644 (file)
--- a/ata.ml
+++ b/ata.ml
@@ -42,19 +42,23 @@ and formula = { fid: int;
 module FormNode = 
 struct
   type t = formula
-  let hash = function
+  let hash t = match t.pos with 
     | False -> 0
     | True -> 1
-    | And(f1,f2) -> 2+17*f1.fid + 37*f2.fid
-    | Or(f1,f2) -> 3+101*f1.fid + 253*f2.fid
-    | Atom(d,b,s) -> 5+(if d=`Left then 11 else 19)*(if b then 23 else 31)*s
+    | And(f1,f2) -> (2+17*f1.fid + 37*f2.fid) land max_int
+    | Or(f1,f2) -> (3+101*f1.fid + 253*f2.fid) land max_int
+    | Atom(`Left,true,s) -> (5 + 11 * 23 * s) land max_int
+    | Atom(`Right,true,s) -> (5 + 19 * 23 * s) land max_int
+    | Atom(`Left,false,s) -> (5 + 11 * 39 * s) land max_int
+    | Atom(`Right,false,s) -> (5 + 19 * 39 * s) land max_int
 
-  let hash t = (hash t.pos) land max_int
 
   let equal f1 f2 = 
+    if f1.fid == f2.fid || f1.pos == f2.pos then true
+    else
     match f1.pos,f2.pos with
       | False,False | True,True -> true
-      | Atom(d1,b1,s1), Atom(d2,b2,s2) when (d1 = d2) && (b1=b2) &&(s1=s2) -> true
+      | Atom(d1,b1,s1), Atom(d2,b2,s2) when (b1==b2) &&  (s1=s2) && (d1 = d2) -> true
       | Or(g1,g2),Or(h1,h2) 
       | And(g1,g2),And(h1,h2)  -> g1.fid == h1.fid && g2.fid == h2.fid
       | _ -> false
@@ -150,7 +154,7 @@ module HTagSetKey =
 struct 
   type t = Ptset.t*Tag.t 
   let int_hash key = key lsl 31 lor (key lsl 8)
-  let equal (s1,s2) (t1,t2) = Tag.equal s2 t2 &&  Ptset.equal s1 t1
+  let equal (s1,s2) (t1,t2) =  (s2 == t2) &&  Ptset.equal s1 t1
   let hash (s,t) = int_hash (Ptset.hash s) lxor ( int_hash (Tag.hash t))
 end
 module HTagSet = Hashtbl.Make(HTagSetKey)
diff --git a/main.ml b/main.ml
index feecc1d..7cc631b 100644 (file)
--- a/main.ml
+++ b/main.ml
@@ -21,7 +21,23 @@ let time f x =
 ;;
 let total_time () =  List.fold_left (+.) 0. !l;;
 
+let poa = TagSet.add Tag.pcdata (TagSet.singleton Tag.attribute)
 
+let rec fill_hashtag t =
+  if Tree.Binary.is_node t then 
+    begin
+      let tag = Tree.Binary.tag t in
+      let a = 
+       if TagSet.mem tag poa
+       then 0
+       else
+         fill_hashtag (Tree.Binary.first_child t) 
+      in
+      let b = fill_hashtag (Tree.Binary.next_sibling t)
+      in a+b+1
+    end
+  else 0
+  
 
 let test_slashslash tree k =
   let test =
@@ -187,7 +203,12 @@ let main v query output =
       in
        XPath.Ast.print Format.err_formatter query;
        Format.fprintf Format.err_formatter "\n%!";
-       Printf.eprintf "Compiling query : ";    
+(*     Printf.eprintf "Dummy iteration : ";
+       time (fill_hashtag) v;
+       Printf.eprintf "Dummy iteration (tag access cached) : ";
+       time (fill_hashtag) v;
+*)
+       Printf.eprintf "Compiling query : ";
        let auto,_ = time XPath.Compile.compile  query in
          Printf.eprintf "Execution time %s : " (if !Options.count_only then "(counting only)" else "");
          begin
index 673523c..3d30f68 100644 (file)
--- a/ptset.ml
+++ b/ptset.ml
@@ -82,7 +82,7 @@ let branch_ne = function
 
 let zero_bit k m = (k land m) == 0
 
-let singleton k = if k < 0 then failwith "singleton" else leaf k
+let singleton k = leaf k
 
 let rec mem k n = match n.node with
   | Empty -> false
diff --git a/tree.ml b/tree.ml
index 354e031..780791a 100644 (file)
--- a/tree.ml
+++ b/tree.ml
@@ -133,6 +133,19 @@ struct
 (*    external tag : t -> [`Tree ] node -> T = "caml_xml_tree_tag"*)
     external tag_id : t -> [`Tree ] node -> Tag.t = "caml_xml_tree_tag_id"
 
+(*
+    let tag_hash = Hashtbl.create 4097
+
+    let tag_id t id = 
+      try 
+       Hashtbl.find tag_hash id
+      with
+       | Not_found -> 
+           let tag = tag_id t id in
+             Hashtbl.add tag_hash id tag;tag
+*)
+
+
     let is_last t n = equal nil (next_sibling t n)
     
     external prev_text : t -> [`Tree] node -> [`Text ] node = "caml_xml_tree_prev_text"