open Absyn; open Symbol; %% %term EOF | ID of string | INT of int | STRING of string | COMMA | COLON | SEMICOLON | LPAREN | RPAREN | LBRACK | RBRACK | LBRACE | RBRACE | DOT | PLUS | MINUS | TIMES | DIVIDE | EQ | NEQ | LT | LE | GT | GE | AND | OR | ASSIGN | ARRAY | IF | THEN | ELSE | WHILE | FOR | TO | DO | LET | IN | END | OF | BREAK | NIL | FUNCTION | VAR | TYPE | UMINUS | RIGHT_DUMMY %nonassoc ASSIGN %left AND OR %left GT LT GE LE %nonassoc EQ NEQ %left PLUS MINUS %left TIMES DIVIDE %left UMINUS %right RIGHT_DUMMY %right ELSE (*if we encounter an else, we must shift!*) %nonterm EXP of exp | PROGRAM of exp | DEC of dec | DECS of dec list | EXP_COMMA_SEQ of exp list | EXP_SC_SEQ of (exp * pos) list | EXP_ID_COMMA_SEQ of (symbol * exp * pos) list | LVALUE of var | QUALIFIEDLVALUE of var | TY of ty | TY_FIELD_SEQ of field list | DEFUN of fundec | FUNCTIONLIST of fundec list %pos int %verbose %eop EOF %noshift EOF %name Tiger %verbose %keyword WHILE FOR TO BREAK LET IN END FUNCTION VAR TYPE ARRAY IF THEN ELSE DO OF NIL %prefer THEN ELSE LPAREN %value ID ("bogus") %value INT (1) %value STRING ("") %% PROGRAM : EXP (EXP) EXP_ID_COMMA_SEQ : ID EQ EXP ([(symbol ID, EXP, IDleft)]) | EXP_ID_COMMA_SEQ COMMA ID EQ EXP (EXP_ID_COMMA_SEQ @ [(symbol ID, EXP, EXP_ID_COMMA_SEQleft)]) EXP_COMMA_SEQ : EXP ([EXP]) | EXP_COMMA_SEQ COMMA EXP (EXP_COMMA_SEQ @ [EXP]) EXP_SC_SEQ : EXP ([(EXP,EXPleft)]) | EXP_SC_SEQ SEMICOLON EXP (EXP_SC_SEQ @ [(EXP,EXPleft)]) EXP : ID (VarExp(SimpleVar(symbol ID1, ID1left))) | LVALUE (VarExp LVALUE) (* | DEC (DEC) *) (* nil *) | NIL (NilExp) (* sequencing *) (* parentheses *) | LPAREN EXP_SC_SEQ RPAREN (SeqExp (EXP_SC_SEQ1)) (* double checked *) (* no value *) | LPAREN RPAREN (SeqExp([])) | LET DECS IN LPAREN RPAREN END (LetExp {decs=DECS, body=(SeqExp []), pos=LET1left}) (* integer literal *) | INT (IntExp (INT)) (* string literal *) | STRING (StringExp (STRING, STRING1left)) (* negation *) | MINUS EXP %prec UMINUS (OpExp{left=IntExp 0, oper=MinusOp, right=EXP1, pos=MINUS1left}) (* function call *) | ID LPAREN RPAREN (CallExp{func=symbol(ID1), args=[], pos=ID1left}) | ID LPAREN EXP_COMMA_SEQ RPAREN (CallExp{func=symbol(ID1), args=EXP_COMMA_SEQ1, pos=ID1left}) (* record creation *) (* double checked *) | ID LBRACE EXP_ID_COMMA_SEQ RBRACE ( RecordExp{fields=EXP_ID_COMMA_SEQ1, typ=symbol(ID1), pos=ID1left} ) | ID LBRACE RBRACE ( RecordExp {fields=[], typ=symbol (ID1), pos=ID1left }) (* array creation *) | ID LBRACK EXP RBRACK OF EXP %prec RIGHT_DUMMY ( ArrayExp{typ=symbol(ID1), size=EXP1, init=EXP2, pos=ID1left} ) (* array and record assignment *) (* assignment *) | ID ASSIGN EXP (AssignExp{var=SimpleVar(symbol ID1, ID1left), exp=EXP1, pos=ID1left}) | LVALUE ASSIGN EXP (AssignExp{var=LVALUE1, exp=EXP1, pos=LVALUE1left}) (* extent - backend issue *) (* valueless expressions - backend issue *) (* include if & while statements *) (* if then else *) | IF EXP THEN EXP ELSE EXP %prec ELSE (IfExp{test=EXP1, then'=EXP2, else'=SOME EXP3, pos=EXP1left}) (* if then *) | IF EXP THEN EXP %prec RIGHT_DUMMY (IfExp{test=EXP1, then'=EXP2, else'=NONE, pos=EXP1left}) (* while *) | WHILE EXP DO EXP %prec DO (WhileExp{test=EXP1, body=EXP2, pos=EXP1left}) (* for *) | FOR ID ASSIGN EXP TO EXP DO EXP %prec RIGHT_DUMMY (ForExp{var=symbol ID1, escape=ref false, lo=EXP1, hi=EXP2, body=EXP3, pos=FOR1left}) (* break *) | BREAK (BreakExp (BREAK1left)) (* let *) (* this function is not very efficient *) | LET DECS IN EXP_SC_SEQ END (let fun foldDecs [] = [] | foldDecs (FunctionDec(x)::FunctionDec(y)::tail) = foldDecs (FunctionDec(x @ y)::foldDecs tail) | foldDecs (TypeDec(x)::TypeDec(y)::tail) = foldDecs(TypeDec(x @ y)::tail) | foldDecs (head::tail) = head::foldDecs(tail) in LetExp{decs=foldDecs DECS1, body=(SeqExp EXP_SC_SEQ1), pos=DECS1left} end) (* ambiguous *) (* and & or *) (* boolean operators *) | EXP AND EXP (IfExp{test=EXP1, then'=EXP2, else'=SOME (IntExp 0), pos=EXP1left}) | EXP OR EXP (IfExp{test=EXP1, then'=IntExp 1, else'=SOME EXP2, pos=EXP1left}) (* arithmetic *) | EXP PLUS EXP (OpExp{left=EXP1,oper=PlusOp,right=EXP2,pos=EXP1left}) | EXP MINUS EXP (OpExp{left=EXP1,oper=MinusOp,right=EXP2,pos=EXP1left}) | EXP TIMES EXP (OpExp{left=EXP1,oper=TimesOp,right=EXP2,pos=EXP1left}) | EXP DIVIDE EXP (OpExp{left=EXP1,oper=DivideOp,right=EXP2,pos=EXP1left}) (* comparison *) (* string comparison *) | EXP EQ EXP (OpExp{left=EXP1,oper=EqOp,right=EXP2,pos=EXP1left}) | EXP NEQ EXP (OpExp{left=EXP1,oper=NeqOp,right=EXP2,pos=EXP1left}) | EXP GT EXP (OpExp{left=EXP1,oper=GtOp,right=EXP2,pos=EXP1left}) | EXP LT EXP (OpExp{left=EXP1,oper=LtOp,right=EXP2,pos=EXP1left}) | EXP GE EXP (OpExp{left=EXP1,oper=GeOp,right=EXP2,pos=EXP1left}) | EXP LE EXP (OpExp{left=EXP1,oper=LeOp,right=EXP2,pos=EXP1left}) (* fix for operators *) (* | EXP PLUS MULTEXP() | EXP MINUS MULTEXP () | MULTEXP () MULTEXP : MULTEXP TIMES PRIMARY ( OpExp{left=MULTEXP, oper= ) | MULTEXP DIVIDE PRIMARY () | EXP () *) LVALUE : QUALIFIEDLVALUE (QUALIFIEDLVALUE1) | LVALUE DOT ID (FieldVar(LVALUE1, symbol ID1, LVALUE1left)) | LVALUE LBRACK EXP RBRACK (SubscriptVar(LVALUE1, EXP1, LVALUE1left)) QUALIFIEDLVALUE : ID DOT ID (FieldVar(SimpleVar (symbol ID1, ID1left), symbol ID2, ID2left)) | ID LBRACK EXP RBRACK (SubscriptVar(SimpleVar (symbol ID1, ID1left), EXP1, EXP1left)) DEC : TYPE ID EQ TY (TypeDec [{name=symbol ID1, ty=TY1, pos=TYPE1left}]) | VAR ID ASSIGN EXP (VarDec {name=symbol(ID1), escape=ref false, typ=NONE, init=EXP1, pos=VAR1left}) | VAR ID COLON ID ASSIGN EXP (VarDec {name=symbol(ID1), escape=ref false, typ=SOME (symbol(ID2),ID2left), init=EXP1, pos=VAR1left}) | FUNCTIONLIST (FunctionDec FUNCTIONLIST) DEFUN : FUNCTION ID LPAREN TY_FIELD_SEQ RPAREN EQ EXP ({name=symbol(ID1), params=TY_FIELD_SEQ1, result=NONE, body=EXP1, pos=FUNCTION1left, leaf = ref true} : Absyn.fundec) | FUNCTION ID LPAREN TY_FIELD_SEQ RPAREN COLON ID EQ EXP ({name=symbol(ID1), params=TY_FIELD_SEQ1, result=SOME (symbol ID2, ID2left), body=EXP1, pos=FUNCTION1left, leaf = ref true} : Absyn.fundec) (* we somehow left these out before, there's probably a better way to do this, but I don't want to mess up TY_FIELD_SEQ *) | FUNCTION ID LPAREN RPAREN EQ EXP ({name=symbol(ID1), params=[], result=NONE, body=EXP1, pos=FUNCTION1left, leaf = ref true} : Absyn.fundec) | FUNCTION ID LPAREN RPAREN COLON ID EQ EXP ({name=symbol(ID1), params=[], result=SOME (symbol ID2, ID2left), body=EXP1, pos=FUNCTION1left, leaf = ref true}: Absyn.fundec) FUNCTIONLIST : DEFUN ([DEFUN]) | FUNCTIONLIST DEFUN (FUNCTIONLIST @ [DEFUN]) DECS : ( [] ) | DECS DEC ( DECS @ [DEC] ) (* Type ID *) (* 1+1/2 checked *) TY : ID (NameTy (symbol ID, IDleft)) (* records *) | LBRACE RBRACE (RecordTy []) (* takes care of epsilon in the TY_FIELD_SEQ rule *) | LBRACE TY_FIELD_SEQ RBRACE (RecordTy TY_FIELD_SEQ) (* array *) | ARRAY OF ID (ArrayTy (symbol ID, ARRAYleft)) TY_FIELD_SEQ : ID COLON ID ([{name=symbol ID1, escape=ref false, typ=symbol ID2, pos=ID1left}:field]) | TY_FIELD_SEQ COMMA ID COLON ID ( TY_FIELD_SEQ @ [{name=symbol ID1, escape=ref false, typ=symbol ID2, pos=ID1left}:field] )