narju/floor/

machine.rs

use super::host;
use super::{code, rc_exp, rc_val, Env, EnvChunk, Exp, Prim1, Prim2, RcExp, RcVal, Shared, Val};
use std::collections::HashSet;

/// Memo of closures already η-expanded in the current scope (the paper's
/// `findFun`). Without it a recursive closure's lift expands forever.
type FunTable = Shared<Vec<(FunKey, usize)>>;

#[derive(Clone)]
struct FunKey {
    env: Env,
    body: RcExp,
}

/// `Val`'s equality compares a closure by body and never descends into its
/// environment, so this cannot recur through a cyclic value graph.
fn env_equal(a: &Env, b: &Env) -> bool {
    Env::ptr_eq(a, b) || (a.len() == b.len() && a.iter().zip(b.iter()).all(|(x, y)| x == y))
}

/// A type error is a `throw` the program may catch, not a second error system.
/// `Bug` is uncatchable and means an invariant of this file was violated.
#[derive(Debug, PartialEq)]
pub enum Fault {
    Throw(Val),
    Bug(String),
}

impl std::fmt::Display for Fault {
    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
        match self {
            Fault::Throw(v) => write!(f, "{v}"),
            Fault::Bug(s) => write!(f, "bug: {s}"),
        }
    }
}

pub fn throw(tag: &str, detail: Val) -> Fault {
    Fault::Throw(Val::Pair(rc_val(Val::Sym(tag.into())), rc_val(detail)))
}

fn wrong_type(op: &str) -> Fault {
    throw("wrong-type", Val::Sym(op.into()))
}

/// A scalar is its own constant; a pair, closure or cell would need an
/// allocation where a constant was expected. Callers apply this only once some
/// operand is already code, else the whole program would stage.
fn as_syntax(v: &Val) -> Option<RcExp> {
    match v {
        Val::Code(e) => Some(RcExp::clone(e)),
        Val::Num(n) => Some(rc_exp(Exp::Lit(*n))),
        Val::Flo(x) => Some(rc_exp(Exp::Flo(*x))),
        Val::Sym(s) => Some(rc_exp(Exp::Sym(s.clone()))),
        Val::Atom(a) => Some(rc_exp(Exp::Atom(a.clone()))),
        Val::Nil => Some(rc_exp(Exp::Nil)),
        _ => None,
    }
}

fn kind_of(v: &Val) -> &'static str {
    match v {
        Val::Num(_) => "number",
        Val::Flo(_) => "float",
        Val::Sym(_) => "symbol",
        Val::Atom(_) => "atom",
        Val::Nil => "nil",
        Val::Pair(_, _) => "pair",
        Val::Clo(_, _) => "closure",
        Val::Code(_) => "code",
        Val::Cell(_) => "cell",
        Val::Raise(_) => "raise",
    }
}

/// A closure made inside a staged region captures [`Val::Code`] parameters;
/// persisting it would freeze those holes into the residual, so the walk goes
/// everywhere one can hide, closure environments included. The memo is not
/// optional - the environment chain makes a closure a DAG whose sharing is
/// worth about four orders of magnitude.
fn has_holes<M: Mail>(v: &Val, h: &Store<M>) -> bool {
    let mut vals: HashSet<*const Val> = HashSet::new();
    let mut envs: HashSet<*const EnvChunk> = HashSet::new();
    let mut work = vec![Val::clone(v)];
    while let Some(x) = work.pop() {
        match x {
            Val::Code(_) => return true,
            Val::Pair(a, b) => {
                for c in [a, b] {
                    if vals.insert(&*c as *const Val) {
                        work.push(Val::clone(&c));
                    }
                }
            }
            Val::Raise(a) => {
                if vals.insert(&*a as *const Val) {
                    work.push(Val::clone(&a));
                }
            }
            // What a cell holds while staging is not what it will hold, but
            // this is the only moment there is to check.
            Val::Cell(i) => work.push(h.cells[i].clone()),
            Val::Clo(env, _) => {
                let mut cur = Some(env);
                while let Some(e) = cur {
                    if !envs.insert(Shared::as_ptr(&e.0)) {
                        break;
                    }
                    work.extend(e.0.vals.iter().cloned());
                    cur = e.0.parent.clone();
                }
            }
            _ => {}
        }
    }
    false
}

/// One `cons` statement per node, post-order, so the residual allocates the
/// structure rather than carrying it as a constant. `refusal` is the door this
/// was reached through - the same closure is `unliftable` under `lift` and
/// `unreturnable` at a region's end.
fn cons_syntax<M: Mail>(v: &Val, refusal: &'static str, h: &mut Store<M>) -> Result<Exp, Fault> {
    // `None` is "both components are done, cons them".
    let mut work: Vec<Option<&Val>> = vec![Some(v)];
    let mut done: Vec<RcExp> = Vec::new();
    while let Some(step) = work.pop() {
        match step {
            Some(Val::Pair(a, b)) => {
                work.push(None);
                work.push(Some(b));
                work.push(Some(a));
            }
            Some(leaf) => done.push(
                as_syntax(leaf).ok_or_else(|| throw(refusal, Val::Sym(kind_of(leaf).into())))?,
            ),
            None => {
                let cdr = done.pop().expect("cdr");
                let car = done.pop().expect("car");
                let named = h.reflect(Exp::Prim2(Prim2::Cons, car, cdr));
                done.push(rc_exp(named));
            }
        }
    }
    Ok(RcExp::unwrap_or_clone(done.pop().expect("one result")))
}

/// `None` when nothing is code, so the caller computes instead; an error when
/// something is code and something else cannot join it.
fn staged_operands(vs: &[Val], op: &str) -> Option<Result<Vec<RcExp>, Fault>> {
    if !vs.iter().any(|v| matches!(v, Val::Code(_))) {
        return None;
    }
    Some(
        vs.iter()
            .map(|v| as_syntax(v).ok_or_else(|| wrong_type(op)))
            .collect(),
    )
}

/// The floor's only route to the world. It knows nothing about tasks beyond an
/// address being an s-expression; the scheduler supplies this.
pub trait Mail: Send {
    fn spawn(&mut self, thunk: Val) -> Result<Val, Val>;
    fn send(&mut self, addr: &Val, msg: Val) -> Result<Val, Val>;
    /// `None` means the mailbox is empty, which is the only reason
    /// anything in this machine ever blocks.
    fn receive(&mut self) -> Option<Val>;
    fn monitor(&mut self, addr: &Val) -> Result<Val, Val>;
    fn limit(&mut self, addr: &Val, turns: i64) -> Result<Val, Val>;
}

/// Every operation throws, so a bare evaluator is usable and a stray `send` is
/// catchable rather than a panic.
#[derive(Default)]
pub struct NoMail;

impl Mail for NoMail {
    fn spawn(&mut self, _: Val) -> Result<Val, Val> {
        Err(Val::Sym("no-scheduler".into()))
    }
    fn send(&mut self, _: &Val, _: Val) -> Result<Val, Val> {
        Err(Val::Sym("no-scheduler".into()))
    }
    fn receive(&mut self) -> Option<Val> {
        None
    }
    fn monitor(&mut self, _: &Val) -> Result<Val, Val> {
        Err(Val::Sym("no-scheduler".into()))
    }
    fn limit(&mut self, _: &Val, _: i64) -> Result<Val, Val> {
        Err(Val::Sym("no-scheduler".into()))
    }
}

/// The store, in the CESK sense. Cells and the mailbox are effects and survive
/// a `catch`; `fresh` and `block` are staging state and do not. Tasks may share
/// effects but never staging state - one interleaved block is two half
/// residuals.
pub struct Store<M: Mail = NoMail> {
    pub fresh: usize,
    /// Statements of the innermost open reify scope, drained into a `Let`-chain
    /// when it closes. This is where ANF comes from.
    pub block: Vec<Exp>,
    fun: FunTable,
    /// What [`Prim1::IsCodeFun`] answers about. Restored like `fun`: an
    /// abandoned region's variable numbers are handed out again.
    lams: Shared<Vec<usize>>,
    pub level: usize,
    /// `Val::Cell(i)` indexes here
    pub cells: Vec<Val>,
    pub mail: M,
}

impl<M: Mail + Default> Default for Store<M> {
    fn default() -> Self {
        Store::new(M::default())
    }
}

impl<M: Mail> Store<M> {
    pub fn new(mail: M) -> Store<M> {
        Store {
            fresh: 0,
            block: Vec::new(),
            fun: Shared::new(Vec::new()),
            lams: Shared::new(Vec::new()),
            level: 0,
            cells: Vec::new(),
            mail,
        }
    }

    pub fn fresh_var(&mut self) -> usize {
        let v = self.fresh;
        self.fresh += 1;
        v
    }

    fn find_fun(&self, env: &Env, body: &RcExp) -> Option<usize> {
        // Body first: a pointer hit on the same `Lam` node is the common case,
        // and the environment comparison only runs after.
        self.fun.iter().find_map(|(k, level)| {
            let same_body = RcExp::ptr_eq(&k.body, body) || *k.body == **body;
            (same_body && env_equal(&k.env, env)).then_some(*level)
        })
    }

    fn register_fun(&mut self, level: usize, env: &Env, body: &RcExp) {
        Shared::make_mut(&mut self.fun).push((
            FunKey {
                env: env.clone(),
                body: RcExp::clone(body),
            },
            level,
        ));
    }

    /// Called twice for one `lift-fun`, for the name the body knows itself by
    /// and the name outside - the same number, since the scope restore puts
    /// `fresh` back before the `Lam` is reflected.
    fn register_lam(&mut self, level: usize) {
        Shared::make_mut(&mut self.lams).push(level);
    }

