Chapter 23: Optimization

New files

src/rep.rs

src/reach.rs

src/dump.rs

Changed files

src/erase.rs

src/llvm/values.rs

src/llvm/primitives.rs

src/llvm/control.rs

src/llvm/mod.rs

src/anf.rs

src/anf_simplify.rs

src/anf_lint.rs

src/closure.rs

src/flat.rs

src/flat_lint.rs

src/primitives.rs

rt/src/primitives.rs

rt/src/abi.rs

src/main.rs

src/repl.rs

src/jit.rs

src/lib.rs

rt/src/lib.rs

Motivation

Getting the right answer is a good start for an optimizer. We’d also like it to avoid doing the same calculation twice or allocating a fresh box between every pair of arithmetic instructions. A faster-looking expression can turn out to be a rather expensive way to get the same result.

We’ll make a few focused improvements and inspect what they actually change. Traces and machine steps help us catch duplicated or reordered work. A dependency graph tells us which globals we still need. Type information tells codegen when it can use native arithmetic instead of repeatedly boxing intermediate values.

These are small optimizations, but they expose the questions a larger optimizer must answer too. What do we know about this expression? What does the rewrite save? And what happens to evaluation order?

The Language, Now

The only new source function is trace :: String -> a -> a. It writes its first argument and a newline to stderr, then returns its second argument unchanged. Arguments remain strict. An error while evaluating the second argument happens before the trace is printed. trace is a diagnostic facility, not an alternative to IO for ordinary program effects.

-- stderr: exact
f x y = x + y

main = print (f (trace "left" 20) (trace "right" 22))

This prints left followed by right on stderr, and 42 on stdout. Moving a call across the other argument would now be visible. The runtime flushes stdout before writing a trace, preserving the ordering of preceding output.

Theory

Preserve Work

In a strict language, let x = f y in x + x evaluates f y once. Substituting f y for both occurrences of x would evaluate it twice. That changes cost and may repeat a trace. A failing expression is observable too. An unused division by zero cannot simply disappear.

Our simplifier can substitute atoms because reading an atom does no work. It can remove an unused total computation. It can move an immediately applied lambda body into its sole call site, preserving the already evaluated arguments. It cannot use that rule for a lambda called twice. These restrictions make the small transformation understandable without a global cost analysis (Appel 1992).

We can ask the ANF machine to count its steps with simplification switched on and off. The results, errors, and traces must agree, and the simplified program must take no more steps. This gives us a useful way to catch a rewrite that accidentally duplicates work. It doesn’t prove a wall-clock speedup, but it tests a claim we can actually measure without depending on a particular CPU.

Keep Reachable Globals

A global reference gives us an edge in a dependency graph. Starting from main, a worklist follows those edges and retains a predecessor for each newly reached global. This resembles Chapter 9’s dependency analysis, but answers a different question. Which definitions can this execution need?

Strict initialization adds roots. An unused initializer may print a trace, fail, or diverge before main. We retain any initializer whose harmlessness the local classifier cannot establish. Calls and control-flow initializers remain roots. Allocating a closure does not execute its body, so an unused function can be removed. Allocation failure is outside the source cost model.

The surviving globals stay in their original dependency order. In the REPL, all visible bindings are roots because later input may refer to any of them. The witness dump gives one discovery edge for each retained binding, making pruning decisions inspectable.

Keep Type Evidence, Choose Storage Locally

An erased expression no longer carries a System F type, but the compiler can retain a small fact established by that type:

#![allow(unused)]
fn main() {
impl std::fmt::Display for Rep {
    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
        f.write_str(match self {
            Self::Int => "Int",
            Self::Double => "Double",
            Self::Word => "Word",
        })
    }
}
use crate::{
    anf::{Anf, Atom, Rhs, Var},
    core,
    names::Id,
};
use std::collections::BTreeMap;
pub type Table = BTreeMap<Id, Rep>;
/// Missing evidence is an internal error, never an invitation to infer a storage tag.
pub fn get(table: &Table, id: &Id) -> Result<Rep, String> {
    table
        .get(id)
        .copied()
        .ok_or_else(|| format!("missing representation evidence for {id}"))
}
pub fn atom(table: &Table, a: &Atom) -> Result<Rep, String> {
    match a {
        Atom::Var(v) | Atom::Global(v) => get(table, v),
        Atom::Lit(l) => Ok(crate::erase::literal_rep(l)),
    }
}
/// Numeric operands are checked against the primitive's declared signature.
pub fn primitive(
    table: &Table,
    op: crate::ast::Op,
    args: &[Atom],
    result: &Var,
    metadata: &core::Program,
) -> Result<(), String> {
    use crate::primitives::Prim;
    let generic = matches!(
        op,
        crate::ast::Op::Runtime(Prim::Trace | Prim::Error | Prim::Exit)
    );
    let types = if generic {
        vec![core::Type::Var(0)]
    } else {
        vec![]
    };
    let (mut ty, _) = crate::primitives::core_signature(
        op,
        &types,
        &metadata.data_types,
    )?;
    for arg in args {
        let core::Type::Arrow(a, b) = ty else {
            return Err("primitive arity evidence".into());
        };
        if !matches!(a.as_ref(), core::Type::Var(_))
            && atom(table, arg)? != crate::erase::representation(&a)
        {
            return Err(format!(
                "contradictory operand evidence for {}: {:?}",
                op.text(),
                arg
            ));
        }
        ty = *b;
    }
    let expected = if matches!(op, crate::ast::Op::Runtime(Prim::Trace)) {
        atom(table, &args[1])?
    } else if matches!(ty, core::Type::Var(_)) {
        get(table, result)?
    } else {
        crate::erase::representation(&ty)
    };
    if get(table, result)? != expected {
        return Err(format!("contradictory result evidence for {result}"));
    }
    Ok(())
}
/// Copy evidence to the beta continuation's fresh result. No type classification occurs here.
pub fn beta_results(program: &mut crate::anf::Program) {
    let mut todo = program
        .globals
        .iter()
        .map(|(_, b)| b.as_ref())
        .collect::<Vec<_>>();
    let mut joins = BTreeMap::new();
    let mut pending = vec![];
    while let Some(b) = todo.pop() {
        match b {
            Anf::Let(v, r, rest) => {
                if !program.reps.contains_key(v) {
                    let Anf::Jump(j, _) = rest.as_ref() else {
                        panic!("beta result continuation")
                    };
                    pending.push((v.clone(), j.clone()));
                }
                if let Rhs::Lambda(l) = r {
                    todo.push(&l.body);
                }
                todo.push(rest);
            }
            Anf::LetRec(bs, r) => {
                todo.push(r);
                for (_, l) in bs {
                    todo.push(&l.body);
                }
            }
            Anf::Join(j, ps, b, r) => {
                if ps.len() == 1 {
                    joins.insert(j.clone(), program.reps[&ps[0]]);
                }
                todo.push(b);
                todo.push(r);
            }
            Anf::Case(_, alts) => {
                for (_, _, b) in alts {
                    todo.push(b);
                }
            }
            _ => {}
        }
    }
    for (v, j) in pending {
        program.reps.insert(v, joins[&j]);
    }
}
pub fn lint_anf(program: &crate::anf::Program) -> Result<(), String> {
    let mut todo = vec![];
    for (v, b) in &program.globals {
        get(&program.reps, v)?;
        todo.push(b.as_ref());
    }
    while let Some(b) = todo.pop() {
        match b {
            Anf::Let(v, r, rest) => {
                get(&program.reps, v)?;
                match r {
                    Rhs::Prim(p, args, _) => primitive(
                        &program.reps,
                        *p,
                        args,
                        v,
                        &program.metadata,
                    )?,
                    Rhs::Lambda(l) => todo.push(&l.body),
                    _ => {}
                }
                todo.push(rest);
            }
            Anf::LetRec(bs, r) => {
                todo.push(r);
                for (_, l) in bs {
                    todo.push(&l.body);
                }
            }
            Anf::Join(_, _, b, r) => {
                todo.push(b);
                todo.push(r);
            }
            Anf::Case(_, alts) => {
                for (_, _, b) in alts {
                    todo.push(b);
                }
            }
            _ => {}
        }
    }
    Ok(())
}
pub fn lint_flat(program: &crate::flat::Program) -> Result<(), String> {
    use crate::flat::{Flat, Rhs};
    let mut todo = program
        .funcs
        .iter()
        .map(|f| f.body.as_ref())
        .collect::<Vec<_>>();
    for g in &program.globals {
        get(&program.reps, &g.name)?;
        todo.push(g.body.as_ref());
    }
    while let Some(b) = todo.pop() {
        match b {
            Flat::Let(v, r, rest) => {
                get(&program.reps, v)?;
                if let Rhs::Prim(p, args, _) = r {
                    primitive(
                        &program.reps,
                        *p,
                        args,
                        v,
                        &program.metadata,
                    )?;
                }
                todo.push(rest);
            }
            Flat::Join(_, _, b, r) => {
                todo.push(b);
                todo.push(r);
            }
            Flat::Case(_, alts) => {
                for (_, _, b) in alts {
                    todo.push(b);
                }
            }
            _ => {}
        }
    }
    Ok(())
}
#[derive(Clone, Copy, Debug, PartialEq, Eq)]
pub enum Rep {
    Int,
    Double,
    Word,
}
}

