tiger.grm

structure A = Absyn

fun addTypeDec (A.TypeDec(oldTypes), newTypes) = A.TypeDec(oldTypes @ newTypes)
  | addTypeDec (_, newTypes) = A.TypeDec(newTypes)

fun addFuncDec (A.FunctionDec(oldFuncDecs), newFuncDecs) = A.FunctionDec(oldFuncDecs @ newFuncDecs)
  | addFuncDec (_, newFuncDecs) = A.FunctionDec(newFuncDecs)

%%
%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 | UMINUS | 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 

%nonterm  exp of A.exp
	| program of A.exp
	| lvalue of A.var
	| lvaluetail of A.var-> A.var
	| record of A.exp
	| array of A.exp
	| sequence of A.exp
	| fncallexp of A.exp
	| mathexp of A.exp
	| compexp of A.exp
	| boolexp of A.exp
	| assign of A.exp
	| control of A.exp
	| decs of A.dec list
	| dec of A.dec
	| vardec of A.dec
	| fundec of A.dec
	| tydec of A.dec
	| ty of A.ty
	| tyfields of A.field list
	| tyfieldstail of A.field list
	| args of A.exp list
	| argtail of A.exp list
	| seqexp of (A.exp * pos) list
	| seqexptail of (A.exp * pos) list
	| fields of (A.symbol * A.exp * pos) list
	| fieldtail of (A.symbol * A.exp * pos) list
	| funcreturntype of (Symbol.symbol * int) option

%pos int
%verbose
%start program
%eop EOF
%noshift EOF

%name Tiger

%keyword WHILE FOR TO BREAK LET IN END FUNCTION VAR TYPE ARRAY IF THEN ELSE 
	DO OF NIL

%prefer THEN ELSE LPAREN

(* LOW PRECEDENCE *)
%nonassoc FUNCTION TYPE VAR TYPE IF DO OF ASSIGN ARRAY WHILE FOR TO
%left OR
%left AND
%right THEN
%right ELSE

%nonassoc EQ NEQ LT LE GT GE
%left PLUS MINUS
%left TIMES DIVIDE
%left UMINUS
(* HIGH PRECEDENCE *)


%value ID ("bogus")
%value INT (1)
%value STRING ("")

%%

(* This is a skeleton grammar file, meant to illustrate what kind of
 * declarations are necessary above the %% mark.  Students are expected
 *  to replace the two dummy productions below with an actual grammar. 
 *)

program	: exp				(exp)

	
exp: lvalue (A.VarExp(lvalue))
   | NIL (A.NilExp)
   | INT (A.IntExp(INT))
   | STRING (A.StringExp(STRING, STRINGleft))
   | sequence (sequence)
   | fncallexp (fncallexp)
   | mathexp (mathexp)
   | compexp (compexp)
   | boolexp (boolexp)
   | assign (assign)
   | control (control)
   | array (array)
   | record (record)
	 

decs : dec decs (dec::decs)
		 | (*empty*) ([])
			    
dec : tydec (tydec)
    | vardec (vardec)
    | fundec (fundec)

ty : ID (A.NameTy (Symbol.symbol ID, IDleft))
   | LBRACE tyfields RBRACE (A.RecordTy(tyfields))
   | ARRAY OF ID (A.ArrayTy (Symbol.symbol ID, ARRAYleft))

tyfields: (* empty *) ([])
	| ID COLON ID tyfieldstail ({name = Symbol.symbol ID1, escape = (ref true), typ = Symbol.symbol ID2, pos = IDleft}::tyfieldstail)

tyfieldstail : (* empty*) ([])
	     | COMMA ID COLON ID tyfieldstail ({name = Symbol.symbol ID1, escape = (ref true), typ = Symbol.symbol ID2, pos = IDleft}::tyfieldstail)
			

tydec : TYPE ID EQ ty (A.TypeDec([{name = Symbol.symbol ID, ty = ty, pos = TYPEleft}]))
      | tydec TYPE ID EQ ty (addTypeDec(tydec, [{name = Symbol.symbol ID, ty = ty, pos = TYPEleft}]))

vardec: VAR ID ASSIGN exp (A.VarDec({name = Symbol.symbol ID, escape = (ref true), typ = NONE, init = exp, pos = VARleft}))
      | VAR ID COLON ID ASSIGN exp (A.VarDec({name = Symbol.symbol ID1, escape = (ref true), typ = SOME (Symbol.symbol ID2, ID2left), init = exp, pos = VARleft}))
	     
