X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/12aa4087bee3e70f170d7457794921de4e385227..0a24e44d4e9f82f8d3d83de8e58c83c8cf2868b6:/trans/trans.sml diff --git a/trans/trans.sml b/trans/trans.sml index 8ddf780..57e5faa 100644 --- a/trans/trans.sml +++ b/trans/trans.sml @@ -1,8 +1,10 @@ -(* L1 Compiler +(* L2 Compiler * AST -> IR Translator * Author: Kaustuv Chaudhuri * Modified by: Alex Vaynberg * Modified: Frank Pfenning + * Modified: Chris Lu + * Modified: Joshua Wise *) signature TRANS = @@ -16,13 +18,31 @@ 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! *) + | 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" + + and 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" and trans_exp env (A.Var(id)) = (* after type-checking, id must be declared; do not guard lookup *) @@ -30,25 +50,109 @@ struct | 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.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) (* 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() + (* trans_stms : Temp.temp Symbol.table -> (Label.label * Label.label) option -> A.stm list -> (Tree.stm list * Symbol.table) + * 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 env ls (A.Assign(id,e)::stms) = + let val t = Symbol.look' env id handle Option => Temp.new() val env' = Symbol.bind env (id, t) + val (remainder, env') = trans_stms env' ls stms in - T.MOVE(T.TEMP(t), trans_exp env e) - :: trans_stms env' stms + (T.MOVE(T.TEMP(t), trans_exp env e) + :: remainder, env') + end + | trans_stms env ls (A.Return e::stms) = + let val (remainder, env') = trans_stms env ls stms + in + (T.RETURN (trans_exp env e) + :: remainder, env') end - | trans_stms env (A.Return e::nil) = - (* after type-checking, return must be last statement *) - T.RETURN (trans_exp env e) :: nil + + | trans_stms env ls (A.If(e, s, NONE)::stms) = + let val l = Label.new () + val (strans, env') = trans_stms env ls s + val (remainder, env') = trans_stms env' ls stms + in + (T.JUMPIFN(trans_exp env e, l) + :: strans + @ [T.LABEL (l)] + @ remainder, env') + end + | trans_stms env ls (A.If(e, s, SOME s2)::stms) = + let val l = Label.new () + val l2 = Label.new () + val (s1trans, env') = trans_stms env ls s + val (s2trans, env') = trans_stms env' ls s2 + val (remainder, env') = trans_stms env' ls stms + in + (T.JUMPIFN(trans_exp env e, l) + :: s1trans + @ [T.JUMP (l2), T.LABEL (l)] + @ s2trans + @ [T.LABEL (l2)] + @ remainder, env') + end + | trans_stms env ls (A.For(s1, e, s2, s)::stms) = + let + val head = Label.new () + val tail = Label.new () + val loop = Label.new () + val (stm1, env') = if isSome s1 then trans_stms env NONE [valOf s1] else (nil, env) + val (strans, env') = trans_stms env' (SOME(loop,tail)) s + val (stm2, env') = if isSome s2 then trans_stms env' NONE [valOf s2] else (nil, env') + val (remainder, env') = trans_stms env' ls stms + in + (stm1 + @ [T.LABEL head, T.JUMPIFN(trans_exp env' e, tail)] + @ strans + @ [T.LABEL loop] + @ stm2 + @ [T.JUMP head, T.LABEL tail] + @ remainder, env') + end + | trans_stms env ls (A.While(e, s)::stms) = + let + val head = Label.new () + val tail = Label.new () + val (strans, env') = trans_stms env (SOME(head,tail)) s + val (remainder, env') = trans_stms env' ls stms + in + (T.LABEL head + :: T.JUMPIFN(trans_exp env e, tail) + :: strans + @ [T.JUMP head, T.LABEL tail] + @ remainder, env') + end + + | trans_stms env (SOME(b,e)) (A.Break::stms) = + let + val (remainder, env') = trans_stms env (SOME(b,e)) stms + in + ((T.JUMP e) :: remainder, env') + end + | trans_stms env NONE (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker" + | trans_stms env (SOME(b,e)) (A.Continue::stms) = + let + val (remainder, env') = trans_stms env (SOME(b,e)) stms + in + ((T.JUMP b) :: remainder, env') + end + | trans_stms env NONE (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker" + + | trans_stms env ls (A.Nop::stms) = trans_stms env ls stms + | trans_stms env ls (A.MarkedStm m :: stms) = trans_stms env ls ((Mark.data m) :: stms) + | trans_stms env _ nil = (nil, env) - fun translate p = trans_stms Symbol.empty p + fun translate p = let val (trans, _) = trans_stms Symbol.empty NONE p in trans end end