rose-ash/hosts/ocaml/browser/test_letrec_resume.js

#!/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);