3  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
 
   4  * Modified: Frank Pfenning <fp@cs.cmu.edu>
 
   5  * Modified: Joshua Wise <jwise@andrew.cmu.edu>
 
   6  * Modified: Chris Lu <czl@andrew.cmu.edu>
 
  11 structure AU = AstUtils
 
  12 structure AUP = AstUtils.Program
 
  14 (* for simplicity, we only mark expressions, not statements *)
 
  16 (* mark e with region (left, right) in source file *)
 
  17 fun mark (e, (left, right)) = A.Marked (Mark.mark' (e, ParseState.ext (left, right)))
 
  18 fun markstm (e, (left, right)) = A.MarkedStm (Mark.mark' (e, ParseState.ext (left, right)))
 
  19 fun markfunction (e, (left, right)) = A.MarkedFunction (Mark.mark' (e, ParseState.ext (left, right)))
 
  20 fun marktypedef (e, (left, right)) = T.MarkedTypedef (Mark.mark' (e, ParseState.ext (left, right)))
 
  22 (* create lval from expression; here just an id *)
 
  23 (* generates error if not an identifier *)
 
  24 fun make_lval (A.Var(id)) ext = id
 
  25   | make_lval (A.Marked(marked_exp)) ext =
 
  26       make_lval (Mark.data marked_exp) (Mark.ext marked_exp)
 
  27   | make_lval _ ext = ( ErrorMsg.error ext "not a variable" ;
 
  31 %header (functor L5LrValsFn (structure Token : TOKEN))
 
  36  | INTNUM of Word32.word
 
  37  | IDENT of Symbol.symbol
 
  39  | PLUS | MINUS | STAR | SLASH | PERCENT | LSH | RSH | LOGOR | LOGAND | BITAND | BITXOR | BITOR | BITNOT | BANG
 
  40  | ASSIGN | PLUSEQ | MINUSEQ | STAREQ | SLASHEQ | PERCENTEQ | LSHEQ | RSHEQ | BITANDEQ | BITXOREQ | BITOREQ
 
  41  | EQ | NEQ | LT | LE | GT | GE
 
  42  | IF | ELSE | WHILE | FOR | CONTINUE | BREAK
 
  45  | UNARY | ASNOP (* dummy *)
 
  46  | EXTERN | VAR | INT | QUESTION | COLON | COMMA | STRUCT | NULL | LBRACKET | RBRACKET | ARROW | DOT | NEW
 
  47  | PLUSPLUS | MINUSMINUS
 
  51  | programx of A.program
 
  57  | explist of A.exp list
 
  61  | simpoption of A.stm option
 
  62  | elseoption of A.stm list option
 
  63  | idents of A.ident list
 
  66  | extdecl of A.ident * A.function
 
  67  | paramlist of T.variable list
 
  69  | typedecl of T.ident * T.typedef
 
  70  | memberlist of (T.ident * T.vtype) list
 
  71  | member of (T.ident * T.vtype)
 
  72  | function of A.ident * A.function
 
  73  | vardecl of T.variable list
 
  74  | vardecls of T.variable list
 
  76 %verbose                                (* print summary of errors *)
 
  77 %pos int                                (* positions *)
 
  94 %left STAR SLASH PERCENT
 
  96 %left LPAREN LBRACKET ARROW DOT
 
 100 program    : programx               (programx)
 
 102 programx   : decls                  (decls)
 
 103            | programx function      (AUP.append_function programx function)
 
 106            | IDENT                  (T.Typedef IDENT)
 
 107            | vtype STAR             (T.Pointer vtype)
 
 108            | vtype LBRACKET RBRACKET
 
 111 decls      :                        (Symbol.empty, Symbol.empty)
 
 112            | typedecl decls         (AUP.append_typedef decls typedecl)
 
 113            | extdecl decls          (AUP.append_function decls extdecl)
 
 115 extdecl    : EXTERN vtype IDENT LPAREN RPAREN SEMI
 
 116                                     (IDENT, markfunction (A.Extern (vtype, []), (EXTERNleft, SEMIright)))
 
 117            | EXTERN vtype IDENT LPAREN paramlist RPAREN SEMI
 
 118                                     (IDENT, markfunction (A.Extern (vtype, paramlist), (EXTERNleft, SEMIright)))
 
 120 paramlist  : param COMMA paramlist  (param :: paramlist)
 
 123 param      : IDENT COLON vtype      (IDENT, vtype)
 
 125 typedecl   : STRUCT IDENT LBRACE RBRACE SEMI
 
 126                                     (IDENT, marktypedef (T.Struct ([]), (STRUCTleft, SEMIright)))
 
 127            | STRUCT IDENT LBRACE memberlist RBRACE SEMI
 
 128                                     (IDENT, marktypedef (T.Struct (memberlist), (STRUCTleft, SEMIright)))
 
 130 memberlist : member memberlist      (member :: memberlist)
 
 133 member     : IDENT COLON vtype SEMI (IDENT, vtype)
 
 135 function   : vtype IDENT LPAREN paramlist RPAREN LBRACE vardecls stms RBRACE
 
 136                                     (IDENT, markfunction (A.Function (vtype, paramlist, vardecls, stms), (vtypeleft, RBRACEright)))
 
 137            | vtype IDENT LPAREN RPAREN LBRACE vardecls stms RBRACE
 
 138                                     (IDENT, markfunction (A.Function (vtype, [], vardecls, stms), (vtypeleft, RBRACEright)))
 
 141            | vardecl vardecls       (vardecl @ vardecls)
 
 143 vardecl    : VAR idents COLON vtype SEMI
 
 144                                     (map (fn x => (x, vtype)) idents)
 
 146 idents     : IDENT                  ([IDENT])
 
 147            | IDENT COMMA idents     (IDENT :: idents)
 
 150            | stm stms               (stm :: stms)
 
 152 stm        : simp SEMI              (simp)
 
 156 simp       : exp ASSIGN exp %prec ASNOP
 
 157                                     (A.Assign(exp1, exp2))
 
 158            | exp asnop exp %prec ASNOP
 
 159                                     (A.AsnOp(asnop, exp1, exp2))
 
 160            | exp PLUSPLUS %prec ASNOP
 
 161                                     (A.AsnOp(A.PLUS, exp, A.ConstExp(0w1)))
 
 162            | exp MINUSMINUS %prec ASNOP
 
 163                                     (A.AsnOp(A.MINUS, exp, A.ConstExp(0w1)))
 
 164            | exp                    (markstm (A.Effect (exp), (expleft, expright)))
 
 166 control    : IF LPAREN exp RPAREN block elseoption
 
 167                                     (markstm ((A.If (exp, block, elseoption)), (IFleft, elseoptionright)))
 
 168            | WHILE LPAREN exp RPAREN block
 
 169                                     (markstm ((A.While (exp, block)), (WHILEleft, blockright)))
 
 170            | FOR LPAREN simpoption SEMI exp SEMI simpoption RPAREN block
 
 171                                     (markstm ((A.For (simpoption1, exp, simpoption2, block)), (FORleft, blockright)))
 
 172            | CONTINUE SEMI          (markstm ((A.Continue), (CONTINUEleft, SEMIright)))
 
 173            | BREAK SEMI             (markstm ((A.Break), (BREAKleft, SEMIright)))
 
 174            | RETURN exp SEMI        (markstm ((A.Return exp), (RETURNleft, SEMIright)))
 
 176 elseoption : ELSE block             (SOME block)
 
 183            | LBRACE stms RBRACE     (stms)
 
 185 exp        : LPAREN exp RPAREN      (exp)
 
 186            | INTNUM                 (mark (A.ConstExp(INTNUM),(INTNUMleft,INTNUMright)))
 
 187            | IDENT                  (mark (A.Var(IDENT), (IDENTleft,IDENTright)))
 
 188            | exp DOT IDENT          (mark (A.Member(exp, IDENT), (expleft, IDENTright)))
 
 189            | exp ARROW IDENT        (mark (A.DerefMember(exp, IDENT), (expleft, IDENTright)))
 
 190            | STAR exp %prec UNARY   (mark (A.Dereference(exp), (STARleft, expright)))
 
 191            | exp LBRACKET exp RBRACKET
 
 192                                     (mark (A.ArrIndex(exp1, exp2), (exp1left, exp2right)))
 
 193            | exp PLUS exp           (mark (A.OpExp (A.PLUS, [exp1,exp2]), (exp1left,exp2right)))
 
 194            | exp MINUS exp          (mark (A.OpExp (A.MINUS, [exp1,exp2]), (exp1left,exp2right)))
 
 195            | exp STAR exp           (mark (A.OpExp (A.TIMES, [exp1,exp2]), (exp1left,exp2right)))
 
 196            | exp SLASH exp          (mark (A.OpExp (A.DIVIDEDBY, [exp1,exp2]), (exp1left,exp2right)))
 
 197            | exp PERCENT exp        (mark (A.OpExp (A.MODULO, [exp1,exp2]), (exp1left,exp2right)))
 
 198            | exp LSH exp            (mark (A.OpExp (A.LSH, [exp1,exp2]), (exp1left,exp2right)))
 
 199            | exp RSH exp            (mark (A.OpExp (A.RSH, [exp1,exp2]), (exp1left,exp2right)))
 
 200            | exp LOGOR exp          (mark (A.OpExp (A.LOGOR, [exp1,exp2]), (exp1left,exp2right)))
 
 201            | exp LOGAND exp         (mark (A.OpExp (A.LOGAND, [exp1,exp2]), (exp1left,exp2right)))
 
 202            | exp BITOR exp          (mark (A.OpExp (A.BITOR, [exp1,exp2]), (exp1left,exp2right)))
 
 203            | exp BITAND exp         (mark (A.OpExp (A.BITAND, [exp1,exp2]), (exp1left,exp2right)))
 
 204            | exp BITXOR exp         (mark (A.OpExp (A.BITXOR, [exp1,exp2]), (exp1left,exp2right)))
 
 205            | exp EQ exp             (mark (A.OpExp (A.EQ, [exp1,exp2]), (exp1left,exp2right)))
 
 206            | exp NEQ exp            (mark (A.OpExp (A.NEQ, [exp1,exp2]), (exp1left,exp2right)))
 
 207            | exp LT exp             (mark (A.OpExp (A.LT, [exp1,exp2]), (exp1left,exp2right)))
 
 208            | exp LE exp             (mark (A.OpExp (A.LE, [exp1,exp2]), (exp1left,exp2right)))
 
 209            | exp GT exp             (mark (A.OpExp (A.GT, [exp1,exp2]), (exp1left,exp2right)))
 
 210            | exp GE exp             (mark (A.OpExp (A.GE, [exp1,exp2]), (exp1left,exp2right)))
 
 211            | NULL                   (mark (A.Null, (NULLleft, NULLright)))
 
 212            | IDENT LPAREN RPAREN    (mark (A.FuncCall(IDENT, []), (IDENTleft, RPARENright)))
 
 213            | IDENT LPAREN explist RPAREN
 
 214                                     (mark (A.FuncCall(IDENT, explist), (IDENTleft, RPARENright)))
 
 215            | NEW LPAREN vtype RPAREN
 
 216                                     (mark (A.New (vtype), (NEWleft, RPARENright)))
 
 217            | NEW LPAREN vtype LBRACKET exp RBRACKET RPAREN
 
 218                                     (mark (A.NewArr (vtype, exp), (NEWleft, RPARENright)))
 
 219            | MINUS exp %prec UNARY  (mark (A.OpExp (A.NEGATIVE, [exp]), (MINUSleft,expright)))
 
 220            | BITNOT exp %prec UNARY (mark (A.OpExp (A.BITNOT, [exp]), (BITNOTleft,expright)))
 
 221            | BANG exp %prec UNARY   (mark (A.OpExp (A.BANG, [exp]), (BANGleft,expright)))
 
 222            | exp QUESTION exp COLON exp
 
 223                                     (mark (A.Conditional (exp1, exp2, exp3), (exp1left, exp3right)))
 
 225 explist    : exp                    ([exp])
 
 226            | exp COMMA explist      (exp :: explist)
 
 228 asnop      : PLUSEQ                (A.PLUS)
 
 231            | SLASHEQ               (A.DIVIDEDBY)
 
 232            | PERCENTEQ             (A.MODULO)
 
 236            | BITANDEQ              (A.BITAND)
 
 237            | BITXOREQ              (A.BITXOR)