1) Utiliser bitvector pour preserver l'ordre pendant l'evaluation

2) Nettoyer les code inutile.

diff --git a/src/bitvector.ml b/src/bitvector.ml
index a44a58e..73d2aee 100644 (file)
--- a/src/bitvector.ml
+++ b/src/bitvector.ml
@@ -14,7 +14,34 @@ let unsafe_get v n =
   and j = n mod 8 in
   (((Char.code (String.unsafe_get v.bits i)) lsr j) land 1) == 1
 
+let union v1 v2 =
+  assert ( v1.length == v2.length );
+  let res = create v1.length in
+ (* Format.printf "size %d@." (String.length res.bits);*)
+  for i = 0 to String.length v1.bits - 1 do
+      res.bits.[i] <- Char.chr ((Char.code v1.bits.[i]) lor (Char.code v2.bits.[i]))
+  done;
+  res
 
+let inter v1 v2 =
+   assert ( v1.length == v2.length );
+  let res = create v1.length in
+  for i = 0 to String.length v1.bits - 1 do
+    res.bits.[i] <- Char.chr ((Char.code v1.bits.[i]) land (Char.code v2.bits.[i]))
+  done;
+  res
+
+let diff v1 v2 =
+  assert ( v1.length == v2.length );
+  let res = create v1.length in
+  for i = 0 to String.length v1.bits - 1 do
+    res.bits.[i] <- Char.chr (if (Char.code v1.bits.[i]) != ( (Char.code v2.bits.[i])) then 1
+      else 0 )
+  done;
+  res
+
+
+ 
 let unsafe_set v n (b:bool) =
   let x : int = Obj.magic b in
   let i = n / 8

diff --git a/src/bitvector.mli b/src/bitvector.mli
index 2bd31eb..a713185 100644 (file)
--- a/src/bitvector.mli
+++ b/src/bitvector.mli
@@ -7,3 +7,7 @@ val get : t -> int -> bool
 
 val unsafe_set : t -> int -> bool -> unit
 val unsafe_get : t -> int -> bool
+val union : t -> t -> t
+val inter : t -> t -> t
+val diff  : t -> t -> t
+

diff --git a/src/query_tree.ml b/src/query_tree.ml
index 9dcd0d5..d9a226f 100644 (file)
--- a/src/query_tree.ml
+++ b/src/query_tree.ml
@@ -2,16 +2,17 @@ open Table
 
 let compteur = ref 0
 let table_qtree = QTreeHash.create 97
-
-let all_nodes tree = let root = Naive_tree.root tree in
-                    let acc1 = get_descendant tree [root] in
-                    root::acc1
-       
-
-let element_by_tag tree tagset kind = let dom = all_nodes tree in
-                             List.filter (fun c ->
-                               Tree.NodeKind.is_a (Naive_tree.kind tree c) kind &&
-                               QNameSet.mem (Naive_tree.tag tree c) tagset ) dom
+                       
+
+let element_by_tag tree tagset kind = let v = Bitvector.create (Naive_tree.size tree) in
+                                     for i=0 to (Bitvector.length v)-1 do
+                                       let c = Naive_tree.by_preorder tree i in
+                                       if (Tree.NodeKind.is_a (Naive_tree.kind tree c) kind &&
+                                             QNameSet.mem (Naive_tree.tag tree c) tagset )
+                                       then Bitvector.set v i true
+                                     done;
+                                     v
+                        
 
 let mk_node q = {desc = q; id = -1; hash = -1}
 
@@ -145,23 +146,28 @@ let rec eval_qtree tree start q =
        let res =
        match q.desc with
          | Start -> start
-         | Dom ->  all_nodes tree          
+         | Dom -> (* Bitvector.create true (Naive_tree.size tree)*)
+           let v = Bitvector.create (Naive_tree.size tree) in
+           for i=0 to (Bitvector.length v)-1 do
+             Bitvector.set v i true
+           done;
+           v
          | Tag (t,k) -> element_by_tag tree t k                     
-         | Axis (a,q1) -> let ls = eval_qtree tree start q1 in
-                          eval_axis tree ls a                     
+         | Axis (a,q1) -> let v = eval_qtree tree start q1 in
+                          eval_axis tree v a                      
          | Binop (op,q1,q2)-> begin
