/*
 * This is a Yacc-style attribute grammar for type checking the language of
 * Translator 3.  The following attributes are used:
 *
 *      NAME    DESCRIPTION
 *      ===================================================================
 *      symtab  A global tuple-valued attribute representing an abstract
 *              symbol table.  A symtab is a 2-tuple of the form:
 *                  (parenttab, entries)
 *              where parenttab is a symbolic reference to the parent symbol
 *              table, and entries is a list of 3-tuples of the form:
 *                  [ (name, class, type), ... ].
 *              For symbols with class = "proc", a symtab entry is a quintuple
 *              of the form:
 *                  (name, "proc", type, parmtypes, symtab)
 *
 *      type    A string-valued attribute representing the names of types.
 *              Successful type checking is represented by the value of
 *              program.type = "OK".  Note that a string-valued type attribute
 *              is used for this simple language since there are no structured
 *              types.  For a language like Modula-2, the type attribute would
 *              be tuple-valued, in order to represented structured types
 *              effectively.
 *
 *      class   A string-valued attribute representing the names of symbol
 *              classes, specifically "var", "parm", or "proc".
 *
 *      text    A string-valued attribute representing the lexical text of
 *              declared identifiers.
 *
 *      types   A sequence-valued attribute that holds a list of types for
 *              formal and actual procedure parameters.
 *
 *
 * There are three auxiliary functions used to enter and lookup symbols:
 *
 *      Enter(symtab, symbol, class, type) =
 *              let symtab#2 = symtab#2 U (symbol, class, type)
 *
 *      Enter(symtab, symbol, class, type, parmtypes, symtab) =
 *              let symtab#2 = symtab#2 U
 *                  (symbol, class, type, parmtyeps, symtab)
 *
 *      Lookup(symtab, symbol) = the first element S of symtab#2
 *                                      such that S#1 = symbol,
 *                               "ERROR" if no such element
 *
 *
 * There are three auxiliary functions used to enter and exit procedure scopes
 * while symtab values are being computed:
 *
 *      EnterProc(symtab, name) =
 *              let newsymtab = (symtab, [])
 *              Enter(symtab, name, "proc", "", [], newsymtab)
 *              let symtab = newsymtab
 *
 *      EnterParms(symtab, name, type, parmtypes) =
 *              let Lookup(symtab, name)#3 = type
 *              let Lookup(symtab, name)#4 = parmtypes
 *
 *      ExitProc(symtab) =
 *              let symtab = symtab#1
 * 
 */

/**
 * Terminal symbols
 */
%token YPROGRAM
%token YBEGIN
%token YEND
%token YVAR
%token Yidentifier
%token YPROCEDURE
%token YASSMNT
%token YIF
%token YTHEN
%token YELSE
%token YOR
%token YAND
%token YLEOP
%token YGEOP
%token YNEOP
%token Yreal
%token Yinteger
%token Ychar
%token Ybool

/**
 * Operator precedence
 */
%right YASSMNT                                  /* := */
%left '=' '#' '<' '>' YLEOP YGEOP YNEOP         /* relational ops */
%left '+' '-' YOR                               /* add ops */
%left '*' '/' YAND                              /* mult ops */


%%
program         : YPROGRAM decls YBEGIN stmts YEND
                        {symtab = ( (), [("integer", "type", "integer"),...] );
                         $$.type =
                             if ($2.type = "OK") and ($4.type = "OK")
                             then "OK" else "ERROR";}
                ;

decls           : /* empty */
                        {$$.type = "OK";}
                | decl ';' decls
                        {$$.type =
                             if ($1.type = "OK") and ($3.type = "OK")
                             then "OK" else "ERROR";}
                ;

decl            : vardecl
                        {$$.type = $1.type;}
                | procdecl
                        {$$.type = $1.type;}
                ;       

vardecl         : YVAR vars ':' type
                        {$$.type =
                             if ($4.type != "ERROR")
                             then "OK" else "ERROR";
                         $2.type = $4.type; /* notice inherited attribute */
                         $2.class = "var";}
                ;

