Lambda→CEK dispatch: enable IO suspension through sx_call

Lambda calls in sx_call now go through the CEK machine instead of
returning a Thunk for the tree-walker trampoline. This lets perform/
IO suspension work everywhere — including hyperscript wait/bounce.

Key changes:
- sx_runtime: Lambda case calls _cek_eval_lambda_ref (forward ref)
- sx_vm: initializes ref with cek_step_loop + stub VM for suspension
- sx_apply_cek: VmSuspended → __vm_suspended marker dict (not exception)
- continue_with_call callable path: handles __vm_suspended with
  vm-resume-frame, matching the existing JIT Lambda pattern
- sx_render: let VmSuspended propagate through try_catch
- Remove invalid io-contract test (perform now suspends, not errors)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>

hosts/ocaml/lib/sx_ref.ml

@@ -572,9 +572,16 @@ and sf_provide args env =
 and expand_macro mac raw_args env =
   (let body = (macro_body (mac)) in (if sx_truthy ((let _and = (symbol_p (body)) in if not (sx_truthy _and) then _and else (prim_call "=" [(symbol_name (body)); (String "__syntax-rules-body__")]))) then (let closure = (macro_closure (mac)) in (syntax_rules_expand ((env_get (closure) ((String "__sr-literals")))) ((env_get (closure) ((String "__sr-rules")))) (raw_args))) else (let local = (env_merge ((macro_closure (mac))) (env)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (if sx_truthy ((prim_call "<" [(nth (pair) ((Number 1.0))); (len (raw_args))])) then (nth (raw_args) ((nth (pair) ((Number 1.0))))) else Nil)))) (sx_to_list (List (List.mapi (fun i p -> let i = Number (float_of_int i) in (List [p; i])) (sx_to_list (macro_params (mac)))))); Nil)) in (let () = ignore ((if sx_truthy ((macro_rest_param (mac))) then (env_bind local (sx_to_string (macro_rest_param (mac))) (prim_call "slice" [raw_args; (len ((macro_params (mac))))])) else Nil)) in (trampoline ((eval_expr ((macro_body (mac))) (local)))))))))
 
-(* cek-step-loop *)
+(* cek-step-loop — also catches CekPerformRequest from VmClosure calls
+   and converts them to proper CEK suspensions with continuation preserved.
+   NOTE: try/with wraps only cek_step, NOT the recursive call — preserving
+   tail recursion (critical for the millions of steps in large evaluations). *)
 and cek_step_loop state =
-  (if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else (cek_step_loop ((cek_step (state)))))
+  (if sx_truthy ((let _or = (cek_terminal_p (state)) in if sx_truthy _or then _or else (cek_suspended_p (state)))) then state else
+    let next = (try cek_step (state)
+      with Sx_types.CekPerformRequest request ->
+        make_cek_suspended request (cek_env state) (cek_kont state))
+    in cek_step_loop next)
 
 (* cek-run *)
 and cek_run state =
@@ -895,7 +902,7 @@ and step_continue state =
 
 (* continue-with-call *)
 and continue_with_call f args env raw_args kont =
