(* * This is a Yacc-style attribute grammar for type checking and interpretation * of a simple imperative language (SIL). SIL has the same basic semantics as * Lisp with setq. The differences between SIL and imperative Lisp are: (1) * SIL has more Pascal-like syntax; (2) SIL has explicit type declarations for * variables and function parameters; (3) SIL distinguishes between statements * and expressions, where statements are executed solely for their effect on * the store, and do not return a value. * * The following semantic attributes are used in the SIL definition. The meta * notation for semantic data definitions and auxiliary functions is RSL, * an ML-like formal specification language. * * * ATTRIBUTE TYPE DESCRIPTION ==================================================================== *) obj state is (env, store) (* The main state of the program, * representing the topmost attribute * of program evaluation. *); obj alist is list of binding (* A generic association list of * bindings. *); obj binding is n: name (* A generic binding with a name field; * this generic binding is specialized * with additional components for * function and variable bindigns. *); obj env < alist (* The main alist of env bindings. *) is list of (* Note that env is actually two *) env_binding (* separate attributes, denoted env and * env`. Env is an inherited attribute * representing the incoming * environment; env` is a synthesized * attribute representing the outgoing * environment. *); obj store is list of act_rec (* The main list of value bindings. As * with env, store is actually two * attributes: an inherited store and a * synthesized store`. Note the store * is managed in a LIFO discipline, * with the bottomost (earliest added) * act_rec representing the global * store, and the topmost (most * recently added) act_rec representing * the current function activation * record. *); obj env_binding (* A specialization of binding that *) < binding is d: def (* adds a var definition component, * resulting in a (name, def) pair. *); obj def is vd: var_def or (* One of var def or function def. *) fd: fun_def ; obj var_def is type (* Just a type. *); obj fun_def is (t: type, (* A triple of (type, formals, body. *) fs: formals, b: body) ; obj formals is list of (* A binding list for a function *) var_binding (* signature. *); obj var_binding (* A specialization of binding that *) < binding is t: type (* adds a type component, resulting in * a (name, type) pair. *); obj type is string (* One of the strings "integer", * "real", "string", "boolean", or * "OK". *); axiom forall (t:type) (t="integer") or (t="real") or (t="string") or (t="boolean") or (t="OK"); obj body is op (env,store) (* A function from (env,store) -> *) -> (store) (* store, reprsenting the bodies of * * defined functions. *); obj act_rec < alist is list of (* A list of value bindings for a *) value_binding (* function activation. *); obj value_binding (* A specialization of binding that *) < binding is value (* adds a value, resulting in a (name, * value) pair. *); obj value is integer or (* A value of one of the prmitive *) real or (* datatypes. Note that these are *) string or (* represented directly as types of *) boolean (* the meta-language, i.e., RSL. *); obj op_fun is op (* A function from value pair to *) (value,value) (* value, representing the built-in *) -> (value) (* binary operators of the langauge.*); obj op_fun_1 is op (value) (* A function from value to value, *) -> (value) (* representing the built-in unary * operators of the langauge *); obj name is string (* The string name of program * identifiers. *); (* * Auxiliary functions. *) (* * Find the given name in the given association (i.e., binding) list. *) function assoc(n:name, al:alist) -> binding = if al = nil then nil else if n = al[1].n then al[1] else assoc(n, al[2:#al]); (* * Eye candy. *) function last(l:alist) = l[#l]; function butlast(l:alist) = l[1:#l-1]; (* * Reassign the given value to the given name in the given alist. Used for * value bindings only (i.e., not for env bindings). *) function reassign(n:name, v:value, al:alist) = ( let vb:var_binding = {n, v}; if n = al[1].n then vb + al[2:#al] else al[1] + reassign(n, v, al[2:#al]) ); (* * Assign the given value to the given name in the given alist. Used for value * bindings only (i.e., not for env bindings). *) function assign(n:name, v:value, al:alist) = {n, v} + al; (* * Type check the application of the given function to arguments of the given * actual types, in the given environment. *) function chk_apply(fun_name:name, actual_types:type*, e:env) = ( let fun_binding = assoc(fun_name, e). type* = if fs = nil then nil else fs[1].t + make_type_list(fs[2:#fs]); (* * Check the that types in a formals and actuals list agree. *) function chk_bindings(formal_types: type*, actual_types:type*) -> boolean = if formal_types = nil then true else (formal_types[1] = actual_types[1]) and chk_bindings(formal_types[2:#formal_types], actual_types[2:#actual_types]); (* * Apply the function of the given name to the given list of actual paraemr * values, in the context of thee given env and store. *) function apply(fun_name:name, actuals:value*, e:env, s:store) -> (store) = ( let fun_binding = assoc(fun_name, e). type* = if fs = nil then nil else fs[1].n + make_name_list(fs[2:#fs]); function bind(fs:name*, as:value*) -> act_rec = if fs = nil then nil else {fs[1], as[1]} + bind(fs[2:#fs], as[2:#as]); function functionize(tree, in_attributes,out_attributes) -> tree_fun (* = a meta-function that transforms an attributed parse tree denoted by T into a function fT(ia<1>*...*ia)->(sa<1>*...*sa) where ia are some or all of the inherited attributes of T and sa are some or all of the synthesized attributes of T, as specified by in_attributes and out_attributes resp. In practice within this definition, functionize is used to transform the parse tree of a function body into a function (env,store)->(store`). *); obj tree; obj tree_fun is op (in_attributes) -> (out_attributes); obj in_attributes; obj out_attributes; function init_env() = []; (* * *) (* %token PROGRAM %token END %token VAR %token INTEGER %token REAL %token CHAR %token BOOLEAN %token IDENTIFIER %token PROCEDURE %token BEGIN %token IF %token THEN %token ENDIF %token ELSE %token OR %token AND %token LEQ %token GEG %token NEW %token REALVAL %token INTEGERVAL %token CHARVAL %token BOOLVAL %left '=' '<' '>' LEQ GEQ NEQ %left '+' '-' OR %left '*' '/' AND %% program : PROGRAM d:decls s:stmts END {$2.env = init_env() $3.env = $2.env` $3.store = [] $$.state = if ($2.type != error_type) and ($3.type != error_type) then ($2.env`, $3.store`) else error_state} ; decls : /* empty */ {$$.env` = [] $$.type = "OK"} | decl ';' decls {$1.env = $$.env $3.env = $1.env` $$.env` = $1.env` @ $3.env` $$.type = if ($1.type != error_type) and ($3.type != error_type) then "OK" else error_type} ; decl : vardecl {$$.env` = $1.env` $$.type = $1.type} | procdecl {$1.env = $$.env $$.env` = $1.env` $$.type = $1.type} ; vardecl : VAR vars ':' type {$2.type = $4.type $$.env` = $2.env` $$.type = $4.type} ; type : INTEGER {$$.type = "integer"} | REAL {$$.type = "real"} | CHAR {$$.type = "char"} | BOOLEAN {$$.type = "boolean"} ; vars : var {$$.env` = [($1.name, $$.type)]} | var ',' vars {$3.type = $$.type $$.env` = [($1.name, $$.type)] @ $3.env`} ; var : IDENTIFIER {$$.name = $1.name} /* NOTE: The lexer provides ident string names. */ ; procdecl : PROCEDURE prochdr procbody {$3.env = $2.formals @ $$.env $$.env` = [($2.name, nil_type, $2.formals, $3.fun_body)] $$.type = $3.type} | PROCEDURE prochdr ':' type procbody {$5.env = $2.formals @ [($2.name, $4.type)] @ $$.env $$.env` = [($2.name, $4.type, $2.formals @ [($2.name, $4.type)], /* ^^^^^^^^^^^^^^^^^^ return val */ $5.fun_body)] $$.type = $5.type} ; prochdr : IDENTIFIER '(' formals ')' {$$.name = $1.name $$.formals = $3.formals} ; formals : /* empty */ {$$.formals = []} | formal {$$.formals = [$1.env_binding]} | formal ',' formals {$$.formals = $1.env_binding @ $3.formals} ; formal : var ':' type {$$.env_binding = ($1.name, $3.type)} ; procbody : BEGIN stmts END {$$.type = $2.type $$.fun_body = functionize($2,(env,store),store`)} ; stmts : stmt ';' {$1.env = $$.env $1.store = $$.store $$.type = $1.type $$.store` = $1.store`} | stmt ';' stmts {$1.env = $3.env = $$.env $$.type = if $1.(type = "OK") and ($3.type = "OK") then "OK" else error_type $1.store = $$.store $3.store = $1.store` $$.store` = $3.store`} ; stmt : /* empty */ | var ':=' expr {$$.type = if #2(assoc($1.name, $$.env)) = $3.type then "OK" else error_type $3.store = $$.store $$.store` = if (length($$.store) > 1) andalso assoc($1.name, hd($$.store)) then reassign($1,name, $3.value, hd($$.store)) @ tl(store) else if assoc($1.name, last($$.store)) then butlast(store) @ reassign($1.name, $3.value, last($$.store)) else butlast(store) @ assign($1.name, $3.value, last($$.store))} | IDENTIFIER '(' actuals ')' {$$.type = if chk_apply($1,name, $3.types, $$.env) $$.store` = tl(apply( $1.name, $3.values, $$.env, $$.store))} | IF expr THEN stmts ENDIF {$2.env = $4.env = $$.env $$.type = if $2.type = "boolean" then $4.type else error_type /* NOTE WEAKNESS HERE */ $4.store = $$.store $$.store` = if $2.value then $4.store` else $$.store} | IF expr THEN stmts ELSE stmts ENDIF {$2.env = $4.env = $6.env = $$.env $$.type = if $2.type = "boolean" then if $4.type = "OK" and $6.type = "OK" then "OK" else error_type /* NOTE WEAKNESS HERE */ $4.store = $6.store = $$.store $$.store` = if $2.value then $4.store` else $6.store`} ; expr : number {$$.type = $1.type $$.store` = $$.store $$.value = $1.value} | char {$$.type = $1.type $$.store` = $$.store $$.value = $1.value} | bool {$$.type = $1.type $$.store` = $$.store $$.value = $1.value} | var {$$.type = if assoc($1.name, $$.env) then #2(assoc($1.name, $$.env)) else error_type $$.store` = $$.store $$.value = if (length($$.store) > 1) and also assoc($1.name, hd($$.store)) then #2(assoc($1.name, hd($$.store))) else if assoc($1.name, last($$.store)) then #2(assoc($1.name, last($$.store))) else error_value} | IDENTIFIER '(' actuals ')' {$3.env = $$.env $3.store = $$.store $$.type = chk_apply($1,name, $3.types, $$.env) $$.store` = tl(apply( $1.name, $3.values, $$.env, $$.store)) $$.value = last(hd(apply( $1.name, $3.values, $$.env, $$.store)))} | expr rel_op expr %prec '<' {$1.env = $3.env = $$.env $$.type = if ($1.type = $2.type) then $1.type else error_type $1.store = $$.store $3.store = $1.store` /* NOTE */ $$.store` = $3.store ` $$.value = $2.op_fun($1.value, $3.value)} | expr add_op expr %prec '+' {$1.env = $3.env = $$.env $$.type = if ($1.type = $2.type) and (($1.type = "real") or ($1.type = "integer")) then $1.type else error_type $1.store = $$.store $3.store = $1.store` $$.store` = $3.store ` $$.value = $2.op_fun($1.value, $3.value)} | expr mult_op expr %prec '*' {$1.env = $3.env = $$.env $$.type = if ($1.type = $2.type) and (($1.type = "real") or ($1.type = "integer")) then $1.type else error_type $1.store = $$.store $3.store = $1.store` $$.store` = $3.store ` $$.value = $2.op_fun($1.value, $3.value)} | '(' expr ')' {$2.env = $$.env $$.type = $2.type $2.store = $$.store $$.store` = $2.store` $$.value = $2.value} ; add_op : '+' {$$.op_fun = $1.op_fun} | '-' {$$.op_fun = $1.op_fun} | OR {$$.op_fun = $1.op_fun} /* NOTE: The lexer provides function literals. */ ; mult_op : '*' {$$.op_fun = $1.op_fun} | '/' {$$.op_fun = $1.op_fun} | AND {$$.op_fun = $1.op_fun} ; rel_op : '<' {$$.op_fun = $1.op_fun} | '>' {$$.op_fun = $1.op_fun} | '=' {$$.op_fun = $1.op_fun} | LEQ {$$.op_fun = $1.op_fun} | GEQ {$$.op_fun = $1.op_fun} | NEQ {$$.op_fun = $1.op_fun} ; actuals : /* empty */ {$$.types = [] $$.store` = $$.store $$.values = []} | actual {$1.env = $$.env $1.store = $$.store $$.types = [$1.type] $$.store` = $1.store` $$.values = [$1.value]} | actual ',' actuals {$1.env = $3.env = $$.env $1.store = $$.store $3.store = $1.store` /* NOTE sequential eval */ $$.store` = $3.store` $$.values = $1.value @ $3.values} ; actual : expr {$$.type = $1.type $$.store` = $1.store` $$.value = $1.value} ; number : real {$$.type = $1.type $$.value = $1.value} | integer {$$.type = $1.type $$.value = $1.value} ; real : REALVAL {$$.type = "real" $$.value = $1.value} /* The lexer provides real literals. */ ; integer : INTEGERVAL {$$.type = "integer" $$.value = $1.value} /* The lexer provides integer literals. */ ; char : CHARVAL {$$.type = "char" $$.value = $1.value} /* The lexer provides char literals. */ ; bool : BOOLVAL {$$.type = "boolean" $$.value = $1.value} /* The lexer provides boolean literals. */ ; *)