X-Git-Url: http://git.joshuawise.com/snipe.git/blobdiff_plain/0a24e44d4e9f82f8d3d83de8e58c83c8cf2868b6..6ade8b0a3251e44b34c6bdbbd9403e36d6fd6231:/trans/trans.sml

diff --git a/trans/trans.sml b/trans/trans.sml
index 57e5faa..80802be 100644
--- a/trans/trans.sml
+++ b/trans/trans.sml
@@ -1,4 +1,4 @@
-(* L2 Compiler
+(* L3 Compiler
  * AST -> IR Translator
  * Author: Kaustuv Chaudhuri <kaustuv+@cs.cmu.edu>
  * Modified by: Alex Vaynberg <alv@andrew.cmu.edu>
@@ -10,7 +10,7 @@
 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 = 
@@ -38,121 +38,149 @@ struct
     | 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