(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-03-09 11:09:12 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-03-09 19:17:26 CET by Kim Nguyen>
*)
open Ast
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
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 ->
| Child ->
(F.first_child q,
- (q, [ test => phi;
+ (q, [ test => phi %% phi_attr;
QNameSet.any => F.next_sibling q ]) :: trans,
states)
| Descendant self ->
((if self then F.stay q else F.first_child q),
- (q, [ test => phi;
+ (q, [ test => phi %% phi_attr;
QNameSet.any => F.first_child q ++ F.next_sibling q;
]) :: trans,
states)
else F.next_sibling q
in
move,
- (q, [ test => phi;
+ (q, [ test => phi %% phi_attr;
QNameSet.any => move ]) :: trans,
states
| Attribute ->
- 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
(F.first_child q,
(q, [ test => phi %% F.is_attribute;
QNameSet.any => F.next_sibling q]) :: trans,
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
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)
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
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 =
trans
states
in
- loop l trans0 states0 phi0
+ loop l trans0 states0 true phi0
;;