1 module List = ListLabels
3 module Frame = Tiger_frame
4 module Temp = Tiger_temp
16 let name = Temp.Label.gen () in
21 ; frame = Frame.make ~name ~formals
24 let next t ~name ~formals =
25 (* Adding the extra parameter for the static link. See p. 142 *)
26 let formals = true :: formals in
30 ; frame = Frame.make ~name ~formals
33 let formals = function {formals; _} ->
36 let frame = function {frame; _} ->
41 (Tiger_temp.Label.t * Tiger_temp.Label.t) -> Tiger_tree.stm
44 | Ex of Tiger_tree.exp
45 | Nx of Tiger_tree.stm
49 (* must know about static links *)
51 ; access : Frame.access
54 let alloc_local ~level ~escapes =
56 ; access = Frame.alloc_local (Level.frame level) ~escapes
60 (* FIXME: This seems wrong. Should we call Frame.formals? *)
61 List.map (Level.formals level) ~f:(fun escapes ->
62 alloc_local ~level ~escapes
65 let not_implemented func =
66 failwith (Printf.sprintf "Not implemented: %s.%s" __MODULE__ func)
68 let rec seq = function
69 (* TODO: Is appending 0 OK? How else can the empty case be handled? *)
70 | [] -> T.EXP (T.CONST 0)
71 | s :: ss -> T.SEQ (s, seq ss)
73 let cond_stm gen_stm =
74 let t = Temp.Label.gen () in
75 let f = Temp.Label.gen () in
76 let r = Temp.Temp.gen () in
78 [ T.MOVE (T.TEMP r, T.CONST 1)
81 ; T.MOVE (T.TEMP r, T.CONST 0)
89 | Nx stm -> T.ESEQ (stm, T.CONST 0)
91 let stm, exp = cond_stm gen in
97 | Cx gen -> fst (cond_stm gen)
100 (* "should never occur in compiling a well typed Tiger program" p.154 *)
101 | Nx _ -> assert false
102 | Ex e -> fun (_, _) -> T.EXP e (* TODO: Is this right? *)
105 let dummy__FIXME = Ex (T.CONST 0)
107 let simple_var {level; access} =
108 let pointer = not_implemented "simple_var frame pointer" in
109 Ex (Frame.exp ~access ~pointer)