(*
 * This file contains attribute type and auxilliary function definitions used
 * in sil.attr, q.v.
 *
 *	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 gneric 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) =
    if n = al[1].n then {n, v} + 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).<env_binding.d.fd;
    let formal_types = make_type_list(fun_binding.fs);
    let fun_type = fun_binding.t;

    if chk_bindings(formal_types, actual_types) then
        if fun_type = nil then
	    "OK"
        else
            fun_type
    else
        "ERROR"
);

(*
 * Make a list consisting of just the types from the given list of (name,type)
 * pairs.
 *)
function make_type_list(fs:formals) -> 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 parameter
 * 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).<env_binding.d.fd;
    let fun_body = fun_binding.b;
    let formal_names = make_name_list(fun_binding.fs);
    let bindings = bind(formal_names, actuals);

    fun_body(e, bindings + s);
);

function make_name_list(fs:formals) -> 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<m>)->(sa<1>*...*sa<n>)

    where ia<i> are some or all of the inherited attributes of T and sa<j> 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`).
*);

(*
 * The following are just stubs for attributed parse trees and related types
 * used by functionize.
 *)
obj tree;
obj tree_fun is op (in_attributes) -> (out_attributes);
obj in_attributes;
obj out_attributes;

function init_env() = [];