From 53a0fd29a20e7f4550e0eb5fa5b0d5af6191c36d Mon Sep 17 00:00:00 2001 From: =?utf8?q?Kim=20Nguy=E1=BB=85n?= Date: Wed, 13 Mar 2013 11:21:41 +0100 Subject: [PATCH] Add a kind element to the node tree. Improve support for XPath by allowing processing-instruction and comment tests. Fix the handling of attribute nodes. --- src/auto/ata.ml | 19 +++- src/auto/eval.ml | 5 +- src/tree/naive.ml | 116 ++++++++++++++++-------- src/utils/qName.ml | 23 ++--- src/utils/qName.mli | 35 +++----- src/xpath/ast.ml | 38 ++++---- src/xpath/ast.mli | 4 +- src/xpath/compile.ml | 133 ++++++++++++++-------------- src/xpath/ulexer.ml | 9 +- src/xpath/xpath_internal_parser.mly | 59 +++++++----- 10 files changed, 253 insertions(+), 188 deletions(-) diff --git a/src/auto/ata.ml b/src/auto/ata.ml index c7bb172..4418996 100644 --- a/src/auto/ata.ml +++ b/src/auto/ata.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) INCLUDE "utils.ml" @@ -28,7 +28,7 @@ type predicate = | First_child | Stay | Is_first_child | Is_next_sibling - | Is_attribute + | Is of (Tree.Common.NodeKind.t) | Has_first_child | Has_next_sibling @@ -63,7 +63,7 @@ struct | 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 "%s" "@?" + | Is k -> fprintf ppf "is-%a?" Tree.Common.NodeKind.print k | Has_first_child -> fprintf ppf "FC?" | Has_next_sibling -> fprintf ppf "NS?" @@ -77,7 +77,9 @@ end module SFormula = struct include Formula.Make(Atom) + open Tree.Common.NodeKind let mk_atom a b c = atom_ (Atom.make (a,b,c)) + let mk_kind k = mk_atom (Is k) true State.dummy let has_first_child = (mk_atom Has_first_child true State.dummy) @@ -91,7 +93,16 @@ struct (mk_atom Is_next_sibling true State.dummy) let is_attribute = - (mk_atom Is_attribute true State.dummy) + (mk_atom (Is Attribute) true State.dummy) + + let is_element = + (mk_atom (Is Element) true State.dummy) + + let is_processing_instruction = + (mk_atom (Is ProcessingInstruction) true State.dummy) + + let is_comment = + (mk_atom (Is Comment) true State.dummy) let first_child q = and_ diff --git a/src/auto/eval.ml b/src/auto/eval.ml index 4921b7f..4f68da0 100644 --- a/src/auto/eval.ml +++ b/src/auto/eval.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) INCLUDE "utils.ml" @@ -48,8 +48,7 @@ module Make (T : Tree.Sig.S) = struct node == (T.first_child tree (T.parent tree node)) | Is_next_sibling -> node == (T.next_sibling tree (T.parent tree node)) - | Is_attribute -> - QName.has_attribute_prefix (T.tag tree node) + | Is k -> k == (T.kind tree node) | Has_first_child -> T.nil != T.first_child tree node | Has_next_sibling -> diff --git a/src/tree/naive.ml b/src/tree/naive.ml index ee93863..0885bad 100644 --- a/src/tree/naive.ml +++ b/src/tree/naive.ml @@ -14,13 +14,14 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Utils type node = { tag : QName.t; preorder : int; + mutable kind : Common.NodeKind.t; mutable data : string; mutable first_child : node; mutable next_sibling : node; @@ -31,6 +32,7 @@ type node = { let rec nil = { tag = QName.nil; + kind = Common.NodeKind.Element; preorder = -1; data = ""; first_child = nil; @@ -41,6 +43,7 @@ let rec nil = { let dummy_tag = QName.of_string "#dummy" let rec dummy = { tag = dummy_tag; + kind = Common.NodeKind.Element; preorder = -1; data = ""; first_child = dummy; @@ -106,13 +109,14 @@ struct let text_string = QName.to_string QName.text - let attr_map_string = QName.to_string QName.attribute_map + let comment_string = QName.to_string QName.comment + - let att_pref = QName.node QName.attribute_prefix let rec start_element_handler parser_ ctx tag attr_list = do_text parser_ ctx; let parent = top ctx in let n = { tag = QName.of_string tag; + kind = Common.NodeKind.Element; preorder = next ctx; data = ""; first_child = dummy; @@ -126,9 +130,11 @@ struct List.iter (do_attribute parser_ ctx) attr_list and do_attribute parser_ ctx (att, value) = - let att_tag = att_pref ^ att in + let att_tag = QName.to_string (QName.attribute (QName.of_string att)) in start_element_handler parser_ ctx att_tag []; - let n = top ctx in n.data <- value; + let n = top ctx in + n.data <- value; + n.kind <- Common.NodeKind.Attribute; end_element_handler parser_ ctx att_tag and consume_closing ctx n = @@ -151,8 +157,27 @@ struct start_element_handler parser_ ctx text_string []; let node = top ctx in node.data <- s; + node.kind <- Common.NodeKind.Text; end_element_handler parser_ ctx text_string + and comment_handler parser_ ctx s = + do_text parser_ ctx; + start_element_handler parser_ ctx comment_string []; + let node = top ctx in + node.data <- s; + node.kind <- Common.NodeKind.Comment; + end_element_handler parser_ ctx comment_string + + and processing_instruction_handler parser_ ctx tag data = + do_text parser_ ctx; + let pi = QName.to_string + (QName.processing_instruction (QName.of_string tag)) + in + start_element_handler parser_ ctx pi []; + let node = top ctx in + node.data <- data; + node.kind <- Common.NodeKind.ProcessingInstruction; + end_element_handler parser_ ctx pi let character_data_handler _parser ctx text = @@ -162,18 +187,23 @@ struct let ctx = { text_buffer = Buffer.create 512; current_preorder = 0; stack = [] } in - let parser_ = Expat.parser_create ~encoding:None in - Expat.set_start_element_handler parser_ (start_element_handler parser_ ctx); - Expat.set_end_element_handler parser_ (end_element_handler parser_ ctx); - Expat.set_character_data_handler parser_ (character_data_handler parser_ ctx); + let psr = Expat.parser_create ~encoding:None in + Expat.set_start_element_handler psr (start_element_handler psr ctx); + Expat.set_end_element_handler psr (end_element_handler psr ctx); + Expat.set_character_data_handler + psr (character_data_handler psr ctx); + Expat.set_comment_handler psr (comment_handler psr ctx); + Expat.set_processing_instruction_handler psr + (processing_instruction_handler psr ctx); push { tag = QName.document; preorder = next ctx; + kind = Common.NodeKind.Document; data = ""; first_child = dummy; next_sibling = dummy; parent = nil; } ctx; - (parser_, + (psr, fun () -> let node = top ctx in node.next_sibling <- nil; @@ -207,7 +237,6 @@ end let load_xml_file = Parser.parse_file let load_xml_string = Parser.parse_string - let output_escape_string out s = for i = 0 to String.length s - 1 do match s.[i] with @@ -219,47 +248,55 @@ let output_escape_string out s = | c -> output_char out c done + 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 (node.kind == Common.NodeKind.Attribute) then + let tag = QName.to_string (QName.remove_prefix node.tag) in if sep then output_char out ' '; - output out ntag 1 (String.length ntag - 1); + output_string out tag; output_string out "=\""; output_escape_string out node.data; - output_char out '"'; + output_char out '\"'; print_attributes out tree_ node.next_sibling - end - else - node + else + node let rec print_xml out tree_ node = if node != nil then let () = - if node.tag == QName.text then - output_escape_string out node.data - else - let tag = QName.to_string node.tag in - output_char out '<'; - output_string out tag; - let fchild = print_attributes out tree_ node.first_child in - if fchild == nil then output_string out "/>" - else begin - output_char out '>'; - print_xml out tree_ fchild; - output_string out "' - end + let open Common.NodeKind in + match node.kind with + | Node -> () + | Text -> output_escape_string out node.data + | Element | Document -> + let tag = QName.to_string node.tag in + output_char out '<'; + output_string out tag; + let fchild = print_attributes out tree_ node.first_child in + if fchild == nil then output_string out "/>" + else begin + output_char out '>'; + print_xml out tree_ fchild; + output_string out "' + end + | Attribute -> ignore (print_attributes ~sep:false out tree_ node) + | Comment -> + output_string out "" + | ProcessingInstruction -> + output_string out "" in print_xml out tree_ node.next_sibling 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 nnode = { node with next_sibling = nil } in print_xml out tree_ nnode let root t = t.root let first_child _ n = n.first_child @@ -267,6 +304,7 @@ let next_sibling _ n = n.next_sibling let parent _ n = n.parent let tag _ n = n.tag let data _ n = n.data +let kind _ n = n.kind let preorder _ n = n.preorder let print_node fmt n = Parser.debug_node fmt n diff --git a/src/utils/qName.ml b/src/utils/qName.ml index d3f0a43..4a3aac4 100644 --- a/src/utils/qName.ml +++ b/src/utils/qName.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) include Hcons.Make (struct @@ -30,15 +30,18 @@ let to_string = node let document = of_string "#document" let text = of_string "#text" -let cdata_section = of_string "#cdata-section" let comment = of_string "#comment" -let document_fragment = of_string "#document-fragment" -let attribute_map = of_string "#attribute-map" let nil = of_string "#" -let attribute_prefix = of_string "@" -let has_attribute_prefix s = - let s = node s in - String.length s > 0 && s.[0] = '@' -let add_attribute_prefix s = - of_string ("@" ^ (node s)) +let attribute t = of_string ( "@" ^ (to_string t)) +let processing_instruction t = of_string ( "?" ^ (to_string t)) + +let remove_prefix t = + let s = to_string t in + let lens = String.length s in + if lens == 0 then t + else + if s.[0] == '@' || s.[0] == '?' then + of_string (String.sub s 1 (lens-1)) + else + t diff --git a/src/utils/qName.mli b/src/utils/qName.mli index 3d6c899..978ba3c 100644 --- a/src/utils/qName.mli +++ b/src/utils/qName.mli @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) (** Implementation of qualified names as hashconsed strings *) @@ -44,40 +44,27 @@ val text : t [of_string "#text"] *) -val cdata_section : t -(** Represents the QName of a document node. Equivalent to - [of_string "#cdata-section"] -*) - val comment : t (** Represents the QName of a comment node. Equivalent to [of_string "#comment"] *) -val document_fragment : t -(** Represents the QName of a document fragment. Equivalent to - [of_string "#document-fragment"] -*) - -val attribute_map : t -(** Represents the QName of a dummy document node holding the - attributes of the current element. Equivalent to - [of_string "#attribute-map"] -*) - val nil : t (** Represents the QName of a nil node. Equivalent to [of_string "#"] *) -val attribute_prefix : t -(** Represents a prefix that may be prepended to attribute name - to distinguish them from element names +val attribute : t -> t +(** Adds a prefix character (@) to distinguish the name + from an element name *) -val has_attribute_prefix : t -> bool -(** Tests whether the given QName starts with the attribute prefix +val processing_instruction : t -> t +(** Adds a prefix character (?) to distinguish the name + from an element name *) -val add_attribute_prefix : t -> t -(** Prepends the attribute_prefix to the given QName *) +val remove_prefix : t -> t +(** Removes the prefix of the qname given as argument. Does not + do anything if there is no prefix. +*) diff --git a/src/xpath/ast.ml b/src/xpath/ast.ml index d70227b..64c6c8d 100644 --- a/src/xpath/ast.ml +++ b/src/xpath/ast.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Utils @@ -30,7 +30,7 @@ and axis = Self | Attribute | Child | PrecedingSibling | Preceding | Following -and test = QNameSet.t +and test = QNameSet.t * Tree.Common.NodeKind.t and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod and unop = Neg @@ -52,7 +52,6 @@ let star = QNameSet.complement ( QNameSet.from_list [ QName.text; QName.document; - QName.cdata_section; QName.comment]) @@ -128,18 +127,24 @@ and print_axis fmt a = pp fmt "%s" begin | Following -> "following" end -and print_test fmt ts = - try - pp fmt "%s" (List.assoc ts - [ text,"text()"; - node,"node()"; - star, "*" ] ) - with - Not_found -> pp fmt "%s" - (if QNameSet.is_finite ts - then QName.to_string (QNameSet.choose ts) - else "" - ) +and print_test fmt (ts,kind) = + let open Tree.Common.NodeKind in + match kind with + Text -> pp fmt "%s" "text()" + | Element | Attribute -> + pp fmt "%s" begin + if ts == star then "*" + else QName.to_string (QNameSet.choose ts) + end + | Comment -> pp fmt "%s" "comment()" + | ProcessingInstruction -> + pp fmt "processing-instruction(%s)" + begin + if ts == star then "" + else "'" ^ (QName.to_string (QNameSet.choose ts)) ^ "'" + end + | Node -> pp fmt "%s" "node()" + | Document -> pp fmt "%s" "" and print_expr fmt = function | Number (`Int(i)) -> pp fmt "%i" i @@ -171,7 +176,8 @@ and print_expr fmt = function let invert_axis = function -| Self | Attribute as a -> a +| Self -> Self +| Attribute -> Parent (* Improve *) | Child -> Parent | Descendant (b) -> Ancestor (b) | FollowingSibling -> PrecedingSibling diff --git a/src/xpath/ast.mli b/src/xpath/ast.mli index 7cc91e4..0fc63d4 100644 --- a/src/xpath/ast.mli +++ b/src/xpath/ast.mli @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) type path = single_path list @@ -28,7 +28,7 @@ and axis = Self | Attribute | Child | PrecedingSibling | Preceding | Following -and test = Utils.QNameSet.t +and test = Utils.QNameSet.t * Tree.Common.NodeKind.t and binop = Eq | Neq | Lt | Gt | Lte | Gte | Or | And | Add | Sub | Mult | Div | Mod and unop = Neg diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml index 7848b84..2588432 100644 --- a/src/xpath/compile.ml +++ b/src/xpath/compile.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Ast @@ -26,14 +26,6 @@ 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 @@ -41,9 +33,8 @@ 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 ] + [ QName.document; QName.text; QName.comment ] 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 @@ -54,9 +45,12 @@ let root_set = QNameSet.singleton QName.document holds. *) -let compile_axis_test ?(block_attr=true) axis test phi trans states = +let compile_axis_test axis (test,kind) 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 = match kind with + Tree.Common.NodeKind.Node -> phi + | _ -> phi %% F.mk_kind kind + in let phi', trans', states' = match axis with | Self -> @@ -66,23 +60,23 @@ let compile_axis_test ?(block_attr=true) axis test phi trans states = | Child -> (F.first_child q, - (q, [ test => phi %% phi_attr; + (q, [ test => phi; QNameSet.any => F.next_sibling q ]) :: trans, states) | Descendant false -> (F.first_child q, - (q, [ test => phi %% phi_attr; + (q, [ test => phi; 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; + (q', [ test => phi; QNameSet.any => F.first_child q' ++ F.next_sibling q'; ]):: - (q, [ test => phi %% phi_attr]):: trans, + (q, [ test => phi]):: trans, states) | Parent -> @@ -109,13 +103,13 @@ let compile_axis_test ?(block_attr=true) axis test phi trans states = else F.next_sibling q in move, - (q, [ test => phi %% phi_attr; + (q, [ test => phi; QNameSet.any => move ]) :: trans, states | Attribute -> (F.first_child q, - (q, [ test => phi %% F.is_attribute; + (q, [ test => phi; QNameSet.any => F.next_sibling q]) :: trans, states) | _ -> assert false @@ -123,15 +117,6 @@ let compile_axis_test ?(block_attr=true) axis test phi trans states = in phi', trans', q @: states' - -let compile_rev_axis_test block_attr axis test phi trans states = - match axis with - | 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 | Binop (e1, (And|Or as op), e2) -> @@ -159,7 +144,9 @@ and compile_single_path p trans states = let steps = match p with | Absolute steps -> - (Ancestor false, QNameSet.singleton QName.document, [])::steps + (Ancestor false, (QNameSet.singleton QName.document, + Tree.Common.NodeKind.Node), []) + :: steps | Relative steps -> steps in compile_step_list steps trans states @@ -176,60 +163,70 @@ and compile_step_list l trans states = let ephi, etrans, estates = compile_expr e atrans astates in aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist +(** + Compile the top-level XPath query in reverse (doing downward + to the last top-level state): + /a0::t0[p0]/.../an-1::tn-1[pn-1]/an::tn[pn] becomes: + self::node()[ pn and + self::tn[pn]/inv(an)::(tn-1)[pn-1]/.../inv(a1)::t0[p0]/inv(a0)::document()] + + /child::a/attribute::b + self::@b/parent::a/parent::doc() +*) + let compile_top_level_step_list l trans states = - let rec loop l trans states block_attr phi_above = + let rec loop l trans states phi_above = match l with - | (axis, test, elist) :: [] -> - let phi0, trans0, states0 = - 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 %% phi') trans1 states1 - in - let marking_state = - StateSet.choose (StateSet.diff states2 states1) - in - marking_state, trans2, states2 - | (axis, test, elist) :: ll -> + | [] -> assert false + | (axis, (test,kind), elist) :: ll -> let phi0, trans0, states0 = - compile_rev_axis_test - block_attr axis QNameSet.any phi_above trans states + compile_axis_test (invert_axis axis) + (QNameSet.any, Tree.Common.NodeKind.Node) + phi_above trans states in - let phi1, trans1, states1 = - compile_axis_test Self test phi0 trans0 states0 + (* Only select attribute nodes if the previous axis + is attribute *) + let phi0 = + if axis != Attribute then + phi0 %% (Ata.SFormula.not_ Ata.SFormula.is_attribute) + else phi0 in - let phi2, trans2, states2 = - List.fold_left (fun (aphi, atrans, astates) e -> - let ephi, etrans, estates = compile_expr e atrans astates in - aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist - in - loop ll trans2 states2 (axis != Attribute) phi2 - | _ -> assert false + match ll with + [] -> + 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 _, trans2, states2 = + compile_axis_test Self (test,kind) phi1 trans1 states1 + in + let marking_state = + StateSet.choose (StateSet.diff states2 states1) + in + marking_state, trans2, states2 + | _ -> + let phi1, trans1, states1 = + compile_axis_test Self (test,kind) phi0 trans0 states0 + in + let phi2, trans2, states2 = + List.fold_left (fun (aphi, atrans, astates) e -> + let ephi, etrans, estates = compile_expr e atrans astates in + aphi %% ephi, etrans, estates) (phi1, trans1, states1) elist + in + loop ll trans2 states2 phi2 in let phi0, trans0, states0 = compile_axis_test Self - (QNameSet.singleton QName.document) + (QNameSet.singleton QName.document, Tree.Common.NodeKind.Node) Ata.SFormula.true_ trans states in - loop l trans0 states0 true phi0 + loop l trans0 states0 phi0 ;; - let path p = let mstates, trans, states = List.fold_left (fun (ams, atrs, asts) p -> let ms, natrs, nasts = diff --git a/src/xpath/ulexer.ml b/src/xpath/ulexer.ml index 3e71c5a..dbde490 100644 --- a/src/xpath/ulexer.ml +++ b/src/xpath/ulexer.ml @@ -14,7 +14,7 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Xpath_internal_parser @@ -123,8 +123,13 @@ let rec token = lexer | "!=" -> NEQ | "node()" -> NODE | "text()" -> TEXT + | "comment()" -> COMMENT | '@' ncname -> ATTNAME (L.utf8_lexeme lexbuf) - + | "processing-instruction()" -> PI "" + | "processing-instruction('"ncname"')" + | "processing-instruction(\""ncname"\")"-> + let s = L.utf8_lexeme lexbuf in + PI (String.sub s 24 (String.length s - 26)) | ncname -> keyword_or_tag (L.utf8_lexeme lexbuf) | float -> let s = L.utf8_lexeme lexbuf in diff --git a/src/xpath/xpath_internal_parser.mly b/src/xpath/xpath_internal_parser.mly index 3651d2c..a589fde 100644 --- a/src/xpath/xpath_internal_parser.mly +++ b/src/xpath/xpath_internal_parser.mly @@ -15,14 +15,15 @@ (***********************************************************************) (* - Time-stamp: + Time-stamp: *) open Ast - let f () = () + open Tree.Common %} %token TAG +%token PI %token ATTNAME %token STRING %token INT @@ -31,7 +32,7 @@ %token RB LB LP RP %token SLASH SLASHSLASH COLONCOLON STAR PIPE %token EQ NEQ LT GT LTE GTE OR AND ADD SUB DIV MOD -%token NODE TEXT +%token NODE TEXT COMMENT %token COMMA %token EOF @@ -69,14 +70,19 @@ simple_path: absolute_path: SLASH relative_path { $2 } -| SLASHSLASH relative_path { $2 @ [(Descendant true, node, [])] } +| SLASHSLASH relative_path { $2 @ + [(Descendant true, + (node, NodeKind.Node), + [])] } ; relative_path: step { [ $1 ] } | relative_path SLASH step { $3 :: $1 } | relative_path SLASHSLASH step { $3 - :: (Descendant true, node, []) + :: (Descendant true, + (node, NodeKind.Node), + []) :: $1 } ; @@ -85,32 +91,45 @@ step: ; axis_test: - 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) + AXIS COLONCOLON test { let a, (t,k) = $1, $3 in + let new_t = + if a == Attribute && Utils.QNameSet.is_finite t then + Utils.QNameSet.fold + (fun t a -> + Utils.QNameSet.add + (Utils.QName.attribute t) a) + t Utils.QNameSet.empty + else t + in + (a, (new_t,k)) } | test { Child, $1 } | AXIS { let _ = Format.flush_str_formatter () in let () = Format.fprintf Format.str_formatter "%a" Ast.print_axis $1 in let a = Format.flush_str_formatter () in - Child, Utils.QNameSet.singleton (Utils.QName.of_string a) + Child, (Utils.QNameSet.singleton (Utils.QName.of_string a),NodeKind.Element) } | ATTNAME { (Attribute, - Utils.QNameSet.singleton (Utils.QName.of_string $1)) } + (Utils.QNameSet.singleton (Utils.QName.of_string $1), + NodeKind.Attribute)) } ; test: - NODE { node } -| TEXT { text } -| STAR { star } -| TAG { Utils.QNameSet.singleton(Utils.QName.of_string $1) } + NODE { node, NodeKind.Node } +| TEXT { text, NodeKind.Text } +| STAR { star, NodeKind.Element } +| COMMENT { Utils.QNameSet.singleton(Utils.QName.comment), + NodeKind.Comment + } +| PI { Utils.QNameSet.singleton( + Utils.QName.processing_instruction ( + Utils.QName.of_string $1) + ), NodeKind.ProcessingInstruction + } +| TAG { Utils.QNameSet.singleton(Utils.QName.of_string $1), + NodeKind.Element + } ; pred_list: -- 2.17.1