From 8dd3eaa1d95a0d40c9bb43e283b8dd7deb6300ac Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 19 Mar 2026 22:48:26 +0000 Subject: [PATCH] =?UTF-8?q?CALL=5FPRIM:=20primitives=20first,=20then=20glo?= =?UTF-8?q?bals=20=E2=80=94=20VM=20for-each=20works!?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/lib/sx_vm.ml | 23 ++++++++++++++++++----- 1 file changed, 18 insertions(+), 5 deletions(-) diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index 6d0cc39..2d1635f 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -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). *)