translate.sml

structure F = MipsFrame

signature TRANSLATE =
sig
    type exp
    type level
    type access

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

    val simpleVar : access * level -> exp
    val arrayDec : exp * exp -> exp
    val recordDec: exp list -> exp
    val intExp : int -> exp
    val fieldVar: exp * int -> exp
    val subscriptVar: exp * exp -> exp
    val whileExp: exp * exp * Temp.label -> exp
    val breakExp: Temp.label -> exp
    val ifExp: exp * exp * exp option -> exp
    val opExp: exp * A.oper * exp -> exp
    val funCallExp: level * level * Temp.label * exp list -> exp
    val assignStm: exp * exp -> exp
    val getResult: unit -> F.frag list
    val stringExp: string -> exp
    val nilExp: unit -> exp
    val unitExp: unit -> exp
    val seqExp: exp list -> exp
    val procEntryExit : {level: level, body: exp} -> unit
    val convertToStm : exp -> Tree.stm
    val concatExpList: exp list * exp -> exp
    val printLevel: level -> string
    val clearFrags: unit -> unit
end
    

structure Translate: TRANSLATE = struct

datatype level = TOP
	       | NESTED of {uniq: unit ref, parent: level, frame: F.frame}

datatype exp = 
         Ex of Tr.exp
	 | Nx of Tr.stm
	 | Cx of Temp.label * Temp.label -> Tr.stm

type access = level * F.access

val outermost = TOP

(* list of fragments generated by the compiler *)
val frags : F.frag list ref = ref []

(* helper function for generating statement sequences from a list of Tree
   * statements. *)
fun seq (x::[]) = x
  | seq (x::rest) = Tr.SEQ(x, seq(rest))
  (* the empty list of sequences is represented by the 0 expression *)
  | seq ([]) = Tr.EXP(Tr.CONST 0)

fun unEx (Ex e) = e
  | unEx (Nx (Tr.EXP e)) = e
  | unEx (Nx (Tr.SEQ(stm, Tr.SEQ e))) = Tr.ESEQ(stm, unEx (Nx(Tr.SEQ e)))
  | unEx (Nx (Tr.SEQ(stm, Tr.EXP e))) = Tr.ESEQ(stm, e)
  | unEx (Nx e) = Tr.ESEQ(e, Tr.CONST(0))
  | unEx (Cx func) =
    let
	val r = Temp.newtemp()
	val t = Temp.newlabel()
	val f = Temp.newlabel()
	val tempo = Tr.TEMP r
    in
	Tr.ESEQ(seq[func(t, f),
		    Tr.LABEL t,
		    Tr.MOVE(tempo, Tr.CONST 1),
		    Tr.LABEL f,
		    Tr.MOVE(tempo, Tr.CONST 0)], tempo)
    end

fun unNx (Ex e) = Tr.EXP e
  | unNx (Nx e) = e
  | unNx (Cx f) =
    let
	val r = Temp.newlabel()
    in
	seq[f(r, r), Tr.LABEL r]
    end

val convertToStm = unNx

fun unCx (Ex (Tr.CONST(1))) = (fn (t, f) => Tr.JUMP (Tr.NAME(t), [t]))
  | unCx (Ex (Tr.CONST(0))) = (fn (t, f) => Tr.JUMP (Tr.NAME(f), [f]))
  | unCx (Ex e) = (fn (t, f) => Tr.CJUMP(Tr.EQ, e, Tr.CONST(1), t, f))
  | unCx (Nx _) = (Err.error 0 "Compiler error: unCx an Nx"; fn (a, b) => Tr.LABEL(Temp.newlabel()))
  | unCx (Cx f) = f

fun printLevel (NESTED {uniq, parent, frame}) = "NESTED \n"
  | printLevel (TOP) = "TOP \n"
	


fun seq [] = Tr.EXP(Tr.CONST 0)
  | seq[stm] = stm
  | seq(stm::stms) = Tr.SEQ(stm,seq(stms))

fun newLevel {parent = p, name = name, formals = formals} =
    NESTED {uniq = ref (), parent = p,
	    frame = F.newFrame{ name = name, formals = true::formals}}
