%{

open TinyML
open FSharp.Common.Parsing.LexYacc
open TinyML.Ast

let parse_error_rich = Some (fun ctx -> raise (ParseErrorContextException ctx))

let desugar_params params e0 = List.foldBack (fun (id, tyo) e -> Lambda (id, tyo, e)) params e0

%}
 

%token <System.Int32> INT
%token <System.Double> FLOAT
%token <System.Char> CHAR
%token <System.String> STRING ID

%token IF THEN ELSE FUN ARROW LET REC IN
       TRUE FALSE 
       BRA KET 
       PLUS MINUS STAR SLASH PERCENT
       LT GT LEQ GEQ EQ NEQ
       AND OR NOT
       COLON SEMICOLON2 COMMA
%token EOF

%nonassoc THEN ELSE
%left COMMA
%right ARROW
%left OR
%left AND 
%left EQ LT GT LEQ GEQ NEQ
%left PLUS MINUS 
%left STAR SLASH MOD 
%left APP
%nonassoc NOT
%nonassoc UMINUS

%type < TinyML.Ast.expr > program
%type < TinyML.Ast.interactive > interactive

%start program
%start interactive

%%

program:
    expr EOF                            { $1 }

interactive:
    expr SEMICOLON2                     { IExpr $1 }
  | binding SEMICOLON2                  { IBinding $1 }

expr:
    expr_tuple_atom                     { $1 }
  | BRA expr_tuple_atoms KET            { Tuple $2 }

binding:
  | LET ID EQ expr                      { (false, $2, None, $4) }
  | LET ID COLON ty EQ expr             { (false, $2, Some $4, $6) }
  | LET REC ID EQ expr                  { (true, $3, None, $5) }
  | LET REC ID COLON ty EQ expr         { (true, $3, Some $5, $7) }

  | LET ID params EQ expr               { (false, $2, None, desugar_params $3 $5) }
  | LET REC ID params EQ expr           { (true, $3, None, desugar_params $4 $6 )}

param:
    ID                                  { ($1, None) }
  | BRA ID COLON ty KET                 { ($2, Some $4) }

params:
    param                               { [$1] }
  | param params                        { $1 :: $2 } 

lit:
    INT                                 { LInt $1 }
  | FLOAT                               { LFloat $1 }
  | STRING                              { LString $1 }
  | CHAR                                { LChar $1 }
  | TRUE                                { LBool true }
  | FALSE                               { LBool false }
  | BRA KET                             { LUnit }

expr_app_atom:
    lit                                 { Lit $1 }
  | ID                                  { Var $1 }
  | BRA expr KET                        { $2 }

expr_tuple_atom:
    expr_app_atom                               { $1 }
  | expr_tuple_atom expr_app_atom %prec APP     { App ($1, $2) }

  | FUN ID ARROW expr                           { Lambda ($2, None, $4) }
  | FUN BRA ID COLON ty KET ARROW expr          { Lambda ($3, Some $5, $8) }

  | binding IN expr                             { LetIn ($1, $3) }
  
  | NOT expr_tuple_atom							{ UnOp ("not", $2) }
  | MINUS expr_tuple_atom %prec UMINUS  		{ UnOp ("-", $2) }

  | expr_tuple_atom PLUS expr_tuple_atom        { BinOp ($1, "+", $3) }
  | expr_tuple_atom MINUS expr_tuple_atom       { BinOp ($1, "-", $3) }
  | expr_tuple_atom STAR expr_tuple_atom        { BinOp ($1, "*", $3) }
  | expr_tuple_atom SLASH expr_tuple_atom       { BinOp ($1, "/", $3) }
  | expr_tuple_atom PERCENT expr_tuple_atom     { BinOp ($1, "%", $3) }

  | expr_tuple_atom EQ expr_tuple_atom          { BinOp ($1, "=", $3) }
  | expr_tuple_atom NEQ expr_tuple_atom         { BinOp ($1, "<>", $3) }
  | expr_tuple_atom LT expr_tuple_atom          { BinOp ($1, "<", $3) }
  | expr_tuple_atom GT expr_tuple_atom          { BinOp ($1, ">", $3) }
  | expr_tuple_atom LEQ expr_tuple_atom         { BinOp ($1, "<=", $3) }
  | expr_tuple_atom GEQ expr_tuple_atom         { BinOp ($1, ">=", $3) }
  | expr_tuple_atom AND expr_tuple_atom         { BinOp ($1, "and", $3) }
  | expr_tuple_atom OR expr_tuple_atom          { BinOp ($1, "or", $3) }

  | IF expr THEN expr                           { IfThenElse ($2, $4, None) }
  | IF expr THEN expr ELSE expr                 { IfThenElse ($2, $4, Some $6) }

expr_tuple_atoms:
    expr_tuple_atom                             { [$1] }
  | expr_tuple_atom COMMA expr_tuple_atoms      { $1 :: $3 }


ty:
    ID                                  { TyName $1 }
  | ty ARROW ty                         { TyArrow ($1, $3) }
  | ty_tuple                            { TyTuple $1 }
  | BRA ty KET                          { $2 }
    
ty_tuple:
    ty STAR ty                          { [$1; $3] }
  | ty STAR ty STAR ty_tuple            { $1 :: $3 :: $5 }

    

