Hojun-Cho/ww
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

examples: lisp — pure-ww Lisp interpreter, REPL, in-process tests

Browse Source 
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:
Hojun-Cho
2026-05-12 22:33:24 +09:00
parent b7893916a3
commit ab173b095a
11 changed files with 2288 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

154
examples/lisp/CLAUDE.md Normal file
View File

@@ -0,0 +1,154 @@
examples/lisp — tiny Lisp interpreter in pure ww. Demo program; not a
production interpreter. Treat the files below as a worked example of
"what does and doesn't lower cleanly through the wwstage cgen today",
not as a reference Lisp implementation.
## Layout
- `lispcore.ww` interpreter module: types, lexer, parser, env,
eval, apply, printer, REPL. Everything the entry
point and the test driver consume is `export`-ed.
- `lisp.ww` entry point; `use lispcore;` + `main()`.
- `lisp_test.ww` in-process test driver (66 probes). Built as a
standalone binary, exec'd directly — `ww test`
drops `-I` in single-file mode, so the Makefile
runs the binary itself.
- `test_*.lisp` demo source files (`cat test_X.lisp | ./lisp`).
The lispcore.ww + lisp.ww split exists so the tests can `use` the
interpreter functions. Both files combine under the same module name
(the directory's basename, `lisp`), because `ww`'s module resolver
takes the *containing-directory* basename when finding a sibling.
Cross-module type prefixes like `lispcore.value` don't resolve in the
test — use the bare names.
## wwstage cgen workarounds at play
Every workaround below is documented inline at its use site. The
shape of the bug is what matters, not the specific symptom — the
same bug class shows up in any new code that hits the same pattern.
1. **Top-level `[N]T` arrays mis-address inside functions.**
`globalarr[i] = …` lowers to `LEAQ (BP), BX` instead of
`LEAQ globalarr(SB), BX` — the global address gets treated as a
stack frame, corrupting both. Heap-allocate via `os.alloc` into a
`*T` and alias to a local at the top of each function before
indexing. See `sym_off` / `sym_blob` / `obuf`.
2. **`global_ptr[i]` mis-addresses too.** Even after switching to a
pointer global, `MOVQ global_ptr(SB), BX` is replaced with
`MOVQ (BP), BX`. Alias `let p = global_ptr;` at function entry,
then `p[i]`. See every helper that touches the symbol interner.
3. **Two-level field write through a non-pointer sub-struct.**
`L.cur.kind = k` or `L.src.ptr = buf.ptr` (where `cur`/`src` is a
non-pointer struct field of a struct reached through a pointer) is
silently dropped — the function body emits no store. Either
flatten the sub-struct (see `lexer.curkind`/`curival`/…) or build
the whole sub-struct as a local and do a single whole-struct
assign (`let s: str = …; L.src = s;`).
4. **f64 through every boundary is unreliable.** The cgen routes f64
stores via integer registers; in most paths AX gets stored where
X0 should have been written.
- `alloc(value{ fval = v })`: writes the kind enum (AX still
holds it) instead of the f64.
- `p.fval = v` through a `*T`: same — stores AX.
- `*p = v` for `*f64`: stores AX.
- `func(f64_arg)` where the source is a struct field: cgen does
`MOVQ off(BX), AX` (integer load) and never puts the bits in X0.
What does work: `MOVSD X0, global(SB)` (a top-level f64 global)
and `MOVSD X0, off(BP)` (a local f64 slot). The interpreter
threads f64 through a scratch global (`fbuf`) and byte-copies
8 bytes wherever a `*f64` would normally suffice. See `vfloat`,
`to_f64`, `copybytes`.
5. **`alloc(value{ text = s })` writes only `s.ptr`.** The cgen sets
up `s.ptr` in AX, sets the new-pointer in BX, then needs `s.len`
in another reg — but the same BX gets clobbered by the new-pointer
reload, so the `.len` store never happens. Manual init via
`p.text = s` writes both halves correctly.
6. **`(slice | E)` tagged-union returns drop `slice.len`.** The
wwstage return convention is AX=tag, DX=payload1, CX=payload2. A
slice header is 24 bytes (ptr/len/cap); only ptr and cap come
through in DX/CX. The intermediate `BX = s.len` is loaded but
never moved into a return register. Inline the slice-building
loop into the caller instead of factoring it into a helper. See
`eval`'s argument-eval inline.
7. **`xs[i].kind` drops the trailing field load.** Field access on a
slice element gives back only the bytes at `&xs[i]` — the cgen
doesn't chain the dereference. Bind to a local first:
`let p = xs[i]; if (p.kind …)`. See every builtin.
8. **f64 compound assigns are mis-lowered to `acc = d` (no OP).**
`acc += f` / `acc /= f` etc. on f64 locals drop the operator.
Write the explicit form: `acc = acc + f` / `acc = acc / f`.
Integer compound assigns work fine, so `acc += i` on `i64`
stays as-is.
If a new function "should work but acts weird", the bug is almost
always one of the above and shows up under valgrind/gdb the same
way it did the first time: silently dropped store, missing field
read, garbage payload after a tagged-union return.
## Interpreter limitations (design, not bug)
- **No GC.** Every cons / value / env frame is `mmap`'d via
`rt_alloc` and never reclaimed. A long REPL session leaks until
the process exits. The test_huge demo peaks at ~595 MB under
`--pages-as-heap=yes`. Per-top-level-form arena reset would cut
this by ~100× — see the closing note in `repl()` for the hook
point.
- **No tail-call optimization.** Recursion grows the C-side stack
one frame per Lisp call. `(spin 100000 0)` will eventually stack-
overflow even though it's tail-recursive in source.
- **No bigints.** `i64` wraps silently on overflow. `(fact 21)`
rolls over.
- **Float printing is fixed `%.6f`.** `1.0` prints as `1.000000`.
Strconv has no `ftos` yet.
- **String escapes are accepted but not translated.** `"\n"` in
source lands as the two bytes `\\` + `n`, not a newline.
- **No `(load)` / file I/O builtins.** Programs come in via stdin.
## Latent issues — not observed, but the surface to watch
- Other i64 compound assigns in the cgen aren't audited site-by-site.
Workaround #8 covers f64; if you add new arithmetic on integers
inside a hot loop, scan the asm.
- The interactive REPL's `shift_buf(L.curstart)` assumes `parse_expr`
always primes exactly one token of lookahead after returning success.
A future parser change that skips that prime silently eats input.
- The `define` tie-back prepends a self-binding frame onto
`bv.envp`. It assumes constructors always initialize `envp`. They
do today.
- Cross-module type names (`lispcore.value`) don't resolve; we
side-step by using bare names. If `ww`'s module resolver starts
honoring the qualified form, the tests still work — but if it
starts *rejecting* unqualified cross-module references, both
files break.
## Build / test / profile
```
make # build ./lisp
make test # build + run lisp_test (66 in-process probes)
make demo # cat each test_*.lisp through ./lisp
make clean
```
Demo files are pipe-driven: `cat test_arith.lisp | ./lisp`.
Valgrind:
```
valgrind --error-exitcode=2 ./lisp < test_huge.lisp
valgrind --tool=massif --pages-as-heap=yes ./lisp < test_huge.lisp
```
The memcheck leak counter reads "0 allocs / 0 frees" because
`rt_alloc` is `mmap`, not `malloc`. Memcheck still catches uninit
reads, bad accesses, and stack issues. For real heap-shape analysis
use massif with `--pages-as-heap=yes`.

48
examples/lisp/Makefile Normal file
View File

@@ -0,0 +1,48 @@
# examples/lisp — tiny Lisp interpreter, built with the ww toolchain.
# No FFI: the program lives entirely on lib/* and libwwrt.a.
#
# Layout
# lisp.ww entry point. `use lispcore;` + `main()` = repl().
# lispcore.ww interpreter module. Types/functions are `export`-ed
# so both lisp.ww and lisp_test.ww consume them via
# the same `use lispcore;`.
# lisp_test.ww in-process test driver, executed by `make test`
# (which invokes `ww test`).
#
# `ww`'s module resolver uses the *directory's basename* as the module
# name when finding `lispcore.ww` through `-I <dir>`. Passing the
# absolute path of the current directory keeps that name stable
# (otherwise `-I.` collapses to ".", and the cgen mangles symbols as
# `..helper`, which then breaks the assembler).
WW := $(shell cd ../..; pwd)/out/bin/ww
HERE := $(shell pwd)
lisp: lisp.ww lispcore.ww
$(WW) build lisp.ww -I $(HERE)
# `ww test <file.ww>` in single-file mode discards extra args, so we
# can't pass `-I` through it. Build the test as a normal binary and
# exec it directly — exit 0 means all probes passed.
test: lisp_test lisp
./lisp_test
lisp_test: lisp_test.ww lispcore.ww
$(WW) build lisp_test.ww -I $(HERE)
# Demo programs in tree. `make demo` runs every test_*.lisp through
# the REPL; each prints its results to stdout (errors go to stderr
# and don't break the run). Useful as a smoke check after edits.
DEMOS := test_arith.lisp test_list.lisp test_lambda.lisp test_error.lisp
demo: lisp
@for f in $(DEMOS); do \
echo "==> $$f"; \
./lisp < $$f; \
done
clean:
rm -f lisp lisp.o lisp.s lisp.combined.ww \
lisp_test lisp_test.o lisp_test.s lisp_test.combined.ww
.PHONY: clean test demo

10
examples/lisp/lisp.ww Normal file
View File

@@ -0,0 +1,10 @@
// lisp — entry point. The interpreter lives in `lispcore.ww`; this
// file only wires it to `main()` so `ww build lisp.ww` produces the
// REPL binary. The matching tests live in `lisp_test.ww` and pull
// the same module via `use lispcore;`.
use lispcore;
export fn main() i32 = {
return lispcore.repl();
};

299
examples/lisp/lisp_test.ww Normal file
View 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;
};

