Working for element only document (with arbitrary paths & negation).
[tatoo.git] / src / xpath / compile.ml
index f1212f2..15a5c60 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-05 15:24:20 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-05 19:21:37 CET by Kim Nguyen>
 *)
 
 open Ast
@@ -26,10 +26,20 @@ let mk_atom 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
 
+let node_set = QNameSet.remove QName.document QNameSet.any
+let star_set = QNameSet.diff QNameSet.any (
+  List.fold_right (QNameSet.add)
+    [ QName.document; QName.text; QName.attribute_map ]
+    QNameSet.empty)
+let attribute = QNameSet.singleton QName.attribute_map
+let root_set = QNameSet.singleton QName.document
+
 (* [compile_axis_test axis test q phi trans states] Takes an xpath
    [axis] and node [test], a formula [phi], a list of [trans]itions
    and a set of [states] and returns a formula [phi'], a new set of
@@ -56,12 +66,13 @@ let compile_axis_test axis test phi trans states =
     | Descendant self ->
         (if self then (`Epsilon ** q) else (`Left ** q)),
       (q, [ test => phi;
-            QNameSet.any => (`Left ** q) ++ (`Right ** q) ]) :: trans,
+            QNameSet.any => (`Left ** q);
+            QNameSet.any => (`Right ** q) ]) :: trans,
       states
 
     | Parent ->
         let q' = State.make () in
-        let move = (`Up1 ** q) ++ (`Up2 ** q') in
+        let move = (`Up1 ** q %% is_left) ++ (`Up2 ** q' %% is_right) in
         move,
         (q, [ test => phi ])
         :: (q', [ QNameSet.any => move ]) :: trans,
@@ -69,10 +80,10 @@ let compile_axis_test axis test phi trans states =
 
     | Ancestor self ->
         let q' = State.make () in
-        let move = (`Up1 ** q) ++ (`Up2 ** q') in
+        let move = (`Up1 ** q %% is_left) ++ (`Up2 ** q' %% is_right) in
         (if self then (`Epsilon ** q) else move),
         (q, [ test => phi;
-              QNameSet.any => move ])
+              star_set => move ])
         :: (q', [ QNameSet.any => move ]) :: trans,
         (q' @: states)
 
@@ -80,11 +91,11 @@ let compile_axis_test axis test phi trans states =
         let move =
           if axis = PrecedingSibling then
             (`Up2 ** q)
-          else (`Right ** q)
+          else (`Right ** q %% is_right)
         in
         move,
         (q, [ test => phi;
-              QNameSet.any => move ]) :: trans,
+              star_set => move ]) :: trans,
         states
 
     | Attribute ->