(* L4 Compiler * L4 grammar * Author: Kaustuv Chaudhuri * Modified: Frank Pfenning * Modified: Joshua Wise * Modified: Chris Lu *) structure A = Ast structure AU = AstUtils structure AUP = AstUtils.Program (* 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))) fun markfunction (e, (left, right)) = A.MarkedFunction (Mark.mark' (e, ParseState.ext (left, right))) fun marktypedef (e, (left, right)) = A.MarkedTypedef (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 ) %% %header (functor L4LrValsFn (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 | STRUCT | NULL | LBRACKET | RBRACKET | ARROW | DOT | NEW %nonterm program of A.program | programx 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 | 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 | decls of A.program | extdecl of A.ident * A.function | paramlist of A.variable list | param of A.variable | typedecl of A.ident * A.typedef | memberlist of (A.ident * A.vtype) list | member of (A.ident * A.vtype) | function of A.ident * 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 L4 %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 LBRACKET ARROW DOT %% program : programx (programx) programx : decls (decls) | programx function (AUP.append_function programx function) vtype : INT (A.Int) | IDENT (A.Typedef IDENT) | vtype STAR (A.Pointer vtype) | vtype LBRACKET RBRACKET (A.Array vtype) decls : (Symbol.empty, Symbol.empty) | typedecl decls (AUP.append_typedef decls typedecl) | extdecl decls (AUP.append_function decls extdecl) extdecl : EXTERN vtype IDENT LPAREN RPAREN SEMI (IDENT, markfunction (A.Extern (vtype, []), (EXTERNleft, SEMIright))) | EXTERN vtype IDENT LPAREN paramlist RPAREN SEMI (IDENT, markfunction (A.Extern (vtype, paramlist), (EXTERNleft, SEMIright))) paramlist : param COMMA paramlist (param :: paramlist) | param ([param]) param : IDENT COLON vtype (IDENT, vtype) typedecl : STRUCT IDENT LBRACE RBRACE SEMI (IDENT, marktypedef (A.Struct ([]), (STRUCTleft, SEMIright))) | STRUCT IDENT LBRACE memberlist RBRACE SEMI (IDENT, marktypedef (A.Struct (memberlist), (STRUCTleft, SEMIright))) memberlist : member memberlist (member :: memberlist) | member ([member]) member : IDENT COLON vtype SEMI (IDENT, vtype) function : vtype IDENT LPAREN paramlist RPAREN LBRACE vardecls stms RBRACE (IDENT, markfunction (A.Function (vtype, paramlist, vardecls, stms), (vtypeleft, RBRACEright))) | vtype IDENT LPAREN RPAREN LBRACE vardecls stms RBRACE (IDENT, markfunction (A.Function (vtype, [], vardecls, stms), (vtypeleft, RBRACEright))) 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 ASSIGN exp %prec ASNOP (A.Assign(exp1, exp2)) | exp asnop exp %prec ASNOP (A.AsnOp(asnop, exp1, exp2)) | exp (markstm (A.Effect (exp), (expleft, expright))) 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 DOT IDENT (mark (A.Member(exp, IDENT), (expleft, IDENTright))) | exp ARROW IDENT (mark (A.DerefMember(exp, IDENT), (expleft, IDENTright))) | STAR exp %prec UNARY (mark (A.Dereference(exp), (STARleft, expright))) | exp LBRACKET exp RBRACKET (mark (A.ArrIndex(exp1, exp2), (exp1left, exp2right))) | 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))) | NULL (mark (A.Null, (NULLleft, NULLright))) | IDENT LPAREN RPAREN (mark (A.FuncCall(IDENT, []), (IDENTleft, RPARENright))) | IDENT LPAREN explist RPAREN (mark (A.FuncCall(IDENT, explist), (IDENTleft, RPARENright))) | NEW LPAREN vtype RPAREN (mark (A.New (vtype), (NEWleft, RPARENright))) | NEW LPAREN vtype LBRACKET exp RBRACKET RPAREN (mark (A.NewArr (vtype, exp), (NEWleft, 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 : PLUSEQ (A.PLUS) | MINUSEQ (A.MINUS) | STAREQ (A.TIMES) | SLASHEQ (A.DIVIDEDBY) | PERCENTEQ (A.MODULO) | LSHEQ (A.LSH) | RSHEQ (A.RSH) | BITOREQ (A.BITOR) | BITANDEQ (A.BITAND) | BITXOREQ (A.BITXOR)