X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Ftable.ml;h=64d4103ba64558375126848ae1914c2c993d0561;hb=72818d02fb469c39a3d8043300152beae3e7e162;hp=7a49b75337bb38dcb0c19c1822a59015efc69639;hpb=cb10072a53278e0f5c6f6ddf9679dbd9643c7f7e;p=tatoo.git

diff --git a/src/table.ml b/src/table.ml
index 7a49b75..64d4103 100644
--- a/src/table.ml
+++ b/src/table.ml
@@ -1,10 +1,4 @@
 
-type move = Self
-	    | Firstchild
-	    | Nextsibling
-	    | Revfirstchild
-	    | Prevsibling
-
 type query_tree_desc = Binop of op * query_tree * query_tree
 		       | Axis of Xpath.Ast.axis * query_tree
 		       | Start 
@@ -70,6 +64,14 @@ let rec union_list t l1 l2 =
       else if (comp_node t h1 h2) then h1::(union_list t ll1 l2)
       else h1 ::(union_list t ll1 ll2)
 
+let rec merge_list t l1 l2 =
+  match l1,l2 with
+    | [],l2 -> l2
+    | l1,[] -> l1
+    | h1::ll1, h2::ll2 -> if (comp_node t h2 h1) then h1:: (merge_list t ll1 l2)
+      else if (comp_node t h1 h2) then h2:: (merge_list t l1 ll2)
+      else h1::(merge_list t ll1 ll2)
+
 let rec inter_list t l1 l2 =
   match l1,l2 with
     | [],l2 -> []
@@ -111,59 +113,7 @@ and print_binop fmt o =
     | Inter -> Format.fprintf fmt "Inter"
     | Diff -> Format.fprintf fmt "Diff"
 
-let rec eval_relation tree m n =
-  match m with
-      Self -> n
-    | Firstchild ->  Naive_tree.first_child tree n
-    | Nextsibling -> Naive_tree.next_sibling tree n
-    | Revfirstchild -> Naive_tree.parent_of_first tree n
-    | Prevsibling -> Naive_tree.prev_sibling tree n
-
-(*28/01/2014  
-  parametres : tree  l'arbre xml
-               ls    l'ensemble de noeuds
-               m     move   
-  retour : l'ensemble de noeuds qui correspondent ॆ la relation r
-*)
-
-
- 
-
-let rec eval_move tree ls m =
-  match m with
-      Self -> ls
-    | r -> List.filter (fun n -> n != Naive_tree.nil)
-           (List.map (eval_relation tree r) ls) 
 	   
-
-(*28/01/2014  
-  parametres : tree  l'arbre xml
-               ls    l'ensemble de noeuds
-               m     move   
-  retour : l'ensemble de noeuds qui correspondent ॆ des relations lr
-*)
-
-and eval_star tree ls lr =
-  let h = Hashtbl.create 17 in
-  let q = Queue.create () in
-  List.iter ( fun e -> Queue.add e q ) ls;
-  while not (Queue.is_empty q ) do
-    let n = Queue.pop q in
-    if not (Hashtbl.mem h n) then begin
-      Hashtbl.add h n ();
-      List.iter ( fun r -> let m = eval_relation tree r n in
-			   if m != Naive_tree.nil && not (Hashtbl.mem h m ) then begin
-			     
-			     Queue.add m q; end
-      ) lr
-    end
-  done;
-  let l = Hashtbl.fold (fun k _ acc -> k::acc) h [] in
-  l
- (*  
- Tas.sort_of_list tree l 
-  List.sort (compare_node tree) l*)
-
 let rec compare_node_list tree l1 l2 =
   match l1,l2 with
       [],[] -> 0
@@ -172,125 +122,176 @@ let rec compare_node_list tree l1 l2 =
     | n1::ll1,n2::ll2 -> let b = compare_node tree n1 n2 in
 			 if b=0 then compare_node_list tree ll1 ll2 
 			 else b
-			   
-let get_descendant tree ln =
+
+
+
+let bitvector_of_nodes tree l =
+  let v = Bitvector.create (Naive_tree.size tree) in
+  List.iter(fun n -> let j = Naive_tree.preorder tree n in 
+		     Bitvector.set v j true ) l;
+  v
+
+let decode_bit tree v = 
+  let l = ref [] in
+  for i = 0 to (Bitvector.length v) - 1 do
+    if Bitvector.get v i then
+      let n = Naive_tree.by_preorder tree i in
+      l := n::!l
+  done;
+  List.rev !l
+
+let get_list_ordred tree ll =
+  let l1 = List.fold_left (fun acc l -> merge_list tree acc l) [] ll in
+  List.rev l1
+
+let get_descendant tree v =
   let rec aux n acc =