    fn is_lam(&self, e: &Exp) -> bool {
        matches!(e, Exp::Var(n) if self.lams.contains(n))
    }

    /// The paper's `reflect`.
    pub fn reflect(&mut self, e: Exp) -> Exp {
        self.block.push(e);
        Exp::Var(self.fresh_var())
    }

    pub fn reflectc(&mut self, e: Exp) -> Val {
        code(self.reflect(e))
    }
}

/// Staging state saved across a region that may be abandoned.
pub struct Scope {
    fresh: usize,
    block: Vec<Exp>,
    fun: FunTable,
    lams: Shared<Vec<usize>>,
}

impl Scope {
    /// Sets the region's statements aside and opens an empty block, so an
    /// abandoned region cannot leave half a `Let`-chain behind.
    fn save<M: Mail>(h: &mut Store<M>) -> Scope {
        Scope {
            fresh: h.fresh,
            block: std::mem::take(&mut h.block),
            // A refcount bump, not a copy; `register_fun` writes through
            // `make_mut`, so an earlier snapshot stays intact.
            fun: Shared::clone(&h.fun),
            lams: Shared::clone(&h.lams),
        }
    }

    /// Discards everything the region staged; callers wanting to keep the
    /// staged form drain the block first.
    fn restore<M: Mail>(self, h: &mut Store<M>) {
        h.fresh = self.fresh;
        h.block = self.block;
        h.fun = self.fun;
        h.lams = self.lams;
    }
}

/// Where ANF comes from: one `Let` binding per reflected statement, in
/// emission order, ending in `tail`.
pub fn drain(stmts: Vec<Exp>, tail: Exp) -> Exp {
    stmts
        .into_iter()
        .rev()
        .fold(tail, |acc, stmt| Exp::Let(rc_exp(stmt), rc_exp(acc)))
}

/// How leniently a value is coerced to syntax.
#[derive(Debug, Clone, Copy, PartialEq, Eq)]
pub enum ForceMode {
    /// `lift`: scalars fold, a pair is built, a closure η-expands.
    Lift,
    /// What a staged site requires of a result. Stops short of
    /// [`Lift`](ForceMode::Lift) at closures: η-expanding one would compile a
    /// function nobody asked to compile, freezing its semantics.
    Scalar,
    /// `force-code`: code or an error, so a branch that fails to produce code
    /// is caught rather than silently η-expanded.
    Strict,
}

/// What surrounding staged form a completed reify scope slots into.
pub enum Reify {
    IfTrue { c: RcExp, env: Env, f: RcExp },
    IfFalse { c: RcExp, t: RcExp },
    RunStaged { b: RcExp },
    RunNowInner { env: Env },
    LiftRefDone { s1: RcExp },
    CatchDone,
    Produce,
}

/// What to do with the expression a [`Cont::ForceCode`] produces.
pub enum Then {
    /// Drain the block into a `Let`-chain, restore the scope, dispatch `then`.
    Drain {
        saved: Scope,
        then: Reify,
    },
    WrapAsCode,
    IsCodeStaged {
        s1: RcExp,
    },
}

pub enum Mode {
    Eval { env: Env, exp: RcExp },
    Apply { val: Val },
}

pub enum Cont {
    Prim1Finish {
        op: Prim1,
    },
    Prim2Right {
        env: Env,
        op: Prim2,
        e2: RcExp,
    },
    Prim2Finish {
        op: Prim2,
        v1: Val,
    },
    /// The operator goes into `done` alongside the arguments because that is
    /// the frame the callee is entered under - a closure binds itself first.
    /// So an empty `done` means the operator is still being evaluated, which is
    /// how `receives` tells operator position from argument position.
    AppArgs {
        env: Env,
        args: Box<[RcExp]>,
        done: Vec<Val>,
    },
    ApplyArgs {
        env: Env,
        args: RcExp,
    },
    ApplyFinish {
        f: Val,
    },
    LiftFunClo {
        env: Env,
        f: RcExp,
    },
    LiftFunGo {
        arity: u16,
    },
    OpArgs {
        idx: u16,
        env: Env,
        args: Vec<RcExp>,
        next: usize,
        done: Vec<Val>,
    },
    IfDispatch {
        env: Env,
        then_: RcExp,
        else_: RcExp,
    },
    LetBody {
        env: Env,
        body: RcExp,
    },
    /// Carries the staging state to roll back to, so an abandoned region
    /// leaves no half-built block behind.
    CatchExit {
        saved: Scope,
    },
    ThrowFinish,

    // ── staging ────────────────────────────────────────────────────────
    LiftFinish,
    /// The iterative form of the reference's `force-code`, so a closure
    /// η-expansion grows the continuation stack rather than Rust's.
    ForceCode {
        mode: ForceMode,
        then: Then,
    },
    LiftCloFinish {
        arity: u16,
        then: Then,
    },
    /// A block that stayed empty means nothing staged, so the value passes
    /// through unchanged.
    ReifyVExit {
        saved: Scope,
    },
    RunNowExit {
        saved_level: usize,
    },
    LiftRefDispatch {
        env: Env,
        e2: RcExp,
    },
    LiftRefPersist,
    RunDispatch {
        env: Env,
        e: RcExp,
    },
    IsCodeRight {
        env: Env,
        e2: RcExp,
    },
    IsCodeFinish {
        v1: Val,
    },
    EvalmsRight {
        env: Env,
        e2: RcExp,
    },
    EvalmsFinish {
        env_val: Val,
    },
}

pub struct Machine {
    mode: Mode,
    kont: Vec<Cont>,
}

pub enum Step {
    Running,
    /// The mailbox was empty. The machine has not consumed the step and
    /// will retry the same `receive` when stepped again.
    Blocked,
    Done(Val),
}

impl Machine {
    pub fn new(env: Env, exp: RcExp) -> Machine {
        Machine {
            mode: Mode::Eval { env, exp },
            kont: Vec::new(),
        }
    }

    /// A machine poised to apply `f` to `arg`. How a spawned task starts:
    /// its thunk arrives as a value, never as syntax, so both ride in as
    /// [`Exp::Proc`], the carrier cross-stage persistence uses.
    pub fn applying(f: Val, arg: Val) -> Machine {
        let call = Exp::App(
            rc_exp(Exp::Proc(rc_val(f))),
            Box::new([rc_exp(Exp::Proc(rc_val(arg)))]),
        );
        Machine::new(Env::default(), rc_exp(call))
    }

    pub fn step<M: Mail>(&mut self, h: &mut Store<M>) -> Result<Step, Fault> {
        // A blocking receive must not consume its continuation, so it is
        // detected before anything is popped. A *staged* receive is an
        // ordinary primitive and takes the normal path.
        if let (Mode::Apply { val }, Some(Cont::Prim1Finish { op: Prim1::Receive })) =
            (&self.mode, self.kont.last())
        {
            if !matches!(val, Val::Code(_)) {
                match h.mail.receive() {
                    Some(msg) => {
                        self.kont.pop();
                        self.mode = Mode::Apply { val: msg };
                        return Ok(Step::Running);
                    }
                    None => return Ok(Step::Blocked),
                }
            }
        }

        if let Mode::Apply { val } = &self.mode {
            if self.kont.is_empty() {
                return Ok(Step::Done(val.clone()));
            }
            let top = self.kont.last().expect("checked non-empty");
            if matches!(val, Val::Raise(_)) && !receives(top) {
                self.propagate(h);
                return Ok(Step::Running);
            }
        }

        let mode = std::mem::replace(&mut self.mode, Mode::Apply { val: Val::Nil });
        let next = match mode {
            Mode::Eval { env, exp } => self.eval(env, exp, h),
            Mode::Apply { val } => {
                let k = self.kont.pop().expect("checked non-empty");
                self.resume(k, val, h)
            }
        };

        match next {
            Ok(mode) => {
                self.mode = mode;
                Ok(Step::Running)
            }
            Err(Fault::Throw(v)) => {
                self.mode = Mode::Apply {
                    val: super::raise(v),
                };
                Ok(Step::Running)
            }
            Err(bug) => Err(bug),
        }
    }

    /// Carry a raise past one continuation (see [`receives`]). A frame that
    /// opened a staging scope restores it, leaving no half-built block behind.
    fn propagate<M: Mail>(&mut self, h: &mut Store<M>) {
        match self.kont.pop().expect("checked non-empty") {
            // The one frame that stops a raise.
            Cont::CatchExit { saved } => {
                saved.restore(h);
                if let Mode::Apply { val: Val::Raise(v) } = &self.mode {
                    self.mode = Mode::Apply { val: Val::clone(v) };
                }
            }
            Cont::ReifyVExit { saved }
            | Cont::ForceCode {
                then: Then::Drain { saved, .. },
                ..
            } => saved.restore(h),
            Cont::RunNowExit { saved_level } => h.level = saved_level,
            _ => {}
        }
    }

    pub fn run<M: Mail>(mut self, h: &mut Store<M>) -> Result<Val, Fault> {
        loop {
            match self.step(h)? {
                Step::Running => {}
                Step::Done(v) => return Ok(v),
                Step::Blocked => return Err(throw("blocked", Val::Sym("no-scheduler".into()))),
            }
        }
    }

    /// One turn: step until the machine blocks, finishes, or spends the budget.
    /// `Blocked` is returned once, on the edge, so the scheduler never polls.
    pub fn turn<M: Mail>(
        &mut self,
        h: &mut Store<M>,
        budget: usize,
    ) -> Result<(Step, usize), Fault> {
        for spent in 0..budget {
            match self.step(h)? {
                Step::Running => {}
                other => return Ok((other, spent + 1)),
            }
        }
        Ok((Step::Running, budget))
    }

