X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fcompile.ml;fp=src%2Fxpath%2Fcompile.ml;h=15a5c603398c30bd025db3edc3b41c700790d841;hp=f1212f2a4707b10dd2b8b971cb92376cded559e0;hb=249bd234500a64919cf00f4a59ab4927a068d689;hpb=8026ca9faaa968ced3c2e75ca1d6b55f7270ca50 diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml index f1212f2..15a5c60 100644 --- a/src/xpath/compile.ml +++ b/src/xpath/compile.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) 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 ->