%{

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
  )

%}

%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

%token <Position> TIMES DIVIDE NUMNEG
%token <Position> NOT AND OR
%token <bool * Position> BOOLVAL

%token <Position> FILTER SCAN REPLICATE

%nonassoc ifprec letprec
%left AND OR
%nonassoc NOT
%left DEQ LTH
%left PLUS MINUS
%left TIMES DIVIDE
%nonassoc NUMNEG

%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

%type <AbSyn.UntypedExp> MultiLet

%%

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))}
;

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) }
    | REPLICATE LPAR Exp COMMA Exp RPAR
                     { Replicate ($3, $5, (), $1) }
    | FILTER LPAR FunArg COMMA Exp RPAR
                     { Filter ($3, $5, (), $1) }
    | SCAN LPAR FunArg COMMA Exp COMMA Exp RPAR
                     { Scan ($3, $5, $7, (), $1) }
    | LPAR Exp RPAR  { $2 }
    | LET ID EQ Exp MultiLet %prec letprec
        { Let (Dec (fst $2, $4, $3), $5, $1) }
    | ID LBRACKET Exp RBRACKET
                     { Index (fst $1, $3, (), $2) }

    | Exp TIMES Exp  { Times ($1, $3, $2) }
    | Exp DIVIDE Exp { Divide ($1, $3, $2) }
    | NUMNEG Exp     { Negate ($2, $1) }

    | Exp AND Exp    { And ($1, $3, $2) }
    | Exp OR Exp     { Or ($1, $3, $2) }
    | NOT Exp        { Not ($2, $1) }
    | BOOLVAL        { Constant (BoolVal (fst $1), snd $1) }
;

MultiLet : IN Exp                   { $2 }
         | SEMICOLON ID EQ Exp MultiLet
                { Let (Dec (fst $2, $4, $3), $5, $1) }
;

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) }
;

%%