    /// A subexpression needing no frame: nothing to push, no step spent.
    /// Declines raises - a frame not pushed cannot be asked what it [`receives`].
    fn direct(exp: &RcExp, env: &Env) -> Option<Val> {
        let v = match &**exp {
            Exp::Lit(n) => Val::Num(*n),
            Exp::Flo(x) => Val::Flo(*x),
            Exp::Sym(s) => Val::Sym(s.clone()),
            Exp::Atom(a) => Val::Atom(a.clone()),
            Exp::Nil => Val::Nil,
            Exp::Proc(v) => Val::clone(v),
            // An unbound index declines, so the ordinary path reports it.
            Exp::Var(i) => env.get(*i)?.clone(),
            Exp::Lam(_, _) => Val::Clo(env.clone(), RcExp::clone(exp)),
            _ => return None,
        };
        (!matches!(v, Val::Raise(_))).then_some(v)
    }

    /// An all-direct primitive application, valid only where the frame
    /// [`receives`]: running it may already have emitted, so it cannot decline.
    fn direct_prim<M: Mail>(
        exp: &RcExp,
        env: &Env,
        h: &mut Store<M>,
    ) -> Option<Result<Val, Fault>> {
        Some(match &**exp {
            Exp::Prim1(op, e) if !matches!(op, Prim1::Receive) => {
                prim1(*op, Machine::direct(e, env)?, h)
            }
            Exp::Prim2(op, a, b) => {
                let x = Machine::direct(a, env)?;
                let y = Machine::direct(b, env)?;
                prim2(*op, x, y, h)
            }
            _ => return None,
        })
    }

    fn eval<M: Mail>(&mut self, env: Env, exp: RcExp, h: &mut Store<M>) -> Result<Mode, Fault> {
        let val = match &*exp {
            Exp::Lit(n) => Val::Num(*n),
            Exp::Flo(x) => Val::Flo(*x),
            Exp::Sym(s) => Val::Sym(s.clone()),
            Exp::Atom(a) => Val::Atom(a.clone()),
            Exp::Nil => Val::Nil,
            Exp::Proc(v) => Val::clone(v),

            Exp::Var(i) => match env.get(*i) {
                Some(v) => v.clone(),
                None => return Err(throw("unbound", Val::Num(*i as i64))),
            },

            // Closures from one node share the `Rc`, which is how repeated
            // lifts of the same closure recognise each other.
            Exp::Lam(_, _) => Val::Clo(env, RcExp::clone(&exp)),

            // `receive` is excluded: blocking is recognised by the frame this
            // fast path would not push (see the head of `step`).
            Exp::Prim1(op, e) => {
                if !matches!(op, Prim1::Receive) {
                    if let Some(v) = Machine::direct(e, &env) {
                        return Ok(Mode::Apply {
                            val: prim1(*op, v, h)?,
                        });
                    }
                }
                self.kont.push(Cont::Prim1Finish { op: *op });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(e),
                });
            }

            Exp::Prim2(op, a, b) => {
                if let Some(x) = Machine::direct(a, &env) {
                    return Ok(match Machine::direct(b, &env) {
                        Some(y) => Mode::Apply {
                            val: prim2(*op, x, y, h)?,
                        },
                        None => {
                            self.kont.push(Cont::Prim2Finish { op: *op, v1: x });
                            Mode::Eval {
                                env,
                                exp: RcExp::clone(b),
                            }
                        }
                    });
                }
                self.kont.push(Cont::Prim2Right {
                    env: env.clone(),
                    op: *op,
                    e2: RcExp::clone(b),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(a),
                });
            }

            // `done` is built to be the callee's frame: the operator first,
            // because a closure binds itself, then the arguments.
            Exp::App(f, args) => {
                let mut done = Vec::with_capacity(args.len() + 1);
                match Machine::direct(f, &env) {
                    Some(fv) => done.push(fv),
                    None => {
                        self.kont.push(Cont::AppArgs {
                            env: env.clone(),
                            args: args.clone(),
                            done,
                        });
                        return Ok(Mode::Eval {
                            env,
                            exp: RcExp::clone(f),
                        });
                    }
                }
                // An argument's frame [`receives`], so a primitive one needs no
                // frame either; the operator is a value and cannot have emitted.
                while let Some(a) = args.get(done.len() - 1) {
                    match Machine::direct(a, &env) {
                        Some(v) => done.push(v),
                        None => match Machine::direct_prim(a, &env, h) {
                            Some(Ok(v)) => done.push(v),
                            Some(Err(fault)) => {
                                self.kont.push(Cont::AppArgs {
                                    env,
                                    args: args.clone(),
                                    done,
                                });
                                return Err(fault);
                            }
                            None => break,
                        },
                    }
                }
                if done.len() == args.len() + 1 {
                    return self.enter(done, h);
                }
                let exp = RcExp::clone(&args[done.len() - 1]);
                self.kont.push(Cont::AppArgs {
                    env: env.clone(),
                    args: args.clone(),
                    done,
                });
                return Ok(Mode::Eval { env, exp });
            }

            // Both operands are inspected rather than bound, so neither
            // position [`receives`] and neither may take a fast path.
            Exp::Apply(f, args) => {
                self.kont.push(Cont::ApplyArgs {
                    env: env.clone(),
                    args: RcExp::clone(args),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(f),
                });
            }

            Exp::Op(idx, args) => {
                let mut done = Vec::with_capacity(args.len());
                while let Some(v) = args.get(done.len()).and_then(|e| Machine::direct(e, &env)) {
                    done.push(v);
                }
                if done.len() == args.len() {
                    return self.run_op(*idx, done, h);
                }
                let exp = RcExp::clone(&args[done.len()]);
                self.kont.push(Cont::OpArgs {
                    idx: *idx,
                    env: env.clone(),
                    args: args.clone(),
                    next: done.len() + 1,
                    done,
                });
                return Ok(Mode::Eval { env, exp });
            }

            // A staged condition still needs its frame: both arms are then
            // compiled, each under its own block.
            Exp::If(c, t, e) => {
                if let Some(v) = Machine::direct(c, &env) {
                    if !matches!(v, Val::Code(_)) {
                        return Ok(Mode::Eval {
                            env,
                            exp: match v {
                                Val::Num(0) | Val::Nil => RcExp::clone(e),
                                _ => RcExp::clone(t),
                            },
                        });
                    }
                    self.kont.push(Cont::IfDispatch {
                        env: env.clone(),
                        then_: RcExp::clone(t),
                        else_: RcExp::clone(e),
                    });
                    return Ok(Mode::Apply { val: v });
                }
                self.kont.push(Cont::IfDispatch {
                    env: env.clone(),
                    then_: RcExp::clone(t),
                    else_: RcExp::clone(e),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(c),
                });
            }

            // `LetBody` receives a raise, so a primitive init needs no frame.
            Exp::Let(init, body) => {
                let bound = match Machine::direct(init, &env) {
                    Some(v) => Some(v),
                    None => match Machine::direct_prim(init, &env, h) {
                        Some(Ok(v)) => Some(v),
                        // The throw has to land where it would have, so the
                        // frame goes on before the fault is let out.
                        Some(Err(f)) => {
                            self.kont.push(Cont::LetBody {
                                env,
                                body: RcExp::clone(body),
                            });
                            return Err(f);
                        }
                        None => None,
                    },
                };
                if let Some(v) = bound {
                    return Ok(Mode::Eval {
                        env: env.push_owned(v),
                        exp: RcExp::clone(body),
                    });
                }
                self.kont.push(Cont::LetBody {
                    env: env.clone(),
                    body: RcExp::clone(body),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(init),
                });
            }

