[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.program
end

structure Trans :> TRANS = 
struct

  structure A = Ast
  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 _ = Type.alignment_reset()
      val _ = Type.sizeof_reset()
      fun sizeof a = Type.sizeof defs a
      fun alignment a = Type.alignment defs a
      fun align t curpos = Type.align defs t curpos

      fun offset_s id (Type.Typedef(id')) =
        let
          val shit = Symbol.look' defs id'
          fun eat (Type.Struct(l)) = l
            | eat (Type.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 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 (Type.Typedef id') =
        let
          val td = 
            case Type.defdata (Symbol.look' defs id')
            of Type.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 (Type.Pointer i) = i
        | deref (Type.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, Temp.sts (Type.size (typeof' vartypes exp))))
                stms,
              Temp.sts (Type.size (AstUtils.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))))
              val tipo = type_s id (typeof' vartypes exp)
            in
	      if Type.issmall tipo
	      then T.MEMORY(apk, Temp.sts (Type.size tipo))
	      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 (Type.issmall (deref (typeof' vartypes exp)))
            then T.MEMORY(trans_exp env vartypes exp, Temp.sts (Type.size (deref (typeof' 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 (deref (typeof' vartypes exp1))))))
              val tipo = deref (typeof' vartypes exp1)
              val d =
                if not (Flag.isset Flags.safe)
                then asubk
                else T.COND (T.BINOP
                              (T.BE,
                               T.MEMORY (T.BINOP (
                                 T.SUB,
                                 trans_exp env vartypes exp1, 
                                 T.CONST 0w8), Temp.Long),
                               trans_exp env vartypes exp2),
                             T.NULLPTR,
                             asubk)
            in
              if Type.issmall tipo
              then T.MEMORY(d, Temp.sts (Type.size tipo))
              else d
            end
        | trans_exp env vartypes (A.New(tipo)) =
            let
              val t1 = T.TEMP (Temp.new "result" Temp.Quad)
            in
              T.STMVAR (
                [T.MOVE (t1, T.ALLOC (T.CONST (Word32.fromInt(sizeof tipo)))),
                 T.EFFECT (T.MEMORY (t1, Temp.Long))],
                t1)
            end
        | trans_exp env vartypes (A.NewArr(tipo, exp)) =
            let
              val size = T.BINOP(T.MUL, trans_exp env vartypes exp, T.CONST(Word32.fromInt(sizeof tipo)))
              val t1 = T.TEMP (Temp.new "allocated address" Temp.Quad)
              val ts = T.TEMP (Temp.new "size" Temp.Long)
            in
              if not (Flag.isset Flags.safe)
              then T.STMVAR ([T.MOVE (t1, T.ALLOC size),
                              T.EFFECT (T.COND (T.BINOP (T.EQ, trans_exp env vartypes exp, T.CONST 0w0), T.CONST 0w0, T.MEMORY (t1, Temp.Long)))],
                             t1)
              else T.COND (T.BINOP(T.EQ, size, T.CONST 0w0),
                           T.NULLPTR,
                           T.STMVAR (
                             [T.MOVE(t1,
                                T.COND(
                                  T.BINOP(T.LT, size, T.CONST 0w0),
                                  T.NULLPTR,
                                  T.ALLOC (T.BINOP (T.ADD, size, T.CONST 0w8)))
                                ),
                              T.MOVE(T.MEMORY (t1, Temp.Long), trans_exp env vartypes exp)],
                             T.BINOP(T.ADD, t1, T.CONST 0w8)))
            end
        | trans_exp env vartypes (A.Null) = T.NULLPTR
        | trans_exp env vartypes (A.Conditional(c,e1,e2)) = T.COND(trans_exp env vartypes c, trans_exp env vartypes e1, trans_exp env vartypes e2)

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