examples: lisp — own STR bytes; dotted-pair literals

vstr now copies the input bytes into the trans arena and promote_v
does the same into perm at the top-level boundary. STR cells used
to borrow the lexer's input slice; the REPL's buf-shift between
forms overwrote those bytes, so a top-level (define x "...") would
print garbage after the next read. Mirror of Hare's strings::dup,
arena-routed so the bytes share the cell's lifetime.

Parser learns dotted-pair literals: '(a b . c) splices the tail
into the cdr of the last cons. A bare '.' inside a list lexes as
tkind.DOT; outside a list it's still a parser error. Pre-fix the
'.' lexed as a one-byte SYM, producing a 3-element proper list.

Drop the unused args_to_slice — eval inlines on purpose (the
wwstage cgen drops slice.len through a tagged-union return).

Tests: 18 new probes (str-survives-3-defines, str-from-lambda,
dotted-pair walk + error edges) + a check_str helper. 101/101.
This commit is contained in:
2026-05-13 01:41:47 +09:00
parent 3f0d1939f5
commit ebfd8c3652
2 changed files with 170 additions and 34 deletions

View File

@@ -34,6 +34,8 @@
// 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):
@@ -290,10 +292,25 @@ export fn vsym(id: i32) *value = {
// 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;
p.text = s;
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;
};
@@ -472,6 +489,7 @@ type tkind = enum i32 {
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
@@ -656,6 +674,9 @@ fn next(L: *lexer) (i32 | parserr | eof) = {
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) {
@@ -714,6 +735,26 @@ fn parse_expr(L: *lexer) (*value | parserr | eof) = {
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; }
@@ -851,6 +892,22 @@ fn promote_v(v: *value) *value = {
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
@@ -908,22 +965,6 @@ fn list_len(v: *value) i32 = {
return n;
};
// args_to_slice — flatten a Lisp list of already-evaluated values into
// a ww `[]*value`. Exercises `append(s, v)`. The caller releases the
// slice via os.free.
fn args_to_slice(args: *value) []*value = {
let s: []*value;
s.ptr = nil;
s.len = 0;
s.cap = 0;
let cur: *value = args;
for (cur.kind == valkind.CONS) {
append(s, cur.car);
cur = cur.cdr;
};
return s;
};
// ---- arithmetic helpers ----------------------------------------------
//
// Numeric ops are int-when-all-ints / float-otherwise. We scan once
@@ -1527,24 +1568,13 @@ fn obuf_putint(v: i64) void = {
};
fn obuf_putfloat(v: f64) void = {
// One decimal place is fine for the demo — full-fidelity printing
// is a strconv.ftos away.
let neg: bool = false;
let f: f64 = v;
if (f < 0.0) { neg = true; f = -f; };
let ip: i64 = f: i64;
let frac: f64 = (f - (ip: f64)) * 1000000.0;
let fp: i64 = frac: i64;
if (neg) { obuf_putc('-': u8); };
obuf_putint(ip);
obuf_putc('.': u8);
// Pad to 6 digits.
let pad: [16]u8;
let n: i32 = strconv.i64tos(pad[0:16], fp);
let z: i32 = 6 - n;
for (z > 0) { obuf_putc('0': u8); z -= 1; };
// 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(pad[i]); i += 1; };
for (i < n) { obuf_putc(buf[i]); i += 1; };
};
fn obuf_flush() void = {