X-Git-Url: http://git.nguyen.vg/gitweb/?a=blobdiff_plain;f=src%2Fxpath%2Fcompile.ml;h=123583fc750fb849e961ecd87f00e754c9050def;hb=35c32fbd2543a399cc6939f21317bebf37172646;hp=b22a74b6024263a9527fe51bba53ca1cbd56a542;hpb=f49a93deba13602e16a3923695281e9a20215ac8;p=tatoo.git

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index b22a74b..123583f 100644
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -14,22 +14,30 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-04 17:55:28 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 ( ++ ) 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)
+    [ 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
@@ -43,34 +51,35 @@ 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) %% (`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) ++ (`Up2 ** q') 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) ++ (`Up2 ** q') 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;
               QNameSet.any => move ])
         :: (q', [ QNameSet.any => move ]) :: trans,
@@ -79,8 +88,8 @@ let compile_axis_test axis test phi trans states =
     | FollowingSibling | PrecedingSibling ->
         let move =
           if axis = PrecedingSibling then
-            (`Up2 ** q)
-          else (`Right ** q)
+            F.previous_sibling q
+          else F.next_sibling q
         in
         move,
         (q, [ test => phi;
@@ -88,18 +97,16 @@ let compile_axis_test axis test phi trans states =
         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
@@ -110,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