ww/examples/lisp/lispcore.ww

// lispcore — tiny Lisp interpreter module. The public surface that
// lisp.ww (the REPL entry point) and lisp_test.ww (the in-process
// test driver) consume. Pure-stdlib: no @symbol FFI of its own
// (every system call routes through lib/os, lib/fmt, lib/ascii,
// lib/strconv, lib/strings).
//
// What this exercises across the ww language:
//   - tagged-union returns with many variants:
//       (*value | rterror)        from eval
//       (*value | parserr | eof)  from the parser
//   - `match` with `yield` so the REPL dispatch is one expression
//   - `?` to propagate the error variant up the call chain
//   - struct types with manual field-store init through *T (the
//     `alloc(structlit{...})` sugar trips f64/str cgen traps; we
//     hand-roll instead — see arena_alloc and the v* constructors)
//   - enum types (valkind, sform, btin, tkind) + `switch` dispatch
//   - tagged-union-typed function parameters + bool-return helpers
//   - `[]*value` slices with `append(s, v)` growth
//   - `for (let x .. xs)` byte/element range loop
//   - classic `for (cond)` + `break`
//   - `defer` to release the slurp buffer on every exit edge
//   - runes ('a'), str literals, f64 arithmetic, mixed i64/f64 promo
//   - a chunked perm/trans bump arena with Cheney-style promotion
//     at top-level define/set! boundaries; trans resets between
//     forms so deep eval graphs don't keep growing process RSS
//   - module imports (use os/fmt/ascii/strconv/strings)
//
// Build:    make
// Run:      ./lisp                 — REPL on stdin
//           echo '(+ 1 2)' | ./lisp
//
// Surface:
//   atoms       nil, #t, #f, integers, floats, "strings", symbols
//   special     quote if define lambda let begin set!
//   builtins    + - * / mod = < > <= >= cons car cdr list
//               null? pair? number? symbol? eq? not print println
//   reader      '(a b . c) — dotted-pair tail goes into the cdr of
//               the last cons cell, classic Scheme/Common Lisp.
//
// wwstage cgen workarounds in this file (search for "wwstage" or the
// trap name for context at each site):
//
//   - top-level `[N]T` arrays are mis-addressed inside functions
//     (LEAQ from BP, not from the SB symbol). Heap-allocate via
//     os.alloc into a `*T` and alias to a local before indexing.
//   - `global_ptr[i]` is mis-addressed too — alias `global` into a
//     local `*T` at function entry; `local_ptr[i]` then works.
//   - two-level field stores `L.cur.kind = k` (with `cur` a non-
//     pointer sub-struct) silently drop. Flatten the inner fields.
//   - `alloc(value{ fval = ... })` and `p.fval = …` store an integer
//     reg at the f64 offset. Same for `*p = v` when p is *f64.
//     Routing through a top-level f64 global + byte copy is reliable.
//   - `alloc(value{ text = s })` writes only s.ptr, not s.len.
//     Manual init via `p.text = s` writes both halves.
//   - `(slice | E)` tagged-union returns drop the slice's `len`.
//     Inline the slice builder; don't return it through tagged-union.
//   - `xs[i].kind` reads only the slice index, drops the trailing
//     field load. Bind `let p = xs[i];` first.
//   - `acc /= d` / `acc += f` on f64 locals lower to `acc = d` (drop
//     the OP). Write the explicit form `acc = acc OP d`.

use os;
use fmt;
use ascii;
use strconv;
use strings;

// ---- value representation ---------------------------------------------
//
// One heap-allocated `value` per atom or cons cell. ww doesn't have
// C-style unions, so every variant carries the full payload set; the
// `kind` tag tells us which fields are live. ~72 bytes is acceptable
// for a demo — every cons cell allocates one.

export type valkind = enum i32 {
	NIL     = 0,
	BOOL    = 1,
	INT     = 2,
	FLOAT   = 3,
	SYM     = 4,
	STR     = 5,
	CONS    = 6,
	BUILTIN = 7,
	LAMBDA  = 8,
};

export type value = struct {
	kind:  valkind,
	bval:  i32,	// BOOL: 0/1
	ival:  i64,	// INT, BUILTIN id, LAMBDA arity
	fval:  f64,	// FLOAT
	sid:   i32,	// SYM — interner id
	text:  str,	// STR
	car:   *value,	// CONS car / LAMBDA params head; promote fwd
	cdr:   *value,	// CONS cdr / LAMBDA body head
	envp:  *env,	// LAMBDA captured env
	pin:   i32,	// 0 = trans, 1 = perm, -1 = forwarded (see promote_v)
};

// 4+4+8+8+4+pad+16+8+8+8+4 = 76 with natural alignment. Round up to
// 96 so any future field growth (or alignment surprise from the
// wwstage cgen) doesn't corrupt the next heap cell.
def VALUE_SZ: u64 = 96u64;

// env — single linked list of (sym → value) bindings. Adding a new
// scope is just a prepend; lookup walks the chain head→tail.
export type env = struct {
	sid:  i32,
	val:  *value,	// promote_env stashes the perm-forwarded ptr here
	next: *env,
	pin:  i32,	// 0 = trans, 1 = perm, -1 = forwarded
};
def ENV_SZ: u64 = 32u64;

// ---- arena allocator --------------------------------------------------
//
// Two bump-pointer arenas over 64 KiB chunks: `perm_arena` for cells
// that have to outlive the top-level form that produced them (top-
// level definitions and the value graph they pin), and `trans_arena`
// for everything else (parse cells, intermediate evals, the form's
// result). repl() resets the trans arena between top-level forms.
//
// Pre-arena every cell paid the 4 KiB page-per-call cost of
// rt_alloc; test_huge.lisp peaked at ~525 MB under massif
// --pages-as-heap=yes. With chunking alone Pass A brought that to
// ~253 MB; per-form trans reset (this pass) drops it further by
// reclaiming the trans high-water mark after each form.
//
// Promotion. eval routes every alloc through trans by default;
// `env_define` at the top level (`tailed == false`) calls
// `promote_v` first, which deep-copies the value graph into perm
// using Cheney-style forwarding in the source cells (`pin = -1` plus
// the new perm pointer stashed in `.car`/`.val`). `env_set` does the
// same when the binding it lands on lives in perm. After that, no
// perm cell ever points back into trans, so the reset is safe.
//
// Chunk recycling. arena_reset_trans hands the head chunk's older
// neighbours to a free list inside the same arena; subsequent
// overflows pop from that list before mmap'ing new memory. Peak
// virtual address space is bounded by max-form working set.

def ARENA_CHUNK:  u64 = 65536u64;	// 64 KiB per mmap
def CHUNK_HEADER: u64 = 32u64;		// header bytes, 8-aligned

type chunk = struct {
	next: *chunk,
	cur:  u64,
};

type arena = struct {
	head: *chunk,	// active bump chunk; .next chains older chunks
	free: *chunk,	// recycled chunks (single-linked via .next)
};

let perm_arena:  arena;
let trans_arena: arena;

fn arena_new_chunk(prev: *chunk) *chunk = {
	let raw: *u8 = os.alloc(ARENA_CHUNK): *u8;
	let c: *chunk = raw: *chunk;
	c.next = prev;
	c.cur  = 0u64;
	return c;
};

export fn arena_init() void = {
	perm_arena.head  = arena_new_chunk(nil);
	perm_arena.free  = nil;
	trans_arena.head = arena_new_chunk(nil);
	trans_arena.free = nil;
};

// arena_alloc_in — bump `n` bytes off the arena's head chunk; pull
// from the free list (or mmap fresh) if the head is too full.
// Allocated bytes are memzero'd so reused trans chunks start clean
// for the new form.
fn arena_alloc_in(A: *arena, n: u64) *void = {
	let n8: u64 = (n + 7u64) & ~7u64;
	let h: *chunk = A.head;
	if (h.cur + n8 + CHUNK_HEADER > ARENA_CHUNK) {
		let c: *chunk;
		if (A.free != nil) {
			c = A.free;
			A.free = c.next;
			c.next = h;
			c.cur  = 0u64;
		} else {
			c = arena_new_chunk(h);
		};
		A.head = c;
		h = c;
	};
	let raw: *u8 = h: *u8;
	let p: *u8 = raw + CHUNK_HEADER + h.cur;
	h.cur += n8;
	let i: u64 = 0u64;
	for (i < n8) { p[i] = 0; i += 1u64; };
	return p: *void;
};