Int and Double establish numeric types. Word covers everything else, including type variables. This is evidence, not a storage layout. An Int returned by a call still arrives as a tagged word. Code generation decides when to decode it into a register. Calls, returns, fields, captures, globals, and join parameters retain the uniform ABI from Chapter 20 (Leroy 1990).

Integer register operations need one extra step. An LLVM i64 has 64 bits, while Fun’s signed integer has 63. Adding $2^{61}$ to itself must produce $- 2^{62}$ . Without normalization, a following comparison would see a positive number, and division by two would produce the wrong sign. After arithmetic we shift left once, then arithmetically right once. This sign-extends bit 62 and restores Fun’s range before any later use. Adding $2^{62}$ to itself instead wraps to zero, not a negative number.

Double arithmetic can keep intermediate results in floating-point registers. Passing the result to another function still requires a box because our calling convention passes words. So a primitive Double accumulation loop still boxes its accumulator once per iteration at the tail call. The improvement is that it doesn’t box every arithmetic intermediate along the way.

We’ll check that distinction by counting allocations. Overloaded source operators can still make dictionary calls, so they may not produce this direct primitive loop. Specializing those dictionaries is a separate opportunity.

Implementation

The shared runtime owns trace behavior. Both interpreters and the native ABI use it, so even an arbitrary closure can be the returned value:

