narju/

tower.rs

use crate::floor::machine::{drain, Fault, Machine, Store};
use crate::floor::{list, rc_exp, rc_val, Env, Exp, RcExp, Val};

fn sym(s: &str) -> Val {
    Val::Sym(s.into())
}

/// A `clambda` evaluated outside a staged region answers `('cfun . f)`, the tag
/// telling a call site that `f` is compiled rather than primitive. From out here
/// there is nothing to decide, so the wrapper only gets in the way.
fn unwrap_cfun(v: &Val) -> &Val {
    match v {
        Val::Pair(h, t) if matches!(&**h, Val::Sym(s) if s == "cfun") => t,
        _ => v,
    }
}

pub const SOURCE: &str = include_str!("../naj/tower.naj");

/// The library, evaluated by the evaluator rather than compiled beside it.
pub const PRELUDE: &str = include_str!("../naj/prelude.naj");

/// The prompt. An object program and a task like any other: nothing about a
/// REPL needs to be built into the host.
pub const REPL: &str = include_str!("../naj/repl.naj");

/// Resolves `naj.deps` into `naj.lock`. An object program for the same reason
/// the prompt is one: everything it needed was already a capability.
pub const LOCK: &str = include_str!("../naj/lock.naj");

/// A loaded evaluator and the heap it runs in; two towers do not share cells.
/// The interpreter and environment are held here rather than in the evaluator
/// because both accumulate: the prelude pushes a frame onto `env`, and an
/// alteration replaces `m`.
pub struct Tower {
    heap: Store,
    api: Val,
    m: Val,
    env: Val,
}

impl Tower {
    pub fn load() -> Result<Tower, Fault> {
        let exp = match crate::surface::compile(SOURCE).map_err(Fault::Throw)? {
            Val::Code(e) => e,
            other => return Err(Fault::Bug(format!("tower source is not code: {other}"))),
        };
        let mut heap = Store::default();
        let api = Machine::new(Env::default(), exp).run(&mut heap)?;
        let mut t = Tower {
            heap,
            api,
            m: Val::Nil,
            env: Val::Nil,
        };
        t.m = t.get("m")?;
        t.env = t.get("env")?;

        // The prelude is an object program, evaluated by the evaluator just
        // loaded. Its value is a frame, which goes in front of the base one.
        let forms = crate::floor::read::read(PRELUDE).map_err(Fault::Throw)?;
        let src = crate::surface::desugar_body(&forms).map_err(Fault::Throw)?;
        let frame = t.eval(&src)?;
        t.env = Val::Pair(rc_val(frame), rc_val(t.env.clone()));
        Ok(t)
    }

    /// Apply a value from this tower to arguments built outside it. A live value
    /// with no source form rides in as [`Exp::Proc`], the carrier cross-stage
    /// persistence uses.
    pub fn call(&mut self, f: &Val, args: &[Val]) -> Result<Val, Fault> {
        let proc = |v: &Val| rc_exp(Exp::Proc(rc_val(v.clone())));
        let exp = Exp::App(proc(unwrap_cfun(f)), args.iter().map(proc).collect());
        Machine::new(Env::default(), rc_exp(exp)).run(&mut self.heap)
    }

    /// What a module load amounts to, and how a value written outside the
    /// evaluator - an interpreter mutation, say - gets inside it.
    pub fn run_source(&mut self, src: &str) -> Result<Val, Fault> {
        match crate::surface::compile(src).map_err(Fault::Throw)? {
            Val::Code(e) => Machine::new(Env::default(), e).run(&mut self.heap),
            other => Err(Fault::Bug(format!("source is not code: {other}"))),
        }
    }

    /// One entry of the evaluator's export selector.
    pub fn get(&mut self, name: &str) -> Result<Val, Fault> {
        let api = self.api.clone();
        self.call(&api, &[Val::Sym(name.into())])
    }

    pub fn eval(&mut self, prog: &Val) -> Result<Val, Fault> {
        let m = self.m.clone();
        self.eval_under(&m, prog)
    }

    /// The environment is this tower's either way: an alteration changes what
    /// the forms mean, not what is in scope.
    pub fn eval_under(&mut self, m: &Val, prog: &Val) -> Result<Val, Fault> {
        let f = self.get("eval")?;
        let env = self.env.clone();
        self.call(&f, &[m.clone(), env, prog.clone()])
    }

    /// The residual of a program, without running it. Staging leaves its
    /// bindings in the heap's open block and hands back only the variable naming
    /// the result, so closing the block is this caller's job.
    pub fn compile(&mut self, prog: &Val) -> Result<Val, Fault> {
        let m = self.m.clone();
        self.compile_under(&m, prog)
    }

    /// As [`Tower::compile`], but under a given interpreter.
    pub fn compile_under(&mut self, m: &Val, prog: &Val) -> Result<Val, Fault> {
        let f = self.get("compile")?;
        let env = self.env.clone();
        let r = self.call(&f, &[m.clone(), env, prog.clone()])?;
        Ok(self.close(r))
    }

    /// The floor closure a scheduler starts, evaluating `prog` with the task's
    /// own address bound to `self`. Nothing of this tower's heap goes with it,
    /// so the task runs in the heap that spawned it.
    pub fn task(&mut self, prog: &Val) -> Result<Val, Fault> {
        let f = self.get("task")?;
        let m = self.m.clone();
        let env = self.env.clone();
        self.call(&f, &[m, env, prog.clone()])
    }

    /// A file, as the entry point of a task. The forms become the body of a
    /// thunk the prelude's `script` runs once, so a sequence of definitions
    /// ending in an expression still gets the loop an RPC needs. Nothing starts
    /// until a message arrives: the invocation is a message like any other.
    pub fn script(&mut self, forms: &[Val]) -> Result<Val, Fault> {
        let mut thunk = vec![sym("lambda"), sym("run"), Val::Nil];
        thunk.extend_from_slice(forms);
        let whole = list(&[sym("script"), sym("self"), list(&thunk)]);
        let prog = crate::surface::desugar_body(&[whole]).map_err(Fault::Throw)?;
        self.task(&prog)
    }

    /// It reads its lines by calling `('host stdin)`, so what it needs from a
    /// caller is a console to register and one message to start it.
    pub fn repl(&mut self) -> Result<Val, Fault> {
        let forms = crate::floor::read::read(REPL).map_err(Fault::Throw)?;
        let prog = crate::surface::desugar_body(&forms).map_err(Fault::Throw)?;
        self.task(&prog)
    }

