Simplify the automaton encoding a bit (remove redundant predicates in formulae).
[tatoo.git] / src / xpath / xpath_internal_parser.mly
1 %{
2 (***********************************************************************)
3 (*                                                                     *)
4 (*                               TAToo                                 *)
5 (*                                                                     *)
6 (*                     Kim Nguyen, LRI UMR8623                         *)
7 (*                   Universit√© Paris-Sud & CNRS                       *)
8 (*                                                                     *)
9 (*  Copyright 2010-2012 Universit√© Paris-Sud and Centre National de la *)
10 (*  Recherche Scientifique. All rights reserved.  This file is         *)
11 (*  distributed under the terms of the GNU Lesser General Public       *)
12 (*  License, with the special exception on linking described in file   *)
13 (*  ../LICENSE.                                                        *)
14 (*                                                                     *)
15 (***********************************************************************)
16
17   open Ast
18   open Tree
19 %}
20
21 %token <string> TAG
22 %token <string> PI
23 %token <string> ATTNAME
24 %token <string> STRING
25 %token <int>  INT
26 %token <float> FLOAT
27 %token <Ast.axis> AXIS
28 %token RB LB LP RP
29 %token SLASH SLASHSLASH COLONCOLON STAR PIPE DOT DOTDOT
30 %token EQ NEQ LT GT LTE GTE OR AND ADD SUB DIV MOD
31 %token NODE TEXT COMMENT
32 %token COMMA
33 %token EOF
34
35 %left OR
36 %left AND
37 %left EQ NEQ
38 %left LT GT LTE GTE
39 %left ADD SUB
40 %left MOD DIV STAR
41 %nonassoc uminus
42
43 %start xpath_query
44 %type <Ast.path> xpath_query
45
46
47 %%
48 xpath_query:
49 path EOF          { $1 }
50 ;
51
52 path:
53   path_rev { List.rev $1 }
54 ;
55
56 path_rev:
57   simple_path     { [ $1 ] }
58 | path_rev PIPE simple_path { $3 :: $1 }
59 ;
60
61
62 simple_path:
63    absolute_path  { Absolute  (List.rev $1) }
64 |  relative_path  { Relative  (List.rev $1) }
65 ;
66
67 absolute_path:
68   SLASH relative_path { $2 }
69 | SLASHSLASH relative_path { $2 @
70                                [(Descendant true,
71                                  (node, NodeKind.Node),
72                                  [])] }
73 ;
74
75 /*
76   step is always a small list, of size 1-3 so @ is
77   cheap
78 */
79 relative_path:
80   step { $1 }
81 | relative_path SLASH step { $3 @ $1 }
82 | relative_path SLASHSLASH step { $3 @
83                                     ((Descendant true,
84                                       (node, NodeKind.Node),
85                                       [])
86                                      :: $1) }
87 ;
88
89 step:
90   DOT                    { [ (Self, (node, NodeKind.Node), []) ] }
91 | DOTDOT                 { [ (Parent, (node, NodeKind.Node), []) ] }
92 | axis_test pred_list    {
93     match $1 with
94       (a,b) :: r -> (a,b,$2) :: (List.map (fun (a,b) -> (a,b,[])) r)
95     | [] -> assert false
96   }
97 ;
98
99 axis_test:
100   AXIS COLONCOLON test  { let a, (t,k) = $1, $3 in
101                           match a with
102                           | Attribute -> [ a, (t, NodeKind.Attribute) ]
103                           | Preceding|Following ->
104                               [ (Descendant true, (t,k));
105                                 if a == Preceding then
106                                   (PrecedingSibling, (node, NodeKind.Node))
107                                 else
108                                   (FollowingSibling, (node, NodeKind.Node));
109                                 (Ancestor true, (node, NodeKind.Node)) ]
110
111                           | _ -> [ a, (t,k) ]
112                         }
113 | test                  { [ Child, $1 ] }
114 | AXIS            {
115   let _ = Format.flush_str_formatter () in
116   let () = Format.fprintf Format.str_formatter "%a" Ast.print_axis $1 in
117   let a = Format.flush_str_formatter () in
118   [Child, (QNameSet.singleton (QName.of_string a),NodeKind.Element)]
119 }
120 | ATTNAME             {  [(Attribute,
121                            (QNameSet.singleton (QName.of_string $1),
122                             NodeKind.Attribute))] }
123 ;
124
125 test:
126   NODE                { node, NodeKind.Node }
127 | TEXT                { text, NodeKind.Text }
128 | STAR                { node, NodeKind.Element }
129 | COMMENT             { QNameSet.singleton(QName.comment),
130                         NodeKind.Comment
131                       }
132 | PI                  { (if $1 = "" then star
133                          else QNameSet.singleton(
134                              QName.of_string $1
135                          )), NodeKind.ProcessingInstruction
136                       }
137 | TAG                 { QNameSet.singleton(QName.of_string $1),
138                         NodeKind.Element
139                       }
140 ;
141
142 pred_list:
143   pred_list_rev             { List.rev $1 }
144 ;
145
146 pred_list_rev:
147              { [] }
148 | pred_list LB expr RB   { $3 :: $1 }
149 ;
150
151 expr:
152   INT                       { Number(`Int($1)) }
153 | FLOAT                     { Number(`Float($1)) }
154 | STRING                    { String $1 }
155 | SUB expr     %prec uminus { Unop(Neg, $2) }
156 | expr AND expr             { Binop($1, And, $3) }
157 | expr OR expr              { Binop($1, Or, $3) }
158 | expr ADD expr             { Binop($1, Add, $3) }
159 | expr SUB expr             { Binop($1, Sub, $3) }
160 | expr STAR expr            { Binop($1, Mult, $3) }
161 | expr DIV expr             { Binop($1, Div, $3) }
162 | expr MOD expr             { Binop($1, Mod, $3) }
163 | expr EQ expr              { Binop($1, Eq, $3) }
164 | expr NEQ expr             { Binop($1, Neq, $3) }
165 | expr LT expr              { Binop($1, Lt, $3) }
166 | expr LTE expr             { Binop($1, Lte, $3) }
167 | expr GT expr              { Binop($1, Gt, $3) }
168 | expr GTE expr             { Binop($1, Gte, $3) }
169 | TAG LP arg_list RP        { Fun_call(QName.of_string $1, $3) }
170 | LP expr RP                { $2 }
171 | path                      { Path $1 }
172 ;
173
174 arg_list:
175                             { [] }
176 | arg_list1                 { List.rev $1 }
177 ;
178
179 arg_list1:
180   expr                     { [ $1 ] }
181 | arg_list1 COMMA expr     { $3 :: $1 }
182 ;