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 (file)
--- a/src/tree/naive.ml
+++ b/src/tree/naive.ml
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
 (***********************************************************************)
 
 (*

-  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
 
 *)
 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;
     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 [];
 
   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;
     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 =
     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
 
     | 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 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
     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 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 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 '>';
     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
 
   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
 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 (file)
--- a/src/utils/qNameSet.ml
+++ b/src/utils/qNameSet.ml
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
 (***********************************************************************)
 
 (*

-  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))
 *)
 
 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 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
 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
 end

diff --git a/src/utils/qNameSet.mli b/src/utils/qNameSet.mli
index 175ba26..132d834 100644 (file)
--- a/src/utils/qNameSet.mli
+++ b/src/utils/qNameSet.mli
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
 (***********************************************************************)
 
 (*

-  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
 *)
 
 (** 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
 
 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
 
 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
 end

diff --git a/src/xpath/compile.ml b/src/xpath/compile.ml
index 123583f..1c46b8f 100644 (file)
--- a/src/xpath/compile.ml
+++ b/src/xpath/compile.ml
@@ -14,7 +14,7 @@
 (***********************************************************************)
 
 (*
 (***********************************************************************)
 
 (*

-  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
 *)
 
 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 ( ++ ) 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
 
 
 module F = Ata.SFormula
 


@@ -46,8 +54,9 @@ let root_set = QNameSet.singleton QName.document
    holds.
 *)
 
    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 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 ->
   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,
 
     | 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),
                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)
                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,
           else F.next_sibling q
         in
         move,

-        (q, [ test => phi;
+        (q, [ test => phi %% phi_attr;

               QNameSet.any => move ]) :: trans,
         states
 
     | Attribute ->
               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,
         (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'
 
 
   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
   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
 
 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 =
         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 =
     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
         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 =
         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)
           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 =
         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
         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
               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 =
     | _ -> assert false
   in
   let phi0, trans0, states0 =


@@ -204,7 +218,7 @@ let compile_top_level_step_list l trans states =
       trans
       states
   in
       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 (file)
--- a/src/xpath/xpath_internal_parser.mly
+++ b/src/xpath/xpath_internal_parser.mly
@@ -15,7 +15,7 @@
 (***********************************************************************)
 
 (*
 (***********************************************************************)
 
 (*

-  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
 *)
 
   open Ast


@@ -84,7 +84,16 @@ step:
 ;
 
 axis_test:
 ;
 
 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
 | test                  { Child, $1 }
 | AXIS            {
   let _ = Format.flush_str_formatter () in