Simplify the automaton encoding a bit (remove redundant predicates in formulae).

[tatoo.git] / src / xpath / xpath_internal_parser.mly

diff --git a/src/xpath/xpath_internal_parser.mly b/src/xpath/xpath_internal_parser.mly
index 3651d2c..6395b6e 100644 (file)
--- a/src/xpath/xpath_internal_parser.mly
+++ b/src/xpath/xpath_internal_parser.mly
@@ -14,24 +14,21 @@
 (*                                                                     *)
 (***********************************************************************)
 
-(*
-  Time-stamp: <Last modified on 2013-03-10 14:31:48 CET by Kim Nguyen>
-*)
-
   open Ast
-  let f () = ()
+  open Tree
 %}
 
 %token <string> TAG
+%token <string> PI
 %token <string> ATTNAME
 %token <string> STRING
 %token <int>  INT
 %token <float> FLOAT
 %token <Ast.axis> AXIS
 %token RB LB LP RP
-%token SLASH SLASHSLASH COLONCOLON STAR PIPE
+%token SLASH SLASHSLASH COLONCOLON STAR PIPE DOT DOTDOT
 %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,48 +66,77 @@ simple_path:
 
 absolute_path:
   SLASH relative_path { $2 }
-| SLASHSLASH relative_path { $2 @ [(Descendant true, node, [])] }
+| SLASHSLASH relative_path { $2 @
+                               [(Descendant true,
+                                 (node, NodeKind.Node),
+                                 [])] }
 ;
 
+/*
+  step is always a small list, of size 1-3 so @ is
+  cheap
+*/
 relative_path:
-  step { [ $1 ] }
-| relative_path SLASH step { $3 :: $1 }
-| relative_path SLASHSLASH step { $3
-                                  :: (Descendant true, node, [])
-                                  :: $1 }
+  step { $1 }
+| relative_path SLASH step { $3 @ $1 }
+| relative_path SLASHSLASH step { $3 @
+                                    ((Descendant true,
+                                      (node, NodeKind.Node),
+                                      [])
+                                     :: $1) }
 ;
 
 step:
-  axis_test pred_list    { let a, b = $1 in a, b, $2 }
+  DOT                    { [ (Self, (node, NodeKind.Node), []) ] }
+| DOTDOT                 { [ (Parent, (node, NodeKind.Node), []) ] }
+| axis_test pred_list    {
+    match $1 with
+      (a,b) :: r -> (a,b,$2) :: (List.map (fun (a,b) -> (a,b,[])) r)
+    | [] -> assert false
+  }
 ;
 
 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
+                          match a with
+                          | Attribute -> [ a, (t, NodeKind.Attribute) ]
+                          | Preceding|Following ->
+                              [ (Descendant true, (t,k));
+                                if a == Preceding then
+                                  (PrecedingSibling, (node, NodeKind.Node))
+                                else
+                                  (FollowingSibling, (node, NodeKind.Node));
+                                (Ancestor true, (node, NodeKind.Node)) ]
+
+                          | _ -> [ a, (t,k) ]
                         }
-| test                  { Child, $1 }
+| 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, (QNameSet.singleton (QName.of_string a),NodeKind.Element)]
 }
-| ATTNAME             {  (Attribute,
-                          Utils.QNameSet.singleton (Utils.QName.of_string $1)) }
+| ATTNAME             {  [(Attribute,
+                           (QNameSet.singleton (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                { node, NodeKind.Element }
+| COMMENT             { QNameSet.singleton(QName.comment),
+                        NodeKind.Comment
+                      }
+| PI                  { (if $1 = "" then star
+                         else QNameSet.singleton(
+                             QName.of_string $1
+                         )), NodeKind.ProcessingInstruction
+                      }
+| TAG                 { QNameSet.singleton(QName.of_string $1),
+                        NodeKind.Element
+                      }
 ;
 
 pred_list:
@@ -140,7 +166,7 @@ expr:
 | expr LTE expr             { Binop($1, Lte, $3) }
 | expr GT expr              { Binop($1, Gt, $3) }
 | expr GTE expr             { Binop($1, Gte, $3) }
-| TAG LP arg_list RP        { Fun_call(Utils.QName.of_string $1, $3) }
+| TAG LP arg_list RP        { Fun_call(QName.of_string $1, $3) }
 | LP expr RP                { $2 }
 | path                      { Path $1 }
 ;