    /// A `script` rather than a `task` because it runs once and ends, which is
    /// the shape a file gets and the same message starts it.
    pub fn locker(&mut self) -> Result<Val, Fault> {
        let forms = crate::floor::read::read(LOCK).map_err(Fault::Throw)?;
        self.script(&forms)
    }

    fn close(&mut self, v: Val) -> Val {
        let Val::Code(e) = v else { return v };
        let stmts = std::mem::take(&mut self.heap.block);
        Val::Code(rc_exp(drain(stmts, RcExp::unwrap_or_clone(e))))
    }
}

#[cfg(test)]
mod tests {
    use super::*;
    use crate::floor::host::Str;
    use crate::floor::{list, pair};
    use crate::sched::{addr, Heap};
    use crate::world::host;

    fn prog(text: &str) -> Val {
        let forms = crate::floor::read::read(text).expect("reads");
        crate::surface::desugar_body(&forms).expect("desugars")
    }

    fn run(text: &str) -> Val {
        Tower::load()
            .expect("loads")
            .eval(&prog(text))
            .expect("no fault")
    }

    #[test]
    fn the_evaluator_loads() {
        Tower::load().expect("loads");
    }

    #[test]
    fn an_interpreted_program_computes() {
        assert_eq!(run("(let ((x 3)) (* x (+ x 1)))"), Val::Num(12));
    }

