X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/12aa4087bee3e70f170d7457794921de4e385227..6ade8b0a3251e44b34c6bdbbd9403e36d6fd6231:/trans/trans.sml diff --git a/trans/trans.sml b/trans/trans.sml index 8ddf780..80802be 100644 --- a/trans/trans.sml +++ b/trans/trans.sml @@ -1,14 +1,16 @@ -(* L1 Compiler +(* L3 Compiler * AST -> IR Translator * Author: Kaustuv Chaudhuri * Modified by: Alex Vaynberg * Modified: Frank Pfenning + * Modified: Chris Lu + * Modified: Joshua Wise *) signature TRANS = sig (* translate abstract syntax tree to IR tree *) - val translate : Ast.program -> Tree.stm list + val translate : Ast.program -> Tree.func list end structure Trans :> TRANS = @@ -16,39 +18,169 @@ 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.NEGATIVE = T.SUB (* unary to binary! *) - - and trans_exp env (A.Var(id)) = - (* after type-checking, id must be declared; do not guard lookup *) - T.TEMP (Symbol.look' env id) - | trans_exp env (A.ConstExp c) = T.CONST(c) - | trans_exp env (A.OpExp(oper, [e1, e2])) = - T.BINOP(trans_oper oper, trans_exp env e1, trans_exp env e2) - | trans_exp env (A.OpExp(A.NEGATIVE, [e])) = - T.BINOP(trans_oper A.NEGATIVE, T.CONST(Word32Signed.ZERO), trans_exp env e) - | trans_exp env (A.Marked(marked_exp)) = - trans_exp env (Mark.data marked_exp) - (* anything else should be impossible *) - - (* translate the statement *) - (* trans_stms : Temp.temp Symbol.table -> A.stm list -> Tree.stm list *) - fun trans_stms env (A.Assign(id,e)::stms) = - let val t = Temp.new() - val env' = Symbol.bind env (id, t) - in - T.MOVE(T.TEMP(t), trans_exp env e) - :: trans_stms env' stms - end - | trans_stms env (A.Return e::nil) = - (* after type-checking, return must be last statement *) - T.RETURN (trans_exp env e) :: nil - - fun translate p = trans_stms Symbol.empty p + | 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 p = + let + val allfuncs = foldr (fn (A.Extern(_),b) => b + | (A.Function(_, id, _, _, _), b) => Symbol.bind b (id, () )) + Symbol.empty p + + 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 trans_exp env (A.Var(id)) = + (* after type-checking, id must be declared; do not guard lookup *) + T.TEMP (Symbol.look' env id) + | trans_exp env (A.ConstExp c) = T.CONST(c) + | trans_exp env (A.OpExp(oper, [e1, e2])) = + T.BINOP(trans_oper oper, trans_exp env e1, trans_exp env e2) + | trans_exp env (A.OpExp(oper, [e])) = + T.UNOP(trans_unop oper, trans_exp env e) + | trans_exp env (A.OpExp(oper, _)) = + raise ErrorMsg.InternalError "expected one or two operands, got it in the oven" + | trans_exp env (A.Marked(marked_exp)) = + trans_exp env (Mark.data marked_exp) + | trans_exp env (A.FuncCall(func, stms)) = + T.CALL(func, List.map (trans_exp env) stms) + + (* 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 ls (A.Assign(id,e)::stms) = + let + val t = Symbol.look' vars id handle Option => raise ErrorMsg.InternalError "Undeclared variable, should have been caught in typechecker..." + val remainder = trans_stms vars ls stms + in + T.MOVE(T.TEMP(t), trans_exp vars e) + :: remainder + end + | trans_stms vars ls (A.Return e::stms) = + let + val remainder = trans_stms vars ls stms + in + T.RETURN (trans_exp vars e) + :: remainder + end + + | trans_stms vars ls (A.If(e, s, NONE)::stms) = + let + val l = Label.new () + val strans = trans_stms vars ls s + val remainder = trans_stms vars ls stms + in + (T.JUMPIFN(trans_exp vars e, l) + :: strans + @ [T.LABEL (l)] + @ remainder) + end + | trans_stms vars ls (A.If(e, s, SOME s2)::stms) = + let + val l = Label.new () + val l2 = Label.new () + val s1trans = trans_stms vars ls s + val s2trans = trans_stms vars ls s2 + val remainder = trans_stms vars ls stms + in + (T.JUMPIFN(trans_exp vars e, l) + :: s1trans + @ [T.JUMP (l2), T.LABEL (l)] + @ s2trans + @ [T.LABEL (l2)] + @ remainder) + end + | trans_stms vars 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 NONE [valOf s1] else nil + val strans = trans_stms vars (SOME(loop,tail)) s + val stm2 = if isSome s2 then trans_stms vars NONE [valOf s2] else nil + val remainder = trans_stms vars ls stms + in + (stm1 + @ [T.LABEL head, T.JUMPIFN(trans_exp vars e, tail)] + @ strans + @ [T.LABEL loop] + @ stm2 + @ [T.JUMP head, T.LABEL tail] + @ remainder) + end + | trans_stms vars ls (A.While(e, s)::stms) = + let + val head = Label.new () + val tail = Label.new () + val strans = trans_stms vars (SOME(head,tail)) s + val remainder = trans_stms vars ls stms + in + (T.LABEL head + :: T.JUMPIFN(trans_exp vars e, tail) + :: strans + @ [T.JUMP head, T.LABEL tail] + @ remainder) + end + + | trans_stms vars (SOME(b,e)) (A.Break::stms) = + let + val remainder = trans_stms vars (SOME(b,e)) stms + in + ((T.JUMP e) :: remainder) + end + | trans_stms vars NONE (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker" + | trans_stms vars (SOME(b,e)) (A.Continue::stms) = + let + val remainder = trans_stms vars (SOME(b,e)) stms + in + ((T.JUMP b) :: remainder) + end + | trans_stms vars NONE (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker" + | trans_stms vars ls (A.Nop::stms) = trans_stms vars ls stms + | trans_stms vars ls (A.MarkedStm m :: stms) = trans_stms vars ls ((Mark.data m) :: stms) + | trans_stms vars _ nil = nil + + fun trans_funcs (A.Extern(t, id, varl)::l) = trans_funcs l + | trans_funcs (A.Function(t, id, args, vars, body)::l) = + let + val (a,_) = ListPair.unzip (args @ vars) + val allvars = foldr (fn (a,b) => Symbol.bind b (a, Temp.new(Symbol.name(a)))) Symbol.empty a + val b = trans_stms allvars 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)) + numberedargs + in + (T.FUNCTION(id, argmv @ b)) :: (trans_funcs l) + end + | trans_funcs nil = nil + in + trans_funcs p + end end