(***********************************************************************)
(*
- 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
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
| 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,
| 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)
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 ->