            Exp::Catch(body) => {
                let saved = Scope::save(h);
                self.kont.push(Cont::CatchExit { saved });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(body),
                });
            }

            Exp::Throw(e) => {
                self.kont.push(Cont::ThrowFinish);
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(e),
                });
            }

            Exp::Lift(e) => {
                self.kont.push(Cont::LiftFinish);
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(e),
                });
            }

            Exp::LiftFun(n, f) => {
                self.kont.push(Cont::LiftFunClo {
                    env: env.clone(),
                    f: RcExp::clone(f),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(n),
                });
            }

            // Not a `Prim2`: the dispatch on the first operand happens before
            // the second is evaluated, since a staged first operand means the
            // second must be evaluated inside a reify scope.
            Exp::LiftRef(a, b) => {
                self.kont.push(Cont::LiftRefDispatch {
                    env: env.clone(),
                    e2: RcExp::clone(b),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(a),
                });
            }

            Exp::Run(b, e) => {
                self.kont.push(Cont::RunDispatch {
                    env: env.clone(),
                    e: RcExp::clone(e),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(b),
                });
            }

            Exp::IsCode(a, b) => {
                self.kont.push(Cont::IsCodeRight {
                    env: env.clone(),
                    e2: RcExp::clone(b),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(a),
                });
            }

            Exp::Evalms(a, b) => {
                self.kont.push(Cont::EvalmsRight {
                    env: env.clone(),
                    e2: RcExp::clone(b),
                });
                return Ok(Mode::Eval {
                    env,
                    exp: RcExp::clone(a),
                });
            }
        };
        Ok(Mode::Apply { val })
    }

    fn resume<M: Mail>(&mut self, k: Cont, val: Val, h: &mut Store<M>) -> Result<Mode, Fault> {
        match k {
            Cont::Prim1Finish { op } => Ok(Mode::Apply {
                val: prim1(op, val, h)?,
            }),

            Cont::Prim2Right { env, op, e2 } => {
                self.kont.push(Cont::Prim2Finish { op, v1: val });
                Ok(Mode::Eval { env, exp: e2 })
            }

            Cont::Prim2Finish { op, v1 } => Ok(Mode::Apply {
                val: prim2(op, v1, val, h)?,
            }),

            Cont::AppArgs {
                env,
                args,
                mut done,
            } => {
                done.push(val);
                if done.len() == args.len() + 1 {
                    return self.enter(done, h);
                }
                let exp = RcExp::clone(&args[done.len() - 1]);
                self.kont.push(Cont::AppArgs {
                    env: env.clone(),
                    args,
                    done,
                });
                Ok(Mode::Eval { env, exp })
            }

            Cont::ApplyArgs { env, args } => {
                self.kont.push(Cont::ApplyFinish { f: val });
                Ok(Mode::Eval { env, exp: args })
            }

            Cont::ApplyFinish { f } => {
                let mut done = vec![f];
                let mut rest = val;
                loop {
                    match rest {
                        Val::Nil => break,
                        Val::Pair(a, d) => {
                            done.push(RcVal::unwrap_or_clone(a));
                            rest = RcVal::unwrap_or_clone(d);
                        }
                        _ => return Err(wrong_type("apply")),
                    }
                }
                self.enter(done, h)
            }

            Cont::OpArgs {
                idx,
                env,
                args,
                next,
                mut done,
            } => {
                done.push(val);
                if next == args.len() {
                    return self.run_op(idx, done, h);
                }
                let exp = RcExp::clone(&args[next]);
                self.kont.push(Cont::OpArgs {
                    idx,
                    env: env.clone(),
                    args,
                    next: next + 1,
                    done,
                });
                Ok(Mode::Eval { env, exp })
            }

            // Each arm gets its own block: a statement emitted inside one arm
            // may not escape into the surrounding sequence.
            Cont::IfDispatch { env, then_, else_ } => match val {
                Val::Code(c) => {
                    let saved = Scope::save(h);
                    self.kont.push(Cont::ForceCode {
                        mode: ForceMode::Scalar,
                        then: Then::Drain {
                            saved,
                            then: Reify::IfTrue {
                                c,
                                env: env.clone(),
                                f: else_,
                            },
                        },
                    });
                    Ok(Mode::Eval { env, exp: then_ })
                }
                Val::Num(0) | Val::Nil => Ok(Mode::Eval { env, exp: else_ }),
                _ => Ok(Mode::Eval { env, exp: then_ }),
            },

            Cont::LetBody { env, body } => Ok(Mode::Eval {
                env: env.push_owned(val),
                exp: body,
            }),

            // Optimistically a reify scope: a body that staged nothing produces
            // its value directly, one that staged anything residualizes the
            // `catch`, so error handling survives compilation.
            Cont::CatchExit { saved } => {
                if h.block.is_empty() && !matches!(val, Val::Code(_)) {
                    saved.restore(h);
                    return Ok(Mode::Apply { val });
                }
                // A body that staged an effect can still end in a plain value,
                // so the tail is lifted rather than required to be code.
                self.kont.push(Cont::ForceCode {
                    mode: ForceMode::Lift,
                    then: Then::Drain {
                        saved,
                        then: Reify::CatchDone,
                    },
                });
                Ok(Mode::Apply { val })
            }

            // Throwing a code value residualizes the throw rather than
            // performing one at staging time.
            Cont::ThrowFinish => match val {
                Val::Code(e) => Ok(Mode::Apply {
                    val: h.reflectc(Exp::Throw(e)),
                }),
                v => Ok(Mode::Apply {
                    val: super::raise(v),
                }),
            },

            // ── staging ────────────────────────────────────────────────

            // Only a closure needs the continuation stack; the rest force
            // synchronously.
            Cont::LiftFunClo { env, f } => {
                let arity = match val {
                    Val::Num(n) => u16::try_from(n).map_err(|_| wrong_type("lift-fun"))?,
                    _ => return Err(wrong_type("lift-fun")),
                };
                self.kont.push(Cont::LiftFunGo { arity });
                Ok(Mode::Eval { env, exp: f })
            }

            // The same eta-expansion a closure lift does, but with the frame
            // handed over as a list: the expansion is a floor closure of one
            // argument whatever arity it is writing.
            Cont::LiftFunGo { arity } => {
                let saved = Scope::save(h);
                // Allocated in the order the body indexes them, the closure's
                // own name first - which is the one thing the body could not
                // otherwise find out about a residual variable.
                h.register_lam(h.fresh);
                let vars: Vec<Val> = (0..=arity).map(|_| code(Exp::Var(h.fresh_var()))).collect();
                let frame = vars
                    .into_iter()
                    .rev()
                    .fold(Val::Nil, |t, v| Val::Pair(rc_val(v), rc_val(t)));
                self.kont.push(Cont::LiftCloFinish {
                    arity,
                    then: Then::WrapAsCode,
                });
                // Scalar, unlike the `lift` of a floor closure below: an object
                // function that answers with a constant is ordinary.
                self.kont.push(Cont::ForceCode {
                    mode: ForceMode::Scalar,
                    then: Then::Drain {
                        saved,
                        then: Reify::Produce,
                    },
                });
                self.enter(vec![val, frame], h)
            }

            Cont::LiftFinish => {
                self.kont.push(Cont::ForceCode {
                    mode: ForceMode::Lift,
                    then: Then::WrapAsCode,
                });
                Ok(Mode::Apply { val })
            }

            Cont::ForceCode { mode, then } => self.force(mode, then, val, h),

            Cont::LiftCloFinish { arity, then } => {
                let body = match val {
                    Val::Code(e) => RcExp::unwrap_or_clone(e),
                    _ => return Err(wrong_type("lift")),
                };
                // The scope restore put `fresh` back to the level this closure
                // was registered at, so this reflect allocates that level.
                let produced = h.reflect(Exp::Lam(arity, rc_exp(body)));
                // Again, for the scope outside: the registration made before the
                // body was staged went out with the restore that closed it.
                if let Exp::Var(n) = produced {
                    h.register_lam(n);
                }
                self.dispatch_then(then, produced, h)
            }

            Cont::ReifyVExit { saved } => {
                let stmts = std::mem::take(&mut h.block);
                let out = if stmts.is_empty() {
                    val
                } else {
                    match val {
                        Val::Code(e) => code(drain(stmts, RcExp::unwrap_or_clone(e))),
                        _ => {
                            return Err(Fault::Bug(
                                "reify: non-empty block with a non-code result".into(),
                            ))
                        }
                    }
                };
                saved.restore(h);
                Ok(Mode::Apply { val: out })
            }

            Cont::RunNowExit { saved_level } => {
                h.level = saved_level;
                Ok(Mode::Apply { val })
            }

            Cont::LiftRefDispatch { env, e2 } => match val {
                Val::Code(s1) => {
                    let saved = Scope::save(h);
                    self.kont.push(Cont::ForceCode {
                        mode: ForceMode::Lift,
                        then: Then::Drain {
                            saved,
                            then: Reify::LiftRefDone { s1 },
                        },
                    });
                    Ok(Mode::Eval { env, exp: e2 })
                }
                _ => {
                    self.kont.push(Cont::LiftRefPersist);
                    Ok(Mode::Eval { env, exp: e2 })
                }
            },

            // Cross-stage persistence is by reference, never structural, so a
            // free closure keeps its identity instead of being η-recompiled -
            // which is why it must be a whole value, refused here where the
            // program still says which operand it was.
            Cont::LiftRefPersist => {
                // The tag, not the value: what fails here is a graph with enough
                // sharing to have no printed form, so carrying it out would
                // trade a diagnosis for a hang.
                if has_holes(&val, h) {
                    return Err(throw("unpersistable", Val::Sym(kind_of(&val).into())));
                }
                Ok(Mode::Apply {
                    val: Val::Code(rc_exp(Exp::Proc(rc_val(val)))),
                })
            }

            Cont::RunDispatch { env, e } => match val {
                Val::Code(b) => {
                    let saved = Scope::save(h);
                    self.kont.push(Cont::ForceCode {
                        mode: ForceMode::Strict,
                        then: Then::Drain {
                            saved,
                            then: Reify::RunStaged { b },
                        },
                    });
                    Ok(Mode::Eval { env, exp: e })
                }
                // Compile under an inner scope, then execute what it produced
                // under an outer one. Three continuations, firing inside out.
                _ => {
                    let env_len = env.len();
                    self.kont.push(Cont::RunNowExit {
                        saved_level: h.level,
                    });
                    h.level += 1;

                    let saved_outer = Scope::save(h);
                    self.kont.push(Cont::ReifyVExit { saved: saved_outer });

                    let saved_inner = Scope::save(h);
                    self.kont.push(Cont::ForceCode {
                        mode: ForceMode::Strict,
                        then: Then::Drain {
                            saved: saved_inner,
                            then: Reify::RunNowInner { env: env.clone() },
                        },
                    });

                    // The compiled program is closed over this environment, so
                    // its residual variables start above the bindings in scope.
                    h.fresh = env_len;
                    Ok(Mode::Eval { env, exp: e })
                }
            },

            Cont::IsCodeRight { env, e2 } => {
                self.kont.push(Cont::IsCodeFinish { v1: val });
                Ok(Mode::Eval { env, exp: e2 })
            }

            Cont::IsCodeFinish { v1 } => match v1 {
                Val::Code(s1) => {
                    self.kont.push(Cont::ForceCode {
                        mode: ForceMode::Strict,
                        then: Then::IsCodeStaged { s1 },
                    });
                    Ok(Mode::Apply { val })
                }
                _ => Ok(Mode::Apply {
                    val: bool_val(matches!(val, Val::Code(_))),
                }),
            },

            Cont::EvalmsRight { env, e2 } => {
                self.kont.push(Cont::EvalmsFinish { env_val: val });
                Ok(Mode::Eval { env, exp: e2 })
            }

            Cont::EvalmsFinish { env_val } => {
                let env = env_from_list(&env_val)?;
                let exp = match val {
                    Val::Code(e) => e,
                    _ => return Err(wrong_type("evalms")),
                };
                let saved = Scope::save(h);
                self.kont.push(Cont::ReifyVExit { saved });
                Ok(Mode::Eval { env, exp })
            }
        }
    }

    /// Coerce a value to syntax. Every case but a closure is immediate; a
    /// closure η-expands through the continuation stack, so lifting a deeply
    /// recursive function cannot overflow.
    fn force<M: Mail>(
        &mut self,
        mode: ForceMode,
        then: Then,
        val: Val,
        h: &mut Store<M>,
    ) -> Result<Mode, Fault> {
        if let ForceMode::Strict | ForceMode::Scalar = mode {
            let immediate = match (mode, &val) {
                // The one structure this mode builds: a region answering with a
                // pair is answering with a result, not leaking an artefact.
                (ForceMode::Scalar, Val::Pair(_, _)) => {
                    Some(rc_exp(cons_syntax(&val, "unreturnable", h)?))
                }
                (ForceMode::Scalar, v) => as_syntax(v),
                (_, Val::Code(e)) => Some(RcExp::clone(e)),
                _ => None,
            };
            return match immediate {
                Some(e) => {
                    let produced = RcExp::unwrap_or_clone(e);
                    self.dispatch_then(then, produced, h)
                }
                // Nothing is named at a scalar boundary - the region merely
                // ended - so the refusal is named for the boundary instead.
                None if mode == ForceMode::Scalar => {
                    Err(throw("unreturnable", Val::Sym(kind_of(&val).into())))
                }
                None => Err(wrong_type("force-code")),
            };
        }
        match val {
            Val::Code(e) => {
                let produced = RcExp::unwrap_or_clone(e);
                self.dispatch_then(then, produced, h)
            }
            Val::Num(n) => self.dispatch_then(then, Exp::Lit(n), h),
            Val::Flo(x) => self.dispatch_then(then, Exp::Flo(x), h),
            Val::Sym(s) => self.dispatch_then(then, Exp::Sym(s), h),
            Val::Atom(a) => self.dispatch_then(then, Exp::Atom(a), h),
            Val::Nil => self.dispatch_then(then, Exp::Nil, h),

            // Folding a cell would freeze its contents at staging time. Cell
            // *operations* residualize; the cell itself is not syntax.
            Val::Cell(_) => Err(throw("unliftable", Val::Sym("cell".into()))),

            // Unreachable in practice - `step` propagates past a frame that
            // inspects - but coercing a raise to syntax would lose it.
            v @ Val::Raise(_) => Ok(Mode::Apply { val: v }),

            Val::Pair(a, b) => {
                let produced = cons_syntax(&Val::Pair(a, b), "unliftable", h)?;
                self.dispatch_then(then, produced, h)
            }

            Val::Clo(cenv, lam) => {
                let Exp::Lam(arity, body) = &*lam else {
                    return Err(Fault::Bug(format!("closure over {lam}")));
                };
                let (arity, body) = (*arity, RcExp::clone(body));
                // Already expanded in this scope: resolving to the variable
                // naming it is what stops a recursive lift.
                if let Some(n) = h.find_fun(&cenv, &lam) {
                    return self.dispatch_then(then, Exp::Var(n), h);
                }
                let level = h.fresh;
                h.register_fun(level, &cenv, &lam);

                let saved = Scope::save(h);
                // One variable for the closure's own name, then one per
                // parameter, in the order the body indexes them.
                let mut frame = Vec::with_capacity(usize::from(arity) + 1);
                for _ in 0..=arity {
                    frame.push(code(Exp::Var(h.fresh_var())));
                }
                let env = cenv.frame(frame);

                self.kont.push(Cont::LiftCloFinish { arity, then });
                // Strict: a lifted closure's body must itself produce code.
                // `(lift (lambda 5))` is an error - lift the 5.
                self.kont.push(Cont::ForceCode {
                    mode: ForceMode::Strict,
                    then: Then::Drain {
                        saved,
                        then: Reify::Produce,
                    },
                });
                Ok(Mode::Eval { env, exp: body })
            }
        }
    }

    fn dispatch_then<M: Mail>(
        &mut self,
        then: Then,
        produced: Exp,
        h: &mut Store<M>,
    ) -> Result<Mode, Fault> {
        match then {
            Then::WrapAsCode => Ok(Mode::Apply {
                val: code(produced),
            }),
            Then::IsCodeStaged { s1 } => Ok(Mode::Apply {
                val: h.reflectc(Exp::IsCode(s1, rc_exp(produced))),
            }),
            Then::Drain { saved, then } => {
                let stmts = std::mem::take(&mut h.block);
                let built = drain(stmts, produced);
                saved.restore(h);
                self.dispatch_reify(then, built, h)
            }
        }
    }

    fn dispatch_reify<M: Mail>(
        &mut self,
        then: Reify,
        built: Exp,
        h: &mut Store<M>,
    ) -> Result<Mode, Fault> {
        match then {
            Reify::IfTrue { c, env, f } => {
                let saved = Scope::save(h);
                self.kont.push(Cont::ForceCode {
                    mode: ForceMode::Scalar,
                    then: Then::Drain {
                        saved,
                        then: Reify::IfFalse {
                            c,
                            t: rc_exp(built),
                        },
                    },
                });
                Ok(Mode::Eval { env, exp: f })
            }
            Reify::IfFalse { c, t } => Ok(Mode::Apply {
                val: h.reflectc(Exp::If(c, t, rc_exp(built))),
            }),
            Reify::RunStaged { b } => Ok(Mode::Apply {
                val: h.reflectc(Exp::Run(b, rc_exp(built))),
            }),
            Reify::LiftRefDone { s1 } => Ok(Mode::Apply {
                val: h.reflectc(Exp::LiftRef(s1, rc_exp(built))),
            }),
            // The inner scope's code is executed here; its value flows to the
            // outer scope waiting below on the stack.
            Reify::RunNowInner { env } => Ok(Mode::Eval {
                env,
                exp: rc_exp(built),
            }),
            Reify::CatchDone => Ok(Mode::Apply {
                val: h.reflectc(Exp::Catch(rc_exp(built))),
            }),
            Reify::Produce => Ok(Mode::Apply { val: code(built) }),
        }
    }

    /// Apply the operator at the head of `done` to the arguments behind it.
    /// `done` is already the frame the callee runs in - a closure binds itself
    /// then its parameters - so it becomes the environment chunk whole.
    fn enter<M: Mail>(&mut self, done: Vec<Val>, h: &mut Store<M>) -> Result<Mode, Fault> {
        let arity = done.len() - 1;
        match &done[0] {
            Val::Clo(cenv, lam) => {
                let Exp::Lam(n, body) = &**lam else {
                    return Err(Fault::Bug(format!("closure over {lam}")));
                };
                if usize::from(*n) != arity {
                    return Err(throw("arity", Val::Num(arity as i64)));
                }
                let (cenv, body) = (cenv.clone(), RcExp::clone(body));
                Ok(Mode::Eval {
                    env: cenv.frame(done),
                    exp: body,
                })
            }

            // A code operator residualizes the whole application, so the
            // arguments join it as constants; anything with no syntactic form
            // is the type error. Same rule as the primitives and host ops.
            Val::Code(_) => {
                let mut parts = staged_operands(&done, "app").expect("operator is code")?;
                let f = parts.remove(0);
                Ok(Mode::Apply {
                    val: h.reflectc(Exp::App(f, parts.into())),
                })
            }

            _ => Err(wrong_type("app")),
        }
    }

    fn run_op<M: Mail>(
        &mut self,
        idx: u16,
        args: Vec<Val>,
        h: &mut Store<M>,
    ) -> Result<Mode, Fault> {
        let def = host::registry().get(idx);
        if args.len() != def.arity {
            return Err(throw("arity", Val::Sym(def.name.into())));
        }
        // The staging rule for the whole table, the same one the core
        // primitives follow: one staged operand stages the call, and the rest
        // join it as constants of the residual.
        if let Some(parts) = staged_operands(&args, def.name) {
            return Ok(Mode::Apply {
                val: h.reflectc(Exp::Op(idx, parts?)),
            });
        }
        match (def.run)(&args) {
            Ok(v) => Ok(Mode::Apply { val: v }),
            Err(v) => Err(Fault::Throw(v)),
        }
    }
}

