Simplify the automaton encoding a bit (remove redundant predicates in formulae).

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

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index 1bfe292..d33fbb4 100644 (file)
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -40,10 +40,10 @@ let root_set = QNameSet.singleton QName.document
 *)
 
 let compile_axis_test axis (test,kind) phi trans states =
-  let q = State.make () in
+  let q = State.next () in
   let phi = match kind with
-    Tree.NodeKind.Node -> phi
-  | _ -> phi %% F.is kind
+      Tree.NodeKind.Node -> phi
+    | _ -> phi %% F.is kind
   in
   let phi', trans', states' =
     match axis with
@@ -65,16 +65,15 @@ let compile_axis_test axis (test,kind) phi trans states =
              ]) :: trans,
          states)
     | Descendant true ->
-        let q' = State.make () in
-        (F.or_ (F.stay q) (F.first_child q'),
-         (q', [ test => phi;
-               QNameSet.any => F.first_child q' ++ F.next_sibling q';
-             ])::
-         (q, [ test => phi]):: trans,
+        let q' = State.next () in
+        (F.stay q ++ F.first_child q',
+         (q', [ QNameSet.any => F.stay q ++ F.first_child q' ++ F.next_sibling q';
+              ])::
+           (q, [ test => phi]):: trans,
          states)
 
     | Parent ->
-        let q' = State.make () in
+        let q' = State.next () in
         let move = F.parent q ++ F.previous_sibling q' in
         (move,
          (q, [ test => phi ])
@@ -82,13 +81,12 @@ let compile_axis_test axis (test,kind) phi trans states =
          (q' @: states))
 
     | Ancestor self ->
-        let q' = State.make () in
-        let move = F.parent q ++ F.previous_sibling q' in
-        (if self then F.stay q else move),
-        (q, [ test => phi;
-              QNameSet.any => move ])
-        :: (q', [ QNameSet.any => move ]) :: trans,
-        (q' @: states)
+      let q' = State.next () in
+      let move = F.parent q' ++ F.previous_sibling q' in
+      (if self then F.stay q ++ F.stay q' else F.stay q'),
+      (q', [ QNameSet.any => move ++ F.parent q])
+      :: (q, [ test => phi ]) :: trans,
+      (q' @: states)
 
     | FollowingSibling | PrecedingSibling ->
         let move =
@@ -158,9 +156,9 @@ and compile_step_list l trans states =
         aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
 
 (**
-   Compile the top-level XPath query in reverse (doing downward
+   Compile the top-level XPath query in reverse (going downward
    to the last top-level state):
-   /a0::t0[p0]/.../an-1::tn-1[pn-1]/an::tn[pn] becomes:
+   /a0::t0[p0]/../an-1::tn-1[pn-1]/an::tn[pn] becomes:
    self::node()[ pn and
    self::tn[pn]/inv(an)::(tn-1)[pn-1]/.../inv(a1)::t0[p0]/inv(a0)::document()]
 
@@ -181,36 +179,36 @@ let compile_top_level_step_list l trans states =
         (* Only select attribute nodes if the previous axis
            is attribute *)
         let phi0 =
-          if axis != Attribute then
+          if axis != Attribute && kind == Tree.NodeKind.Node then
             phi0 %% (F.not_ F.is_attribute)
           else phi0
         in
         match ll with
           [] ->
-            let phi1, trans1, states1 =
-              List.fold_left (fun (aphi, atrans, astates) e ->
+          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 _, trans2, states2 =
-              compile_axis_test Self (test,kind) phi1 trans1 states1
-            in
-            let marking_state =
-              StateSet.choose (StateSet.diff states2 states1)
-            in
-            marking_state, trans2, states2
+          in
+          let _, trans2, states2 =
+            compile_axis_test Self (test,kind) phi1 trans1 states1
+          in
+          let marking_state =
+            StateSet.choose (StateSet.diff states2 states1)
+          in
+          marking_state, trans2, states2
         | _ ->
-            let phi1, trans1, states1 =
-              compile_axis_test Self (test,kind) phi0 trans0 states0
-            in
-            let phi2, trans2, states2 =
-              List.fold_left (fun (aphi, atrans, astates) e ->
+          let phi1, trans1, states1 =
+            compile_axis_test Self (test,kind) phi0 trans0 states0
+          in
+          let phi2, trans2, states2 =
+            List.fold_left (fun (aphi, atrans, astates) e ->
                 let ephi, etrans, estates = compile_expr e atrans astates in
                 aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist
-            in
-            loop ll trans2 states2  phi2
+          in
+          loop ll trans2 states2  phi2
   in
-  let starting = State.make () in
+  let starting = State.next () in
   let phi0, trans0, states0 =
     compile_axis_test
       Self
@@ -238,7 +236,7 @@ let path p =
   let builder = Ata.Builder.make () in
   (** ensure that we have a single selecting state at the end *)
   let phi_sel = StateSet.fold (fun q acc -> F.or_ (F.stay q) acc) mstates F.false_ in
-  let q_sel = State.make () in
+  let q_sel = State.next () in
   let states = StateSet.add q_sel states in
   let mstates = StateSet.singleton q_sel in
   let trans = (q_sel, [QNameSet.any, phi_sel]) :: trans in