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

CALL_PRIM: primitives first, then globals — VM for-each works!

Browse Source 
Root cause of for-each failure: CALL_PRIM checked globals before
primitives. Globals had ho_via_cek wrappers that routed for-each
through the CEK machine — which couldn't call VM closures correctly.

Fix: check Sx_primitives.get_primitive FIRST (native call_any that
handles NativeFn directly), fall back to globals for env-specific
bindings like set-render-active!.

Result: (for-each (fn (x) (+ x 1)) (list 1 2 3)) on VM → 42 ✓

Full adapter aser chain executing:
  aser → aser-list → aser-call → for-each callback
  Fails at UPVALUE_GET idx=6 (have 6) — compiler upvalue count
  off by one. Next fix: compiler scope analysis.

Also: floor(0)=-1 bug found and fixed (was round(x-0.5), now
uses OCaml's native floor). This was causing all compile failures.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
giles
2026-03-19 22:48:26 +00:00
parent e6663a74ba
commit 8dd3eaa1d9
1 changed files with 18 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
hosts/ocaml/lib/sx_vm.ml
View File

@@ -205,8 +205,13 @@ let rec run vm =
(* Return — don't recurse, let caller continue *)
| 51 (* OP_CLOSURE *) ->
let idx = read_u16 frame in
if idx >= Array.length consts then
raise (Eval_error (Printf.sprintf "VM: CLOSURE idx %d >= consts %d" idx (Array.length consts)));
let code_val = consts.(idx) in
let code = code_from_value code_val in
Printf.eprintf "[vm-closure] idx=%d type=%s bc_len=%d consts=%d sp_before=%d\n%!"
idx (type_of code_val)
(Array.length code.bytecode) (Array.length code.constants) vm.sp;
(* Read upvalue descriptors from bytecode *)
let uv_count = match code_val with
| Dict d -> (match Hashtbl.find_opt d "upvalue-count" with
@@ -246,10 +251,12 @@ let rec run vm =
let args = List.init argc (fun _ -> pop vm) |> List.rev in
let result =
try
(* Check globals first (has env bindings like set-render-active!),
then fall back to registered primitives *)
let fn_val = try Hashtbl.find vm.globals name with Not_found ->
Sx_primitives.get_primitive name
(* Check primitives FIRST (native implementations of map/filter/etc.),
then globals (which may have ho_via_cek wrappers that route
through the CEK — these can't call VM closures). *)
let fn_val = try Sx_primitives.get_primitive name with _ ->
try Hashtbl.find vm.globals name with Not_found ->
raise (Eval_error ("VM: unknown primitive " ^ name))
in
(match fn_val with
| NativeFn (_, fn) -> fn args
@@ -353,7 +360,13 @@ and call_closure cl args globals =
List.iter (fun a -> push vm a) args;
for _ = List.length args to cl.code.locals - 1 do push vm Nil done;
vm.frames <- [frame];
run vm;
(try run vm
with e ->
Printf.eprintf "[vm-call-closure] FAIL in %s: %s (bc_len=%d args=%d sp=%d)\n%!"
(match cl.name with Some n -> n | None -> "?")
(Printexc.to_string e)
(Array.length cl.code.bytecode) (List.length args) vm.sp;
raise e);
pop vm
(** Execute a compiled module (top-level bytecode). *)