From ebfd8c36522e608dc974b5e892b1216793dfbad6 Mon Sep 17 00:00:00 2001 From: Hojun-Cho Date: Wed, 13 May 2026 01:41:47 +0900 Subject: [PATCH] =?UTF-8?q?examples:=20lisp=20=E2=80=94=20own=20STR=20byte?= =?UTF-8?q?s;=20dotted-pair=20literals?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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. --- examples/lisp/lisp_test.ww | 106 +++++++++++++++++++++++++++++++++++++ examples/lisp/lispcore.ww | 98 ++++++++++++++++++++++------------ 2 files changed, 170 insertions(+), 34 deletions(-) diff --git a/examples/lisp/lisp_test.ww b/examples/lisp/lisp_test.ww index 624c5a05..0932cc6b 100644 --- a/examples/lisp/lisp_test.ww +++ b/examples/lisp/lisp_test.ww @@ -167,6 +167,61 @@ fn check_err(name: str, input: str, ep: **env) void = { }; }; +// check_str — assert kind==STR and byte-wise equal to `want`. Covers +// the str-ownership story: vstr/promote_v copy bytes into the arena +// so the value survives the REPL's buf reuse. +fn check_str(name: str, input: str, want: str, ep: **env) void = { + ntotal += 1; + let r = eval_str(input, ep); + match (r) { + case let v: *value => { + let p: *value = v; + if (p.kind != valkind.STR) { + fail(name, "kind != STR"); + return; + }; + let got: str = p.text; + if (got.len != want.len) { + faili(name, "wrong len", got.len: i64); + return; + }; + let i: i32 = 0; + for (i < got.len) { + if (got[i] != want[i]) { + faili(name, "byte mismatch at", i: i64); + return; + }; + i += 1; + }; + ok(name); + }; + case let _e: rterror => fail(name, "rterror"); + }; +}; + +// strconv.f64tos probes. We run them through lisp_test rather than a +// standalone strconv test program because there's no stdlib-test +// scaffolding yet (cf. test/wcc/900_stdlib.c which only checks +// modules compile, not behaviour). Move out when that lands. +fn check_f64tos(name: str, v: f64, want: str) void = { + ntotal += 1; + let buf: [32]u8; + let n: i32 = strconv.f64tos(buf[0:32], v); + if (n != want.len) { + faili(name, "wrong len", n: i64); + return; + }; + let i: i32 = 0; + for (i < n) { + if (buf[i] != want[i]) { + faili(name, "byte mismatch at", i: i64); + return; + }; + i += 1; + }; + ok(name); +}; + // run an expression for its effect (e.g. `(define ...)`); ignore the // returned nil. Test passes iff there's no runtime error. fn run(name: str, input: str, ep: **env) void = { @@ -282,12 +337,63 @@ export fn main() i32 = { check_float("float-promote", "(+ 1 2.5)", 3.5, ep); check_bool ("float-cmp", "(< 1.0 2.0)", true, ep); + // ---- strconv.f64tos ---- + // Direct probes against the new strconv entry. The lisp printer + // delegates to this, so any regression here surfaces in `(println + // 1.5)` style output too. See lib/strconv/strconv.ww for the + // documented subset (no NaN/Inf/sci, ≥9.22e18 → "huge"). + check_f64tos("f64tos-int", 1.0, "1"); + check_f64tos("f64tos-half", 1.5, "1.5"); + check_f64tos("f64tos-pi", 3.14, "3.14"); + check_f64tos("f64tos-tenth", 0.1, "0.1"); + check_f64tos("f64tos-neg", -2.5, "-2.5"); + check_f64tos("f64tos-zero", 0.0, "0"); + check_f64tos("f64tos-hundred", 100.0, "100"); + check_f64tos("f64tos-leadzero", 0.05, "0.05"); + check_f64tos("f64tos-roundup", 0.9999996, "1"); + check_f64tos("f64tos-trim", 123.450000, "123.45"); + check_f64tos("f64tos-huge", 9.5e18, "huge"); + // ---- runtime errors ---- check_err ("err-unbound", "this-symbol-isnt-bound", ep); check_err ("err-car-not-pair", "(car 1)", ep); check_err ("err-div-zero", "(/ 5 0)", ep); check_err ("err-bad-arg", "(+ 'a 'b)", ep); + // ---- strings (vstr/promote_v deep-copy) ---- + // Pre-fix, top-level (define s "..") then later use printed + // garbage because vstr borrowed the lexer's input buffer and + // the REPL shifted it between forms. vstr now owns its bytes, + // promote_v copies them into perm. Each probe runs eval_str on + // its own input, so any borrow back into a dead source slice + // would surface here as a byte mismatch. + check_str ("str-literal", "\"hello\"", "hello", ep); + run ("def-s1", "(define s1 \"first\")", ep); + run ("def-s2", "(define s2 \"second\")", ep); + run ("def-s3", "(define s3 \"third\")", ep); + check_str ("str-s1-survives", "s1", "first", ep); + check_str ("str-s2-survives", "s2", "second", ep); + check_str ("str-s3-survives", "s3", "third", ep); + // String embedded in a lambda body — the lambda's body cell + // holds a STR sub-cell that has to be promoted too. + run ("def-getstr", "(define getstr (lambda () \"inside\"))", ep); + check_str ("str-from-lambda", "(getstr)", "inside", ep); + + // ---- dotted-pair literals ---- + // '(1 . 2) used to lex `.` as a 1-byte SYM, producing a + // 3-element proper list. Now: lexer emits tkind.DOT inside a + // list and the parser splices it as the cdr. + check_kind ("dot-pair-kind", "'(1 . 2)", valkind.CONS, ep); + check_int ("dot-pair-car", "(car '(1 . 2))", 1i64, ep); + check_int ("dot-pair-cdr", "(cdr '(1 . 2))", 2i64, ep); + check_bool ("dot-pair-not-pair-cdr", "(pair? (cdr '(1 . 2)))", false, ep); + // Walk `(1 2 . 3)` → car=1, cadr=2, cddr=3 (the dotted tail). + check_int ("dot-tail-car", "(car '(1 2 . 3))", 1i64, ep); + check_int ("dot-tail-cadr", "(car (cdr '(1 2 . 3)))", 2i64, ep); + check_int ("dot-tail-cddr", "(cdr (cdr '(1 2 . 3)))", 3i64, ep); + check_err ("dot-leading", "'(. 2)", ep); + check_err ("dot-trailing", "'(1 . 2 3)", ep); + // ---- summary ---- let buf: [32]u8; let n: i32 = 0; diff --git a/examples/lisp/lispcore.ww b/examples/lisp/lispcore.ww index dd8a75c2..f2114ee8 100644 --- a/examples/lisp/lispcore.ww +++ b/examples/lisp/lispcore.ww @@ -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 = {