(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-03-09 11:35:17 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-03-09 18:06:46 CET by Kim Nguyen>
*)
INCLUDE "utils.ml"
| Stay -> fprintf ppf "%s(%a)" Pretty.epsilon State.print q
| Is_first_child -> fprintf ppf "FC%s?" Pretty.inverse
| Is_next_sibling -> fprintf ppf "NS%s?" Pretty.inverse
- | Is_attribute -> fprintf ppf "@?"
+ | Is_attribute -> fprintf ppf "%s" "@?"
| Has_first_child -> fprintf ppf "FC?"
| Has_next_sibling -> fprintf ppf "NS?"
and_
(mk_atom Previous_sibling true q)
is_next_sibling
+
let stay q =
(mk_atom Stay true q)
(***********************************************************************)
(*
- 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-04 17:42:09 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-03-09 17:54:35 CET by Kim Nguyen>
*)
include FiniteCofinite.Make(Ptset.Make(QName))
let print fmt e = printer fmt e is_finite elements complement is_any
+let specials = [ QName.document; QName.text; QName.text ]
+let notstar = from_list specials
+let star = diff any notstar
+let node = any
+let text = singleton QName.text
+
module Weak =
struct
include FiniteCofinite.Weak(Ptset.Weak(QName))
let print fmt e = printer fmt e is_finite elements complement is_any
+ let notstar = from_list specials
+ let star = diff any notstar
+ let node = any
+ let text = singleton QName.text
end
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-03-04 23:03:05 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-03-09 17:53:53 CET by Kim Nguyen>
*)
(** Implementation of sets of Qualified Names that can be finite
include FiniteCofinite.S with type elt = QName.t
include Common_sig.Printable with type t := t
+val star : t
+val text : t
+val node : t
module Weak :
sig
include FiniteCofinite.S with type elt = QName.t
include Common_sig.Printable with type t := t
+ val star : t
+ val text : t
+ val node : t
end
(***********************************************************************)
(*
- 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
;;
(***********************************************************************)
(*
- Time-stamp: <Last modified on 2013-03-09 16:56:45 CET by Kim Nguyen>
+ Time-stamp: <Last modified on 2013-03-09 19:24:28 CET by Kim Nguyen>
*)
open Ast
;
axis_test:
- AXIS COLONCOLON test { $1, $3 }
+ AXIS COLONCOLON test { let a, t = $1, $3 in
+ if a == Attribute && Utils.QNameSet.is_finite t then
+ (a, Utils.QNameSet.fold
+ (fun t a ->
+ Utils.QNameSet.add
+ (Utils.QName.add_attribute_prefix t) a)
+ t Utils.QNameSet.empty)
+ else
+ (a, t)
+ }
| test { Child, $1 }
| AXIS {
let _ = Format.flush_str_formatter () in
--- /dev/null
+<a><b id="1"/></a>
\ No newline at end of file
--- /dev/null
+<a>
+ <b id="3" class="foo">
+ <c id="4" class="bar"/>
+ <d id="5" class="bar"/>
+ </b>
+ <e id="6" />
+</a>
+