/* analyseur syntaxique pour le langage Julia */
 
%{
  open Ast
  open Lexing
%}
 
/* liste des tokens */
 
%token EOF
%token NEWLINE
 
%token RETURN ASSIGN END
 
%token FOR WHILE
%token ELSE ELSEIF IF
%token FUNCTION
%token MUTABLE STRUCT
 
%token <int64> CST
%token <string> IDENT
%token <string> STRING
 
%token ADD SUB MUL MOD POW
%token EQ DIFF LT LE GE GT
%token AND OR
 
%token SEMICOLON COMMA COLON DOT DOUBLECOLON
%token LPAR RPAR
 
%token <string> IDENT_PARG
%token <int64> ENTIER_PARG
%token <string> PARD_IDENT
%token <int64 * string> ENTIER_IDENT
 
%token NOT
 
%token TRUE FALSE
 
/* prioritées et associativitées des tokens */
 
%nonassoc RETURN
 
%nonassoc WHILE TRUE STRING LPAR IF IDENT_PARG IDENT FOR FALSE ENTIER_PARG ENTIER_IDENT CST
 
%right ASSIGN
%left OR
%left AND
%left EQ DIFF LT LE GE GT
%left ADD SUB
%left MUL MOD
%nonassoc UNARY_MINUS NOT
%right POW
%left DOT
 
/* point d'entrée */
%start file
 
/* type de retour */
%type <Ast.fichier> file
 
%%
 
file:
  decls = decl*
  EOF 
    { decls }
;
 
decl:
  | e = expr SEMICOLON
    { Dexpr e }
  | f = fonction
    { Dfun f }
  | s = structure
    { Dstruct s }
;
 
expr:
  e = expr_desc
    { {desc = e; loc = $startpos, $endpos} }
;
 
expr_desc:
  | SUB e = expr %prec UNARY_MINUS
    { Eunop (Uneg, e) }
  | NOT e = expr
    { Eunop (Unot, e) }
  | x = CST
    { Ecst (Cint x) }
  | s = STRING
    { Ecst (Cstring s) }
  | TRUE
    { Ecst (Cbool true) }
  | FALSE
    { Ecst (Cbool false) }
  | e = ENTIER_IDENT
    { Eentier_ident (fst e, snd e) } 
  | x = ENTIER_PARG b = bloc1 RPAR
    { Eentier_parg_bloc (x, b) }
  | LPAR b = bloc1 RPAR
    { Ebloc b }
  | LPAR e = expr id = PARD_IDENT
    { Epard_ident (e, id) }
  | id = IDENT_PARG l = separated_list(COMMA, expr) RPAR
    { Ecall (id, l) }
  | e1 = expr op = binop e2 = expr
    { Ebinop (e1, op, e2) }
  | l = lvalue ASSIGN e = expr
    { Eassign (l, e) }
  | l = lvalue
    { Elvalue l }
  | RETURN e=expr
    { Ereturn (Some e) }
  | RETURN
    { Ereturn None }
  | f = for_
    { f }
  | x = while_
    { x }
  | l = expr_bloc_if(IF) 
   { Eif(l) } 
;
 
%inline non_unit_expr:
  e = non_unit_expr_desc
    { {desc = e; loc = $startpos, $endpos} : expr}
;
non_unit_expr_desc:
  | x = CST
    { Ecst (Cint x) }
  | s = STRING
    { Ecst (Cstring s) }
  | TRUE
    { Ecst (Cbool true) }
  | FALSE
    { Ecst (Cbool false) }
  | e = ENTIER_IDENT
    { Eentier_ident (fst e, snd e) } 
  | x = ENTIER_PARG b = bloc1 RPAR
    { Eentier_parg_bloc (x, b) }
  | LPAR b = bloc1 RPAR
    { Ebloc b }
  | LPAR e = expr id = PARD_IDENT
    { Epard_ident (e, id) }
  | id = IDENT_PARG l = separated_list(COMMA, expr) RPAR
    { Ecall (id, l) }
  | e1 = non_unit_expr op = binop e2 = expr
    { Ebinop (e1, op, e2) }
  | l = non_unit_lvalue ASSIGN e = expr
    { Eassign (l, e) }
  | l = non_unit_lvalue
    { Elvalue l }
  | RETURN e=expr
    { Ereturn (Some e) }
  | RETURN
    { Ereturn None }
  | f = for_
    { f } 
  | x = while_
    { x }
  | l = expr_bloc_if(IF)
    { Eif(l) }
 
;
 
for_:
  FOR id = IDENT ASSIGN e1 = expr x = expr_bloc_loop(COLON)
    { Efor(id, e1, fst x, snd x) } 
 
while_:
  x = expr_bloc_loop(WHILE)
    { Ewhile(fst x, snd x) } 
 
expr_bloc_if(X):
  X e = expr l = else_
    { (Some e, []) :: l } 
  | X  e1 = expr e2 = non_unit_expr b = ioption(preceded(SEMICOLON, bloc)) l = else_
    { (Some e1, e2 :: (match b with None -> [] | Some x -> x)) ::  l }
  | X  e = expr SEMICOLON b = bloc l = else_
    { (Some e, b) :: l  }
;
 
expr_bloc_loop(X):
  X e = expr END
    { (e, []) }
  | X e1 = expr e2 = non_unit_expr b = ioption(preceded(SEMICOLON, bloc)) END
  { (e1, e2 :: (match b with None -> [] | Some l -> l))}
  | X e = expr SEMICOLON b = bloc END
    { (e, b) }
;
 
else_:
  | END
    { [] }
  | ELSE b=bloc END
    { [ None, b ] }
  | l = expr_bloc_if(ELSEIF)
    { l } 
;
 
%inline lvalue:
  | s = IDENT
    { LvalueIdent s } 
  | e = expr DOT id = IDENT
    { LvalueStruct (e, id) }
;
 
%inline non_unit_lvalue:
  | s = IDENT
    { LvalueIdent s }
  | e = non_unit_expr DOT id = IDENT
    { LvalueStruct (e, id) } 
;
 
%inline binop:
  | ADD {Badd} | SUB {Bsub} | MUL {Bmul} | MOD {Bmod} | POW {Bpow}
  | EQ {Beq} | DIFF {Bdiff} | LT {Blt} | LE {Ble} | GE {Bge} | GT {Bgt}
  | AND {Band} | OR {Bor}
;
 
bloc:
 
  l = separated_nonempty_list(SEMICOLON, ioption(expr))
  { 
    List.fold_right (fun x cur -> match x with | None -> cur | Some v -> v :: cur) l []
  }
;
 
fonction:
  FUNCTION id = IDENT_PARG l = separated_list(COMMA, param) RPAR t = option(preceded(DOUBLECOLON, IDENT)) b = bloc END SEMICOLON
    { 
      {
        loc = $startpos, $endpos;
        desc = (id, l, t, b)
      } : fonction
    }
;
 
param:
  id = IDENT t = preceded(DOUBLECOLON, IDENT)?
  { 
    {loc = $startpos, $endpos; desc = id, t } : param 
    }
;
 
bloc1:
  e = expr f = option(preceded(SEMICOLON, bloc))
  {  e :: (match f with | None -> [] | Some l -> l) }
;
 
structure:
  m = MUTABLE? STRUCT id=IDENT l = separated_nonempty_list(SEMICOLON, param?) END SEMICOLON
  { {desc = (match m with | None -> false | _ -> true), id, l;
    loc = $startpos, $endpos } : structure }
;