#!/usr/bin/env node // Repro: letrec sibling bindings nil after perform/resume in browser kernel // // Bug: After a CEK IO suspension (perform / hs-wait) resumes in the // WASM browser kernel, calling a sibling letrec binding could return // nil, with the error surfaced as `[sx] resume: Not callable: nil`. // // Root cause: cek-run / cek_run_iterative raised // `"IO suspension in non-IO context"` when a tree-walked eval_expr // (sf_letrec init exprs / non-last body, macro body, qq unquote, scope // body, provide body, dynamic-wind) hit a perform. The CEK suspension // was created correctly but never propagated through the OCaml-side // _cek_io_suspend_hook, so the outer driver never saw VmSuspended. // // Fix: cek_run / cek_run_iterative now invoke _cek_io_suspend_hook on // suspension (raising VmSuspended for the outer driver). When the hook // is unset (pure-CEK harness), they fall back to the legacy error. // // This test exercises the WASM kernel through K.callFn — the path that // browser event handlers use. Suspension surfaces as a JS object with // {suspended, request, resume(result)} that the test drives synchronously. // // Companion: spec/tests/test-letrec-resume-treewalk.sx tests the // CEK-only path through the OCaml test runner. const path = require('path'); const fs = require('fs'); const KERNEL = path.join(__dirname, '..', '_build', 'default', 'browser', 'sx_browser.bc.js'); if (!fs.existsSync(KERNEL)) { console.error('FATAL: missing ' + KERNEL + ' — run `dune build` from hosts/ocaml first'); process.exit(2); } require(KERNEL); const K = globalThis.SxKernel; let passed = 0, failed = 0; const failures = []; function test(name, fn) { try { const r = fn(); if (r === true) { passed++; console.log(' PASS: ' + name); } else { failed++; failures.push({ name, error: 'got ' + JSON.stringify(r) }); console.log(' FAIL: ' + name + ' — got ' + JSON.stringify(r)); } } catch (e) { failed++; failures.push({ name, error: e.message || String(e) }); console.log(' FAIL: ' + name + ' — ' + (e.message || e)); } } function driveSync(result) { while (result && typeof result === 'object' && result.suspended) { result = result.resume(null); } return result; } function callExpr(src) { K.eval('(define _t-fn (fn () ' + src + '))'); const fn = K.eval('_t-fn'); return driveSync(K.callFn(fn, [])); } console.log('\n=== letrec + perform/resume regression tests ===\n'); test('basic letrec without perform', () => callExpr('(letrec ((f (fn () "ok"))) (f))') === 'ok'); test('callFn perform suspends and resumes with nil', () => { K.eval('(define _t-perform (fn () (perform {:op "io"})))'); let r = K.callFn(K.eval('_t-perform'), []); if (!r || !r.suspended) return 'no suspension: ' + JSON.stringify(r); return r.resume(null) === null; }); test('letrec, single binding, perform/resume', () => callExpr('(letrec ((f (fn () (perform {:op "io"})))) (f))') === null); test('letrec, 2 bindings, body calls sibling after suspended call', () => callExpr(` (letrec ((wait-then (fn () (do (perform {:op "io"}) "wait-done"))) (other-fn (fn () "other-result"))) (do (wait-then) (other-fn)))`) === 'other-result'); test('letrec, suspending fn calls sibling after own perform', () => callExpr(` (letrec ((wait-and-call (fn () (do (perform {:op "io"}) (other-fn)))) (other-fn (fn () "from-sibling"))) (wait-and-call))`) === 'from-sibling'); test('letrec, fn references sibling value after perform/resume', () => callExpr(` (letrec ((shared "shared-state") (do-fn (fn () (do (perform {:op "io"}) shared)))) (do-fn))`) === 'shared-state'); test('letrec, recursive self-call after perform (wait-boot pattern)', () => { K.eval('(define _wb-c 0)'); K.eval('(set! _wb-c 0)'); return callExpr(` (letrec ((wait-boot (fn () (do (perform {:op "io"}) (if (>= _wb-c 1) "done" (do (set! _wb-c (+ 1 _wb-c)) (wait-boot))))))) (wait-boot))`) === 'done'; }); test('top-level define + perform + sibling call after resume', () => { K.eval('(define do-suspend-x (fn () (do (perform {:op "io"}) (do-other-x))))'); K.eval('(define do-other-x (fn () "ok-from-other"))'); return callExpr('(do-suspend-x)') === 'ok-from-other'; }); test('letrec, two performs (sequential) then sibling call', () => callExpr(` (letrec ((wait-twice (fn () (do (perform {:op "io1"}) (perform {:op "io2"}) (other)))) (other (fn () "after-double"))) (wait-twice))`) === 'after-double'); // === Tree-walk paths that previously raised "IO suspension in non-IO context" === test('letrec init expr with perform — suspension propagates (no error)', () => { let r; try { r = callExpr('(letrec ((x (perform {:op "io"}))) "ok")'); } catch (e) { return 'threw: ' + e.message; } return r === null || r === 'ok'; }); test('letrec non-last body with perform — suspension propagates (no error)', () => { let r; try { r = callExpr('(letrec ((x 1)) (perform {:op "io"}) "after")'); } catch (e) { return 'threw: ' + e.message; } return r === null || r === 'after'; }); test('macro body with perform — suspension propagates', () => { K.eval('(defmacro _m1 (form) (do (perform {:op "io"}) form))'); let r; try { r = callExpr('(_m1 "macro-ok")'); } catch (e) { return 'threw: ' + e.message; } return r === 'macro-ok' || r === null; }); test('quasiquote unquote with perform — suspension propagates', () => { let r; try { r = callExpr('(let ((y "yyy")) `(a ,(do (perform {:op "io"}) y) c))'); } catch (e) { return 'threw: ' + e.message; } return r !== undefined; }); console.log('\n--- Results ---'); console.log('passed: ' + passed); console.log('failed: ' + failed); if (failed > 0) { console.log('\nFailures:'); failures.forEach(f => console.log(' - ' + f.name + ': ' + f.error)); process.exit(1); } process.exit(0);