fn arena_alloc(n: u64) *void = {
	return arena_alloc_in(&trans_arena, n);
};

fn arena_alloc_perm(n: u64) *void = {
	return arena_alloc_in(&perm_arena, n);
};

// arena_reset_trans — detach chunks above the bottom of trans, push
// them onto the free list for reuse, memzero the touched portion of
// the head chunk (we kept its memory, not its contents), and reset
// the bump pointer. Called from repl() between top-level forms.
export fn arena_reset_trans() void = {
	let h: *chunk = trans_arena.head;
	if (h == nil) { return; };
	if (h.next != nil) {
		let cur: *chunk = h.next;
		let end: *chunk = cur;
		for (end.next != nil) { end = end.next; };
		end.next = trans_arena.free;
		trans_arena.free = cur;
		h.next = nil;
	};
	let raw: *u8 = (h: *u8) + CHUNK_HEADER;
	let i: u64 = 0u64;
	for (i < h.cur) { raw[i] = 0; i += 1u64; };
	h.cur = 0u64;
};

// ---- error variants ---------------------------------------------------

export type rterror = !str;	// runtime: division by zero, unbound symbol, …
export type parserr = !str;	// parse:   bad token, unterminated string, …
export type eof     = !void;	// parser:  end of input — distinct from a parse error

// ---- value constructors ----------------------------------------------
//
// Every v* constructor allocates one VALUE_SZ slab from the arena and
// initialises the fields the kind needs. The cgen's
// `alloc(value{...})` struct-literal sugar lowers to rt_alloc directly
// (one mmap per cell), so the constructors hand-roll the alloc + per-
// field stores instead. Same shape as `new T(...)` in other languages.

export fn vnil() *value = {
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.NIL;
	return p;
};

export fn vbool(b: bool) *value = {
	let n: i32 = 0;
	if (b) { n = 1; };
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.BOOL;
	p.bval = n;
	return p;
};

export fn vint(v: i64) *value = {
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.INT;
	p.ival = v;
	return p;
};

// f64 → struct-field via a *T pointer is mis-lowered (stores AX instead
// of MOVSD from X0). MOVSD into a top-level f64 global works, so route
// the bits through a scratch global and copy them as bytes.
def FVAL_OFF: u64 = 16u64;
let fbuf: f64 = 0.0;

fn vfloat(v: f64) *value = {
	fbuf = v;
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.FLOAT;
	let raw: *u8 = p: *u8;
	let dst: *u8 = raw + FVAL_OFF;
	let srcp: *f64 = &fbuf;
	let src: *u8 = srcp: *u8;
	let i: u64 = 0u64;
	for (i < 8u64) { dst[i] = src[i]; i += 1u64; };
	return p;
};

export fn vsym(id: i32) *value = {
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.SYM;
	p.sid  = id;
	return p;
};

// Manual init via `p.text = s` writes both halves of the str slice;
// the cgen's struct-literal path drops s.len because BX gets reloaded
// with the new-pointer before the .len store.
//
// Ownership. We always copy `s`'s bytes into the trans arena. The
// argument is borrowed (from the lexer's L.src, which is the REPL's
// `buf`; or from a caller-supplied source string), and the REPL
// rewrites `buf` between forms — so a STR value that kept the borrow
// would print garbage after the next read/shift. Same shape as
// symbols (which are already copied into `sym_blob`); same shape as
// Hare's strings::dup. promote_v's STR branch re-copies into perm at
// the top-level define/set! boundary.
fn vstr(s: str) *value = {
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.STR;
	let dst: *u8 = arena_alloc(s.len: u64): *u8;
	let i: i32 = 0;
	for (i < s.len) { dst[i] = s[i]; i += 1; };
	let owned: str;
	owned.ptr = dst;
	owned.len = s.len;
	p.text = owned;
	return p;
};

export fn vcons(a: *value, d: *value) *value = {
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.CONS;
	p.car  = a;
	p.cdr  = d;
	return p;
};

fn vbuiltin(id: i32) *value = {
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.BUILTIN;
	p.ival = id: i64;
	return p;
};

fn vlambda(params: *value, body: *value, e: *env) *value = {
	let p: *value = arena_alloc(VALUE_SZ): *value;
	p.kind = valkind.LAMBDA;
	p.car  = params;
	p.cdr  = body;
	p.envp = e;
	return p;
};

// ---- symbol interner --------------------------------------------------
//
// Parallel arrays. The `def NAME: [N]T` form keeps everything in .bss
// — no heap, no init. The wwstage cgen treats `[N]<primitive>` arrays
// as primitive-sized for indexing, which is the trap cmatrix's comment
// warns about; we hold every per-symbol field as its own array.

def SYM_CAP:    i32 = 256;
def SYM_BLOBSZ: i32 = 8192;

// Backing storage is heap-allocated by main() rather than declared as
// a top-level `[N]T` global, because the wwstage cgen still mis-lowers
// `globalarr[i] = …` (variable index) to `LEAQ (BP), BX` — it treats
// the global address as if it were on the stack. Pointers indexed
// through `[i]` go through the cmatrix path (LEAQ from rt_alloc result)
// which works.
let sym_off:    *i32 = nil;
let sym_len:    *i32 = nil;
let sym_blob:   *u8  = nil;
let sym_count:  i32  = 0;
let sym_blobuse: i32 = 0;

// Pre-interned ids for the special-form / builtin tables. Computed in
// initsyms(); the consts below are filled at runtime, not at compile
// time, so we keep them as plain mutable globals.
let SID_QUOTE:  i32 = 0;
let SID_IF:     i32 = 0;
let SID_DEFINE: i32 = 0;
let SID_LAMBDA: i32 = 0;
let SID_LET:    i32 = 0;
let SID_BEGIN:  i32 = 0;
let SID_SETBANG: i32 = 0;

// streqid / intern / symname all alias the global *T pointers into
// locals before indexing. The wwstage cgen mis-lowers `global[i]` when
// `global` is a pointer-typed top-level let: it reads BP+0 instead of
// `LEAQ global(SB)`. Through a local the address path is correct.

fn streqid(a: str, off: i32, len: i32) bool = {
	if (a.len != len) { return false; };
	let blob: *u8 = sym_blob;
	let i: i32 = 0;
	for (i < len) {
		if (a[i] != blob[off + i]) { return false; };
		i += 1;
	};
	return true;
};

export fn intern(s: str) i32 = {
	let offt: *i32 = sym_off;
	let lent: *i32 = sym_len;
	let blob: *u8  = sym_blob;
	let i: i32 = 0;
	for (i < sym_count) {
		if (streqid(s, offt[i], lent[i])) { return i; };
		i += 1;
	};
	os.assert(sym_count < SYM_CAP, "sym table full");
	os.assert(sym_blobuse + s.len <= SYM_BLOBSZ, "sym blob full");
	let off: i32 = sym_blobuse;
	let j: i32 = 0;
	for (j < s.len) {
		blob[off + j] = s[j];
		j += 1;
	};
	offt[sym_count] = off;
	lent[sym_count] = s.len;
	let id: i32 = sym_count;
	sym_count += 1;
	sym_blobuse += s.len;
	return id;
};

fn symname(id: i32) str = {
	let offt: *i32 = sym_off;
	let lent: *i32 = sym_len;
	let r: str;
	r.ptr = sym_blob + offt[id];
	r.len = lent[id];
	return r;
};

// ---- builtin / special-form ids --------------------------------------

type sform = enum i32 {
	NONE    = 0,
	QUOTE   = 1,
	IF      = 2,
	DEFINE  = 3,
	LAMBDA  = 4,
	LET     = 5,
	BEGIN   = 6,
	SETBANG = 7,
};

type btin = enum i32 {
	ADD     = 0,
	SUB     = 1,
	MUL     = 2,
	DIV     = 3,
	MOD     = 4,
	EQ      = 5,
	LT      = 6,
	GT      = 7,
	LE      = 8,
	GE      = 9,
	CONS    = 10,
	CAR     = 11,
	CDR     = 12,
	LIST    = 13,
	NULLP   = 14,
	PAIRP   = 15,
	NUMP    = 16,
	SYMP    = 17,
	EQP     = 18,
	NOT     = 19,
	PRINT   = 20,
	PRINTLN = 21,
};

