Rework the formula predicates:

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

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index 15a5c60..123583f 100644 (file)
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -14,24 +14,22 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-05 19:21:37 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-09 11:09:12 CET by Kim Nguyen>
 *)
 
 open Ast
 open Auto
 open Utils
 
-let mk_atom l b q =
-  Ata.SFormula.atom_ (Ata.Move.make (l,b,q))
 
 let ( => ) a b = (a, b)
-let ( ** ) l q = mk_atom l true q
-let is_left = mk_atom `Is1 true State.dummy
-let is_right = mk_atom `Is2 true State.dummy
 let ( ++ ) a b = Ata.SFormula.or_ a b
 let ( %% ) a b = Ata.SFormula.and_ a b
 let ( @: ) a b = StateSet.add a b
 
+module F = Ata.SFormula
+
+
 let node_set = QNameSet.remove QName.document QNameSet.any
 let star_set = QNameSet.diff QNameSet.any (
   List.fold_right (QNameSet.add)
@@ -53,64 +51,62 @@ let compile_axis_test axis test phi trans states =
   let phi', trans', states' =
     match axis with
     | Self ->
-          (`Epsilon ** q),
-          (q, [  test => phi ]) :: trans,
-          states
+        (F.stay q,
+         (q, [  test => phi ]) :: trans,
+         states)
 
     | Child ->
-        (`Left ** q),
-      (q, [ test => phi;
-            QNameSet.any => (`Right ** q) ]) :: trans,
-      states
+        (F.first_child q,
+         (q, [ test => phi;
+               QNameSet.any => F.next_sibling q ]) :: trans,
+         states)
 
     | Descendant self ->
-        (if self then (`Epsilon ** q) else (`Left ** q)),
-      (q, [ test => phi;
-            QNameSet.any => (`Left ** q);
-            QNameSet.any => (`Right ** q) ]) :: trans,
-      states
+        ((if self then F.stay q else F.first_child q),
+         (q, [ test => phi;
+               QNameSet.any => F.first_child q ++ F.next_sibling q;
+             ]) :: trans,
+         states)
 
     | Parent ->
         let q' = State.make () in
-        let move = (`Up1 ** q %% is_left) ++ (`Up2 ** q' %% is_right) in
-        move,
-        (q, [ test => phi ])
-        :: (q', [ QNameSet.any => move ]) :: trans,
-        (q' @: states)
+        let move = F.parent q ++ F.previous_sibling q' in
+        (move,
+         (q, [ test => phi ])
+         :: (q', [ QNameSet.any => move ]) :: trans,
+         (q' @: states))
 
     | Ancestor self ->
         let q' = State.make () in
-        let move = (`Up1 ** q %% is_left) ++ (`Up2 ** q' %% is_right) in
-        (if self then (`Epsilon ** q) else move),
+        let move = F.parent q ++ F.previous_sibling q' in
+        (if self then F.stay q else move),
         (q, [ test => phi;
-              star_set => move ])
+              QNameSet.any => move ])
         :: (q', [ QNameSet.any => move ]) :: trans,
         (q' @: states)
 
     | FollowingSibling | PrecedingSibling ->
         let move =
           if axis = PrecedingSibling then
-            (`Up2 ** q)
-          else (`Right ** q %% is_right)
+            F.previous_sibling q
+          else F.next_sibling q
         in
         move,
         (q, [ test => phi;
-              star_set => move ]) :: trans,
+              QNameSet.any => move ]) :: trans,
         states
 
     | Attribute ->
-        let q' = State.make () in
         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
-        (`Left ** q),
-        (q, [ QNameSet.singleton QName.attribute_map => (`Left ** q') ])
-        :: (q', [ test => phi;
-                  QNameSet.any => (`Right ** q') ]) :: trans,
-        (q' @:states)
+        (F.first_child q,
+         (q, [ test => phi %% F.is_attribute;
+               QNameSet.any => F.next_sibling q]) :: trans,
+         states)
     | _ -> assert false
 
   in
@@ -121,9 +117,6 @@ let compile_rev_axis_test axis test phi trans states =
   match axis with
   | Attribute -> assert false
   | _ -> compile_axis_test (invert_axis axis) test phi trans states
-;;
-
-
 
 let rec compile_expr e trans states =
   match e with