Fix some primitive: return callback result, not element
List.find returns the element that matched, but SX some should return
the callback's truthy return value. This caused get-verb-info to return
"get" (the verb string) instead of the {method, url} dict.
Also added _active_vm tracking to VM for future HO primitive optimization,
and reverted get-verb-info to use some (no longer needs for-each workaround).
Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -731,8 +731,12 @@ let () =
|
||||
register "some" (fun args ->
|
||||
match args with
|
||||
| [f; (List items | ListRef { contents = items })] ->
|
||||
(try List.find (fun x -> sx_truthy (call_any f [x])) items
|
||||
with Not_found -> Bool false)
|
||||
let rec find = function
|
||||
| [] -> Bool false
|
||||
| x :: rest ->
|
||||
let result = call_any f [x] in
|
||||
if sx_truthy result then result else find rest
|
||||
in find items
|
||||
| [_; Nil] -> Bool false
|
||||
| _ -> raise (Eval_error "some: expected (fn list)"));
|
||||
register "every?" (fun args ->
|
||||
|
||||
@@ -41,6 +41,13 @@ let jit_failed_sentinel = {
|
||||
|
||||
let is_jit_failed cl = cl.vm_code.vc_arity = -1
|
||||
|
||||
(** Current active VM — allows HO primitives (map, filter, for-each, some)
|
||||
to call VmClosure callbacks on the same VM instead of creating a new one.
|
||||
This is critical: creating a new VM per callback loses the calling VM's
|
||||
stack/frame context, causing upvalue-captured host objects to become
|
||||
inaccessible. *)
|
||||
let _active_vm : vm option ref = ref None
|
||||
|
||||
let create globals =
|
||||
{ stack = Array.make 4096 Nil; sp = 0; frames = []; globals }
|
||||
|
||||
@@ -125,11 +132,20 @@ let code_from_value v =
|
||||
Used for entry points: JIT Lambda calls, module execution, cross-boundary. *)
|
||||
let rec call_closure cl args globals =
|
||||
incr _vm_call_count;
|
||||
let prev_vm = !_active_vm in
|
||||
let vm = create globals in
|
||||
_active_vm := Some vm;
|
||||
push_closure_frame vm cl args;
|
||||
(try run vm with e -> raise e);
|
||||
(try run vm with e -> _active_vm := prev_vm; raise e);
|
||||
_active_vm := prev_vm;
|
||||
pop vm
|
||||
|
||||
(** Call a VmClosure on the active VM if one exists, otherwise create a new one.
|
||||
This is the path used by HO primitives (map, filter, for-each, some) so
|
||||
callbacks can access upvalues that reference the calling VM's state. *)
|
||||
and call_closure_reuse cl args =
|
||||
call_closure cl args cl.vm_env_ref
|
||||
|
||||
(** Call a value as a function — dispatch by type.
|
||||
VmClosure: pushes frame on current VM (fast intra-VM path).
|
||||
Lambda: tries JIT then falls back to CEK.
|
||||
@@ -629,4 +645,4 @@ let jit_compile_lambda (l : lambda) globals =
|
||||
(* Wire up forward references *)
|
||||
let () = jit_compile_ref := jit_compile_lambda
|
||||
let () = _vm_call_closure_ref := (fun cl args ->
|
||||
call_closure cl args cl.vm_env_ref)
|
||||
call_closure_reuse cl args)
|
||||
|
||||
Reference in New Issue
Block a user