fix: cek_run propagates IO suspension via _cek_io_suspend_hook
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 1m52s

When a `perform` fired inside a tree-walked eval_expr path — sf_letrec init
exprs / non-last body exprs, expand_macro body, qq_expand unquote,
sf_dynamic_wind / sf_scope / sf_provide bodies — cek_run raised
"IO suspension in non-IO context" and swallowed the suspension. The hook
that converts the CEK suspended state to VmSuspended (so the outer driver
sees it as a resumable suspension object) was defined in sx_vm.ml but
never invoked from cek_run.

Repro in Node.js (hosts/ocaml/browser/test_letrec_resume.js):
  (letrec ((x (perform {:op "io"}))) "ok")           ;; threw the error
  (letrec ((x 1)) (perform {:op "io"}) "after")      ;; threw the error

The originally reported browser symptom — "[sx] resume: Not callable: nil"
after hs-wait resumes inside a letrec — was the same root cause showing
through the JIT/VM resume path instead of as a top-level error.

Fix: cek_run and cek_run_iterative now check !_cek_io_suspend_hook and
invoke it when the loop terminates in a suspended state. The hook (set by
sx_vm.ml in the browser, by run_tests.ml in the test runner) converts the
suspension to VmSuspended / resolves IO synchronously. When the hook is
unset (pure-CEK harness), the legacy Eval_error is raised so misuse stays
visible.

Also patches:
- hosts/ocaml/bootstrap.py — regex-patches the transpiled cek_run on regen
  so the fix survives a fresh `python3 hosts/ocaml/bootstrap.py` cycle.
- hosts/ocaml/browser/sx_browser.ml — api_eval / api_eval_vm / api_eval_expr
  now catch VmSuspended and surface a clean error string (K.eval has no
  driver to resume; callers who want resumption use callFn).

Tests:
- spec/tests/test-letrec-resume-treewalk.sx — 7 CEK-level regression tests
  covering letrec init / non-last body, scope/provide bodies, sibling
  fn-after-perform. All 7 fail in baseline ("IO suspension in non-IO
  context"), all 7 pass with the fix.
- hosts/ocaml/browser/test_letrec_resume.js — 13 WASM kernel tests via
  callFn driveSync, including the wait-boot pattern from the briefing.
  All 13 pass.

Suite results: 4557 pass / 1338 fail (was 4550 / 1339); +7 new passes,
-1 flaky timeout (hs-upstream-if sieve), no regressions.
This commit is contained in:
2026-05-07 10:13:48 +00:00
parent a5044cfc08
commit fc13acb805
5 changed files with 275 additions and 4 deletions

View File

@@ -0,0 +1,61 @@
;; Letrec + perform/resume — tree-walk paths regression
;;
;; Before the fix: cek-run raised "IO suspension in non-IO context" when
;; a perform fired inside any tree-walked eval_expr path:
;; - sf_letrec init exprs / non-last body exprs (the original bug)
;; - sf_dynamic_wind, sf_scope, sf_provide bodies
;; - expand_macro body, qq_expand unquote
;;
;; After the fix: cek-run invokes _cek_io_suspend_hook which (in this test
;; runner) resolves the IO and returns the result, allowing evaluation to
;; complete successfully. End-to-end: the expression returns a value
;; instead of throwing the swallowed-suspension error.
;;
;; The test runner's hook resolves IO requests via resolve_io (mock).
;; In production browser, the hook raises VmSuspended → JS resume callback.
(defsuite
"letrec-resume-treewalk-init"
(deftest
"perform in letrec init expr — evaluates without error"
(let
((result (eval-expr-cek (quote (letrec ((x (perform {:op "request-arg" :args (list "k")}))) (or x "default"))) (make-env))))
(assert (or (string? result) (nil? result)))))
(deftest
"perform in letrec non-last body — evaluates without error"
(let
((result (eval-expr-cek (quote (letrec ((x 42)) (perform {:op "request-arg" :args (list "k")}) (+ x 1))) (make-env))))
(assert= result 43)))
(deftest
"letrec init perform result reachable — no nil sibling"
(let
((result (eval-expr-cek (quote (letrec ((x 99) (y (fn () x))) (perform {:op "request-arg" :args (list "k")}) (y))) (make-env))))
(assert= result 99))))
(defsuite
"letrec-resume-treewalk-bodies"
(deftest
"perform inside scope body — evaluates without error"
(let
((result (eval-expr-cek (quote (scope "test-scope" :value 1 (perform {:op "request-arg" :args (list "k")}) "scope-done")) (make-env))))
(assert= result "scope-done")))
(deftest
"perform inside provide body — evaluates without error"
(let
((result (eval-expr-cek (quote (provide "test-key" 7 (perform {:op "request-arg" :args (list "k")}) "provide-done")) (make-env))))
(assert= result "provide-done"))))
(defsuite
"letrec-resume-treewalk-recursive"
(deftest
"letrec sibling fn called after perform/resume — sibling not nil"
(let
((result (eval-expr-cek (quote (letrec ((sib "from-sibling") (suspending (fn () (do (perform {:op "request-arg" :args (list "k")}) sib)))) (suspending))) (make-env))))
(assert= result "from-sibling")))
(deftest
"letrec — suspending fn calls sibling fn after own perform"
(let
((result (eval-expr-cek (quote (letrec ((wait-and-call (fn () (do (perform {:op "request-arg" :args (list "k")}) (other)))) (other (fn () "called-after-resume"))) (wait-and-call))) (make-env))))
(assert= result "called-after-resume"))))