fn bool_val(b: bool) -> Val {
    Val::Num(if b { 1 } else { 0 })
}

/// `evalms` takes its environment as an ordinary list, so a program can build
/// one. De Bruijn indices count from the front, the order the list has.
fn env_from_list(v: &Val) -> Result<Env, Fault> {
    let mut vals = Vec::new();
    let mut cur = v;
    loop {
        match cur {
            Val::Nil => return Ok(Env::new(vals)),
            Val::Pair(a, b) => {
                vals.push(Val::clone(a));
                cur = b;
            }
            _ => return Err(wrong_type("evalms")),
        }
    }
}

/// Whether a frame takes delivery of a raise rather than passing it on. Two
/// ways to be on this list: a frame that only *binds* the value it resumes
/// with (so object code can be handed a raise and decide for itself), or one
/// that asks the question (`raise?`, `raise-value`). Everything else - operator
/// position, arithmetic operand, condition, lift - propagates.
fn receives(k: &Cont) -> bool {
    match k {
        // An argument is only bound, so a raise passes into the callee as an
        // ordinary value. An operator is inspected, so it does not.
        Cont::AppArgs { done, .. } => !done.is_empty(),
        Cont::LetBody { .. }
        | Cont::Prim1Finish {
            op: Prim1::IsRaise | Prim1::RaiseValue,
        } => true,
        _ => false,
    }
}