#![allow(unused)]
fn main() {
use crate::layout::normalize;
#[derive(Clone, Debug, PartialEq)]
/// Only primitive input/output types: arbitrary algebraic values stay in each engine.
pub enum Value {
    Int(i64),
    Double(f64),
    Char(char),
    String(String),
    Bool(bool),
    Chars(Vec<char>),
    MaybeInt(Option<i64>),
    Unit,
}
#[derive(Clone, Debug, PartialEq, Eq)]
pub enum Failure {
    Runtime(String),
    Exit(i32),
}
impl From<String> for Failure {
    fn from(s: String) -> Self {
        Self::Runtime(s)
    }
}
impl From<&str> for Failure {
    fn from(s: &str) -> Self {
        Self::Runtime(s.into())
    }
}
impl std::fmt::Display for Failure {
    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
        match self {
            Self::Runtime(s) => f.write_str(s),
            Self::Exit(n) => write!(f, "exit {n}"),
        }
    }
}
/// Optional surrounding whitespace and sign; decimal digits only, within signed 63 bits.
pub fn read_int(source: &str) -> Option<i64> {
    let s = source.trim();
    let digits = s.strip_prefix(['+', '-']).unwrap_or(s);
    if digits.is_empty() || !digits.bytes().all(|b| b.is_ascii_digit()) {
        return None;
    }
    s.parse().ok().filter(|n| {
        (crate::layout::INT_MIN..=crate::layout::INT_MAX).contains(n)
    })
}
macro_rules! primitives {($($variant:ident => $name:literal),* $(,)?)=>{
    #[derive(Clone,Copy,Debug,PartialEq,Eq)] pub enum Prim {$($variant),*}
    pub const ALL:&[Prim]=&[$(Prim::$variant),*];
    impl Prim {pub fn name(self)->&'static str {match self {$(Self::$variant=>$name),*}}}
};}
primitives! {
    IntAdd=>"prim_intAdd",IntSub=>"prim_intSub",IntMul=>"prim_intMul",IntNeg=>"prim_intNeg",IntQuot=>"prim_intQuot",IntRem=>"prim_intRem",IntDiv=>"prim_intDiv",IntMod=>"prim_intMod",IntEq=>"prim_intEq",IntLt=>"prim_intLt",IntLe=>"prim_intLe",
    DblAdd=>"prim_dblAdd",DblSub=>"prim_dblSub",DblMul=>"prim_dblMul",DblDiv=>"prim_dblDiv",DblNeg=>"prim_dblNeg",DblSqrt=>"prim_dblSqrt",DblExp=>"prim_dblExp",DblLog=>"prim_dblLog",DblSin=>"prim_dblSin",DblCos=>"prim_dblCos",DblPow=>"prim_dblPow",DblEq=>"prim_dblEq",DblLt=>"prim_dblLt",DblLe=>"prim_dblLe",
    IntToDbl=>"prim_intToDbl",DblFloor=>"prim_dblFloor",DblRound=>"prim_dblRound",DblTruncate=>"prim_dblTruncate",ChrOrd=>"prim_chrOrd",ChrChr=>"prim_chrChr",ChrEq=>"prim_chrEq",ChrLt=>"prim_chrLt",
    StrAppend=>"prim_strAppend",StrLength=>"prim_strLength",StrEq=>"prim_strEq",StrCompare=>"prim_strCompare",StrUnpack=>"prim_strUnpack",StrPack=>"prim_strPack",
    ShowInt=>"prim_showInt",ShowDouble=>"prim_showDouble",ShowChar=>"prim_showChar",ShowString=>"prim_showString",ReadInt=>"prim_readInt",Error=>"prim_error",PutStr=>"prim_putStr",GetLine=>"prim_getLine",Exit=>"prim_exit",Trace=>"prim_trace"
}
/// Formatting starts from Rust's shortest round-trip digits, then normalizes notation.
pub fn show_double(n: f64) -> String {
    if n.is_nan() {
        return "NaN".into();
    }
    if n.is_infinite() {
        return if n.is_sign_negative() {
            "-Infinity"
        } else {
            "Infinity"
        }
        .into();
    }
    if n == 0.0 {
        return if n.is_sign_negative() { "-0.0" } else { "0.0" }.into();
    }
    let raw = format!("{:?}", n.abs());
    let (mantissa, exponent) = raw
        .split_once('e')
        .map_or((raw.as_str(), 0), |(a, b)| (a, b.parse::<i32>().unwrap()));
    let point =
        mantissa.find('.').unwrap_or(mantissa.len()) as i32 + exponent;
    let digits = mantissa.replace('.', "");
    let leading = digits.len() - digits.trim_start_matches('0').len();
    let digits = digits.trim_start_matches('0').trim_end_matches('0');
    let point = point - leading as i32;
    let body = if (1e-4..1e16).contains(&n.abs()) {
        if point <= 0 {
            format!("0.{}{digits}", "0".repeat((-point) as usize))
        } else if point as usize >= digits.len() {
            format!(
                "{digits}{}.0",
                "0".repeat(point as usize - digits.len())
            )
        } else {
            format!(
                "{}.{}",
                &digits[..point as usize],
                &digits[point as usize..]
            )
        }
    } else {
        format!(
            "{}.{}e{:+}",
            &digits[..1],
            if digits.len() == 1 { "0" } else { &digits[1..] },
            point - 1
        )
    };
    if n.is_sign_negative() {
        format!("-{body}")
    } else {
        body
    }
}
/// Quote Unicode text using Fun escapes.
pub fn quote(text: &str, delimiter: char) -> String {
    let mut result = String::from(delimiter);
    for c in text.chars() {
        match c {
            '\n' => result.push_str("\\n"),
            '\t' => result.push_str("\\t"),
            '\0' => result.push_str("\\0"),
            '\\' => result.push_str("\\\\"),
            c if c == delimiter => {
                result.push('\\');
                result.push(c);
            }
            c if c.is_control() => {
                result.push_str(&format!("\\u{{{:x}}}", c as u32))
            }
            c => result.push(c),
        }
    }
    result.push(delimiter);
    result
}
/// Execute a checked primitive, returning errors without terminating the host.
pub fn evaluate(p: Prim, args: &[Value]) -> Result<Value, Failure> {
    use Prim::*;
    let int = |i| match args[i] {
        Value::Int(n) => n,
        _ => unreachable!("typed primitive"),
    };
    let dbl = |i| match args[i] {
        Value::Double(n) => n,
        _ => unreachable!("typed primitive"),
    };
    let chr = |i| match args[i] {
        Value::Char(c) => c,
        _ => unreachable!("typed primitive"),
    };
    let string = |i| match &args[i] {
        Value::String(s) => s.as_str(),
        _ => unreachable!("typed primitive"),
    };
    let integer = |n| Value::Int(normalize(n));
    let double = |n: f64| Value::Double(n);
    let text = |s| Value::String(s);
    let boolean = Value::Bool;
    Ok(match p {
        IntAdd => integer(int(0).wrapping_add(int(1))),
        IntSub => integer(int(0).wrapping_sub(int(1))),
        IntMul => integer(int(0).wrapping_mul(int(1))),
        IntNeg => integer(-int(0)),
        IntQuot | IntRem | IntDiv | IntMod => {
            let (a, b) = (int(0), int(1));
            if b == 0 {
                return Err("divide by zero".into());
            }
            let (mut q, mut r) = (a / b, a % b);
            if matches!(p, IntDiv | IntMod) && r != 0 && (r < 0) != (b < 0)
            {
                q -= 1;
                r += b;
            }
            integer(if matches!(p, IntQuot | IntDiv) { q } else { r })
        }
        IntEq => boolean(int(0) == int(1)),
        IntLt => boolean(int(0) < int(1)),
        IntLe => boolean(int(0) <= int(1)),
        DblAdd => double(dbl(0) + dbl(1)),
        DblSub => double(dbl(0) - dbl(1)),
        DblMul => double(dbl(0) * dbl(1)),
        DblDiv => double(dbl(0) / dbl(1)),
        DblPow => double(dbl(0).powf(dbl(1))),
        DblNeg => double(-dbl(0)),
        DblSqrt => double(dbl(0).sqrt()),
        DblExp => double(dbl(0).exp()),
        DblLog => double(dbl(0).ln()),
        DblSin => double(dbl(0).sin()),
        DblCos => double(dbl(0).cos()),
        DblEq => boolean(dbl(0) == dbl(1)),
        DblLt => boolean(dbl(0) < dbl(1)),
        DblLe => boolean(dbl(0) <= dbl(1)),
        IntToDbl => double(int(0) as f64),
        DblFloor | DblRound | DblTruncate => {
            let n = match p {
                DblFloor => dbl(0).floor(),
                DblRound => dbl(0).round_ties_even(),
                _ => dbl(0).trunc(),
            };
            integer(if n.is_nan() {
                0
            } else {
                (n as i64).clamp(-(1_i64 << 62), (1_i64 << 62) - 1)
            })
        }
        ChrOrd => integer(chr(0) as i64),
        ChrChr => {
            let c = u32::try_from(int(0))
                .ok()
                .and_then(char::from_u32)
                .ok_or("invalid character code point")?;
            Value::Char(c)
        }
        ChrEq => boolean(chr(0) == chr(1)),
        ChrLt => boolean(chr(0) < chr(1)),
        StrAppend => text(format!("{}{}", string(0), string(1))),
        StrLength => integer(string(0).chars().count() as i64),
        StrEq => boolean(string(0) == string(1)),
        StrCompare => integer(match string(0).cmp(string(1)) {
            std::cmp::Ordering::Less => -1,
            std::cmp::Ordering::Equal => 0,
            std::cmp::Ordering::Greater => 1,
        }),
        StrUnpack => Value::Chars(string(0).chars().collect()),
        StrPack => match &args[0] {
            Value::Chars(cs) => text(cs.iter().collect()),
            _ => unreachable!("typed character list"),
        },
        ShowInt => text(int(0).to_string()),
        ShowDouble => text(show_double(dbl(0))),
        ShowChar => text(quote(&chr(0).to_string(), '\'')),
        ShowString => text(quote(string(0), '"')),
        ReadInt => Value::MaybeInt(read_int(string(0))),
        Error => return Err(string(0).into()),
        PutStr => {
            use std::io::Write;
            std::io::stdout()
                .write_all(string(0).as_bytes())
                .map_err(|e| e.to_string())?;
            Value::Unit
        }
        GetLine => {
            use std::io::Write;
            std::io::stdout().flush().map_err(|e| e.to_string())?;
            let mut line = String::new();
            if std::io::stdin()
                .read_line(&mut line)
                .map_err(|e| e.to_string())?
                == 0
            {
                return Err("end of input".into());
            }
            if line.ends_with('\n') {
                line.pop();
                if line.ends_with('\r') {
                    line.pop();
                }
            }
            text(line)
        }
        Trace => {
            trace(string(0))?;
            args[1].clone()
        }
        Exit => return Err(Failure::Exit(int(0) as i32)),
    })
}
/// Match Rust main's broken-pipe policy when entered through a generated C main.
pub(crate) fn init_io() {
    static INIT: std::sync::Once = std::sync::Once::new();
    INIT.call_once(|| {
        // SAFETY: on the supported Unix targets, SIGPIPE is 13 and SIG_IGN is
        // the distinguished handler value 1. This installs no Rust callback.
        unsafe {
            unsafe extern "C" {
                fn signal(number: i32, handler: usize) -> usize;
            }
            signal(13, 1);
        }
    });
}
/// The trace event happens after both strict operands have been evaluated.
pub fn trace(message: &str) -> Result<(), Failure> {
    init_io();
    use std::io::Write;
    std::io::stdout().flush().map_err(|e| e.to_string())?;
    writeln!(std::io::stderr().lock(), "{message}")
        .map_err(|e| e.to_string())?;
    Ok(())
}
}

