%{
(***********************************************************************)
(*                                                                     *)
(*                               TAToo                                 *)
(*                                                                     *)
(*                     Kim Nguyen, LRI UMR8623                         *)
(*                   Université Paris-Sud & CNRS                       *)
(*                                                                     *)
(*  Copyright 2010-2012 Université Paris-Sud and Centre National de la *)
(*  Recherche Scientifique. All rights reserved.  This file is         *)
(*  distributed under the terms of the GNU Lesser General Public       *)
(*  License, with the special exception on linking described in file   *)
(*  ../LICENSE.                                                        *)
(*                                                                     *)
(***********************************************************************)

  open Ast
  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 DOT DOTDOT
%token EQ NEQ LT GT LTE GTE OR AND ADD SUB DIV MOD
%token NODE TEXT COMMENT
%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_query
%type <Ast.path> xpath_query


%%
xpath_query:
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 { $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, NodeKind.Node),
                                      [])
                                     :: $1) }
;

step:
  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,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 ] }
| 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, (QNameSet.singleton (QName.of_string a),NodeKind.Element)]
}
| ATTNAME             {  [(Attribute,
                           (QNameSet.singleton (QName.of_string $1),
                            NodeKind.Attribute))] }
;

test:
  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:
  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 }
;