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:
@@ -983,7 +983,15 @@ let cek_run_iterative state =
|
||||
s := cek_step !s
|
||||
done;
|
||||
(match cek_suspended_p !s with
|
||||
| Bool true -> raise (Eval_error "IO suspension in non-IO context")
|
||||
| Bool true ->
|
||||
(* Propagate IO suspension so the outer handler
|
||||
(value_to_js wrapper or _cek_eval_lambda_ref) can drive it.
|
||||
Without this, perform inside nested eval_expr contexts
|
||||
(e.g. event handler → trampoline → eval_expr) gets swallowed.
|
||||
Use _cek_io_suspend_hook if set; otherwise fall back to error. *)
|
||||
(match !Sx_types._cek_io_suspend_hook with
|
||||
| Some hook -> hook !s
|
||||
| None -> raise (Eval_error "IO suspension in non-IO context"))
|
||||
| _ -> cek_value !s)
|
||||
with Eval_error msg ->
|
||||
_last_error_kont_ref := cek_kont !s;
|
||||
|
||||
@@ -252,6 +252,12 @@ exception CekPerformRequest of value
|
||||
Used by the HTTP server to handle perform (text-measure) during aser. *)
|
||||
let _cek_io_resolver : (value -> value -> value) option ref = ref None
|
||||
|
||||
(** Hook: handle CEK IO suspension in eval_expr (cek_run_iterative).
|
||||
When set, called with the suspended CEK state instead of raising
|
||||
"IO suspension in non-IO context". Used by the browser WASM kernel
|
||||
to convert CEK suspensions to VmSuspended for _driveAsync handling. *)
|
||||
let _cek_io_suspend_hook : (value -> value) option ref = ref None
|
||||
|
||||
(** Hook: convert VM suspension exceptions to CekPerformRequest.
|
||||
Set by sx_vm after it defines VmSuspended. Called by sx_runtime.sx_apply_cek. *)
|
||||
let _convert_vm_suspension : (exn -> unit) ref = ref (fun _ -> ())
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user