From b86d0b7e15b6b902c94ab39311f42fd7c887b86a Mon Sep 17 00:00:00 2001 From: giles Date: Thu, 16 Apr 2026 16:34:56 +0000 Subject: [PATCH] IO suspension: _cek_io_suspend_hook propagates perform through eval_expr MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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) --- hosts/ocaml/lib/sx_ref.ml | 10 +++++++++- hosts/ocaml/lib/sx_types.ml | 6 ++++++ hosts/ocaml/lib/sx_vm.ml | 11 +++++++++++ 3 files changed, 26 insertions(+), 1 deletion(-) diff --git a/hosts/ocaml/lib/sx_ref.ml b/hosts/ocaml/lib/sx_ref.ml index a2d40733..4a763ef8 100644 --- a/hosts/ocaml/lib/sx_ref.ml +++ b/hosts/ocaml/lib/sx_ref.ml @@ -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; diff --git a/hosts/ocaml/lib/sx_types.ml b/hosts/ocaml/lib/sx_types.ml index 3cf17f52..42c07412 100644 --- a/hosts/ocaml/lib/sx_types.ml +++ b/hosts/ocaml/lib/sx_types.ml @@ -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 _ -> ()) diff --git a/hosts/ocaml/lib/sx_vm.ml b/hosts/ocaml/lib/sx_vm.ml index b7c25403..355d5c57 100644 --- a/hosts/ocaml/lib/sx_vm.ml +++ b/hosts/ocaml/lib/sx_vm.ml @@ -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