// classify_sform — special-forms are recognised by the *symbol id* of
// the operator, so the lexer doesn't need to know about them. Symbol
// ids for SID_QUOTE etc. are filled in by initsyms().
fn classify_sform(id: i32) sform = {
	if (id == SID_QUOTE)   { return sform.QUOTE; };
	if (id == SID_IF)      { return sform.IF; };
	if (id == SID_DEFINE)  { return sform.DEFINE; };
	if (id == SID_LAMBDA)  { return sform.LAMBDA; };
	if (id == SID_LET)     { return sform.LET; };
	if (id == SID_BEGIN)   { return sform.BEGIN; };
	if (id == SID_SETBANG) { return sform.SETBANG; };
	return sform.NONE;
};

// ---- lexer ------------------------------------------------------------
//
// Token-by-token over a borrowed []u8 source. `(`, `)`, `'` are single
// chars; integers/floats/strings/symbols all need a small state body.

type tkind = enum i32 {
	END    = 0,	// out of input
	LPAREN = 1,
	RPAREN = 2,
	QUOTE  = 3,	// '
	INT    = 4,
	FLOAT  = 5,
	STR    = 6,
	SYM    = 7,
	TRUE   = 8,
	FALSE  = 9,
	DOT    = 10,	// standalone '.' inside a list — dotted-pair marker
};

// Current-token fields are flattened into `lexer`. ww's wwstage cgen
// drops two-level field stores like `L.curkind = k` (with cur a
// non-pointer sub-struct) — emits an empty function body. Single-
// level stores through *lexer work fine.

type lexer = struct {
	src:      str,
	pos:      i32,
	curstart: i32,	// byte offset where L.curkind's source starts —
			// the parser's one-token lookahead means L.pos has
			// already advanced past the lookahead's bytes; the
			// interactive REPL needs this to know how many of
			// `buf` are safely consumed.
	curkind:  tkind,
	curival:  i64,
	curfval:  f64,
	cursid:   i32,
	curtext:  str,
};

fn isdelim(c: u8) bool = {
	if (ascii.isspace(c: rune)) { return true; };
	if (c == '(': u8) { return true; };
	if (c == ')': u8) { return true; };
	if (c == '\'': u8) { return true; };
	if (c == ';': u8) { return true; };
	return false;
};

fn skipws(L: *lexer) void = {
	for (L.pos < L.src.len) {
		let c: u8 = L.src[L.pos];
		if (ascii.isspace(c: rune)) {
			L.pos += 1;
			continue;
		};
		// `;` to end of line — Scheme-style line comment.
		if (c == ';': u8) {
			for (L.pos < L.src.len) {
				if (L.src[L.pos] == 10u8) {
					L.pos += 1;
					break;
				};
				L.pos += 1;
			};
			continue;
		};
		break;
	};
};

fn readatom(L: *lexer) str = {
	let start: i32 = L.pos;
	for (L.pos < L.src.len) {
		if (isdelim(L.src[L.pos])) { break; };
		L.pos += 1;
	};
	let r: str;
	r.ptr = L.src.ptr + start;
	r.len = L.pos - start;
	return r;
};

// allnum — true iff `s` is a (possibly-signed) sequence of digits.
fn allnum(s: str) bool = {
	if (s.len == 0) { return false; };
	let i: i32 = 0;
	if (s[0] == '-': u8) {
		if (s.len == 1) { return false; };
		i = 1;
	};
	for (i < s.len) {
		if (!ascii.isdigit(s[i]: rune)) { return false; };
		i += 1;
	};
	return true;
};

// allfloat — like allnum but allows exactly one '.'. Lets us pick
// floats out of the atom stream before falling through to symbol.
fn allfloat(s: str) bool = {
	if (s.len == 0) { return false; };
	let i: i32 = 0;
	let dots: i32 = 0;
	let digits: i32 = 0;
	if (s[0] == '-': u8) {
		if (s.len == 1) { return false; };
		i = 1;
	};
	for (i < s.len) {
		let c: u8 = s[i];
		if (c == '.': u8) {
			dots += 1;
			if (dots > 1) { return false; };
		} else if (ascii.isdigit(c: rune)) {
			digits += 1;
		} else {
			return false;
		};
		i += 1;
	};
	return digits > 0 && dots == 1;
};

// parsef — tiny decimal float scanner. Not IEEE-perfect, but adequate
// for the demo. Mirrors strconv.stoi64's shape.
fn parsef(s: str) f64 = {
	let i: i32 = 0;
	let neg: bool = false;
	if (s[0] == '-': u8) { neg = true; i = 1; };
	let intp: f64 = 0.0;
	for (i < s.len) {
		let c: u8 = s[i];
		if (c == '.': u8) { i += 1; break; };
		intp = intp * 10.0 + ((c: i64 - 48): f64);
		i += 1;
	};
	let frac: f64 = 0.0;
	let scale: f64 = 1.0;
	for (i < s.len) {
		let c: u8 = s[i];
		frac = frac * 10.0 + ((c: i64 - 48): f64);
		scale = scale * 10.0;
		i += 1;
	};
	let v: f64 = intp + frac / scale;
	if (neg) { v = -v; };
	return v;
};

// readstr — consume "..." from the input. Caller has already eaten
// the opening quote. Returns the inner text as a borrowed str, or
// parserr on unterminated input. Escape handling is intentionally
// thin: \n \t \" \\ — anything else passes through as the trailing
// byte.
fn readstr(L: *lexer, out: *str) (i32 | parserr) = {
	let start: i32 = L.pos;
	for (L.pos < L.src.len) {
		let c: u8 = L.src[L.pos];
		if (c == '"': u8) {
			let r: str;
			r.ptr = L.src.ptr + start;
			r.len = L.pos - start;
			L.pos += 1;	// past closing quote
			*out = r;
			return 0;
		};
		if (c == '\\': u8 && L.pos + 1 < L.src.len) {
			L.pos += 2;
			continue;
		};
		L.pos += 1;
	};
	return "unterminated string": parserr;
};

// next — advance L.cur to the next token. Three-variant return so the
// caller can distinguish "got token", "ran out cleanly", and "broken
// input" without re-checking flags.
fn next(L: *lexer) (i32 | parserr | eof) = {
	skipws(L);
	L.curstart = L.pos;	// start-of-current-token (or end-of-input)
	if (L.pos >= L.src.len) {
		L.curkind = tkind.END;
		return eof{};
	};
	let c: u8 = L.src[L.pos];
	if (c == '(': u8)  { L.curkind = tkind.LPAREN; L.pos += 1; return 0; };
	if (c == ')': u8)  { L.curkind = tkind.RPAREN; L.pos += 1; return 0; };
	if (c == '\'': u8) { L.curkind = tkind.QUOTE;  L.pos += 1; return 0; };
	if (c == '"': u8) {
		L.pos += 1;
		let s: str;
		readstr(L, &s)?;
		L.curkind = tkind.STR;
		L.curtext = s;
		return 0;
	};
	let a: str = readatom(L);
	if (a.len == 0) { return "empty token": parserr; };
	if (strings.compare(a, "#t") == 0) { L.curkind = tkind.TRUE;  return 0; };
	if (strings.compare(a, "#f") == 0) { L.curkind = tkind.FALSE; return 0; };
	// Bare `.` inside a list is the dotted-pair marker. Outside a
	// list parse_expr will reject it; here we just tag it.
	if (a.len == 1 && a[0] == '.': u8) { L.curkind = tkind.DOT; return 0; };
	if (allnum(a)) {
		let r = strconv.stoi64(a);
		match (r) {
		case let v: i64 => {
			L.curkind = tkind.INT;
			L.curival = v;
			return 0;
		};
		case let e: strconv.invalid => { return "bad integer": parserr; };
		case let e: strconv.overflow => { return "integer overflow": parserr; };
		};
	};
	if (allfloat(a)) {
		L.curkind = tkind.FLOAT;
		L.curfval = parsef(a);
		return 0;
	};
	L.curkind = tkind.SYM;
	L.cursid = intern(a);
	return 0;
};

// ---- parser -----------------------------------------------------------
//
// Read one s-expression. After a successful parse, L.cur holds the
// next un-consumed token (parser is eager-lookahead).