type            : Yidentifier
                        {$$.type = Lookup(symtab, $1.text)#3;}
                ;

vars            : var
                        {Enter(symtab, $1.text, $$.class, $$.type);}
                | var ',' vars
                        {$3.type = $$.type;
                         $3.class = $$.class;
                         Enter(symtab, $1.text, $$.class, $$.type);}
                ;

var             : Yidentifier
                        {$$.text = $1.text;}
                           /* The lexer provides Yidentifier as a string */
                ;

procdecl        : YPROCEDURE prochdr ';' procbody
                        {$$.type =
                             if ($2.type = "OK") and ($4.type = "OK")
                             then "OK" else "ERROR";
                         ExitProc(symtab);}
                ;

prochdr         : Yidentifier '(' formals ')'
                        {EnterProc(symtab, $1.text);
                         EnterParms(symtab, $2.text, "", $3.types);
                         $$.type =
                             if (foreach (t in $3.types) t != "ERROR")
                             then "OK" else "ERROR";}
                | Yidentifier '(' formals ')' ':' type
                        {EnterProc(symtab, $1.text);
                         EnterParms(symtab, $2.text, $6.type, $3.types);
                         $$.type =
                             if (foreach (t in $3.types) t != "ERROR") and
                                ($6.type != "ERROR")
                             then "OK" else "ERROR";}
                ;

formals         : /* empty */
                        {$$.types = null;}
                | formal
                        {$$.types = $1.type;}
                | formal ',' formals
                        {$$.types = $1.type U $3.types;}
                ;

formal          : Yidentifier ':' type
                        {Enter(symtab, $1.text, "parm", $3.type);
                         $$.text = $1.text;
                         $$.type = $3;}
                ;

procbody        : decls YBEGIN stmts YEND
                        {$$.type =
                             if ($1.type = "OK)" and ($3.type = "OK")
                             then "OK" else "ERROR";}
                ;

stmts           : stmt ';'
                        {$$.type = $1.type;}
                | stmt ';' stmts
                        {$$.type =
                             if ($1.type = "OK") and ($3.type = "OK")
                             then "OK" else "ERROR";}
                ;

stmt            : /* empty */
                | Yidentifier YASSMNT expr
                        {$$.type =
                             if Lookup(symtab, $1.text)#3 = $3.type
                             then "OK" else "ERROR";
                        }
                | Yidentifier '(' actuals ')'
                        {let ftypes = Lookup(symtab, $1.text)#4;
                         let proctype = Lookup(symtab, $1.text)#3;
                         $$.type = 
                             if (foreach (fp in ftypes, ap in $3.types)
                                 (fp = ap)) and (proctype = null)
                             then "OK" else"ERROR";
                        }
                | YIF expr YTHEN stmts YEND
                        {$$.type =
                             if ($2.type = "boolean") and
                                ($4.type = "OK")
                             then "OK" else "ERROR";
                        }
                | YIF expr YTHEN stmts YELSE stmts YEND
                        {$$.type =
                             if ($2.type = "boolean") and
                                ($4.type = "OK") and
                                ($6.type = "OK")
                             then "OK" else "ERROR";
                        }
                ;

expr            : number
                        {$$.type = $1.type;}
                | char
                       {$$.type = $1.type;}
                | bool
                        {$$.type = $1.type;}
                | Yidentifier
                        {$$.type = Lookup(symtab, $1.text)#3;}
                | Yidentifier '(' actuals ')'
                        {let ftypes = Lookup(symtab, $1.text)#4;
                         let proctype = Lookup(symtab, $1.text)#3;
                         $$.type = 
                             if (foreach (fp in ftypes, ap in $3.types)
                                 (fp = ap)) and (proctype != null)
                             then proctype else "ERROR";
                        }
                | expr relop expr      %prec '<'
                        {$$.type =
                            if ($1.type = $3.type) and
                               (($1.type = "real") or ($1.type = "integer")
                                   or ($1.type = "char"))
                            then $1.type else "ERROR";
                        }
                | expr addop expr      %prec '+'
                        {$$.type =    /* For simplicity, this is Mod-2 rule */
                            if ($1.type = $3.type) and
                               (($1.type = "real") or ($1.type = "integer"))
                            then $1.type else "ERROR";
                        }
                | expr multop expr     %prec '*'
                        {$$.type = 
                            if ($1.type = $3.type) and
                               (($1.type = "real") or ($1.type = "integer"))
                            then $1.type else "ERROR";
                        }
                | '(' expr ')'
                        {$$.type = $2.type;}
                ;

addop           : '+'
                | '-'
                | YOR
                ;

multop          : '*'
                | '/'
                | YAND
                ;

relop           : '<'
                | '>'
                | '='
                | YLEOP
                | YGEOP
                | YNEOP
                ;

actuals         : /* empty */
                        {$$.types = null;}
                | actual
                        {$$.types = $1.type;}
                | actual ',' actuals
                        {$$.types = $1.type U $3.types;}
                ;

actual          : expr
                        {$$.type = $1.type;}

number          : real
                        {$$.type = $1.type;}
                | integer
                        {$$.type = $1.type;}
                ;

real            : Yreal
                        {$$.type = "real";}
                ;
                
integer         : Yinteger
                        {$$.type = "integer";}
                ;

char            : Ychar
                        {$$.type = "char";}
                ;

bool            : Ybool
                        {$$.type = "boolean";}
                ;