module Frame = Tiger_frame
module Temp = Tiger_temp
+module T = Tiger_tree
module Level = struct
type t =
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 *)
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)