fn prim1<M: Mail>(op: Prim1, v: Val, h: &mut Store<M>) -> Result<Val, Fault> {
    // Every predicate answers `false` for another type but residualizes for
    // code, since at staging time the type is unknown.
    macro_rules! pred {
        ($ctor:expr, $pat:pat) => {
            match v {
                Val::Code(e) => Ok(h.reflectc($ctor(e))),
                ref x => Ok(bool_val(matches!(x, $pat))),
            }
        };
    }
    match op {
        Prim1::IsNum => pred!(|e| Exp::Prim1(Prim1::IsNum, e), Val::Num(_) | Val::Flo(_)),
        Prim1::IsSym => pred!(|e| Exp::Prim1(Prim1::IsSym, e), Val::Sym(_)),
        Prim1::IsNil => pred!(|e| Exp::Prim1(Prim1::IsNil, e), Val::Nil),
        Prim1::IsPair => pred!(|e| Exp::Prim1(Prim1::IsPair, e), Val::Pair(_, _)),

        Prim1::Car => match v {
            Val::Pair(a, _) => Ok(Val::clone(&a)),
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::Car, e))),
            _ => Err(wrong_type("car")),
        },
        Prim1::Cdr => match v {
            Val::Pair(_, b) => Ok(Val::clone(&b)),
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::Cdr, e))),
            _ => Err(wrong_type("cdr")),
        },

        Prim1::CellNew => match v {
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::CellNew, e))),
            v => {
                h.cells.push(v);
                Ok(Val::Cell(h.cells.len() - 1))
            }
        },
        Prim1::CellRead => match v {
            Val::Cell(i) => Ok(h.cells[i].clone()),
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::CellRead, e))),
            _ => Err(wrong_type("cell-read")),
        },

        // Deliberately exempt from the rule `send` obeys: a thunk stays a live
        // closure, so spawning is heap-local by construction - the child shares
        // the captured cells. Starting a task elsewhere is a message, not this.
        Prim1::Spawn => match v {
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::Spawn, e))),
            v => h.mail.spawn(v).map_err(Fault::Throw),
        },
        Prim1::Monitor => match v {
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::Monitor, e))),
            v => h.mail.monitor(&v).map_err(Fault::Throw),
        },
        // The watch cannot fail where the spawn succeeded: a child is heap-local
        // by construction, so its address routes locally.
        Prim1::SpawnMonitor => match v {
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::SpawnMonitor, e))),
            v => {
                let child = h.mail.spawn(v).map_err(Fault::Throw)?;
                h.mail.monitor(&child).map_err(Fault::Throw)?;
                Ok(child)
            }
        },
        // Handled before the continuation is popped: an empty mailbox must
        // leave the machine resumable.
        Prim1::Receive => match v {
            Val::Code(e) => Ok(h.reflectc(Exp::Prim1(Prim1::Receive, e))),
            _ => Err(Fault::Bug("receive reached prim1".into())),
        },

        // No code arm, deliberately: a residual is not a raise but an
        // expression that may produce one later, and saying so is what lets an
        // interpreter's raise test vanish during compilation.
        Prim1::IsRaise => Ok(bool_val(matches!(v, Val::Raise(_)))),
        Prim1::IsCodeFun => Ok(bool_val(matches!(&v, Val::Code(e) if h.is_lam(e)))),
        Prim1::RaiseValue => match v {
            Val::Raise(e) => Ok(Val::clone(&e)),
            _ => Err(wrong_type("raise-value")),
        },
    }
}

fn prim2<M: Mail>(op: Prim2, v1: Val, v2: Val, h: &mut Store<M>) -> Result<Val, Fault> {
    // The one member of this enum with no code arm: a pair is run-time data, so
    // `cons` of two code values is a pair of them. Staging a pair is `lift`.
    if let Prim2::Cons = op {
        return Ok(Val::Pair(rc_val(v1), rc_val(v2)));
    }

    if matches!((&v1, &v2), (Val::Code(_), _) | (_, Val::Code(_))) {
        let (Some(a), Some(b)) = (as_syntax(&v1), as_syntax(&v2)) else {
            return Err(wrong_type(op.name()));
        };
        return Ok(h.reflectc(Exp::Prim2(op, a, b)));
    }

    match op {
        Prim2::Cons => unreachable!("handled above"),

        Prim2::Eq => Ok(bool_val(v1 == v2)),

        Prim2::Plus | Prim2::Minus | Prim2::Times | Prim2::Div | Prim2::Mod | Prim2::Lt => {
            arith(op, v1, v2)
        }

        Prim2::CellSet => match v1 {
            Val::Cell(i) => {
                h.cells[i] = v2.clone();
                Ok(v2)
            }
            _ => Err(wrong_type("cell-set!")),
        },

        Prim2::Send => match is_data(&v2) {
            true => h.mail.send(&v1, v2).map_err(Fault::Throw),
            false => Err(throw("not-data", v2)),
        },

        Prim2::LimitTurns => match v2 {
            Val::Num(n) if n > 0 => h.mail.limit(&v1, n).map_err(Fault::Throw),
            _ => Err(wrong_type("limit-turns")),
        },
    }
}

/// Whether a value is an s-expression, which is all a channel carries. A
/// closure ships the semantics it was made under and a cell index means nothing
/// outside its store, so restricting the payload here rather than in a
/// scheduler is what makes a local send observationally identical to a remote
/// one. Iterative, and terminating because a cycle needs a cell to tie it.
fn is_data(v: &Val) -> bool {
    let mut work = vec![v];
    while let Some(v) = work.pop() {
        match v {
            Val::Num(_) | Val::Flo(_) | Val::Sym(_) | Val::Atom(_) | Val::Nil => {}
            Val::Pair(a, b) => {
                work.push(a);
                work.push(b);
            }
            // A raise is in flight, not at rest: what crosses a channel is the
            // value it carries, unwrapped by whoever decided to report it.
            Val::Clo(_, _) | Val::Code(_) | Val::Cell(_) | Val::Raise(_) => return false,
        }
    }
    true
}

fn arith(op: Prim2, v1: Val, v2: Val) -> Result<Val, Fault> {
    let name = match op {
        Prim2::Plus => "+",
        Prim2::Minus => "-",
        Prim2::Times => "*",
        Prim2::Div => "/",
        Prim2::Mod => "%",
        Prim2::Lt => "<",
        _ => unreachable!("not arithmetic"),
    };
    match (v1, v2) {
        (Val::Num(a), Val::Num(b)) => match op {
            Prim2::Plus => Ok(Val::Num(a.wrapping_add(b))),
            Prim2::Minus => Ok(Val::Num(a.wrapping_sub(b))),
            Prim2::Times => Ok(Val::Num(a.wrapping_mul(b))),
            Prim2::Lt => Ok(bool_val(a < b)),
            Prim2::Div | Prim2::Mod if b == 0 => {
                Err(throw("divide-by-zero", Val::Sym(name.into())))
            }
            Prim2::Div => Ok(Val::Num(a.wrapping_div(b))),
            Prim2::Mod => Ok(Val::Num(a.wrapping_rem(b))),
            _ => unreachable!("not arithmetic"),
        },
        // Mixed integer and float widens, the only place the core's second
        // numeric type costs anything.
        (a, b) if is_num(&a) && is_num(&b) => {
            let (x, y) = (as_f64(&a), as_f64(&b));
            match op {
                Prim2::Plus => Ok(Val::Flo(x + y)),
                Prim2::Minus => Ok(Val::Flo(x - y)),
                Prim2::Times => Ok(Val::Flo(x * y)),
                Prim2::Div => Ok(Val::Flo(x / y)),
                Prim2::Mod => Ok(Val::Flo(x % y)),
                Prim2::Lt => Ok(bool_val(x < y)),
                _ => unreachable!("not arithmetic"),
            }
        }
        _ => Err(wrong_type(name)),
    }
}

fn is_num(v: &Val) -> bool {
    matches!(v, Val::Num(_) | Val::Flo(_))
}

fn as_f64(v: &Val) -> f64 {
    match v {
        Val::Num(n) => *n as f64,
        Val::Flo(x) => *x,
        _ => unreachable!("checked by is_num"),
    }
}

#[cfg(test)]
mod tests {
    use super::*;
    use crate::floor::host::Str;
    use crate::floor::{rc_exp, Env};

    fn eval(e: Exp) -> Result<Val, Fault> {
        Machine::new(Env::default(), rc_exp(e)).run(&mut Store::<NoMail>::default())
    }

