narju/parse/

mod.rs

//! S-expression reader and name-resolution lowering to [`Exp`].
//!
//! Source text passes through up to three stages here:
//!
//! 1. **Reading** ([`parse_one`] / [`parse_all`]): text to [`Sexp`]
//!    trees. Comments (`;` to end of line) are dropped; the
//!    quote-family reader macros (`'`, `` ` ``, `,`, `,@`) become
//!    `quote` / `quasiquote` / `unquote` list heads.
//! 2. **Surface desugaring**, applied only at source boundaries:
//!    [`sug`] rewrites the `cadr` family into car/cdr chains
//!    everywhere, including inside quoted data (Pink source is quoted
//!    data); [`expand_qq`] turns quasiquote in *loaded files* into
//!    plain cons/quote source.
//! 3. **Lowering** ([`lower`]): [`Sexp`] to [`Exp`], resolving each
//!    name to an environment index against a compile-time name stack.
//!    Special forms are matched by head symbol and shape here; a list
//!    that matches nothing becomes a (curried) application.
//!
//! Values entered at a REPL prompt follow 1–3; data read by the `read`
//! primitive stops after 1 and is converted directly to a value with
//! [`sexp_to_val`].

use smol_str::SmolStr;

use crate::core::{rc_exp, Exp};

// ── S-expression type ─────────────────────────────────────────────────────────

/// A read s-expression — the concrete syntax tree, before lowering.
///
/// Unlike [`Exp`] and [`crate::core::Val`], lists here are flat
/// `Vec<Sexp>`, which is what the shape-matching in lowering wants.
#[derive(Debug, Clone, PartialEq)]
pub enum Sexp {
    /// Integer atom: a maximal symbol-char run matching `-?[0-9]+`.
    Num(i64),
    /// Symbol atom.
    /// SmolStr: inline storage for strings ≤22 bytes (all common symbol names).
    Sym(SmolStr),
    /// Parenthesized list.
    List(Vec<Sexp>),
    /// The atom `nil`, classified at read time.
    Nil,
}

// ── Parser ────────────────────────────────────────────────────────────────────
//
// Hand-written explicit-stack parser: paren nesting lives in a heap `Vec`
// of frames, never on the native call stack. The previous chumsky
// combinator recursed one (large, debug-mode) frame cycle per nesting
// level, which overflowed the 2 MiB default test-thread stack once
// lib/pink-forms.naj pushed source depth past ~70 parens.
//
// Grammar (unchanged): atoms are maximal runs of symbol chars, classified
// as Num iff `-?[0-9]+` (else Sym; `nil` → Nil); `'`/`` ` `` → quote /
// quasiquote; `,` and `,@` both → unquote; `;` comments to end of line.

/// Character set for atoms: alphanumerics plus Scheme-ish punctuation.
fn is_sym_char(c: char) -> bool {
    c.is_alphanumeric()
        || matches!(
            c,
            '+' | '-' | '*' | '/' | '?' | '!' | '<' | '>' | '=' | '_' | '#' | '.'
        )
}

/// Classify a completed atom token: `nil`, then number, else symbol.
/// A numeric-looking token that overflows `i64` falls back to symbol.
fn classify_atom(tok: &str) -> Sexp {
    if tok == "nil" {
        return Sexp::Nil;
    }
    let digits = tok.strip_prefix('-').unwrap_or(tok);
    if !digits.is_empty() && digits.bytes().all(|b| b.is_ascii_digit()) {
        if let Ok(n) = tok.parse::<i64>() {
            return Sexp::Num(n);
        }
    }
    Sexp::Sym(SmolStr::new(tok))
}

/// A finished value gets wrapped in any pending quote-family prefixes
/// (innermost = most recently seen, so pop order is correct), then lands
/// in the enclosing list frame or the top-level output.
fn finish(
    mut v: Sexp,
    pending: &mut Vec<&'static str>,
    stack: &mut Vec<(Vec<Sexp>, Vec<&'static str>)>,
    out: &mut Vec<Sexp>,
) {
    while let Some(tag) = pending.pop() {
        v = Sexp::List(vec![Sexp::Sym(tag.into()), v]);
    }
    match stack.last_mut() {
        Some((items, _)) => items.push(v),
        None => out.push(v),
    }
}

/// Parse top-level forms iteratively. If `stop_after_one`, return as soon
/// as the first complete form closes (trailing input ignored — matching
/// the old `parse_one`, which ran the combinator without `end()`).
fn parse_forms(src: &str, stop_after_one: bool) -> Result<Vec<Sexp>, String> {
    let mut out: Vec<Sexp> = Vec::new();
    // Each frame: (items so far, quote-prefixes that wrap the list on close).
    let mut stack: Vec<(Vec<Sexp>, Vec<&'static str>)> = Vec::new();
    // Quote-family prefixes awaiting the next value at the current point.
    let mut pending: Vec<&'static str> = Vec::new();
    let mut i = 0;
    while i < src.len() {
        let c = src[i..].chars().next().expect("i is on a char boundary");
        if c.is_whitespace() {
            i += c.len_utf8();
            continue;
        }
        match c {
            ';' => {
                i += src[i..].find('\n').map_or(src.len() - i, |n| n + 1);
            }
            '(' => {
                stack.push((Vec::new(), std::mem::take(&mut pending)));
                i += 1;
            }
            ')' => {
                if let Some(tag) = pending.last() {
                    return Err(format!("expected expression after {tag}, found ')'"));
                }
                let (items, wrappers) = stack
                    .pop()
                    .ok_or_else(|| "unexpected ')'".to_string())?;
                pending = wrappers;
                finish(Sexp::List(items), &mut pending, &mut stack, &mut out);
                i += 1;
                if stop_after_one && stack.is_empty() {
                    return Ok(out);
                }
            }
            '\'' => {
                pending.push("quote");
                i += 1;
            }
            '`' => {
                pending.push("quasiquote");
                i += 1;
            }
            ',' => {
                i += 1;
                if src[i..].starts_with('@') {
                    i += 1;
                }
                pending.push("unquote");
            }
            c if is_sym_char(c) => {
                let start = i;
                while let Some(ch) = src[i..].chars().next() {
                    if !is_sym_char(ch) {
                        break;
                    }
                    i += ch.len_utf8();
                }
                finish(classify_atom(&src[start..i]), &mut pending, &mut stack, &mut out);
                if stop_after_one && stack.is_empty() {
                    return Ok(out);
                }
            }
            other => return Err(format!("unexpected character '{other}'")),
        }
    }
    if !stack.is_empty() {
        return Err(format!(
            "unexpected end of input: {} unclosed '('",
            stack.len()
        ));
    }
    if let Some(tag) = pending.last() {
        return Err(format!("unexpected end of input after {tag}"));
    }
    Ok(out)
}

// ── Surface desugaring ────────────────────────────────────────────────────────

/// pink.scm's `sug` pre-pass (pink.scm:11): desugar `cadr`/`caddr`/`cadddr`
/// into car/cdr chains over the whole surface tree — **including quoted
/// data**, since Pink source is itself a quoted list. Oracle under Chez:
/// `(sug '(quote (cadr x)))` => `(quote (car (cdr x)))`.
///
/// Applied exactly once, at the surface-source boundary
/// (`TopLevel::eval_exp`) — not inside `lower`'s recursion, and not on the
/// `read` primitive's runtime data (the reference sugs source only).
///
/// ```rust
/// use narju::parse::{parse_one, sug};
///
/// let form = parse_one("(cadr xs)").unwrap();
/// assert_eq!(sug(&form), parse_one("(car (cdr xs))").unwrap());
/// ```
pub fn sug(sexp: &Sexp) -> Sexp {
    if let Sexp::List(items) = sexp {
        if let [Sexp::Sym(op), arg] = items.as_slice() {
            let cdrs = match op.as_str() {
                "cadr" => Some(1),
                "caddr" => Some(2),
                "cadddr" => Some(3),
                _ => None,
            };
            if let Some(cdrs) = cdrs {
                let mut acc = sug(arg);
                for _ in 0..cdrs {
                    acc = Sexp::List(vec![Sexp::Sym("cdr".into()), acc]);
                }
                return Sexp::List(vec![Sexp::Sym("car".into()), acc]);
            }
        }
        return Sexp::List(items.iter().map(sug).collect());
    }
    sexp.clone()
}

// ── Name resolution: Sexp -> Exp ─────────────────────────────────────────────

/// Lower a read s-expression to an [`Exp`], resolving names against
/// `names` — the compile-time stack of binders in scope, which mirrors
/// the runtime environment slot-for-slot. Innermost binding wins
/// (`rposition`), so shadowing works; an unresolved name is an error at
/// lowering time, not runtime.
///
/// `names` is borrowed mutably because binders push onto it during
/// their body's lowering; it is restored before returning. Callers
/// evaluating closed top-level forms pass a fresh `Vec`.
pub fn lower(sexp: &Sexp, names: &mut Vec<SmolStr>) -> Result<Exp, String> {
    match sexp {
        Sexp::Num(n) => Ok(Exp::Lit(*n)),
        Sexp::Nil => Ok(Exp::Nil),

        Sexp::Sym(s) => {
            if s == "#t" { return Ok(Exp::Lit(1)); }
            if s == "#f" { return Ok(Exp::Lit(0)); }
            names
                .iter()
                .rposition(|n| n == s)
                .map(Exp::Var)
                .ok_or_else(|| format!("unbound variable: {s}"))
        }

        Sexp::List(items) => lower_list(items, names).map_err(|e| {
            if e.starts_with("unbound") {
                let head = items.first().map(|s| format!("{s:?}")).unwrap_or_default();
                format!("{e} [in list starting with {head}]")
            } else {
                e
            }
        }),
    }
}

/// Lower a list form: special forms first (matched by head symbol and
/// arity), then binary application, then the n-ary case, which curries
/// left-to-right — `(f a b)` is `((f a) b)`.
///
/// A special-form head with the wrong arity falls through to the
/// application arms, matching pink.scm's behavior — e.g. `(car)` is an
/// application of the variable `car`, and errors as unbound. `let` is
/// the one exception with an explicit arity error, since a malformed
/// `let` otherwise fails with a confusing unbound-variable message.
fn lower_list(items: &[Sexp], names: &mut Vec<SmolStr>) -> Result<Exp, String> {
    match items {
        [] => Err("empty list expression".into()),

        [Sexp::Sym(q), rest @ ..] if q == "quote" => {
            if rest.len() != 1 {
                return Err("quote takes exactly one argument".into());
            }
            lower_quote(&rest[0])
        }

        [Sexp::Sym(q), rest @ ..] if q == "quasiquote" => {
            if rest.len() != 1 {
                return Err("quasiquote takes exactly one argument".into());
            }
            lower_quasiquote(&rest[0], names)
        }

        [Sexp::Sym(kw), Sexp::Sym(f), Sexp::Sym(x), body] if kw == "lambda" => {
            let base = names.len();
            names.push(f.clone());
            names.push(x.clone());
            // Truncate before `?`: an error mid-body must not leave the
            // binders on the caller's name stack.
            let body_exp = lower(body, names);
            names.truncate(base);
            Ok(Exp::Lam(rc_exp(body_exp?)))
        }

        [Sexp::Sym(kw), Sexp::Sym(x), e, body] if kw == "let" => {
            let e_exp = lower(e, names)?;
            let base = names.len();
            names.push(x.clone());
            let body_exp = lower(body, names);
            names.truncate(base);
            Ok(Exp::Let(rc_exp(e_exp), rc_exp(body_exp?)))
        }

        [Sexp::Sym(kw), rest @ ..] if kw == "let" => Err(format!(
            "let requires (let name init body), got {} args after let",
            rest.len()
        )),

        [Sexp::Sym(kw), c, t, e] if kw == "if" => Ok(Exp::If(
            rc_exp(lower(c, names)?),
            rc_exp(lower(t, names)?),
            rc_exp(lower(e, names)?),
        )),

        [Sexp::Sym(op), a] if op == "number?" => Ok(Exp::IsNum(rc_exp(lower(a, names)?))),
        [Sexp::Sym(op), a] if op == "symbol?" => Ok(Exp::IsSym(rc_exp(lower(a, names)?))),
        [Sexp::Sym(op), a] if op == "null?" => {
            Ok(Exp::IsNil(rc_exp(lower(a, names)?)))
        }
        [Sexp::Sym(op), a] if op == "pair?" => Ok(Exp::IsPair(rc_exp(lower(a, names)?))),
        [Sexp::Sym(op), a, b] if op == "code?" => Ok(Exp::IsCode(
            rc_exp(lower(a, names)?),
            rc_exp(lower(b, names)?),
        )),
        [Sexp::Sym(op), a] if op == "car" => Ok(Exp::Car(rc_exp(lower(a, names)?))),
        [Sexp::Sym(op), a] if op == "cdr" => Ok(Exp::Cdr(rc_exp(lower(a, names)?))),

        [Sexp::Sym(op), a, b] if op == "cons" => Ok(Exp::Cons(
            rc_exp(lower(a, names)?),
            rc_exp(lower(b, names)?),
        )),
        [Sexp::Sym(op), a, b] if op == "+" => Ok(Exp::Plus(
            rc_exp(lower(a, names)?),
            rc_exp(lower(b, names)?),
        )),
        [Sexp::Sym(op), a, b] if op == "-" => Ok(Exp::Minus(
            rc_exp(lower(a, names)?),
            rc_exp(lower(b, names)?),
        )),
        [Sexp::Sym(op), a, b] if op == "*" => Ok(Exp::Times(
            rc_exp(lower(a, names)?),
            rc_exp(lower(b, names)?),
        )),
        [Sexp::Sym(op), a, b] if op == "eq?" => Ok(Exp::Eq(
            rc_exp(lower(a, names)?),
            rc_exp(lower(b, names)?),
        )),

        [Sexp::Sym(kw), e] if kw == "lift" => Ok(Exp::Lift(rc_exp(lower(e, names)?))),
        [Sexp::Sym(kw), b, e] if kw == "run" => Ok(Exp::Run(
            rc_exp(lower(b, names)?),
            rc_exp(lower(e, names)?),
        )),
        [Sexp::Sym(kw), e1, e2] if kw == "lift-ref" => Ok(Exp::LiftRef(
            rc_exp(lower(e1, names)?),
            rc_exp(lower(e2, names)?),
        )),
        [Sexp::Sym(kw), b, v] if kw == "log" => Ok(Exp::Log(
            rc_exp(lower(b, names)?),
            rc_exp(lower(v, names)?),
        )),
        // catch is the single restricted floor primitive for error handling.
        // It is written for the boot script (lib/purple.naj) — not intended
        // for user code. It IS parseable here so the boot script can be
        // loaded, but user programs should use the REPL's error handling via
        // define/try at the Pink level rather than calling catch directly.
        [Sexp::Sym(kw), e] if kw == "catch" => Ok(Exp::Catch(rc_exp(lower(e, names)?))),
        [Sexp::Sym(kw), e] if kw == "throw" => Ok(Exp::Throw(rc_exp(lower(e, names)?))),
        [Sexp::Sym(kw), v] if kw == "cell-new" => {
            Ok(Exp::CellNew(rc_exp(lower(v, names)?)))
        }
        [Sexp::Sym(kw), c] if kw == "cell-read" => {
            Ok(Exp::CellRead(rc_exp(lower(c, names)?)))
        }
        [Sexp::Sym(kw), c, v] if kw == "cell-set!" => Ok(Exp::CellSet(
            rc_exp(lower(c, names)?),
            rc_exp(lower(v, names)?),
        )),
        [Sexp::Sym(kw), p] if kw == "read" => Ok(Exp::Read(rc_exp(lower(p, names)?))),
        [Sexp::Sym(kw), p] if kw == "read-file" => {
            Ok(Exp::ReadFile(rc_exp(lower(p, names)?)))
        }
        [Sexp::Sym(kw), e] if kw == "print" => Ok(Exp::Print(rc_exp(lower(e, names)?))),
        [Sexp::Sym(kw), el, ex] if kw == "evalms" => Ok(Exp::Evalms(
            rc_exp(lower(el, names)?),
            rc_exp(lower(ex, names)?),
        )),
        [Sexp::Sym(kw), e, env_list] if kw == "trans" => Ok(Exp::Trans(
            rc_exp(lower(e, names)?),
            rc_exp(lower(env_list, names)?),
        )),

        [f, arg] => Ok(Exp::App(
            rc_exp(lower(f, names)?),
            rc_exp(lower(arg, names)?),
        )),

        [f, args @ ..] => {
            let mut acc = lower(f, names)?;
            for arg in args {
                acc = Exp::App(rc_exp(acc), rc_exp(lower(arg, names)?));
            }
            Ok(acc)
        }
    }
}

// ── Quasiquote expansion ──────────────────────────────────────────────────────

/// Lower a quasiquoted datum: atoms become literals, `(unquote e)`
/// splices `e` as a host expression, lists become cons-chains.
fn lower_quasiquote(sexp: &Sexp, names: &mut Vec<SmolStr>) -> Result<Exp, String> {
    match sexp {
        Sexp::Num(n) => Ok(Exp::Lit(*n)),
        Sexp::Nil => Ok(Exp::Nil),
        Sexp::Sym(s) => Ok(Exp::Sym(s.clone())),

        Sexp::List(items) => {
            if let [Sexp::Sym(tag), inner] = items.as_slice() {
                if tag == "unquote" {
                    return lower(inner, names);
                }
            }
            lower_qq_list(items, names)
        }
    }
}

/// Build the cons-chain for a quasiquoted list by folding right-to-left.
///
/// Iterative on the list axis so deep quasiquoted lists (e.g. the spliced
/// `pink-tie-src` in `lib/purple.naj`) can't overflow the native stack.
/// Per-item dispatch into `lower` / `lower_quasiquote` is still recursive
/// on Sexp *tree* depth, but real inputs are wide-and-shallow there so
/// that recursion is not at risk in practice.
fn lower_qq_list(items: &[Sexp], names: &mut Vec<SmolStr>) -> Result<Exp, String> {
    let mut acc = Exp::Nil;
    for item in items.iter().rev() {
        // An `,unquote` head splices its argument as a host expression.
        // Anything else recurses as a quasiquoted datum.
        let head_exp = match item {
            Sexp::List(inner) => match inner.as_slice() {
                [Sexp::Sym(tag), splice_expr] if tag == "unquote" => {
                    lower(splice_expr, names)?
                }
                _ => lower_quasiquote(item, names)?,
            },
            _ => lower_quasiquote(item, names)?,
        };
        acc = Exp::Cons(rc_exp(head_exp), rc_exp(acc));
    }
    Ok(acc)
}

// ── Read-time quasiquote expansion (read-file only) ──────────────────────────

/// Expand quasiquote in loaded `.naj` source into plain cons/quote *source*.
///
/// Like `sug`, this is a read-time source transform, applied by the
/// `read-file` primitive only — the `read` primitive stays un-transformed.
/// The reference gets quasiquote from Scheme (mk.scm is a Scheme-level
/// template over Pink source); narju's floor is the Scheme analogue, so
/// loaded libraries get the same affordance without touching pink-poly.
///
/// `(quote x)` is opaque outside quasiquote. Inside a template, a quoted
/// form is ordinary list data — `'b` in a template builds the datum
/// `(quote b)`, matching Scheme, where unquotes under it still splice.
pub fn expand_qq(sexp: &Sexp) -> Result<Sexp, String> {
    match sexp {
        Sexp::List(items) => {
            if let [Sexp::Sym(tag), inner] = items.as_slice() {
                match tag.as_str() {
                    "quote" => return Ok(sexp.clone()),
                    "quasiquote" => return qq_datum(inner),
                    _ => {}
                }
            }
            let expanded = items.iter().map(expand_qq).collect::<Result<Vec<_>, _>>()?;
            Ok(Sexp::List(expanded))
        }
        _ => Ok(sexp.clone()),
    }
}

/// Turn a quasiquoted datum into source that reconstructs it: atoms become
/// `(quote atom)`, `(unquote e)` splices `e` (itself qq-expanded), lists
/// become right-folded `(cons …)` chains ending in `(quote ())`.
fn qq_datum(sexp: &Sexp) -> Result<Sexp, String> {
    match sexp {
        Sexp::Num(_) => Ok(sexp.clone()),
        Sexp::Sym(_) | Sexp::Nil => Ok(quote_datum(sexp)),
        Sexp::List(items) => {
            if let [Sexp::Sym(tag), inner] = items.as_slice() {
                match tag.as_str() {
                    "unquote" => return expand_qq(inner),
                    "quasiquote" => {
                        return Err("nested quasiquote unsupported in loaded source".into())
                    }
                    _ => {}
                }
            }
            let mut acc = quote_datum(&Sexp::Nil);
            for item in items.iter().rev() {
                let head = qq_datum(item)?;
                acc = Sexp::List(vec![Sexp::Sym("cons".into()), head, acc]);
            }
            Ok(acc)
        }
    }
}

/// Wrap a datum as `(quote datum)` source.
fn quote_datum(sexp: &Sexp) -> Sexp {
    Sexp::List(vec![Sexp::Sym("quote".into()), sexp.clone()])
}

// ── Quoted datum lowering ─────────────────────────────────────────────────────

/// Lower a quoted datum: atoms become literal expressions, lists
/// become cons-chains of quoted elements. No names are resolved —
/// everything under `quote` is data.
fn lower_quote(sexp: &Sexp) -> Result<Exp, String> {
    match sexp {
        Sexp::Sym(s) => Ok(Exp::Sym(s.clone())),
        Sexp::Num(n) => Ok(Exp::Lit(*n)),
        Sexp::Nil => Ok(Exp::Nil),
        Sexp::List(items) => lower_quoted_list(items),
    }
}

/// Build the cons-chain for a quoted list by folding right-to-left.
///
/// Same iteration shape as `lower_qq_list`, minus the unquote dispatch
/// — quoted contexts treat everything as data. Per-item recursion into
/// `lower_quote` is still tree-depth-bounded, which is fine for realistic
/// inputs.
fn lower_quoted_list(items: &[Sexp]) -> Result<Exp, String> {
    let mut acc = Exp::Nil;
    for item in items.iter().rev() {
        let head = lower_quote(item)?;
        acc = Exp::Cons(rc_exp(head), rc_exp(acc));
    }
    Ok(acc)
}

// ── Runtime helpers ───────────────────────────────────────────────────────────

/// Convert a read s-expression directly into a runtime value — lists
/// become `Tup` chains, no lowering, no name resolution. This is how
/// the `read` and `read-file` primitives hand parsed input to the
/// evaluator as data.
pub fn sexp_to_val(sexp: &Sexp) -> crate::core::Val {
    use crate::core::{tup, Val};
    match sexp {
        Sexp::Num(n) => Val::Cst(*n),
        Sexp::Sym(s) => Val::Sym(s.clone()),
        Sexp::Nil => Val::Nil,
        Sexp::List(items) => items.iter().rev().fold(Val::Nil, |acc, item| {
            tup(sexp_to_val(item), acc)
        }),
    }
}

/// Read the first complete form from `src`, ignoring anything after it.
pub fn parse_one(src: &str) -> Result<Sexp, String> {
    let mut forms = parse_forms(src.trim(), true)?;
    forms
        .pop()
        .ok_or_else(|| "unexpected end of input: expected an s-expression".to_string())
}

/// Parse every top-level form in `src`. String-error twin of
/// `repl::parse_all`, callable from the evaluator (`read-file`) without a
/// layering inversion.
pub fn parse_all(src: &str) -> Result<Vec<Sexp>, String> {
    if src.trim().is_empty() {
        return Ok(vec![]);
    }
    parse_forms(src, false)
}