-  (if sx_truthy ((parameter_p (f))) then (let uid = (parameter_uid (f)) in let frame = (kont_find_provide (kont) (uid)) in (make_cek_value ((if sx_truthy (frame) then (get (frame) ((String "value"))) else (parameter_default (f)))) (env) (kont))) else (if sx_truthy ((callcc_continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let captured = (callcc_continuation_data (f)) in (make_cek_value (arg) (env) (captured))) else (if sx_truthy ((continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let cont_data = (continuation_data (f)) in (let captured = (get (cont_data) ((String "captured"))) in (let result' = (cek_run ((make_cek_value (arg) (env) (captured)))) in (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_lambda (f)))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_component (f)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_island (f)))))))))) then (let result' = (sx_apply_cek f args) in (if sx_truthy ((Bool (is_eval_error result'))) then (make_cek_value ((get (result') ((String "message")))) (env) ((kont_push ((make_raise_eval_frame (env) ((Bool false)))) (kont)))) else (make_cek_value (result') (env) (kont)))) else (if sx_truthy ((is_lambda (f))) then (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (env)) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((bind_lambda_params (params) (args) (local))))))) then (let () = ignore ((if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else Nil)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil))) else Nil)) in (let jit_result = (jit_try_call (f) (args)) in (if sx_truthy ((jit_skip_p (jit_result))) then (make_cek_state ((lambda_body (f))) (local) (kont)) else (if sx_truthy ((let _and = (dict_p (jit_result)) in if not (sx_truthy _and) then _and else (get (jit_result) ((String "__vm_suspended"))))) then (make_cek_suspended ((get (jit_result) ((String "request")))) (env) ((kont_push ((make_vm_resume_frame ((get (jit_result) ((String "resume")))) (env))) (kont)))) else (make_cek_value (jit_result) (local) (kont))))))) else (if sx_truthy ((let _or = (is_component (f)) in if sx_truthy _or then _or else (is_island (f)))) then (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (f))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (f))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (f))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_cek_state ((component_body (f))) (local) ((kont_push ((make_comp_trace_frame ((component_name (f))) ((component_file (f))))) (kont))))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Not callable: "); (inspect (f))])))))))))))
+  (if sx_truthy ((parameter_p (f))) then (let uid = (parameter_uid (f)) in let frame = (kont_find_provide (kont) (uid)) in (make_cek_value ((if sx_truthy (frame) then (get (frame) ((String "value"))) else (parameter_default (f)))) (env) (kont))) else (if sx_truthy ((callcc_continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let captured = (callcc_continuation_data (f)) in (make_cek_value (arg) (env) (captured))) else (if sx_truthy ((continuation_p (f))) then (let arg = (if sx_truthy ((empty_p (args))) then Nil else (first (args))) in let cont_data = (continuation_data (f)) in (let captured = (get (cont_data) ((String "captured"))) in (let result' = (cek_run ((make_cek_value (arg) (env) (captured)))) in (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((let _and = (is_callable (f)) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_lambda (f)))))) in if not (sx_truthy _and) then _and else (let _and = (Bool (not (sx_truthy ((is_component (f)))))) in if not (sx_truthy _and) then _and else (Bool (not (sx_truthy ((is_island (f)))))))))) then (let result' = (sx_apply_cek f args) in (if sx_truthy ((Bool (is_eval_error result'))) then (make_cek_value ((get (result') ((String "message")))) (env) ((kont_push ((make_raise_eval_frame (env) ((Bool false)))) (kont)))) else (if sx_truthy ((let _and = (dict_p (result')) in if not (sx_truthy _and) then _and else (get (result') ((String "__vm_suspended"))))) then (make_cek_suspended ((get (result') ((String "request")))) (env) ((kont_push ((make_vm_resume_frame ((get (result') ((String "resume")))) (env))) (kont)))) else (make_cek_value (result') (env) (kont))))) else (if sx_truthy ((is_lambda (f))) then (let params = (lambda_params (f)) in let local = (env_merge ((lambda_closure (f))) (env)) in (let () = ignore ((if sx_truthy ((Bool (not (sx_truthy ((bind_lambda_params (params) (args) (local))))))) then (let () = ignore ((if sx_truthy ((prim_call ">" [(len (args)); (len (params))])) then (raise (Eval_error (value_to_str (String (sx_str [(let _or = (lambda_name (f)) in if sx_truthy _or then _or else (String "lambda")); (String " expects "); (len (params)); (String " args, got "); (len (args))]))))) else Nil)) in (let () = ignore ((List.iter (fun pair -> ignore ((env_bind local (sx_to_string (first (pair))) (nth (pair) ((Number 1.0)))))) (sx_to_list (prim_call "zip" [params; args])); Nil)) in (List.iter (fun p -> ignore ((env_bind local (sx_to_string p) Nil))) (sx_to_list (prim_call "slice" [params; (len (args))])); Nil))) else Nil)) in (let jit_result = (jit_try_call (f) (args)) in (if sx_truthy ((jit_skip_p (jit_result))) then (make_cek_state ((lambda_body (f))) (local) (kont)) else (if sx_truthy ((let _and = (dict_p (jit_result)) in if not (sx_truthy _and) then _and else (get (jit_result) ((String "__vm_suspended"))))) then (make_cek_suspended ((get (jit_result) ((String "request")))) (env) ((kont_push ((make_vm_resume_frame ((get (jit_result) ((String "resume")))) (env))) (kont)))) else (make_cek_value (jit_result) (local) (kont))))))) else (if sx_truthy ((let _or = (is_component (f)) in if sx_truthy _or then _or else (is_island (f)))) then (let parsed = (parse_keyword_args (raw_args) (env)) in let kwargs = (first (parsed)) in let children = (nth (parsed) ((Number 1.0))) in let local = (env_merge ((component_closure (f))) (env)) in (let () = ignore ((List.iter (fun p -> ignore ((env_bind local (sx_to_string p) (let _or = (dict_get (kwargs) (p)) in if sx_truthy _or then _or else Nil)))) (sx_to_list (component_params (f))); Nil)) in (let () = ignore ((if sx_truthy ((component_has_children (f))) then (env_bind local (sx_to_string (String "children")) children) else Nil)) in (make_cek_state ((component_body (f))) (local) ((kont_push ((make_comp_trace_frame ((component_name (f))) ((component_file (f))))) (kont))))))) else (raise (Eval_error (value_to_str (String (sx_str [(String "Not callable: "); (inspect (f))])))))))))))
 
 (* sf-case-step-loop *)
 and sf_case_step_loop match_val clauses env kont =

hosts/ocaml/lib/sx_render.ml

@@ -64,6 +64,7 @@ let expand_macro m args_val _env = match m with
 let try_catch try_fn catch_fn =
   try sx_call try_fn []
   with
+  | Sx_vm.VmSuspended _ as e -> raise e
   | Eval_error msg -> sx_call catch_fn [String msg]
   | e -> sx_call catch_fn [String (Printexc.to_string e)]
 

hosts/ocaml/lib/sx_runtime.ml

@@ -44,10 +44,8 @@ let sx_call f args =
   match f with
   | NativeFn (_, fn) -> fn args
   | VmClosure cl -> !Sx_types._vm_call_closure_ref cl args
-  | Lambda l ->
-    let local = Sx_types.env_extend l.l_closure in
-    List.iter2 (fun p a -> ignore (Sx_types.env_bind local p a)) l.l_params args;
-    Thunk (l.l_body, local)
+  | Lambda _ ->
+    !Sx_types._cek_eval_lambda_ref f args
   | Continuation (k, _) ->
     k (match args with x :: _ -> x | [] -> Nil)
   | CallccContinuation _ ->
@@ -75,11 +73,22 @@ let sx_apply_cek f args_list =
   match f with
   | NativeFn _ | VmClosure _ ->
     (try sx_apply f args_list
-     with Eval_error msg ->
-       let d = Hashtbl.create 3 in
-       Hashtbl.replace d "__eval_error__" (Bool true);
-       Hashtbl.replace d "message" (String msg);
-       Dict d)
+     with
+     | CekPerformRequest _ as e -> raise e
+     | exn ->
+       (* Check if this is a VM suspension — return marker dict so
+          continue_with_call can build a proper suspended CEK state
+          with vm-resume-frame on the kont. *)
+       (match !_vm_suspension_to_dict exn with
+        | Some marker -> marker
+        | None ->
+          (match exn with
+           | Eval_error msg ->
+             let d = Hashtbl.create 3 in
+             Hashtbl.replace d "__eval_error__" (Bool true);
+             Hashtbl.replace d "message" (String msg);
+             Dict d
+           | _ -> raise exn)))
   | _ -> sx_apply f args_list
 
 (** Check if a value is an eval-error marker from sx_apply_cek. *)

hosts/ocaml/lib/sx_types.ml

@@ -229,12 +229,34 @@ let _vm_call_closure_ref : (vm_closure -> value list -> value) ref =
 let _cek_call_ref : (value -> value -> value) ref =
   ref (fun _ _ -> raise (Failure "CEK call not initialized"))
 
+(** Forward ref: evaluate a Lambda via CEK (supports perform/suspension).
+    Set by sx_vm.ml to break the sx_runtime → sx_ref dependency cycle. *)
+let _cek_eval_lambda_ref : (value -> value list -> value) ref =
+  ref (fun _ _ -> raise (Failure "CEK eval lambda not initialized"))
+
 
 (** {1 Errors} *)
 
 exception Eval_error of string
 exception Parse_error of string
 
+(** Raised when a VmClosure hits OP_PERFORM inside a CEK evaluation.
+    The CEK step loop catches this and creates a proper io-suspended state
+    with the continuation preserved for resume. Defined here (not in sx_vm)
+    to avoid a dependency cycle between sx_runtime and sx_vm. *)
+exception CekPerformRequest of value
+
+(** 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 _ -> ())
+
+(** Hook: convert VM suspension to a __vm_suspended marker dict.
+    Returns Some(dict) for VmSuspended, None otherwise.
+    The dict has keys: __vm_suspended, request, resume.
+    Used by sx_apply_cek so continue_with_call can build a proper
+    suspended CEK state with vm-resume-frame on the kont. *)
+let _vm_suspension_to_dict : (exn -> value option) ref = ref (fun _ -> None)
+
 
 (** {1 Record type descriptor table} *)
 

hosts/ocaml/lib/sx_vm.ml

@@ -43,6 +43,15 @@ type vm = {
     ip past OP_PERFORM, stack ready for a result push). *)
 exception VmSuspended of value * vm
 
+(* Register the VM suspension converter so sx_runtime.sx_apply_cek can
+   catch VmSuspended and convert it to CekPerformRequest without a
+   direct dependency on this module. *)
+let () = Sx_types._convert_vm_suspension := (fun exn ->
+  match exn with
+  | VmSuspended (request, _vm) -> raise (CekPerformRequest request)
+  | _ -> ())
+
+
 (** Forward reference for JIT compilation — set after definition. *)
 let jit_compile_ref : (lambda -> (string, value) Hashtbl.t -> vm_closure option) ref =
   ref (fun _ _ -> None)
@@ -936,6 +945,27 @@ 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_reuse cl args)
+let () = _vm_suspension_to_dict := (fun exn ->
+  match exn with
+  | VmSuspended (request, vm) ->
+    let d = Hashtbl.create 3 in
+    Hashtbl.replace d "__vm_suspended" (Bool true);
+    Hashtbl.replace d "request" request;
+    Hashtbl.replace d "resume" (NativeFn ("vm-resume", fun args ->
+      match args with [result] -> resume_vm vm result | _ -> Nil));
+    Some (Dict d)
+  | _ -> None)
+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
+  match Sx_runtime.get_val final (String "phase") with
+  | String "io-suspended" ->
+    (* Create a stub VM to carry the suspended CEK state.
+       resume_vm will: cek_resume → push result → run (no-op, no frames) → pop *)
+    let vm = create (Hashtbl.create 0) in
+    vm.pending_cek <- Some final;
+    raise (VmSuspended (Sx_runtime.get_val final (String "request"), vm))
+  | _ -> Sx_ref.cek_value final)
 
 
 (** {1 Debugging / introspection} *)