examples: lisp — pure-ww Lisp interpreter, REPL, in-process tests
Demo program that lives entirely on lib/* and libwwrt.a — no @symbol
FFI of its own. The interpreter sits in lispcore.ww (exports for the
test driver); lisp.ww is a 3-line entry that calls lispcore.repl().
Language surface: integers, floats, symbols, strings, lists, lambdas
with closures, define / set! / if / quote / let / begin, recursion
(fact / fib / ackermann / gcd), map / filter / reduce as user code.
REPL is line-buffered: each read tries to parse one top-level form,
asks for more on "unterminated list", evaluates and prints, then
shifts consumed bytes off the front of the buffer. Lookahead-aware —
the parser primes one extra token so we shift to L.curstart, not
L.pos, otherwise the first byte of the next form gets eaten.
lisp_test.ww exec'd as a regular binary (ww test drops -I in single-
file mode); 66 probes cover arithmetic, lists, closures, recursion,
errors. test_*.lisp drive the live REPL through `make demo`.
The wwstage cgen still mis-lowers a handful of patterns at this
shape of program — top-level array indexing, global-ptr deref,
two-level field stores, f64 routing through *T, alloc(structlit{})
for f64/str fields, (slice | E) returns, xs[i].kind chains, f64
compound assigns. Each workaround is annotated at its use site;
the full taxonomy is in examples/lisp/CLAUDE.md.
This commit is contained in:
299
examples/lisp/lisp_test.ww
Normal file
299
examples/lisp/lisp_test.ww
Normal file
@@ -0,0 +1,299 @@
|
||||
// lisp_test — in-process test driver for the tiny Lisp.
|
||||
//
|
||||
// Drives eval_str on a sequence of source snippets and
|
||||
// inspects the returned `*value` (kind + payload). `ww test
|
||||
// lisp_test.ww` builds + execs this; exit 0 means every probe
|
||||
// passed, non-zero means at least one failed (with `FAIL <name>`
|
||||
// on stderr).
|
||||
//
|
||||
// We exercise the same wwstage cgen edges as lisp.ww itself, so a
|
||||
// regression in cross-module type / field access shows up here:
|
||||
// - `*value` field reads (.kind / .ival / .fval / .sid)
|
||||
// - `(*value | rterror)` returns crossing the
|
||||
// use-boundary
|
||||
// - module-qualified enum constants (`valkind.INT`) in
|
||||
// `==` comparisons and `case let _: rterror =>` arms.
|
||||
|
||||
use os;
|
||||
use fmt;
|
||||
use strconv;
|
||||
use lispcore;
|
||||
|
||||
let nfail: i32 = 0;
|
||||
let ntotal: i32 = 0;
|
||||
|
||||
// ---- result printers --------------------------------------------------
|
||||
|
||||
fn pname(name: str) void = {
|
||||
os.write(1, name.ptr, name.len: u64);
|
||||
};
|
||||
|
||||
fn ok(name: str) void = {
|
||||
os.write(1, "ok ".ptr, 5u64);
|
||||
pname(name);
|
||||
os.write(1, "\n".ptr, 1u64);
|
||||
};
|
||||
|
||||
fn fail(name: str, why: str) void = {
|
||||
os.write(2, "FAIL ".ptr, 5u64);
|
||||
os.write(2, name.ptr, name.len: u64);
|
||||
os.write(2, ": ".ptr, 2u64);
|
||||
os.write(2, why.ptr, why.len: u64);
|
||||
os.write(2, "\n".ptr, 1u64);
|
||||
nfail += 1;
|
||||
};
|
||||
|
||||
fn faili(name: str, why: str, got: i64) void = {
|
||||
os.write(2, "FAIL ".ptr, 5u64);
|
||||
os.write(2, name.ptr, name.len: u64);
|
||||
os.write(2, ": ".ptr, 2u64);
|
||||
os.write(2, why.ptr, why.len: u64);
|
||||
os.write(2, " got=".ptr, 5u64);
|
||||
let buf: [32]u8;
|
||||
let n: i32 = strconv.i64tos(buf[0:32], got);
|
||||
os.write(2, buf.ptr, n: u64);
|
||||
os.write(2, "\n".ptr, 1u64);
|
||||
nfail += 1;
|
||||
};
|
||||
|
||||
// ---- assertion helpers ------------------------------------------------
|
||||
//
|
||||
// Each `check_*` evaluates `input` against the supplied env, then
|
||||
// verifies the result. We always bind the result to a local *value
|
||||
// before doing field access — the wwstage cgen drops the trailing
|
||||
// field load on chained `xs[0].kind`-style reads.
|
||||
|
||||
fn check_int(name: str, input: str, expected: i64, 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.INT) {
|
||||
fail(name, "kind != INT");
|
||||
return;
|
||||
};
|
||||
if (p.ival != expected) {
|
||||
faili(name, "wrong i64", p.ival);
|
||||
return;
|
||||
};
|
||||
ok(name);
|
||||
};
|
||||
case let _e: rterror => fail(name, "rterror");
|
||||
};
|
||||
};
|
||||
|
||||
fn check_bool(name: str, input: str, expected: bool, 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.BOOL) {
|
||||
fail(name, "kind != BOOL");
|
||||
return;
|
||||
};
|
||||
let want: i32 = 0;
|
||||
if (expected) { want = 1; };
|
||||
if (p.bval != want) {
|
||||
faili(name, "wrong bool", p.bval: i64);
|
||||
return;
|
||||
};
|
||||
ok(name);
|
||||
};
|
||||
case let _e: rterror => fail(name, "rterror");
|
||||
};
|
||||
};
|
||||
|
||||
fn check_kind(name: str, input: str, want: valkind, ep: **env) void = {
|
||||
ntotal += 1;
|
||||
let r = eval_str(input, ep);
|
||||
match (r) {
|
||||
case let v: *value => {
|
||||
let p: *value = v;
|
||||
if (p.kind != want) {
|
||||
faili(name, "wrong kind", p.kind as i32: i64);
|
||||
return;
|
||||
};
|
||||
ok(name);
|
||||
};
|
||||
case let _e: rterror => fail(name, "rterror");
|
||||
};
|
||||
};
|
||||
|
||||
// Float — bit-equal comparison through the `fbuf` route lispcore uses
|
||||
// elsewhere. f64 hand-routing avoids the cgen's mis-lowering of f64
|
||||
// reads from struct fields.
|
||||
let chkfbuf: f64 = 0.0;
|
||||
|
||||
fn fapprox(a: f64, b: f64) bool = {
|
||||
// Tolerance 1e-6 — enough for "is the answer right?" without
|
||||
// pulling in a real float compare.
|
||||
let d: f64 = a - b;
|
||||
if (d < 0.0) { d = -d; };
|
||||
return d < 0.000001;
|
||||
};
|
||||
|
||||
fn check_float(name: str, input: str, expected: f64, 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.FLOAT) {
|
||||
fail(name, "kind != FLOAT");
|
||||
return;
|
||||
};
|
||||
// Cross-module *f64-via-pointer-deref read of v.fval.
|
||||
let raw: *u8 = p: *u8;
|
||||
let fp: *f64 = (raw + 16u64): *f64;
|
||||
let got: f64 = *fp;
|
||||
if (!fapprox(got, expected)) {
|
||||
fail(name, "wrong float");
|
||||
return;
|
||||
};
|
||||
ok(name);
|
||||
};
|
||||
case let _e: rterror => fail(name, "rterror");
|
||||
};
|
||||
};
|
||||
|
||||
fn check_err(name: str, input: str, ep: **env) void = {
|
||||
ntotal += 1;
|
||||
let r = eval_str(input, ep);
|
||||
match (r) {
|
||||
case let _v: *value => fail(name, "expected rterror, got value");
|
||||
case let _e: rterror => 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 = {
|
||||
ntotal += 1;
|
||||
let r = eval_str(input, ep);
|
||||
match (r) {
|
||||
case let _v: *value => ok(name);
|
||||
case let _e: rterror => fail(name, "rterror during run");
|
||||
};
|
||||
};
|
||||
|
||||
// ---- entry ------------------------------------------------------------
|
||||
|
||||
export fn main() i32 = {
|
||||
// Shared env across the whole suite. `define`s leak between
|
||||
// probes so later tests can reference `fact`, `square`, etc.
|
||||
let e: *env = nil;
|
||||
let ep: **env = &e;
|
||||
initsyms();
|
||||
bind_builtins(ep);
|
||||
|
||||
// ---- atoms + simple arithmetic ----
|
||||
check_int ("int-literal", "42", 42i64, ep);
|
||||
check_int ("add", "(+ 1 2 3 4 5)", 15i64, ep);
|
||||
check_int ("sub", "(- 100 25 25)", 50i64, ep);
|
||||
check_int ("mul", "(* 6 7)", 42i64, ep);
|
||||
check_int ("div", "(/ 100 5)", 20i64, ep);
|
||||
check_int ("div-3way", "(/ 1000 10 5)", 20i64, ep);
|
||||
check_int ("mod", "(mod 17 5)", 2i64, ep);
|
||||
check_int ("neg", "(- 7)", -7i64, ep);
|
||||
check_int ("nested", "(+ (* 2 3) (* 4 5))", 26i64, ep);
|
||||
|
||||
// ---- comparisons ----
|
||||
check_bool ("eq-true", "(= 5 5)", true, ep);
|
||||
check_bool ("eq-false", "(= 5 6)", false, ep);
|
||||
check_bool ("lt-chained", "(< 1 2 3 4)", true, ep);
|
||||
check_bool ("lt-fail", "(< 1 2 2)", false, ep);
|
||||
check_bool ("gt", "(> 5 3 1)", true, ep);
|
||||
check_bool ("le", "(<= 3 3 4)", true, ep);
|
||||
|
||||
// ---- conditionals + truthy ----
|
||||
check_int ("if-then", "(if #t 1 2)", 1i64, ep);
|
||||
check_int ("if-else", "(if #f 1 2)", 2i64, ep);
|
||||
check_int ("if-truthy-int", "(if 0 1 2)", 1i64, ep);
|
||||
check_bool ("not-false", "(not #f)", true, ep);
|
||||
|
||||
// ---- lists ----
|
||||
check_kind ("quote-list-cons", "'(1 2 3)", valkind.CONS, ep);
|
||||
check_kind ("empty-list-nil", "'()", valkind.NIL, ep);
|
||||
check_kind ("cons-cell", "(cons 1 2)", valkind.CONS, ep);
|
||||
check_int ("car", "(car '(11 22 33))", 11i64, ep);
|
||||
check_int ("car-of-list", "(car (list 7 8))", 7i64, ep);
|
||||
check_int ("len-cdr", "(car (cdr '(1 2 3)))",2i64, ep);
|
||||
check_bool ("null?-empty", "(null? '())", true, ep);
|
||||
check_bool ("null?-pair", "(null? '(1))", false, ep);
|
||||
check_bool ("pair?-cons", "(pair? '(a))", true, ep);
|
||||
check_bool ("pair?-atom", "(pair? 'a)", false, ep);
|
||||
|
||||
// ---- predicates ----
|
||||
check_bool ("number?-int", "(number? 42)", true, ep);
|
||||
check_bool ("number?-float", "(number? 3.14)", true, ep);
|
||||
check_bool ("number?-sym", "(number? 'foo)", false, ep);
|
||||
check_bool ("symbol?-sym", "(symbol? 'foo)", true, ep);
|
||||
check_bool ("symbol?-int", "(symbol? 1)", false, ep);
|
||||
check_bool ("eq?-sym", "(eq? 'a 'a)", true, ep);
|
||||
check_bool ("eq?-int", "(eq? 7 7)", true, ep);
|
||||
check_bool ("eq?-mixed", "(eq? 'a 1)", false, ep);
|
||||
|
||||
// ---- define + lookup + set! ----
|
||||
run ("def-x", "(define x 100)", ep);
|
||||
check_int ("ref-x", "x", 100i64, ep);
|
||||
run ("set-x", "(set! x 7)", ep);
|
||||
check_int ("ref-x-set", "x", 7i64, ep);
|
||||
|
||||
// ---- lambdas + recursion ----
|
||||
run ("def-sq", "(define sq (lambda (n) (* n n)))", ep);
|
||||
check_int ("call-sq", "(sq 9)", 81i64, ep);
|
||||
run ("def-fact", "(define fact (lambda (n) (if (<= n 1) 1 (* n (fact (- n 1))))))", ep);
|
||||
check_int ("fact-5", "(fact 5)", 120i64, ep);
|
||||
check_int ("fact-10", "(fact 10)", 3628800i64, ep);
|
||||
run ("def-fib", "(define fib (lambda (n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))", ep);
|
||||
check_int ("fib-10", "(fib 10)", 55i64, ep);
|
||||
check_int ("fib-15", "(fib 15)", 610i64, ep);
|
||||
run ("def-gcd", "(define gcd (lambda (a b) (if (= b 0) a (gcd b (mod a b)))))", ep);
|
||||
check_int ("gcd", "(gcd 60 48)", 12i64, ep);
|
||||
|
||||
// ---- higher-order ----
|
||||
run ("def-map", "(define mp (lambda (f l) (if (null? l) '() (cons (f (car l)) (mp f (cdr l))))))", ep);
|
||||
run ("def-inc", "(define inc (lambda (n) (+ n 1)))", ep);
|
||||
check_kind ("map-yields-list", "(mp inc '(1 2 3))", valkind.CONS, ep);
|
||||
check_int ("map-car", "(car (mp inc '(1 2 3)))", 2i64, ep);
|
||||
|
||||
// ---- let + begin ----
|
||||
check_int ("let-product", "(let ((a 3) (b 4)) (* a b))", 12i64, ep);
|
||||
check_int ("begin-last", "(begin 1 2 (+ 10 20))", 30i64, ep);
|
||||
|
||||
// ---- floats ----
|
||||
check_float("float-add", "(+ 1.5 2.5)", 4.0, ep);
|
||||
check_float("float-mul", "(* 0.5 0.5)", 0.25, ep);
|
||||
check_float("float-div", "(/ 22.0 7.0)", 3.142857, ep);
|
||||
check_float("float-promote", "(+ 1 2.5)", 3.5, ep);
|
||||
check_bool ("float-cmp", "(< 1.0 2.0)", true, ep);
|
||||
|
||||
// ---- 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);
|
||||
|
||||
// ---- summary ----
|
||||
let buf: [32]u8;
|
||||
let n: i32 = 0;
|
||||
if (nfail == 0) {
|
||||
os.write(1, "\nlisp_test: ".ptr, 12u64);
|
||||
n = strconv.i64tos(buf[0:32], ntotal: i64);
|
||||
os.write(1, buf.ptr, n: u64);
|
||||
os.write(1, "/".ptr, 1u64);
|
||||
os.write(1, buf.ptr, n: u64);
|
||||
os.write(1, " pass\n".ptr, 6u64);
|
||||
return 0;
|
||||
};
|
||||
os.write(2, "\nlisp_test: ".ptr, 12u64);
|
||||
n = strconv.i64tos(buf[0:32], nfail: i64);
|
||||
os.write(2, buf.ptr, n: u64);
|
||||
os.write(2, " of ".ptr, 4u64);
|
||||
n = strconv.i64tos(buf[0:32], ntotal: i64);
|
||||
os.write(2, buf.ptr, n: u64);
|
||||
os.write(2, " failed\n".ptr, 8u64);
|
||||
return 1;
|
||||
};
|
||||
Reference in New Issue
Block a user