X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=blobdiff_plain;f=src%2Fxpath%2Fcompile.ml;h=7848b84ffec7407381836da1f33a571b4c3cd049;hp=f1212f2a4707b10dd2b8b971cb92376cded559e0;hb=9d83bf3832f03462a5d1f451d96e8d30347bf363;hpb=8026ca9faaa968ced3c2e75ca1d6b55f7270ca50 diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml index f1212f2..7848b84 100644 --- a/src/xpath/compile.ml +++ b/src/xpath/compile.ml @@ -14,21 +14,37 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) 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 +(* +let add_attribute_prefix 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 +*) + +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 @@ -38,39 +54,49 @@ let ( @: ) a b = StateSet.add a b holds. *) -let compile_axis_test axis test phi trans states = +let compile_axis_test ?(block_attr=true) axis test phi trans states = let q = State.make () in + let phi_attr = if block_attr then F.not_ F.is_attribute else F.true_ in 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 - - | Descendant self -> - (if self then (`Epsilon ** q) else (`Left ** q)), - (q, [ test => phi; - QNameSet.any => (`Left ** q) ++ (`Right ** q) ]) :: trans, - states + (F.first_child q, + (q, [ test => phi %% phi_attr; + QNameSet.any => F.next_sibling q ]) :: trans, + states) + + | Descendant false -> + (F.first_child q, + (q, [ test => phi %% phi_attr; + QNameSet.any => F.first_child q ++ F.next_sibling q; + ]) :: trans, + states) + | Descendant true -> + let q' = State.make () in + (F.or_ (F.stay q) (F.first_child q'), + (q', [ test => phi %% phi_attr; + QNameSet.any => F.first_child q' ++ F.next_sibling q'; + ]):: + (q, [ test => phi %% phi_attr]):: 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,40 +105,32 @@ 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; + (q, [ test => phi %% phi_attr; 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 phi', trans', q @: states' -let compile_rev_axis_test axis test phi trans states = +let compile_rev_axis_test block_attr axis test phi trans states = match axis with - | Attribute -> assert false - | _ -> compile_axis_test (invert_axis axis) test phi trans states -;; - - + | Attribute -> + compile_axis_test + ~block_attr:false Parent test phi trans states + | _ -> compile_axis_test + ~block_attr:block_attr (invert_axis axis) test phi trans states let rec compile_expr e trans states = match e with @@ -159,19 +177,26 @@ and compile_step_list l trans states = aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist let compile_top_level_step_list l trans states = - let rec loop l trans states phi_above = + let rec loop l trans states block_attr phi_above = match l with | (axis, test, elist) :: [] -> let phi0, trans0, states0 = - compile_rev_axis_test axis QNameSet.any phi_above trans states + compile_rev_axis_test + block_attr axis QNameSet.any phi_above trans states in let phi1, trans1, states1 = List.fold_left (fun (aphi, atrans, astates) e -> let ephi, etrans, estates = compile_expr e atrans astates in aphi %% ephi, etrans, estates) (phi0, trans0, states0) elist in + let phi' = + if axis = Attribute then + F.is_attribute + else + F.not_ F.is_attribute + in let _, trans2, states2 = - compile_axis_test Self test phi1 trans1 states1 + compile_axis_test Self test (phi1 %% phi') trans1 states1 in let marking_state = StateSet.choose (StateSet.diff states2 states1) @@ -179,7 +204,8 @@ let compile_top_level_step_list l trans states = marking_state, trans2, states2 | (axis, test, elist) :: ll -> let phi0, trans0, states0 = - compile_rev_axis_test axis QNameSet.any phi_above trans states + compile_rev_axis_test + block_attr axis QNameSet.any phi_above trans states in let phi1, trans1, states1 = compile_axis_test Self test phi0 trans0 states0 @@ -189,7 +215,7 @@ let compile_top_level_step_list l trans states = let ephi, etrans, estates = compile_expr e atrans astates in aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist in - loop ll trans2 states2 phi2 + loop ll trans2 states2 (axis != Attribute) phi2 | _ -> assert false in let phi0, trans0, states0 = @@ -200,7 +226,7 @@ let compile_top_level_step_list l trans states = trans states in - loop l trans0 states0 phi0 + loop l trans0 states0 true phi0 ;;