fun formals TOP = []
  | formals (NESTED e) = map (fn x => (NESTED(e), x)) ((#formals o #frame) e)

fun allocLocal lv esc =
    ( print ((if esc then "true" else "false") ^ "\n");
    case lv of
	NESTED e => (lv, F.allocLocal (#frame e) esc)
      | TOP => (outermost, F.allocLocal (F.newFrame{name = Temp.newlabel(), formals = []}) esc) (* Should not run here at all, don't alloc at TOP level *)
)

(* Generate a chain of FP of the caller frame to pass as first arg to callee *)
fun generateSLChain (TOP, TOP, currentFP) = (Err.error 0 "Impossible"; currentFP)
  | generateSLChain (NESTED _, TOP, currentFP) = (Err.error 0 "Impossible"; currentFP)
  | generateSLChain (TOP, NESTED usedLevel, currentFP) = (Err.error 0 "Impossible"; currentFP)
  | generateSLChain (NESTED decLevel, NESTED usedLevel, currentFP) =
    if (#uniq decLevel) = (#uniq usedLevel)
    then currentFP
    else
	let
	    val STATIC_LINK_OFFSET = F.initialOffset
	    val curStaticLink = Tr.MEM(Tr.BINOP(Tr.PLUS, Tr.CONST(STATIC_LINK_OFFSET), currentFP)) (*This is fp of the previous frame*)
	in
	    generateSLChain (
		NESTED decLevel,
		#parent usedLevel,
		curStaticLink
	    )
	end
	    

fun simpleVar ((decLevel: level, access: F.access): access, usedLevel: level) =
    Ex(F.exp (access) (generateSLChain(decLevel, usedLevel, Tr.TEMP(F.FP))))	

fun arrayDec (sizeExp, initEx) =
    Ex (F.externalCall("tig_initArray", [unEx sizeExp, unEx initEx]))

fun recordDec (fields) =
    let
	val length = List.length fields
	val r = Temp.newtemp()
	val allocRecStm = Tr.MOVE(Tr.TEMP(r), Tr.CALL(Tr.NAME(Temp.namedlabel ("malloc")), [Tr.CONST((length + 1) * F.wordSize)]))
	fun calFieldAddr index = Tr.MEM(Tr.BINOP(Tr.PLUS, Tr.TEMP(r), Tr.CONST((index + 1) * F.wordSize)))
	fun createFieldStm (index, cur, stms) = (Tr.MOVE(calFieldAddr(index), unEx cur)::stms)
	val fieldStms = List.foldri createFieldStm [] fields
	val finalLocationExp = Tr.TEMP(r)
    in
	Ex(Tr.ESEQ(seq(allocRecStm::fieldStms), finalLocationExp))
    end

fun intExp e = Ex (Tr.CONST e)

fun nilExp () = intExp(0)
fun unitExp () = intExp(0)

fun fieldVar (recordTemp, index) = Ex (Tr.MEM (Tr.BINOP(Tr.PLUS, unEx recordTemp, Tr.CONST(F.wordSize * (index + 1))))) (* check here *)

fun subscriptVar (arrayTemp, indexExp) =
    let
	(* remember array is allocated from top to bottom
	   => if array loc = x => first element is saved at x - 4*)
	val indexExp = Tr.BINOP(Tr.PLUS, unEx indexExp, Tr.CONST(1))
    in
	Ex (Tr.MEM (Tr.BINOP(Tr.PLUS, unEx arrayTemp,
			     Tr.BINOP(Tr.MUL, indexExp, Tr.CONST(F.wordSize)))))
    end

fun whileExp (testExp, bodyExp, done) =
    let
	val test = Temp.newlabel()
	val body = Temp.newlabel()
	val funControl = unCx testExp
	val bodyStm = unNx bodyExp
    in
	Nx (seq [
		 Tr.JUMP(Tr.NAME(test), [test]),
		 Tr.LABEL(test),
		 funControl(body, done),
		 Tr.LABEL(body),
		 bodyStm,
		 Tr.JUMP(Tr.NAME(test), [test]),
		 Tr.LABEL(done)
	   ])
    end

fun breakExp doneLabel =
    Nx (Tr.JUMP(Tr.NAME(doneLabel), [doneLabel]))

fun ifExp (test, Nx then', SOME(Nx else')) =
    let
	val testFn = unCx test
	val t = Temp.newlabel()
	val f = Temp.newlabel()
	val done = Temp.newlabel()
    in
	Nx (
	    seq [
		testFn(t,f),
		Tr.LABEL(t),
		then',
		Tr.JUMP(Tr.NAME(done), [done]),
		Tr.LABEL(f),
		else',
		Tr.LABEL(done)
	    ]
	)
    end

  | ifExp (test, Nx then', NONE) =
    let
	val testFn = unCx test
	val t = Temp.newlabel()
	val done = Temp.newlabel()
    in
	Nx (
	    seq [
		testFn(t, done),
		Tr.LABEL(t),
		then',
		Tr.LABEL(done)
	    ]
	)
    end
  | ifExp (test, Cx then', SOME(Cx else')) = 
    let
	val testFn = unCx test
	val a = Temp.newlabel()
	val b = Temp.newlabel()
    in
	Cx (fn (t, f) =>
	       seq[
		   testFn(a, f),
		   Tr.LABEL(a),
		   then' (b, f),
		   Tr.LABEL(b),
		   else' (t, f)
	       ]
	   )
    end
  | ifExp (test, Cx then', NONE) = 
    let
	val testFn = unCx test
	val a = Temp.newlabel()
    in
	Cx (fn (t, f) =>
	       seq[
		   testFn(a, f),
		   Tr.LABEL(a),
		   then' (t, f)
	       ]
	   )
    end
	
       
  | ifExp (test, then', else') =
    let
	val t = Temp.newlabel()
	val f = Temp.newlabel()
	val r = Temp.newtemp()
	val join = Temp.newlabel()
	val func = unCx test
	val tempo = Tr.TEMP r
	val stms = case else' of
		       SOME elseExp => seq [
					  func(t, f),
					  Tr.LABEL(t),
					  Tr.MOVE(tempo, unEx(then')),
					  Tr.JUMP(Tr.NAME(join), [join]),
					  Tr.LABEL(f),
					  Tr.MOVE(tempo, unEx(elseExp)),
					  Tr.JUMP(Tr.NAME(join), [join]),
					  Tr.LABEL(join)
				      ]
		     | NONE => seq [
				  func(t, f),
				  Tr.LABEL(t),
				  Tr.MOVE(tempo, unEx(then')),
				  Tr.JUMP(Tr.NAME(join), [join]),
				  Tr.LABEL(f),
				  Tr.JUMP(Tr.NAME(join), [join]),
				  Tr.LABEL(join)
			      ]
    in
	Ex(Tr.ESEQ(stms, tempo))
    end



fun opExp (left, oper: A.oper, right) =
    let
	fun opCx(oper: Tr.relop) = Cx (fn (t, f) => Tr.CJUMP(oper, unEx(left), unEx (right), t, f))
	fun opEx(oper: Tr.binop) = Ex(Tr.BINOP(oper, unEx (left), unEx (right)))
    in
	case oper of
	    A.PlusOp => opEx Tr.PLUS
	  | A.MinusOp => opEx Tr.MINUS
	  | A.TimesOp => opEx Tr.MUL 
	  | A.DivideOp => opEx Tr.DIV
	  | A.EqOp => opCx Tr.EQ
	  | A.NeqOp => opCx Tr.NE
	  | A.LtOp => opCx Tr.LT
	  | A.LeOp => opCx Tr.LE
	  | A.GtOp => opCx Tr.GT
	  | A.GeOp => opCx Tr.GE
    end

(* Only external function are declared at TOP level, No need to send SL for external one *)
fun funCallExp (TOP, _, label, args) = Ex(Tr.CALL(Tr.NAME(label), (map unEx args)))
  | funCallExp (decLevel, usedLevel, label, args) =
    let
	(* compute static link and add to arg as first arg *)
	val funAddr = generateSLChain(decLevel, usedLevel, Tr.TEMP(F.FP))
	val newArgs = funAddr::(map unEx args)
    in
	Ex(Tr.CALL(Tr.NAME(label), newArgs))
    end

fun assignStm (addrExp, value) =
    Nx(Tr.MOVE(unEx(addrExp), unEx(value)))

fun seqHelper [] = (Tr.EXP(Tr.CONST(0)), Tr.CONST(0))
  | seqHelper (x::[]) = (Tr.EXP(Tr.CONST(0)), unEx(x))
  | seqHelper (h::tl) =
    let
	val (next, last) = seqHelper tl
    in
	(Tr.SEQ(unNx(h), next), last)
    end

fun seqExp exps =
    let
	val (seqStms, lastExp) = seqHelper exps
    in
	Ex (Tr.ESEQ(seqStms, lastExp))
    end


fun procEntryExit {level, body} =
    let
        val levelFrame =
            case level of
                TOP => (Err.error 0 "Fundec should not happen in outermost";   
                             F.newFrame {name=Temp.newlabel(), formals=[]})
              | NESTED ({uniq=_, parent=_, frame=frame'}) => frame'
	val returnStm = Tr.MOVE(Tr.TEMP(F.RV), unEx body)
	val bodyStm = F.procEntryExit1(levelFrame, returnStm)
    in
        frags := F.PROC({body=bodyStm, frame=levelFrame})::(!frags)
    end

fun stringExp lit =
    let
      val lab= Temp.newlabel()
    in
      (frags := F.STRING(lab, lit):: !frags;
       Ex(Tr.NAME(lab)))
    end

fun getResult () = !frags

fun clearFrags () = frags := [];

fun concatExpList (expList, body) = Ex(Tr.ESEQ(seq(map unNx expList), unEx(body)))

end