    fn lam(body: Exp) -> Exp {
        Exp::Lam(1, rc_exp(body))
    }
    fn app(f: Exp, a: Exp) -> Exp {
        Exp::App(rc_exp(f), Box::new([rc_exp(a)]))
    }
    fn p1(op: Prim1, a: Exp) -> Exp {
        Exp::Prim1(op, rc_exp(a))
    }
    fn p2(op: Prim2, a: Exp, b: Exp) -> Exp {
        Exp::Prim2(op, rc_exp(a), rc_exp(b))
    }
    fn if_(c: Exp, t: Exp, f: Exp) -> Exp {
        Exp::If(rc_exp(c), rc_exp(t), rc_exp(f))
    }

    #[test]
    fn arithmetic_widens_only_when_an_operand_is_float() {
        assert_eq!(
            eval(p2(Prim2::Plus, Exp::Lit(2), Exp::Lit(3))),
            Ok(Val::Num(5))
        );
        assert_eq!(
            eval(p2(Prim2::Plus, Exp::Lit(2), Exp::Flo(0.5))),
            Ok(Val::Flo(2.5))
        );
        assert_eq!(
            eval(p2(Prim2::Div, Exp::Lit(7), Exp::Lit(2))),
            Ok(Val::Num(3))
        );
    }

    #[test]
    fn a_closure_receives_itself_so_recursion_needs_no_fixed_point() {
        // (lambda self n. if n < 1 then 1 else n * (self (n - 1))) 5
        let n = Exp::Var(1);
        let me = Exp::Var(0);
        let fact = lam(if_(
            p2(Prim2::Lt, n.clone(), Exp::Lit(1)),
            Exp::Lit(1),
            p2(
                Prim2::Times,
                n.clone(),
                app(me, p2(Prim2::Minus, n, Exp::Lit(1))),
            ),
        ));
        assert_eq!(eval(app(fact, Exp::Lit(5))), Ok(Val::Num(120)));
    }

    #[test]
    fn a_cell_written_inside_an_abandoned_catch_keeps_its_write() {
        // (let c (cell-new 1)
        //   (let _ (catch (let _ (cell-set! c 2) (throw 'boom)))
        //     (cell-read c)))
        //
        // Unwinding is not a transaction: staging state rolls back,
        // effects do not.
        let body = Exp::Let(
            rc_exp(Exp::Catch(rc_exp(Exp::Let(
                rc_exp(p2(Prim2::CellSet, Exp::Var(0), Exp::Lit(2))),
                rc_exp(Exp::Throw(rc_exp(Exp::Sym("boom".into())))),
            )))),
            rc_exp(p1(Prim1::CellRead, Exp::Var(0))),
        );
        let prog = Exp::Let(rc_exp(p1(Prim1::CellNew, Exp::Lit(1))), rc_exp(body));

        let mut h = Store::<NoMail>::default();
        let got = Machine::new(Env::default(), rc_exp(prog)).run(&mut h);
        assert_eq!(got, Ok(Val::Num(2)));
        assert!(h.block.is_empty());
        assert_eq!(h.fresh, 0);
    }

    #[test]
    fn catch_yields_the_thrown_value() {
        assert_eq!(
            eval(Exp::Catch(rc_exp(Exp::Throw(rc_exp(Exp::Sym(
                "boom".into()
            )))))),
            Ok(Val::Sym("boom".into()))
        );
    }

    #[test]
    fn an_uncaught_throw_is_the_answer_rather_than_a_failure() {
        assert_eq!(
            eval(Exp::Throw(rc_exp(Exp::Sym("boom".into())))),
            Ok(super::super::raise(Val::Sym("boom".into())))
        );
    }

    #[test]
    fn a_raise_passed_as_an_argument_is_an_ordinary_value() {
        assert_eq!(
            eval(Exp::App(
                rc_exp(Exp::Lam(1, rc_exp(Exp::Lit(7)))),
                Box::new([rc_exp(Exp::Throw(rc_exp(Exp::Sym("boom".into()))))])
            )),
            Ok(Val::Num(7))
        );
    }

    #[test]
    fn a_raise_propagates_through_a_primitive() {
        assert_eq!(
            eval(p2(
                Prim2::Plus,
                Exp::Lit(1),
                Exp::Throw(rc_exp(Exp::Sym("boom".into())))
            )),
            Ok(super::super::raise(Val::Sym("boom".into())))
        );
    }

    #[test]
    fn a_raise_is_a_datum_in_exactly_the_positions_that_bind_one() {
        let let_ = |init: Exp, body: Exp| Exp::Let(rc_exp(init), rc_exp(body));
        // A partial primitive over direct operands - the case the fast
        // path runs itself instead of pushing a frame for - and an
        // explicit throw, which no fast path is eligible for. Both must
        // land in the same place or the fast path is the difference.
        let boom = || p2(Prim2::Div, Exp::Lit(1), Exp::Lit(0));
        let thrown = || Exp::Throw(rc_exp(Exp::Sym("boom".into())));
        let div0 = || {
            Ok(super::super::raise(Val::Pair(
                rc_val(Val::Sym("divide-by-zero".into())),
                rc_val(Val::Sym("/".into())),
            )))
        };

        // Bound: `LetBody` and `AppFinish` receive, so the body runs and
        // the raise is an ordinary value it may ignore.
        assert_eq!(eval(let_(boom(), Exp::Lit(7))), Ok(Val::Num(7)));
        assert_eq!(eval(let_(thrown(), Exp::Lit(7))), Ok(Val::Num(7)));
        assert_eq!(eval(app(lam(Exp::Lit(7)), boom())), Ok(Val::Num(7)));
        assert_eq!(eval(app(lam(Exp::Lit(7)), thrown())), Ok(Val::Num(7)));
        // Or use, in which case it leaves as the value it always was.
        assert_eq!(eval(let_(boom(), Exp::Var(0))), div0());
        assert_eq!(eval(app(lam(Exp::Var(1)), boom())), div0());

        // Propagated: nothing here receives, so the surrounding
        // computation does not happen.
        assert_eq!(eval(p2(Prim2::Plus, boom(), Exp::Lit(1))), div0());
        assert_eq!(eval(p2(Prim2::Plus, Exp::Lit(1), boom())), div0());
        assert_eq!(eval(p1(Prim1::Car, boom())), div0());
        assert_eq!(eval(if_(boom(), Exp::Lit(1), Exp::Lit(2))), div0());
        assert_eq!(eval(app(boom(), Exp::Lit(1))), div0());

        // Inspected: the two predicates receive, which is how object code
        // asks the question at all.
        assert_eq!(eval(p1(Prim1::IsRaise, boom())), Ok(Val::Num(1)));
        assert_eq!(
            eval(p1(Prim1::RaiseValue, boom())),
            Ok(Val::Pair(
                rc_val(Val::Sym("divide-by-zero".into())),
                rc_val(Val::Sym("/".into()))
            ))
        );

        // Through a `catch`, which is how it reaches object code. The
        // third is the one that matters: a raise that *propagated* is
        // caught the same as one that was bound and returned, so `catch`
        // does not inherit the distinction.
        let caught = || {
            Ok(Val::Pair(
                rc_val(Val::Sym("divide-by-zero".into())),
                rc_val(Val::Sym("/".into())),
            ))
        };
        assert_eq!(
            eval(Exp::Catch(rc_exp(let_(boom(), Exp::Var(0))))),
            caught()
        );
        assert_eq!(
            eval(Exp::Catch(rc_exp(app(lam(Exp::Var(1)), boom())))),
            caught()
        );
        assert_eq!(
            eval(Exp::Catch(rc_exp(p2(Prim2::Plus, Exp::Lit(1), boom())))),
            caught()
        );

        // Nested, where an inner fast path must not consume the outer
        // position: an ordinary `let` over a folded primitive still binds
        // its result, and a raise one argument deep still propagates from
        // the position it was raised in.
        assert_eq!(
            eval(let_(p2(Prim2::Plus, Exp::Lit(1), Exp::Lit(2)), Exp::Var(0))),
            Ok(Val::Num(3))
        );
        assert_eq!(
            eval(app(lam(Exp::Var(1)), p1(Prim1::Car, Exp::Nil))),
            Ok(super::super::raise(Val::Pair(
                rc_val(Val::Sym("wrong-type".into())),
                rc_val(Val::Sym("car".into()))
            )))
        );
    }

    #[test]
    fn a_partial_primitive_throws_a_catchable_value() {
        let bad = p2(Prim2::Div, Exp::Lit(1), Exp::Lit(0));
        assert_eq!(
            eval(Exp::Catch(rc_exp(bad))),
            Ok(Val::Pair(
                rc_val(Val::Sym("divide-by-zero".into())),
                rc_val(Val::Sym("/".into()))
            ))
        );
    }

    #[test]
    fn host_ops_run_through_the_table() {
        let idx = host::registry().lookup("str-append").expect("op present");
        let prog = Exp::Op(
            idx,
            vec![
                rc_exp(Exp::Atom(match Str::val("na") {
                    Val::Atom(a) => a,
                    _ => unreachable!(),
                })),
                rc_exp(Exp::Atom(match Str::val("rju") {
                    Val::Atom(a) => a,
                    _ => unreachable!(),
                })),
            ],
        );
        assert_eq!(eval(prog), Ok(Str::val("narju")));
    }

    #[test]
    fn receive_blocks_without_consuming_its_continuation() {
        let mut h = Store::<NoMail>::default();
        let mut m = Machine::new(Env::default(), rc_exp(p1(Prim1::Receive, Exp::Nil)));
        // Drive to the block and confirm it stays blocked rather than
        // falling through with a value.
        for _ in 0..8 {
            match m.step(&mut h).expect("no fault") {
                Step::Blocked => return,
                Step::Done(v) => panic!("completed with {v}"),
                Step::Running => {}
            }
        }
        panic!("never reached the block");
    }

