-(* L2 Compiler
+(* L3 Compiler
* AST -> IR Translator
* Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
* Modified by: Alex Vaynberg <alv@andrew.cmu.edu>
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 =
| 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 *)
- 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)
- (* anything else should be impossible *)
+ 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)
- (* 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)
- :: 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
+ (* 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 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)
+ | 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, env')
- end
- | trans_stms env ls (A.If(e, s, SOME s2)::stms) =
- let val l = Label.new ()
+ @ remainder)
+ end
+ | trans_stms vars 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)
+ 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, 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"
+ @ 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 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)
+ | 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 translate p = let val (trans, _) = trans_stms Symbol.empty NONE p in trans end
+ 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
git.joshuawise.com / snipe.git / blobdiff