-           let ls1 = eval_qtree tree start q1 in
-           let ls2 = eval_qtree tree start q2 in
+           let v1 = eval_qtree tree start q1 in
+           let v2 = eval_qtree tree start q2 in
            match op with         
-             | Union -> union_list tree ls1 ls2            
-             | Inter -> inter_list tree ls1 ls2
-             | Diff -> diff_list tree ls1 ls2
+             | Union -> Bitvector.union v1 v2      
+             | Inter -> Bitvector.inter v1 v2
+             | Diff -> Bitvector.diff  v1 v2
          end
        in
        QTreeHash.add table_qtree q res;
-       compteur := !compteur + (List.length res);
+       compteur := !compteur + Bitvector.length res; (*????8*)
        res
     end
   in
-  debug tree q resultat;
+ (* debug tree q resultat;*)
   resultat

diff --git a/src/query_tree.mli b/src/query_tree.mli
index 6a8678f..7335e52 100644 (file)
--- a/src/query_tree.mli
+++ b/src/query_tree.mli
@@ -1,12 +1,7 @@
 val compteur : int ref
 (**the counter of nodes*)
 
-val all_nodes : Naive_tree.t -> Naive_tree.node list
-(** [all_nodes t] returns all the nodes in the tree [t].
-    Returns an empty list if there are no nodes in the tree.
- *)
-
-val element_by_tag : Naive_tree.t -> QNameSet.t -> Tree.NodeKind.t -> Naive_tree.node list
+val element_by_tag : Naive_tree.t -> QNameSet.t -> Tree.NodeKind.t -> Bitvector.t
 (** [element_by_tag t tag] returns all the nodes whose tag equal to [tag] in the tree [t]. *)
 
 val compile_single_path : Xpath.Ast.single_path -> Table.query_tree 
@@ -23,7 +18,7 @@ val minimize_qtree : Table.query_tree -> Table.query_tree
     [q] query_tree
 *)
 
-val eval_qtree : Naive_tree.t -> Naive_tree.node list ->Table.query_tree -> Naive_tree.node list
+val eval_qtree : Naive_tree.t -> Bitvector.t ->Table.query_tree -> Bitvector.t
 (** [eval_qtree tree start q] returns the set of nodes that evaluate by the query_tree [q].
     [start] the set of nodes departing.
     [q] query_tree

diff --git a/src/table.ml b/src/table.ml
index 15d39bc..64d4103 100644 (file)
--- a/src/table.ml
+++ b/src/table.ml
@@ -123,121 +123,175 @@ let rec compare_node_list tree l1 l2 =
                         if b=0 then compare_node_list tree ll1 ll2 
                         else b
 
+
+
+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 ln =
+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
+    if n == Naive_tree.nil then acc
+    else let n1 = Naive_tree.first_child tree n in
+        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
-        let acc2 = aux n2 acc1 in
-        acc2
-  in
-  let ll = List.map (fun n -> 
-    let n1 = Naive_tree.first_child tree n in
-    aux n1 [] ) ln in
-  get_list_ordred tree ll
+        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
-    aux n1 [] )  ln in
-  get_list_ordred tree 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 -> aux n [] ) ln in
-  get_list_ordred tree 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 =
-  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 then union_list tree [n2] acc   
-    else acc
-  ) [] ln
- 
+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) 
+                       
       
                     
 

diff --git a/src/table_driver.ml b/src/table_driver.ml
index f690b74..d42743e 100644 (file)
--- a/src/table_driver.ml
+++ b/src/table_driver.ml
@@ -30,8 +30,11 @@ let main () =
   let mini_qtree_list = 
     List.map (fun qtree -> Query_tree.minimize_qtree qtree) query_tree_list 
   in
+  let root = Bitvector.create (Naive_tree.size doc) in
+  Bitvector.set root 0 true;
   List.iter ( fun q -> 
-    let res = eval_qtree doc [ (Naive_tree.root doc) ] q in
+    let v = eval_qtree doc root q in
+    let res = decode_bit doc v in
     print_string "<xml_result num=\"1\" >\n";
     print_node_list doc res;
     print_string "</xml_result>\n";

diff --git a/todo.txt b/todo.txt
new file mode 100644 (file)
index 0000000..1d33861
--- /dev/null
+++ b/todo.txt
@@ -0,0 +1 @@
+c7229e6e3c000938a74abeb52749f62a65c3bbfd