%{
(*
   grammar.mly
   15-411
   by Roland Flury
*)
(* @version $Id: grammar.mly,v 1.6 2004/10/30 19:33:22 ajo Exp $ *)

module A = Absyn open Absyn
module E = Errormsg

let context l r : E.pos = (rhs_start l, rhs_end r)

%}

%token <string> ID
%token <int32> INTCONST
%token LBRACE RBRACE LPAREN RPAREN LBRACKET RBRACKET
%token SEMICOL COLON COMMA DOT ARROW EOF
%token PLUS MINUS TIMES DIVIDE MOD
%token RELLT RELGT RELLE RELGE RELEQ RELNE
%token LOGAND LOGOR LOGXOR
%token BITAND BITOR BITXOR
%token BITSHL BITSHR
%token PTRPLUS PTRMINUS PTREQ PTRNE
%token NEGATE LOGNEGATE BITNEGATE DEREF
%token ASSIGN PLUSASSIGN MINUSASSIGN TIMESASSIGN DIVIDEASSIGN MODASSIGN
%token SIZE OFFSET ALLOC
%token STRUCT VAR IF ELSE RETURN
%token BOOL INT TRUE FALSE NULL

%start program

%type <Absyn.program> program

%left LOGOR
%left LOGXOR
%left LOGAND
%left RELEQ RELNE PTREQ PTRNE
%left RELLT RELLE RELGT RELGE
%left PTRPLUS PTRMINUS
%left BITOR
%left BITXOR
%left BITAND
%left BITSHL BITSHR
%left PLUS MINUS
%left TIMES DIVIDE MOD
%right NEGATE LOGNEGATE BITNEGATE ADDRESSOF DEREF
%left ARROW DOT LBRACKET
%%

program:
| typedclseq LBRACE vardclseq stmtseq RBRACE EOF
    { A.Program($1, $3, $4) }

typedclseq:
|     { [] }
| typedcl typedclseq    { $1 :: $2 }

typedcl:
| STRUCT ID LBRACE RBRACE SEMICOL
    { A.Typedcl($2, [], context 1 5) }
| STRUCT ID LBRACE fieldseq RBRACE SEMICOL
    { A.Typedcl($2, $4, context 1 6) }

fieldseq:
| field    { [$1] }
| field SEMICOL    { [$1] }
| field SEMICOL fieldseq    { $1 :: $3 }

field:
| ID COLON typeval    { ($1, $3) }

vardclseq:
|     { [] }
| vardcl vardclseq    { $1 @ $2 }

vardcl:
| VAR idseq COLON typeval SEMICOL
    { List.map (fun s -> A.Vardcl(s, $4, context 2 4)) $2 }

idseq:
| ID    { [$1] }
| ID COMMA idseq    { $1 :: $3 }

typeval:
| BOOL    { A.BoolT }
| INT    { A.IntT }
| ID    { A.StructT $1 }
| typeval TIMES    { A.PtrT $1 }


stmtseq:
|    { [] }
| stmt stmtseq    { $1 @ $2 }

stmt:
| matched {$1} | unmatched {$1}
matched:
| SEMICOL    { [] }
| assgnstmt SEMICOL    { [$1] }
| expr SEMICOL    { [A.Exp($1)] }
| RETURN expr SEMICOL    { [A.Return($2, context 2 2)] }
| IF LPAREN expr RPAREN block ELSE block    { [A.IfElse($3, $5, $7, context 3 3)] }
| IF LPAREN expr RPAREN block ELSE matched    { [A.IfElse($3, $5, $7, context 3 3)] }
| IF LPAREN expr RPAREN matched ELSE block    { [A.IfElse($3, $5, $7, context 3 3)] }
| IF LPAREN expr RPAREN matched ELSE matched    { [A.IfElse($3, $5, $7, context 3 3)] }
unmatched:
| IF LPAREN expr RPAREN stmt    { [A.IfElse($3, $5, [], context 3 3)] }
| IF LPAREN expr RPAREN block    { [A.IfElse($3, $5, [], context 3 3)] }
| IF LPAREN expr RPAREN matched ELSE unmatched    { [A.IfElse($3, $5, $7, context 3 3)] }
| IF LPAREN expr RPAREN block ELSE unmatched    { [A.IfElse($3, $5, $7, context 3 3)] }

block:
| LBRACE stmtseq RBRACE    { $2 }


assgnstmt:
| expr ASSIGN expr
    { A.Assign($1, $3, false, context 1 3) }
| expr PLUSASSIGN expr
    { A.Assign($1, A.BinOpExp($1, A.PLUS, $3, context 3 3, AnyT), false, context 1 3) }
| expr MINUSASSIGN expr
    { A.Assign($1, A.BinOpExp($1, A.MINUS, $3, context 3 3, AnyT), false, context 1 3) }
| expr TIMESASSIGN expr
    { A.Assign($1, A.BinOpExp($1, A.TIMES, $3, context 3 3, AnyT), false, context 1 3) }
