[snipe.git] / trans / trans.sml

(* L3 Compiler
 * AST -> IR Translator
 * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
 * Modified by: Alex Vaynberg <alv@andrew.cmu.edu>
 * Modified: Frank Pfenning <fp@cs.cmu.edu>
 * Modified: Chris Lu <czl@andrew.cmu.edu>
 * Modified: Joshua Wise <jwise@andrew.cmu.edu>
 *)

signature TRANS =
sig
  (* translate abstract syntax tree to IR tree *)
  val translate : Ast.program -> Tree.func list
end

structure Trans :> TRANS = 
struct

  structure A = Ast
  structure AU = AstUtils
  structure T = Tree
  
  fun trans_oper A.PLUS = T.ADD
    | trans_oper A.MINUS = T.SUB
    | trans_oper A.TIMES = T.MUL
    | trans_oper A.DIVIDEDBY = T.DIV
    | trans_oper A.MODULO = T.MOD
    | trans_oper A.LSH = T.LSH
    | trans_oper A.RSH = T.RSH
    | trans_oper A.LOGOR = T.LOGOR
    | trans_oper A.LOGAND = T.LOGAND
    | trans_oper A.BITOR = T.BITOR
    | trans_oper A.BITXOR = T.BITXOR
    | trans_oper A.BITAND = T.BITAND
    | trans_oper A.NEQ = T.NEQ
    | trans_oper A.EQ = T.EQ
    | trans_oper A.LT = T.LT
    | trans_oper A.LE = T.LE
    | trans_oper A.GE = T.GE
    | trans_oper A.GT = T.GT
    | trans_oper _ = raise ErrorMsg.InternalError "expected AST binop, got AST unop"

  fun translate (defs, funcs) =
    let
      val funclist = Symbol.elemsi funcs

      val alignments = ref Symbol.empty  (* Ref for memoization. *)
      fun alignment A.Int = 4
        | alignment (A.Typedef(id)) =
         (case Symbol.look (!alignments) id
            of NONE =>
              let
                val r = alignment_s (Symbol.look' defs id)
                val _ = (alignments := (Symbol.bind (!alignments) (id, r)))
              in
                r
              end
             | SOME r => r)
        | alignment (A.Pointer(_)) = 8
        | alignment (A.Array(_)) = 8
        | alignment (A.TNull) = raise ErrorMsg.InternalError "alignmentof TNull?"
      and alignment_s (A.Struct(members)) =
            foldl
              (fn ((_,t),al) => Int.max (al, alignment t))
              1
              members
        | alignment_s (A.MarkedTypedef(a)) = alignment_s (Mark.data a)

      fun align t curpos =
        let
          val al = alignment t
        in
          if (curpos mod al) = 0
          then curpos
          else curpos + al - (curpos mod al)
        end

      val sizes = ref Symbol.empty
      fun sizeof_v A.Int = 4
        | sizeof_v (A.Typedef(id)) =
         (case Symbol.look (!sizes) id
            of NONE =>
              let
                val r = sizeof_s (Symbol.look' defs id)
                val _ = (sizes := (Symbol.bind (!sizes) (id, r)))
              in
                r
              end
             | SOME r => r)
        | sizeof_v (A.Pointer(_)) = 8
        | sizeof_v (A.Array(_)) = 8
        | sizeof_v (A.TNull) = raise ErrorMsg.InternalError "sizeof TNull?"
      and sizeof_s (A.Struct(l)) =
          foldl
            (fn ((_,t),curpos) => align t curpos + sizeof_v t)
            0
            l
        | sizeof_s (A.MarkedTypedef(a)) = sizeof_s (Mark.data a)

      fun offset_s id (A.Typedef(id')) =
        let
          val shit = Symbol.look' defs id'
          fun eat (A.Struct(l)) = l
            | eat (A.MarkedTypedef(a)) = eat (Mark.data a)
          fun offset_s' ((id1,t)::l') curofs =
            let
              val a = align t curofs
            in
              if Symbol.compare(id,id1) = EQUAL
                then a
              else offset_s' l' (a + sizeof_v t)
            end
            | offset_s' nil _ = raise ErrorMsg.InternalError "looking for offset of something that isn't in the structure"
        in
          offset_s' (eat shit) 0
        end
        | offset_s _ _ = raise ErrorMsg.InternalError "cannot find offset into non-typedef"
      
      fun type_s id (A.Typedef id') =
        let
          val td = 
            case AU.Typedef.data (Symbol.look' defs id')
            of A.Struct d => d
             | _ => raise ErrorMsg.InternalError "data didn't return struct"
          fun type_s' ((id',t)::l) =
            if (Symbol.compare (id, id') = EQUAL)
            then t
            else type_s' l
            | type_s' nil = raise ErrorMsg.InternalError "struct member not found in type_s"
        in
          type_s' td
        end
        | type_s id _ = raise ErrorMsg.InternalError "cannot find internal type non-typedef"
      
      fun deref (A.Pointer i) = i
        | deref (A.Array i) = i
        | deref _ = raise ErrorMsg.InternalError "cannot deref non-pointer"

      fun trans_unop A.NEGATIVE = T.NEG
        | trans_unop A.BITNOT = T.BITNOT
        | trans_unop A.BANG = T.BANG
        | trans_unop _ = raise ErrorMsg.InternalError "expected AST unop, got AST binop"
      
      fun typeof' vartypes exp = TypeChecker.typeof (defs, funcs) vartypes NONE exp

      fun trans_exp env vartypes (A.Var(id)) =
        (* after type-checking, id must be declared; do not guard lookup *)
            T.TEMP (Symbol.look' env id)
        | trans_exp env vartypes (A.ConstExp c) = T.CONST(c)
        | trans_exp env vartypes (A.OpExp(oper, [e1, e2])) =
            T.BINOP(trans_oper oper, trans_exp env vartypes e1, trans_exp env vartypes e2)
        | trans_exp env vartypes (A.OpExp(oper, [e])) =
            T.UNOP(trans_unop oper, trans_exp env vartypes e)
        | trans_exp env vartypes (A.OpExp(oper, _)) =
            raise ErrorMsg.InternalError "expected one or two operands, got it in the oven"
        | trans_exp env vartypes (A.Marked(marked_exp)) =
            trans_exp env vartypes (Mark.data marked_exp)
        | trans_exp env vartypes (A.FuncCall(func, stms)) =
            T.CALL(func,
              List.map
                (fn exp => (trans_exp env vartypes exp, AU.Type.size (typeof' vartypes exp)))
                stms,
              AU.Type.size (AU.Function.returntype (Symbol.look' funcs func)) )
        | trans_exp env vartypes (A.Member (exp, id)) =
            let
              val apk = T.BINOP (T.ADD, trans_exp env vartypes exp, T.CONST (Word32.fromInt (offset_s id (typeof' vartypes exp))))
            in
	      if (AU.Type.issmall (type_s id (typeof' vartypes exp)))
	      then T.MEMORY(apk)
	      else apk
	    end
        | trans_exp env vartypes (A.DerefMember (exp, id)) =
            trans_exp env vartypes (A.Member (A.Dereference (exp), id))
        | trans_exp env vartypes (A.Dereference(exp)) =
            if (AU.Type.issmall (deref (typeof' vartypes exp)))
            then T.MEMORY(trans_exp env vartypes exp)
            else trans_exp env vartypes exp
        | trans_exp env vartypes (A.ArrIndex(exp1, exp2)) =
            let
              val asubk = T.BINOP(T.ADD, trans_exp env vartypes exp1, 
                                  T.BINOP(T.MUL, trans_exp env vartypes exp2,
                                          T.CONST(Word32.fromInt(sizeof_v (deref (typeof' vartypes exp1))))))
            in
              if (AU.Type.issmall (deref (typeof' vartypes exp1)))
              then T.MEMORY(asubk)
              else asubk
            end
        | trans_exp env vartypes (A.New(tipo)) =
            T.ALLOC(T.CONST (Word32.fromInt(sizeof_v tipo)))
        | trans_exp env vartypes (A.NewArr(tipo, exp)) =
            T.ALLOC(T.BINOP(T.MUL, trans_exp env vartypes exp, T.CONST(Word32.fromInt(sizeof_v tipo))))
        | trans_exp env vartypes (A.Null) = T.CONST(0w0)

        (* anything else should be impossible *)

      (* trans_stms : Temp.temp Symbol.table -> (Label.label * Label.label) option -> A.stm list -> Tree.stm list
       * translates a statement to the corresponding IR
       * we pass around the environment and the current loop context, if any
       * (usually called ls, which contains a continue label and a break label)
       *)
      fun trans_stms vars vartypes ls (A.Assign(e1,e2)::stms) = T.MOVE(trans_exp vars vartypes e1, trans_exp vars vartypes e2, AU.Type.size (typeof' vartypes e2))::(trans_stms vars vartypes ls stms)
        | trans_stms vars vartypes ls (A.AsnOp(oop,e1,e2)::stms) =
          let
            val te1 = trans_exp vars vartypes e1
            val te2 = trans_exp vars vartypes e2
            val t1 = T.TEMP (Temp.new "memory deref cache" 8)
            val size = AU.Type.size (typeof' vartypes e2)
          in
            case te1
            of T.MEMORY(m) => T.MOVE(t1, m, 8) :: T.MOVE (T.MEMORY(t1), T.BINOP(trans_oper oop, T.MEMORY(t1), te2), size) :: (trans_stms vars vartypes ls stms)
             | _ => T.MOVE(te1, T.BINOP(trans_oper oop, te1, te2), size) :: (trans_stms vars vartypes ls stms)
          end
        | trans_stms vars vartypes ls (A.Return e::stms) =
          let
            val remainder = trans_stms vars vartypes ls stms
          in 
            T.RETURN (trans_exp vars vartypes e, AU.Type.size (typeof' vartypes e))
            :: remainder
          end
        | trans_stms vars vartypes ls (A.If(e, s, NONE)::stms) =
          let
            val l = Label.new ()
            val strans = trans_stms vars vartypes ls s
            val remainder = trans_stms vars vartypes ls stms
          in
            (T.JUMPIFN(trans_exp vars vartypes e, l)
            :: strans
            @ [T.LABEL (l)]
            @ remainder)
          end
        | trans_stms vars vartypes ls (A.If(e, s, SOME s2)::stms) =
          let
            val l = Label.new ()
            val l2 = Label.new ()
            val s1trans = trans_stms vars vartypes ls s
            val s2trans = trans_stms vars vartypes ls s2
            val remainder = trans_stms vars vartypes ls stms
          in
            (T.JUMPIFN(trans_exp vars vartypes e, l)
            :: s1trans
            @ [T.JUMP (l2), T.LABEL (l)]
            @ s2trans
            @ [T.LABEL (l2)]
            @ remainder)
          end
        | trans_stms vars vartypes ls (A.For(s1, e, s2, s)::stms) = 
          let
            val head = Label.new ()
            val tail = Label.new ()
            val loop = Label.new ()
            val stm1 = if isSome s1 then trans_stms vars vartypes NONE [valOf s1] else nil
            val strans = trans_stms vars vartypes (SOME(loop,tail)) s
            val stm2 = if isSome s2 then trans_stms vars vartypes NONE [valOf s2] else nil
            val remainder = trans_stms vars vartypes ls stms
          in
            (stm1
            @ [T.LABEL head, T.JUMPIFN(trans_exp vars vartypes e, tail)]
            @ strans
            @ [T.LABEL loop]
            @ stm2
            @ [T.JUMP head, T.LABEL tail]
            @ remainder)
          end
        | trans_stms vars vartypes ls (A.While(e, s)::stms) =
          let
            val head = Label.new ()
            val tail = Label.new ()
            val strans = trans_stms vars vartypes (SOME(head,tail)) s
            val remainder = trans_stms vars vartypes ls stms
          in
            (T.LABEL head
            :: T.JUMPIFN(trans_exp vars vartypes e, tail)
            :: strans
            @ [T.JUMP head, T.LABEL tail]
            @ remainder)
          end
        | trans_stms vars vartypes ls (A.Effect(e)::stms) = (T.EFFECT (trans_exp vars vartypes e, AU.Type.size (typeof' vartypes e))) :: (trans_stms vars vartypes ls stms)
        | trans_stms vars vartypes (SOME(b,e)) (A.Break::stms) =
          let
            val remainder = trans_stms vars vartypes (SOME(b,e)) stms
          in
            ((T.JUMP e) :: remainder)
          end
        | trans_stms vars vartypes  NONE       (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker"
        | trans_stms vars vartypes (SOME(b,e)) (A.Continue::stms) =
          let
            val remainder = trans_stms vars vartypes (SOME(b,e)) stms
          in
            ((T.JUMP b) :: remainder)
          end
        | trans_stms vars vartypes  NONE       (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker"
        | trans_stms vars vartypes ls (A.Nop::stms) = trans_stms vars vartypes ls stms
        | trans_stms vars vartypes ls (A.MarkedStm m :: stms) = trans_stms vars vartypes ls ((Mark.data m) :: stms)
        | trans_stms vars vartypes _ nil = nil

      fun trans_funcs ((id, A.Extern(_, _))::l) = trans_funcs l
        | trans_funcs ((id, A.MarkedFunction a)::l) = trans_funcs ((id, Mark.data a)::l)
        | trans_funcs ((id, A.Function(t, args, vars, body))::l) =
            let
              val allvars = foldr
                              (fn ((name, t),b) =>
                                Symbol.bind b (name, Temp.new (Symbol.name(name)) (AU.Type.size t)))
                              Symbol.empty
                              (args @ vars)
              val vartypes = foldr (fn ((i, t), b) => Symbol.bind b (i, t)) Symbol.empty (args @ vars)
              val b = trans_stms allvars vartypes NONE body
              val (argn,_) = ListPair.unzip args
              val numberedargs = ListPair.zip (List.tabulate (length argn, fn x => x), argn)
              val argmv = map
                (fn (n, argname) => T.MOVE(T.TEMP (Symbol.look' allvars argname), T.ARG (n, Temp.size (Symbol.look' allvars argname)), Temp.size (Symbol.look' allvars argname)))
                numberedargs
            in
              (T.FUNCTION(id, argmv @ b)) :: (trans_funcs l)
            end
        | trans_funcs nil = nil

    in
      trans_funcs funclist
    end
end
Commit	Line	Data
6ade8b0a	1	(* L3 Compiler
12aa4087 JW	2	* AST -> IR Translator
	3	* Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
	4	* Modified by: Alex Vaynberg <alv@andrew.cmu.edu>
	5	* Modified: Frank Pfenning <fp@cs.cmu.edu>
0a24e44d JW	6	* Modified: Chris Lu <czl@andrew.cmu.edu>
0a24e44d JW	7	* Modified: Joshua Wise <jwise@andrew.cmu.edu>
12aa4087 JW	8	*)
	9
	10	signature TRANS =
	11	sig
	12	(* translate abstract syntax tree to IR tree *)
6ade8b0a	13	val translate : Ast.program -> Tree.func list
12aa4087 JW	14	end
	15
	16	structure Trans :> TRANS =
	17	struct
	18
	19	structure A = Ast
1144856b	20	structure AU = AstUtils
12aa4087	21	structure T = Tree
0a24e44d	22
12aa4087 JW	23	fun trans_oper A.PLUS = T.ADD
	24	\| trans_oper A.MINUS = T.SUB
	25	\| trans_oper A.TIMES = T.MUL
	26	\| trans_oper A.DIVIDEDBY = T.DIV
	27	\| trans_oper A.MODULO = T.MOD
0a24e44d JW	28	\| trans_oper A.LSH = T.LSH
	29	\| trans_oper A.RSH = T.RSH
	30	\| trans_oper A.LOGOR = T.LOGOR
	31	\| trans_oper A.LOGAND = T.LOGAND
	32	\| trans_oper A.BITOR = T.BITOR
	33	\| trans_oper A.BITXOR = T.BITXOR
	34	\| trans_oper A.BITAND = T.BITAND
	35	\| trans_oper A.NEQ = T.NEQ
	36	\| trans_oper A.EQ = T.EQ
	37	\| trans_oper A.LT = T.LT
	38	\| trans_oper A.LE = T.LE
	39	\| trans_oper A.GE = T.GE
	40	\| trans_oper A.GT = T.GT
	41	\| trans_oper _ = raise ErrorMsg.InternalError "expected AST binop, got AST unop"
12aa4087	42
1144856b	43	fun translate (defs, funcs) =
6ade8b0a	44	let
1144856b JW	45	val funclist = Symbol.elemsi funcs
	46
	47	val alignments = ref Symbol.empty (* Ref for memoization. *)
	48	fun alignment A.Int = 4
	49	\| alignment (A.Typedef(id)) =
	50	(case Symbol.look (!alignments) id
	51	of NONE =>
	52	let
	53	val r = alignment_s (Symbol.look' defs id)
	54	val _ = (alignments := (Symbol.bind (!alignments) (id, r)))
	55	in
	56	r
	57	end
	58	\| SOME r => r)
	59	\| alignment (A.Pointer(_)) = 8
	60	\| alignment (A.Array(_)) = 8
	61	\| alignment (A.TNull) = raise ErrorMsg.InternalError "alignmentof TNull?"
	62	and alignment_s (A.Struct(members)) =
	63	foldl
	64	(fn ((_,t),al) => Int.max (al, alignment t))
	65	1
	66	members
	67	\| alignment_s (A.MarkedTypedef(a)) = alignment_s (Mark.data a)
	68
	69	fun align t curpos =
	70	let
	71	val al = alignment t
	72	in
	73	if (curpos mod al) = 0
	74	then curpos
	75	else curpos + al - (curpos mod al)
	76	end
	77
	78	val sizes = ref Symbol.empty
	79	fun sizeof_v A.Int = 4
	80	\| sizeof_v (A.Typedef(id)) =
	81	(case Symbol.look (!sizes) id
	82	of NONE =>
	83	let
	84	val r = sizeof_s (Symbol.look' defs id)
	85	val _ = (sizes := (Symbol.bind (!sizes) (id, r)))
	86	in
	87	r
	88	end
	89	\| SOME r => r)
	90	\| sizeof_v (A.Pointer(_)) = 8
	91	\| sizeof_v (A.Array(_)) = 8
	92	\| sizeof_v (A.TNull) = raise ErrorMsg.InternalError "sizeof TNull?"
	93	and sizeof_s (A.Struct(l)) =
	94	foldl
	95	(fn ((_,t),curpos) => align t curpos + sizeof_v t)
	96	0
	97	l
	98	\| sizeof_s (A.MarkedTypedef(a)) = sizeof_s (Mark.data a)
	99
	100	fun offset_s id (A.Typedef(id')) =
	101	let
	102	val shit = Symbol.look' defs id'
	103	fun eat (A.Struct(l)) = l
	104	\| eat (A.MarkedTypedef(a)) = eat (Mark.data a)
	105	fun offset_s' ((id1,t)::l') curofs =
	106	let
	107	val a = align t curofs
	108	in
109	if Symbol.compare(id,id1) = EQUAL
110	then a
111	else offset_s' l' (a + sizeof_v t)
112	end
113	\| offset_s' nil _ = raise ErrorMsg.InternalError "looking for offset of something that isn't in the structure"
114	in
115	offset_s' (eat shit) 0
116	end
117	\| offset_s _ _ = raise ErrorMsg.InternalError "cannot find offset into non-typedef"
118
119	fun type_s id (A.Typedef id') =
120	let
121	val td =
122	case AU.Typedef.data (Symbol.look' defs id')
123	of A.Struct d => d
124	\| _ => raise ErrorMsg.InternalError "data didn't return struct"
125	fun type_s' ((id',t)::l) =
126	if (Symbol.compare (id, id') = EQUAL)
127	then t
128	else type_s' l
129	\| type_s' nil = raise ErrorMsg.InternalError "struct member not found in type_s"
130	in
131	type_s' td
132	end
133	\| type_s id _ = raise ErrorMsg.InternalError "cannot find internal type non-typedef"
134
135	fun deref (A.Pointer i) = i
136	\| deref (A.Array i) = i
137	\| deref _ = raise ErrorMsg.InternalError "cannot deref non-pointer"
6ade8b0a JW	138
	139	fun trans_unop A.NEGATIVE = T.NEG
	140	\| trans_unop A.BITNOT = T.BITNOT
	141	\| trans_unop A.BANG = T.BANG
	142	\| trans_unop _ = raise ErrorMsg.InternalError "expected AST unop, got AST binop"
1144856b JW	143
1144856b JW	144	fun typeof' vartypes exp = TypeChecker.typeof (defs, funcs) vartypes NONE exp
6ade8b0a	145
1144856b	146	fun trans_exp env vartypes (A.Var(id)) =
6ade8b0a JW	147	(* after type-checking, id must be declared; do not guard lookup *)
6ade8b0a JW	148	T.TEMP (Symbol.look' env id)
1144856b JW	149	\| trans_exp env vartypes (A.ConstExp c) = T.CONST(c)
	150	\| trans_exp env vartypes (A.OpExp(oper, [e1, e2])) =
	151	T.BINOP(trans_oper oper, trans_exp env vartypes e1, trans_exp env vartypes e2)
	152	\| trans_exp env vartypes (A.OpExp(oper, [e])) =
	153	T.UNOP(trans_unop oper, trans_exp env vartypes e)
	154	\| trans_exp env vartypes (A.OpExp(oper, _)) =
6ade8b0a	155	raise ErrorMsg.InternalError "expected one or two operands, got it in the oven"
1144856b JW	156	\| trans_exp env vartypes (A.Marked(marked_exp)) =
	157	trans_exp env vartypes (Mark.data marked_exp)
	158	\| trans_exp env vartypes (A.FuncCall(func, stms)) =
	159	T.CALL(func,
	160	List.map
	161	(fn exp => (trans_exp env vartypes exp, AU.Type.size (typeof' vartypes exp)))
	162	stms,
	163	AU.Type.size (AU.Function.returntype (Symbol.look' funcs func)) )
	164	\| trans_exp env vartypes (A.Member (exp, id)) =
	165	let
	166	val apk = T.BINOP (T.ADD, trans_exp env vartypes exp, T.CONST (Word32.fromInt (offset_s id (typeof' vartypes exp))))
	167	in
	168	if (AU.Type.issmall (type_s id (typeof' vartypes exp)))
	169	then T.MEMORY(apk)
	170	else apk
	171	end
	172	\| trans_exp env vartypes (A.DerefMember (exp, id)) =
	173	trans_exp env vartypes (A.Member (A.Dereference (exp), id))
	174	\| trans_exp env vartypes (A.Dereference(exp)) =
	175	if (AU.Type.issmall (deref (typeof' vartypes exp)))
	176	then T.MEMORY(trans_exp env vartypes exp)
	177	else trans_exp env vartypes exp
	178	\| trans_exp env vartypes (A.ArrIndex(exp1, exp2)) =
	179	let
	180	val asubk = T.BINOP(T.ADD, trans_exp env vartypes exp1,
	181	T.BINOP(T.MUL, trans_exp env vartypes exp2,
	182	T.CONST(Word32.fromInt(sizeof_v (deref (typeof' vartypes exp1))))))
	183	in
	184	if (AU.Type.issmall (deref (typeof' vartypes exp1)))
	185	then T.MEMORY(asubk)
	186	else asubk
	187	end
	188	\| trans_exp env vartypes (A.New(tipo)) =
	189	T.ALLOC(T.CONST (Word32.fromInt(sizeof_v tipo)))
	190	\| trans_exp env vartypes (A.NewArr(tipo, exp)) =
	191	T.ALLOC(T.BINOP(T.MUL, trans_exp env vartypes exp, T.CONST(Word32.fromInt(sizeof_v tipo))))
	192	\| trans_exp env vartypes (A.Null) = T.CONST(0w0)
12aa4087	193
6ade8b0a JW	194	(* anything else should be impossible *)
	195
	196	(* trans_stms : Temp.temp Symbol.table -> (Label.label * Label.label) option -> A.stm list -> Tree.stm list
	197	* translates a statement to the corresponding IR
	198	* we pass around the environment and the current loop context, if any
	199	* (usually called ls, which contains a continue label and a break label)
	200	*)
1144856b JW	201	fun trans_stms vars vartypes ls (A.Assign(e1,e2)::stms) = T.MOVE(trans_exp vars vartypes e1, trans_exp vars vartypes e2, AU.Type.size (typeof' vartypes e2))::(trans_stms vars vartypes ls stms)
1144856b JW	202	\| trans_stms vars vartypes ls (A.AsnOp(oop,e1,e2)::stms) =
6ade8b0a	203	let
1144856b JW	204	val te1 = trans_exp vars vartypes e1
	205	val te2 = trans_exp vars vartypes e2
	206	val t1 = T.TEMP (Temp.new "memory deref cache" 8)
	207	val size = AU.Type.size (typeof' vartypes e2)
6ade8b0a	208	in
1144856b JW	209	case te1
	210	of T.MEMORY(m) => T.MOVE(t1, m, 8) :: T.MOVE (T.MEMORY(t1), T.BINOP(trans_oper oop, T.MEMORY(t1), te2), size) :: (trans_stms vars vartypes ls stms)
	211	\| _ => T.MOVE(te1, T.BINOP(trans_oper oop, te1, te2), size) :: (trans_stms vars vartypes ls stms)
6ade8b0a	212	end
1144856b	213	\| trans_stms vars vartypes ls (A.Return e::stms) =
6ade8b0a	214	let
1144856b	215	val remainder = trans_stms vars vartypes ls stms
6ade8b0a	216	in
1144856b	217	T.RETURN (trans_exp vars vartypes e, AU.Type.size (typeof' vartypes e))
6ade8b0a JW	218	:: remainder
6ade8b0a JW	219	end
1144856b	220	\| trans_stms vars vartypes ls (A.If(e, s, NONE)::stms) =
6ade8b0a JW	221	let
6ade8b0a JW	222	val l = Label.new ()
1144856b JW	223	val strans = trans_stms vars vartypes ls s
1144856b JW	224	val remainder = trans_stms vars vartypes ls stms
6ade8b0a	225	in
1144856b	226	(T.JUMPIFN(trans_exp vars vartypes e, l)
0a24e44d JW	227	:: strans
0a24e44d JW	228	@ [T.LABEL (l)]
6ade8b0a JW	229	@ remainder)
6ade8b0a JW	230	end
1144856b	231	\| trans_stms vars vartypes ls (A.If(e, s, SOME s2)::stms) =
6ade8b0a JW	232	let
6ade8b0a JW	233	val l = Label.new ()
0a24e44d	234	val l2 = Label.new ()
1144856b JW	235	val s1trans = trans_stms vars vartypes ls s
	236	val s2trans = trans_stms vars vartypes ls s2
	237	val remainder = trans_stms vars vartypes ls stms
6ade8b0a	238	in
1144856b	239	(T.JUMPIFN(trans_exp vars vartypes e, l)
0a24e44d JW	240	:: s1trans
	241	@ [T.JUMP (l2), T.LABEL (l)]
	242	@ s2trans
	243	@ [T.LABEL (l2)]
6ade8b0a JW	244	@ remainder)
6ade8b0a JW	245	end
1144856b	246	\| trans_stms vars vartypes ls (A.For(s1, e, s2, s)::stms) =
6ade8b0a JW	247	let
	248	val head = Label.new ()
	249	val tail = Label.new ()
	250	val loop = Label.new ()
1144856b JW	251	val stm1 = if isSome s1 then trans_stms vars vartypes NONE [valOf s1] else nil
	252	val strans = trans_stms vars vartypes (SOME(loop,tail)) s
	253	val stm2 = if isSome s2 then trans_stms vars vartypes NONE [valOf s2] else nil
	254	val remainder = trans_stms vars vartypes ls stms
6ade8b0a JW	255	in
6ade8b0a JW	256	(stm1
1144856b	257	@ [T.LABEL head, T.JUMPIFN(trans_exp vars vartypes e, tail)]
6ade8b0a JW	258	@ strans
	259	@ [T.LABEL loop]
	260	@ stm2
	261	@ [T.JUMP head, T.LABEL tail]
	262	@ remainder)
	263	end
1144856b	264	\| trans_stms vars vartypes ls (A.While(e, s)::stms) =
6ade8b0a JW	265	let
	266	val head = Label.new ()
	267	val tail = Label.new ()
1144856b JW	268	val strans = trans_stms vars vartypes (SOME(head,tail)) s
1144856b JW	269	val remainder = trans_stms vars vartypes ls stms
6ade8b0a JW	270	in
6ade8b0a JW	271	(T.LABEL head
1144856b	272	:: T.JUMPIFN(trans_exp vars vartypes e, tail)
6ade8b0a JW	273	:: strans
	274	@ [T.JUMP head, T.LABEL tail]
	275	@ remainder)
	276	end
1144856b JW	277	\| trans_stms vars vartypes ls (A.Effect(e)::stms) = (T.EFFECT (trans_exp vars vartypes e, AU.Type.size (typeof' vartypes e))) :: (trans_stms vars vartypes ls stms)
1144856b JW	278	\| trans_stms vars vartypes (SOME(b,e)) (A.Break::stms) =
6ade8b0a	279	let
1144856b	280	val remainder = trans_stms vars vartypes (SOME(b,e)) stms
6ade8b0a JW	281	in
	282	((T.JUMP e) :: remainder)
	283	end
1144856b JW	284	\| trans_stms vars vartypes NONE (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker"
1144856b JW	285	\| trans_stms vars vartypes (SOME(b,e)) (A.Continue::stms) =
6ade8b0a	286	let
1144856b	287	val remainder = trans_stms vars vartypes (SOME(b,e)) stms
6ade8b0a JW	288	in
	289	((T.JUMP b) :: remainder)
	290	end
1144856b JW	291	\| trans_stms vars vartypes NONE (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker"
	292	\| trans_stms vars vartypes ls (A.Nop::stms) = trans_stms vars vartypes ls stms
	293	\| trans_stms vars vartypes ls (A.MarkedStm m :: stms) = trans_stms vars vartypes ls ((Mark.data m) :: stms)
	294	\| trans_stms vars vartypes _ nil = nil
12aa4087	295
1144856b JW	296	fun trans_funcs ((id, A.Extern(_, _))::l) = trans_funcs l
	297	\| trans_funcs ((id, A.MarkedFunction a)::l) = trans_funcs ((id, Mark.data a)::l)
	298	\| trans_funcs ((id, A.Function(t, args, vars, body))::l) =
6ade8b0a	299	let
1144856b JW	300	val allvars = foldr
	301	(fn ((name, t),b) =>
	302	Symbol.bind b (name, Temp.new (Symbol.name(name)) (AU.Type.size t)))
	303	Symbol.empty
	304	(args @ vars)
	305	val vartypes = foldr (fn ((i, t), b) => Symbol.bind b (i, t)) Symbol.empty (args @ vars)
	306	val b = trans_stms allvars vartypes NONE body
6ade8b0a JW	307	val (argn,_) = ListPair.unzip args
	308	val numberedargs = ListPair.zip (List.tabulate (length argn, fn x => x), argn)
	309	val argmv = map
1144856b	310	(fn (n, argname) => T.MOVE(T.TEMP (Symbol.look' allvars argname), T.ARG (n, Temp.size (Symbol.look' allvars argname)), Temp.size (Symbol.look' allvars argname)))
6ade8b0a JW	311	numberedargs
	312	in
	313	(T.FUNCTION(id, argmv @ b)) :: (trans_funcs l)
	314	end
	315	\| trans_funcs nil = nil
1144856b	316
6ade8b0a	317	in
1144856b	318	trans_funcs funclist
6ade8b0a	319	end
12aa4087	320	end