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
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:
61
spec/tests/test-letrec-resume-treewalk.sx
Normal file
61
spec/tests/test-letrec-resume-treewalk.sx
Normal 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"))))
|
||||
Reference in New Issue
Block a user