structure Semant : SEMANT = struct

structure T = Types
       (* & *)
structure A = Absyn
structure S = Symbol
       (* S *)
	      
structure Frame = MipsFrame

type expty = {exp : Translate.exp, ty: Types.ty}
type venv = Env.enventry Symbol.table
type tenv = Types.ty Symbol.table
		  
local
    (* our global ass...yes, the whole world's ass would weigh quite a bit *)
    val mybutt : (Temp.label Stack.stack) = Stack.create()

    fun map2 (thefun, hd1::[], hd2::[]) =
	[thefun (hd1, hd2)]
      | map2 (thefun, hd1::tl1, hd2::tl2) =
	(thefun (hd1, hd2))::map2(thefun, tl1, tl2)
      | map2 (thefun, [], []) = []
      | map2 (thefun, _, _) = raise List.Empty
    fun map3 (thefun, hd1::[], hd2::[], hd3::[]) =
	[thefun (hd1, hd2, hd3)]
      | map3 (thefun, hd1::tl1, hd2::tl2, hd3::tl3) =
	(thefun (hd1, hd2, hd3))::map3(thefun, tl1, tl2, tl3)
      | map3 (thefun, [], [], []) = []
      | map3 (thefun, _, _, _) = raise List.Empty

    fun map4 (thefun, hd1::[], hd2::[], hd3::[], hd4::[]) =
	[thefun (hd1, hd2, hd3, hd4)]
      | map4 (thefun, hd1::tl1, hd2::tl2, hd3::tl3, hd4::tl4) =
	(thefun (hd1, hd2, hd3, hd4))::map4(thefun, tl1, tl2, tl3, tl4)
      | map4 (thefun, [], [], [], []) = []
      | map4 (thefun, _, _, _, _) = raise List.Empty

    fun untuplify2 (l:('a * 'b) list) : 'a list * 'b list = (map #1 l, map #2 l)
    fun untuplify3 (l:('a * 'b * 'c) list) : 'a list * 'b list * 'c list =
                   (map #1 l, map #2 l, map #3 l)
		   
    fun Listposition e l =
	(let fun pos ([], n) = raise Empty
	      | pos (hd::tl, n) = if hd = e then n else pos (tl, (n+1))
	in
	    pos (l, 0)
	end)

    val debug_global = true
    val error = ErrorMsg.error
    fun assertType (ty, exptypes, p) =
	(if List.exists (fn x => x = ty) exptypes then
	    true
	else
	    (ErrorMsg.error p ("one of [" ^ (foldr (fn (t, s) => (T.name t) ^ ", " ^ s)
						   (T.name (hd exptypes))
						   (tl exptypes))
			       ^ "] expected, but " ^ (T.name ty) ^ " found");
	     false))
	    
    fun assertInt (exptype, pos) =
	assertType (exptype, [T.INT], pos)
    fun assertString (exptype, pos) =
	assertType (exptype, [T.STRING], pos)
    fun assertUnit (exptype, pos) =
	assertType (exptype, [T.UNIT], pos)
    fun assertSame (ty1, ty2, pos) =
	(if ty1 = ty2 then
	    true
	else
	    (ErrorMsg.error pos ("type mismatch:  " ^ (T.name ty1)
				 ^ " vs. " ^ (T.name ty2)); false))
	
    fun assertStringOrInt (exptype, pos) =
	assertType (exptype, [T.STRING, T.INT], pos)
	
    fun assertEquivalence (T.NIL, T.RECORD(bindings, unique), pos) = true
      | assertEquivalence (T.RECORD(bindings, unique), T.NIL, pos) = true
      | assertEquivalence (T.ARRAY(_,_), T.NIL, pos) = true
      | assertEquivalence (T.NIL, T.ARRAY(_,_), pos) = true
      | assertEquivalence (x, y, pos) = assertSame(x, y, pos)
				   
    fun realType (T.NAME(name, ref (SOME x))) = realType(x)
      | realType (T.NAME(name, ref NONE)) =
	(ErrorMsg.error 0 " internal compiler error in realType"; T.UNIT)
      | realType (x) = x
		       
    fun debugSay (s) =
	(if debug_global then
	    TextIO.print (s ^ "\n")
	else
	    ())

    fun sortRecordFields (fields : Absyn.field list) =
	(ListMergeSort.sort (fn (a, b) =>  (Symbol.name (#name a)) <  (Symbol.name (#name b)))
			   fields)

    fun sortRecordFieldUsages (fields : (Symbol.symbol * Absyn.exp * Absyn.pos) list) =
	(ListMergeSort.sort (fn (a, b) =>  (Symbol.name (#1 a)) <  (Symbol.name (#1 b)))
			   fields)
	    
in
(* ----------------------------------------------------------------- *)
fun transProg exp =
    (debugSay "Calling trans.newlevel in transProg\n";
    let val level = Translate.newLevel({parent=Translate.outermost,
					name=Temp.namedlabel "tigermain",
	 				formals=[]:bool list})
	val {exp=body, ty=ty} = transExp (Env.base_venv, Env.base_tenv, exp, level)
    in
        Translate.procEntryExit({level=level,body=body});
	Translate.getResult()
    end)
(* ----------------------------------------------------------------- *)
and transExp (venv, tenv, A.OpExp{left, oper=A.PlusOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright,ty=tyright} = transExp (venv, tenv, right, level)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = Translate.transArithOp (A.PlusOp, expleft, expright), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.MinusOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = Translate.transArithOp (A.MinusOp, expleft, expright), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.TimesOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = Translate.transArithOp (A.TimesOp, expleft, expright), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.DivideOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
    in
	assertInt(tyleft, pos);
	assertInt(tyright, pos);
	{exp = Translate.transArithOp(A.DivideOp, expleft, expright), ty = Types.INT }
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.EqOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
	val (realtype_left, realtype_right) = (realType(tyleft), realType(tyright))
    in
	assertEquivalence(realtype_left, realtype_right, pos);
	{exp=Translate.transComparisonOp(A.EqOp, expleft, expright), ty=T.INT}
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.NeqOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
	val (realtype_left, realtype_right) = (realType(tyleft), realType(tyright))
    in
        assertEquivalence(realtype_left, realtype_right, pos);
        {exp=Translate.transComparisonOp(A.NeqOp, expleft, expright), ty=T.INT}
    end
  | transExp (venv, tenv, A.OpExp{left, oper=A.LtOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
	val (realtype_left, realtype_right) = (realType(tyleft), realType(tyright))
    in
        assertStringOrInt(realtype_left, pos);
	assertStringOrInt(realtype_right, pos);
	assertSame(realtype_left, realtype_right, pos);
	{exp=Translate.transComparisonOp(A.LtOp, expleft, expright), ty=T.INT}
    end

  | transExp (venv, tenv, A.OpExp{left, oper=A.LeOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
	val (realtype_left, realtype_right) = (realType(tyleft), realType(tyright))
    in
	assertStringOrInt(realtype_left, pos);
	assertStringOrInt(realtype_right, pos);
	assertSame(realtype_left, realtype_right, pos);
	{exp=Translate.transComparisonOp(A.LeOp, expleft, expright), ty=T.INT}
    end

  | transExp (venv, tenv, A.OpExp{left, oper=A.GtOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
	val (realtype_left, realtype_right) = (realType(tyleft), realType(tyright))
    in
	assertStringOrInt(realtype_left, pos);
	assertStringOrInt(realtype_right, pos);
	assertSame(realtype_left, realtype_right, pos);
	{exp=Translate.transComparisonOp(A.GtOp, expleft, expright), ty=T.INT}
    end

  | transExp (venv, tenv, A.OpExp{left, oper=A.GeOp, right, pos},level) =
    let val {exp=expleft, ty=tyleft} = transExp (venv, tenv, left, level)
	val {exp=expright, ty=tyright} = transExp (venv, tenv, right, level)
	val (realtype_left, realtype_right) = (realType(tyleft), realType(tyright))
    in
	assertStringOrInt(realtype_left, pos);
	assertStringOrInt(realtype_right, pos);
	assertSame(realtype_left, realtype_right, pos);
	{exp=Translate.transComparisonOp(A.GeOp, expleft, expright), ty=T.INT}
    end
  | transExp (venv, tenv, A.IntExp(x),level) =
    {exp = Translate.transIntValue x, ty = Types.INT }
  | transExp (venv, tenv, A.StringExp(x, pos),level) =
    {exp = Translate.transStringValue x, ty = Types.STRING }
  | transExp (venv, tenv, A.NilExp, level) =
    {exp = Translate.transNilValue (), ty = Types.NIL }
  | transExp (venv, tenv, A.SeqExp(x),level) =
    let val (explist : Translate.exp list,
	     typlist : T.ty list) = untuplify2 (map (fn (e : Absyn.exp) =>
						      let val {exp=exp,ty=ty} =
							      transExp(venv,tenv,e,level) in (exp,ty)
						      end) (map #1 x))
	val transexps : Translate.exp = Translate.transSeqExp explist
    in
	{exp=transexps, ty=hd (List.rev typlist)}
	handle Empty => {exp=transexps, ty=T.UNIT}
    end
  | transExp (venv, tenv, A.IfExp{test, then', else', pos}, level) =
    let val {exp=testexp, ty=testty} = transExp(venv, tenv, test, level)
	val {exp=thenexp, ty=thenty} = transExp(venv, tenv, then', level)
	val (testty_real, thenty_real) = (realType testty, realType thenty)
    in
	assertInt(testty_real, pos);
	case else' of SOME x =>
		      let val {exp=elseexp, ty=elsety} = transExp (venv, tenv, x, level)
			  val elsety_real = realType(elsety)
		      in
			  assertEquivalence(thenty_real, elsety_real, pos);
			  {exp = Translate.transIfExp(testexp, thenexp, elseexp),
			   ty = thenty_real}
		      end
		    | NONE =>
		      (assertUnit(thenty_real, pos);
		       {exp = Translate.transIfExp(testexp,thenexp,
						   Translate.transNilValue()),
			ty = T.UNIT})
    end
  | transExp (venv, tenv, A.WhileExp{test, body, pos}, level) =
    let val {exp=testExp, ty=testty} = transExp(venv, tenv, test, level)
	val {exp=bodyExp, ty=bodyty} = transExp(venv, tenv, body, level)
	val la = Temp.newlabel()
    in
	(Stack.push (mybutt, la);
	 assertInt(testty, pos);
	 assertUnit(bodyty,pos);
	 
	 let val retExp = Translate.transWhileExp(testExp, bodyExp, la)
	 in
	     Stack.pop mybutt;
	     {exp=retExp, ty=T.UNIT}
	 end)
    end
  | transExp (venv, tenv, A.LetExp{decs=decs, body=body, pos=pos}, level) =
    let
	val {venv=venv', tenv=tenv',initexp=initexp} = transDecs (venv, tenv, decs, level)
	val {exp=bodyexp, ty=ty} = transExp(venv', tenv', body, level)
    in
        {exp=Translate.transSeqExp([initexp,bodyexp]), ty=ty}
    end
  | transExp (venv, tenv, A.ForExp{var=var,escape=escape,lo=lo,hi=hi,body=body,pos=pos}, level) =
    let
	val {exp=initExp, ty=loty} = transExp(venv, tenv, lo, level)
	val {exp=limitExp, ty=hity} = transExp(venv, tenv, hi, level)
	val {exp=bodyExp, ty=bodyty} =
	    transExp(S.enter(venv,var,
			     Env.VarEntry{access=(Translate.allocLocal level (!escape)),
					  ty=T.INT}),
		     tenv, body, level)
	val (loty_real, hity_real, bodyty_real) = (realType loty, realType hity, realType bodyty)
	val la = Temp.newlabel()
    in
	Stack.push (mybutt, la);
	assertInt(loty_real,pos);
	assertInt(hity_real,pos);
	let val retExp = Translate.transForExp(initExp,limitExp,bodyExp)
	in
	    Stack.pop mybutt;
	    {exp=retExp, ty=bodyty_real}
	end
    end
  | transExp (venv, tenv, A.BreakExp(pos), level) =
    {exp = Translate.transBreakExp(Stack.pop mybutt), ty = T.UNIT}
  | transExp (venv, tenv, A.AssignExp{var=var,exp=exp,pos=pos}, level) =
    let
	val {exp=lhs, ty=expty} = transExp(venv, tenv, exp, level)
	val {exp=rhs, ty=varty} = transVar(venv, tenv, var, level)
	val (expty_real, varty_real) = (realType expty, realType varty)
    in
	debugSay ("AssignExp: expty = " ^ (T.name expty)
		  ^ " varty = " ^ (T.name varty)
		  ^ " expty_real = " ^ (T.name expty_real)
		  ^ " varty_real = " ^ (T.name varty_real));
	(*  TextIO.print("(assignexp) expty =\n");
	 *  T.print(expty);
	 *  TextIO.print("(assignexp) varty =\n");
	 *  T.print(varty); *)
	(* nil for a record is ok *)
	assertEquivalence(varty_real, expty_real, pos);
	{exp = Translate.transAssignExp (lhs, rhs), ty=T.UNIT}
    end
  | transExp (venv, tenv, A.VarExp(v), level) =
    transVar(venv, tenv, v, level)
  | transExp (venv, tenv, A.CallExp{func=func, args=args, pos=pos}, level) =
    let
	val argExps = map (fn x => (transExp(venv, tenv, x, level))) args
    in
	case S.look(venv,func) of
	    SOME (Env.FunEntry{label=label,level=funLevel, formals=formals,result=result}) =>
	    (if (List.length argExps) = (List.length formals) then
		 (map2 ((fn (x,y) => assertSame(realType(#ty x),
						realType(y),pos)), argExps, formals);
		  result)
	     else
		 (error pos ("function " ^ (S.name func) ^ " has "
			     ^ (Int.toString (List.length formals))
			     ^ " arguments, here called with "
			     ^ (Int.toString (List.length argExps)));
		  T.UNIT);
		 {exp=Translate.transCallExp(label, level, funLevel, (map #exp argExps)),
		  ty=realType(result)})
	  | SOME (Env.VarEntry (ty)) => (error pos ((S.name func)
						    ^ " is not a function, it cannot be applied");
					 {exp=Translate.transNilValue(),ty=T.UNIT})
	  | NONE => (error pos ("undeclared function " ^ (S.name func));
		     {exp=Translate.transNilValue(),ty=T.UNIT})
    end
  | transExp (venv, tenv, A.ArrayExp{typ,size,init,pos}, level) =
    let
	val {exp=initexp, ty=initty} = transExp(venv, tenv, init, level)
	val {exp=sizeexp, ty=sizety} = transExp(venv, tenv, size, level)
	val initty_real = realType(initty)
	val sizety_real = realType(sizety)
	val retty = case S.look(tenv,typ)
		     of SOME (x) => let val realty = realType(x) in
					(*  TextIO.print("(arrayexp) realty =\n");
					 *  T.print(realty);					 *)
					case realty of T.ARRAY(ty, unique) =>
						       if assertSame(realType ty, initty_real, pos)
						       then
							   T.ARRAY(ty, unique)
						       else
							   T.UNIT
						     | _ =>
						       (error pos ((S.name typ) ^
								   " is not an array"); T.UNIT)
				    end
		      | NONE => (error pos ("unknown type " ^ (S.name typ)); T.UNIT)
    in
	assertInt(sizety_real, pos);
	debugSay ("ArrayExp("^(S.name typ)^"): initty = " ^ (T.name initty)
		  ^ " sizety = " ^ (T.name sizety)
		  ^ " retty = " ^ (T.name retty));
	{exp=Translate.transArrayExp(sizeexp,initexp), ty=retty}
    end
  | transExp (venv, tenv, A.RecordExp{typ=typ,fields=fields,pos=pos}, level) =
    let
	(* translate all of the expressions in the record initializer *)
	val fields' = map (fn (sym, exp, pos) => (sym, transExp(venv, tenv, exp, level), pos))
			  (sortRecordFieldUsages fields)
    in
	case S.look(tenv,typ)
	 of SOME t =>
	    (case realType(t) of
		 (T.RECORD(params, unique)) =>
		 (* loop over the declared parameters *)
		 ((app (fn (paramname, paramty) =>
			   case List.find (fn (fieldname, _, _)
					      => paramname = fieldname)
					  fields'
			    of SOME (sym, {exp=_, ty=fieldty}, _) =>
			       let val fieldty_real = (realType fieldty)
				   val paramty_real = (realType paramty)
			       in
				   (*  TextIO.print("(recordexp) fieldty_real =\n");
				    *  T.print(fieldty_real);
				    *  TextIO.print("(recordexp) paramty_real =\n");
				    *  T.print(paramty_real); *)
				   assertEquivalence(fieldty_real, paramty_real, pos);
				   ()
			       end
			     | NONE => error pos ("required field "
						  ^ (S.name paramname) ^ " missing"))
		       params);
		  (* now, loop over the given parameters *)
		  (app (fn (fieldname, _, _) =>
			   case List.find (fn (paramname, _) => paramname = fieldname)
					  params
			    of NONE => error pos ("unknown field "
						  ^ (S.name fieldname))
			     | _ => ())
		       fields');
		  {exp=Translate.transRecordExp(Translate.transIntValue(List.length fields'),
						(map #exp (map #2 fields'))),
		   ty = T.RECORD(params,unique)})
	       | _ => (error pos ("type " ^ (S.name typ) ^ " is not a record");
		       {exp=Translate.transNilValue(), ty=T.UNIT}))
	  | NONE => (error pos ("unknown type " ^ (S.name typ));
		     {exp=Translate.transNilValue(), ty=T.UNIT})
    end
(* ------------------------------------------------------------ *)
and transDecs (venv, tenv, decs, level) =
    let val {venv=venv',tenv=tenv',initexps=initexps} =
	List.foldl (fn (e, {venv=venv,tenv=tenv,initexps=initexps}) =>
		       (let val {venv=venv'',tenv=tenv'',exp=exp} = transDec(venv,tenv,e,level)
                        in
                           {venv=venv'',tenv=tenv'',initexps=exp @ initexps}
                        end))
		   {venv=venv,tenv=tenv,initexps=[]} decs
    in
        {venv=venv',tenv=tenv',initexp=Translate.transSeqExp initexps}
    end
(* ------------------------------------------------------------ *)
and transVar (venv, tenv, A.SimpleVar (sym,pos), level) =
    (case S.look(venv,sym) of
	 SOME (Env.VarEntry {access=access,ty=ty}) =>
	 let val exp = Translate.simpleVar (access, level)
	     val typ_real = realType(ty)
	 in
	     debugSay ("SimpleVar ("^(S.name sym)^") typ = " ^ (T.name ty)
		       ^ " typ_real = " ^ (T.name typ_real));
	     {exp=exp, ty=realType(ty)}
	 end
       | _ => (error pos ("undeclared variable "
			  ^ (S.name sym));
	       {exp=Translate.Ex(Tree.CONST 0), ty=T.UNIT}))

(* ------------------------------------------------------------ *)
  | transVar (venv, tenv, A.FieldVar(var, fieldname, pos), level) =
    let
   	val {exp=varexp, ty=ty} = transVar(venv, tenv, var, level)
	val ty_real = realType ty
    in
	case ty of T.RECORD (elts : (Symbol.symbol * Types.ty) list, unique) =>
		   (case List.find (fn (sym :Symbol.symbol, _) => fieldname = sym) elts
		     of SOME (sym':Symbol.symbol, ty':Types.ty) =>
			(let val (pos:int,ty:Types.ty) = (Listposition sym' (map #1 elts),
							  realType(ty')) in
			     {exp=Translate.transFieldVarExp(varexp,
							     Translate.transIntValue(pos)),
			     ty=ty}
			 end)
		      | NONE => (error pos ("no such element in record "
					    ^ S.name(fieldname));
				 {exp=Translate.transNilValue(),ty=T.UNIT}))
		 | _ => (error pos "object of field access is not a record";
			 {exp=Translate.transNilValue(),ty=T.UNIT})
    end
(* ------------------------------------------------------------ *)
  | transVar (venv, tenv, A.SubscriptVar(var, exp, pos), level) =
    let
	val {exp=offset, ty=indexty} = transExp(venv, tenv, exp, level)
	val {exp=base, ty=varty} = transVar(venv, tenv, var, level)
	val varty_real = realType(varty)
	val retty =
	    case indexty of T.INT =>
			    (case varty_real of T.ARRAY (ty, unique) =>
						ty
					      | _ => (error pos "subscript found where non-array expected";
						      T.UNIT))
			  | _ => (error pos ("array subscript must be an integer"); T.UNIT)
	val retty_real = realType retty
    in
	debugSay ("SubscriptVar: indexty = " ^ (T.name indexty)
		  ^ " varty = " ^ (T.name varty)
		  ^ " retty = " ^ (T.name retty));
	{exp = Translate.transSubscriptVarExp(base,offset), ty=retty_real}
    end
(* ------------------------------------------------------------ *)
and transDec (venv, tenv, A.VarDec{name,typ=NONE,init, pos, escape}, level) =
    let
	val {exp=initExp,ty=ty} = transExp(venv, tenv, init, level)
	val ty_real = realType(ty)
 	val varInit = (Translate.allocLocal level (!escape))
    in
	debugSay ("VarDec (" ^ (S.name name) ^ ") ty = " ^ (T.name ty)
		  ^ " ty_real = " ^ (T.name ty_real));
	{tenv=tenv, venv=S.enter(venv, name,
				 Env.VarEntry{ty=
 					      (if (ty = T.NIL) then
						  (error pos "It's illegal to assign nil to something for which you haven't yet declared the type.";
						   T.UNIT)
						  else
						      ty_real),
					      access=varInit }),
	 exp=[Translate.transVarInit(varInit, initExp)]}
    end
(* ------------------------------------------------------------ *)
  | transDec (venv, tenv, A.VarDec{name, typ=SOME (sym, decpos), init, pos,escape}, level) =
    let
   	val {exp=initExp, ty=varty} = transExp(venv, tenv, init, level)
	val varty_real = realType(varty)
	val varInit = (Translate.allocLocal level (!escape))
    in
   	let val decty =
		case S.look(tenv, sym) of SOME t => t
					| NONE => (error pos "unknown return type";
						   T.UNIT)
	    val decty_real = realType(decty)
	in
	    (*  TextIO.print("(vardec some) varty =\n");
	     *  T.print(varty);
	     *  TextIO.print("(vardec some) decty =\n");
	     *  T.print(decty); *)
	    assertEquivalence(decty_real,varty_real, pos);
	    (* records can be nil *)
	    {venv=S.enter(venv, name, Env.VarEntry{access=varInit,
						   ty=realType(decty)}),
	     tenv=tenv, exp=[Translate.transVarInit (varInit, initExp)] }
	end
    end
(* ------------------------------------------------------------ *)
  | transDec (venv, tenv, A.TypeDec (decs), level) =
    let val tenv' = foldr (fn ({name=name,ty=ty,pos=pos}, env) =>
			      (debugSay("entering " ^ (S.name name) ^ " into tenv");
   			       S.enter(env, name, T.NAME (name, ref NONE))))
   			  tenv
   			  decs
    in
	(* use "beenhere" to keep track of symbols we have seen while typechecking *)
   	(app (fn {name=name,ty=ty,pos=pos} =>
		 (* now process the "body" of each type *)
		 let
		     val body = transTy(tenv', ty)
		 in
		     (* now we destructively update the types *)
		     case S.look(tenv', name) of (SOME (T.NAME(x, ref (SOME y)))) =>
						 error pos "illegal duplicate type definition"
					       | (SOME (T.NAME(x, binding))) =>
						 binding := SOME body
					       | _ =>
						 error pos "internal compiler error"
		 end)
	     decs);
	(app (fn {name=name,ty=ty,pos=pos} =>
		 let
		     fun cyclicCheck (T.NAME(curname, binding), seen)  =
			 (case binding of (ref (SOME x)) =>
					  if curname = name then
					      (error pos  ("illegal cyclic type definition "
							   ^ (foldl (fn (c, s) =>
								       (S.name c) ^ " ->" ^ s)
								   ""
								   seen)
							   ^ (S.name name));
					       binding := (SOME T.UNIT))
					  else
					      cyclicCheck (x, curname::seen)
					| _ => ())
		       | cyclicCheck _ = ()
		     val body = case S.look(tenv',name) of SOME t => t
							 | _ => (error pos "internal compiler error";
								 T.UNIT)
		 in
		     case body of (T.NAME(curname, ref (SOME x))) =>
				  cyclicCheck (x, [name])
				| _ => ()
		 end)
	     decs);
	{venv=venv,tenv=tenv', exp=[]}
    end
  (* 	fun getHeaders (tenv, A.TypeDec [{name:A.symbol,ty:A.ty,pos:A.pos}]) =
    *  	S.enter(tenv, name, Types.NAME(name, ref NONE))
    *        | getHeaders (tenv, A.TypeDec ({name,ty,pos}::tail)) =
    *  	let val tenv' = S.enter(tenv, name, Types.NAME(name, ref NONE))
    *  	in
    *  	    getHeaders (tenv', A.TypeDec(tail))
    *  	end
    *      val mylist = A.TypeDec ({name=name, ty=ty, pos=pos}::tail)
    *      val tenv1  = getHeaders (tenv, mylist)
    *      val tenv'' = S.enter(tenv1, name, transTy (tenv1, ty))
    *  in
    *      transDec (venv, tenv'', A.TypeDec(tail))
    *  end (* getHeaders sub *) *)
 | transDec (venv, tenv, A.FunctionDec (decs), level) =
   let
       type paramtuple = (Symbol.symbol * Types.ty * bool ref)
       type paramtupleandaccess = (Symbol.symbol * Types.ty * bool ref * Translate.access)
       type accesslist = Translate.access list
	(* a list of the return types of each of the functions *)
       val resultlist
	 = map (fn {result=result,...}:A.fundec =>
		   case result of SOME (result,pos) =>
				  (case S.look(tenv,result)
				    of SOME t => realType(t)
				     | NONE => (error pos ("unknown return type"
							   ^ (S.name result)); T.UNIT))
				| NONE => T.UNIT)
	       decs

       (* a list of the formal parameters (name, type, escape) of each of the functions *)
       val paramlistlist : paramtuple list list =
	   map (fn {params=params,...} =>
		   map (fn {name,typ,pos,escape} =>
			   (* this function turns a parameter into the tuple
				   (name, type, escape) *)
			   case S.look (tenv, typ)
			    of SOME t => (name, t, escape)
			     | NONE => (error pos ("undeclared type " ^ (S.name name));
					(name, T.UNIT, escape)))
		       params)
	       decs
	(* the environment containing the above two values,
	 the accesses to the formal parameters, and a list of the new levels *)
       val (venv', accesseses, levels) : (Env.enventry Symbol.table * Translate.access list list
					  * Translate.level list) =
	   foldr (fn ((name, result, params), (env, accesseses, levels)) =>
		     let val funname = Temp.namedlabel (S.name name)
			 val newlev =  Translate.newLevel{parent=level,
							  name = funname,
							  formals=map (op !) (map #3 params)}
			 val thefun = Env.FunEntry{level=newlev,
						   label= funname,
						   formals=map #2 params, result=result}
			 val formals : Translate.access list = Translate.formals newlev
		     in
			  (S.enter(env, name, thefun), formals::accesseses, newlev::levels)
		     end)
		 (venv, [], [])
		 (map3 ((fn ({name=name,...} :A.fundec,
			     result,
			     params) =>
			    (name, result, params)),
			decs, resultlist, paramlistlist))
       val params : paramtupleandaccess list list =
	   map2 ((fn (paramlist : paramtuple list, accesslist : accesslist) =>
		     map2 ((fn ((name, typ, escape), access) => (name, typ, escape, access),
			    paramlist, accesslist))),
		 paramlistlist, accesseses)
	   
   in
       (* check for duplicate function definitions, in a very inefficient manner *)
       app (fn {name=name,pos=pos,...}::tl : A.fundec list =>
	       error pos ("duplicate function definition " ^ (S.name name))
	     | _ => error 0 "severe internal compiler error: you")
	   (List.filter (fn l => (List.length l) >= 2)
			(map (fn {name=name,pos=pos,...} : A.fundec =>
				 List.filter (fn {name=x,...} : A.fundec => name = x) decs)
			     decs));
	(* loop over all of the function declarations, type-checking each of the booties *)
       map4 ((fn ({name=name,pos=pos,body=body,...} : A.fundec,
		  result,
		  paramaccesses : paramtupleandaccess list,
		  level) =>
		 let
		     (* fold all of the formal paramaters into a new environment *)
		     val venv'' = List.foldr (fn ((name,ty,escape:bool ref, access),
						  venv) =>
						 S.enter(venv,name,
							 Env.VarEntry{access=access, ty=ty}))
					     venv'
					     paramaccesses
		     (* now, type-check and translate the body *)
		     val {exp=bodyexp, ty=initty} = transExp(venv'', tenv, body, level)
		     val initty_real = realType(initty)
		 in
		     (Translate.procEntryExit{level=level,body=bodyexp};
		      assertEquivalence(result, initty_real, pos))
		 end), decs, resultlist, params, levels);
	{venv=venv',tenv=tenv, exp=[]}
   end
(* ------------------------------------------------------------ *)
and transTy (tenv, A.RecordTy (fields)) =
  T.RECORD (map (fn {name=name,escape=escape,typ=typ,pos=pos} : A.field =>
		    (name, (case S.look(tenv, typ) of
				SOME t => t
			      | NONE => (error pos ("undeclared type " ^ (S.name typ)); T.UNIT))))
		(sortRecordFields fields),
	    ref ())
| transTy (tenv, A.NameTy (sym, pos)) =
    (case S.look(tenv, sym) of
	 SOME t => t
       | NONE => (error pos ("undeclared type " ^ (S.name sym)); T.UNIT))
| transTy (tenv, A.ArrayTy (sym, pos)) =
  T.ARRAY((case S.look (tenv, sym) of
	       SOME (t) => t
	     | NONE => (error pos ("undeclared array type " ^ (S.name sym)); T.UNIT)),
	  ref ())

end

end
(* ------------------------------------------------------------ *)