fn parse_expr(L: *lexer) (*value | parserr | eof) = {
	let k: tkind = L.curkind;
	if (k == tkind.END) { return eof{}; };
	if (k == tkind.RPAREN) { return "unexpected ')'": parserr; };

	if (k == tkind.LPAREN) {
		// Advance past '('.
		let r = next(L);
		match (r) {
		case let _ok: i32 => { };
		case let e: parserr => return e;
		case eof => return "unterminated list": parserr;
		};
		// Empty list `()`.
		if (L.curkind == tkind.RPAREN) {
			let r2 = next(L);
			// Discard the eof shape — empty input after ')' is fine.
			match (r2) {
			case let _ok: i32 => { };
			case let e: parserr => return e;
			case eof => { };
			};
			return vnil();
		};
		let head: *value = vnil();
		let tail: *value = nil;
		for (true) {
			if (L.curkind == tkind.RPAREN) { break; };
			if (L.curkind == tkind.END) {
				return "unterminated list": parserr;
			};
			// Dotted-pair tail: `(a b . c)` ⇒ (a . (b . c)). The
			// `.` token can only appear after at least one element,
			// then exactly one more expression, then `)`.
			if (L.curkind == tkind.DOT) {
				if (tail == nil) {
					return "'.': nothing to dot": parserr;
				};
				let r = next(L);
				match (r) {
				case let _ok: i32 => { };
				case let e: parserr => return e;
				case eof => return "unterminated list": parserr;
				};
				let cdrv = parse_expr(L)?;
				tail.cdr = cdrv;
				if (L.curkind != tkind.RPAREN) {
					return "'.': expected ')' after cdr": parserr;
				};
				break;
			};
			let v = parse_expr(L)?;
			let cell: *value = vcons(v, vnil());
			if (tail == nil) { head = cell; }
			else            { tail.cdr = cell; };
			tail = cell;
			if (L.curkind == tkind.RPAREN) { break; };
		};
		// Advance past ')'.
		let r3 = next(L);
		match (r3) {
		case let _ok: i32 => { };
		case let e: parserr => return e;
		case eof => { };
		};
		return head;
	};

	if (k == tkind.QUOTE) {
		// Advance past '.
		let r = next(L);
		match (r) {
		case let _ok: i32 => { };
		case let e: parserr => return e;
		case eof => return "EOF after quote": parserr;
		};
		let inner = parse_expr(L)?;
		// 'expr ⇒ (quote expr)
		return vcons(vsym(SID_QUOTE), vcons(inner, vnil()));
	};

	// Self-evaluating atom — read the token, then advance.
	let v: *value = vnil();
	if (k == tkind.INT)   { v = vint(L.curival); }
	else if (k == tkind.FLOAT) { v = vfloat(L.curfval); }
	else if (k == tkind.STR)   { v = vstr(L.curtext); }
	else if (k == tkind.SYM)   { v = vsym(L.cursid); }
	else if (k == tkind.TRUE)  { v = vbool(true); }
	else if (k == tkind.FALSE) { v = vbool(false); }
	else { return "unexpected token": parserr; };

	let r4 = next(L);
	match (r4) {
	case let _ok: i32 => { };
	case let e: parserr => return e;
	case eof => { };
	};
	return v;
};

// ---- env --------------------------------------------------------------

fn env_define(e: **env, sid: i32, v: *value) void = {
	let f: *env = arena_alloc(ENV_SZ): *env;
	f.sid  = sid;
	f.val  = v;
	f.next = *e;
	*e = f;
};

// env_define_perm — top-level define path. The new env node lives in
// the perm arena (pin=1); the caller must have already promoted `v`
// (see promote_v) so that no perm cell ends up pointing into trans.
fn env_define_perm(e: **env, sid: i32, v: *value) void = {
	let f: *env = arena_alloc_perm(ENV_SZ): *env;
	f.sid  = sid;
	f.val  = v;
	f.next = *e;
	f.pin  = 1;
	*e = f;
};

fn env_lookup(e: *env, sid: i32) (*value | rterror) = {
	let cur: *env = e;
	for (cur != nil) {
		if (cur.sid == sid) { return cur.val; };
		cur = cur.next;
	};
	return "unbound symbol": rterror;
};

// env_set — when the binding we land on lives in perm, the new value
// has to be promoted before we store it, or the perm cell would point
// into trans and dangle on the next reset.
fn env_set(e: *env, sid: i32, v: *value) (i32 | rterror) = {
	let cur: *env = e;
	for (cur != nil) {
		if (cur.sid == sid) {
			let nv: *value = v;
			if (cur.pin == 1) { nv = promote_v(v); };
			cur.val = nv;
			return 0;
		};
		cur = cur.next;
	};
	return "set!: unbound symbol": rterror;
};

// ---- promotion (trans → perm) ----------------------------------------
//
// Top-level define / set! is the only way a cell can escape its
// originating top-level form. promote_v deep-copies the reachable
// graph from a trans cell into perm, leaving forwarding markers in
// place so cycles (recursive lambdas, the (define) tie-back frame,
// shared sub-trees) don't get cloned twice and so back-edges resolve
// to the new perm cells.
//
// Forwarding encoding. After a trans cell has been promoted, its
// `pin` is set to -1 and the new perm pointer is stashed in `.car`
// (for value) or `.val` (for env). The original kind/fields are
// effectively dead from that point — anyone who reaches the trans
// cell again chases the forwarding pointer instead. The cells stay
// in trans until the next arena_reset_trans wipes them.

fn promote_v(v: *value) *value = {
	if (v == nil) { return nil; };
	let p: *value = v;
	if (p.pin == 1)  { return v; };		// already perm
	if (p.pin == -1) { return p.car; };	// forwarded; chase

	let n: *value = arena_alloc_perm(VALUE_SZ): *value;
	n.kind = p.kind;
	n.bval = p.bval;
	n.ival = p.ival;
	n.sid  = p.sid;
	n.text = p.text;
	n.car  = p.car;
	n.cdr  = p.cdr;
	n.envp = p.envp;
	if (p.kind == valkind.FLOAT) {
		// f64 byte copy — `n.fval = p.fval` through *value lowers
		// to an integer-reg store at the f64 offset, same trap
		// vfloat sidesteps via the `fbuf` scratch global.
		let psrc: *u8 = (p: *u8) + FVAL_OFF;
		let ndst: *u8 = (n: *u8) + FVAL_OFF;
		let i: u64 = 0u64;
		for (i < 8u64) { ndst[i] = psrc[i]; i += 1u64; };
	};
	if (p.kind == valkind.STR) {
		// Deep-copy the bytes into perm. vstr put them in trans, and
		// the trans reset that ends every top-level form would drop
		// them. Mirror of Hare's strings::dup, but into the perm
		// arena rather than os.alloc so the bytes share the lifetime
		// of the rest of the perm graph.
		let plen: i32 = p.text.len;
		let dst: *u8 = arena_alloc_perm(plen: u64): *u8;
		let src: *u8 = p.text.ptr;
		let i: i32 = 0;
		for (i < plen) { dst[i] = src[i]; i += 1; };
		let owned: str;
		owned.ptr = dst;
		owned.len = plen;
		n.text = owned;
	};
	n.pin = 1;

	// Forward before recursing — a sub-pointer that loops back to
	// `p` (recursive lambda envp, define tie-back) chases the
	// forward instead of allocating a second perm copy.
	p.pin = -1;
	p.car = n;

	if (n.kind == valkind.CONS) {
		n.car = promote_v(n.car);
		n.cdr = promote_v(n.cdr);
	} else if (n.kind == valkind.LAMBDA) {
		n.car  = promote_v(n.car);	// params list
		n.cdr  = promote_v(n.cdr);	// body list
		n.envp = promote_env(n.envp);
	};
	return n;
};

fn promote_env(e: *env) *env = {
	if (e == nil) { return nil; };
	let q: *env = e;
	if (q.pin == 1)  { return e; };
	if (q.pin == -1) { return q.val: *env; };	// forwarded; chase

	let n: *env = arena_alloc_perm(ENV_SZ): *env;
	n.sid  = q.sid;
	n.val  = q.val;
	n.next = q.next;
	n.pin  = 1;

	q.pin = -1;
	q.val = n: *value;	// reuse .val as the forwarding slot

	n.val  = promote_v(n.val);
	n.next = promote_env(n.next);
	return n;
};