fundec : FUNCTION ID LPAREN tyfields RPAREN funcreturntype EQ exp (A.FunctionDec([{ name = Symbol.symbol ID, params = tyfields, result = funcreturntype, body = exp, pos = FUNCTIONleft}]))
       | fundec FUNCTION ID LPAREN tyfields RPAREN funcreturntype EQ exp (addFuncDec(fundec, [{ name = Symbol.symbol ID, params = tyfields, result = funcreturntype, body = exp, pos = FUNCTIONleft}]))

funcreturntype: (*empty*) (NONE)
	      | COLON ID  (SOME (Symbol.symbol ID, IDleft ))

lvalue : ID lvaluetail (lvaluetail(A.SimpleVar(Symbol.symbol ID, IDleft)))

lvaluetail : (* empty*) (fn var => var)
	   | DOT ID lvaluetail (fn var => lvaluetail(A.FieldVar(var, Symbol.symbol ID, DOTleft)))
	   | LBRACK exp RBRACK lvaluetail (fn var => lvaluetail(A.SubscriptVar(var, exp, LBRACKleft)))
		
fields : (* empty *) ([])
       | ID EQ exp fieldtail ((Symbol.symbol ID, exp, IDleft)::fieldtail)

fieldtail : (* empty *) ([])
	  | COMMA ID EQ exp fieldtail ((Symbol.symbol ID, exp, IDleft)::fieldtail)

record : ID LBRACE fields RBRACE (A.RecordExp({fields = fields, typ = Symbol.symbol ID, pos = IDleft}))

array : ID LBRACK exp RBRACK OF exp (A.ArrayExp({typ = Symbol.symbol ID, size = exp1, init = exp2, pos = IDleft}))
	   
args: (* empty *) ([])
    | exp argtail (exp::argtail)

argtail : (* empty *) ([])
	| COMMA exp argtail (exp::argtail)

seqexp: exp seqexptail ((exp, expleft)::seqexptail)

seqexptail: (* empty *) ([])
	  | SEMICOLON exp seqexptail ((exp, expleft)::seqexptail)

sequence : LPAREN seqexp RPAREN (A.SeqExp(seqexp))
		  
fncallexp : ID LPAREN args RPAREN (A.CallExp({func = Symbol.symbol ID, args = args, pos = IDleft }))

mathexp : MINUS exp %prec UMINUS (A.OpExp({left=A.IntExp(0), oper=A.MinusOp, right=exp, pos=MINUSleft}))
	| exp PLUS exp (A.OpExp({left=exp1, oper=A.PlusOp, right=exp2, pos=exp1left}))
	| exp MINUS exp (A.OpExp({left=exp1, oper=A.MinusOp, right=exp2, pos=exp1left}))
	| exp TIMES exp (A.OpExp({left=exp1, oper=A.TimesOp, right=exp2, pos=exp1left}))
	| exp DIVIDE exp (A.OpExp({left=exp1, oper=A.DivideOp, right=exp2, pos=exp1left}))

compexp : exp EQ exp (A.OpExp({left=exp1, oper=A.EqOp, right=exp2, pos=exp1left}))
	| exp NEQ exp (A.OpExp({left=exp1, oper=A.NeqOp, right=exp2, pos=exp1left}))
	| exp LT exp (A.OpExp({left=exp1, oper=A.LtOp, right=exp2, pos=exp1left}))
	| exp LE exp (A.OpExp({left=exp1, oper=A.LeOp, right=exp2, pos=exp1left}))
	| exp GT exp (A.OpExp({left=exp1, oper=A.GtOp, right=exp2, pos=exp1left}))
	| exp GE exp (A.OpExp({left=exp1, oper=A.GeOp, right=exp2, pos=exp1left}))

boolexp : exp AND exp (A.IfExp({ test = exp1, then' = exp2, else' = SOME(A.IntExp(0)), pos = exp1left})) 
	| exp OR exp (A.IfExp({ test = exp1, then' = A.IntExp(1), else' = SOME(exp2), pos = exp1left}))
	      
assign : lvalue ASSIGN exp (A.AssignExp({ var = lvalue, exp = exp, pos = ASSIGNleft }))

control : IF exp THEN exp ELSE exp (A.IfExp({ test = exp1, then' = exp2, else' = SOME exp3, pos = IFleft}))
	| IF exp THEN exp (A.IfExp({ test = exp1, then' = exp2, else' = NONE, pos = IFleft}))
	| WHILE exp DO exp (A.WhileExp({test = exp1, body = exp2, pos = WHILEleft}))
	| FOR ID ASSIGN exp TO exp DO exp (A.ForExp({var = Symbol.symbol ID, escape = (ref true), lo = exp1, hi = exp2 , body = exp3, pos = FORleft}))
	| BREAK (A.BreakExp(BREAKleft))
	| LET decs IN seqexp END (A.LetExp({decs = decs, body = A.SeqExp(seqexp), pos = LETleft }))