--- /dev/null
+%{
+
+ open XPath.Ast
+ let f () = ()
+%}
+
+%token <string> TAG
+%token <string> STRING
+%token <int> INT
+%token <float> FLOAT
+%token <XPath.Ast.axis> AXIS
+%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 COMMA
+%token EOF
+
+%left OR
+%left AND
+%left EQ NEQ
+%left LT GT LTE GTE
+%left ADD SUB
+%left MOD DIV STAR
+%nonassoc uminus
+
+%start xpath
+%type <XPath.Ast.path> xpath
+
+
+%%
+xpath:
+path EOF { $1 }
+;
+
+path:
+ path_rev { List.rev $1 }
+;
+
+path_rev:
+ simple_path { [ $1 ] }
+| path_rev PIPE simple_path { $3 :: $1 }
+;
+
+
+simple_path:
+ absolute_path { Absolute (List.rev $1) }
+| relative_path { Relative (List.rev $1) }
+;
+
+absolute_path:
+ SLASH relative_path { $2 }
+| SLASHSLASH relative_path { (DescendantOrSelf, node, []) :: $2 }
+;
+
+relative_path:
+ step { [ $1 ] }
+| relative_path SLASH step { $3 :: $1 }
+| relative_path SLASHSLASH step { $3
+ :: (DescendantOrSelf, node, [])
+ :: $1 }
+;
+
+step:
+ axis_test pred_list { let a, b = $1 in a, b, $2 }
+;
+
+axis_test:
+ AXIS COLONCOLON test { $1, $3 }
+| test { Child, $1 }
+| AXIS {
+ let _ = Format.flush_str_formatter () in
+ let () = Format.fprintf Format.str_formatter "%a" XPath.Ast.print_axis $1 in
+ let a = Format.flush_str_formatter () in
+ Child, QNameSet.singleton (QName.of_string a)
+}
+;
+
+test:
+ NODE { node }
+| TEXT { text }
+| STAR { star }
+| TAG { QNameSet.singleton(QName.of_string $1) }
+;
+
+pred_list:
+ pred_list_rev { List.rev $1 }
+;
+
+pred_list_rev:
+ { [] }
+| pred_list LB expr RB { $3 :: $1 }
+;
+
+expr:
+ INT { Number(`Int($1)) }
+| FLOAT { Number(`Float($1)) }
+| STRING { String $1 }
+| SUB expr %prec uminus { Unop(Neg, $2) }
+| expr AND expr { Binop($1, And, $3) }
+| expr OR expr { Binop($1, Or, $3) }
+| expr ADD expr { Binop($1, Add, $3) }
+| expr SUB expr { Binop($1, Sub, $3) }
+| expr STAR expr { Binop($1, Mult, $3) }
+| expr DIV expr { Binop($1, Div, $3) }
+| expr MOD expr { Binop($1, Mod, $3) }
+| expr EQ expr { Binop($1, Eq, $3) }
+| expr NEQ expr { Binop($1, Neq, $3) }
+| expr LT expr { Binop($1, Lt, $3) }
+| 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(QName.of_string $1, $3) }
+| LP expr RP { $2 }
+| path { Path $1 }
+;
+
+arg_list:
+ { [] }
+| arg_list1 { List.rev $1 }
+;
+
+arg_list1:
+ expr { [ $1 ] }
+| arg_list1 COMMA expr { $3 :: $1 }
+;
+