X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fcompile.ml;fp=src%2Fxpath%2Fcompile.ml;h=1c46b8f93b42f8154c475c87295c9b52793b67df;hp=123583fc750fb849e961ecd87f00e754c9050def;hb=7aa6c5c4e2b329bbf5fa7cc31a7542ba48ace84f;hpb=54d24e939b72601a55832aa447ed31f1b256f02e

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index 123583f..1c46b8f 100644
--- 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-09 19:17:26 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,13 +66,13 @@ 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;
+         (q, [ test => phi %% phi_attr;
                QNameSet.any => F.first_child q ++ F.next_sibling q;
              ]) :: trans,
          states)
@@ -92,17 +101,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 +116,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 +169,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 +196,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 +207,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 +218,7 @@ let compile_top_level_step_list l trans states =
       trans
       states
   in
-  loop l trans0 states0 phi0
+  loop l trans0 states0 true phi0
 ;;