From: Kim Nguyễn Date: Sat, 9 Mar 2013 21:36:02 +0000 (+0100) Subject: Fix the handling of attributes: X-Git-Tag: v0.1~152^2~1 X-Git-Url: http://git.nguyen.vg/gitweb/?p=tatoo.git;a=commitdiff_plain;h=7aa6c5c4e2b329bbf5fa7cc31a7542ba48ace84f Fix the handling of attributes: - make use of the Is_attribute predicate in formulæ - Change the encoding of attributes in the tree structure (attributes are now proper children with a particular marker in the tag name). --- diff --git a/src/tree/naive.ml b/src/tree/naive.ml index db1b202..ee93863 100644 --- a/src/tree/naive.ml +++ b/src/tree/naive.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Utils @@ -123,19 +123,12 @@ struct 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 = @@ -226,16 +219,19 @@ let output_escape_string out s = | 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 @@ -246,13 +242,7 @@ let rec print_xml out tree_ node = 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 '>'; @@ -264,7 +254,13 @@ let rec print_xml out tree_ node = 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 diff --git a/src/utils/qNameSet.ml b/src/utils/qNameSet.ml index 934d2de..d895ff3 100644 --- a/src/utils/qNameSet.ml +++ b/src/utils/qNameSet.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) include FiniteCofinite.Make(Ptset.Make(QName)) @@ -32,8 +32,18 @@ let printer fmt e test conv inv is_any = 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 diff --git a/src/utils/qNameSet.mli b/src/utils/qNameSet.mli index 175ba26..132d834 100644 --- a/src/utils/qNameSet.mli +++ b/src/utils/qNameSet.mli @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) (** Implementation of sets of Qualified Names that can be finite @@ -22,9 +22,15 @@ 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 diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml index 123583f..1c46b8f 100644 --- a/src/xpath/compile.ml +++ b/src/xpath/compile.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Ast @@ -26,6 +26,14 @@ let ( => ) a b = (a, b) 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 @@ -46,8 +54,9 @@ let root_set = QNameSet.singleton QName.document 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 -> @@ -57,13 +66,13 @@ let compile_axis_test axis test phi trans states = | 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) @@ -92,17 +101,11 @@ let compile_axis_test axis test phi 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, @@ -113,10 +116,13 @@ let compile_axis_test axis test phi trans states = 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 @@ -163,19 +169,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) @@ -183,7 +196,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 @@ -193,7 +207,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 = @@ -204,7 +218,7 @@ let compile_top_level_step_list l trans states = trans states in - loop l trans0 states0 phi0 + loop l trans0 states0 true phi0 ;; diff --git a/src/xpath/xpath_internal_parser.mly b/src/xpath/xpath_internal_parser.mly index de63cdf..fe38f67 100644 --- a/src/xpath/xpath_internal_parser.mly +++ b/src/xpath/xpath_internal_parser.mly @@ -15,7 +15,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Ast @@ -84,7 +84,16 @@ step: ; 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