The simplifier states what its rewrites are allowed to do beside the code.

#![allow(unused)]
fn main() {
//! A rewrite may delete an unused total RHS, replace an atom by an equal atom,
//! or move a lambda applied exactly once. It may never copy a call, a failing
//! primitive, or an effect, nor move one past another. Allocation failure is
//! outside the source cost model. The oracle checks transitions and trace order.
}

reach::analyze performs a stable graph traversal. Its roots include observable initializers, and the first edge to a global becomes its witness:

#![allow(unused)]
fn main() {
use crate::{
    anf::{Anf, Atom, Body, Program, Rhs},
    names::Id,
};
use std::collections::{BTreeMap, BTreeSet, VecDeque};
/// Source-ordered survivors and their first discovery edge. Roots have no predecessor.
pub struct Reach {
    pub kept: Vec<Id>,
    pub witness: BTreeMap<Id, Option<Id>>,
}
/// Visit every reference, including captures hidden in nested lambdas, without recursion.
fn references(body: &Body) -> BTreeSet<Id> {
    let mut found = BTreeSet::new();
    let mut todo = vec![body.as_ref()];
    let mut mark = |a: &Atom| {
        if let Atom::Global(v) = a {
            found.insert(v.clone());
        }
    };
    while let Some(body) = todo.pop() {
        match body {
            Anf::Let(_, rhs, rest) => {
                todo.push(rest);
                match rhs {
                    Rhs::Atom(a) | Rhs::Field(a, _) => mark(a),
                    Rhs::Call(f, args) => {
                        mark(f);
                        for a in args {
                            mark(a);
                        }
                    }
                    Rhs::Con(_, args) | Rhs::Prim(_, args, _) => {
                        for a in args {
                            mark(a);
                        }
                    }
                    Rhs::Lambda(l) => todo.push(&l.body),
                }
            }
            Anf::LetRec(bs, rest) => {
                todo.push(rest);
                for (_, l) in bs {
                    todo.push(&l.body);
                }
            }
            Anf::Join(_, _, body, rest) => {
                todo.push(rest);
                todo.push(body);
            }
            Anf::Case(a, alts) => {
                mark(a);
                for (_, _, body) in alts {
                    todo.push(body);
                }
            }
            Anf::Ret(a) => mark(a),
            Anf::TailCall(f, args) => {
                mark(f);
                for a in args {
                    mark(a);
                }
            }
            Anf::Jump(_, args) => {
                for a in args {
                    mark(a);
                }
            }
            Anf::Fail(_) => {}
        }
    }
    found
}
/// A closure's body does not run during initialization. Calls and failure stay roots.
pub fn discardable(body: &Body) -> bool {
    let mut todo = vec![body.as_ref()];
    while let Some(body) = todo.pop() {
        match body {
            Anf::Let(_, rhs, rest) => {
                if !crate::anf_simplify::discardable(rhs) {
                    return false;
                }
                todo.push(rest);
            }
            Anf::LetRec(_, rest) => todo.push(rest),
            Anf::Ret(_) => {}
            // Control-flow initializers are conservatively retained. A jump may loop.
            _ => return false,
        }
    }
    true
}
/// Filtering preserves the original dependency and initialization order.
pub fn prune(program: &mut Program, reach: &Reach) {
    program
        .globals
        .retain(|(id, _)| reach.witness.contains_key(id));
}
/// Stable diagnostic spelling keeps unique-number churn out of the witness dump.
pub fn display(reach: &Reach, original: usize) -> String {
    use std::fmt::Write;
    let mut text = String::new();
    for id in &reach.kept {
        let parent = reach.witness[id]
            .as_ref()
            .map_or("root", |p| p.text.as_str());
        writeln!(text, "{} <- {parent}", id.text).unwrap();
    }
    writeln!(
        text,
        "kept {}, dropped {}",
        reach.kept.len(),
        original - reach.kept.len()
    )
    .unwrap();
    text
}
/// Follow dependencies from explicit roots and observable initializers in stable order.
pub fn analyze(program: &Program, roots: &[Id]) -> Reach {
    let bodies = program
        .globals
        .iter()
        .map(|(id, body)| (id.clone(), body))
        .collect::<BTreeMap<_, _>>();
    let mut witness = BTreeMap::new();
    let mut todo = VecDeque::new();
    for id in roots.iter().cloned().chain(
        program
            .globals
            .iter()
            .filter(|(_, b)| !discardable(b))
            .map(|(v, _)| v.clone()),
    ) {
        if bodies.contains_key(&id) && !witness.contains_key(&id) {
            witness.insert(id.clone(), None);
            todo.push_back(id);
        }
    }
    while let Some(id) = todo.pop_front() {
        for next in references(bodies[&id]) {
            if bodies.contains_key(&next) && !witness.contains_key(&next) {
                witness.insert(next.clone(), Some(id.clone()));
                todo.push_back(next);
            }
        }
    }
    Reach {
        kept: program
            .globals
            .iter()
            .filter(|(v, _)| witness.contains_key(v))
            .map(|(v, _)| v.clone())
            .collect(),
        witness,
    }
}
}

Erasure classifies types while they are still available:

#![allow(unused)]
fn main() {
use crate::{
    ast::Op, core, data::ConId, names::Id, rep::Rep, source::Span,
};
use std::collections::BTreeMap;
#[derive(Clone, Debug)]
/// Expression-result evidence supplies the type of fresh ANF temporaries.
pub struct Expr {
    pub node: Node,
    pub rep: Rep,
}
#[derive(Clone, Debug)]
/// Untyped Core retains strict evaluation order and lexical join points.
pub enum Node {
    Var(Id),
    Global(Id),
    Lit(core::Lit),
    Lam(Id, Box<Expr>),
    App(Box<Expr>, Box<Expr>),
    Let(bool, Vec<(Id, Expr)>, Box<Expr>),
    Con(ConId, Vec<Expr>),
    Prim(Op, Vec<Expr>, Span),
    Case(Box<Expr>, Id, Vec<(core::AltCon, Vec<Id>, Expr)>),
    Join(Id, Vec<Id>, Box<Expr>, Box<Expr>),
    Jump(Id, Vec<Expr>),
    Fail(Span),
}
#[derive(Clone, Debug)]
pub struct Program {
    pub globals: Vec<(Id, Expr)>,
    pub reps: BTreeMap<Id, Rep>,
    pub metadata: core::Program,
}
/// Postorder erasure uses a worklist so expression depth does not consume host stack.
fn expression(
    root: &core::Expr,
    program: &core::Program,
    reps: &mut BTreeMap<Id, Rep>,
) -> Expr {
    use core::{Expr as C, Type as T};
    let mut todo = vec![(root, false)];
    let mut results: Vec<(Expr, T)> = vec![];
    while let Some((e, done)) = todo.pop() {
        let children: Vec<&core::Expr> = match e {
            C::Lam(_, e) | C::TyLam(_, e) | C::TyApp(e, _) => vec![e],
            C::App(f, a) => vec![f, a],
            C::Let(g, b) => g
                .binds
                .iter()
                .map(|b| b.rhs.as_ref())
                .chain(std::iter::once(b.as_ref()))
                .collect(),
            C::Con(_, _, es) | C::Prim(_, _, es, _) | C::Jump(_, es, _) => {
                es.iter().collect()
            }
            C::Case(e, _, _, alts) => std::iter::once(e.as_ref())
                .chain(alts.iter().map(|a| &a.rhs))
                .collect(),
            C::Join(_, _, b, r) => vec![b, r],
            C::Match(_) => panic!("match compilation precedes erasure"),
            _ => vec![],
        };
        if !done {
            todo.push((e, true));
            todo.extend(children.into_iter().rev().map(|c| (c, false)));
            continue;
        }
        let start = results.len() - children.len();
        let mut parts = results.split_off(start).into_iter();
        let mut bind = |i: &core::Id| {
            reps.insert(i.name.clone(), representation(&i.ty));
            i.name.clone()
        };
        let (node, ty) = match e {
            C::Var(i) => (Node::Var(i.name.clone()), i.ty.clone()),
            C::Global(i) => (Node::Global(i.name.clone()), i.ty.clone()),
            C::Lit(l) => (
                Node::Lit(l.clone()),
                match l {
                    core::Lit::Int(_) => T::Int,
                    core::Lit::Double(_) => T::Double,
                    core::Lit::Char(_) => T::Char,
                    core::Lit::String(_) => T::String,
                },
            ),
            C::Lam(i, _) => {
                let (b, t) = parts.next().unwrap();
                (Node::Lam(bind(i), Box::new(b)), T::arrow(i.ty.clone(), t))
            }
            C::App(_, _) => {
                let (f, t) = parts.next().unwrap();
                let (a, _) = parts.next().unwrap();
                let T::Arrow(_, t) = t else {
                    panic!("checked Core application")
                };
                (Node::App(Box::new(f), Box::new(a)), *t)
            }
            C::TyLam(v, _) => {
                let (e, t) = parts.next().unwrap();
                (e.node, T::Forall(*v, Box::new(t)))
            }
            C::TyApp(_, a) => {
                let (e, t) = parts.next().unwrap();
                let T::Forall(v, t) = t else {
                    panic!("checked Core instantiation")
                };
                (e.node, t.substitute(v, a))
            }
            C::Let(g, _) => {
                let bs = g
                    .binds
                    .iter()
                    .map(|b| (bind(&b.name), parts.next().unwrap().0))
                    .collect();
                let (b, t) = parts.next().unwrap();
                (Node::Let(g.recursive, bs, Box::new(b)), t)
            }
            C::Con(c, args, _) => {
                let d = &program.constructors[c.index as usize];
                let t = crate::elaborate::instantiate(
                    &d.result,
                    &d.parameters,
                    args,
                );
                (Node::Con(c.clone(), parts.map(|p| p.0).collect()), t)
            }
            C::Prim(op, ts, _, span) => {
                let (mut t, n) = crate::primitives::core_signature(
                    *op,
                    ts,
                    &program.data_types,
                )
                .expect("checked primitive");
                for _ in 0..n {
                    let T::Arrow(_, b) = t else { unreachable!() };
                    t = *b;
                }
                (Node::Prim(*op, parts.map(|p| p.0).collect(), *span), t)
            }
            C::Case(_, i, t, alts) => {
                let e = parts.next().unwrap().0;
                let alts = alts
                    .iter()
                    .map(|a| {
                        (
                            a.con.clone(),
                            a.binders.iter().map(&mut bind).collect(),
                            parts.next().unwrap().0,
                        )
                    })
                    .collect();
                (Node::Case(Box::new(e), bind(i), alts), t.clone())
            }
            C::Join(j, ps, _, _) => {
                let b = parts.next().unwrap().0;
                let (r, t) = parts.next().unwrap();
                (
                    Node::Join(
                        j.clone(),
                        ps.iter().map(&mut bind).collect(),
                        Box::new(b),
                        Box::new(r),
                    ),
                    t,
                )
            }
            C::Jump(j, _, t) => (
                Node::Jump(j.clone(), parts.map(|p| p.0).collect()),
                t.clone(),
            ),
            C::PatternFail(s, t) => (Node::Fail(*s), t.clone()),
            C::Match(_) => unreachable!(),
        };
        results.push((
            Expr {
                node,
                rep: representation(&ty),
            },
            ty,
        ));
    }
    results.pop().unwrap().0
}
/// Evidence is recorded while types exist. Later passes may only copy established facts.
pub fn erase(mut program: core::Program) -> Program {
    let mut reps = BTreeMap::new();
    let globals = program
        .groups
        .iter()
        .flat_map(|g| &g.binds)
        .map(|b| {
            reps.insert(b.name.name.clone(), representation(&b.name.ty));
            (b.name.name.clone(), expression(&b.rhs, &program, &mut reps))
        })
        .collect();
    program.global_types = program
        .groups
        .iter()
        .flat_map(|g| &g.binds)
        .map(|b| {
            (
                b.name.name.clone(),
                crate::core_type::fingerprint(&b.name.ty),
            )
        })
        .collect();
    // Consuming Core must not recursively destroy its nested expressions.
    let mut todo = program
        .groups
        .drain(..)
        .flat_map(|g| g.binds.into_iter().map(|b| *b.rhs))
        .collect::<Vec<_>>();
    while let Some(e) = todo.pop() {
        use core::Expr as C;
        match e {
            C::Lam(_, b) | C::TyLam(_, b) | C::TyApp(b, _) => todo.push(*b),
            C::App(a, b) | C::Join(_, _, a, b) => {
                todo.push(*a);
                todo.push(*b);
            }
            C::Let(g, b) => {
                todo.push(*b);
                todo.extend(g.binds.into_iter().map(|b| *b.rhs));
            }
            C::Con(_, _, es) | C::Prim(_, _, es, _) | C::Jump(_, es, _) => {
                todo.extend(es)
            }
            C::Case(e, _, _, alts) => {
                todo.push(*e);
                todo.extend(alts.into_iter().map(|a| a.rhs));
            }
            C::Match(_) => {
                unreachable!("match compilation precedes erasure")
            }
            _ => {}
        }
    }
    Program {
        globals,
        reps,
        metadata: program,
    }
}
pub(crate) fn literal_rep(l: &core::Lit) -> Rep {
    match l {
        core::Lit::Int(_) => Rep::Int,
        core::Lit::Double(_) => Rep::Double,
        _ => Rep::Word,
    }
}
/// Compact syntax uses an explicit print stack and bounded indentation. Debug's
/// indentation grows with depth and makes even a linear tree quadratic in bytes.
impl std::fmt::Display for Expr {
    fn fmt(&self, f: &mut std::fmt::Formatter<'_>) -> std::fmt::Result {
        enum Work<'a> {
            Expr(&'a Expr),
            Text(String),
        }
        let mut todo = vec![Work::Expr(self)];
        while let Some(work) = todo.pop() {
            match work {
                Work::Text(s) => write!(f, "{s}")?,
                Work::Expr(e) => {
                    let mut parts = vec![];
                    match &e.node {
                        Node::Var(v) => write!(f, "{v}")?,
                        Node::Global(v) => write!(f, "@{v}")?,
                        Node::Lit(l) => write!(f, "{l}")?,
                        Node::Lam(v, b) => {
                            write!(f, "(lambda {v}. ")?;
                            parts.push(Work::Expr(b));
                            parts.push(Work::Text(")".into()));
                        }
                        Node::App(a, b) => {
                            write!(f, "(")?;
                            parts.extend([
                                Work::Expr(a),
                                Work::Text(" ".into()),
                                Work::Expr(b),
                                Work::Text(")".into()),
                            ]);
                        }
                        Node::Con(c, es) => {
                            write!(f, "({}", c.name)?;
                            for e in es {
                                parts.push(Work::Text(" ".into()));
                                parts.push(Work::Expr(e));
                            }
                            parts.push(Work::Text(")".into()));
                        }
                        Node::Prim(p, es, _) => {
                            write!(f, "({}", p.text())?;
                            for e in es {
                                parts.push(Work::Text(" ".into()));
                                parts.push(Work::Expr(e));
                            }
                            parts.push(Work::Text(")".into()));
                        }
                        Node::Jump(j, es) => {
                            write!(f, "(jump {j}")?;
                            for e in es {
                                parts.push(Work::Text(" ".into()));
                                parts.push(Work::Expr(e));
                            }
                            parts.push(Work::Text(")".into()));
                        }
                        Node::Let(rec, bs, b) => {
                            write!(
                                f,
                                "(let{} ",
                                if *rec { "rec" } else { "" }
                            )?;
                            for (v, e) in bs {
                                parts.push(Work::Text(format!("{v} = ")));
                                parts.push(Work::Expr(e));
                                parts.push(Work::Text(";\n".into()));
                            }
                            parts.extend([
                                Work::Text("in ".into()),
                                Work::Expr(b),
                                Work::Text(")".into()),
                            ]);
                        }
                        Node::Case(e, v, alts) => {
                            write!(f, "(case ")?;
                            parts.extend([
                                Work::Expr(e),
                                Work::Text(format!(" as {v} {{\n")),
                            ]);
                            for (c, ps, e) in alts {
                                let c = match c {
                                    core::AltCon::Con(c) => c.name.clone(),
                                    core::AltCon::Lit(l) => l.to_string(),
                                    core::AltCon::Default => "_".into(),
                                };
                                parts.push(Work::Text(c));
                                for p in ps {
                                    parts.push(Work::Text(format!(" {p}")));
                                }
                                parts.extend([
                                    Work::Text(" -> ".into()),
                                    Work::Expr(e),
                                    Work::Text(";\n".into()),
                                ]);
                            }
                            parts.push(Work::Text("})".into()));
                        }
                        Node::Join(j, ps, b, r) => {
                            write!(f, "(join {j}")?;
                            for p in ps {
                                write!(f, " {p}")?;
                            }
                            write!(f, " = ")?;
                            parts.extend([
                                Work::Expr(b),
                                Work::Text("\nin ".into()),
                                Work::Expr(r),
                                Work::Text(")".into()),
                            ]);
                        }
                        Node::Fail(s) => write!(f, "fail {s:?}")?,
                    }
                    todo.extend(parts.into_iter().rev());
                }
            }
        }
        Ok(())
    }
}
/// Destroy an owned erased tree without recursively following Box edges.
pub fn discard(root: Expr) {
    let mut todo = vec![root];
    while let Some(e) = todo.pop() {
        match e.node {
            Node::Lam(_, b) => todo.push(*b),
            Node::App(a, b) | Node::Join(_, _, a, b) => {
                todo.push(*a);
                todo.push(*b);
            }
            Node::Let(_, bs, b) => {
                todo.push(*b);
                todo.extend(bs.into_iter().map(|(_, e)| e));
            }
            Node::Con(_, es) | Node::Prim(_, es, _) | Node::Jump(_, es) => {
                todo.extend(es)
            }
            Node::Case(e, _, alts) => {
                todo.push(*e);
                todo.extend(alts.into_iter().map(|(_, _, e)| e));
            }
            _ => {}
        }
    }
}
/// This is the single classification point. A type variable proves no numeric representation.
pub(crate) fn representation(ty: &core::Type) -> Rep {
    match ty {
        core::Type::Int => Rep::Int,
        core::Type::Double => Rep::Double,
        _ => Rep::Word,
    }
}
}