// ---- helpers on values ------------------------------------------------

fn truthy(v: *value) bool = {
	// Only #f is false. nil/0/"" are truthy, classic Lisp.
	if (v.kind == valkind.BOOL && v.bval == 0) { return false; };
	return true;
};

fn list_len(v: *value) i32 = {
	let n: i32 = 0;
	let cur: *value = v;
	for (cur.kind == valkind.CONS) {
		n += 1;
		cur = cur.cdr;
	};
	return n;
};

// ---- arithmetic helpers ----------------------------------------------
//
// Numeric ops are int-when-all-ints / float-otherwise. We scan once
// to decide, then run the right loop.

fn any_float(xs: []*value) bool = {
	for (let x .. xs) {
		if (x.kind == valkind.FLOAT) { return true; };
	};
	return false;
};

// to_f64 / to_i64 take an out-pointer rather than `(T | rterror)`:
// the wwstage tagged-union return convention doesn't put a returned
// f64 in X0 (it pushes the bits into DX), but the unwrap path reads
// X0 — so the caller sees garbage. An out-pointer sidesteps the
// boundary entirely.

// f64 movement through the wwstage cgen is fragile: only MOVSD into a
// top-level global emits the right MOVSD. Field-of-pointer stores,
// struct-literal stores, and function-arg passing for f64 all run
// through integer registers and lose the value. We treat every
// "f64 stored at address A" as a byte-copy from a known-good source.
//
//   copybytes(d, s) — pure 8-byte memcpy.
//   to_f64 — INT branch routes through `fbuf` (global f64 store works
//            for the CVTSI2SD-produced X0), then byte-copies; FLOAT
//            branch is a direct bit-copy from `v.fval`.

fn copybytes(d: *u8, s: *u8) void = {
	let i: u64 = 0u64;
	for (i < 8u64) { d[i] = s[i]; i += 1u64; };
};

fn to_f64(v: *value, out: *f64) bool = {
	let dst: *u8 = out: *u8;
	if (v.kind == valkind.INT) {
		fbuf = v.ival: f64;
		let sp: *f64 = &fbuf;
		copybytes(dst, sp: *u8);
		return true;
	};
	if (v.kind == valkind.FLOAT) {
		let raw: *u8 = v: *u8;
		copybytes(dst, raw + FVAL_OFF);
		return true;
	};
	return false;
};

fn to_i64(v: *value, out: *i64) bool = {
	if (v.kind == valkind.INT)   { *out = v.ival;        return true; };
	if (v.kind == valkind.FLOAT) { *out = v.fval: i64;   return true; };
	return false;
};

// ---- builtins ---------------------------------------------------------

// Helper: pull a single i64 out of xs[i], or error.
fn arg_i64(x: *value) (i64 | rterror) = {
	if (x.kind == valkind.INT)   { return x.ival; };
	if (x.kind == valkind.FLOAT) { return x.fval: i64; };
	return "expected number": rterror;
};

// f64 compound assigns (+=, -=, *=, /=) get mis-lowered to `acc = f`
// (drop the OP) in the wwstage cgen — write `acc = acc OP f`.
// Integer compound assigns work fine.

fn b_add(xs: []*value) (*value | rterror) = {
	if (any_float(xs)) {
		let acc: f64 = 0.0;
		let f: f64 = 0.0;
		for (let x .. xs) {
			if (!to_f64(x, &f)) { return "expected number": rterror; };
			acc = acc + f;
		};
		return vfloat(acc);
	};
	let acc: i64 = 0;
	for (let x .. xs) { acc += arg_i64(x)?; };
	return vint(acc);
};

fn b_sub(xs: []*value) (*value | rterror) = {
	if (xs.len == 0) { return "(-): need at least 1 arg": rterror; };
	if (any_float(xs)) {
		let acc: f64 = 0.0;
		let f: f64 = 0.0;
		if (!to_f64(xs[0], &acc)) { return "expected number": rterror; };
		if (xs.len == 1) { return vfloat(-acc); };
		let i: i32 = 1;
		for (i < xs.len) {
			if (!to_f64(xs[i], &f)) { return "expected number": rterror; };
			acc = acc - f;
			i += 1;
		};
		return vfloat(acc);
	};
	let acc: i64 = arg_i64(xs[0])?;
	if (xs.len == 1) { return vint(-acc); };
	let i: i32 = 1;
	for (i < xs.len) { acc -= arg_i64(xs[i])?; i += 1; };
	return vint(acc);
};

fn b_mul(xs: []*value) (*value | rterror) = {
	if (any_float(xs)) {
		let acc: f64 = 1.0;
		let f: f64 = 0.0;
		for (let x .. xs) {
			if (!to_f64(x, &f)) { return "expected number": rterror; };
			acc = acc * f;
		};
		return vfloat(acc);
	};
	let acc: i64 = 1;
	for (let x .. xs) { acc *= arg_i64(x)?; };
	return vint(acc);
};

// Compound `acc /= d` is mis-lowered (store-without-divide) in the
// wwstage cgen — explicit `acc = acc / d` works.

fn b_div(xs: []*value) (*value | rterror) = {
	if (xs.len < 2) { return "(/): need at least 2 args": rterror; };
	if (any_float(xs)) {
		let acc: f64 = 0.0;
		let d: f64 = 0.0;
		if (!to_f64(xs[0], &acc)) { return "expected number": rterror; };
		let i: i32 = 1;
		for (i < xs.len) {
			if (!to_f64(xs[i], &d)) { return "expected number": rterror; };
			if (d == 0.0) { return "divide by zero": rterror; };
			acc = acc / d;
			i += 1;
		};
		return vfloat(acc);
	};
	let acc: i64 = arg_i64(xs[0])?;
	let i: i32 = 1;
	for (i < xs.len) {
		let d: i64 = arg_i64(xs[i])?;
		if (d == 0) { return "divide by zero": rterror; };
		acc = acc / d;
		i += 1;
	};
	return vint(acc);
};

fn b_mod(xs: []*value) (*value | rterror) = {
	if (xs.len != 2) { return "(mod): need 2 args": rterror; };
	let a: i64 = arg_i64(xs[0])?;
	let b: i64 = arg_i64(xs[1])?;
	if (b == 0) { return "mod by zero": rterror; };
	let q: i64 = a / b;
	return vint(a - q * b);
};

fn cmp2(xs: []*value, want: i32) (*value | rterror) = {
	if (xs.len < 2) { return "comparison: need >=2 args": rterror; };
	let i: i32 = 0;
	let af: f64 = 0.0;
	let bf: f64 = 0.0;
	for (i < xs.len - 1) {
		if (!to_f64(xs[i],     &af)) { return "expected number": rterror; };
		if (!to_f64(xs[i + 1], &bf)) { return "expected number": rterror; };
		let ok: bool = false;
		if (want == 0) { ok = (af == bf); }
		else if (want == 1) { ok = (af < bf); }
		else if (want == 2) { ok = (af > bf); }
		else if (want == 3) { ok = (af <= bf); }
		else               { ok = (af >= bf); };
		if (!ok) { return vbool(false); };
		i += 1;
	};
	return vbool(true);
};

fn b_cons(xs: []*value) (*value | rterror) = {
	if (xs.len != 2) { return "cons: need 2 args": rterror; };
	return vcons(xs[0], xs[1]);
};

// Field access on a slice element (xs[i].kind) is mis-lowered by the
// wwstage cgen: it emits only the slice index, drops the trailing
// field load. Workaround: bind xs[i] to a local *value first.

fn b_car(xs: []*value) (*value | rterror) = {
	if (xs.len != 1) { return "car: need 1 arg": rterror; };
	let p: *value = xs[0];
	if (p.kind != valkind.CONS) { return "car: not a pair": rterror; };
	return p.car;
};

fn b_cdr(xs: []*value) (*value | rterror) = {
	if (xs.len != 1) { return "cdr: need 1 arg": rterror; };
	let p: *value = xs[0];
	if (p.kind != valkind.CONS) { return "cdr: not a pair": rterror; };
	return p.cdr;
};

fn b_list(xs: []*value) (*value | rterror) = {
	let head: *value = vnil();
	let i: i32 = xs.len - 1;
	for (i >= 0) {
		head = vcons(xs[i], head);
		i -= 1;
	};
	return head;
};

