(* L3 Compiler
 * L3 grammar
 * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
 * Modified: Frank Pfenning <fp@cs.cmu.edu>
 * Modified: Joshua Wise <jwise@andrew.cmu.edu>
 * Modified: Chris Lu <czl@andrew.cmu.edu>
 *)

structure A = Ast

(* for simplicity, we only mark expressions, not statements *)

(* mark e with region (left, right) in source file *)
fun mark (e, (left, right)) = A.Marked (Mark.mark' (e, ParseState.ext (left, right)))
fun markstm (e, (left, right)) = A.MarkedStm (Mark.mark' (e, ParseState.ext (left, right)))

(* create lval from expression; here just an id *)
(* generates error if not an identifier *)
fun make_lval (A.Var(id)) ext = id
  | make_lval (A.Marked(marked_exp)) ext =
      make_lval (Mark.data marked_exp) (Mark.ext marked_exp)
  | make_lval _ ext = ( ErrorMsg.error ext "not a variable" ;
			Symbol.bogus )

(* expand_asnop (exp1, "op=", exp2) region = "exp1 = exp1 op exps"
 * or = "exp1 = exp2" if asnop is "="
 * generates error if exp1 is an lval (identifier)
 * syntactically expands a compound assignment operator
 *)
fun expand_asnop (exp1, NONE, exp2) (left, right) =
      A.Assign(make_lval exp1 NONE, exp2)
  | expand_asnop (exp1, SOME(oper), exp2) (left, right) =
      A.Assign(make_lval exp1 NONE,
	       mark(A.OpExp(oper, [exp1, exp2]), (left, right)))

%%
%header (functor L3LrValsFn (structure Token : TOKEN))

%term 
   EOF
 | SEMI
 | INTNUM of Word32.word
 | IDENT of Symbol.symbol
 | RETURN
 | PLUS | MINUS | STAR | SLASH | PERCENT | LSH | RSH | LOGOR | LOGAND | BITAND | BITXOR | BITOR | BITNOT | BANG
 | ASSIGN | PLUSEQ | MINUSEQ | STAREQ | SLASHEQ | PERCENTEQ | LSHEQ | RSHEQ | BITANDEQ | BITXOREQ | BITOREQ
 | EQ | NEQ | LT | LE | GT | GE
 | IF | ELSE | WHILE | FOR | CONTINUE | BREAK
 | LBRACE | RBRACE
 | LPAREN | RPAREN
 | UNARY | ASNOP (* dummy *)
 | EXTERN | VAR | INT | COLON | COMMA

%nonterm 
   program of A.program
 | stms of A.stm list
 | stm of A.stm
 | simp of A.stm
 | return of A.stm
 | exp of A.exp
 | explist of A.exp list
 | control of A.stm
 | asnop of A.oper option
 | block of A.stm list
 | simpoption of A.stm option
 | elseoption of A.stm list option
 | idents of A.ident list
 | vtype of A.vtype
 | extdecls of A.function list
 | extdecl of A.function
 | paramlist of A.variable list
 | param of A.variable
 | functions of A.function list
 | function of A.function
 | vardecl of A.variable list
 | vardecls of A.variable list

%verbose                                (* print summary of errors *)
%pos int                                (* positions *)
%start program
%eop EOF
%noshift EOF

%name L3

%left LOGOR
%left LOGAND
%left BITOR
%left BITXOR
%left BITAND
%left EQ NEQ
%left LT LE GT GE
%left LSH RSH
%left PLUS MINUS
%left STAR SLASH PERCENT
%right UNARY
%left LPAREN

%%

program    : extdecls functions     (extdecls @ functions)

vtype      : INT                    (A.Int)

extdecls   :                        ([])
           | extdecl extdecls       (extdecl :: extdecls)

extdecl    : EXTERN vtype IDENT LPAREN RPAREN SEMI
                                    (A.Extern (vtype, IDENT, []))
           | EXTERN vtype IDENT LPAREN param RPAREN SEMI
                                    (A.Extern (vtype, IDENT, [param]))
           | EXTERN vtype IDENT LPAREN paramlist RPAREN SEMI
                                    (A.Extern (vtype, IDENT, paramlist))

paramlist  : param COMMA paramlist  (param :: paramlist)
           | param                  ([param])

param      : IDENT COLON vtype      (IDENT, vtype)

functions  :                        ([])
           | function functions     (function :: functions)

function   : vtype IDENT LPAREN RPAREN LBRACE vardecls stms RBRACE
                                    (A.Function (vtype, IDENT, [], vardecls, stms))
           | vtype IDENT LPAREN paramlist RPAREN LBRACE vardecls stms RBRACE
                                    (A.Function (vtype, IDENT, paramlist, vardecls, stms))

vardecls   :                        ([])
           | vardecl vardecls       (vardecl @ vardecls)

vardecl    : VAR idents COLON vtype SEMI
                                    (map (fn x => (x, vtype)) idents)

idents     : IDENT                  ([IDENT])
           | IDENT COMMA idents     (IDENT :: idents)

stms       :                        ([])
           | stm stms               (stm :: stms)

stm        : simp SEMI              (simp)
           | control                (control)
           | SEMI                   (A.Nop)

simp       : exp asnop exp %prec ASNOP
                                    (expand_asnop (exp1, asnop, exp2) (exp1left, exp2right))

control    : IF LPAREN exp RPAREN block elseoption
                                    (markstm ((A.If (exp, block, elseoption)), (IFleft, elseoptionright)))
           | WHILE LPAREN exp RPAREN block
                                    (markstm ((A.While (exp, block)), (WHILEleft, blockright)))
           | FOR LPAREN simpoption SEMI exp SEMI simpoption RPAREN block
                                    (markstm ((A.For (simpoption1, exp, simpoption2, block)), (FORleft, blockright)))
           | CONTINUE SEMI          (markstm ((A.Continue), (CONTINUEleft, SEMIright)))
           | BREAK SEMI             (markstm ((A.Break), (BREAKleft, SEMIright)))
           | RETURN exp SEMI        (markstm ((A.Return exp), (RETURNleft, SEMIright)))

elseoption : ELSE block             (SOME block)
           |                        (NONE)

simpoption :                        (NONE)
           | simp                   (SOME simp)

block      : stm                    ([stm])
           | LBRACE stms RBRACE     (stms)

exp        : LPAREN exp RPAREN      (exp)
           | INTNUM                 (mark (A.ConstExp(INTNUM),(INTNUMleft,INTNUMright)))
           | IDENT                  (mark (A.Var(IDENT), (IDENTleft,IDENTright)))
           | exp PLUS exp           (mark (A.OpExp (A.PLUS, [exp1,exp2]), (exp1left,exp2right)))
           | exp MINUS exp          (mark (A.OpExp (A.MINUS, [exp1,exp2]), (exp1left,exp2right)))
           | exp STAR exp           (mark (A.OpExp (A.TIMES, [exp1,exp2]), (exp1left,exp2right)))
           | exp SLASH exp          (mark (A.OpExp (A.DIVIDEDBY, [exp1,exp2]), (exp1left,exp2right)))
           | exp PERCENT exp        (mark (A.OpExp (A.MODULO, [exp1,exp2]), (exp1left,exp2right)))
           | exp LSH exp            (mark (A.OpExp (A.LSH, [exp1,exp2]), (exp1left,exp2right)))
           | exp RSH exp            (mark (A.OpExp (A.RSH, [exp1,exp2]), (exp1left,exp2right)))
           | exp LOGOR exp          (mark (A.OpExp (A.LOGOR, [exp1,exp2]), (exp1left,exp2right)))
           | exp LOGAND exp         (mark (A.OpExp (A.LOGAND, [exp1,exp2]), (exp1left,exp2right)))
           | exp BITOR exp          (mark (A.OpExp (A.BITOR, [exp1,exp2]), (exp1left,exp2right)))
           | exp BITAND exp         (mark (A.OpExp (A.BITAND, [exp1,exp2]), (exp1left,exp2right)))
           | exp BITXOR exp         (mark (A.OpExp (A.BITXOR, [exp1,exp2]), (exp1left,exp2right)))
           | exp EQ exp             (mark (A.OpExp (A.EQ, [exp1,exp2]), (exp1left,exp2right)))
           | exp NEQ exp            (mark (A.OpExp (A.NEQ, [exp1,exp2]), (exp1left,exp2right)))
           | exp LT exp             (mark (A.OpExp (A.LT, [exp1,exp2]), (exp1left,exp2right)))
           | exp LE exp             (mark (A.OpExp (A.LE, [exp1,exp2]), (exp1left,exp2right)))
           | exp GT exp             (mark (A.OpExp (A.GT, [exp1,exp2]), (exp1left,exp2right)))
           | exp GE exp             (mark (A.OpExp (A.GE, [exp1,exp2]), (exp1left,exp2right)))
           | IDENT LPAREN RPAREN    (mark (A.FuncCall(IDENT, []), (IDENTleft, RPARENright)))
           | IDENT LPAREN exp RPAREN
                                    (mark (A.FuncCall(IDENT, [exp]), (IDENTleft, RPARENright)))
           | IDENT LPAREN explist RPAREN
                                    (mark (A.FuncCall(IDENT, explist), (IDENTleft, RPARENright)))
           | MINUS exp %prec UNARY  (mark (A.OpExp (A.NEGATIVE, [exp]), (MINUSleft,expright)))
           | BITNOT exp %prec UNARY (mark (A.OpExp (A.BITNOT, [exp]), (BITNOTleft,expright)))
           | BANG exp %prec UNARY   (mark (A.OpExp (A.BANG, [exp]), (BANGleft,expright)))

explist    : exp                    ([exp])
           | exp COMMA explist      (exp :: explist)

asnop      : ASSIGN                (NONE)
           | PLUSEQ                (SOME(A.PLUS))
           | MINUSEQ               (SOME(A.MINUS))
           | STAREQ                (SOME(A.TIMES))
           | SLASHEQ               (SOME(A.DIVIDEDBY))
           | PERCENTEQ             (SOME(A.MODULO))
           | LSHEQ                 (SOME(A.LSH))
           | RSHEQ                 (SOME(A.RSH))
           | BITOREQ               (SOME(A.BITOR))
           | BITANDEQ              (SOME(A.BITAND))
           | BITXOREQ              (SOME(A.BITXOR))