(*
 * This file contains attribute type and auxilliary function definitions used
 * in sil.attr, q.v.
 *
 *
 *	 ATTRIBUTE	TYPE		DESCRIPTION
	 =================================================================== *)
type	 name =		string		(* String name of program indents *)

type	 typ =		string		(* One of "integer", "real", "string",
			 		   "booleanb", "nil_type", "OK", or
					   "ERROR" *)

datatype value =	I of int |	(* A value of one of the prmitive *)
			R of real |	(* datatypes.  Note that these are *)
			S of string |	(* represented directly as types of *)
			B of bool	(* the meta-language, i.e., ML. *)

type	 value_binding = name * value	(* A (name,value) pair *)

type	 op_fun =	value*value ->	(* A function from value pair to *)
			  value		(* value, representing the built-in *)
					(* binary operators of the langauge *)

type	 op_fun_1 =	value ->	(* A function from value to value, *)
			  value		(* representing the built-in unary *)
					(* operators of the langauge *)

type	 act_rec =	value_binding	(* A list of value bindings for a *)
			  list		(* function activation *)

type	 var_binding =	name * typ	(* A variable env binding *)

type 	 formals =	var_binding	(* A list of var bindings for a *)
			  list		(* function signature *)

datatype fun_binding =	F of		(* A function env binding *)
			name * typ *
			formals * body
   and
	 env_binding =	VarB of		(* An env binding is a var or fun *)
			  var_binding |	(* binding *)
			FB of
			  fun_binding |
			  nil_env_binding
   and
	 env =		EBL of		(* The main list of env bindings. *)
			  env_binding	(* Note that env is actually two *)
			    list	(* separate attributes, denoted env and
					 * env`.  Env is an inherited attribute
					 * representing the incoming
					 * environment; env` is a synthesized
					 * attribute representing the outgoing
					 * environment. *)
   and
	 store =	ARL of act_rec	(* The main list of value bindings.  *)
			   list		(* 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. *)

   and
	 body =		B of 		(* A function from (env * store) -> *)
			  env*store ->	(* store, reprsenting the bodies of *)
			    store	(* defined functions. *)

type	 state =	env * store	(* The main state of the program,
					 * representing the topmost attribute
					 * of program evaluation. *)

datatype binding =	EB of		(* An env binding, value binding, or *)
			 env_binding |	(* nil binding *)
			ValB of
			 value_binding |
			nil_binding


(*
 * The following auxiliary functions are used in the definition:
 *
 *
 *      fun assoc(name, alist) =
 *          if null(alist) then nil_binding
 *          else if name = #1(hd(alist)) then hd(alist)
 *          else assoc(name, tl(alist))
 *
 *      
 *
 *      fun butlast(l) =
 *          if (null(l) orelse null(tl(l))) then nil
 *          else hd(l) :: butlast(tl(l))
 *
 *      fun reassign_local(name, value, alist) =
 *          if name = #1(hd(alist)) then (name, value) :: tl(alist)
 *          else hd(alist) :: reassign(name, value, tl(alist)
 *
 *      fun assign(name, value, alist) = (name, value) :: alist
 *
 *      fun chk_apply(fun_name, actual_types, env)
 *          let
 *              val fun_binding = assoc(fun_name, env)
 *              val formals = make_type_list(#2(fun_binding))
 *              val fun-type = #1(fun_binding)
 *          in
 *              if chk_bindings(formals, actuals) then
 *                  if fun_type = nil_type then
 *                      "OK"
 *                  else
 *                      fun_type
 *              else
 *                  error_type
 *          end
 *
 *      fun make_type_list(formals) =
 *          if formals = nil then nil
 *          else #2(hd(formals)) :: make_type_list(tl(formals))
 *
 *      fun chk_bindings(formals, actuals) =
 *          if formals = nil then true
 *          else (hd(formals) = hd(actuals)) and
 *                      chk_bindings(tl(formals), tl(actuals))
 *
 *      fun apply(fun_name, actuals, env, store) =
 *          let
 *              val fun_binding = assoc(fun_name, env)
 *              val fun_body = #3(fun_binding)
 *              val formals = make_name_list(#2(fun_binding))
 *              val bindings = bind(formals, actuals)
 *          in
 *                  fun_body(env, bindings @ store)
 *          end
 *
 *      fun make_name_list(formals) =
 *          if formals = nil then nil
 *          else #1(hd(formals)) :: make_name_list(tl(formals))
 *
 *      fun bind(formals, actuals) =
 *          if formals = nil then nil
 *          else (hd(formals), hd(actuals)) :: bind(tl(formals), tl(actuals))
 *
 *      fun functionize(tree,ins,outs) = 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 ins and outs, resp.  In practice within this
 *          definition, functionize is used to transform the parse tree of a
 *          function body into a function fn:(env*store)->store`.
 *
 *      fun init_env() = []
 *)

fun get_env_binding_name(VarB(x)) = #1(x)
|   get_env_binding_name(FB(x)) = ""
|   get_env_binding_name(nil_env_binding) = ""

(*
 * Get the name of a environment or value binding.
 *)
fun get_binding_name(EB(x)) = get_env_binding_name(x)
|   get_binding_name(ValB(x)) = #1(x)
|   get_binding_name(nil_binding) = ""

(*
 * Find the given name in the given association (i.e., binding) list.
 *)
fun assoc(name, alist) =
    if null(alist) then nil_binding
    else if name = get_binding_name(hd(alist)) then hd(alist)
    else assoc(name, tl(alist))

(*
 * Make a list consisting of just the types from the given list of (name,type)
 * pairs.
 *)
fun make_type_list(formals:formals) =
    if formals = nil then nil
    else #2(hd(formals)) :: make_type_list(tl(formals))

(*
 * Check the that types in a formals and actuals list agree.
 *)
fun chk_bindings(formals, actuals) =
    if formals = nil then true
    else (hd(formals) = hd(actuals)) andalso
		chk_bindings(tl(formals), tl(actuals))

(*
 * Type check the application of the given function to arguments of the given
 * actual types, in the given environment.
 *)
(*
fun chk_apply(fun_name, actual_types, env) =
    let
	val fun_binding = assoc(fun_name, env)
	val formal_types = make_type_list(get_fun_def_formals(fun_binding))
	val fun_type = #1(fun_binding)
    in
	if chk_bindings(formal_types, actual_types) then
	    if fun_type = "nil_type" then
		"OK"
	    else
		fun_type
	else
	    "ERROR"
    end
*)

(*
 * Assign the given value to the given name in the given alist.  Used for value
 * bindings only (i.e., not for env bindings).
 *)
fun assign(name, value, alist) = (name, value) :: alist

(*
 * Reassign the given value to the given name in the given alist.  Used for
 * value bindings only (i.e., not for env bindings).
 *)
fun reassign(name, value, alist:env_binding list) =
    if name = get_env_binding_name(hd(alist)) then
	VarB(name, value) :: tl(alist)
    else
	hd(alist) :: reassign(name, value, tl(alist))

(*
 * Eye candy.
 *)
fun last(l) = List.nth(l, length(l) - 1)
fun butlast(l) = hd(List.drop(l, length(l) - 1))