-    if n == Naive_tree.nil then  acc
-    else let n1 = Naive_tree.first_child tree n in 
-	 let acc1 = aux n1 (n::acc) in
-	 let n2 = Naive_tree.next_sibling tree n in
-	 let acc2 = aux n2 acc1 in
-	 acc2
-  in
-  let l = List.fold_left (fun acc n -> if List.mem n acc then acc 
+    if n == Naive_tree.nil then acc
     else let n1 = Naive_tree.first_child tree n in
-	 aux n1 acc) [] ln 
-  in
-  List.rev l 
+	 let j = Naive_tree.preorder tree n in
+	 Bitvector.set acc j true;
+	 let acc1 = aux n1 acc in
+	 let n2 = Naive_tree.next_sibling tree n in
+	 aux n2 acc1
+  in	    
+  let v0 = Bitvector.create (Naive_tree.size tree) in
+ (* let v = bitvector_of_nodes tree ln in*)
+  for i = 0 to (Bitvector.length v)-1 do
+    if Bitvector.get v i then
+      let n = Naive_tree.by_preorder tree i in
+      let n1 = Naive_tree.first_child tree n in
+      let _ = aux n1 v0 in ();
+  done;
+  v0
 
-let get_child tree ln =
+let get_child tree v =
   let rec aux n acc =
     if n == Naive_tree.nil then acc
-    else 
+    else
       let n1 = Naive_tree.next_sibling tree n in
-      aux n1 (n::acc)
+      Bitvector.set acc (Naive_tree.preorder tree n) true;
+      aux n1 acc
   in
-  let ll = List.map (fun  n->
-    let n1 = Naive_tree.first_child tree n in
-    let res = aux n1 [] in
-    List.rev res
-  )  ln in
-  List.fold_left (fun acc l -> union_list tree acc l) [] ll
+  let v0 = Bitvector.create (Naive_tree.size tree) in
+  (*let v = bitvector_of_nodes tree ln in*)
+  for i = 0 to (Bitvector.length v)-1 do
+    if Bitvector.get v i then
+      let n = Naive_tree.by_preorder tree i in
+      let n1 = Naive_tree.first_child tree n in
+      let _ = aux n1 v0 in ();
+  done;
+  v0
 
   
-let get_followingSibling tree ln =
+let get_followingSibling tree v =
   let rec aux n acc =
     let n1 = Naive_tree.next_sibling tree n in
     if n1 == Naive_tree.nil then acc
-    else aux n1 (n1::acc)
+    else begin
+      Bitvector.set acc (Naive_tree.preorder tree n1) true;
+      aux n1 acc end
   in
-  let ll = List.map (fun n -> let res = aux n [] in
-			      List.rev res ) ln in
-  List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll 
+  let v0 = Bitvector.create (Naive_tree.size tree) in
+ (* let v = bitvector_of_nodes tree ln in*)
+  for i = 0 to (Bitvector.length v)-1 do
+    if Bitvector.get v i then
+      let n = Naive_tree.by_preorder tree i in
+      let _ = aux n v0 in ();
+  done;
+  v0
   
- 
 let rec get_firstBling tree n pred =
   if n== Naive_tree.nil then pred
   else get_firstBling tree (Naive_tree.prev_sibling tree n) n
     
-let get_parent tree ln =
-  let l = List.fold_left (fun acc n ->
-    let n1 = get_firstBling tree n Naive_tree.nil in
-    let n2 = Naive_tree.parent_of_first tree n1 in
-    if n2 == Naive_tree.nil or List.mem n2 acc then acc
-    else union_list tree [n2] acc   
-  ) [] ln
-  in
-  l
-
-  
+let get_parent tree v = 
+  let v0 = Bitvector.create (Naive_tree.size tree) in
+ (* let v = bitvector_of_nodes tree ln in*)
+  for i = 0 to (Bitvector.length v)-1 do
+    if Bitvector.get v i then
+      let n = Naive_tree.by_preorder tree i in
+      let n1 = get_firstBling tree n Naive_tree.nil in
+      let n2 = Naive_tree.parent_of_first tree n1 in
+      if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
+					 Bitvector.set v0 j true
+      end
+  done;
+  v0
+
+let get_ancestor tree v =
+  let v0 = Bitvector.create (Naive_tree.size tree) in
+ (* let v = bitvector_of_nodes tree ln in  *)
+
+  for i = (Bitvector.length v)-1 downto 0 do
+    if Bitvector.get v i then
+      let n = Naive_tree.by_preorder tree i in
+      let n0 = ref n in
+      while !n0 != Naive_tree.nil do
+	let n1 = get_firstBling tree !n0 Naive_tree.nil in
+	let n2 = Naive_tree.parent_of_first tree n1 in
+	n0 := n2;
+	if n2 != Naive_tree.nil then begin let j = Naive_tree.preorder tree n2 in
+					   Bitvector.set v0 j true;
+					   Bitvector.set v j true;
+	end
+      done;
+  done;
+  v0
 