1469
examples/lisp/lispcore.ww Normal file
View File

File diff suppressed because it is too large Load Diff

26
examples/lisp/test_arith.lisp Normal file
View File

@@ -0,0 +1,26 @@
; test_arith.lisp — arithmetic and comparisons.
; Run: cat test_arith.lisp | ./lisp
;
; Each form's expected result is in the trailing comment.
(+ 1 2 3 4 5) ; => 15
(* 6 7) ; => 42
(- 100 25 25) ; => 50
(/ 100 5) ; => 20
(/ 1000 10 5) ; => 20
(mod 17 5) ; => 2
(- 7) ; => -7
(+ (* 2 3) (* 4 5)) ; => 26
(+ (- 50 10) (* 2 5)) ; => 50
(= 5 5) ; => #t
(= 5 6) ; => #f
(< 1 2 3 4) ; => #t
(<= 3 3 4) ; => #t
(> 5 3 1) ; => #t
; mixed int/float — int operands auto-promote
(+ 1 2.5) ; => 3.5
(* 2 3.0) ; => 6.0
(/ 22.0 7.0) ; => 3.142857

18
examples/lisp/test_error.lisp Normal file
View File

@@ -0,0 +1,18 @@
; test_error.lisp — runtime errors. Each form should produce
; `error: <message>` on stderr; the REPL keeps going and prints
; surviving results on stdout.
;
; Run: cat test_error.lisp | ./lisp
undefined-symbol ; error: unbound symbol
(car 1) ; error: car: not a pair
(cdr '()) ; error: cdr: not a pair
(/ 5 0) ; error: divide by zero
(mod 7 0) ; error: mod by zero
(+ 'a 'b) ; error: expected number
(car) ; error: car: need 1 arg
(cons 1) ; error: cons: need 2 args
; sanity: the REPL recovers — these should print normally.
(+ 1 2) ; => 3
"still alive" ; => "still alive"

167
examples/lisp/test_huge.lisp Normal file
View File

@@ -0,0 +1,167 @@
; test_huge.lisp — broad workout for the interpreter. Each section
; defines a set of helpers and then exercises them, so the same
; program touches arithmetic, list-building, closures, recursion,
; tail calls, and a few short-loop computations.
;
; Run: cat test_huge.lisp | ./lisp
; Profile: valgrind --tool=massif --pages-as-heap=yes ./lisp < test_huge.lisp
;; -- core helpers --------------------------------------------------------
(define inc (lambda (n) (+ n 1)))
(define dec (lambda (n) (- n 1)))
(define neg (lambda (n) (- 0 n)))
(define abs (lambda (n) (if (< n 0) (- 0 n) n)))
(define square (lambda (n) (* n n)))
(define cube (lambda (n) (* n n n)))
(define even? (lambda (n) (= 0 (mod n 2))))
(define odd? (lambda (n) (not (even? n))))
;; -- list utilities ------------------------------------------------------
(define len (lambda (l)
(if (null? l) 0 (+ 1 (len (cdr l))))))
(define nth (lambda (l n)
(if (= n 0) (car l) (nth (cdr l) (- n 1)))))
(define last (lambda (l)
(if (null? (cdr l)) (car l) (last (cdr l)))))
(define reverse-onto (lambda (l acc)
(if (null? l) acc (reverse-onto (cdr l) (cons (car l) acc)))))
(define reverse (lambda (l) (reverse-onto l '())))
(define append2 (lambda (a b)
(if (null? a) b (cons (car a) (append2 (cdr a) b)))))
(define map (lambda (f l)
(if (null? l) '() (cons (f (car l)) (map f (cdr l))))))
(define filter (lambda (p l)
(if (null? l) '()
(if (p (car l))
(cons (car l) (filter p (cdr l)))
(filter p (cdr l))))))
(define reduce (lambda (f acc l)
(if (null? l) acc (reduce f (f acc (car l)) (cdr l)))))
(define iota (lambda (n)
(if (= n 0) '() (cons n (iota (- n 1))))))
(define range (lambda (n) (reverse (iota n))))
;; -- numeric helpers -----------------------------------------------------
(define max2 (lambda (a b) (if (> a b) a b)))
(define min2 (lambda (a b) (if (< a b) a b)))
(define max-list (lambda (l) (reduce max2 (car l) (cdr l))))
(define min-list (lambda (l) (reduce min2 (car l) (cdr l))))
(define sum (lambda (l) (reduce + 0 l)))
(define product (lambda (l) (reduce * 1 l)))
(define gcd (lambda (a b)
(if (= b 0) a (gcd b (mod a b)))))
(define lcm (lambda (a b) (/ (* a b) (gcd a b))))
;; -- recursive showpieces ------------------------------------------------
(define fact (lambda (n)
(if (<= n 1) 1 (* n (fact (- n 1))))))
(define fib (lambda (n)
(if (< n 2) n (+ (fib (- n 1)) (fib (- n 2))))))
(define ack (lambda (m n)
(if (= m 0) (+ n 1)
(if (= n 0) (ack (- m 1) 1)
(ack (- m 1) (ack m (- n 1)))))))
;; -- closures (let / let-over-lambda) -----------------------------------
(define adder (lambda (k) (lambda (x) (+ x k))))
(define muller (lambda (k) (lambda (x) (* x k))))
(define counter (lambda () (begin (define c 0) (lambda () (begin (set! c (+ c 1)) c)))))
(define add1 (adder 1))
(define add10 (adder 10))
(define add100 (adder 100))
(define dbl (muller 2))
(define triple (muller 3))
;; -- exercise the helpers -----------------------------------------------
(map inc '(1 2 3 4 5)) ; => (2 3 4 5 6)
(map square '(1 2 3 4 5 6 7 8 9 10)) ; => (1 4 9 ... 100)
(filter even? '(1 2 3 4 5 6 7 8 9 10)) ; => (2 4 6 8 10)
(filter odd? (range 12)) ; => (1 3 5 7 9 11)
(sum (range 100)) ; => 5050
(sum (map square (range 10))) ; => 385
(product '(1 2 3 4 5 6 7)) ; => 5040
(max-list '(3 1 4 1 5 9 2 6 5 3 5)) ; => 9
(min-list '(3 1 4 1 5 9 2 6 5 3 5)) ; => 1
(len (range 50)) ; => 50
(nth (range 30) 17) ; => 18
(last (range 25)) ; => 25
(reverse (range 8)) ; => (8 7 6 5 4 3 2 1)
(append2 '(1 2 3) '(a b c)) ; => (1 2 3 a b c)
(append2 (range 4) (reverse (range 4))) ; => (1 2 3 4 4 3 2 1)
;; -- gcd / lcm batch ----------------------------------------------------
(gcd 1024 768) ; => 256
(gcd 12345 54321) ; => 3
(gcd 1000003 1000033) ; => 1
(lcm 12 18) ; => 36
(lcm 7 11) ; => 77
;; -- factorials ----------------------------------------------------------
(fact 1) ; => 1
(fact 5) ; => 120
(fact 10) ; => 3628800
(fact 15) ; => 1307674368000
(fact 20) ; => 2432902008176640000
;; -- fibonacci (exponential — sized for ~few sec under massif) ---------
(fib 5) ; => 5
(fib 10) ; => 55
(fib 15) ; => 610
(fib 18) ; => 2584
;; -- ackermann -----------------------------------------------------------
(ack 2 2) ; => 7
(ack 2 4) ; => 11
(ack 3 3) ; => 61
;; -- closure exercise ---------------------------------------------------
(add1 41) ; => 42
(add10 92) ; => 102
(add100 1) ; => 101
(dbl 21) ; => 42
(triple 14) ; => 42
(map add10 '(1 2 3 4 5)) ; => (11 12 13 14 15)
(map dbl (range 6)) ; => (2 4 6 8 10 12)
;; -- mixed pipeline (filter → map → reduce) -----------------------------
(define pipeline (lambda (l)
(reduce + 0 (map square (filter even? l)))))
(pipeline (range 10)) ; even squares 1..10 = 4+16+36+64+100 = 220
(pipeline (range 20)) ; even squares 1..20
(pipeline (range 30))
;; -- tail-recursive spin -------------------------------------------------
(define spin (lambda (n acc)
(if (= n 0) acc (spin (- n 1) (+ acc 1)))))
(spin 200 0) ; => 200
(spin 500 0) ; => 500
(spin 1000 0) ; => 1000
;; -- mutual-flavored recursion ------------------------------------------
(define ev? (lambda (n) (if (= n 0) #t (od? (- n 1)))))
(define od? (lambda (n) (if (= n 0) #f (ev? (- n 1)))))
(ev? 12) ; => #t
(od? 13) ; => #t
(ev? 27) ; => #f
;; -- final sanity -------------------------------------------------------
(+ (fact 6) (fib 14) (gcd 60 24)) ; 720 + 377 + 12 = 1109
(reduce + 0 (map (lambda (n) (* n n)) (range 20))) ; 1+4+9+...+400 = 2870
"all done"

63
examples/lisp/test_lambda.lisp Normal file
View File

@@ -0,0 +1,63 @@
; test_lambda.lisp — lambdas, define, recursion, higher-order.
; Run: cat test_lambda.lisp | ./lisp
; one-liner lambda
((lambda (n) (* n n)) 7) ; => 49
; named function
(define square (lambda (n) (* n n)))
(square 9) ; => 81
(square 12) ; => 144
; classic recursion
(define fact (lambda (n)
(if (<= n 1) 1
(* n (fact (- n 1))))))
(fact 5) ; => 120
(fact 10) ; => 3628800
(fact 12) ; => 479001600
(define fib (lambda (n)
(if (< n 2) n
(+ (fib (- n 1)) (fib (- n 2))))))
(fib 10) ; => 55
(fib 15) ; => 610
(fib 20) ; => 6765
(define gcd (lambda (a b)
(if (= b 0) a
(gcd b (mod a b)))))
(gcd 60 48) ; => 12
(gcd 1024 768) ; => 256
; higher-order: map / filter / reduce
(define map (lambda (f l)
(if (null? l) '()
(cons (f (car l)) (map f (cdr l))))))
(define filter (lambda (p l)
(if (null? l) '()
(if (p (car l))
(cons (car l) (filter p (cdr l)))
(filter p (cdr l))))))
(define reduce (lambda (f acc l)
(if (null? l) acc
(reduce f (f acc (car l)) (cdr l)))))
(define inc (lambda (n) (+ n 1)))
(define even? (lambda (n) (= (mod n 2) 0)))
(map inc '(1 2 3 4 5)) ; => (2 3 4 5 6)
(filter even? '(1 2 3 4 5 6)) ; => (2 4 6)
(reduce + 0 '(1 2 3 4 5 6 7 8 9 10)) ; => 55
; closure over the captured env
(define adder (lambda (k) (lambda (x) (+ x k))))
(define add5 (adder 5))
(add5 10) ; => 15
(add5 100) ; => 105
; mutual-like with set!
(define c 0)
(set! c 41)
(set! c (+ c 1))
c ; => 42

31
examples/lisp/test_list.lisp Normal file
View File

@@ -0,0 +1,31 @@
; test_list.lisp — pairs, lists, predicates, quoting.
; Run: cat test_list.lisp | ./lisp
'() ; => ()
'(1 2 3) ; => (1 2 3)
'(a b c) ; => (a b c)
(cons 1 2) ; => (1 . 2)
(cons 1 '(2 3)) ; => (1 2 3)
(list 'x 'y 'z) ; => (x y z)
(car '(11 22 33)) ; => 11
(cdr '(11 22 33)) ; => (22 33)
(car (cdr '(1 2 3))) ; => 2
(car (cdr (cdr '(1 2 3)))) ; => 3
(null? '()) ; => #t
(null? '(1)) ; => #f
(pair? '(a)) ; => #t
(pair? 'a) ; => #f
(number? 42) ; => #t
(number? 'foo) ; => #f
(symbol? 'foo) ; => #t
(symbol? 1) ; => #f
(eq? 'a 'a) ; => #t
(eq? 'a 'b) ; => #f
; nested literal
'((1 2) (3 4) (5 6)) ; => ((1 2) (3 4) (5 6))
(car '((a b) (c d))) ; => (a b)