fn b_nullp(xs: []*value) (*value | rterror) = {
	if (xs.len != 1) { return "null?: need 1 arg": rterror; };
	let p: *value = xs[0];
	return vbool(p.kind == valkind.NIL);
};

fn b_pairp(xs: []*value) (*value | rterror) = {
	if (xs.len != 1) { return "pair?: need 1 arg": rterror; };
	let p: *value = xs[0];
	return vbool(p.kind == valkind.CONS);
};

fn b_nump(xs: []*value) (*value | rterror) = {
	if (xs.len != 1) { return "number?: need 1 arg": rterror; };
	let p: *value = xs[0];
	let k: valkind = p.kind;
	return vbool(k == valkind.INT || k == valkind.FLOAT);
};

fn b_symp(xs: []*value) (*value | rterror) = {
	if (xs.len != 1) { return "symbol?: need 1 arg": rterror; };
	let p: *value = xs[0];
	return vbool(p.kind == valkind.SYM);
};

fn b_eqp(xs: []*value) (*value | rterror) = {
	if (xs.len != 2) { return "eq?: need 2 args": rterror; };
	let a: *value = xs[0];
	let b: *value = xs[1];
	if (a.kind != b.kind) { return vbool(false); };
	if (a.kind == valkind.NIL)  { return vbool(true); };
	if (a.kind == valkind.BOOL) { return vbool(a.bval == b.bval); };
	if (a.kind == valkind.INT)  { return vbool(a.ival == b.ival); };
	if (a.kind == valkind.SYM)  { return vbool(a.sid  == b.sid); };
	// Reference equality for everything else — matches eq? semantics
	// in classic Lisps.
	return vbool(a == b);
};

fn b_not(xs: []*value) (*value | rterror) = {
	if (xs.len != 1) { return "not: need 1 arg": rterror; };
	let p: *value = xs[0];
	return vbool(!truthy(p));
};

fn b_print(xs: []*value) (*value | rterror) = {
	for (let x .. xs) { print_value(x, false); };
	return vnil();
};

fn b_println(xs: []*value) (*value | rterror) = {
	for (let x .. xs) { print_value(x, false); };
	fmt.println("");
	return vnil();
};

// apply_builtin — switch over the builtin id (an i32 stashed in the
// BUILTIN value's ival slot). Switch case labels reject the `:` cast
// form, so the id and the btin enum must agree on i32.
fn apply_builtin(id: i32, xs: []*value) (*value | rterror) = {
	switch (id) {
	case btin.ADD:     return b_add(xs);
	case btin.SUB:     return b_sub(xs);
	case btin.MUL:     return b_mul(xs);
	case btin.DIV:     return b_div(xs);
	case btin.MOD:     return b_mod(xs);
	case btin.EQ:      return cmp2(xs, 0);
	case btin.LT:      return cmp2(xs, 1);
	case btin.GT:      return cmp2(xs, 2);
	case btin.LE:      return cmp2(xs, 3);
	case btin.GE:      return cmp2(xs, 4);
	case btin.CONS:    return b_cons(xs);
	case btin.CAR:     return b_car(xs);
	case btin.CDR:     return b_cdr(xs);
	case btin.LIST:    return b_list(xs);
	case btin.NULLP:   return b_nullp(xs);
	case btin.PAIRP:   return b_pairp(xs);
	case btin.NUMP:    return b_nump(xs);
	case btin.SYMP:    return b_symp(xs);
	case btin.EQP:     return b_eqp(xs);
	case btin.NOT:     return b_not(xs);
	case btin.PRINT:   return b_print(xs);
	case btin.PRINTLN: return b_println(xs);
	};
	return "unknown builtin": rterror;
};

// ---- eval -------------------------------------------------------------

