coop/rose-ash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix vm-global-get in native OCaml VM + transpiled VM ref

Browse Source 
The previous commit fixed lib/vm.sx (SX spec) but the server uses
sx_vm.ml (hand-maintained native OCaml) and sx_vm_ref.ml (transpiled).
Both had the same globals-first lookup bug. Now all three implementations
check closure env before vm.globals, matching vm-global-set.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-04-06 12:14:30 +00:00
parent 3a9d113537
commit 577d09f443
3 changed files with 34 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files

33
hosts/ocaml/lib/sx_vm_ref.ml
View File

@@ -198,32 +198,31 @@ let vm_globals_ref v = let m = unwrap_vm v in Dict m.vm_globals
let vm_global_get vm_val frame_val name =
let m = unwrap_vm vm_val in
let n = value_to_string name in
(* Try globals table first *)
match Hashtbl.find_opt m.vm_globals n with
let f = unwrap_frame frame_val in
(* Check closure env first (matches vm_global_set priority) *)
let found_in_env = match f.vf_closure.vm_closure_env with
| Some env ->
let id = intern n in
let rec find_env e =
match Hashtbl.find_opt e.bindings id with
| Some v -> Some v
| None -> (match e.parent with Some p -> find_env p | None -> None)
in find_env env
| None -> None
in
match found_in_env with
| Some v -> v
| None ->
(* Walk closure env chain *)
let f = unwrap_frame frame_val in
let not_found () =
(* Try evaluator's primitive table *)
match Hashtbl.find_opt m.vm_globals n with
| Some v -> v
| None ->
try prim_call n [] with _ ->
(* Try symbol resolve hook — transparent lazy module loading *)
match !_symbol_resolve_hook with
| Some hook ->
(match hook n with
| Some v -> v
| None -> raise (Eval_error ("VM undefined: " ^ n)))
| None -> raise (Eval_error ("VM undefined: " ^ n))
in
(match f.vf_closure.vm_closure_env with
| Some env ->
let id = intern n in
let rec find_env e =
match Hashtbl.find_opt e.bindings id with
| Some v -> v
| None -> (match e.parent with Some p -> find_env p | None -> not_found ())
in find_env env
| None -> not_found ())
let vm_global_set vm_val frame_val name v =
let m = unwrap_vm vm_val in