- [x] ch 3: Parser
- [x] ch 4: AST
- [x] ch 5: Semantic Analysis (type checking)
+- [x] ch 6: Activation Records
#### In-progress
-- [ ] ch 6: Activation Records
-#### TODO (short-term)
- [ ] ch 7: Translation to Intermediate Code
+#### TODO (short-term)
- [ ] ch 08: Basic Blocks and Traces
- [ ] ch 09: Instruction Selection
- [ ] ch 10: Liveness Analysis
module Map = Tiger_map
module Sym = Tiger_symbol
+module Translate = Tiger_translate
module Type = Tiger_env_type
module Value = Tiger_env_value
{ typs : Type.env
; vals : Value.env
; loop : Sym.t option
+ ; level : Translate.Level.t
}
let base =
{ typs = Type.built_in
; vals = Value.built_in
; loop = None
+ ; level = Translate.Level.init
}
let get_typ {typs; _} k =
let loop_current {loop; _} =
loop
+
+let level_set t level =
+ {t with level}
+
+let level_get {level; _} =
+ level
val loop_begin : t -> (Tiger_symbol.t * t)
val loop_end : t -> Tiger_symbol.t -> t
val loop_current : t -> Tiger_symbol.t option
+
+val level_set : t -> Tiger_translate.Level.t -> t
+val level_get : t -> Tiger_translate.Level.t
module Map = Tiger_map
module Symbol = Tiger_symbol
+module Temp = Tiger_temp
+module Translate = Tiger_translate
module Type = Tiger_env_type
type t =
| Var of
- {ty : Type.t}
+ { access : Tiger_translate.access
+ ; ty : Tiger_env_type.t
+ }
| Fun of
- { formals : Type.t list
- ; result : Type.t
+ { formals : Tiger_env_type.t list
+ ; result : Tiger_env_type.t
+ ; level : Tiger_translate.Level.t
+ ; label : Tiger_temp.Label.t
}
type env =
]
|> List.map ~f:(fun (name, formals, result) ->
let key = Symbol.of_string name in
- let value = Fun {formals; result} in
+ let level = Translate.Level.init in
+ let label = Temp.Label.gen () in
+ let value = Fun {formals; result; level; label} in
(key, value)
)
|> Map.of_list
type t =
| Var of
- {ty : Tiger_env_type.t}
+ { access : Tiger_translate.access
+ ; ty : Tiger_env_type.t
+ }
| Fun of
{ formals : Tiger_env_type.t list
; result : Tiger_env_type.t
+ ; level : Tiger_translate.Level.t
+ ; label : Tiger_temp.Label.t
}
type env =
--- /dev/null
+include Tiger_mips_frame
--- /dev/null
+include Tiger_frame_sig.S
--- /dev/null
+module type S = sig
+ type t
+
+ type access
+
+ val make :
+ name:Tiger_temp.Label.t -> formals:bool list -> t
+
+ val name :
+ t -> Tiger_temp.Label.t
+
+ val formals :
+ t -> access list
+
+ val alloc_local :
+ t -> escapes:bool -> access
+end
--- /dev/null
+module List = ListLabels
+
+module Temp = Tiger_temp
+
+type access =
+ | InFrame of {offset_from_frame_pointer : int}
+ | InReg of {register : Temp.Temp.t}
+
+type t =
+(* p.136 Frame.t is a data structure holding:
+ * - the locations of all the formals
+ * - instructions required to implement the "view shift"
+ * - the number of locals allocated so far
+ * - the `label` at which the function's machine code is to begin (see p.140)
+ * *)
+ { name : Temp.Label.t
+ ; formals : access list
+ ; locals_count : int
+ ; instructions : unit (* TODO: instructions for view shift *)
+ }
+
+let name {name; _} =
+ name
+
+let formals {formals; _} =
+ formals
+
+let alloc offset_from_frame_pointer ~escapes =
+ if escapes then
+ InFrame {offset_from_frame_pointer}
+ else
+ InReg {register = Temp.Temp.gen ()}
+
+let alloc_local _ ~escapes =
+ (* FIXME: offset_from_frame_pointer. With neither mutation nor new frame? *)
+ let offset_from_frame_pointer = 0 in
+ alloc offset_from_frame_pointer ~escapes
+
+let make ~name ~formals =
+ (* p.136: For each formal parameter, "newFrame" must calculate two things:
+ * - How the parameter will be seen from inside the function
+ * (in a register, or in a frame location);
+ * - What instructions must be produced to implement the "view shift"
+ * *)
+ let formals, locals_count =
+ (* TODO: What should offset increment be? Word? *)
+ List.fold_left formals ~init:([], 0) ~f:(fun (formals, offset) escapes ->
+ ((alloc offset ~escapes) :: formals, succ offset)
+ )
+ in
+ { name
+ ; formals
+ ; locals_count
+ ; instructions = () (* TODO: instructions for view shift *)
+ }
--- /dev/null
+include Tiger_frame_sig.S
module Escape = Tiger_semant_escape
module Pos = Tiger_position
module Sym = Tiger_symbol
+module Temp = Tiger_temp
module Translate = Tiger_translate
module Type = Tiger_env_type
module Value = Tiger_env_value
return_string
| A.CallExp {func; args; pos} ->
(match env_get_val ~sym:func ~env ~pos with
- | Value.Fun {formals; result} ->
+ | Value.Fun {formals; result; level=_; label=_} ->
let expected = List.length formals in
let given = List.length args in
if given = expected then
check_int (trexp lo) ~pos;
check_int (trexp hi) ~pos;
let (loop, env) = Env.loop_begin env in
- let env = Env.set_val env var (Value.Var {ty = Type.Int}) in
+ let level = Env.level_get env in
+ (* Assuming all escape, for now *)
+ let access = Translate.alloc_local ~level ~escapes:true in
+ let env = Env.set_val env var (Value.Var {ty = Type.Int; access}) in
(* Only care if an error is raised *)
ignore (transExp ~env body);
ignore (Env.loop_end env loop);
(function
| A.SimpleVar {symbol=sym; pos} ->
(match env_get_val ~sym ~env ~pos with
- | Value.Fun _ -> E.raise (E.Id_is_a_function {id=sym; pos})
- | Value.Var {ty} -> return (actual_ty ~pos ty)
+ | Value.Fun _ ->
+ E.raise (E.Id_is_a_function {id=sym; pos})
+ | Value.Var {ty; access=_} ->
+ return (actual_ty ~pos ty)
)
| A.FieldVar {var; symbol; pos} ->
let {exp=_; ty} = trvar var in
ty
)
in
- Env.set_val env name (Value.Var {ty})
+ let access =
+ Translate.alloc_local
+ ~level:(Env.level_get env)
+ ~escapes:true (* Assuming all escape, for now... *)
+ in
+ Env.set_val env name (Value.Var {ty; access})
| A.TypeDecs typedecs ->
check_cycles typedecs;
let env =
| Some (s, p) -> env_get_typ_actual ~sym:s ~env ~pos:p
| None -> Type.Unit
in
- Env.set_val env name (Value.Fun {formals; result})
+ let label = Temp.Label.gen () in
+ let level =
+ Translate.Level.next
+ (Env.level_get env)
+ ~name:label
+ (* Assuming all escape (for now) *)
+ ~formals:(List.map formals ~f:(fun _ -> true))
+ in
+ let env = Env.level_set env level in
+ Env.set_val env name (Value.Fun {formals; result; level; label})
)
in
List.iter fundecs ~f:(
List.fold_left params ~init:env_with_fun_heads_only ~f:(
fun env (A.Field {name=var_name; escape=_; typ; pos}) ->
let var_ty = env_get_typ_actual ~env ~sym:typ ~pos in
- Env.set_val env var_name (Value.Var {ty = var_ty})
+ let level = Env.level_get env in
+ (* Assuming all escape, for now *)
+ let access = Translate.alloc_local ~level ~escapes:true in
+ Env.set_val
+ env
+ var_name
+ (Value.Var {ty = var_ty; access})
)
in
(* we only care if an exception is raised *)
open Semant
let transProg absyn =
- Escape.find absyn;
+ Escape.find ~prog:absyn;
let {exp = _; ty = _} = transExp absyn ~env:Env.base in
()
--- /dev/null
+open Printf
+
+module Sym = Tiger_symbol
+
+module Counter : sig
+ type t
+
+ val create : unit -> t
+
+ val next : t -> int
+end = struct
+ type t = int ref
+
+ let create () =
+ ref 0
+
+ let next t =
+ incr t;
+ !t
+end
+
+module Temp = struct
+ type t = int
+
+ let t = Counter.create ()
+
+ let gen () =
+ Counter.next t
+
+ let to_string t =
+ sprintf "t%d" t
+end
+
+module Label = struct
+ type t = Sym.t
+
+ let counter = Counter.create ()
+
+ let of_string =
+ Sym.of_string
+
+ let gen () =
+ of_string (sprintf "L%d" (Counter.next counter))
+
+ let to_string =
+ Sym.to_string
+end
--- /dev/null
+(* "We use the word _temporary_ to mean a value that is temporarily held in a
+ * register, and the word _label_ to mean some machine-language location whose
+ * exact address is yet to be determined - just like a label in assembly
+ * language." ch. 6.2, p. 139 *)
+
+(* "temp" is an abstract name of "local variable" *)
+module Temp : sig
+ type t
+
+ val gen : unit -> t
+ (** "newtemp" - new temporary from an infinite set of temps. *)
+
+ val to_string : t -> string
+end
+
+(* "label" is an abstract name for "static memory address" *)
+module Label : sig
+ type t
+
+ val gen : unit -> t
+ (** "newlabel" - new label from an infinite set of labels. *)
+
+ val of_string : string -> t
+ (** "namedlabel" - new label whose assembly-language name is string. *)
+
+ val to_string : t -> string
+end
+module List = ListLabels
+
+module Frame = Tiger_frame
+module Temp = Tiger_temp
+
+module Level = struct
+ type t =
+ { parent : t option
+ ; name : Temp.Label.t
+ ; formals : bool list
+ ; frame : Frame.t
+ }
+
+ let init =
+ let name = Temp.Label.gen () in
+ let formals = [] in
+ { parent = None
+ ; name
+ ; formals
+ ; frame = Frame.make ~name ~formals
+ }
+
+ let next t ~name ~formals =
+ (* Adding the extra parameter for the static link. See p. 142 *)
+ let formals = true :: formals in
+ { parent = Some t
+ ; name
+ ; formals
+ ; frame = Frame.make ~name ~formals
+ }
+
+ let formals = function {formals; _} ->
+ formals
+
+ let frame = function {frame; _} ->
+ frame
+end
+
type exp = unit
+
+type access =
+ (* must know about static links *)
+ { level : Level.t
+ ; frame_access : Frame.access
+ }
+
+let alloc_local ~level ~escapes =
+ { level
+ ; frame_access = Frame.alloc_local (Level.frame level) ~escapes
+ }
+
+let formals ~level =
+ (* FIXME: This seems wrong. Should we call Frame.formals? *)
+ List.map (Level.formals level) ~f:(fun escapes ->
+ alloc_local ~level ~escapes
+ )
+module Level : sig
+ type t
+
+ val init : t
+ (** "outermost" in Applel's code *)
+
+ val next : t -> name:Tiger_temp.Label.t -> formals:bool list -> t
+ (** "newLevel" in Appel's code *)
+end
+
type exp = unit
+
+type access
+
+val alloc_local : level:Level.t -> escapes:bool -> access
+
+val formals : level:Level.t -> access list
home / code / tiger.ml.git / commitdiff
