Begin translation module

[tiger.ml.git] / compiler / src / lib / tiger / tiger_translate.ml

diff --git a/compiler/src/lib/tiger/tiger_translate.ml b/compiler/src/lib/tiger/tiger_translate.ml
index f07ec68..483335a 100644 (file)
--- 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)