// eval — drive the evaluation of a single form. Most paths are ordinary
// recursion; tail positions (IF branch, last form of BEGIN/LET/lambda
// body, and a tail call into another lambda) re-enter this loop with a
// new (v, cure) instead of recursing, so deep tail-recursive Lisp code
// doesn't grow the C stack one frame per call.
//
// Scope handling. `ein` is the *caller's* env slot. While evaluation
// stays in the caller's scope (top-level work, IF, BEGIN), `define`/
// `set!` mutate via `ein` so a top-level define lands in the caller's
// global env. Once a tail-jump enters a fresh scope (LET binding,
// lambda body), `tailed` flips and further `define`s are confined to
// the local `cure` chain — same behavior as the pre-TCO code, where
// LET/apply created their own `pe` local that died at scope exit.
export fn eval(v0: *value, ein: **env) (*value | rterror) = {
	let v: *value = v0;
	let cure: *env = *ein;
	let tailed: bool = false;
	for (true) {
		// Self-evaluating atoms — every variant of `valkind` that
		// isn't SYM (lookup) or CONS (application).
		if (v.kind == valkind.NIL)     { return v; };
		if (v.kind == valkind.BOOL)    { return v; };
		if (v.kind == valkind.INT)     { return v; };
		if (v.kind == valkind.FLOAT)   { return v; };
		if (v.kind == valkind.STR)     { return v; };
		if (v.kind == valkind.BUILTIN) { return v; };
		if (v.kind == valkind.LAMBDA)  { return v; };

		if (v.kind == valkind.SYM) {
			return env_lookup(cure, v.sid)?;
		};

		// CONS — application. Head selects a special form (via
		// symbol id) or evaluates to a callable.
		let head: *value = v.car;
		let rest: *value = v.cdr;

		let sf: sform = sform.NONE;
		if (head.kind == valkind.SYM) {
			sf = classify_sform(head.sid);
		};

		if (sf == sform.QUOTE) {
			if (rest.kind != valkind.CONS) {
				return "quote: missing arg": rterror;
			};
			return rest.car;
		};
		if (sf == sform.IF) {
			if (list_len(rest) < 2) {
				return "if: need cond + then": rterror;
			};
			let cnd: *value = rest.car;
			let thn: *value = rest.cdr.car;
			let cv = eval(cnd, &cure)?;
			if (truthy(cv)) {
				v = thn;
				continue;
			};
			let elsep: *value = rest.cdr.cdr;
			if (elsep.kind == valkind.CONS) {
				v = elsep.car;
				continue;
			};
			return vnil();
		};
		if (sf == sform.DEFINE) {
			if (list_len(rest) != 2) {
				return "define: (define name expr)": rterror;
			};
			let nameval: *value = rest.car;
			if (nameval.kind != valkind.SYM) {
				return "define: name must be symbol": rterror;
			};
			let body: *value = rest.cdr.car;
			let bv = eval(body, &cure)?;
			// Top-level define (`tailed == false`, ein points at
			// the global env): promote bv into perm and allocate
			// the env node in perm too, so this binding survives
			// the trans reset that ends every top-level form.
			// Nested defines stay trans-local — they're scoped to
			// the lambda body that produced them.
			if (tailed) {
				env_define(&cure, nameval.sid, bv);
			} else {
				bv = promote_v(bv);
				env_define_perm(ein, nameval.sid, bv);
				cure = *ein;
			};
			// Recursive-lambda tie-back: prepend a self-binding
			// frame to the captured env so `(fact …)` inside
			// fact's body resolves. Earlier versions clobbered
			// `bv.envp` with `*e`, which wiped out any non-global
			// env that closures (e.g. `(adder 5)` returning
			// `(lambda (x) (+ x k))`) had captured.
			if (bv.kind == valkind.LAMBDA) {
				let frame: *env;
				if (tailed) {
					frame = arena_alloc(ENV_SZ): *env;
				} else {
					frame = arena_alloc_perm(ENV_SZ): *env;
					frame.pin = 1;
				};
				frame.sid  = nameval.sid;
				frame.val  = bv;
				frame.next = bv.envp;
				bv.envp = frame;
			};
			return vnil();
		};
		if (sf == sform.SETBANG) {
			if (list_len(rest) != 2) {
				return "set!: (set! name expr)": rterror;
			};
			let nameval: *value = rest.car;
			if (nameval.kind != valkind.SYM) {
				return "set!: name must be symbol": rterror;
			};
			let body: *value = rest.cdr.car;
			let bv = eval(body, &cure)?;
			env_set(cure, nameval.sid, bv)?;
			return bv;
		};
		if (sf == sform.LAMBDA) {
			if (list_len(rest) < 2) {
				return "lambda: (lambda (params) body...)": rterror;
			};
			let params: *value = rest.car;
			let body: *value = rest.cdr;
			return vlambda(params, body, cure);
		};
		if (sf == sform.LET) {
			// (let ((x v) (y w) ...) body...). Bindings see the
			// outer scope; the body sees `inner`.
			if (list_len(rest) < 2) {
				return "let: (let ((b ...)) body)": rterror;
			};
			let binds: *value = rest.car;
			let body: *value = rest.cdr;
			let inner: *env = cure;
			let bcur: *value = binds;
			for (bcur.kind == valkind.CONS) {
				let pair: *value = bcur.car;
				if (list_len(pair) != 2) {
					return "let: bad binding": rterror;
				};
				let nm: *value = pair.car;
				if (nm.kind != valkind.SYM) {
					return "let: name must be sym": rterror;
				};
				let val = eval(pair.cdr.car, &cure)?;
				let f: *env = arena_alloc(ENV_SZ): *env;
				f.sid  = nm.sid;
				f.val  = val;
				f.next = inner;
				inner = f;
				bcur = bcur.cdr;
			};
			cure = inner;
			tailed = true;
			// All-but-last in non-tail; last via loop jump.
			let bf: *value = body;
			for (bf.cdr.kind == valkind.CONS) {
				eval(bf.car, &cure)?;
				bf = bf.cdr;
			};
			v = bf.car;
			continue;
		};
		if (sf == sform.BEGIN) {
			if (rest.kind != valkind.CONS) { return vnil(); };
			let bf: *value = rest;
			for (bf.cdr.kind == valkind.CONS) {
				eval(bf.car, &cure)?;
				bf = bf.cdr;
			};
			v = bf.car;
			continue;
		};

		// Normal application: evaluate head, then args, dispatch.
		let callee: *value = eval(head, &cure)?;

		// Inline the args walk: a separate `(slice | rterror)`
		// return loses xs.len through the wwstage cgen's 3-reg
		// tagged-union convention (AX=tag, DX=ptr, CX=cap — len
		// is computed into BX and dropped). Keeping the slice
		// strictly local sidesteps that.
		let xs: []*value;
		xs.ptr = nil;
		xs.len = 0;
		xs.cap = 0;
		let acur: *value = rest;
		for (acur.kind == valkind.CONS) {
			let av = eval(acur.car, &cure)?;
			append(xs, av);
			acur = acur.cdr;
		};

		// Each apply leaks one 4 KiB rt_ensure page if we don't
		// release `xs.ptr` — release happens in every exit edge
		// below. `xs.cap` was set by the doubling slice grower and
		// matches what rt_ensure mmaped.
		let xs_cap: u64 = (xs.cap: u64) * 8u64;
		let xs_ptr: *void = xs.ptr: *void;
		if (callee.kind == valkind.BUILTIN) {
			// Match into a local before freeing: leaving the
			// `(*value | rterror)` result inside a `let r = …`
			// across the os.free call lets a wwstage cgen quirk
			// stomp on the rterror's str.len (the union is spilled
			// to AX/DX/CX, and the foreign-call clobber blanks one
			// of them before the `?` reads it back).
			match (apply_builtin(callee.ival: i32, xs)) {
			case let pv: *value => {
				if (xs_ptr != nil) { os.free(xs_ptr: *void, xs_cap); };
				return pv;
			};
			case let er: rterror => {
				if (xs_ptr != nil) { os.free(xs_ptr: *void, xs_cap); };
				return er;
			};
			};
		};
		if (callee.kind == valkind.LAMBDA) {
			// Extend the lambda's captured env with one frame
			// per param, then tail-jump into the body.
			let inner: *env = callee.envp;
			let p: *value = callee.car;
			let i: i32 = 0;
			for (p.kind == valkind.CONS) {
				if (i >= xs.len) {
					if (xs_ptr != nil) { os.free(xs_ptr: *void, xs_cap); };
					return "lambda: too few args": rterror;
				};
				let nm: *value = p.car;
				if (nm.kind != valkind.SYM) {
					if (xs_ptr != nil) { os.free(xs_ptr: *void, xs_cap); };
					return "lambda: bad param": rterror;
				};
				let f: *env = arena_alloc(ENV_SZ): *env;
				f.sid  = nm.sid;
				f.val  = xs[i];
				f.next = inner;
				inner = f;
				p = p.cdr;
				i += 1;
			};
			if (i != xs.len) {
				if (xs_ptr != nil) { os.free(xs_ptr: *void, xs_cap); };
				return "lambda: too many args": rterror;
			};
			if (xs_ptr != nil) { os.free(xs_ptr: *void, xs_cap); };
			cure = inner;
			tailed = true;
			let bod: *value = callee.cdr;
			for (bod.cdr.kind == valkind.CONS) {
				eval(bod.car, &cure)?;
				bod = bod.cdr;
			};
			v = bod.car;
			continue;
		};
		if (xs_ptr != nil) { os.free(xs_ptr: *void, xs_cap); };
		return "not callable": rterror;
	};
	// Unreachable — every path inside the loop returns or continues.
	return vnil();
};

// ---- printer ---------------------------------------------------------

// Use a fixed-size scratch buffer so we don't bounce through fmt for
// every glyph. fmt.print already buffers per-write into write(2), but
// we'd like one syscall per top-level value.

let obuf:    *u8 = nil;
let obufuse: i32 = 0;
def OBUF_SZ: i32 = 4096;

fn obuf_putc(c: u8) void = {
	let buf: *u8 = obuf;
	if (obufuse >= OBUF_SZ) {
		os.write(1, buf, obufuse: u64);
		obufuse = 0;
	};
	buf[obufuse] = c;
	obufuse += 1;
};

fn obuf_puts(s: str) void = {
	let i: i32 = 0;
	for (i < s.len) { obuf_putc(s[i]); i += 1; };
};

fn obuf_putint(v: i64) void = {
	let tmp: [32]u8;
	let n: i32 = strconv.i64tos(tmp[0:32], v);
	let i: i32 = 0;
	for (i < n) { obuf_putc(tmp[i]); i += 1; };
};

fn obuf_putfloat(v: f64) void = {
	// strconv.f64tos handles sign, 6-digit fractional, trailing-zero
	// trim. Buffer size 32 covers the worst-case "-1234567890123456789"
	// plus ".XXXXXX" (29 bytes — round up to 32).
	let buf: [32]u8;
	let n: i32 = strconv.f64tos(buf[0:32], v);
	let i: i32 = 0;
	for (i < n) { obuf_putc(buf[i]); i += 1; };
};

fn obuf_flush() void = {
	if (obufuse > 0) {
		os.write(1, obuf, obufuse: u64);
		obufuse = 0;
	};
};

export fn print_value(v: *value, nl: bool) void = {
	let k: valkind = v.kind;
	switch (k) {
	case valkind.NIL: obuf_puts("()");
	case valkind.BOOL: {
		if (v.bval == 0) { obuf_puts("#f"); } else { obuf_puts("#t"); };
	};
	case valkind.INT:   obuf_putint(v.ival);
	case valkind.FLOAT: obuf_putfloat(v.fval);
	case valkind.SYM:   obuf_puts(symname(v.sid));
	case valkind.STR: {
		obuf_putc('"': u8);
		obuf_puts(v.text);
		obuf_putc('"': u8);
	};
	case valkind.BUILTIN: obuf_puts("#<builtin>");
	case valkind.LAMBDA:  obuf_puts("#<lambda>");
	case valkind.CONS: {
		obuf_putc('(': u8);
		let cur: *value = v;
		let first: bool = true;
		for (cur.kind == valkind.CONS) {
			if (!first) { obuf_putc(' ': u8); };
			first = false;
			print_value(cur.car, false);
			cur = cur.cdr;
		};
		if (cur.kind != valkind.NIL) {
			obuf_puts(" . ");
			print_value(cur, false);
		};
		obuf_putc(')': u8);
	};
	};
	if (nl) { obuf_putc(10u8); };
	obuf_flush();
};

// ---- builtin binding --------------------------------------------------

// bind_one — initial global-env wire-up. Builtins are part of the
// permanent root env, so both the binding node and the value cell go
// to perm (or the first arena_reset_trans would wipe them).
fn bind_one(e: **env, name: str, id: i32) void = {
	let sid: i32 = intern(name);
	let bv: *value = promote_v(vbuiltin(id));
	env_define_perm(e, sid, bv);
};

