IO suspension: _cek_io_suspend_hook propagates perform through eval_expr

Root cause: cek_run_iterative (used by eval_expr/trampoline) raised
"IO suspension in non-IO context" when the CEK hit a perform. This
blocked IO suspension from propagating through nested eval_expr calls
(event handler → trampoline → eval_expr → for-each callback → hs-wait).

Fix: added _cek_io_suspend_hook (Sx_types) that converts CEK suspension
to VmSuspended, set by sx_vm.ml at init. cek_run_iterative now calls the
hook instead of erroring. The VmSuspended propagates to the value_to_js
wrapper which has _driveAsync handling.

+42 test passes (3924→3966), zero regressions.

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
2026-04-16 16:34:56 +00:00
parent 133edd4c5e
commit b86d0b7e15
3 changed files with 26 additions and 1 deletions

View File

@@ -1020,6 +1020,17 @@ let () = _vm_suspension_to_dict := (fun exn ->
| _ -> Nil));
Some (Dict d)
| _ -> None)
(* Hook: when eval_expr (cek_run_iterative) encounters a CEK suspension,
convert it to VmSuspended so it propagates to the outer handler
(value_to_js wrapper, _driveAsync, etc.). Without this, perform
inside nested eval_expr calls (event handler → trampoline → eval_expr)
gets swallowed as "IO suspension in non-IO context". *)
let () = _cek_io_suspend_hook := Some (fun suspended_state ->
let request = Sx_ref.cek_io_request suspended_state in
let vm = create (Hashtbl.create 0) in
vm.pending_cek <- Some suspended_state;
raise (VmSuspended (request, vm)))
let () = _cek_eval_lambda_ref := (fun f args ->
let state = Sx_ref.continue_with_call f (List args) (Env (make_env ())) (List args) (List []) in
let final = Sx_ref.cek_step_loop state in