Add a kind element to the node tree. Improve support for XPath by
authorKim Nguyễn <kn@lri.fr>
Wed, 13 Mar 2013 10:21:41 +0000 (11:21 +0100)
committerKim Nguyễn <kn@lri.fr>
Wed, 13 Mar 2013 10:21:41 +0000 (11:21 +0100)
allowing processing-instruction and comment tests.
Fix the handling of attribute nodes.

src/auto/ata.ml
src/auto/eval.ml
src/tree/naive.ml
src/utils/qName.ml
src/utils/qName.mli
src/xpath/ast.ml
src/xpath/ast.mli
src/xpath/compile.ml
src/xpath/ulexer.ml
src/xpath/xpath_internal_parser.mly

index c7bb172..4418996 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-09 18:06:46 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-11 00:14:28 CET by Kim Nguyen>
 *)
 
 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_
index 4921b7f..4f68da0 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-09 09:22:47 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-10 23:31:33 CET by Kim Nguyen>
 *)
 
 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 ->
index ee93863..0885bad 100644 (file)
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-09 18:49:04 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-13 10:33:17 CET by Kim Nguyen>
 *)
 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 "</";
-      output_string out tag;
-      output_char 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 "</";
+          output_string out tag;
+          output_char out '>'
+        end
+    | Attribute -> ignore (print_attributes ~sep:false out tree_ node)
+    | Comment ->
+        output_string out "<!--";
+        output_string out node.data;
+        output_string out "-->"
+    | ProcessingInstruction ->
+        output_string out "<?";
+        output_string out (QName.to_string (QName.remove_prefix node.tag));
+        output_char out ' ';
+        output_string out node.data;
+        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
index d3f0a43..4a3aac4 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-02-14 16:14:44 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-10 23:05:56 CET by Kim Nguyen>
 *)
 
 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
index 3d6c899..978ba3c 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-04 22:48:34 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-10 23:02:12 CET by Kim Nguyen>
 *)
 
 (** 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.
+*)
index d70227b..64c6c8d 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-04 16:24:20 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-13 10:59:20 CET by Kim Nguyen>
 *)
 
 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 "<INFINITE>"
-      )
+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" "<DOCUMENT>"
 
 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
index 7cc91e4..0fc63d4 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-04 16:24:33 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-13 10:59:27 CET by Kim Nguyen>
 *)
 
 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
index 7848b84..2588432 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-10 12:28:07 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-13 11:02:32 CET by Kim Nguyen>
 *)
 
 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 =
index 3e71c5a..dbde490 100644 (file)
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-10 14:34:41 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-13 10:34:14 CET by Kim Nguyen>
 *)
 
 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
index 3651d2c..a589fde 100644 (file)
 (***********************************************************************)
 
 (*
-  Time-stamp: <Last modified on 2013-03-10 14:31:48 CET by Kim Nguyen>
+  Time-stamp: <Last modified on 2013-03-13 09:56:09 CET by Kim Nguyen>
 *)
 
   open Ast
-  let f () = ()
+  open Tree.Common
 %}
 
 %token <string> TAG
+%token <string> PI
 %token <string> ATTNAME
 %token <string> STRING
 %token <int>  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: