tatara-lisp-eval 0.4.4

//! Built-in primitive procedures.
//!
//! `install_primitives` registers the standard set of procedures on an
//! `Interpreter<H>`. The functions are generic over `H` so they compose
//! with any embedder. Primitives never read or mutate host state — they
//! operate only on their `Value` arguments.
//!
//! The public contract is the set of names registered. Removing or
//! renaming any entry is a breaking change; adding entries is fine.

use std::sync::Arc;

use tatara_lisp::{Sexp, Span};

use crate::error::{EvalError, Result};
use crate::eval::Interpreter;
use crate::ffi::{owned_args, Arity};
use crate::persist::List;
use crate::value::Value;

/// Names of primitive procedures registered by `install_primitives`.
/// Kept in sync by a self-test — see `tests::names_match_installed`.
pub const PRIMITIVE_NAMES: &[&str] = &[
    // arithmetic
    "+",
    "-",
    "*",
    "/",
    "modulo",
    "abs",
    "min",
    "max",
    "expt",
    "sqrt",
    "floor",
    "ceiling",
    "round",
    "truncate",
    "gcd",
    "lcm",
    "sin",
    "cos",
    "tan",
    "asin",
    "acos",
    "atan",
    "atan2",
    "hypot",
    "log",
    "exp",
    // explicit two's-complement arithmetic
    "wrapping-add",
    "wrapping-sub",
    "wrapping-mul",
    // comparison
    "=",
    "<",
    ">",
    "<=",
    ">=",
    "not=",
    // type predicates
    "null?",
    "pair?",
    "list?",
    "symbol?",
    "string?",
    "integer?",
    "number?",
    "boolean?",
    "procedure?",
    "foreign?",
    "atom?",
    "keyword?",
    // lists
    "car",
    "cdr",
    "cons",
    "list",
    "length",
    "reverse",
    "append",
    "take",
    "drop",
    "nth",
    // equality
    "eq?",
    "equal?",
    // strings
    "string-length",
    "string-append",
    "string",
    // string <-> symbol/keyword
    "symbol->string",
    "keyword->string",
    "string->symbol",
    "string->keyword",
    // IO (embedder may replace)
    "display",
    "newline",
    "print",
    "println",
    "pr-str",
    // Reader / eval helpers
    "read-string",
    "read-all",
    // Comparison / bit ops
    "compare",
    "bit-and",
    "bit-or",
    "bit-xor",
    "bit-not",
    "bit-shift-left",
    "bit-shift-right",
    // Hygiene helpers
    "gensym",
    // Structured errors
    "error",
    "ex-info",
    "throw",
    "error?",
    "error-tag",
    "error-message",
    "error-data",
    "error-data-get",
];

/// Register the standard primitive set on `interp`.
pub fn install_primitives<H: 'static>(interp: &mut Interpreter<H>) {
    // ── Arithmetic ────────────────────────────────────────────────
    // Integer arithmetic is CHECKED: a result that does not fit `i64` is
    // `EvalError::IntegerOverflow`, never a wrapped value. It used to be `a + b`
    // on `i64`, which wraps in a release build and panics in a debug one — the
    // answer was a function of the build profile. Wrapping is still there,
    // asked for by name: `wrapping-add`, `wrapping-sub`, `wrapping-mul`.
    interp.register_fn("+", Arity::AtLeast(0), |args: &[Value], _h: &mut H, sp| {
        reduce_numeric(args, sp, "+", 0, 0.0, i64::checked_add, |a, b| a + b)
    });
    interp.register_fn("-", Arity::AtLeast(1), prim_sub::<H>);
    interp.register_fn("*", Arity::AtLeast(0), |args: &[Value], _h: &mut H, sp| {
        reduce_numeric(args, sp, "*", 1, 1.0, i64::checked_mul, |a, b| a * b)
    });
    interp.register_fn(
        "wrapping-add",
        Arity::AtLeast(0),
        |args: &[Value], _h: &mut H, sp| {
            let mut acc: i64 = 0;
            for a in args {
                acc = acc.wrapping_add(expect_int(a, sp)?);
            }
            Ok(Value::Int(acc))
        },
    );
    interp.register_fn(
        "wrapping-sub",
        Arity::AtLeast(1),
        |args: &[Value], _h: &mut H, sp| {
            let first = expect_int(&args[0], sp)?;
            if args.len() == 1 {
                return Ok(Value::Int(first.wrapping_neg()));
            }
            let mut acc = first;
            for a in &args[1..] {
                acc = acc.wrapping_sub(expect_int(a, sp)?);
            }
            Ok(Value::Int(acc))
        },
    );
    interp.register_fn(
        "wrapping-mul",
        Arity::AtLeast(0),
        |args: &[Value], _h: &mut H, sp| {
            let mut acc: i64 = 1;
            for a in args {
                acc = acc.wrapping_mul(expect_int(a, sp)?);
            }
            Ok(Value::Int(acc))
        },
    );
    interp.register_fn("/", Arity::AtLeast(1), prim_div::<H>);
    interp.register_fn(
        "modulo",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| {
            let a = expect_int(&args[0], sp)?;
            let b = expect_int(&args[1], sp)?;
            if b == 0 {
                return Err(EvalError::DivisionByZero { at: sp });
            }
            a.checked_rem_euclid(b)
                .map(Value::Int)
                .ok_or(EvalError::IntegerOverflow {
                    op: "modulo",
                    at: sp,
                })
        },
    );
    interp.register_fn(
        "abs",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Int(n) => n
                .checked_abs()
                .map(Value::Int)
                .ok_or(EvalError::IntegerOverflow { op: "abs", at: sp }),
            Value::Float(n) => Ok(Value::Float(n.abs())),
            other => Err(EvalError::type_mismatch("number", other.type_name(), sp)),
        },
    );
    interp.register_fn(
        "min",
        Arity::AtLeast(1),
        |args: &[Value], _h: &mut H, sp| {
            reduce_numeric(
                args,
                sp,
                "min",
                i64::MAX,
                f64::INFINITY,
                |a, b| Some(a.min(b)),
                f64::min,
            )
        },
    );
    interp.register_fn(
        "max",
        Arity::AtLeast(1),
        |args: &[Value], _h: &mut H, sp| {
            reduce_numeric(
                args,
                sp,
                "max",
                i64::MIN,
                f64::NEG_INFINITY,
                |a, b| Some(a.max(b)),
                f64::max,
            )
        },
    );

    // ── Comparison ────────────────────────────────────────────────
    interp.register_fn("=", Arity::AtLeast(2), |args: &[Value], _h: &mut H, sp| {
        cmp_chain(args, sp, |a, b| a == b, |a, b| a == b)
    });
    interp.register_fn("<", Arity::AtLeast(2), |args: &[Value], _h: &mut H, sp| {
        cmp_chain(args, sp, |a, b| a < b, |a, b| a < b)
    });
    interp.register_fn(">", Arity::AtLeast(2), |args: &[Value], _h: &mut H, sp| {
        cmp_chain(args, sp, |a, b| a > b, |a, b| a > b)
    });
    interp.register_fn("<=", Arity::AtLeast(2), |args: &[Value], _h: &mut H, sp| {
        cmp_chain(args, sp, |a, b| a <= b, |a, b| a <= b)
    });
    interp.register_fn(">=", Arity::AtLeast(2), |args: &[Value], _h: &mut H, sp| {
        cmp_chain(args, sp, |a, b| a >= b, |a, b| a >= b)
    });

    // ── Predicates ────────────────────────────────────────────────
    interp.register_fn("null?", Arity::Exact(1), |a: &[Value], _h: &mut H, _sp| {
        // Scheme R7RS: null? holds for both `()` and the empty list literal.
        // We represent both as `Value::Nil` and `Value::List([])` — accept both.
        Ok(Value::Bool(match &a[0] {
            Value::Nil => true,
            Value::List(xs) => xs.is_empty(),
            _ => false,
        }))
    });
    interp.register_fn("pair?", Arity::Exact(1), |a: &[Value], _h: &mut H, _sp| {
        Ok(Value::Bool(
            matches!(&a[0], Value::List(xs) if !xs.is_empty()),
        ))
    });
    interp.register_fn("list?", Arity::Exact(1), |a: &[Value], _h: &mut H, _sp| {
        Ok(Value::Bool(matches!(&a[0], Value::List(_) | Value::Nil)))
    });
    interp.register_fn(
        "symbol?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| Ok(Value::Bool(matches!(&a[0], Value::Symbol(_)))),
    );
    interp.register_fn(
        "string?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| Ok(Value::Bool(matches!(&a[0], Value::Str(_)))),
    );
    interp.register_fn(
        "integer?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| Ok(Value::Bool(matches!(&a[0], Value::Int(_)))),
    );
    interp.register_fn(
        "number?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| {
            Ok(Value::Bool(matches!(
                &a[0],
                Value::Int(_) | Value::Float(_)
            )))
        },
    );
    interp.register_fn(
        "boolean?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| Ok(Value::Bool(matches!(&a[0], Value::Bool(_)))),
    );
    interp.register_fn(
        "procedure?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| {
            Ok(Value::Bool(matches!(
                &a[0],
                Value::Closure(_) | Value::NativeFn(_)
            )))
        },
    );
    interp.register_fn(
        "foreign?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| Ok(Value::Bool(matches!(&a[0], Value::Foreign(_)))),
    );

    // ── Lists ─────────────────────────────────────────────────────
    interp.register_fn("car", Arity::Exact(1), prim_car::<H>);
    interp.register_fn("cdr", Arity::Exact(1), prim_cdr::<H>);
    interp.register_owned_fn("cons", Arity::Exact(2), prim_cons::<H>);
    interp.register_fn("list", Arity::Any, |args: &[Value], _h: &mut H, _sp| {
        Ok(Value::list(args.iter().cloned()))
    });
    interp.register_fn(
        "length",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Nil => Ok(Value::Int(0)),
            Value::List(xs) => Ok(Value::Int(xs.len() as i64)),
            other => Err(EvalError::type_mismatch("list", other.type_name(), sp)),
        },
    );
    interp.register_fn(
        "reverse",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Nil => Ok(Value::Nil),
            Value::List(xs) => Ok(Value::list(xs.iter().rev().cloned())),
            other => Err(EvalError::type_mismatch("list", other.type_name(), sp)),
        },
    );
    interp.register_owned_fn("append", Arity::Any, prim_append::<H>);

    // ── Equality ──────────────────────────────────────────────────
    interp.register_fn("eq?", Arity::Exact(2), |a: &[Value], _h: &mut H, _sp| {
        Ok(Value::Bool(value_eq_shallow(&a[0], &a[1])))
    });
    interp.register_fn("equal?", Arity::Exact(2), |a: &[Value], _h: &mut H, _sp| {
        Ok(Value::Bool(value_eq_deep(&a[0], &a[1])))
    });

    // ── Strings ───────────────────────────────────────────────────
    interp.register_fn(
        "string-length",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Str(s) => Ok(Value::Int(s.chars().count() as i64)),
            other => Err(EvalError::type_mismatch("string", other.type_name(), sp)),
        },
    );
    interp.register_fn(
        "string-append",
        Arity::Any,
        |args: &[Value], _h: &mut H, sp| {
            let mut out = String::new();
            for a in args {
                match a {
                    Value::Str(s) => out.push_str(s.as_ref()),
                    other => return Err(EvalError::type_mismatch("string", other.type_name(), sp)),
                }
            }
            Ok(Value::Str(Arc::from(out)))
        },
    );

    // (string x) — universal Value → string conversion via Display.
    // Clojure idiom — works on any Value.
    interp.register_fn(
        "string",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, _sp| {
            let s = match &args[0] {
                // Strings pass through unchanged (no quoting).
                Value::Str(s) => s.to_string(),
                other => format!("{other}"),
            };
            Ok(Value::Str(Arc::from(s)))
        },
    );

    // ── More numeric ──────────────────────────────────────────────
    interp.register_fn(
        "expt",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| match (&args[0], &args[1]) {
            // An integer to a non-negative integer power is exact or refused.
            // It used to wrap (`wrapping_mul`) below an exponent of 64 and
            // turn into a float at 64 and above.
            (Value::Int(b), Value::Int(e)) if *e >= 0 => u32::try_from(*e)
                .ok()
                .and_then(|e| b.checked_pow(e))
                .map(Value::Int)
                .ok_or(EvalError::IntegerOverflow { op: "expt", at: sp }),
            (a, b) => {
                let af = as_number_either(a, sp)?.to_float();
                let bf = as_number_either(b, sp)?.to_float();
                Ok(Value::Float(af.powf(bf)))
            }
        },
    );
    interp.register_fn("sqrt", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        Ok(Value::Float(n.sqrt()))
    });
    interp.register_fn(
        "floor",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| {
            let n = as_number_either(&args[0], sp)?.to_float();
            float_to_int(n.floor(), "floor", sp)
        },
    );
    interp.register_fn(
        "ceiling",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| {
            let n = as_number_either(&args[0], sp)?.to_float();
            float_to_int(n.ceil(), "ceiling", sp)
        },
    );
    interp.register_fn(
        "round",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| {
            let n = as_number_either(&args[0], sp)?.to_float();
            float_to_int(n.round(), "round", sp)
        },
    );
    interp.register_fn(
        "truncate",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| {
            let n = as_number_either(&args[0], sp)?.to_float();
            float_to_int(n.trunc(), "truncate", sp)
        },
    );
    interp.register_fn(
        "gcd",
        Arity::AtLeast(0),
        |args: &[Value], _h: &mut H, sp| {
            if args.is_empty() {
                return Ok(Value::Int(0));
            }
            let mut g = abs_int(expect_int(&args[0], sp)?, "gcd", sp)?;
            for a in &args[1..] {
                let b = abs_int(expect_int(a, sp)?, "gcd", sp)?;
                g = gcd(g, b);
            }
            Ok(Value::Int(g))
        },
    );
    interp.register_fn(
        "lcm",
        Arity::AtLeast(0),
        |args: &[Value], _h: &mut H, sp| {
            if args.is_empty() {
                return Ok(Value::Int(1));
            }
            let mut l = abs_int(expect_int(&args[0], sp)?, "lcm", sp)?;
            for a in &args[1..] {
                let b = abs_int(expect_int(a, sp)?, "lcm", sp)?;
                if l == 0 || b == 0 {
                    l = 0;
                } else {
                    l = (l / gcd(l, b))
                        .checked_mul(b)
                        .ok_or(EvalError::IntegerOverflow { op: "lcm", at: sp })?;
                }
            }
            Ok(Value::Int(l))
        },
    );
    interp.register_fn("sin", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        Ok(Value::Float(n.sin()))
    });
    interp.register_fn("cos", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        Ok(Value::Float(n.cos()))
    });
    interp.register_fn("tan", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        Ok(Value::Float(n.tan()))
    });
    // The inverses. `asin` and `acos` are defined only on [-1, 1]; outside it
    // Rust answers NaN, which then compares false to everything and flows on
    // as a number. A NaN angle is not an angle, so it is refused by name.
    // A caller clamping a value that went slightly past 1 through rounding
    // does so on purpose, where the reason is visible.
    interp.register_fn("asin", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        if !(-1.0..=1.0).contains(&n) {
            return Err(EvalError::native_fn(
                "asin",
                format!("{n} is outside [-1, 1]"),
                sp,
            ));
        }
        Ok(Value::Float(n.asin()))
    });
    interp.register_fn("acos", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        if !(-1.0..=1.0).contains(&n) {
            return Err(EvalError::native_fn(
                "acos",
                format!("{n} is outside [-1, 1]"),
                sp,
            ));
        }
        Ok(Value::Float(n.acos()))
    });
    interp.register_fn("atan", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        Ok(Value::Float(n.atan()))
    });
    // (atan2 y x): the angle of the point (x, y), in (-pi, pi]. The argument
    // order is C's and every libm's, y first, so a formula copied from a
    // reference reads the same here.
    interp.register_fn(
        "atan2",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| {
            let y = as_number_either(&args[0], sp)?.to_float();
            let x = as_number_either(&args[1], sp)?.to_float();
            Ok(Value::Float(y.atan2(x)))
        },
    );
    // (hypot x y): sqrt(x^2 + y^2) without the overflow or underflow the
    // squares would suffer.
    interp.register_fn(
        "hypot",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| {
            let x = as_number_either(&args[0], sp)?.to_float();
            let y = as_number_either(&args[1], sp)?.to_float();
            Ok(Value::Float(x.hypot(y)))
        },
    );
    interp.register_fn(
        "log",
        Arity::Range(1, 2),
        |args: &[Value], _h: &mut H, sp| {
            let n = as_number_either(&args[0], sp)?.to_float();
            if args.len() == 1 {
                Ok(Value::Float(n.ln()))
            } else {
                let base = as_number_either(&args[1], sp)?.to_float();
                Ok(Value::Float(n.log(base)))
            }
        },
    );
    interp.register_fn("exp", Arity::Exact(1), |args: &[Value], _h: &mut H, sp| {
        let n = as_number_either(&args[0], sp)?.to_float();
        Ok(Value::Float(n.exp()))
    });

    // ── More list ops ─────────────────────────────────────────────
    interp.register_fn("take", Arity::Exact(2), |args: &[Value], _h: &mut H, sp| {
        let n = expect_int(&args[0], sp)?.max(0) as usize;
        Ok(match list_view(&args[1], sp)? {
            Some(xs) if n > 0 => Value::List(Arc::new(xs.take(n))),
            _ => Value::list([]),
        })
    });
    interp.register_fn("drop", Arity::Exact(2), |args: &[Value], _h: &mut H, sp| {
        let n = expect_int(&args[0], sp)?.max(0) as usize;
        Ok(match list_view(&args[1], sp)? {
            Some(xs) => Value::List(Arc::new(xs.skip(n))),
            None => Value::list([]),
        })
    });
    interp.register_fn("nth", Arity::Exact(2), |args: &[Value], _h: &mut H, sp| {
        let n = expect_int(&args[0], sp)?;
        let xs = list_view(&args[1], sp)?;
        Ok(usize::try_from(n)
            .ok()
            .and_then(|i| xs.and_then(|xs| xs.get(i)))
            .cloned()
            .unwrap_or(Value::Nil))
    });
    interp.register_fn("not=", Arity::Exact(2), |a: &[Value], _h: &mut H, _sp| {
        Ok(Value::Bool(!value_eq_deep(&a[0], &a[1])))
    });
    interp.register_fn("atom?", Arity::Exact(1), |a: &[Value], _h: &mut H, _sp| {
        Ok(Value::Bool(!matches!(
            &a[0],
            Value::List(_) | Value::Nil | Value::Closure(_) | Value::NativeFn(_)
        )))
    });
    interp.register_fn(
        "keyword?",
        Arity::Exact(1),
        |a: &[Value], _h: &mut H, _sp| Ok(Value::Bool(matches!(&a[0], Value::Keyword(_)))),
    );

    // ── String <-> symbol/keyword interop ────────────────────────
    interp.register_fn(
        "symbol->string",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Symbol(s) => Ok(Value::Str(s.clone())),
            other => Err(EvalError::type_mismatch("symbol", other.type_name(), sp)),
        },
    );
    interp.register_fn(
        "keyword->string",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Keyword(s) => Ok(Value::Str(s.clone())),
            other => Err(EvalError::type_mismatch("keyword", other.type_name(), sp)),
        },
    );
    interp.register_fn(
        "string->symbol",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Str(s) => Ok(Value::Symbol(s.clone())),
            other => Err(EvalError::type_mismatch("string", other.type_name(), sp)),
        },
    );
    interp.register_fn(
        "string->keyword",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Str(s) => Ok(Value::Keyword(s.clone())),
            other => Err(EvalError::type_mismatch("string", other.type_name(), sp)),
        },
    );

    // ── IO (embedder may substitute) ─────────────────────────────
    interp.register_fn(
        "display",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, _sp| {
            print!("{}", args[0]);
            Ok(Value::Nil)
        },
    );
    interp.register_fn(
        "newline",
        Arity::Exact(0),
        |_args: &[Value], _h: &mut H, _sp| {
            println!();
            Ok(Value::Nil)
        },
    );
    interp.register_fn(
        "print",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, _sp| {
            println!("{}", args[0]);
            Ok(Value::Nil)
        },
    );

    // (println v) — print + newline. Convenient for scripts.
    interp.register_fn("println", Arity::Any, |args: &[Value], _h: &mut H, _sp| {
        for (i, a) in args.iter().enumerate() {
            if i > 0 {
                print!(" ");
            }
            print!("{a}");
        }
        println!();
        Ok(Value::Nil)
    });

    // (pr-str v) — like (string v) but strings retain their quotes
    // (useful for debugging — you can paste the result back).
    interp.register_fn(
        "pr-str",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, _sp| Ok(Value::Str(Arc::from(format!("{}", args[0])))),
    );

    // (read-string source) — parse Lisp source from a string into a
    // Value (the first form). Errors if source is empty or has parse
    // problems. Pair with (eval ...) for runtime metaprogramming.
    interp.register_fn(
        "read-string",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Str(s) => {
                let forms = tatara_lisp::read_spanned(s)?;
                if forms.is_empty() {
                    return Err(EvalError::native_fn(
                        Arc::<str>::from("read-string"),
                        "empty source",
                        sp,
                    ));
                }
                Ok(crate::code::spanned_to_value(&forms[0]))
            }
            other => Err(EvalError::type_mismatch("string", other.type_name(), sp)),
        },
    );

    // (read-all source) — parse ALL top-level forms; returns a list.
    interp.register_fn(
        "read-all",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Str(s) => {
                let forms = tatara_lisp::read_spanned(s)?;
                let values: Vec<Value> = forms.iter().map(crate::code::spanned_to_value).collect();
                Ok(Value::list(values))
            }
            other => Err(EvalError::type_mismatch("string", other.type_name(), sp)),
        },
    );

    // (compare a b) — three-way comparison: -1 / 0 / 1. Defined for
    // numbers and strings; symbols and keywords compare lexically by
    // their name.
    interp.register_fn(
        "compare",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| {
            Ok(Value::Int(cmp_to_int(compare_values(
                &args[0], &args[1], sp,
            )?)))
        },
    );

    // ── Bit ops ───────────────────────────────────────────────────
    interp.register_fn(
        "bit-and",
        Arity::AtLeast(0),
        |args: &[Value], _h: &mut H, sp| {
            let mut acc: i64 = -1; // all-ones for AND identity
            for a in args {
                acc &= expect_int(a, sp)?;
            }
            Ok(Value::Int(acc))
        },
    );
    interp.register_fn(
        "bit-or",
        Arity::AtLeast(0),
        |args: &[Value], _h: &mut H, sp| {
            let mut acc: i64 = 0;
            for a in args {
                acc |= expect_int(a, sp)?;
            }
            Ok(Value::Int(acc))
        },
    );
    interp.register_fn(
        "bit-xor",
        Arity::AtLeast(0),
        |args: &[Value], _h: &mut H, sp| {
            let mut acc: i64 = 0;
            for a in args {
                acc ^= expect_int(a, sp)?;
            }
            Ok(Value::Int(acc))
        },
    );
    interp.register_fn(
        "bit-not",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| Ok(Value::Int(!expect_int(&args[0], sp)?)),
    );
    interp.register_fn(
        "bit-shift-left",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| {
            let n = expect_int(&args[0], sp)?;
            let shift = expect_int(&args[1], sp)? as u32;
            Ok(Value::Int(n.wrapping_shl(shift)))
        },
    );
    interp.register_fn(
        "bit-shift-right",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| {
            let n = expect_int(&args[0], sp)?;
            let shift = expect_int(&args[1], sp)? as u32;
            Ok(Value::Int(n.wrapping_shr(shift)))
        },
    );

    // ── gensym ────────────────────────────────────────────────────
    // Process-global counter — guaranteed unique across all
    // Interpreters in the same process. `(gensym)` returns "g42";
    // `(gensym "tag")` returns "tag42".
    interp.register_fn(
        "gensym",
        Arity::Range(0, 1),
        |args: &[Value], _h: &mut H, sp| {
            use std::sync::atomic::{AtomicU64, Ordering};
            static COUNTER: AtomicU64 = AtomicU64::new(0);
            let n = COUNTER.fetch_add(1, Ordering::Relaxed);
            let prefix: String = match args.first() {
                None => "g".to_string(),
                Some(Value::Str(s)) => s.to_string(),
                Some(Value::Symbol(s)) => s.to_string(),
                Some(other) => {
                    return Err(EvalError::type_mismatch(
                        "string or symbol",
                        other.type_name(),
                        sp,
                    ))
                }
            };
            Ok(Value::Symbol(Arc::from(format!("{prefix}__{n}__auto"))))
        },
    );

    // ── Structured errors ─────────────────────────────────────────
    // Clojure-style ex-info: tag + message + data plist.
    use crate::value::ErrorObj;

    // (error tag message [data]) — tag is keyword/string, message is
    // string, data is an optional plist (alternating key value list).
    interp.register_fn(
        "error",
        Arity::Range(2, 3),
        |args: &[Value], _h: &mut H, sp| {
            let tag: Arc<str> = match &args[0] {
                Value::Keyword(s) | Value::Symbol(s) | Value::Str(s) => s.clone(),
                other => {
                    return Err(EvalError::type_mismatch(
                        "keyword/symbol/string",
                        other.type_name(),
                        sp,
                    ))
                }
            };
            let message: Arc<str> = match &args[1] {
                Value::Str(s) => s.clone(),
                other => return Err(EvalError::type_mismatch("string", other.type_name(), sp)),
            };
            let data = if args.len() == 3 {
                plist_to_pairs(&args[2], sp)?
            } else {
                Vec::new()
            };
            Ok(Value::Error(Arc::new(ErrorObj { tag, message, data })))
        },
    );

    // (ex-info message data) — convenience: tag = "ex-info".
    interp.register_fn(
        "ex-info",
        Arity::Range(1, 2),
        |args: &[Value], _h: &mut H, sp| {
            let message: Arc<str> = match &args[0] {
                Value::Str(s) => s.clone(),
                other => return Err(EvalError::type_mismatch("string", other.type_name(), sp)),
            };
            let data = if args.len() == 2 {
                plist_to_pairs(&args[1], sp)?
            } else {
                Vec::new()
            };
            Ok(Value::Error(Arc::new(ErrorObj {
                tag: Arc::from("ex-info"),
                message,
                data,
            })))
        },
    );

    // (throw err) — raise as EvalError::User. If err isn't an Error
    // value, wrap it with tag "user".
    interp.register_fn(
        "throw",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| {
            let value = args[0].clone();
            Err(EvalError::User { value, at: sp })
        },
    );

    // Predicate.
    interp.register_fn(
        "error?",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, _sp| Ok(Value::Bool(matches!(&args[0], Value::Error(_)))),
    );

    // Accessors.
    interp.register_fn(
        "error-tag",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Error(e) => Ok(Value::Keyword(e.tag.clone())),
            other => Err(EvalError::type_mismatch("error", other.type_name(), sp)),
        },
    );

    interp.register_fn(
        "error-message",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Error(e) => Ok(Value::Str(e.message.clone())),
            other => Err(EvalError::type_mismatch("error", other.type_name(), sp)),
        },
    );

    // (error-data err) → plist (k1 v1 k2 v2 ...).
    interp.register_fn(
        "error-data",
        Arity::Exact(1),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Error(e) => {
                let mut out = Vec::with_capacity(e.data.len() * 2);
                for (k, v) in &e.data {
                    out.push(k.clone());
                    out.push(v.clone());
                }
                Ok(Value::list(out))
            }
            other => Err(EvalError::type_mismatch("error", other.type_name(), sp)),
        },
    );

    // (error-data-get err key) → value or nil.
    interp.register_fn(
        "error-data-get",
        Arity::Exact(2),
        |args: &[Value], _h: &mut H, sp| match &args[0] {
            Value::Error(e) => {
                for (k, v) in &e.data {
                    if value_eq_deep(k, &args[1]) {
                        return Ok(v.clone());
                    }
                }
                Ok(Value::Nil)
            }
            other => Err(EvalError::type_mismatch("error", other.type_name(), sp)),
        },
    );
}

/// Parse a plist Value (alternating k/v list) into a `Vec<(Value, Value)>`.
fn plist_to_pairs(v: &Value, sp: Span) -> Result<Vec<(Value, Value)>> {
    let xs = match v {
        Value::Nil => return Ok(Vec::new()),
        Value::List(xs) => xs,
        other => {
            return Err(EvalError::type_mismatch(
                "plist (list)",
                other.type_name(),
                sp,
            ))
        }
    };
    if xs.len() % 2 != 0 {
        return Err(EvalError::native_fn(
            Arc::<str>::from("plist"),
            "plist must have even number of elements (k v k v ...)",
            sp,
        ));
    }
    let mut out = Vec::with_capacity(xs.len() / 2);
    let mut i = 0;
    while i < xs.len() {
        out.push((xs[i].clone(), xs[i + 1].clone()));
        i += 2;
    }
    Ok(out)
}

/// `|n|`, refused for `i64::MIN`, whose magnitude does not fit.
fn abs_int(n: i64, op: &'static str, at: Span) -> Result<i64> {
    n.checked_abs().ok_or(EvalError::IntegerOverflow { op, at })
}

/// A float already rounded to an integral value, as an `Int` — or refused when
/// it is not finite or does not fit. `as i64` saturated instead, so
/// `(floor 1e300)` answered `9223372036854775807` and `(round nan)` answered 0.
fn float_to_int(f: f64, op: &'static str, at: Span) -> Result<Value> {
    // 2^63 is exactly representable; every finite float below it and at or
    // above -2^63 converts exactly (the argument is already integral).
    const LIMIT: f64 = 9_223_372_036_854_775_808.0;
    if f.is_finite() && (-LIMIT..LIMIT).contains(&f) {
        #[allow(clippy::cast_possible_truncation)]
        Ok(Value::Int(f as i64))
    } else {
        Err(EvalError::IntegerOverflow { op, at })
    }
}

fn gcd(a: i64, b: i64) -> i64 {
    if b == 0 {
        a
    } else {
        gcd(b, a % b)
    }
}

/// The ordering `compare` answers with, as a Rust `Ordering`: numbers by
/// value (an int and a float compare as floats), strings, symbols and
/// keywords by their text. Anything else, or two values of different kinds,
/// is a type error. Public so a sort orders by exactly the rules `compare`
/// states (`hof::sort_keyed_values`).
pub fn compare_values(a: &Value, b: &Value, sp: Span) -> Result<std::cmp::Ordering> {
    match (a, b) {
        (Value::Int(a), Value::Int(b)) => Ok(a.cmp(b)),
        (Value::Float(a), Value::Float(b)) => {
            Ok(a.partial_cmp(b).unwrap_or(std::cmp::Ordering::Equal))
        }
        (Value::Int(a), Value::Float(b)) => Ok((*a as f64)
            .partial_cmp(b)
            .unwrap_or(std::cmp::Ordering::Equal)),
        (Value::Float(a), Value::Int(b)) => Ok(a
            .partial_cmp(&(*b as f64))
            .unwrap_or(std::cmp::Ordering::Equal)),
        (Value::Str(a), Value::Str(b)) => Ok(a.as_ref().cmp(b.as_ref())),
        (Value::Symbol(a), Value::Symbol(b)) => Ok(a.as_ref().cmp(b.as_ref())),
        (Value::Keyword(a), Value::Keyword(b)) => Ok(a.as_ref().cmp(b.as_ref())),
        (a, b) => Err(EvalError::type_mismatch(
            "comparable values of the same kind",
            std::boxed::Box::leak(
                format!("{} vs {}", a.type_name(), b.type_name()).into_boxed_str(),
            ),
            sp,
        )),
    }
}

fn cmp_to_int(o: std::cmp::Ordering) -> i64 {
    match o {
        std::cmp::Ordering::Less => -1,
        std::cmp::Ordering::Equal => 0,
        std::cmp::Ordering::Greater => 1,
    }
}

/// Borrow a list-shaped Value. `Nil` is the empty list, answered as `None`.
/// Used by primitives that don't care about ownership.
fn list_view(v: &Value, sp: Span) -> Result<Option<&List>> {
    match v {
        Value::Nil => Ok(None),
        Value::List(xs) => Ok(Some(xs)),
        other => Err(EvalError::type_mismatch("list", other.type_name(), sp)),
    }
}

// ── Helpers ───────────────────────────────────────────────────────

fn expect_int(v: &Value, sp: Span) -> Result<i64> {
    match v {
        Value::Int(n) => Ok(*n),
        other => Err(EvalError::type_mismatch("integer", other.type_name(), sp)),
    }
}

fn as_number_either(v: &Value, sp: Span) -> Result<NumVal> {
    match v {
        Value::Int(n) => Ok(NumVal::I(*n)),
        Value::Float(n) => Ok(NumVal::F(*n)),
        other => Err(EvalError::type_mismatch("number", other.type_name(), sp)),
    }
}

#[derive(Clone, Copy)]
enum NumVal {
    I(i64),
    F(f64),
}

impl NumVal {
    fn to_float(self) -> f64 {
        match self {
            Self::I(n) => n as f64,
            Self::F(n) => n,
        }
    }
}

fn reduce_numeric(
    args: &[Value],
    sp: Span,
    op: &'static str,
    int_init: i64,
    float_init: f64,
    fi: impl Fn(i64, i64) -> Option<i64>,
    ff: impl Fn(f64, f64) -> f64,
) -> Result<Value> {
    // All-int fast path. Promote to float on first Float encountered.
    let mut saw_float = false;
    let mut acc_i = int_init;
    let mut acc_f = float_init;
    for a in args {
        match as_number_either(a, sp)? {
            NumVal::I(n) => {
                if saw_float {
                    acc_f = ff(acc_f, n as f64);
                } else {
                    acc_i = fi(acc_i, n).ok_or(EvalError::IntegerOverflow { op, at: sp })?;
                }
            }
            NumVal::F(n) => {
                if !saw_float {
                    acc_f = ff(acc_i as f64, n);
                    saw_float = true;
                } else {
                    acc_f = ff(acc_f, n);
                }
            }
        }
    }
    if saw_float {
        Ok(Value::Float(acc_f))
    } else {
        Ok(Value::Int(acc_i))
    }
}

fn prim_sub<H: 'static>(args: &[Value], _h: &mut H, sp: Span) -> Result<Value> {
    if args.len() == 1 {
        return match as_number_either(&args[0], sp)? {
            NumVal::I(n) => n
                .checked_neg()
                .map(Value::Int)
                .ok_or(EvalError::IntegerOverflow { op: "-", at: sp }),
            NumVal::F(n) => Ok(Value::Float(-n)),
        };
    }
    let first = as_number_either(&args[0], sp)?;
    let mut saw_float = matches!(first, NumVal::F(_));
    let mut acc_i: i64 = if let NumVal::I(n) = first { n } else { 0 };
    let mut acc_f: f64 = first.to_float();
    for a in &args[1..] {
        match as_number_either(a, sp)? {
            NumVal::I(n) => {
                if saw_float {
                    acc_f -= n as f64;
                } else {
                    acc_i = acc_i
                        .checked_sub(n)
                        .ok_or(EvalError::IntegerOverflow { op: "-", at: sp })?;
                }
            }
            NumVal::F(n) => {
                if !saw_float {
                    acc_f = (acc_i as f64) - n;
                    saw_float = true;
                } else {
                    acc_f -= n;
                }
            }
        }
    }
    Ok(if saw_float {
        Value::Float(acc_f)
    } else {
        Value::Int(acc_i)
    })
}

fn prim_div<H: 'static>(args: &[Value], _h: &mut H, sp: Span) -> Result<Value> {
    if args.len() == 1 {
        return match as_number_either(&args[0], sp)? {
            NumVal::I(n) => {
                if n == 0 {
                    Err(EvalError::DivisionByZero { at: sp })
                } else {
                    Ok(Value::Float(1.0 / (n as f64)))
                }
            }
            NumVal::F(n) => {
                if n == 0.0 {
                    Err(EvalError::DivisionByZero { at: sp })
                } else {
                    Ok(Value::Float(1.0 / n))
                }
            }
        };
    }
    let first = as_number_either(&args[0], sp)?;
    let mut saw_float = matches!(first, NumVal::F(_));
    let mut acc_i: i64 = if let NumVal::I(n) = first { n } else { 0 };
    let mut acc_f: f64 = first.to_float();
    for a in &args[1..] {
        let b = as_number_either(a, sp)?;
        let zero = matches!(b, NumVal::I(0)) || matches!(b, NumVal::F(n) if n == 0.0);
        if zero {
            return Err(EvalError::DivisionByZero { at: sp });
        }
        match b {
            NumVal::I(n) => {
                if saw_float {
                    acc_f /= n as f64;
                } else if acc_i.checked_rem(n) == Some(0) {
                    acc_i = acc_i
                        .checked_div(n)
                        .ok_or(EvalError::IntegerOverflow { op: "/", at: sp })?;
                } else if acc_i.checked_rem(n).is_none() {
                    // i64::MIN / -1: the one quotient that does not fit.
                    return Err(EvalError::IntegerOverflow { op: "/", at: sp });
                } else {
                    acc_f = acc_i as f64 / n as f64;
                    saw_float = true;
                }
            }
            NumVal::F(n) => {
                if !saw_float {
                    acc_f = acc_i as f64 / n;
                    saw_float = true;
                } else {
                    acc_f /= n;
                }
            }
        }
    }
    Ok(if saw_float {
        Value::Float(acc_f)
    } else {
        Value::Int(acc_i)
    })
}

fn cmp_chain(
    args: &[Value],
    sp: Span,
    cmp_i: impl Fn(i64, i64) -> bool,
    cmp_f: impl Fn(f64, f64) -> bool,
) -> Result<Value> {
    for w in args.windows(2) {
        let ok = match (as_number_either(&w[0], sp)?, as_number_either(&w[1], sp)?) {
            (NumVal::I(a), NumVal::I(b)) => cmp_i(a, b),
            (a, b) => cmp_f(a.to_float(), b.to_float()),
        };
        if !ok {
            return Ok(Value::Bool(false));
        }
    }
    Ok(Value::Bool(true))
}

fn prim_car<H: 'static>(args: &[Value], _h: &mut H, sp: Span) -> Result<Value> {
    match &args[0] {
        Value::List(xs) if !xs.is_empty() => Ok(xs[0].clone()),
        Value::Nil | Value::List(_) => Err(EvalError::native_fn(
            Arc::<str>::from("car"),
            "car of empty list",
            sp,
        )),
        other => Err(EvalError::type_mismatch("pair", other.type_name(), sp)),
    }
}

fn prim_cdr<H: 'static>(args: &[Value], _h: &mut H, sp: Span) -> Result<Value> {
    match &args[0] {
        Value::List(xs) if !xs.is_empty() => {
            if xs.len() == 1 {
                Ok(Value::Nil)
            } else {
                Ok(Value::List(Arc::new(xs.skip(1))))
            }
        }
        Value::Nil | Value::List(_) => Err(EvalError::native_fn(
            Arc::<str>::from("cdr"),
            "cdr of empty list",
            sp,
        )),
        other => Err(EvalError::type_mismatch("pair", other.type_name(), sp)),
    }
}

// `cons` and `append` take their arguments BY VALUE (`register_owned_fn`), so
// a list the caller holds alone is extended in its own allocation:
// `Arc::make_mut` updates in place when the count is 1 and copies once
// otherwise, which is the same decision `map::map_cow` makes for maps.

fn prim_cons<H: 'static>(args: Vec<Value>, _h: &mut H, sp: Span) -> Result<Value> {
    let [head, tail] = owned_args::<2>("cons", args, sp)?;
    // The tail is shared, not copied: `push_front` on the persistent list
    // touches O(1) nodes, where the old `Vec` rebuild copied every element.
    Ok(match tail {
        Value::Nil => Value::List(Arc::new(List::from(vec![head]))),
        Value::List(mut xs) => {
            Arc::make_mut(&mut xs).push_front(head);
            Value::List(xs)
        }
        other => Value::List(Arc::new(List::from(vec![head, other]))),
    })
}

fn prim_append<H: 'static>(args: Vec<Value>, _h: &mut H, sp: Span) -> Result<Value> {
    // Every operand is checked before the first is touched, so a bad one
    // further along cannot leave the accumulator half-extended.
    let mut lists = Vec::with_capacity(args.len());
    for a in args {
        match a {
            Value::Nil => {}
            Value::List(xs) => lists.push(xs),
            other => return Err(EvalError::type_mismatch("list", other.type_name(), sp)),
        }
    }
    let mut lists = lists.into_iter();
    let Some(mut out) = lists.next() else {
        return Ok(Value::Nil);
    };
    // Concatenation of persistent lists: each operand's structure is shared,
    // so `(append acc (list x))` costs O(log n) rather than a copy of `acc`,
    // and nothing at all beyond the new element when `acc` is held once.
    let acc = Arc::make_mut(&mut out);
    for xs in lists {
        acc.append(Arc::try_unwrap(xs).unwrap_or_else(|shared| List::clone(&shared)));
    }
    if out.is_empty() {
        Ok(Value::Nil)
    } else {
        Ok(Value::List(out))
    }
}

fn value_eq_shallow(a: &Value, b: &Value) -> bool {
    match (a, b) {
        (Value::Nil, Value::Nil) => true,
        (Value::Bool(a), Value::Bool(b)) => a == b,
        (Value::Int(a), Value::Int(b)) => a == b,
        (Value::Float(a), Value::Float(b)) => a == b,
        (Value::Str(a), Value::Str(b)) => Arc::ptr_eq(a, b) || a == b,
        (Value::Symbol(a), Value::Symbol(b)) => a == b,
        (Value::Keyword(a), Value::Keyword(b)) => a == b,
        (Value::List(a), Value::List(b)) => Arc::ptr_eq(a, b) || a.ptr_eq(b),
        (Value::NativeFn(a), Value::NativeFn(b)) => a.name == b.name,
        (Value::Closure(a), Value::Closure(b)) => Arc::ptr_eq(a, b),
        _ => false,
    }
}

fn value_eq_deep(a: &Value, b: &Value) -> bool {
    match (a, b) {
        (Value::List(a), Value::List(b)) => {
            if a.len() != b.len() {
                return false;
            }
            a.iter().zip(b.iter()).all(|(x, y)| value_eq_deep(x, y))
        }
        (Value::Sexp(a, _), Value::Sexp(b, _)) => sexp_eq(a, b),
        _ => value_eq_shallow(a, b),
    }
}

fn sexp_eq(a: &Sexp, b: &Sexp) -> bool {
    a == b
}

#[cfg(test)]
mod tests {
    use super::*;

    #[test]
    fn primitive_names_are_unique() {
        let mut seen = std::collections::HashSet::new();
        for n in PRIMITIVE_NAMES {
            assert!(seen.insert(*n), "duplicate primitive: {n}");
        }
    }

    #[test]
    fn names_match_installed() {
        // Every name in PRIMITIVE_NAMES must resolve to a NativeFn after
        // install_primitives.
        struct NoHost;
        let mut i: Interpreter<NoHost> = Interpreter::new();
        install_primitives(&mut i);
        for name in PRIMITIVE_NAMES {
            let v = i
                .lookup_global(name)
                .unwrap_or_else(|| panic!("primitive `{name}` not installed"));
            assert!(
                matches!(v, Value::NativeFn(_)),
                "`{name}` is not a native-fn: {v:?}"
            );
        }
    }
}