    #[test]
    fn an_object_closure_is_applied_by_recursion() {
        assert_eq!(
            run(
                "(let ((f (lambda fact (n) (if (< n 1) 1 (* n (fact (- n 1)))))))
                   (f 5))"
            ),
            Val::Num(120)
        );
    }

    #[test]
    fn quoted_data_survives_evaluation() {
        assert_eq!(run("(car (cdr '(1 2 3)))"), Val::Num(2));
    }

    #[test]
    fn an_imported_frame_brings_its_names_into_scope() {
        assert_eq!(
            run("(define (arith base)
                   (list (cons 'up (lambda u (n) (+ n base)))
                         (cons 'down (lambda d (n) (- n base)))))
                 (import (arith 10))
                 (down (up 5))"),
            Val::Num(5)
        );
    }

    #[test]
    fn an_import_nests_like_every_other_binding() {
        assert_eq!(
            run("(define x 1)
                 (import (list (cons 'x 2)))
                 (define x 3)
                 x"),
            Val::Num(3)
        );
        assert_eq!(
            run("(define x 1)
                 (import (list (cons 'x 2)))
                 x"),
            Val::Num(2)
        );
    }

    #[test]
    fn an_imported_semantics_is_a_value_and_not_an_installation() {
        assert_eq!(
            run(&format!(
                "(define shifting (list (cons 'M {SHIFT})))
                 (import shifting)
                 (let ((f (lambda f (n) (+ n 1))))
                   (cons (f 0) ((with-interp f (M (interp-of f))) 0)))"
            )),
            pair(Val::Num(1), Val::Num(11))
        );
    }

    #[test]
    fn an_import_needs_something_to_import_into() {
        let forms = crate::floor::read::read("(import (list))").expect("reads");
        assert!(crate::surface::desugar_body(&forms).is_err());
    }

    #[test]
    fn a_compiled_function_agrees_with_the_interpreted_one() {
        let src = |kw: &str| {
            format!(
                "(let ((fib ({kw} fib (n)
                              (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))))
                   (fib 10))"
            )
        };
        assert_eq!(run(&src("lambda")), Val::Num(55));
        assert_eq!(run(&src("clambda")), Val::Num(55));
    }

    #[test]
    fn an_interpreter_is_a_value_a_function_can_alter() {
        let mut t = Tower::load().expect("loads");
        let shift = t
            .run_source(
                // Floor source, so the handler reaches into the
                // continuation's representation rather than calling
                // `apply-cont`: `('cont f . h)`, and this one never
                // raises.
                "(lambda M (m)
                   (cons (cons 'eval-lit
                               (lambda h (m l e r k)
                                 ((car (cdr k)) (+ e 1))))
                         m))",
            )
            .expect("no fault");
        let base = t.get("m").expect("no fault");
        let altered = t.call(&shift, &[base]).expect("no fault");

        let p = prog("(+ 1 1)");
        assert_eq!(t.eval_under(&altered, &p), Ok(Val::Num(4)));
        assert_eq!(t.eval(&p), Ok(Val::Num(2)));
    }

    fn shift(n: i64) -> Val {
        prog(&format!("(lambda h (m l e r k) (apply-cont k (+ e {n})))"))
    }

    fn with_lit(t: &mut Tower, h: Val) -> Val {
        assert!(matches!(&h, Val::Pair(a, _) if **a == Val::Sym("clo".into())));
        let entry = Val::Pair(rc_val(Val::Sym("eval-lit".into())), rc_val(h));
        Val::Pair(rc_val(entry), rc_val(t.get("m").expect("no fault")))
    }

    fn shifted(t: &mut Tower) -> Val {
        let h = t.eval(&shift(1)).expect("no fault");
        with_lit(t, h)
    }

    #[test]
    fn an_object_level_handler_materializes_the_level_above_it() {
        let mut t = Tower::load().expect("loads");
        let altered = shifted(&mut t);

        let p = prog("(+ 1 1)");
        assert_eq!(t.eval_under(&altered, &p), Ok(Val::Num(4)));
        assert_eq!(t.eval(&p), Ok(Val::Num(2)));
    }

    #[test]
    fn a_materialized_level_leaves_no_trace_in_the_residual() {
        let mut t = Tower::load().expect("loads");
        let altered = shifted(&mut t);
        let p = prog("(clambda f (n) (+ n 1))");
        let out = t.compile_under(&altered, &p).expect("no fault");
        match out {
            Val::Code(e) => assert_eq!(format!("{e}"), "(let (lambda (let (+ x1 2) x2)) x0)"),
            other => panic!("expected code, got {other}"),
        }
    }

    #[test]
    fn a_level_is_interpreted_by_the_one_that_wrote_it() {
        let mut t = Tower::load().expect("loads");

        let h2 = t.eval(&shift(1)).expect("no fault");
        let m2 = with_lit(&mut t, h2);
        let h1 = t.eval_under(&m2, &shift(10)).expect("no fault");
        let m1 = with_lit(&mut t, h1);

        assert_eq!(t.eval_under(&m1, &prog("(+ 1 1)")), Ok(Val::Num(24)));
    }

    #[test]
    fn call_cc_is_an_ordinary_definition_in_the_object_language() {
        assert_eq!(run("(+ 1 (call/cc (lambda (k) (k 5))))"), Val::Num(6));
        assert_eq!(
            run("(+ 1 (call/cc (lambda (k) (+ 100 (k 5)))))"),
            Val::Num(6)
        );
        // Not escaping: the continuation is ignored and the body's value
        // is returned the ordinary way.
        assert_eq!(run("(+ 1 (call/cc (lambda (k) 5)))"), Val::Num(6));
    }

    #[test]
    fn a_prompt_bounds_the_continuation_reified_under_it() {
        assert_eq!(
            run("(* 10 (prompt (lambda () (+ 1 (call/cc (lambda (k) (+ 100 (k 5))))))))"),
            Val::Num(60)
        );
        // `abort` needs no continuation to have been reified: it hands
        // its value to the prompt and abandons everything between.
        assert_eq!(
            run("(* 10 (prompt (lambda () (+ 1 (abort 5)))))"),
            Val::Num(50)
        );
    }

    #[test]
    fn a_reflective_call_site_stages_away() {
        let mut t = Tower::load().expect("loads");
        let p = prog("(clambda f (n) (+ 1 (call/cc (lambda (k) (+ 100 (k n))))))");
        match t.compile(&p).expect("no fault") {
            Val::Code(e) => assert_eq!(format!("{e}"), "(let (lambda (let (+ 1 x1) x2)) x0)"),
            other => panic!("expected code, got {other}"),
        }
    }

    fn residual(text: &str) -> String {
        let mut t = Tower::load().expect("loads");
        match t.compile(&prog(text)).expect("no fault") {
            Val::Code(e) => format!("{e}"),
            other => panic!("expected code, got {other}"),
        }
    }

    #[test]
    fn a_residual_is_floor_code_in_anf() {
        assert_eq!(
            residual("(clambda f (n) (+ n 1))"),
            "(let (lambda (let (+ x1 1) x2)) x0)"
        );
    }

    #[test]
    fn a_compiled_function_keeps_the_arity_it_was_written_at() {
        assert_eq!(
            residual("(clambda g (a b) (+ (* a b) 1))"),
            "(let (lambda/2 (let (* x1 x2) (let (+ x3 1) x4))) x0)"
        );
    }

    #[test]
    fn recursion_and_a_staged_conditional_survive_compilation() {
        assert_eq!(
            residual("(clambda fib (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))"),
            "(let (lambda (let (< x1 2) (let (if x2 x1 \
             (let (- x1 1) (let (x0 x3) (let (- x1 2) \
             (let (x0 x5) (let (+ x4 x6) x7)))))) x3))) x0)"
        );
    }

    #[test]
    fn a_residual_carries_the_semantics_it_was_compiled_under() {
        let mut t = Tower::load().expect("loads");
        let base = t.get("m").expect("base interpreter");
        // Every literal comes out a hundred larger, and the addition that
        // does it happens while compiling: both its operands are
        // constants, so nothing about the site is staged and there is
        // nothing to emit.
        let marked = {
            let h = t
                .eval(&prog("(lambda h (m l e r k) (apply-cont k (+ e 100)))"))
                .expect("handler evaluates");
            pair(pair(sym("eval-lit"), h), base.clone())
        };

        let src = prog("(clambda f (n) (+ n 1))");
        let show = |v: Val| match v {
            Val::Code(e) => format!("{e}"),
            other => panic!("expected code, got {other}"),
        };
        assert_eq!(
            show(t.compile_under(&base, &src).expect("no fault")),
            "(let (lambda (let (+ x1 1) x2)) x0)"
        );
        assert_eq!(
            show(t.compile_under(&marked, &src).expect("no fault")),
            "(let (lambda (let (+ x2 101) x3)) x1)"
        );

        // And the same through `run`, where what comes back is applicable.
        let get = "(let ((f (clambda f (n) (+ n 1)))) f)";
        let f = t.eval_under(&base, &prog(get)).expect("no fault");
        let g = t.eval_under(&marked, &prog(get)).expect("no fault");
        assert_eq!(t.call(&f, &[Val::Num(1)]).expect("no fault"), Val::Num(2));
        assert_eq!(t.call(&g, &[Val::Num(1)]).expect("no fault"), Val::Num(102));
    }

    #[test]
    fn a_clambda_that_ran_is_tagged_as_compiled() {
        let mut t = Tower::load().expect("loads");
        // Staged it stays code, so the tag distinguishes only the run case -
        // where the value is a floor closure and would otherwise be taken for
        // a primitive by the call site.
        let f = t
            .eval(&prog("(let ((f (clambda f (n) (+ n 1)))) f)"))
            .expect("no fault");
        assert!(matches!(&f, Val::Pair(h, t)
            if **h == sym("cfun") && matches!(&**t, Val::Clo(_, _))));
        assert_eq!(t.call(&f, &[Val::Num(1)]).expect("no fault"), Val::Num(2));
    }

    #[test]
    fn a_call_to_an_operator_the_site_does_not_know_dispatches_at_run_time() {
        // The emitted decision, in full: the operand list is built, and
        // the four things `static-apply` needs ride in as persisted
        // values rather than as syntax.
        assert_eq!(
            residual("(clambda f (g n) (g n))"),
            "(let (lambda/2 (let (cons x2 ()) \
             (let (#<closure> #<closure> x1 x3 #<('cont #<closure> . #<closure>)>) x4))) x0)"
        );

        for op in ["lambda", "clambda"] {
            let src = format!("(let ((f ({op} f (g n) (g n)))) (f {{}} 5))");
            // An interpreted callee and a compiled one: one call site, two
            // representations, and the answer does not depend on which
            // arrives.
            for arg in ["(lambda h (x) (+ x 1))", "(clambda h (x) (+ x 1))"] {
                assert_eq!(run(&src.replace("{}", arg)), Val::Num(6), "{op} {arg}");
            }
            // A primitive is a floor closure, so it goes through the same
            // arm a compiled function does.
            assert_eq!(
                run(&format!("(let ((f ({op} f (g n) (g n 1)))) (f + 5))")),
                Val::Num(6)
            );
            // And a value that is not applicable at all fails the same
            // way it does interpreted, rather than failing to compile.
            let Val::Raise(v) = run(&src.replace("{}", "7")) else {
                panic!("expected a raise from {op}");
            };
            assert_eq!(v.to_string(), "('cannot-apply . 7)");
        }
    }

    #[test]
    fn a_compiled_combinator_runs_its_callee_under_the_callees_own_semantics() {
        let map = "(let ((map (clambda map (f xs) \
                    (if (nil? xs) '() (cons (f (car xs)) (map f (cdr xs)))))))";
        assert_eq!(
            run(&format!("{map} (map (lambda h (x) (* x 2)) '(1 2 3)))")),
            run("'(2 4 6)")
        );

        // The same callee under an interpreter where a literal is worth a
        // hundred more than it says. Nothing about the compiled `map`
        // changed, and it was compiled before the alteration existed.
        let hundred = "(let ((louder (lambda a (m) \
                       (cons (cons 'eval-lit \
                             (lambda h (m l e r k) (apply-cont k (+ e 100)))) m))))";
        let dbl = "(lambda h (x) (* x 2))";
        assert_eq!(
            run(&format!(
                "{map} {hundred} (let ((d {dbl})) \
                 (map (with-interp d (louder (interp-of d))) '(1 2 3)))))"
            )),
            run("'(102 204 306)")
        );
    }

    #[test]
    fn a_closure_made_while_staging_is_not_a_value_to_persist() {
        let mk = |body: &str| {
            format!("(let ((f (clambda f (g n) (g (lambda h (x) {body}))))) ((f (lambda i (c) c) 1) 10))")
        };
        for body in ["(+ x n)", "(+ x 1)"] {
            let Val::Raise(v) = run(&mk(body)) else {
                panic!("expected a raise from {body}");
            };
            assert_eq!(v.to_string(), "('unpersistable . 'pair)", "{body}");
        }
        // The operand that is *not* built here still crosses: it arrives
        // as code and stays code.
        assert_eq!(
            run("(let ((f (clambda f (g n) (g n)))) (f (lambda h (x) (+ x 1)) 5))"),
            Val::Num(6)
        );
    }

    #[test]
    fn a_closure_is_not_a_result_a_compiled_region_can_give_back() {
        // Alone; as a leaf of a structure the region does build; and in
        // one arm of a staged conditional, which is the same boundary
        // reached a third way.
        for body in [
            "(lambda h (x) (+ x n))",
            "(cons 1 (lambda h (x) x))",
            "(if (< n 2) (lambda h (x) x) 0)",
        ] {
            let p = format!("(let ((f (clambda f (n) {body}))) (f 1))");
            let Val::Raise(v) = run(&p) else {
                panic!("expected a raise from {body}");
            };
            assert_eq!(v.to_string(), "('unreturnable . 'closure)", "{body}");
        }
    }

    #[test]
    fn a_reflective_operator_cannot_arrive_at_a_compiled_call_site() {
        let bind = "(let ((r (lambda reflect (m l e r k) (apply-cont k (car e)))))";
        let tag = |src: String| {
            let Val::Raise(v) = run(&src) else {
                panic!("expected a raise from {src}");
            };
            let Val::Pair(t, _) = &*v else {
                panic!("expected a tagged raise, got {v}");
            };
            Val::clone(t)
        };
        // Interpreted, the operand arrives as syntax and is never
        // evaluated. Compiled, it was evaluated before anything looked at
        // the operator — which is why the site is gone by the dispatch.
        assert_eq!(
            run(&format!("{bind} (let ((f (lambda f (g) (g zzz)))) (f r)))")),
            sym("zzz")
        );
        assert_eq!(
            tag(format!("{bind} (let ((f (clambda f (g) (g zzz)))) (f r)))")),
            sym("unbound")
        );
        // With an operand that does evaluate, the dispatch is reached and
        // names what it cannot do.
        assert_eq!(
            run(&format!("{bind} (let ((f (lambda f (g) (g 1)))) (f r)))")),
            Val::Num(1)
        );
        assert_eq!(
            tag(format!("{bind} (let ((f (clambda f (g) (g 1)))) (f r)))")),
            sym("no-call-site")
        );
    }

    #[test]
    fn a_compiled_region_can_answer_with_a_pair() {
        assert_eq!(
            residual("(clambda f (n) (cons n 1))"),
            "(let (lambda (let (cons x1 1) x2)) x0)"
        );
        assert_eq!(
            residual("(clambda f (n) (cons n '(1 2)))"),
            "(let (lambda (let (cons 2 ()) (let (cons 1 x2) \
             (let (cons x1 x3) x4)))) x0)"
        );
        assert_eq!(
            run("(let ((f (clambda f (n) (cons n '(1 2))))) (f 7))"),
            run("(let ((f (lambda f (n) (cons n '(1 2))))) (f 7))")
        );
    }

    #[test]
    fn each_arm_of_a_staged_conditional_builds_its_own_structure() {
        assert_eq!(
            run("(let ((f (clambda f (n) (if (< n 2) '(a) '(b c))))) (f 7))"),
            run("(let ((f (lambda f (n) (if (< n 2) '(a) '(b c))))) (f 7))")
        );
    }

    #[test]
    fn a_handler_can_put_a_value_into_the_residual_that_nothing_else_would() {
        let mut t = Tower::load().expect("loads");
        let base = t.get("m").expect("base interpreter");
        let marked = {
            let h = t
                .eval(&prog(
                    "(lambda h (m l e r k) (apply-cont k (+ e ((l 'lift) 100))))",
                ))
                .expect("handler evaluates");
            pair(pair(sym("eval-lit"), h), base)
        };
        let src = prog("(clambda f (n) (+ n 1))");
        let Val::Code(e) = t.compile_under(&marked, &src).expect("no fault") else {
            panic!("expected code");
        };
        assert_eq!(
            format!("{e}"),
            "(let (lambda (let (+ 1 100) (let (+ x1 x2) x3))) x0)"
        );
    }

    #[test]
    fn a_compiled_region_inlines_interpreted_code_and_calls_compiled_code() {
        assert_eq!(
            residual("(let ((g (lambda g (x) (+ x 1)))) (clambda f (n) (g (g n))))"),
            "(let (lambda (let (+ x1 1) (let (+ x2 1) x3))) x0)"
        );
        assert_eq!(
            residual("(let ((g (clambda g (x) (+ x 1)))) (clambda f (n) (g (g n))))"),
            "(let (lambda (let (+ x1 1) x2)) \
             (let (lambda (let (x0 x2) (let (x0 x3) x4))) x1))"
        );
    }

    #[test]
    fn a_host_value_compiles_to_the_answer_it_interprets() {
        let body = "(s) (if (eq? s \"x\") 1 0)";
        assert_eq!(
            run(&format!("(let ((f (lambda f {body}))) (f \"x\"))")),
            Val::Num(1)
        );
        assert_eq!(
            run(&format!("(let ((f (clambda f {body}))) (f \"x\"))")),
            Val::Num(1)
        );
        assert_eq!(
            residual(&format!("(clambda f {body})")),
            "(let (lambda (let (eq? x1 \"x\") (let (if x2 1 0) x3))) x0)"
        );
    }

    #[test]
    fn an_interpreted_recursive_callee_is_refused_rather_than_unfolded() {
        let mut t = Tower::load().expect("loads");
        let out = t.compile(&prog(
            "(let ((g (lambda g (x) (if (< x 1) 0 (g (- x 1))))))
               (clambda f (n) (g n)))",
        ));
        assert_eq!(
            out,
            Ok(crate::floor::raise(list(&[
                sym("inlines-forever"),
                sym("g")
            ])))
        );
    }

    #[test]
    fn a_refused_cycle_names_every_function_on_it() {
        let mut t = Tower::load().expect("loads");
        let out = t.compile(&prog(
            "(let ((h (lambda h (y g) (g y h))))
               (let ((g (lambda g (x h) (h x g))))
                 (clambda f (n) (g n h))))",
        ));
        assert_eq!(
            out,
            Ok(crate::floor::raise(list(&[
                sym("inlines-forever"),
                sym("g"),
                sym("h")
            ])))
        );
    }

    #[test]
    fn a_recursion_over_static_data_still_unfolds() {
        assert_eq!(
            residual(
                "(let ((walk (lambda walk (xs n)
                               (if (nil? xs) n (walk (cdr xs) (+ n 1))))))
                   (clambda f (n) (walk '(1 2 3) n)))"
            ),
            "(let (lambda (let (+ x1 1) (let (+ x2 1) (let (+ x3 1) x4)))) x0)"
        );
    }

    #[test]
    fn a_constant_joins_a_residual_wherever_it_came_from() {
        assert_eq!(
            residual("(clambda f (n) (+ n (car '(7 8))))"),
            "(let (lambda (let (+ x1 7) x2)) x0)"
        );
    }

    #[test]
    fn a_task_is_an_object_program_and_the_address_it_was_given() {
        let mut t = Tower::load().expect("loads");
        let entry = t.task(&prog("self")).expect("no fault");

        let mut h = Heap::new(1000);
        let id = h.spawn(entry);
        h.run().expect("no bug");
        assert_eq!(h.take_exits(), vec![(id, ok(addr(id)))]);
    }

    const SHIFT: &str = "(lambda M (i)
                           (with-handler i 'eval-lit
                             (lambda h (m l e r k) (apply-cont k (+ e 10)))))";

    #[test]
    fn a_procedures_interpreter_is_a_value_that_can_be_replaced() {
        assert_eq!(
            run(&format!(
                "(let ((f (lambda f (n) (+ n 1))))
                   (cons (f 0)
                         ((with-interp f ({SHIFT} (interp-of f))) 0)))"
            )),
            Val::Pair(rc_val(Val::Num(1)), rc_val(Val::Num(11)))
        );
    }

    #[test]
    fn the_interpreter_in_force_is_readable_as_a_value() {
        assert_eq!(
            run(&format!(
                "(let ((i ({SHIFT} (interpreter))))
                   ((with-interp (lambda f (n) (+ n 1)) i) 0))"
            )),
            Val::Num(11)
        );
    }

    #[test]
    fn a_program_can_be_evaluated_in_an_environment_it_is_handed() {
        assert_eq!(
            run("(let ((r (env-extend (environment) 'x 20)))
                   (eval-in r (desugar-body (read \"(+ x 2)\"))))"),
            Val::Num(22)
        );
    }

    #[test]
    fn a_protected_region_reports_which_way_it_ended() {
        assert_eq!(
            run("(cons (attempt (lambda () (+ 1 2)))
                       (attempt (lambda () (throw 'boom))))"),
            pair(
                pair(sym("ok"), Val::Num(3)),
                pair(sym("throw"), sym("boom"))
            )
        );
    }

    #[test]
    fn a_raise_stops_at_the_nearest_protected_region() {
        assert_eq!(
            run("(attempt (lambda ()
                   (+ 1 (cdr (attempt (lambda () (throw 7)))))))"),
            pair(sym("ok"), Val::Num(8))
        );
    }

    #[test]
    fn a_call_to_a_task_that_dies_raises_at_the_call_site() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (let ((child (spawn (lambda c (me)
                                                    (begin (receive)
                                                           (throw 'boom))))))
                                (cons 'stop
                                      (attempt (lambda () (call child 'ping))))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        let id = h.spawn(entry);
        h.post(&addr(id), sym("go"));
        h.run().expect("no bug");
        assert_eq!(
            h.take_exits(),
            vec![
                (1, pair(sym("throw"), sym("boom"))),
                (
                    id,
                    ok(pair(
                        sym("throw"),
                        pair(
                            sym("callee-down"),
                            pair(addr(1), pair(sym("throw"), sym("boom")))
                        )
                    ))
                ),
            ]
        );
    }

    #[test]
    fn a_death_the_handler_asked_about_reaches_the_handler() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (if (tagged? msg 'task-down)
                                  (cons 'stop msg)
                                  (let ((child (spawn (lambda c (me)
                                                        (begin (receive) 7)))))
                                    (begin (monitor child)
                                           (begin (send child 'go) st)))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        let id = h.spawn(entry);
        h.post(&addr(id), sym("go"));
        h.run().expect("no bug");
        assert_eq!(
            h.take_exits(),
            vec![
                (1, ok(Val::Num(7))),
                (
                    id,
                    ok(pair(sym("task-down"), pair(addr(1), ok(Val::Num(7)))))
                ),
            ]
        );
    }

    #[test]
    fn a_supervisor_restarts_a_child_and_then_gives_up() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(
                "(supervise self (list (cons 'kid (cons 1 (lambda c (me) (throw 'boom))))))",
            ))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        let id = h.spawn(entry);
        h.post(&addr(id), sym("go"));
        h.run().expect("no bug");
        assert_eq!(
            h.take_exits(),
            vec![
                (1, pair(sym("throw"), sym("boom"))),
                (2, pair(sym("throw"), sym("boom"))),
                (
                    id,
                    ok(pair(
                        sym("give-up"),
                        pair(sym("kid"), pair(sym("throw"), sym("boom")))
                    ))
                ),
            ]
        );
    }

    #[test]
    fn a_child_that_returns_is_not_restarted() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(
                "(supervise self (list (cons 'kid (cons 3 (lambda c (me) 7)))))",
            ))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        let id = h.spawn(entry);
        h.post(&addr(id), sym("go"));
        h.run().expect("no bug");
        assert_eq!(
            h.take_exits(),
            vec![(1, ok(Val::Num(7))), (id, ok(sym("all-done")))]
        );
    }

    #[test]
    fn a_task_that_never_reaches_receive_is_ended() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (if (tagged? msg 'task-down)
                                  (cons 'stop msg)
                                  (let ((child (spawn-monitor
                                                (lambda c (me)
                                                  ((lambda f (x) (f x)) 0)))))
                                    (begin (limit-turns child 2) st))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(10_000);
        let id = h.spawn(entry);
        h.post(&addr(id), sym("go"));
        h.run().expect("no bug");
        assert_eq!(
            h.take_exits(),
            vec![
                (1, pair(sym("throw"), sym("unresponsive"))),
                (
                    id,
                    ok(pair(
                        sym("task-down"),
                        pair(addr(1), pair(sym("throw"), sym("unresponsive")))
                    ))
                ),
            ]
        );
    }

    #[test]
    fn spawn_with_forks_the_semantics_rather_than_sharing_it() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(&format!(
                "(begin (spawn-with {SHIFT} (lambda c (me) (send '(host child) (+ 0 1))))
                        (send '(host parent) (+ 0 1)))"
            )))
            .expect("no fault");

        let mut h = Heap::new(200_000);
        h.spawn(entry);
        h.run().expect("no bug");
        assert_eq!(
            h.take_away(),
            vec![(host("parent"), Val::Num(1)), (host("child"), Val::Num(21)),]
        );
    }

    #[test]
    fn become_changes_what_the_next_message_means() {
        let mut t = Tower::load().expect("loads");
        let src = prog(&format!(
            "(task-loop self
                        (lambda h (st msg)
                          (cond ((tagged? msg 'shift) (become {SHIFT} st))
                                ((tagged? msg 'ask) (cons 'stop (+ 0 1)))
                                (else st)))
                        0)"
        ));
        let ending_with = |t: &mut Tower, msgs: &[&str]| {
            let mut h = Heap::new(100_000);
            let id = h.spawn(t.task(&src).expect("no fault"));
            for m in msgs {
                h.post(&addr(id), list(&[Val::Sym((*m).into())]));
            }
            h.run().expect("no bug");
            h.take_exits()
        };

        assert_eq!(ending_with(&mut t, &["ask"]), vec![(0, ok(Val::Num(1)))]);
        assert_eq!(
            ending_with(&mut t, &["shift", "ask"]),
            vec![(0, ok(Val::Num(21)))]
        );
    }

    #[test]
    fn an_object_procedure_can_be_spawned() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog("(spawn (lambda c (me) (send '(host child) me)))"))
            .expect("no fault");

        let mut h = Heap::new(10_000);
        let parent = h.spawn(entry);
        h.run().expect("no bug");

        let child = addr(1);
        assert_eq!(
            h.take_away(),
            vec![(
                list(&[Val::Sym("host".into()), Val::Sym("child".into())]),
                child.clone()
            )]
        );
        assert_eq!(h.take_exits(), vec![(parent, ok(child)), (1, ok(Val::Nil))]);
    }

    #[test]
    fn a_call_suspends_a_task_rather_than_blocking_it() {
        let mut t = Tower::load().expect("loads");
        let server = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg) (begin (reply msg (* 2 (cadddr msg))) st))
                            0)",
            ))
            .expect("no fault");
        let client = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg) (cons 'stop (+ 1 (call (cadr msg) 20))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(10_000);
        let s = h.spawn(server);
        let c = h.spawn(client);
        h.post(&addr(c), list(&[Val::Sym("go".into()), addr(s)]));
        h.run().expect("no bug");

        // The server is still looping, so the only task that ended is the
        // caller - with the value its suspended call site computed.
        assert_eq!(h.take_exits(), vec![(c, ok(Val::Num(41)))]);
    }

    #[test]
    fn a_message_arriving_mid_turn_waits_for_it() {
        let mut t = Tower::load().expect("loads");
        let server = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg) (begin (reply msg (* 2 (cadddr msg))) st))
                            0)",
            ))
            .expect("no fault");
        let client = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (cond ((tagged? msg 'note)
                                     (begin (send '(host seen) st) (cons 'stop st)))
                                    ((tagged? msg 'go) (+ st (call (cadr msg) 20)))
                                    (else st)))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(10_000);
        let s = h.spawn(server);
        let c = h.spawn(client);
        h.post(&addr(c), list(&[Val::Sym("go".into()), addr(s)]));
        h.post(&addr(c), list(&[Val::Sym("note".into())]));
        h.run().expect("no bug");

        assert_eq!(
            h.take_away(),
            vec![(
                list(&[Val::Sym("host".into()), Val::Sym("seen".into())]),
                Val::Num(40)
            )]
        );
        assert_eq!(h.take_exits(), vec![(c, ok(Val::Num(40)))]);
    }

    #[test]
    fn a_turn_may_hand_the_task_over_and_the_backlog_goes_with_it() {
        let mut t = Tower::load().expect("loads");
        let node = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (let ((kid (spawn (lambda (me)
                                                  (begin (send self (list 'register 'kid me))
                                                         (task-loop me
                                                                    (lambda k (s2 m2) s2)
                                                                    0))))))
                                (let ((_ (call '(host tick) 'wait)))
                                  (hand greeter '()))))
                            0)",
            ))
            .expect("no fault");
        let asker = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg) (cons 'stop (call (cadr msg) '(names))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        let n = h.spawn(node);
        let a = h.spawn(asker);
        // The child's registration has to be in flight while the node is
        // still setting up, which is what the `tick` call and the reply
        // below arrange: nothing answers `tick`, so the first run ends
        // with the node suspended and the registration waiting.
        h.post(&addr(n), Val::Sym("go".into()));
        h.run().expect("no bug");
        h.post(
            &addr(n),
            list(&[Val::Sym("reply".into()), Val::Num(1), Val::Nil]),
        );
        h.post(&addr(a), list(&[Val::Sym("go".into()), addr(n)]));
        h.run().expect("no bug");

        assert_eq!(
            h.take_exits(),
            vec![(a, ok(list(&[Val::Sym("kid".into())])))]
        );
    }

    #[test]
    fn a_task_calling_itself_is_refused_rather_than_left_to_park() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg) (cons 'stop (call self '(anything))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(10_000);
        let id = h.spawn(entry);
        h.post(&addr(id), Val::Sym("go".into()));
        h.run().expect("no bug");

        let sym = |s: &str| Val::Sym(s.into());
        assert_eq!(
            h.take_exits(),
            vec![(
                id,
                Val::Pair(
                    rc_val(sym("throw")),
                    rc_val(pair(sym("self-call"), list(&[sym("anything")])))
                )
            )]
        );
    }

    #[test]
    fn a_reference_holds_a_value_and_survives_a_request_it_does_not_know() {
        let mut t = Tower::load().expect("loads");
        let driver = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (let ((c (spawn (lambda (me) (ref me 0)))))
                                (let ((first (call c '(read))))
                                  (let ((_ (call c '(write 42))))
                                    (let ((bad (attempt (lambda () (call c '(oops))))))
                                      (cons 'stop
                                            (list first bad (call c '(read)))))))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        let d = h.spawn(driver);
        h.post(&addr(d), Val::Sym("go".into()));
        h.run().expect("no bug");

        let sym = |s: &str| Val::Sym(s.into());
        // The reference is still looping, so the driver is the only exit.
        assert_eq!(
            h.take_exits(),
            vec![(
                d,
                ok(list(&[
                    Val::Num(0),
                    list(&[sym("throw"), sym("bad-request"), sym("oops")]),
                    Val::Num(42),
                ]))
            )]
        );
    }

    #[test]
    fn the_list_library_computes() {
        assert_eq!(run("(length (append '(1 2) '(3 4)))"), Val::Num(4));
        assert_eq!(run("(nth 0 (reverse '(1 2 3)))"), Val::Num(3));
        assert_eq!(
            run("(fold (lambda (a x) (+ a x)) 0 (filter (lambda (x) (> x 2)) '(1 2 3 4)))"),
            Val::Num(7)
        );
        assert_eq!(
            run("(last (map (lambda (x) (* x x)) '(1 2 3)))"),
            Val::Num(9)
        );
        assert_eq!(
            run("(foldr (lambda (x a) (cons x a)) '() '(1 2))"),
            list(&[Val::Num(1), Val::Num(2)])
        );
    }

    #[test]
    fn an_index_past_the_end_raises() {
        let sym = |s: &str| Val::Sym(s.into());
        assert_eq!(
            run("(attempt (lambda () (nth 9 '(1))))"),
            pair(sym("throw"), pair(sym("no-such-index"), Val::Num(9)))
        );
        assert_eq!(
            run("(attempt (lambda () (last '())))"),
            pair(sym("throw"), sym("empty-list"))
        );
    }

    #[test]
    fn a_mapped_effect_runs_front_to_back() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog("(map (lambda (x) (send '(host trace) x)) '(1 2 3))"))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        h.spawn(entry);
        h.run().expect("no bug");
        assert_eq!(
            h.take_away(),
            vec![
                (host("trace"), Val::Num(1)),
                (host("trace"), Val::Num(2)),
                (host("trace"), Val::Num(3)),
            ]
        );
    }

    #[test]
    fn the_comparisons_derive_from_the_one_the_floor_has() {
        assert_eq!(
            run("(list (> 2 1) (< 2 1) (<= 2 2) (>= 1 2) (= 3 3) (not 0))"),
            list(&[
                Val::Num(1),
                Val::Num(0),
                Val::Num(1),
                Val::Num(0),
                Val::Num(1),
                Val::Num(1)
            ])
        );
    }

    #[test]
    fn text_is_taken_apart_and_put_back_together() {
        assert_eq!(run(r#"(join "-" (split "a.b.c" "."))"#), Str::val("a-b-c"));
        assert_eq!(run(r#"(str-at "abc" 1)"#), Str::val("b"));
        assert_eq!(run(r#"(substr "abc" 1 99)"#), Str::val("bc"));
        assert_eq!(run(r#"(length (split "" "."))"#), Val::Num(1));
        assert_eq!(run(r#"(eq? (str->sym "kid") 'kid)"#), Val::Num(1));
    }

    #[test]
    fn a_search_that_finds_nothing_answers_past_the_end() {
        assert_eq!(run(r#"(str-find "hello" "ll")"#), Val::Num(2));
        assert_eq!(run(r#"(str-find "hello" "z")"#), Val::Num(5));
        assert_eq!(run(r#"(str-find "hello" "h")"#), Val::Num(0));
        assert_eq!(run(r#"(str-has? "hello" "ell")"#), Val::Num(1));
        assert_eq!(run(r#"(str-has? "hello" "elk")"#), Val::Num(0));
        assert_eq!(run(r#"(starts-with? "hello" "he")"#), Val::Num(1));
        assert_eq!(run(r#"(ends-with? "hello" "lo")"#), Val::Num(1));
        // A prefix longer than the string compares unequal rather than
        // raising on the negative index `substr` clamps away.
        assert_eq!(run(r#"(ends-with? "no" "ohno")"#), Val::Num(0));
        assert_eq!(run(r#"(str-trim "  hi \n")"#), Str::val("hi"));
        assert_eq!(run(r#"(str-trim "   ")"#), Str::val(""));
    }

    #[test]
    fn text_reaches_the_alphabet_and_the_number_it_spells() {
        assert_eq!(run(r#"(str->num "42")"#), Val::Num(42));
        assert_eq!(run(r#"(str->num " -1.5 ")"#), Val::Flo(-1.5));
        assert_eq!(
            run(r#"(attempt (lambda () (str->num "twelve")))"#),
            pair(sym("throw"), pair(sym("not-a-number"), Str::val("twelve")))
        );
        assert_eq!(run(r#"(str-upper "aß")"#), Str::val("ASS"));
        assert_eq!(run(r#"(str-lower "ABC")"#), Str::val("abc"));
        assert_eq!(run(r#"(ord "A")"#), Val::Num(65));
        assert_eq!(run(r#"(chr 65)"#), Str::val("A"));
        assert_eq!(run(r#"(chr (+ (ord "a") 1))"#), Str::val("b"));
    }

    #[test]
    fn the_arithmetic_reaches_past_the_polynomials() {
        assert_eq!(run("(sqrt 4)"), Val::Flo(2.0));
        assert_eq!(run("(pow 2 10)"), Val::Flo(1024.0));
        assert_eq!(run("(round (* 100 (log (exp 1))))"), Val::Num(100));
        assert_eq!(run("(round (* 1000 (sin 0)))"), Val::Num(0));
        assert_eq!(run("(round (* 1000 (atan2 0 1)))"), Val::Num(0));
        assert_eq!(run("(floor -1.5)"), Val::Num(-2));
        assert_eq!(run("(ceil -1.5)"), Val::Num(-1));
        assert_eq!(run("(trunc -1.5)"), Val::Num(-1));
        assert_eq!(run("(round -1.5)"), Val::Num(-2));
        // An integer is already one, and is not widened and narrowed to
        // prove it.
        assert_eq!(run("(ceil 3)"), Val::Num(3));
        assert_eq!(run("(abs -3)"), Val::Num(3));
        assert_eq!(run("(max 2 (min 5 9))"), Val::Num(5));
        assert_eq!(run("(list (even? 4) (odd? -3))"), run("(list 1 1)"));
    }

    #[test]
    fn the_surface_forms_reach_the_object_language() {
        assert_eq!(run("(let ((b 2)) `(a ,b ,@'(c d)))"), run("'(a 2 c d)"));
        assert_eq!(run("(case 'b ((a) 1) ((b c) 2) (else 3))"), Val::Num(2));
        assert_eq!(run("(let (((a . r) '(1 2 3))) (+ a (car r)))"), Val::Num(3));
        assert_eq!(run("((lambda ((a b)) (- a b)) '(1 2))"), Val::Num(-1));
    }

    #[test]
    fn definitions_reach_each_other_in_the_object_language() {
        assert_eq!(
            run("(define (ev? n) (if (eq? n 0) 1 (od? (- n 1))))
                 (define (od? n) (if (eq? n 0) 0 (ev? (- n 1))))
                 (+ (* 10 (ev? 8)) (od? 7))"),
            Val::Num(11)
        );
        assert_eq!(
            run("(define (a n) (b (+ n 1)))
                 (define (b n) (* n 2))
                 (a 3)"),
            Val::Num(8)
        );
    }

    #[test]
    fn a_cycle_refuses_to_compile_and_says_which() {
        let mut t = Tower::load().expect("loads");
        let out = t
            .compile(&prog(
                "(define (ev? n) (if (eq? n 0) 1 (od? (- n 1))))
                 (define (od? n) (if (eq? n 0) 0 (ev? (- n 1))))
                 (clambda f (n) (ev? n))",
            ))
            .expect("no fault");
        let text = format!("{out}");
        assert!(text.contains("inlines-forever"), "{text}");
        assert!(text.contains("ev?") && text.contains("od?"), "{text}");

        assert_eq!(
            residual(
                "(define (a n) (b (+ n 1)))
                 (define (b n) (* n 2))
                 (clambda f (n) (a n))"
            ),
            "(let (lambda (let (+ x1 1) (let (* x2 2) x3))) x0)"
        );
    }

    #[test]
    fn compiling_the_members_does_not_rescue_a_cycle() {
        let mut t = Tower::load().expect("loads");
        let out = t
            .eval(&prog(
                "(define ev? (clambda ev? (n) (if (eq? n 0) 1 (od? (- n 1)))))
                 (define od? (clambda od? (n) (if (eq? n 0) 0 (ev? (- n 1)))))
                 (ev? 8)",
            ))
            .expect("no fault");
        let text = format!("{out}");
        assert!(text.contains("inlines-forever"), "{text}");
        assert!(text.contains("ev?") && text.contains("od?"), "{text}");
    }

    #[test]
    fn a_table_answers_by_key_and_refuses_a_verb_it_does_not_know() {
        let mut t = Tower::load().expect("loads");
        let driver = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (let ((tb (spawn (lambda (me) (table-at me '())))))
                                (let ((_ (call tb '(put a 1))))
                                  (let ((_ (call tb '(put b 2))))
                                    (let ((got (call tb '(get a))))
                                      (let ((miss (attempt (lambda () (call tb '(get z))))))
                                        (let ((bad (attempt (lambda () (call tb '(nonsense))))))
                                          (let ((_ (call tb '(drop b))))
                                            (cons 'stop
                                                  (list got miss bad
                                                        (call tb '(keys))))))))))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(200_000);
        let d = h.spawn(driver);
        h.post(&addr(d), sym("go"));
        h.run().expect("no bug");
        assert_eq!(
            h.take_exits(),
            vec![(
                d,
                ok(list(&[
                    Val::Num(1),
                    pair(sym("throw"), pair(sym("no-such-key"), sym("z"))),
                    list(&[sym("throw"), sym("bad-request"), sym("nonsense")]),
                    list(&[sym("a")]),
                ]))
            )]
        );
    }

    #[test]
    fn a_future_answers_every_reader_with_the_one_result() {
        let mut t = Tower::load().expect("loads");
        let driver = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (let ((src (spawn (lambda (me) (ref me 7)))))
                                (let ((f (future src '(read))))
                                  (cons 'stop (list (call f '(read)) (call f '(read)))))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(200_000);
        let d = h.spawn(driver);
        h.post(&addr(d), sym("go"));
        h.run().expect("no bug");
        assert_eq!(
            h.take_exits(),
            vec![(d, ok(list(&[Val::Num(7), Val::Num(7)])))]
        );
    }

    #[test]
    fn a_supervisor_names_the_children_it_holds_up() {
        let mut t = Tower::load().expect("loads");
        let driver = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg)
                              (let ((sup (spawn (lambda (me)
                                                  (supervise me (list (cons 'a (cons 3 (lambda c (me) (receive))))))))))
                                (let ((which (call sup '(which-children))))
                                  (let ((one (call sup '(child a))))
                                    (let ((none (attempt (lambda () (call sup '(child z))))))
                                      (cons 'stop
                                            (list (map (lambda (e) (car e)) which)
                                                  (eq? one (cdr (car which)))
                                                  none)))))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(200_000);
        let d = h.spawn(driver);
        h.post(&addr(d), sym("go"));
        h.run().expect("no bug");
        let exits = h.take_exits();
        assert_eq!(
            exits,
            vec![(
                d,
                ok(list(&[
                    list(&[sym("a")]),
                    Val::Num(1),
                    pair(sym("throw"), pair(sym("no-such-child"), sym("z"))),
                ]))
            )]
        );
    }

    #[test]
    fn a_deadline_arms_a_timer_that_answers_the_call_it_bounds() {
        let mut t = Tower::load().expect("loads");
        let entry = t
            .task(&prog(
                "(task-loop self
                            (lambda h (st msg) (cons 'stop (call-within 50 '(host nowhere) '(hi))))
                            0)",
            ))
            .expect("no fault");

        let mut h = Heap::new(100_000);
        let id = h.spawn(entry);
        h.post(&addr(id), sym("go"));
        h.run().expect("no bug");

        // No clock is registered, so the timer never fires and the task
        // parks: a world without the capability simply never times out.
        assert_eq!(h.take_exits(), vec![]);
        assert_eq!(
            h.take_away(),
            vec![
                (
                    host("nowhere"),
                    list(&[sym("req"), addr(id), Val::Num(1), list(&[sym("hi")])])
                ),
                (
                    host("clock"),
                    list(&[
                        sym("after"),
                        Val::Num(50),
                        addr(id),
                        list(&[
                            sym("reply"),
                            Val::Num(1),
                            pair(sym("throw"), sym("timeout"))
                        ])
                    ])
                ),
            ]
        );
    }

    fn ok(v: Val) -> Val {
        Val::Pair(rc_val(Val::Sym("ok".into())), rc_val(v))
    }
}