%{

let p0 = (0,0)

open FSharp.Text.Parsing
open AbSyn

(* parse-error function *)
let mutable ErrorContextDescriptor : string = ""

let parse_error_rich =
  Some (fun (ctxt: ParseErrorContext<_>) ->
    ErrorContextDescriptor <-
      match ctxt.CurrentToken with
      | None -> "At beginning of input\n"
      | Some token -> sprintf "at token %A\n" token
  )

%}

//////////////////////////////////////////////////////////////////////
// TODO: Add new (lexer) token definitions:
//
//   TODO: project task 1 :
//     - multiplication (*), division (/), numerical negation (~), 
//       logical negation (not), logical and (&&), logical or (||),
//       boolean literals (true, false)
//     - add the required precedence and associativity rules for
//       *, /, ~, not, &&, ||
//     - generalize the syntax of let-expressions to allow
//       multiple variable declarations
//
//   TODO: project task 2: replicate, filter, scan 
//
//   TODO: project task 4: array comprehension 
//////////////////////////////////////////////////////////////////////

%token <int * Position> NUM
%token <char * Position> CHARLIT
%token <string * Position> ID STRINGLIT
%token <Position> IF THEN ELSE LET IN EOF
%token <Position> INT CHAR BOOL
%token <Position> PLUS MINUS LESS
%token <Position> DEQ LTH EQ OP MAP REDUCE IOTA ARROW
%token <Position> FUN FN COMMA SEMICOLON READ WRITE
%token <Position> LPAR RPAR LBRACKET RBRACKET LCURLY RCURLY

%nonassoc ifprec letprec
%left DEQ LTH
%left PLUS MINUS

%start Prog
%type <AbSyn.UntypedProg> Prog
%type <AbSyn.UntypedFunDec list> FunDecs
%type <AbSyn.UntypedFunDec> Fun
%type <AbSyn.Type> Type
%type <AbSyn.UntypedExp> Exp
%type <AbSyn.UntypedExp list> Exps
%type <AbSyn.UntypedFunArg> FunArg
// TODO: Task 1(b): add any new nonterminals here

%%

Prog :    FunDecs EOF   { $1 }
;

FunDecs : FUN Fun FunDecs { $2 :: $3 }
        | FUN Fun         { $2 :: [] }
;

Fun : Type ID LPAR Params RPAR EQ Exp
           { FunDec (fst $2, $1, $4, $7, snd $2) }
    | Type ID LPAR RPAR EQ Exp
           { FunDec (fst $2, $1, [], $6, snd $2) }
;

Type :   INT                    { AbSyn.Int }
     |   CHAR                   { AbSyn.Char }
     |   BOOL                   { AbSyn.Bool }
     |   LBRACKET Type RBRACKET { AbSyn.Array $2 }
;

Params : Type ID COMMA Params
                       { Param (fst $2, $1) :: $4 }
       | Type ID       { Param (fst $2, $1) :: [] }
;


BinOp : PLUS  { (Lambda
                       (Int, [Param ("x", Int);
                              Param ("y", Int)],
                        Plus (Var ("x", $1),
                              Var ("y", $1),
                                        $1) ,$1))}
;

///////////////////////////////////////////////////////
// TODO: project tasks 1,2,4: 
//       add grammer rules for the new expressions
///////////////////////////////////////////////////////

Exp : NUM            { Constant (IntVal (fst $1), snd $1) }
    | CHARLIT        { Constant (CharVal (fst $1), snd $1) }
    | ID             { Var $1 }
    | STRINGLIT      { StringLit $1 }
    | LCURLY Exps RCURLY
                     { ArrayLit ($2, (), $1) }
    | Exp PLUS  Exp  { Plus ($1, $3, $2) }
    | Exp MINUS Exp  { Minus($1, $3, $2) }
    | Exp DEQ   Exp  { Equal($1, $3, $2) }
    | Exp LTH   Exp  { Less ($1, $3, $2) }
    | IF Exp THEN Exp ELSE Exp %prec ifprec
                     { If ($2, $4, $6, $1) }
    | ID LPAR Exps RPAR
                     { Apply (fst $1, $3, snd $1) }
    | ID LPAR RPAR   { Apply (fst $1, [], snd $1) }
    | READ LPAR Type RPAR
                     { Read ($3, $1) }
    | WRITE LPAR Exp RPAR
                     { Write ($3, (), $1) }
    | IOTA LPAR Exp RPAR
                     { Iota ($3, $1) }
    | MAP LPAR FunArg COMMA Exp RPAR
                     { Map ($3, $5, (), (), $1) }
    | REDUCE LPAR FunArg COMMA Exp COMMA Exp RPAR
                     { Reduce ($3, $5, $7, (), $1) }
    | REDUCE LPAR OP BinOp COMMA Exp COMMA Exp RPAR
                     { Reduce ($4, $6, $8, (), $1) }
    | LPAR Exp RPAR  { $2 }
    // TODO: task 1(b): replace this with a more general production
    | LET ID EQ Exp IN Exp %prec letprec
                     { Let (Dec (fst $2, $4, $3), $6, $1) }
    | ID LBRACKET Exp RBRACKET
                     { Index (fst $1, $3, (), $2) }
;

Exps : Exp COMMA Exps { $1 :: $3 }
     | Exp            { $1 :: [] }
;

FunArg : ID    { FunName (fst $1 ) }
       | FN Type LPAR RPAR ARROW Exp
               { Lambda ($2, [], $6, $1) }
       | FN Type LPAR Params RPAR ARROW Exp
               { Lambda ($2, $4, $7, $1) }
;

%%