// 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; }; fn vfloat(v: f64) *value = { let p: *value = arena_alloc(VALUE_SZ): *value; p.kind = valkind.FLOAT; p.fval = v; 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]` 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; fn streqid(a: str, off: i32, len: i32) bool = { if (a.len != len) { return false; }; let i: i32 = 0; for (i < len) { if (a[i] != sym_blob[off + i]) { return false; }; i += 1; }; return true; }; export fn intern(s: str) i32 = { let i: i32 = 0; for (i < sym_count) { if (streqid(s, sym_off[i], sym_len[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) { sym_blob[off + j] = s[j]; j += 1; }; sym_off[sym_count] = off; sym_len[sym_count] = s.len; let id: i32 = sym_count; sym_count += 1; sym_blobuse += s.len; return id; }; fn symname(id: i32) str = { let r: str; r.ptr = sym_blob + sym_off[id]; r.len = sym_len[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, strconv.base.DEC); 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) { n.fval = p.fval; }; 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. fn to_f64(v: *value, out: *f64) bool = { if (v.kind == valkind.INT) { *out = v.ival: f64; return true; }; if (v.kind == valkind.FLOAT) { *out = v.fval; 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]); }; fn b_car(xs: []*value) (*value | rterror) = { if (xs.len != 1) { return "car: need 1 arg": rterror; }; if (xs[0].kind != valkind.CONS) { return "car: not a pair": rterror; }; return xs[0].car; }; fn b_cdr(xs: []*value) (*value | rterror) = { if (xs.len != 1) { return "cdr: need 1 arg": rterror; }; if (xs[0].kind != valkind.CONS) { return "cdr: not a pair": rterror; }; return xs[0].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; }; return vbool(xs[0].kind == valkind.NIL); }; fn b_pairp(xs: []*value) (*value | rterror) = { if (xs.len != 1) { return "pair?: need 1 arg": rterror; }; return vbool(xs[0].kind == valkind.CONS); }; fn b_nump(xs: []*value) (*value | rterror) = { if (xs.len != 1) { return "number?: need 1 arg": rterror; }; let k: valkind = xs[0].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; }; return vbool(xs[0].kind == valkind.SYM); }; fn b_eqp(xs: []*value) (*value | rterror) = { if (xs.len != 2) { return "eq?: need 2 args": rterror; }; if (xs[0].kind != xs[1].kind) { return vbool(false); }; if (xs[0].kind == valkind.NIL) { return vbool(true); }; if (xs[0].kind == valkind.BOOL) { return vbool(xs[0].bval == xs[1].bval); }; if (xs[0].kind == valkind.INT) { return vbool(xs[0].ival == xs[1].ival); }; if (xs[0].kind == valkind.SYM) { return vbool(xs[0].sid == xs[1].sid); }; // Reference equality for everything else — matches eq? semantics // in classic Lisps. return vbool(xs[0] == xs[1]); }; fn b_not(xs: []*value) (*value | rterror) = { if (xs.len != 1) { return "not: need 1 arg": rterror; }; return vbool(!truthy(xs[0])); }; 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 s: str = strconv.i64tos(v, strconv.base.DEC); let i: i32 = 0; for (i < s.len) { obuf_putc(s.ptr[i]); i += 1; }; }; fn obuf_putfloat(v: f64) void = { // strconv.f64tos handles sign, 6-digit fractional, trailing-zero // trim. Returns a static-buffer-backed str overwritten on the // next f64tos call. let s: str = strconv.f64tos(v); let i: i32 = 0; for (i < s.len) { obuf_putc(s.ptr[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("#"); case valkind.LAMBDA: obuf_puts("#"); 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; };