-let get_ancestor tree ln =
-  let rec aux tree l1 acc =
-    match l1 with
-	[] -> acc
-      | _ -> let ll1 = get_parent tree l1 in
-	     let acc1 = union_list tree acc ll1 in
-	     aux tree ll1  acc1
-  in  
-  let l = aux tree ln [] in
-  l
-
-let get_preSibling tree ln =
+let get_preSibling tree v =
   let rec aux n acc =
     let n1 = Naive_tree.prev_sibling tree n in
     if n1 == Naive_tree.nil then acc
-    else aux n1 (n1::acc)
+    else begin
+      Bitvector.set acc (Naive_tree.preorder tree n1) true;
+      aux n1 acc end
   in
-  let ll = List.map (fun n -> aux n [] ) ln in
-  List.fold_left (fun acc l1 -> union_list tree acc l1) [] ll 
+  let v0 = Bitvector.create (Naive_tree.size tree) in
+ (* let v = bitvector_of_nodes tree ln in*)
+  for i = 0 to (Bitvector.length v)-1 do
+    if Bitvector.get v i then
+      let n = Naive_tree.by_preorder tree i in
+      let _ = aux n v0 in ()
+  done;
+  v0
+
   
     
 
-let rec eval_axis tree ls a =
+let rec eval_axis tree v a =
   let open Xpath.Ast in
 	match a with
-	    Self -> ls
+	    Self -> v
 	      
-	  | Attribute -> get_child tree ls
+	  | Attribute -> get_child tree v
 	    
-	  | Child -> get_child tree ls
+	  | Child -> get_child tree v
 		       
-	  | Descendant c -> let ls2 = get_descendant tree ls in
-			    let ldes =
-			      if not c then ls2
-			      else union_list tree ls2 ls
-			    in
-			    ldes
+	  | Descendant c -> let v2 = get_descendant tree v in
+			    if not c then v2
+			    else Bitvector.union v2 v
+			   
 			      
-	  | FollowingSibling -> get_followingSibling tree ls
+	  | FollowingSibling -> get_followingSibling tree v
 				  
-	  | Parent -> get_parent tree ls
+	  | Parent -> get_parent tree v
 			
-	  | Ancestor b -> 
-			  let ls3 = get_ancestor tree ls in
-			  let lac =
-			  if not b then ls3
-			  else union_list tree ls3 ls    
-			  in
-			  lac
+	  | Ancestor b -> let v2 = get_ancestor tree v in
+			  if not b then v2
+			  else Bitvector.union v2 v    
+			  
 			    
-	  | PrecedingSibling -> get_preSibling tree ls
+	  | PrecedingSibling -> get_preSibling tree v
 				  
-	  | Preceding -> let ls2 = eval_axis tree ls (Ancestor true) in
-			 let ls3 = eval_axis tree ls2 PrecedingSibling in
-			 let lp = eval_axis tree ls3 (Descendant true) in
-			 lp
+	  | Preceding -> let v2 = eval_axis tree v (Ancestor true) in
+			 let v3 = eval_axis tree v2 PrecedingSibling in
+			 eval_axis tree v3 (Descendant true) 
+			
 			 
-	  | Following -> let ls2 = eval_axis tree ls (Ancestor true) in
-			 let ls3 = eval_axis tree ls2 FollowingSibling in
-			 let lf = eval_axis tree ls3 (Descendant true) in
-			 lf
+	  | Following -> let v2 = eval_axis tree v (Ancestor true) in
+			 let v3 = eval_axis tree v2 FollowingSibling in
+			 eval_axis tree v3 (Descendant true) 
+