    // ── staging ────────────────────────────────────────────────────────

    fn lift(e: Exp) -> Exp {
        Exp::Lift(rc_exp(e))
    }
    fn stage(e: Exp) -> (Val, Vec<Exp>) {
        let mut h = Store::<NoMail>::default();
        let v = Machine::new(Env::default(), rc_exp(e))
            .run(&mut h)
            .expect("no fault");
        (v, h.block)
    }
    fn coded(v: &Val) -> &Exp {
        match v {
            Val::Code(e) => e,
            other => panic!("expected code, got {other}"),
        }
    }

    #[test]
    fn lifting_a_closure_eta_expands_it_into_one_binding() {
        // (lift (lambda self x. (+ x (lift 1))))
        //
        // The body's `+` reflects, so the lambda's residual carries the
        // block the body left - and the outer scope sees only the `Lam`.
        let (v, block) = stage(lift(lam(p2(Prim2::Plus, Exp::Var(1), lift(Exp::Lit(1))))));
        assert_eq!(coded(&v), &Exp::Var(0));
        assert_eq!(
            block,
            vec![Exp::Lam(
                1,
                rc_exp(Exp::Let(
                    rc_exp(p2(Prim2::Plus, Exp::Var(1), Exp::Lit(1))),
                    rc_exp(Exp::Var(2)),
                ))
            )]
        );
    }

    #[test]
    fn lifting_a_pair_builds_it_a_cons_at_a_time() {
        // (lift (cons 1 (cons (lift 2) nil)))
        let (v, block) = stage(lift(p2(
            Prim2::Cons,
            Exp::Lit(1),
            p2(Prim2::Cons, lift(Exp::Lit(2)), Exp::Nil),
        )));
        assert_eq!(coded(&v), &Exp::Var(1));
        assert_eq!(
            block,
            vec![
                p2(Prim2::Cons, Exp::Lit(2), Exp::Nil),
                p2(Prim2::Cons, Exp::Lit(1), Exp::Var(0)),
            ]
        );
    }

    #[test]
    fn a_variable_the_floor_emitted_a_lambda_for_says_so() {
        let is_fun = |e: Exp| eval(Exp::Prim1(Prim1::IsCodeFun, rc_exp(e)));
        assert_eq!(is_fun(lift(lam(Exp::Var(1)))), Ok(Val::Num(1)));
        // A constant is code without naming anything, and a residualized
        // primitive names a value of a kind the floor did not choose.
        assert_eq!(is_fun(lift(Exp::Lit(1))), Ok(Val::Num(0)));
        assert_eq!(
            is_fun(Exp::Prim1(
                Prim1::Car,
                rc_exp(p2(Prim2::Cons, lift(Exp::Lit(1)), lift(Exp::Lit(2))))
            )),
            Ok(Val::Num(0))
        );
    }

    #[test]
    fn building_a_deep_structure_costs_no_stack() {
        let mut h = Store::<NoMail>::default();
        let long = (0..10_000).fold(Val::Nil, |t, i| Val::Pair(rc_val(Val::Num(i)), rc_val(t)));
        cons_syntax(&long, "unliftable", &mut h).expect("built");
        let deep = (0..10_000).fold(Val::Nil, |t, _| Val::Pair(rc_val(t), rc_val(Val::Nil)));
        cons_syntax(&deep, "unliftable", &mut h).expect("built");
        assert_eq!(h.block.len(), 20_000);
    }

    #[test]
    fn a_closure_lifted_twice_expands_once() {
        // (let g (lambda self x. x) (cons (lift g) (lift g)))
        //
        // The second lift resolves through the memo to the variable the
        // first one bound. Without it a recursive lift would not
        // terminate.
        let (v, block) = stage(Exp::Let(
            rc_exp(lam(Exp::Var(1))),
            rc_exp(p2(Prim2::Cons, lift(Exp::Var(0)), lift(Exp::Var(0)))),
        ));
        match v {
            Val::Pair(a, b) => {
                assert_eq!(coded(&a), &Exp::Var(0));
                assert_eq!(coded(&b), &Exp::Var(0));
            }
            other => panic!("expected a pair, got {other}"),
        }
        assert_eq!(block, vec![Exp::Lam(1, rc_exp(Exp::Var(1)))]);
    }

    #[test]
    fn a_staged_if_reifies_each_branch_into_its_own_block() {
        // (if (lift 1) (+ (lift 2) (lift 3)) (lift 4))
        let (v, block) = stage(if_(
            lift(Exp::Lit(1)),
            p2(Prim2::Plus, lift(Exp::Lit(2)), lift(Exp::Lit(3))),
            lift(Exp::Lit(4)),
        ));
        assert_eq!(coded(&v), &Exp::Var(0));
        assert_eq!(
            block,
            vec![if_(
                Exp::Lit(1),
                // The branch's own reflect stayed inside the branch.
                Exp::Let(
                    rc_exp(p2(Prim2::Plus, Exp::Lit(2), Exp::Lit(3))),
                    rc_exp(Exp::Var(0)),
                ),
                Exp::Lit(4),
            )]
        );
    }

    #[test]
    fn cross_stage_persistence_carries_a_value_by_reference() {
        // (let g (lambda self x. x) (lift-ref 1 g))
        //
        // A closure crossing a stage boundary this way keeps its identity
        // rather than being η-expanded into syntax.
        let (v, block) = stage(Exp::Let(
            rc_exp(lam(Exp::Var(1))),
            rc_exp(Exp::LiftRef(rc_exp(Exp::Lit(1)), rc_exp(Exp::Var(0)))),
        ));
        assert!(block.is_empty());
        assert!(matches!(coded(&v), Exp::Proc(p) if matches!(&**p, Val::Clo(_, _))));
    }

    #[test]
    fn a_catch_whose_body_stages_residualizes() {
        // (catch (+ (lift 1) (lift 2)))
        let (v, block) = stage(Exp::Catch(rc_exp(p2(
            Prim2::Plus,
            lift(Exp::Lit(1)),
            lift(Exp::Lit(2)),
        ))));
        assert_eq!(coded(&v), &Exp::Var(0));
        assert_eq!(
            block,
            vec![Exp::Catch(rc_exp(Exp::Let(
                rc_exp(p2(Prim2::Plus, Exp::Lit(1), Exp::Lit(2))),
                rc_exp(Exp::Var(0)),
            )))]
        );
    }

    #[test]
    fn a_staged_catch_ending_in_a_plain_value_lifts_its_tail() {
        // (catch (let _ (+ (lift 1) (lift 2)) 7))
        //
        // Staging an effect does not oblige the body to end in code.
        let (v, block) = stage(Exp::Catch(rc_exp(Exp::Let(
            rc_exp(p2(Prim2::Plus, lift(Exp::Lit(1)), lift(Exp::Lit(2)))),
            rc_exp(Exp::Lit(7)),
        ))));
        assert_eq!(coded(&v), &Exp::Var(0));
        assert_eq!(
            block,
            vec![Exp::Catch(rc_exp(Exp::Let(
                rc_exp(p2(Prim2::Plus, Exp::Lit(1), Exp::Lit(2))),
                rc_exp(Exp::Lit(7)),
            )))]
        );
    }

    #[test]
    fn run_now_executes_the_code_its_argument_produced() {
        // ((run 0 (lift (lambda self x. (+ x (lift 1))))) 41)
        let f = Exp::Run(
            rc_exp(Exp::Lit(0)),
            rc_exp(lift(lam(p2(Prim2::Plus, Exp::Var(1), lift(Exp::Lit(1)))))),
        );
        let mut h = Store::<NoMail>::default();
        let got = Machine::new(Env::default(), rc_exp(app(f, Exp::Lit(41)))).run(&mut h);
        assert_eq!(got, Ok(Val::Num(42)));
        // Running restores the level and leaves no residual behind.
        assert_eq!(h.level, 0);
        assert!(h.block.is_empty());
    }

    fn run_src(text: &str) -> Result<Val, Fault> {
        let forms = crate::floor::read::read(text).expect("reads");
        assert_eq!(forms.len(), 1);
        let exp = match crate::floor::read::trans(&forms[0], &Val::Nil).expect("lowers") {
            Val::Code(e) => e,
            other => panic!("expected code, got {other}"),
        };
        Machine::new(Env::default(), exp).run(&mut Store::<NoMail>::default())
    }

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

    #[test]
    fn source_text_stages_and_runs_what_it_staged() {
        // The power-function specializer, the paper's example: `n` is
        // static, `x` is dynamic, so the residual is a chain of
        // multiplications with no loop left in it.
        assert_eq!(
            run_src(
                "((run 0 (let (pow (lambda (pow n)
                                     (lambda (f x)
                                       (if (< n 1) (lift 1) (* x ((pow (- n 1)) x))))))
                           (lift (pow 3))))
                  2)"
            ),
            Ok(Val::Num(8))
        );
    }

    #[test]
    fn one_staged_operand_stages_the_call_and_the_rest_join_it() {
        let (v, block) = stage(p2(Prim2::Plus, lift(Exp::Lit(1)), Exp::Lit(2)));
        assert_eq!(coded(&v), &Exp::Var(0));
        assert_eq!(block, vec![p2(Prim2::Plus, Exp::Lit(1), Exp::Lit(2))]);
        assert!(matches!(
            eval(p2(
                Prim2::Plus,
                lift(Exp::Lit(1)),
                Exp::Prim2(Prim2::Cons, rc_exp(Exp::Lit(2)), rc_exp(Exp::Nil))
            )),
            Ok(Val::Raise(_))
        ));
    }
}