-- TYPE CHECKING BY NAME COMPATIBILTY
--
-- CS471 Fall 2002
-- A parser and interpreter for a simple language with declarations
--
-- The grammar
--
-- Prog ::= {Decl;}*Stmt{;Stmt}*
-- Stmt ::= Assign|Cond|Loop
-- Assign ::= Id.Id=Exp|Id=Exp
-- Cond ::= if Bool then Prog1 else Prog2 end
-- Loop ::= while Bool do Prog end
-- B ::= Equal|Gt|Lt|And|Or|Not
-- Equal ::= Id==Exp
-- Gt ::= Id>Exp
-- Lt ::= Id<Exp
-- And ::= Bool1 and Bool2
-- Or ::= Bool1 or Bool2
-- Not ::= not Bool
-- Exp ::= Simple|Add|Sub
-- Simple ::= Id.Id|Id|Num
-- Add ::= Simple + Exp
-- Sub ::= Simple - Exp
-- Decl ::= TypeDecl|VarDecl
-- TypeDecl ::= Id=Type
-- VarDecl ::= Id:Id;
-- Type ::= integer|real|Record
-- Record ::= record VarDecl{;VarDecl}* end
--
-- Sample program:
-- t1=RECORD x:INTEGER; y:REAL END;
-- p:t1;
-- n:INTEGER;
-- n = 3;
-- IF n < 0 THEN p.x = n ELSE p.y = n + 1 END
--
--
-- The parser
--
#Go
--	#DEBUG(RULES);
	$Params := #PARM(T);
	$Lex := #CALL_PAS(35 $Params[1]);
	$Tree := #Prog($Lex);
	PRINT 'Syntax tree:';
	PRINT $Tree;
	#Interpret($Tree)
