From 6ca1afb735a1b5619d833d6082f0191ff777e3da Mon Sep 17 00:00:00 2001
From: Siraaj Khandkar <siraaj@khandkar.net>
Date: Fri, 28 Sep 2018 10:41:36 -0400
Subject: [PATCH] Begin translation module

---
 compiler/src/lib/tiger/tiger_semant.ml     |  4 +-
 compiler/src/lib/tiger/tiger_translate.ml  | 48 +++++++++++++++++++++-
 compiler/src/lib/tiger/tiger_translate.mli | 11 ++++-
 3 files changed, 59 insertions(+), 4 deletions(-)

diff --git a/compiler/src/lib/tiger/tiger_semant.ml b/compiler/src/lib/tiger/tiger_semant.ml
index f809509..ad46207 100644
--- a/compiler/src/lib/tiger/tiger_semant.ml
+++ b/compiler/src/lib/tiger/tiger_semant.ml
@@ -54,7 +54,7 @@ end = struct
     | Type.Array _ ->
         ty
 
-  let return ty     = {exp = (); ty}
+  let return ty     = {exp = Translate.dummy__FIXME; ty}
   let return_unit   = return Type.Unit
   let return_nil    = return Type.Nil
   let return_int    = return Type.Int
@@ -325,7 +325,7 @@ end = struct
     | A.VarDec {name; typ=typ_opt; init; pos=pos_outter; escape=_} ->
         let ty =
           (match (typ_opt, transExp ~env init) with
-          | None, {ty; exp=()} ->
+          | None, {ty; exp=_} ->
               ty
           | Some (sym, pos_inner), expty_init ->
               let ty = env_get_typ_actual ~sym ~env ~pos:pos_inner in
diff --git a/compiler/src/lib/tiger/tiger_translate.ml b/compiler/src/lib/tiger/tiger_translate.ml
index f07ec68..483335a 100644
--- a/compiler/src/lib/tiger/tiger_translate.ml
+++ b/compiler/src/lib/tiger/tiger_translate.ml
@@ -2,6 +2,7 @@ module List = ListLabels
 
 module Frame = Tiger_frame
 module Temp  = Tiger_temp
+module T     = Tiger_tree
 
 module Level = struct
   type t =
@@ -36,7 +37,13 @@ module Level = struct
     frame
 end
 
-type exp = unit
+type gen_stm =
+  (Tiger_temp.Label.t * Tiger_temp.Label.t) -> Tiger_tree.stm
+
+type exp =
+  | Ex of Tiger_tree.exp
+  | Nx of Tiger_tree.stm
+  | Cx of gen_stm
 
 type access =
   (* must know about static links *)
@@ -54,3 +61,42 @@ let formals ~level =
   List.map (Level.formals level) ~f:(fun escapes ->
     alloc_local ~level ~escapes
   )
+
+let rec seq = function
+  (* TODO: Is appending 0 OK? How else can the empty case be handled? *)
+  | []      -> T.EXP (T.CONST 0)
+  | s :: ss -> T.SEQ (s, seq ss)
+
+let cond_stm gen_stm =
+  let t = Temp.Label.gen () in
+  let f = Temp.Label.gen () in
+  let r = Temp.Temp.gen () in
+  let stms =
+    [ T.MOVE (T.TEMP r, T.CONST 1)
+    ; gen_stm (t, f)
+    ; T.LABEL f
+    ; T.MOVE (T.TEMP r, T.CONST 0)
+    ; T.LABEL t
+    ]
+  in
+  (seq stms, T.TEMP r)
+
+let unEx = function
+  | Ex exp -> exp
+  | Nx stm -> T.ESEQ (stm, T.CONST 0)
+  | Cx gen ->
+      let stm, exp = cond_stm gen in
+      T.ESEQ (stm, exp)
+
+let unNx = function
+  | Ex exp -> T.EXP exp
+  | Nx stm -> stm
+  | Cx gen -> fst (cond_stm gen)
+
+let unCx = function
+  (* "should never occur in compiling a well typed Tiger program" p.154 *)
+  | Nx _ -> assert false
+  | Ex e -> fun (_, _) -> T.EXP e  (* TODO: Is this right? *)
+  | Cx g -> g
+
+let dummy__FIXME = Ex (T.CONST 0)
diff --git a/compiler/src/lib/tiger/tiger_translate.mli b/compiler/src/lib/tiger/tiger_translate.mli
index 9fd1146..ca4b0b2 100644
--- a/compiler/src/lib/tiger/tiger_translate.mli
+++ b/compiler/src/lib/tiger/tiger_translate.mli
@@ -8,10 +8,19 @@ module Level : sig
   (** "newLevel" in Appel's code *)
 end
 
-type exp = unit
+type gen_stm =
+  (Tiger_temp.Label.t * Tiger_temp.Label.t) -> Tiger_tree.stm
+
+type exp
 
 type access
 
 val alloc_local : level:Level.t -> escapes:bool -> access
 
 val formals : level:Level.t -> access list
+
+val unEx : exp -> Tiger_tree.exp
+val unNx : exp -> Tiger_tree.stm
+val unCx : exp -> gen_stm
+
+val dummy__FIXME : exp  (* FIXME: Remove dummy when real is ready *)
-- 
2.20.1