An explicit postorder worklist records binder and expression-result evidence. ANF copies it to fresh temporaries, including the result of each application in an oversaturated call. Closure conversion preserves it. Missing or contradictory numeric evidence is an internal lint error. The interpreters ignore this table. IR dumps show numeric annotations so the reader can inspect the facts themselves.

Within LLVM emission, a separate enum describes current storage:

#![allow(unused)]
fn main() {
use super::*;
use crate::{
    core::Lit,
    flat::{Atom, FuncId},
    runtime_layout as layout,
};
use inkwell::{
    types::BasicMetadataTypeEnum,
    values::{BasicMetadataValueEnum, PointerValue},
};
impl<'ctx> Backend<'ctx, '_> {
    pub(super) fn n(&self, n: u64) -> IntValue<'ctx> {
        self.word.const_int(n, false)
    }
    pub(super) fn external(
        &self,
        name: &str,
        args: &[BasicMetadataTypeEnum<'ctx>],
        result: bool,
    ) -> FunctionValue<'ctx> {
        self.module.get_function(name).unwrap_or_else(|| {
            let ty = if result {
                self.word.fn_type(args, false)
            } else {
                self.context.void_type().fn_type(args, false)
            };
            self.module.add_function(name, ty, None)
        })
    }
    pub(super) fn call(
        &self,
        name: &str,
        args: &[BasicMetadataValueEnum<'ctx>],
    ) -> Result<IntValue<'ctx>> {
        let types = args
            .iter()
            .map(|a| match a {
                BasicMetadataValueEnum::IntValue(v) => v.get_type().into(),
                BasicMetadataValueEnum::PointerValue(v) => {
                    v.get_type().into()
                }
                _ => unreachable!("runtime ABI operands"),
            })
            .collect::<Vec<_>>();
        let call = self.builder.build_call(
            self.external(name, &types, true),
            args,
            "call",
        )?;
        // A tailcc function must regain control to restore its callee-pop frame.
        // LLVM's tail-call pass may otherwise infer a tail transfer into the C ABI.
        call.set_tail_call_kind(
            inkwell::values::LLVMTailCallKind::LLVMTailCallKindNoTail,
        );
        Ok(call.try_as_basic_value().unwrap_basic().into_int_value())
    }
    pub(super) fn void_call(
        &self,
        name: &str,
        args: &[BasicMetadataValueEnum<'ctx>],
    ) -> Result<()> {
        let types = args
            .iter()
            .map(|a| match a {
                BasicMetadataValueEnum::IntValue(v) => v.get_type().into(),
                BasicMetadataValueEnum::PointerValue(v) => {
                    v.get_type().into()
                }
                _ => unreachable!("runtime ABI operands"),
            })
            .collect::<Vec<_>>();
        self.builder.build_call(
            self.external(name, &types, false),
            args,
            "",
        )?;
        Ok(())
    }
    pub(super) fn pointer(
        &self,
        value: IntValue<'ctx>,
    ) -> Result<PointerValue<'ctx>> {
        Ok(self.builder.build_int_to_ptr(
            value,
            self.context.ptr_type(AddressSpace::default()),
            "ptr",
        )?)
    }
    pub(super) fn slot(
        &self,
        pointer: PointerValue<'ctx>,
        index: u64,
    ) -> Result<PointerValue<'ctx>> {
        // SAFETY: GEP indexes i64 words using the checked ABI layout.
        Ok(unsafe {
            self.builder.build_gep(
                self.word,
                pointer,
                &[self.n(index)],
                "slot",
            )?
        })
    }
    pub(super) fn load(
        &self,
        value: IntValue<'ctx>,
        index: u64,
    ) -> Result<IntValue<'ctx>> {
        Ok(self
            .builder
            .build_load(
                self.word,
                self.slot(self.pointer(value)?, index)?,
                "load",
            )?
            .into_int_value())
    }
    pub(super) fn store(
        &self,
        value: IntValue<'ctx>,
        index: u64,
        field: IntValue<'ctx>,
    ) -> Result<()> {
        self.builder
            .build_store(self.slot(self.pointer(value)?, index)?, field)?;
        Ok(())
    }
    pub(super) fn allocation(
        &self,
        kind: u8,
        tag: u32,
        fields: &[IntValue<'ctx>],
    ) -> Result<IntValue<'ctx>> {
        let name = if matches!(kind, layout::DOUBLE | layout::STRING) {
            "rt_alloc_atomic"
        } else {
            "rt_alloc"
        };
        let ptr = self.context.ptr_type(AddressSpace::default());
        let f = self.module.get_function(name).unwrap_or_else(|| {
            self.module.add_function(
                name,
                ptr.fn_type(&[self.word.into()], false),
                None,
            )
        });
        let size = (fields.len() + 1) as u64
            * if name == "rt_alloc" { 1 } else { 8 };
        let p = self
            .builder
            .build_call(f, &[self.n(size).into()], "alloc")?
            .try_as_basic_value()
            .unwrap_basic()
            .into_pointer_value();
        let value = self.builder.build_ptr_to_int(p, self.word, "word")?;
        self.store(
            value,
            0,
            self.n(layout::header(kind, tag, fields.len() as u32)),
        )?;
        for (i, field) in fields.iter().enumerate() {
            self.store(value, i as u64 + 1, *field)?;
        }
        Ok(value)
    }
    pub(super) fn closure(
        &self,
        f: FuncId,
        captures: &[IntValue<'ctx>],
    ) -> Result<IntValue<'ctx>> {
        let code = self.slow[f.0 as usize]
            .as_global_value()
            .as_pointer_value()
            .const_to_int(self.word);
        let mut fields = vec![
            code,
            self.n(self.program.funcs[f.0 as usize].params.len() as u64),
        ];
        fields.extend_from_slice(captures);
        self.allocation(layout::CLOSURE, 0, &fields)
    }
    fn string(&mut self, s: &str) -> IntValue<'ctx> {
        if let Some(v) = self.strings.get(s) {
            return *v;
        }
        let mut bytes = s.as_bytes().to_vec();
        bytes.resize(bytes.len().div_ceil(8) * 8, 0);
        let data = self.context.const_string(&bytes, false);
        let object = self.context.const_struct(
            &[
                self.n(layout::header(
                    layout::STRING,
                    0,
                    1 + (bytes.len() / 8) as u32,
                ))
                .into(),
                self.n(s.len() as u64).into(),
                data.into(),
            ],
            false,
        );
        let g = self.module.add_global(
            object.get_type(),
            None,
            &format!("fun.string{}", self.strings.len()),
        );
        g.set_linkage(Linkage::Private);
        g.set_constant(true);
        g.set_alignment(8);
        g.set_initializer(&object);
        let word = g.as_pointer_value().const_to_int(self.word);
        self.strings.insert(s.into(), word);
        word
    }
    /// Keep static string words in a retained data root table. Strings themselves are read-only.
    pub(super) fn string_roots(&self) {
        if self.strings.is_empty() {
            return;
        }
        let words = self.strings.values().copied().collect::<Vec<_>>();
        let array = self.word.const_array(&words);
        let roots = self.module.add_global(
            array.get_type(),
            None,
            "fun.string_roots",
        );
        roots.set_linkage(Linkage::Internal);
        roots.set_initializer(&array);
        roots.set_alignment(8);
        let ptr = self.context.ptr_type(AddressSpace::default());
        let used = ptr.const_array(&[roots.as_pointer_value()]);
        let keep =
            self.module.add_global(used.get_type(), None, "llvm.used");
        keep.set_linkage(Linkage::Appending);
        keep.set_section(Some("llvm.metadata"));
        keep.set_initializer(&used);
    }
    pub(super) fn literal(&mut self, l: &Lit) -> Result<IntValue<'ctx>> {
        Ok(match l {
            Lit::Int(n) => self.n(layout::integer(*n)),
            Lit::Char(c) => self.n(layout::integer(*c as i64)),
            Lit::String(s) => self.string(s),
            Lit::Double(bits) => {
                self.allocation(layout::DOUBLE, 0, &[self.n(*bits)])?
            }
        })
    }
    pub(super) fn atom(
        &mut self,
        a: &Atom,
        env: &Env<'ctx>,
    ) -> Result<Loc<'ctx>> {
        Ok(match a {
            Atom::Lit(Lit::Int(n)) => Loc::Int(self.n(*n as u64)),
            Atom::Lit(Lit::Double(bits)) => Loc::Double(
                self.context.f64_type().const_float(f64::from_bits(*bits)),
            ),
            Atom::Lit(l) => Loc::Word(self.literal(l)?),
            Atom::Var(v) => env[v],
            Atom::Global(v) => Loc::Word(
                self.builder
                    .build_load(
                        self.word,
                        self.globals[v].as_pointer_value(),
                        "global",
                    )?
                    .into_int_value(),
            ),
        })
    }
    pub(super) fn loc_word(
        &self,
        value: Loc<'ctx>,
    ) -> Result<IntValue<'ctx>> {
        match value {
            Loc::Word(v) => Ok(v),
            Loc::Int(v) => self.retag(v),
            Loc::Double(v) => self.box_double(v),
        }
    }
    pub(super) fn loc_int(
        &self,
        value: Loc<'ctx>,
    ) -> Result<IntValue<'ctx>> {
        match value {
            Loc::Word(v) => self.untag(v),
            Loc::Int(v) => Ok(v),
            Loc::Double(_) => {
                unreachable!("numeric evidence checked by Flat lint")
            }
        }
    }
    pub(super) fn loc_double(
        &self,
        value: Loc<'ctx>,
    ) -> Result<inkwell::values::FloatValue<'ctx>> {
        match value {
            Loc::Word(v) => self.unbox_double(v),
            Loc::Double(v) => Ok(v),
            Loc::Int(_) => {
                unreachable!("numeric evidence checked by Flat lint")
            }
        }
    }
    pub(super) fn atom_word(
        &mut self,
        a: &Atom,
        env: &Env<'ctx>,
    ) -> Result<IntValue<'ctx>> {
        let loc = self.atom(a, env)?;
        self.loc_word(loc)
    }
    pub(super) fn atoms(
        &mut self,
        args: &[Atom],
        env: &Env<'ctx>,
    ) -> Result<Vec<IntValue<'ctx>>> {
        args.iter().map(|a| self.atom_word(a, env)).collect()
    }
    pub(super) fn known(
        &self,
        f: FuncId,
        env: Option<IntValue<'ctx>>,
        args: &[IntValue<'ctx>],
        tail: bool,
    ) -> Result<IntValue<'ctx>> {
        let mut actual: Vec<BasicMetadataValueEnum> =
            vec![env.unwrap_or(self.n(0)).into()];
        actual
            .extend(args.iter().map(|v| BasicMetadataValueEnum::from(*v)));
        let call = self.builder.build_call(
            self.fast[f.0 as usize],
            &actual,
            "known",
        )?;
        call.set_call_convention(TAIL_CC);
        call.set_tail_call(tail);
        if self
            .builder
            .get_insert_block()
            .unwrap()
            .get_parent()
            .unwrap()
            .get_call_conventions()
            != TAIL_CC
        {
            call.set_tail_call_kind(
                inkwell::values::LLVMTailCallKind::LLVMTailCallKindNoTail,
            );
        }
        Ok(call.try_as_basic_value().unwrap_basic().into_int_value())
    }
    pub(super) fn apply(
        &self,
        f: IntValue<'ctx>,
        args: &[IntValue<'ctx>],
    ) -> Result<IntValue<'ctx>> {
        if (1..=4).contains(&args.len()) {
            let mut actual = vec![f.into()];
            actual.extend(
                args.iter().map(|v| BasicMetadataValueEnum::from(*v)),
            );
            return self.call(&format!("rt_apply{}", args.len()), &actual);
        }
        // Allocate in the entry, never in a loop reached by a join back-edge.
        let entry = self
            .builder
            .get_insert_block()
            .unwrap()
            .get_parent()
            .unwrap()
            .get_first_basic_block()
            .unwrap();
        let alloc = self.context.create_builder();
        if let Some(first) = entry.get_first_instruction() {
            alloc.position_before(&first);
        } else {
            alloc.position_at_end(entry);
        }
        let array = alloc.build_alloca(
            self.word.array_type(args.len().max(1) as u32),
            "arguments",
        )?;
        for (i, a) in args.iter().enumerate() {
            self.builder.build_store(self.slot(array, i as u64)?, *a)?;
        }
        self.call(
            "rt_apply",
            &[f.into(), self.n(args.len() as u64).into(), array.into()],
        )
    }
    pub(super) fn box_double(
        &self,
        v: inkwell::values::FloatValue<'ctx>,
    ) -> Result<IntValue<'ctx>> {
        let bits = self
            .builder
            .build_bit_cast(v, self.word, "bits")?
            .into_int_value();
        self.allocation(layout::DOUBLE, 0, &[bits])
    }
    pub(super) fn unbox_double(
        &self,
        v: IntValue<'ctx>,
    ) -> Result<inkwell::values::FloatValue<'ctx>> {
        Ok(self
            .builder
            .build_bit_cast(
                self.load(v, 1)?,
                self.context.f64_type(),
                "double",
            )?
            .into_float_value())
    }
}
/// Storage is local to codegen. All ABI boundaries still carry tagged words.
#[derive(Clone, Copy)]
pub(super) enum Loc<'ctx> {
    Word(IntValue<'ctx>),
    Int(IntValue<'ctx>),
    Double(inkwell::values::FloatValue<'ctx>),
}
}

atom_word handles ABI uses. Integer and Double primitive operands request native storage instead. A tagged input is decoded once for that use, while a result already in a native register can flow directly into the next primitive. Integer arithmetic calls the normalization helper before storing its native result:

#![allow(unused)]
fn main() {
fn normalize(&self, value: IntValue<'ctx>) -> Result<IntValue<'ctx>> {
    let bits =
        self.builder
            .build_left_shift(value, self.n(1), "wrap.bits")?;
    Ok(self.builder.build_right_shift(
        bits,
        self.n(1),
        true,
        "wrap.int",
    )?)
}
}

To isolate this codegen change, we construct Flat loops that use primitives directly and count runtime calls in the optimized LLVM. The integer loop needs none. The Double loop needs one atomic allocation for the value crossing its call boundary. We separately compare overloaded source programs with the interpreter. That keeps us honest about which improvement we’ve implemented.

Running It

From the repository root:

$ cd crates/ch23_optimize
$ cargo run -q -- run tests/programs/optimize/trace-sharing.fun --engine=anf --print-steps
once
42
steps: 92
$ cargo run -q -- run tests/programs/optimize/trace-sharing.fun --engine=anf --print-steps --no-simplify
once
42
steps: 171
$ cargo run -q -- dump --pass=reach tests/programs/optimize/trace-sharing.fun

The last command lists the retained definitions and their witnesses, ending with the number kept and dropped. Use dump --pass=anf or dump --pass=flat to inspect numeric binder annotations. To examine the actual optimized source loop:

$ cargo run -q -- dump --pass=llvm-opt tests/programs/optimize/double-loop.fun

Follow the dictionary calls as well as the local floating-point instructions. Comparing only the number of instructions in the source function can hide work inside its callees. cargo test --test optimization runs the work oracle and trace corpus. cargo test --test native includes the allocation-count contract.

Exercises

Warm-up. Predict the trace order when the second argument to trace is another traced expression. Confirm it on all engines.
Intermediate. Extend the reachability dump to show the complete path from a root rather than one predecessor.
Intermediate. Add Bool evidence and keep comparison results untagged until they cross a word boundary.
Advanced. Carry native integers through join parameters. State the new storage invariant and extend lint before changing code generation.
Advanced. Extend the work oracle with a counter for dead stores. Construct a rewrite that preserves transition counts but performs an unnecessary store.

Write You a Haskell