##
#Prog
	(. (* $Decls !.:= #Decl ';' *) $Stmts := #Stmts .)
	/RETURN PROG::<.DECLS:$Decls,STMTS:$Stmts.>/
##
#Stmts
	(+ $Stmts !.:= #Stmt + ';') / RETURN $Stmts /
##
#Stmt
	$Stmt := (#Assign ! #Cond ! #Loop) / RETURN $Stmt /
##
#Assign
	$Id1 '.' $Id2 '=' $Exp := #Exp
	/ RETURN ASSIGN::<.REC:$Id1,FIELD:$Id2,EXP:$Exp.> / ;;
	$Id '=' $Exp := #Exp / RETURN ASSIGN::<.ID:$Id,EXP:$Exp.>/
##
#Cond
	'IF' $Test := #Bool 'THEN' $Then := #Stmts 'ELSE' $Else := #Stmts 'END'
	 / RETURN COND::<.TEST:$Test,THEN:$Then,ELSE:$Else.> /
##
#Loop
	'WHILE' $Test := #Bool 'DO' $Body := #Stmts 'END' 
	/ RETURN WHILE::<.TEST:$Test,BODY:$Body.> /
##
#Bool
	$Bool := (#Equal ! #Gt ! #Lt ! #And ! #Or ! #Not) / RETURN $Bool /
##
#Equal
	$Id '==' $Exp := #Exp / RETURN EQUAL::<.ID:$Id,EXP:$Exp.> /
##
#Gt
	$Id '>' $Exp := #Exp / RETURN GT::<.ID:$Id,EXP:$Exp.> /
##
#Lt
	$Id '<' $Exp := #Exp / RETURN LT::<.ID:$Id,EXP:$Exp.> /
##
#And
	$B1 := #Bool 'and' $B2 := #Bool / RETURN LAND::<.B1:$B1,B2:$B2.> /
##
#Or
	$B1 := #Bool 'or' $B2 := #Bool / RETURN LOR::<.B1:$B1,B2:$B2.> /
##
#Not
	'not' $B := #Bool / RETURN LNOT::<.B:$B.> /
##
#Exp
	$Exp := (#Add ! #Sub ! #Simple) / RETURN $Exp/
##
#Simple
	$Id1 '.' $Id2 / RETURN RECACC::<.REC:$Id1,FIELD:$Id2.> / ;;
	$Id / RETURN $Id / ;;
	$Num / RETURN $Num /
##
#Add
	$E1 := #Simple '+' $E2 := #Exp / RETURN ADD::<.E1:$E1,E2:$E2.> /
##
#Sub
	$E1 := #Simple '-' $E2 := #Exp / RETURN SUB::<.E1:$E1,E2:$E2.> /
##
#Decl
	$D := (#VarDecl ! #TypeDecl) / RETURN $D /
##
#VarDecl
	$Id ':' $TypeId / RETURN VARDECL::<.ID:$Id,TYPEID:$TypeId.> /
##
#TypeDecl
	$Id '=' $Type := #Type / RETURN TYPEDECL::<.ID:$Id,TYPE:$Type.> /
##
#Type
	$Type := ('INTEGER' ! 'REAL' ! #Record)
	/ RETURN $Type /
##
#Record
	'RECORD' (+ $Fields !.:= #Decl + ';') 'END'
	/ RETURN RECORD::$Fields /
##
-- The interpreter
-- Variables are declared and checked for existence, and
-- types are checked for name compatibility
--
-- The model of variable storage is a subtree of the program on the
-- VARS branch that contains both type name bindings and variable
-- value bindings. For example, the tree for the above program is
--  <.REC:
--    'RECORD'::
--    (.'VARDECL'::<.ID:'X',TYPEID:'INTEGER'.>
--      'VARDECL'::<.ID:'Y',TYPEID:'REAL'.> 
--    .)
--    ,
--    X:           0,
--    P:<.X:           0,Y:           0.>
--  .>
-- This tree is passed to the interpreter as part of the program itself
--
#Interpret
--      /#DEBUG(RULES)/
	$Program
	/ $Program ++:= <.VARS:#MakeStore($Program.DECLS).>;
	  #IntProg($Program);
  	  PRINT 'Store:';
        PRINT $Program.VARS /
##
#MakeStore
	/IF $$=NULL -> PRINT 'No declarations' FI /
	(. (* $Y ++:= #IdNode *) .) / RETURN $Y /
##
#IdNode
--	/#DEBUG(RULES)/
	VARDECL::<. ID:$Id,TYPEID:$Type .> 
	/ IF #BasicType($Type) -> RETURN <.$Id:0.> 
	  ELSIF #RecordType($Type) -> RETURN <.$Id:#RecordVars($Type).> 
	  ELSIF T -> PRINT 'Unknown type' 
	  FI / ;;
	TYPEDECL::<. ID:$Id,TYPE:$Type .> / RETURN <.$Id:$Type.>/
##
#BasicType
	('INTEGER' ! 'REAL') / RETURN T / ;;
	/ $S := LAST #MakeStore $Y /
	$T / RETURN #BT($T $S) /
##
#BT
	$T1 <* $T2:(INTEGER ! REAL) / IF $T1 = $T2 -> RETURN $T2 FI / *>
##
#RecordType
	/ $S := LAST #MakeStore $Y /
	$T / RETURN #RT($T $S) /
##
#RT
	$T1 <* $T2:$D / IF $T1 = $T2 -> RETURN $T2 FI / *>
##
#RecordVars
	/ $S := LAST #MakeStore $Y /
	$T / RETURN #RecordVar2($T $S) /	
##
#RecordVar2
	$T1 <* $T2:$D / IF $T1 = $T2 -> RETURN #RecordVarIds($D) FI / *> 
##
#RecordVarIds
	(. (* $VarDecl / $Ids ++:= <.$VarDecl.ID:0.> / *) .) / RETURN $Ids /
##
#IntProg
	<.STMTS: #IntStmts.>
##
#IntStmts
	(. (* #IntStmt *) .)
##
#IntStmt
	( #IntAssign ! #IntCond ! #IntLoop )
##
#IntAssign
--	/#DEBUG(RULES);/
	ASSIGN::<.ID:$Id,EXP:$Result := #IntExp.>
	/$Prog := LAST #Interpret $Program;
	 IF $Prog.VARS.$Id = NULL ->
	   PRINT 'Variable not declared';PRINT $Id;RETURN NULL
	 ELSIF $Result -> 
		 $LHType := #FindVarType($Id $Prog.DECLS);
-- find type of LH identifier and compare with type of expression
-- returned from #IntExp
		 IF $LHType = $Result.TYPE ->
		   $Prog.VARS.$Id := $Result.VAL
		 ELSIF T -> PRINT 'Type mismatch (Name)';
			    PRINT $Id;PRINT $LHType;PRINT $Result.TYPE
		 FI
	 ELSIF T -> PRINT 'Type error in expression';RETURN NULL
     	 FI / ;;
	ASSIGN::<.REC:$Rec,FIELD:$Id,EXP:$Result := #IntExp.>
	/$Prog := LAST #Interpret $Program;
	 $R := $Prog.VARS.$Rec;
	 IF $R = NULL ->
	   PRINT 'Variable not declared';PRINT $Rec;RETURN NULL
	 ELSIF $R.$Id = NULL ->
	   PRINT 'Field name unknown in';PRINT $Rec;RETURN NULL
	 ELSIF $Result ->
	         $LHType := #FindFieldType($Rec $Id $Prog.DECLS);
-- find type of LH field identifier and compare with type of expression
-- returned from #IntExp
		 IF $LHType = $Result.TYPE ->
		   $R.$Id := $Result.VAL
		 ELSIF T -> PRINT 'Type mismatch (Name)';
			    PRINT $Rec;PRINT $Id;PRINT $LHType;
			    PRINT $Result.TYPE
		 FI
	 ELSIF T -> PRINT 'Type error in expression';RETURN NULL
	 FI /
##
#IntCond
--	/#DEBUG(RULES)/
	COND::<.TEST:$B := #IntBool,THEN:$Then,ELSE:$Else.>
	/ IF $B -> #IntStmts($Then)
	  ELSIF T -> #IntStmts($Else)
	  FI /
##
#IntLoop
	WHILE::<.TEST:$B := #IntBool,BODY:$Body.>
	/ IF $B -> #IntStmts($Body);#IntLoop($)
	  FI /
##
#IntBool
	EQUAL::<.ID:$Id,EXP:$Val := #IntExp.>
	/ IF LAST #Interpret $Store.$Id = $Val -> RETURN T FI / ;;
	GT::<.ID:$Id,EXP:$Val := #IntExp.>
	/ IF LAST #Interpret $Program.VARS.$Id > $Val -> 
		PRINT LAST #Interpret $Program.VARS.$Id;RETURN T FI / ;;
	LT::<.ID:$Id,EXP:$Val := #IntExp.>
	/ IF LAST #Interpret $Program.VARS.$Id < $Val -> RETURN T FI / ;;
	LAND::<.B1:$B1 := #IntBool,B2:$B2 := #IntBool.>
	/ RETURN $B1 AND B2 /
	LOR::<.B1:$B1 := #IntBool,B2:$B2 := #IntBool.>
	/ RETURN $B1 OR B2 /
	LNOT::<.B:$B1 := #IntBool.>
	/ RETURN NOT $B /
##
#IntExp
--	/#DEBUG(RULES);/
	ADD::<.E1:$E1 := #IntExp,E2:$E2 := #IntExp .> 
	/ IF $E1 AND $E2 AND $E1.TYPE = 'INTEGER' AND $E2.TYPE = 'INTEGER' ->
-- return type (must be integer) with the value
		RETURN <.TYPE:INTEGER, VAL: $E1.VAL + $E2.VAL.>
	  ELSIF T -> PRINT 'Invalid subexpression in addition'; RETURN NULL
	  FI  /;;
	SUB::<.E1:$E1 := #IntExp,E2:$E2 := #IntExp .>
	/ IF $E1 AND $E2 AND $E1.TYPE = 'INTEGER' AND $E2.TYPE = 'INTEGER' ->
-- return type (must be integer) with the value
		 RETURN <.TYPE:INTEGER, VAL: $E1.VAL - $E2.VAL.>
	  ELSIF T -> PRINT 'Invalid subexpression in subtraction'; RETURN NULL
	  FI  /;;
	RECACC::<.REC:$Rec,FIELD:$Id.> 
	/ $Prog := LAST #Interpret $Program;
	  $Temp := $Prog.VARS.$Rec;
	  PRINT $Prog.VARS.$Rec;
	  IF $Temp = NULL -> PRINT 'Variable not declared';PRINT $Rec;
	                     RETURN NULL
	  ELSIF $Temp.$Id = NULL -> PRINT 'Field name unknown';
				    PRINT $Id; RETURN NULL 
	  ELSIF T -> $Type := #FindFieldType($Rec $Id $Prog.DECLS);
-- return type of field identifer with the value
	             RETURN <.TYPE:$Type,VAL:$Temp.$Id.>
	  FI / ;;
	$Id / $Prog := LAST #Interpret $Program;
	      $Temp := $Prog.VARS.$Id;
	      IF $Temp = NULL -> PRINT 'Variable not declared';
				 PRINT $Id;RETURN NULL
	      ELSIF T -> $Type := #FindVarType($Id $Prog.DECLS);
-- return type of identifer with the value
			 RETURN <.TYPE:$Type,VAL:$Temp.>
	      FI / ;;
	$N / 
-- return type of constant (integer) with the value
	      RETURN <.TYPE:INTEGER,VAL:$N.> /
##
#FindVarType
-- find the type of the identifer in the declaration list
-- the list entry has the form VARDECL::<.ID:X,TYPEID:INTEGER.> for a variable
-- x of type integer
	$Id (. (* $Decl / IF $Id = $Decl.ID -> RETURN $Decl.TYPEID FI/ *) .)
	
##
#FindFieldType
	$Rec $Field $Decls
-- find the type of the (record) identifer in the declaration list
-- and then the type of the field identifer in its declaration
	/ $RecType := #FindVarType($Rec $Decls);
	  $RecDecl := #FindRecDecl($RecType $Decls);
	  RETURN #FindVarType($Field $RecDecl)
	/
##
#FindRecDecl
-- find the record declaration in the declaration list
-- the list entry has the form 
-- TYPEDECL::<.ID:REC,TYPE: .. rec declaration .. .>
	$Rec (. (* TYPEDECL::<.ID:$RecId,TYPE:$T.> 
		  / IF $Rec = $RecId -> RETURN $T FI / *) .)
##