trans/trans.sml

   1 (* L3 Compiler
   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>
   6  * Modified: Chris Lu <czl@andrew.cmu.edu>
   7  * Modified: Joshua Wise <jwise@andrew.cmu.edu>
   8  *)
   9
  10 signature TRANS =
  11 sig
  12   (* translate abstract syntax tree to IR tree *)
  13   val translate : Ast.program -> Tree.func list
  14 end
  15
  16 structure Trans :> TRANS =
  17 struct
  18
  19   structure A = Ast
  20   structure T = Tree
  21
  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
  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"
  41
  42   fun translate p =
  43     let
  44       val allfuncs = foldr (fn (A.Extern(_),b) => b
  45                              | (A.Function(_, id, _, _, _), b) => Symbol.bind b (id, () ))
  46                            Symbol.empty p
  47
  48       fun trans_unop A.NEGATIVE = T.NEG
  49         | trans_unop A.BITNOT = T.BITNOT
  50         | trans_unop A.BANG = T.BANG
  51         | trans_unop _ = raise ErrorMsg.InternalError "expected AST unop, got AST binop"
  52
  53       fun trans_exp env (A.Var(id)) =
  54         (* after type-checking, id must be declared; do not guard lookup *)
  55             T.TEMP (Symbol.look' env id)
  56         | trans_exp env (A.ConstExp c) = T.CONST(c)
  57         | trans_exp env (A.OpExp(oper, [e1, e2])) =
  58             T.BINOP(trans_oper oper, trans_exp env e1, trans_exp env e2)
  59         | trans_exp env (A.OpExp(oper, [e])) =
  60             T.UNOP(trans_unop oper, trans_exp env e)
  61         | trans_exp env (A.OpExp(oper, _)) =
  62             raise ErrorMsg.InternalError "expected one or two operands, got it in the oven"
  63         | trans_exp env (A.Marked(marked_exp)) =
  64             trans_exp env (Mark.data marked_exp)
  65         | trans_exp env (A.FuncCall(func, stms)) =
  66             T.CALL(func, List.map (trans_exp env) stms)
  67
  68         (* anything else should be impossible *)
  69
  70       (* trans_stms : Temp.temp Symbol.table -> (Label.label * Label.label) option -> A.stm list -> Tree.stm list
  71        * translates a statement to the corresponding IR
  72        * we pass around the environment and the current loop context, if any
  73        * (usually called ls, which contains a continue label and a break label)
  74        *)
  75       fun trans_stms vars ls (A.Assign(id,e)::stms) =
  76           let
  77             val t = Symbol.look' vars id handle Option => raise ErrorMsg.InternalError "Undeclared variable, should have been caught in typechecker..."
  78             val remainder = trans_stms vars ls stms
  79           in
  80             T.MOVE(T.TEMP(t), trans_exp vars e)
  81             :: remainder
  82           end
  83         | trans_stms vars ls (A.Return e::stms) =
  84           let
  85             val remainder = trans_stms vars ls stms
  86           in
  87             T.RETURN (trans_exp vars e)
  88             :: remainder
  89           end
  90
  91         | trans_stms vars ls (A.If(e, s, NONE)::stms) =
  92           let
  93             val l = Label.new ()
  94             val strans = trans_stms vars ls s
  95             val remainder = trans_stms vars ls stms
  96           in
  97             (T.JUMPIFN(trans_exp vars e, l)
  98             :: strans
  99             @ [T.LABEL (l)]
 100             @ remainder)
 101           end
 102         | trans_stms vars ls (A.If(e, s, SOME s2)::stms) =
 103           let
 104             val l = Label.new ()
 105             val l2 = Label.new ()
 106             val s1trans = trans_stms vars ls s
 107             val s2trans = trans_stms vars ls s2
 108             val remainder = trans_stms vars ls stms
 109           in
 110             (T.JUMPIFN(trans_exp vars e, l)
 111             :: s1trans
 112             @ [T.JUMP (l2), T.LABEL (l)]
 113             @ s2trans
 114             @ [T.LABEL (l2)]
 115             @ remainder)
 116           end
 117         | trans_stms vars ls (A.For(s1, e, s2, s)::stms) =
 118           let
 119             val head = Label.new ()
 120             val tail = Label.new ()
 121             val loop = Label.new ()
 122             val stm1 = if isSome s1 then trans_stms vars NONE [valOf s1] else nil
 123             val strans = trans_stms vars (SOME(loop,tail)) s
 124             val stm2 = if isSome s2 then trans_stms vars NONE [valOf s2] else nil
 125             val remainder = trans_stms vars ls stms
 126           in
 127             (stm1
 128             @ [T.LABEL head, T.JUMPIFN(trans_exp vars e, tail)]
 129             @ strans
 130             @ [T.LABEL loop]
 131             @ stm2
 132             @ [T.JUMP head, T.LABEL tail]
 133             @ remainder)
 134           end
 135         | trans_stms vars ls (A.While(e, s)::stms) =
 136           let
 137             val head = Label.new ()
 138             val tail = Label.new ()
 139             val strans = trans_stms vars (SOME(head,tail)) s
 140             val remainder = trans_stms vars ls stms
 141           in
 142             (T.LABEL head
 143             :: T.JUMPIFN(trans_exp vars e, tail)
 144             :: strans
 145             @ [T.JUMP head, T.LABEL tail]
 146             @ remainder)
 147           end
 148
 149         | trans_stms vars (SOME(b,e)) (A.Break::stms) =
 150           let
 151             val remainder = trans_stms vars (SOME(b,e)) stms
 152           in
 153             ((T.JUMP e) :: remainder)
 154           end
 155         | trans_stms vars  NONE       (A.Break::_) = raise ErrorMsg.InternalError "Break from invalid location... should have been caught in typechecker"
 156         | trans_stms vars (SOME(b,e)) (A.Continue::stms) =
 157           let
 158             val remainder = trans_stms vars (SOME(b,e)) stms
 159           in
 160             ((T.JUMP b) :: remainder)
 161           end
 162         | trans_stms vars  NONE       (A.Continue::_) = raise ErrorMsg.InternalError "Continue from invalid location... should have been caught in typechecker"
 163         | trans_stms vars ls (A.Nop::stms) = trans_stms vars ls stms
 164         | trans_stms vars ls (A.MarkedStm m :: stms) = trans_stms vars ls ((Mark.data m) :: stms)
 165         | trans_stms vars _ nil = nil
 166
 167       fun trans_funcs (A.Extern(t, id, varl)::l) = trans_funcs l
 168         | trans_funcs (A.Function(t, id, args, vars, body)::l) =
 169             let
 170               val (a,_) = ListPair.unzip (args @ vars)
 171               val allvars = foldr (fn (a,b) => Symbol.bind b (a, Temp.new(Symbol.name(a)))) Symbol.empty a
 172               val b = trans_stms allvars NONE body
 173               val (argn,_) = ListPair.unzip args
 174               val numberedargs = ListPair.zip (List.tabulate (length argn, fn x => x), argn)
 175               val argmv = map
 176                 (fn (n, argname) => T.MOVE(T.TEMP (Symbol.look' allvars argname), T.ARG n))
 177                 numberedargs
 178             in
 179               (T.FUNCTION(id, argmv @ b)) :: (trans_funcs l)
 180             end
 181         | trans_funcs nil = nil
 182     in
 183       trans_funcs p
 184     end
 185
 186 end