signature TRANSLATE =
    sig
	type label
	type level
	type access

	type exp

	val outermost: level
	val newLevel:
	    {name: label, parent: level, formals: bool list} -> level

	val frame: level -> Frame.frame

	val formals: level -> access list
	val allocLocal: level -> bool -> access

	val unEx: exp -> Tree.exp
	val unNx: exp -> Tree.stm
	val unCx: exp -> (Temp.label * Temp.label) -> Tree.stm

	val simpleVar: level * access -> exp

	val ZERO: exp
	val ONE: exp

	val nilExp: exp

	val intExp: int -> exp

	val stringExp: string -> exp

	val callExp: level * level * label * exp list -> exp

	val arrayVar: exp * exp -> exp

	val arrayExp: exp * exp -> exp

	val aopEx: Tree.binop * exp * exp -> exp
	val bopCx: Tree.relop * exp * exp -> exp

	val seqExp: exp list -> exp
	val assignExp: exp * exp -> exp

	val ifThenExp: exp * exp -> exp
	val ifThenElseExp: exp * exp * exp -> exp

	val breakExp: label -> exp
	val whileExp: exp * exp * label -> exp

	val letExp: Tree.stm list * exp -> exp

	val transProg: Expressions.exp -> exp
    end

structure Translate :> TRANSLATE where type label = Temp.label =
    struct
        structure A = Array
	structure E = Expressions
	structure F = Frame
	structure S = Symbol
	structure T = Tree
	structure TE = Temp

	val err = Error.err

	type label = TE.label

	datatype level =
	    TOP of F.frame
	  | LEVEL of {frame: F.frame, stalink: int, parent: level} * unit ref

	val outermost = TOP (F.newFrame {name= TE.newLabel (), formals = []})

	fun levEq (TOP _, TOP _) = true
	  | levEq (LEVEL (_, u), LEVEL (_, u')) = (u = u')
	  | levEq (_, _) = false

	fun newLevel {parent= level, name= lab, formals= bs} =
	    let
		(* the first argument is for static link *)
		val F = F.newFrame {name= lab, formals= true :: bs}
		val sl = F.frameOffset (A.sub (F.formals F, 0))
	    in
		LEVEL ({frame= F, stalink= sl, parent= level}, ref ())
	    end

	fun frame (lev: level): F.frame =
	    case lev of TOP F => F | LEVEL ({frame= F, ...}, _) => F

	type access = level * F.access

	fun formals (lev: level): access list =
	    case lev of
		TOP _ => []
	      | LEVEL ({frame= F, ...}, _) =>
                  A.foldr (fn (acc, res) => (lev, acc) :: res) [] (F.formals F)

	fun allocLocal (lev: level) (esc: bool): access =
	    case lev of
		TOP F => (lev, F.allocLocal F esc)
	      | LEVEL ({frame= F, ...}, _) => (lev, F.allocLocal F esc)

	datatype exp =
	    Ex of T.exp
	  | Nx of T.stm
	  | Cx of TE.label * TE.label -> T.stm

	fun unEx (Ex e) = e
	  | unEx (Nx s) = T.ESEQ (s, T.UNIT)
	  | unEx (Cx c) =
	    let
		val r = TE.newTemp ()
		val t = TE.newLabel ()
		and f = TE.newLabel ()
	    in
		T.ESEQ (T.seqStm
			(T.MOVE (T.TEMP r, T.ONE),
			 c (t, f),
			 [T.LABEL f,
			  T.MOVE (T.TEMP r, T.ZERO),
			  T.LABEL t]),
			T.TEMP r)
	    end

	fun unNx (Ex e) = T.EXP (e)
	  | unNx (Nx n) = n
	  | unNx (Cx c) = c (TE.newLabel (), TE.newLabel ())

	fun unCx (Ex e) =
	    (case e of
		 T.CONST 0 => (fn (t, f) => T.JUMP (T.NAME f, [f]))
	       | T.CONST 1 => (fn (t, f) => T.JUMP (T.NAME t, [t]))
	       | _ => (fn (t, f) => T.CJUMP (T.EQ, e, T.ZERO, f, t)))
	  | unCx (Cx c) = c
	  | unCx (Nx _) = err ("translate: unCx: Nx")

	(* functions for translation variables and expressions *)

	fun simpleVar (lev: level, acc: access): exp =
	    let
		val (vLev, vAcc) = acc
	    in
		simpleVarAux (lev, vLev, vAcc, T.TEMP (F.FP))
	    end

	and simpleVarAux (lev: level, vLev: level, vAcc: F.access, fp: T.exp): exp =
	    case levEq (vLev, lev) of
		true => (* the same level *)
		    Ex (F.accessToExp vAcc fp)
	      | false => (* not the same level *)
		(case lev of
		     TOP _ => err "simpleVarAux: TOP"
		   | LEVEL ({parent= lev', stalink= sl, ...}, _) =>
		     simpleVarAux (lev', vLev, vAcc, T.MEM (T.plus (fp, T.CONST sl))))

	fun arrayVar (arr: exp, ind: exp): exp =  Ex (T.MEM (T.plus (unEx arr, unEx ind)))
	    
	val ZERO = Ex (T.ZERO)

	val ONE = Ex (T.ONE)

	val nilExp = Ex (T.CONST 0)

	fun intExp (i: int): exp = Ex (T.CONST i)

	fun stringExp (str: string): exp =
	    let
		val lab = TE.newLabel ()
		val _ = F.addFrag (F.STRING (lab, str))
	    in
		Ex (T.NAME lab)
	    end

	fun extCallExp (flab, args): exp =
	    Ex (T.CALL (T.NAME flab, List.map unEx args))

	fun compStaLink (fp: T.exp,
			 callerLev: level,
			 calleeParentLev: level): T.exp =
	    case levEq (callerLev, calleeParentLev) of
		true => fp (* inner function call *)
	      | false => (* outer function call *)
		    case callerLev of
			TOP _ => err "compStaLink: callerLev: TOP"
	              | LEVEL ({parent= callerLev', stalink= sl, ...}, _) =>
			    compStaLink
			    (T.MEM (T.plus (fp, T.CONST sl)),
			     callerLev', calleeParentLev)

	fun callExp (callerLev: level, calleeLev: level,
		     flab: label, args: exp list): exp =
	    case calleeLev of
		TOP _ => extCallExp (flab, args)
	      | LEVEL ({parent= calleeLev', ...}, _) => 
                let
		    val staLinkExp =
			compStaLink (T.TEMP (F.FP), callerLev, calleeLev')
		in
		    Ex (T.CALL (T.NAME flab,
				staLinkExp :: List.map unEx args))
		end
	       
	fun arrayExp (size: exp, init: exp): exp =
	    extCallExp (TE.namedLabel "initArray", [size, init])

	fun tupleExp (es: exp list): exp =
	    let
		val n = List.length es
		val t = T.TEMP (TE.newTemp ())
		val st0 = T.MOVE (t, unEx (extCallExp (TE.namedLabel "initArray0", [Ex (T.CONST n)])))
		fun aux (i, []) = t
		  | aux (i, e :: es) =
		    let
			val st = T.MOVE (T.MEM (T.plus (t, T.CONST i)), unEx e)
		    in
			T.ESEQ (st, aux (i+1, es))
		    end
	    in
		Ex (T.ESEQ (st0, aux (0, es)))
	    end

	fun aopEx (oper: T.binop, l: exp, r: exp): exp = (* arithmetic *)
	    Ex (T.BINOP (oper, unEx l, unEx r))

	fun bopCx (oper: T.relop, l: exp, r: exp): exp = (* comparison *)
	    Cx (fn (t, f) => T.CJUMP (oper, unEx l, unEx r, t, f))

	fun seqExp (es: exp list): exp =
	    case es of
		[] => Ex (T.UNIT)
	      | e :: es => seqExp1 (e, es)

	and seqExp1 (e1, []) = e1
	  | seqExp1 (e1, e2 :: es) = Ex (seqExp2 (e1, e2, es))

	and seqExp2 (e1, e2, []) = T.ESEQ (unNx e1, unEx e2)
	  | seqExp2 (e1, e2, e3 :: es) =
	    T.ESEQ (unNx e1, seqExp2 (e2, e3, es))
	    
	fun assignExp (e1: exp, e2: exp): exp =
	    Nx (T.MOVE (unEx e1, unEx e2))

	fun ifThenExp (test, e: exp): exp =
	    let
		val r= TE.newTemp ()
		val t = TE.newLabel ()
		val f = TE.newLabel ()
		val test = unCx test
	    in
		Nx (T.seqStm (test (t, f), T.LABEL t, [unNx (e), T.LABEL f]))
	    end

	fun ifThenElseExp (test, e1: exp, e2: exp): exp =
	    let
		val r= TE.newTemp ()
		val t = TE.newLabel ()
		val f = TE.newLabel ()
		val j = TE.newLabel ()
		val test = unCx test
	    in
		Ex (T.ESEQ (T.seqStm
			    (test (t, f),
			     T.LABEL t,
			     [T.MOVE (T.TEMP r, unEx e1),
			      T.JUMP (T.NAME j, [j]),
			      T.LABEL f,
			      T.MOVE (T.TEMP r, unEx e2),
			      T.LABEL j]),
			    T.TEMP r))
	    end

	fun breakExp (doneLab: label): exp =
	    Nx (T.JUMP (T.NAME doneLab, [doneLab]))

	fun whileExp (test: exp, body: exp, doneLab: label): exp =
	    let
		val loopLab = TE.newLabel()
		val testLab = TE.newLabel()
		val test = unCx (test)
	    in
		Nx (T.seqStm
		    (T.JUMP (T.NAME (testLab), [testLab]),
		     T.LABEL loopLab,
		     [unNx (body), T.LABEL (testLab),
		      test (loopLab, doneLab), T.LABEL (doneLab)]))
	    end

	fun letExp (sts: T.stm list, exp: exp): exp =
	    case sts of
		[] => exp
	      | [st] => Ex (T.ESEQ (st, unEx exp))
	      | st1 :: st2 :: sts => 
		    Ex (T.ESEQ (T.seqStm (st1, st2, sts), unEx exp))


	type venv = access S.table
	type fenv = level S.table

	val base_fenv =
	    List.foldr
            (fn (name, fenv) => S.enter (fenv, S.symbol name, outermost))
	    S.empty
	    ["print", "flush", "ord", "chr", "getchar", "not", "concat", "size", "substring", "exit"]

	fun transVar (lev: level, fenv: fenv, venv: venv, olab: label option, v: E.var): exp =
	    case v of
		E.SimpleVar id =>
		  (case S.look (venv, id) of
		       SOME acc => simpleVar (lev, acc)
		     | NONE => err ("transVar: SimpleVar: " ^ S.name id))
	      | E.SelectVar (v, i) =>
                  Ex (T.MEM (T.plus (unEx (transVar (lev, fenv, venv, olab, v)), T.CONST i)))
	      | E.SubscriptVar (v, e) =>
		  Ex (T.MEM (T.plus (unEx (transVar (lev, fenv, venv, olab, v)),
				     unEx (transExp (lev, fenv, venv, olab, e)))))

	and transExp (lev: level, fenv: fenv, venv: venv, olab: label option, e: E.exp): exp =
	    case e of
		E.VarExp v => transVar (lev, fenv, venv, olab, v)
	      | E.IntExp i => intExp i
	      | E.StringExp s => stringExp s
	      | E.NilExp => nilExp
	      | E.AssignExp (v, e) =>
                  assignExp (transVar (lev, fenv, venv, olab, v), transExp (lev, fenv, venv, olab, e))
	      | E.CallExp (fid, es) =>
		  let
		      val fLab = TE.newLabel ()
		  in
		      case S.look (fenv, fid) of
			  SOME fLev => callExp (lev, fLev, fLab, transExpList (lev, fenv, venv, NONE, es))
			| NONE => err ("transExp: CallExp: undeclared function: " ^ S.name fid)
		  end		  
	      | E.ArrayExp (size, init) =>
		  arrayExp (transExp (lev, fenv, venv, olab, size), transExp (lev, fenv, venv, olab, init))		  
	      | E.TupleExp (es) => tupleExp (transExpList (lev, fenv, venv, olab, es))
	      | E.SeqExp (es) => seqExp (transExpList (lev, fenv, venv, olab, es))
	      | E.OpExp (e1, oper, e2) =>
		  let
		      val e1 = transExp (lev, fenv, venv, olab, e1)
		      val e2 = transExp (lev, fenv, venv, olab, e2)
		  in
		      case oper of
			  E.PlusOp => aopEx (T.PLUS, e1, e2)
			| E.MinusOp => aopEx (T.MINUS, e1, e2)
			| E.TimesOp => aopEx (T.MUL, e1, e2)
			| E.DivideOp => aopEx (T.DIV, e1, e2)
			| E.LtOp => bopCx (T.LT, e1, e2)
			| E.LeOp => bopCx (T.LE, e1, e2)
			| E.GtOp => bopCx (T.GT, e1, e2)
			| E.GeOp => bopCx (T.GE, e1, e2)
			| E.AndOp => ifThenElseExp (e1, e2, ZERO)
			| E.OrOp => ifThenElseExp (e1, ONE, e2)
			| E.IntEq => bopCx (T.EQ, e1, e2)
			| E.IntNeq => bopCx (T.NE, e1, e2)
(*
			| E.StrEq =>
			| E.StrNeq =>
			| E.TupEq =>
			| E.TupNeq =>
*)
		  end
	      | E.IfThenExp (e1, e2) =>
		  ifThenExp (transExp (lev, fenv, venv, olab, e1), transExp (lev, fenv, venv, olab, e2))
	      | E.IfThenElseExp (e1, e2, e3) =>
		  ifThenElseExp (transExp (lev, fenv, venv, olab, e1),
				 transExp (lev, fenv, venv, olab, e2),
				 transExp (lev, fenv, venv, olab, e3))
	      | E.BreakExp =>
		  (case olab of SOME lab => breakExp (lab) | NONE => err "transExp: BreakExp")

	      | E.WhileExp (test, body) =>
		  let
		      val doneLab = TE.newLabel ()
		      val test = transExp (lev, fenv, venv, olab, test)
		      val body = transExp (lev, fenv, venv, SOME doneLab, body)
		  in
		      whileExp (test, body, doneLab)
		  end
		       
	      | E.LetExp (ds, body) =>
		  let
		      val (fenv, venv, sts) = transDecs (lev, fenv, venv, olab, ds)
		      val body = transExp (lev, fenv, venv, olab, body)
		  in
		      letExp (sts, body)
		  end

	and transExpList (lev: level, fenv: fenv, venv: venv, olab: label option, es: E.exp list): exp list =
	    List.map (fn e => transExp (lev, fenv, venv, olab, e)) es

	and transDec (lev: level, fenv: fenv, venv: venv, olab: label option, sts: T.stm list, d: E.dec)
	  : fenv * venv * T.stm list =
	  case d of
	      E.FunDec fds =>
		let
		    val fenv = transFunDec (lev, fenv, venv, fds)
		  in
		      (fenv, venv, sts)
		  end

	    | E.VarDec (id, init, esc) =>
              let
		  val init = transExp (lev, fenv, venv, olab, init)
		  val acc = allocLocal lev esc
		  val venv = S.enter (venv, id, acc)
		  val st = T.MOVE (unEx (simpleVar (lev, acc)), unEx init)
	      in
		  (fenv, venv, st :: sts)
	      end

	and transFunDec (lev: level, fenv: fenv, venv: venv, fds: E.fundec list): fenv =
	    let
		fun auxFenv ([], fenv) = fenv
		  | auxFenv ((fid, params, body) :: fds, fenv) =
		    let
			val fLev =
			    newLevel {name=fid, parent= lev,
				      formals= List.map (fn (_, esc) => esc) params}

			val fenv = S.enter (fenv, fid, fLev)
		    in
			auxFenv (fds, fenv)
		    end

		val fenv = auxFenv (fds, fenv)

		fun aux [] = ()
		  | aux ((fid, params, body) :: fds) =
		    let
			val fLev =
			    case S.look (fenv, fid) of
				SOME fLev => fLev
			      | NONE => err ("transFunDec: aux: undeclared function: " ^ S.name fid)

			fun auxVenv ([], [], venv) = venv
			  | auxVenv ((id, _) :: params, acc :: accs, venv) =
			    auxVenv (params, accs, S.enter (venv, id, acc))
			  | auxVenv (_, _, _) = err "transFunDec: auxVenv: unequal length"

			val accs =
			    case formals fLev of
				_ :: accs => accs | [] => err "transFunDec: empty access list"

			val venv = auxVenv (params, accs, venv)

			val body = transExp (fLev, fenv, venv, NONE, body)

			val frag = F.PROC {body= unNx body, frame= frame fLev}
		    in
                        (F.addFrag frag; aux fds)
		    end
	    in
                (aux fds; fenv)
	    end
    
        and transDecs (lev: level, fenv: fenv, venv: venv, olab: label option, ds: E.dec list)
	  : fenv * venv * T.stm list =
	  let
	      fun aux (fenv, venv, sts, []) = (fenv, venv, List.rev sts)
		| aux (fenv, venv, sts, d :: ds) =
		  let
		      val (fenv, venv, sts) = transDec (lev, fenv, venv, olab, sts, d)
		  in
		      aux (fenv, venv, sts, ds)
		  end
	  in
	      aux (fenv, venv, [], ds)
	  end    

	fun transProg (e: E.exp): exp = transExp (outermost, base_fenv, S.empty, NONE, e)

	(* dummy version *)
	fun procEntryExit (lev: level, body: exp): unit = ()
			
    end