-
Notifications
You must be signed in to change notification settings - Fork 21
/
eval.ml
42 lines (40 loc) · 1.54 KB
/
eval.ml
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
open Ground
[%%if ocaml_version >= (5, 2, 0)]
let ident_find_same_heap id (compenv: Instruct.compilation_env) =
match compenv.ce_closure with
| Not_in_closure -> raise Not_found
| In_closure { entries; env_pos } ->
match Ident.find_same id entries with
| Free_variable pos ->
pos - env_pos
| Function _pos ->
(* Recursive functions seem to be unhandled *)
raise Not_found
[%%else]
let ident_find_same_heap id (compenv: Instruct.compilation_env) =
Ident.find_same id compenv.ce_heap
[%%endif]
let value_path scene frame path =
let rec address scene frame path =
let event = frame.Frame.event |> Option.get in
function
| Env.Aident id -> (
if Ident.global id then
let globals = Lazy.force frame.globals in
let pos = Ident.Map.find id globals in
Scene.get_global scene pos
else
try%lwt
let pos = Ident.find_same id event.ev_compenv.ce_stack in
Scene.get_local scene frame (event.ev_stacksize - pos) (* TODO: Why subtracting from ev_stacksize? Not done in Value_scope. get_local already does that. *)
with Not_found ->
let pos = ident_find_same_heap id event.ev_compenv in
Scene.get_environment scene frame pos)
| Env.Adot (root, pos) ->
let%lwt v = address scene frame path root in
assert (Scene.is_block v);
Scene.get_field scene v pos
in
let typenv = Lazy.force frame.Frame.typenv in
let addr = typenv |> Typenv.find_value_address path in
address scene frame path addr