export fn initsyms() void = {
	arena_init();
	sym_off  = os.alloc((SYM_CAP: u64) * 4u64): *i32;
	sym_len  = os.alloc((SYM_CAP: u64) * 4u64): *i32;
	sym_blob = os.alloc(SYM_BLOBSZ: u64): *u8;
	obuf     = os.alloc(OBUF_SZ: u64): *u8;

	// Stash the special-form ids so classify_sform sees them.
	SID_QUOTE   = intern("quote");
	SID_IF      = intern("if");
	SID_DEFINE  = intern("define");
	SID_LAMBDA  = intern("lambda");
	SID_LET     = intern("let");
	SID_BEGIN   = intern("begin");
	SID_SETBANG = intern("set!");
};

export fn bind_builtins(e: **env) void = {
	bind_one(e, "+",       btin.ADD     as i32);
	bind_one(e, "-",       btin.SUB     as i32);
	bind_one(e, "*",       btin.MUL     as i32);
	bind_one(e, "/",       btin.DIV     as i32);
	bind_one(e, "mod",     btin.MOD     as i32);
	bind_one(e, "=",       btin.EQ      as i32);
	bind_one(e, "<",       btin.LT      as i32);
	bind_one(e, ">",       btin.GT      as i32);
	bind_one(e, "<=",      btin.LE      as i32);
	bind_one(e, ">=",      btin.GE      as i32);
	bind_one(e, "cons",    btin.CONS    as i32);
	bind_one(e, "car",     btin.CAR     as i32);
	bind_one(e, "cdr",     btin.CDR     as i32);
	bind_one(e, "list",    btin.LIST    as i32);
	bind_one(e, "null?",   btin.NULLP   as i32);
	bind_one(e, "pair?",   btin.PAIRP   as i32);
	bind_one(e, "number?", btin.NUMP    as i32);
	bind_one(e, "symbol?", btin.SYMP    as i32);
	bind_one(e, "eq?",     btin.EQP     as i32);
	bind_one(e, "not",     btin.NOT     as i32);
	bind_one(e, "print",   btin.PRINT   as i32);
	bind_one(e, "println", btin.PRINTLN as i32);
};

// ---- REPL -------------------------------------------------------------

// Slurp every byte from `fd` until EOF into a fresh buffer. The caller
// owns the buffer. Mirrors Hare's io::drain.
// eval_str — parse a single top-level form from `s` and evaluate it.
// Folds parse failures and EOF into the rterror variant so callers
// only need to dispatch over `(*value | rterror)`. This is the one
// the test driver in `lisp_test.ww` consumes.
export fn eval_str(s: str, ep: **env) (*value | rterror) = {
	let L: lexer;
	L.src = s;
	L.pos = 0;
	match (next(&L)) {
	case let _ok: i32 => { };
	case let e: parserr => return e: str: rterror;
	case eof => return "empty input": rterror;
	};
	let r = parse_expr(&L);
	let v: *value = match (r) {
	case let v: *value => yield v;
	case let e: parserr => return e: str: rterror;
	case eof => return "empty input": rterror;
	};
	return eval(v, ep)?;
};

fn print_err(prefix: str, msg: str) void = {
	os.write(2, prefix.ptr, prefix.len: u64);
	os.write(2, msg.ptr, msg.len: u64);
	os.write(2, "\n".ptr, 1u64);
};

// is_unterminated — parserr-text test for "we ran out of input mid-
// form, please read more". Two specific texts qualify; everything
// else is a hard syntax error.
fn is_unterminated(er: str) bool = {
	if (strings.compare(er, "unterminated list")   == 0) { return true; };
	if (strings.compare(er, "unterminated string") == 0) { return true; };
	return false;
};

// repl — interactive read-eval-print loop. Earlier versions slurped
// stdin to EOF first; this one reads a chunk, tries to parse a top-
// level form, and either evaluates it or asks for more input.
//
// Prompts go to stderr (fd 2) so `./lisp | downstream` doesn't see
// "> " on stdout. The banner does too.
//
// State machine:
//   `buf` accumulates raw bytes. `cont` switches between "> " (start
//   of a fresh form) and "  " (continuing an incomplete form). After
//   a successful parse we shift `L.pos` bytes off the front of `buf`
//   and reuse whatever's behind them as the next form's source.
export fn repl() i32 = {
	let e: *env = nil;
	let ep: **env = &e;
	initsyms();
	bind_builtins(ep);

	os.write(2, "ww-lisp — Ctrl-D to exit.\n".ptr, 28u64);

	let buf: []u8;
	buf.ptr = nil;
	buf.len = 0;
	buf.cap = 0;
	let at_eof: bool = false;
	let cont:   bool = false;	// true = print "  " instead of "> "
	let chunk:  [4096]u8;

	for (true) {
		// 1. If we have no buffered bytes, prompt and read.
		if (buf.len == 0) {
			if (at_eof) { break; };
			if (cont) { os.write(2, "  ".ptr, 2u64); }
			else      { os.write(2, "> ".ptr, 2u64); };
			cont = false;
			let n: i64 = os.read(0, chunk.ptr, 4096u64);
			if (n <= 0) { at_eof = true; continue; };
			let i: i32 = 0;
			for (i < n: i32) { append(buf, chunk[i]); i += 1; };
			continue;
		};

		// 2. Try to parse one top-level form from `buf[0..]`. Build
		// the `src` slice as a local `str` and whole-struct-assign
		// into L — `L.src.ptr = ...` is two-level field write
		// through *lexer + non-pointer sub-struct, which the cgen
		// silently drops (same trap as `L.cur.kind = …`).
		let src: str;
		src.ptr = buf.ptr;
		src.len = buf.len;
		let L: lexer;
		L.src = src;
		L.pos = 0;

		// 2a. Prime — handles "buf is whitespace-only" and tokeniser-
		// level errors before parse_expr ever sees them.
		match (next(&L)) {
		case let _ok: i32 => { };
		case let er: parserr => {
			print_err("parse error: ", er: str);
			buf.len = 0;
			cont = false;
			continue;
		};
		case eof => {
			buf.len = 0;
			cont = false;
			continue;
		};
		};

		// 2b. Parse a single form.
		match (parse_expr(&L)) {
		case let v: *value => {
			match (eval(v, ep)) {
			case let r: *value => print_value(r, true);
			case let er: rterror => print_err("error: ", er: str);
			};
			// The parser primes one token of lookahead, so L.pos
			// already crossed the next form's first byte. Drop up
			// to `L.curstart` so that leading byte stays in `buf`
			// for the next iteration.
			let nc: i32 = L.curstart;
			let nleft: i32 = buf.len - nc;
			let j: i32 = 0;
			for (j < nleft) { buf[j] = buf[nc + j]; j += 1; };
			buf.len = nleft;
			cont = false;
			// Form's parse cells, intermediate eval values, and the
			// printed result are all in the trans arena now and
			// won't be referenced again — reclaim them for the
			// next form. Top-level defines have already been
			// promoted into perm via the DEFINE handler.
			arena_reset_trans();
		};
		case let er: parserr => {
			// "unterminated list" / "unterminated string" means we
			// need more bytes before the form is complete. Anything
			// else is a real syntax error — print, drop, recover.
			if (is_unterminated(er: str)) {
				if (at_eof) {
					print_err("parse error: ", er: str);
					return 1;
				};
				os.write(2, "  ".ptr, 2u64);
				let n: i64 = os.read(0, chunk.ptr, 4096u64);
				if (n <= 0) { at_eof = true; continue; };
				let i: i32 = 0;
				for (i < n: i32) { append(buf, chunk[i]); i += 1; };
				cont = true;
				continue;
			};
			print_err("parse error: ", er: str);
			buf.len = 0;
			cont = false;
			arena_reset_trans();
		};
		case eof => {
			// next() succeeded but parse_expr ran out: the form was
			// a partial atom (e.g., trailing `'`). Read more.
			if (at_eof) { return 0; };
			os.write(2, "  ".ptr, 2u64);
			let n: i64 = os.read(0, chunk.ptr, 4096u64);
			if (n <= 0) { at_eof = true; continue; };
			let i: i32 = 0;
			for (i < n: i32) { append(buf, chunk[i]); i += 1; };
			cont = true;
		};
		};
	};

	return 0;
};