Fix descendant-or-self (which wrongly looked for elements in the

[tatoo.git] / src / xpath / compile.ml

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index 123583f..7848b84 100644 (file)
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-09 11:09:12 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-10 12:28:07 CET by Kim Nguyen>
 *)
 
 open Ast
@@ -26,6 +26,14 @@ let ( => ) a b = (a, b)
 let ( ++ ) a b = Ata.SFormula.or_ a b
 let ( %% ) a b = Ata.SFormula.and_ a b
 let ( @: ) a b = StateSet.add a b
+(*
+let add_attribute_prefix test =
+  if QNameSet.is_finite test then
+    QNameSet.fold (fun tag acc ->
+      QNameSet.add (QName.add_attribute_prefix tag) acc)
+      test QNameSet.empty
+  else test
+*)
 
 module F = Ata.SFormula
 
@@ -46,8 +54,9 @@ let root_set = QNameSet.singleton QName.document
    holds.
 *)
 
-let compile_axis_test axis test phi trans states =
+let compile_axis_test ?(block_attr=true) axis test phi trans states =
   let q = State.make () in
+  let phi_attr = if block_attr then F.not_ F.is_attribute else F.true_ in
   let phi', trans', states' =
     match axis with
     | Self ->
@@ -57,16 +66,24 @@ let compile_axis_test axis test phi trans states =
 
     | Child ->
         (F.first_child q,
-         (q, [ test => phi;
+         (q, [ test => phi %% phi_attr;
                QNameSet.any => F.next_sibling q ]) :: trans,
          states)
 
-    | Descendant self ->
-        ((if self then F.stay q else F.first_child q),
-         (q, [ test => phi;
+    | Descendant false ->
+        (F.first_child q,
+         (q, [ test => phi %% phi_attr;
                QNameSet.any => F.first_child q ++ F.next_sibling q;
              ]) :: trans,
          states)
+    | Descendant true ->
+        let q' = State.make () in
+        (F.or_ (F.stay q) (F.first_child q'),
+         (q', [ test => phi %% phi_attr;
+               QNameSet.any => F.first_child q' ++ F.next_sibling q';
+             ])::
+         (q, [ test => phi %% phi_attr]):: trans,
+         states)
 
     | Parent ->
         let q' = State.make () in
@@ -92,17 +109,11 @@ let compile_axis_test axis test phi trans states =
           else F.next_sibling q
         in
         move,
-        (q, [ test => phi;
+        (q, [ test => phi %% phi_attr;
               QNameSet.any => move ]) :: trans,
         states
 
     | Attribute ->
-        let test = if QNameSet.is_finite test then
-            QNameSet.fold (fun tag acc ->
-              QNameSet.add (QName.add_attribute_prefix tag) acc)
-              test QNameSet.empty
-          else test
-        in
         (F.first_child q,
          (q, [ test => phi %% F.is_attribute;
                QNameSet.any => F.next_sibling q]) :: trans,
@@ -113,10 +124,13 @@ let compile_axis_test axis test phi trans states =
   phi', trans', q @: states'
 
 
-let compile_rev_axis_test axis test phi trans states =
+let compile_rev_axis_test block_attr axis test phi trans states =
   match axis with
-  | Attribute -> assert false
-  | _ -> compile_axis_test (invert_axis axis) test phi trans states
+  | Attribute ->
+      compile_axis_test
+        ~block_attr:false Parent test phi trans states
+  | _ -> compile_axis_test
+      ~block_attr:block_attr (invert_axis axis) test phi trans states
 
 let rec compile_expr e trans states =
   match e with
@@ -163,19 +177,26 @@ and compile_step_list l trans states =
         aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
 
 let compile_top_level_step_list l trans states =
-  let rec loop l trans states phi_above =
+  let rec loop l trans states block_attr phi_above =
     match l with
     | (axis, test, elist) :: [] ->
         let phi0, trans0, states0 =
-          compile_rev_axis_test axis QNameSet.any phi_above trans states
+          compile_rev_axis_test
+            block_attr axis QNameSet.any phi_above trans states
         in
         let phi1, trans1, states1 =
           List.fold_left (fun (aphi, atrans, astates) e ->
             let ephi, etrans, estates = compile_expr e atrans astates in
             aphi %% ephi, etrans, estates) (phi0, trans0, states0) elist
         in
+        let phi' =
+          if axis = Attribute then
+            F.is_attribute
+          else
+            F.not_ F.is_attribute
+        in
         let _, trans2, states2 =
-          compile_axis_test Self test phi1 trans1 states1
+          compile_axis_test Self test (phi1 %% phi') trans1 states1
           in
         let marking_state =
           StateSet.choose (StateSet.diff states2 states1)
@@ -183,7 +204,8 @@ let compile_top_level_step_list l trans states =
         marking_state, trans2, states2
     | (axis, test, elist) :: ll ->
         let phi0, trans0, states0 =
-          compile_rev_axis_test axis QNameSet.any phi_above trans states
+          compile_rev_axis_test
+            block_attr axis QNameSet.any phi_above trans states
         in
         let phi1, trans1, states1 =
           compile_axis_test Self test phi0 trans0 states0
@@ -193,7 +215,7 @@ let compile_top_level_step_list l trans states =
               let ephi, etrans, estates = compile_expr e atrans astates in
               aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
           in
-          loop ll trans2 states2 phi2
+          loop ll trans2 states2 (axis != Attribute) phi2
     | _ -> assert false
   in
   let phi0, trans0, states0 =
@@ -204,7 +226,7 @@ let compile_top_level_step_list l trans states =
       trans
       states
   in
-  loop l trans0 states0 phi0
+  loop l trans0 states0 true phi0
 ;;