(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-03-05 16:20:32 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-03-09 18:49:04 CET by Kim Nguyen>
*)
open Utils
if parent.first_child == dummy then parent.first_child <- n
else parent.next_sibling <- n;
push n ctx;
- match attr_list with
- [] -> ()
- | _ ->
- start_element_handler parser_ ctx attr_map_string [];
- List.iter (do_attribute parser_ ctx) attr_list;
- end_element_handler parser_ ctx attr_map_string
+ List.iter (do_attribute parser_ ctx) attr_list
and do_attribute parser_ ctx (att, value) =
let att_tag = att_pref ^ att in
start_element_handler parser_ ctx att_tag [];
- start_element_handler parser_ ctx text_string [];
let n = top ctx in n.data <- value;
- end_element_handler parser_ ctx text_string;
end_element_handler parser_ ctx att_tag
and consume_closing ctx n =
| c -> output_char out c
done
-let rec print_attributes out tree_ node =
- if node != nil then begin
- let ntag = QName.to_string node.tag in
- output_char out ' ';
+let rec print_attributes ?(sep=true) out tree_ node =
+ let tag = node.tag in
+ if QName.has_attribute_prefix tag then begin
+ let ntag = QName.node tag in
+ if sep then output_char out ' ';
output out ntag 1 (String.length ntag - 1);
output_string out "=\"";
- output_escape_string out node.first_child.data;
+ output_escape_string out node.data;
output_char out '"';
print_attributes out tree_ node.next_sibling
- end
+ end
+ else
+ node
let rec print_xml out tree_ node =
if node != nil then
let tag = QName.to_string node.tag in
output_char out '<';
output_string out tag;
- let fchild =
- if node.first_child.tag == QName.attribute_map then
- let () = print_attributes out tree_ node.first_child.first_child in
- node.first_child.next_sibling
- else
- node.first_child
- in
+ let fchild = print_attributes out tree_ node.first_child in
if fchild == nil then output_string out "/>"
else begin
output_char out '>';
in
print_xml out tree_ node.next_sibling
-let print_xml out tree_ node = print_xml out tree_ { node with next_sibling = nil }
+let print_xml out tree_ node =
+ let nnode = { node with next_sibling = nil } in
+ if QName.has_attribute_prefix nnode.tag then
+ ignore (print_attributes ~sep:false out tree_ nnode)
+ else
+ print_xml out tree_ nnode
+
let root t = t.root
let first_child _ n = n.first_child
let next_sibling _ n = n.next_sibling
(***********************************************************************)
(*
- 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
;;