+++ /dev/null
-(* L4 Compiler
- * L4 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
-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)
git.joshuawise.com / snipe.git / blobdiff