| expr DIVIDEASSIGN expr
    { A.Assign($1, A.BinOpExp($1, A.DIVIDE, $3, context 3 3, AnyT), false, context 1 3) }
| expr MODASSIGN expr
    { A.Assign($1, A.BinOpExp($1, A.MOD, $3, context 3 3, AnyT), false, context 1 3) }


expr:
| LPAREN expr RPAREN    { $2 }
| expr PLUS expr    { A.BinOpExp($1, A.PLUS, $3, context 1 3, AnyT) }
| expr MINUS expr    { A.BinOpExp($1, A.MINUS, $3, context 1 3, AnyT) }
| expr TIMES expr    { A.BinOpExp($1, A.TIMES, $3, context 1 3, AnyT) }
| expr DIVIDE expr    { A.BinOpExp($1, A.DIVIDE, $3, context 1 3, AnyT) }
| expr MOD expr    { A.BinOpExp($1, A.MOD, $3, context 1 3, AnyT) }
| expr RELLT expr    { A.BinOpExp($1, A.RELLT, $3, context 1 3, AnyT) }
| expr RELLE expr    { A.BinOpExp($1, A.RELLE, $3, context 1 3, AnyT) }
| expr RELGT expr    { A.BinOpExp($1, A.RELGT, $3, context 1 3, AnyT) }
| expr RELGE expr    { A.BinOpExp($1, A.RELGE, $3, context 1 3, AnyT) }
| expr RELEQ expr    { A.BinOpExp($1, A.RELEQ, $3, context 1 3, AnyT) }
| expr RELNE expr    { A.BinOpExp($1, A.RELNE, $3, context 1 3, AnyT) }
| expr PTRPLUS expr    { A.BinOpExp($1, A.PTRPLUS, $3, context 1 3, AnyT) }
| expr PTRMINUS expr    { A.BinOpExp($1, A.PTRMINUS, $3, context 1 3, AnyT) }
| expr PTREQ expr    { A.BinOpExp($1, A.PTREQ, $3, context 1 3, AnyT) }
| expr PTRNE expr    { A.BinOpExp($1, A.PTRNE, $3, context 1 3, AnyT) }
| expr LOGOR expr    { A.BinOpExp($1, A.LOGOR, $3, context 1 3, AnyT) }
| expr LOGXOR expr    { A.BinOpExp($1, A.LOGXOR, $3, context 1 3, AnyT) }
| expr LOGAND expr    { A.BinOpExp($1, A.LOGAND, $3, context 1 3, AnyT) }
| expr BITOR expr    { A.BinOpExp($1, A.BITOR, $3, context 1 3, AnyT) }
| expr BITXOR expr    { A.BinOpExp($1, A.BITXOR, $3, context 1 3, AnyT) }
| expr BITAND expr    { A.BinOpExp($1, A.BITAND, $3, context 1 3, AnyT) }
| expr BITSHL expr    { A.BinOpExp($1, A.BITSHL, $3, context 1 3, AnyT) }
| expr BITSHR expr    { A.BinOpExp($1, A.BITSHR, $3, context 1 3, AnyT) }
| MINUS expr %prec NEGATE    { A.UnOpExp(A.NEGATE, $2, context 1 2, AnyT) }
| BITNEGATE expr    { A.UnOpExp(A.BITNEGATE, $2, context 1 2, AnyT) }
| LOGNEGATE expr    { A.UnOpExp(A.LOGNEGATE, $2, context 1 2, AnyT) }
| BITAND expr %prec ADDRESSOF    { A.AmpersandExp($2, context 1 2, AnyT) }
| SIZE LPAREN expr RPAREN    { A.UnOpExp(A.SIZE, $3, context 1 4, AnyT) }
| OFFSET LPAREN expr RPAREN    { A.UnOpExp(A.OFFSET, $3, context 1 4, AnyT) }
| ALLOC LPAREN expr COMMA typeval RPAREN    { A.AllocExp($3, $5, context 1 6, AnyT) }
| INTCONST    { A.IntConstExp($1, context 1 1, AnyT) }
| TRUE    { A.BoolConstExp(true, context 1 1, AnyT) }
| FALSE    { A.BoolConstExp(false, context 1 1, AnyT) }
| NULL    { A.NullConstExp(context 1 1, AnyT) }
| ID    { A.VarExp($1, context 1 1, AnyT) }
| TIMES expr %prec DEREF   { A.UnOpExp(A.DEREF, $2, context 1 2, AnyT) }
| expr LBRACKET expr RBRACKET %prec LBRACKET
    { A.UnOpExp(A.DEREF, A.BinOpExp($1, A.PTRPLUS, $3, context 1 4, AnyT), context 1 4, AnyT) }
| expr DOT ID    { A.FieldExp($1, $3, {ofs = -23}, context 1 3, AnyT) }
| expr ARROW ID    { A.FieldExp(A.UnOpExp(A.DEREF, $1, context 1 1, AnyT), $3, {ofs = -23}, context 1 3, AnyT) }

%%