commit 5fff74b2b6690d5978249b062998d4f15eec8697 parent 58a33b2e7a6a07d40af12ff49f42dfdc406192da Author: Ryan Sepassi <rsepassi@gmail.com> Date: Sat, 25 Apr 2026 12:07:04 -0700 rm old lisp code and script Diffstat:
60 files changed, 0 insertions(+), 1067 deletions(-)
diff --git a/lisp/prelude.scm b/lisp/prelude.scm @@ -1,174 +0,0 @@ -;; Prelude — helpers promoted out of lisp.M1 into Scheme for -;; reviewability. Prepended to every user script by the Makefile -;; (cat src/prelude.scm $user.scm > combined.scm) so these names -;; are in scope before user code runs. -;; -;; Only fixed-arity helpers live here — variadic lambdas aren't yet -;; supported by env_extend, so list/append/min/max stay as P1 primitives. - -;; --- Boolean / logical ---------------------------------------------- -(define not - (lambda (x) (if x #f #t))) - -;; --- Arithmetic helpers (derivable from <, =, -) -------------------- -(define <= - (lambda (x y) (if (< y x) #f #t))) - -(define >= - (lambda (x y) (if (< x y) #f #t))) - -(define zero? - (lambda (x) (= x 0))) - -(define negative? - (lambda (x) (< x 0))) - -(define positive? - (lambda (x) (> x 0))) - -(define abs - (lambda (x) (if (< x 0) (- 0 x) x))) - -;; --- Common c*r compositions --------------------------------------- -(define caar (lambda (x) (car (car x)))) -(define cadr (lambda (x) (car (cdr x)))) -(define cdar (lambda (x) (cdr (car x)))) -(define cddr (lambda (x) (cdr (cdr x)))) -(define caddr (lambda (x) (car (cdr (cdr x))))) - -;; --- List helpers (derivable from cons/car/cdr/null?/pair?/eq?) ----- -(define list? - (lambda (x) - (if (null? x) - #t - (if (pair? x) (list? (cdr x)) #f)))) - -(define length-helper - (lambda (xs acc) - (if (null? xs) acc (length-helper (cdr xs) (+ acc 1))))) - -(define length - (lambda (xs) (length-helper xs 0))) - -(define reverse-helper - (lambda (xs acc) - (if (null? xs) acc (reverse-helper (cdr xs) (cons (car xs) acc))))) - -(define reverse - (lambda (xs) (reverse-helper xs (quote ())))) - -(define list-ref - (lambda (xs n) - (if (= n 0) (car xs) (list-ref (cdr xs) (- n 1))))) - -(define assoc - (lambda (key alist) - (if (null? alist) - #f - (if (eq? (car (car alist)) key) - (car alist) - (assoc key (cdr alist)))))) - -(define member - (lambda (x xs) - (if (null? xs) - #f - (if (eq? (car xs) x) - xs - (member x (cdr xs)))))) - -;; --- map / filter / fold / for-each --------------------------------- -(define map - (lambda (f xs) - (if (null? xs) - (quote ()) - (cons (f (car xs)) (map f (cdr xs)))))) - -(define filter - (lambda (p xs) - (if (null? xs) - (quote ()) - (if (p (car xs)) - (cons (car xs) (filter p (cdr xs))) - (filter p (cdr xs)))))) - -(define fold - (lambda (f acc xs) - (if (null? xs) - acc - (fold f (f acc (car xs)) (cdr xs))))) - -(define for-each - (lambda (f xs) - (if (null? xs) - (quote ()) - (begin - (f (car xs)) - (for-each f (cdr xs)))))) - -;; --- Vector <-> list (derivable from make-vector/vector-ref/set) ---- -(define vector->list-helper - (lambda (v i acc) - (if (< i 0) - acc - (vector->list-helper v (- i 1) (cons (vector-ref v i) acc))))) - -(define vector->list - (lambda (v) - (vector->list-helper v (- (vector-length v) 1) (quote ())))) - -(define list->vector-helper - (lambda (v xs i) - (if (null? xs) - v - (begin - (vector-set! v i (car xs)) - (list->vector-helper v (cdr xs) (+ i 1)))))) - -(define list->vector - (lambda (xs) - (list->vector-helper (make-vector (length xs) 0) xs 0))) - -;; --- Structural equality -------------------------------------------- -;; equal? — eq? fast-path, then recurse into pairs, string contents, -;; and vector elements. No cycle detection (matches the pre-move P1 -;; version's policy). -(define equal?-string - (lambda (a b i n) - (if (= i n) - #t - (if (= (string-ref a i) (string-ref b i)) - (equal?-string a b (+ i 1) n) - #f)))) - -(define equal?-vector - (lambda (a b i n) - (if (= i n) - #t - (if (equal? (vector-ref a i) (vector-ref b i)) - (equal?-vector a b (+ i 1) n) - #f)))) - -(define equal? - (lambda (a b) - (if (eq? a b) - #t - (if (pair? a) - (if (pair? b) - (if (equal? (car a) (car b)) - (equal? (cdr a) (cdr b)) - #f) - #f) - (if (string? a) - (if (string? b) - (if (= (string-length a) (string-length b)) - (equal?-string a b 0 (string-length a)) - #f) - #f) - (if (vector? a) - (if (vector? b) - (if (= (vector-length a) (vector-length b)) - (equal?-vector a b 0 (vector-length a)) - #f) - #f) - #f)))))) diff --git a/lisp/shell.scm b/lisp/shell.scm @@ -1,201 +0,0 @@ -;; Shell-style Scheme library: processes and file I/O. -;; -;; Primitives required from the runtime: -;; (sys-exit code) -;; (sys-clone) → (#t . pid) parent, (#t . 0) child, -;; (#f . errno) on failure -;; (sys-execve path argv) → only returns (#f . errno) on failure; -;; parent env is inherited by the child -;; (sys-wait pid) → (ok . raw-wstatus) -;; (sys-openat dirfd path flags mode) → (ok . fd) -;; (sys-close fd) → (ok . _) -;; (sys-read fd buf count) → (ok . nread), fills buf[0..nread] -;; (sys-write fd buf count) → (ok . nwritten), writes buf[0..count] -;; (sys-argv) → list of bytevectors (argv[0..]); -;; cannot fail, not wrapped in (ok . val) -;; -;; All wrappers that touch syscalls return a pair (ok . val): -;; ok = #t → val is the result -;; ok = #f → val is an errno - -;; ============================================================ -;; processes -;; ============================================================ - -(define (spawn prog . args) - (let ((r (sys-clone))) - (cond - ((not (car r)) r) - ((zero? (cdr r)) - (sys-execve prog (cons prog args)) - (sys-exit 127)) - (else r)))) - -(define (wait pid) - (let ((r (sys-wait pid))) - (if (car r) - (cons #t (decode-wait-status (cdr r))) - r))) - -(define (run prog . args) - (let ((r (apply spawn prog args))) - (if (car r) (wait (cdr r)) r))) - -(define (exit . rest) - (sys-exit (if (null? rest) 0 (car rest)))) - -(define (argv) (sys-argv)) - -;; POSIX wstatus → shell-style code (128+sig for signal termination). -(define (decode-wait-status s) - (let ((termsig (bit-and s #x7f))) - (if (zero? termsig) - (bit-and (arithmetic-shift s -8) #xff) - (+ 128 termsig)))) - -;; ============================================================ -;; file I/O -;; ============================================================ - -(define BUFSIZE 4096) -(define AT_FDCWD -100) -(define O_RDONLY 0) -(define O_WRONLY 1) -(define O_CREAT #x40) ; 0o100 -(define O_TRUNC #x200) ; 0o1000 -(define O_APPEND #x400) ; 0o2000 -(define MODE_644 #x1a4) ; 0o644 -(define NL-BYTE 10) -(define NL-BV (make-bytevector 1 10)) - -(define-record-type port - (%port fd buf pos end) - port? - (fd port-fd) - (buf port-buf) - (pos port-pos port-pos-set!) - (end port-end port-end-set!)) - -(define stdin (%port 0 (make-bytevector BUFSIZE) 0 0)) -(define stdout (%port 1 #f 0 0)) -(define stderr (%port 2 #f 0 0)) - -(define (open-input path) - (let ((r (sys-openat AT_FDCWD path O_RDONLY 0))) - (if (car r) - (cons #t (%port (cdr r) (make-bytevector BUFSIZE) 0 0)) - r))) - -(define (open-output path) - (let ((r (sys-openat AT_FDCWD path - (bit-or O_WRONLY O_CREAT O_TRUNC) MODE_644))) - (if (car r) (cons #t (%port (cdr r) #f 0 0)) r))) - -(define (open-append path) - (let ((r (sys-openat AT_FDCWD path - (bit-or O_WRONLY O_CREAT O_APPEND) MODE_644))) - (if (car r) (cons #t (%port (cdr r) #f 0 0)) r))) - -(define (close p) (sys-close (port-fd p))) - -;; ----- reads ----- - -(define (refill! p) - (let ((r (sys-read (port-fd p) (port-buf p) BUFSIZE))) - (cond - ((not (car r)) r) - (else (port-pos-set! p 0) - (port-end-set! p (cdr r)) - r)))) - -(define (read-bytes p n) - (let ((out (make-bytevector n))) - (let loop ((i 0)) - (cond - ((= i n) (cons #t out)) - ((< (port-pos p) (port-end p)) - (let* ((avail (- (port-end p) (port-pos p))) - (take (if (< avail (- n i)) avail (- n i)))) - (bytevector-copy! out i (port-buf p) (port-pos p) take) - (port-pos-set! p (+ (port-pos p) take)) - (loop (+ i take)))) - (else - (let ((r (refill! p))) - (cond - ((not (car r)) r) - ((zero? (cdr r)) - (cons #t (if (zero? i) (eof-object) (bytevector-copy out 0 i)))) - (else (loop i))))))))) - -(define (read-line p) - (let loop ((acc '())) - (cond - ((< (port-pos p) (port-end p)) - (let* ((buf (port-buf p)) - (start (port-pos p)) - (end (port-end p))) - (let scan ((i start)) - (cond - ((= i end) - (port-pos-set! p i) - (loop (cons (bytevector-copy buf start i) acc))) - ((= (bytevector-u8-ref buf i) NL-BYTE) - (port-pos-set! p (+ i 1)) - (cons #t (bv-concat-reverse - (cons (bytevector-copy buf start i) acc)))) - (else (scan (+ i 1))))))) - (else - (let ((r (refill! p))) - (cond - ((not (car r)) r) - ((zero? (cdr r)) - (cons #t (if (null? acc) (eof-object) (bv-concat-reverse acc)))) - (else (loop acc)))))))) - -(define (read-all p) - (let loop ((acc '())) - (cond - ((< (port-pos p) (port-end p)) - (let ((chunk (bytevector-copy (port-buf p) - (port-pos p) (port-end p)))) - (port-pos-set! p (port-end p)) - (loop (cons chunk acc)))) - (else - (let ((r (refill! p))) - (cond - ((not (car r)) r) - ((zero? (cdr r)) (cons #t (bv-concat-reverse acc))) - (else (loop acc)))))))) - -(define (bv-concat-reverse chunks) - (let* ((xs (reverse chunks)) - (total (let sum ((ys xs) (n 0)) - (if (null? ys) n - (sum (cdr ys) (+ n (bytevector-length (car ys))))))) - (out (make-bytevector total))) - (let loop ((ys xs) (i 0)) - (if (null? ys) - out - (let ((len (bytevector-length (car ys)))) - (bytevector-copy! out i (car ys) 0 len) - (loop (cdr ys) (+ i len))))))) - -;; ----- writes (unbuffered; handle partial writes) ----- - -(define (write-bytes p bv) - (let loop ((bv bv) (total 0)) - (let ((len (bytevector-length bv))) - (if (zero? len) - (cons #t total) - (let ((r (sys-write (port-fd p) bv len))) - (cond - ((not (car r)) r) - ((= (cdr r) len) (cons #t (+ total len))) - (else (loop (bytevector-copy bv (cdr r) len) - (+ total (cdr r)))))))))) - -(define write-string write-bytes) - -(define (write-line p s) - (let ((r (write-bytes p s))) - (if (car r) (write-bytes p NL-BV) r))) diff --git a/scripts/refactor-m1pp-bss.py b/scripts/refactor-m1pp-bss.py @@ -1,205 +0,0 @@ -#!/usr/bin/env python3 -"""One-shot M1pp.P1 BSS refactor. - -Identifies labels in M1pp/M1pp.P1 whose body is one or more ZERO32 lines -(the big BSS-style buffers). Moves them out of the file into BSS: - -* Removes the label declarations + their ZERO32 padding. -* Adds an OFFSET DEFINE for each buffer (offset from BSS_BASE, the byte - past ELF_end). -* Adds a per-buffer 8-byte pointer slot in the in-file data area - (input_buf_ptr, output_buf_ptr, ...). -* Adds initialization code at the top of p1_main that computes each base - pointer once and stores it into its slot. -* Rewrites every `la_<reg> &<buf>` in code to `la_<reg> &<buf>_ptr; - ld_<reg>,<reg>,0` (cached-pointer indirection — same dest reg, no - scratch needed). - -Run: python3 scripts/refactor-m1pp-bss.py -""" - -import re -import sys -from pathlib import Path - -SRC = Path('M1pp/M1pp.P1') -text = SRC.read_text() -lines = text.split('\n') - -# --- Pass 1: identify BSS buffers (label followed by ZERO32 lines). ---------- - -buffers = [] # (name, start_idx, end_idx_exclusive, zero32_count) -i = 0 -while i < len(lines): - line = lines[i].strip() - m = re.match(r':([A-Za-z_][A-Za-z0-9_]*)$', line) - if m: - label = m.group(1) - # scan forward to find ZERO32 lines (allowing intermediate blank/comment) - j = i + 1 - zero32_count = 0 - while j < len(lines): - stripped = lines[j].strip() - if stripped.startswith('ZERO32'): - zero32_count += stripped.split().count('ZERO32') - j += 1 - elif stripped == '' or stripped.startswith('#') or stripped.startswith(';'): - # Comments/blank — peek further - k = j + 1 - while k < len(lines) and (lines[k].strip() == '' or lines[k].strip().startswith('#')): - k += 1 - if k < len(lines) and lines[k].strip().startswith('ZERO32'): - j = k - continue - break - else: - break - if zero32_count > 0: - buffers.append((label, i, j, zero32_count)) - i = j - continue - i += 1 - -# --- Pass 2: compute layout. ------------------------------------------------- - -layout = [] -offset = 0 -for name, _, _, count in buffers: - size = count * 32 - layout.append((name, offset, size)) - offset += size - -bss_total = offset -print(f"Found {len(buffers)} BSS buffers, total {bss_total} bytes ({bss_total/1024:.1f} KB)") -for name, off, size in layout: - print(f" {name:25s} off=0x{off:08x} size={size:9d}") - -# --- Pass 3: build the rewrite. ---------------------------------------------- - -def le_u64(value: int) -> str: - """Encode a non-negative int as 8 bytes little-endian hex.""" - assert 0 <= value < (1 << 64) - return ''.join(f'{(value >> (8*k)) & 0xff:02x}' for k in range(8)).upper() - -# 3a. Generate OFFSET DEFINEs. -offset_defines = ['## --- BSS layout (offsets from ELF_end) -------------------------------------'] -for name, off, _ in layout: - offset_defines.append(f'DEFINE OFF_{name} {le_u64(off)}') -offset_defines.append('') - -# 3b. Generate pointer slots (8 bytes each, ZERO8). -ptr_slots = ['## --- BSS pointer slots (set by p1_main; one per BSS buffer) -----------------'] -for name, _, _ in layout: - ptr_slots.append(f':{name}_ptr') - ptr_slots.append('ZERO8') -ptr_slots.append('') - -# 3c. Generate init code (computes ELF_end + offset, stores into each slot). -init_code = [' # --- init BSS pointer slots from ELF_end ---------------------------------'] -init_code.append(' la_t0 &ELF_end') -for name, off, _ in layout: - if off == 0: - init_code.append(f' la_t1 &{name}_ptr') - init_code.append(f' st_t0,t1,0 # {name}_ptr = ELF_end') - else: - init_code.append(f' li_t1 OFF_{name}') - init_code.append(f' add_t1,t0,t1') - init_code.append(f' la_t2 &{name}_ptr') - init_code.append(f' st_t1,t2,0 # {name}_ptr = ELF_end + OFF_{name}') -init_code.append(' # --- end BSS init -------------------------------------------------------') -init_code.append('') - -# --- Pass 4: rewrite the file. ----------------------------------------------- - -# Build a mask of lines to delete (the BSS buffer blocks). -delete_mask = [False] * len(lines) -for _, start, end in [(n, s, e) for (n, s, e, _) in buffers]: - for k in range(start, end): - delete_mask[k] = True - -# Find p1_main and the line right after enter_0 (insertion point for init code). -p1_main_idx = None -for k, ln in enumerate(lines): - if ln.strip() == ':p1_main': - p1_main_idx = k - break -assert p1_main_idx is not None, 'no :p1_main label' -# Find first non-blank/non-comment line after enter_0. -init_insert_idx = None -for k in range(p1_main_idx + 1, len(lines)): - if 'enter_0' in lines[k]: - init_insert_idx = k + 1 - break -assert init_insert_idx is not None, 'no enter_0 after :p1_main' - -# Find :ELF_end (insertion point for ptr_slots — just before). -elf_end_idx = None -for k, ln in enumerate(lines): - if ln.strip() == ':ELF_end': - elf_end_idx = k - break -assert elf_end_idx is not None - -# Find the constants section to insert OFFSET DEFINEs (after the last sizing -# DEFINE, which I'll detect as the last DEFINE EXPR_INVALID). -defines_insert_idx = None -for k, ln in enumerate(lines): - if ln.strip() == 'DEFINE EXPR_INVALID 1200000000000000': - defines_insert_idx = k + 1 - break -assert defines_insert_idx is not None - -# Build the new line list. Process in reverse so insert indices stay valid. -out = list(lines) - -# Insert ptr_slots just before :ELF_end. -out[elf_end_idx:elf_end_idx] = ptr_slots - -# Then we need to delete buffer blocks. But the delete mask refers to the -# original `lines` indices; ptr_slots insertion shifted later indices. To -# avoid that, do all index-based work on the original `lines`, then assemble -# at the end. - -# Restart with a clean approach. -out = [] -buffer_names = {b[0] for b in buffers} -for k, ln in enumerate(lines): - if delete_mask[k]: - continue - out.append(ln) - if k == defines_insert_idx - 1: - out.extend(offset_defines) - if k == init_insert_idx - 1: - out.extend(init_code) - if k == elf_end_idx - 1: - out.extend(ptr_slots) - -# --- Pass 5: rewrite all `la_<reg> &<buf>` references. ----------------------- - -# Pattern: optional indent, "la_<reg> &<buf>", optional comment. -# Replace with two lines: la_<reg> &<buf>_ptr ; ld_<reg>,<reg>,0 -la_re = re.compile(r'^(\s*)la_([a-z][a-z0-9]+) &(' + '|'.join(re.escape(n) for n in buffer_names) + r')\b(.*)$') - -rewritten = [] -ref_count = 0 -for ln in out: - m = la_re.match(ln) - if m: - indent, reg, name, tail = m.group(1), m.group(2), m.group(3), m.group(4) - rewritten.append(f'{indent}la_{reg} &{name}_ptr{tail}') - rewritten.append(f'{indent}ld_{reg},{reg},0') - ref_count += 1 - else: - rewritten.append(ln) - -print(f"Rewrote {ref_count} la_<reg> &<buf> references.") - -# --- Pass 6: write back. ----------------------------------------------------- - -new_text = '\n'.join(rewritten) -SRC.write_text(new_text) - -old_lines = len(lines) -new_lines = len(rewritten) -print(f"M1pp.P1 lines: {old_lines} -> {new_lines} ({new_lines-old_lines:+d})") -print(f"M1pp.P1 bytes: {len(text)} -> {len(new_text)} ({len(new_text)-len(text):+d})") diff --git a/tests/lisp/00-identity.expected b/tests/lisp/00-identity.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/00-identity.scm b/tests/lisp/00-identity.scm @@ -1,2 +0,0 @@ -(define id (lambda (x) x)) -(id 42) diff --git a/tests/lisp/07-tailcall.expected b/tests/lisp/07-tailcall.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/07-tailcall.scm b/tests/lisp/07-tailcall.scm @@ -1,32 +0,0 @@ -;; Step-7 tail-call smoke test. Exercises every tail-position rewrite -;; in eval/apply: -;; eval_pair → apply application -;; apply → eval body closure body -;; eval_if → eval then/else if-branch tail -;; eval_begin → eval last begin last-form tail -;; eval_sym → lookup symbol resolution -;; eval_lambda → make_closure lambda evaluation -;; eval_quote → car quote evaluation -;; eval_args → cons non-empty arg list -;; -;; Four closures are chained by mutual tail-call (a→b→c→d); d's body -;; combines if + begin + quote + symbol lookup to reach the remaining -;; tail positions in a single go. -;; -;; The LISP.md §"Staged implementation plan" step 7 stress of 10^6 -;; self-calls with flat P1 stack needs an arithmetic primitive to -;; decrement a bounded counter (or a step counter in the interpreter). -;; Both are out of scope for step 7: primitives land at step 10, and -;; the interpreter stays free of per-eval instrumentation. This test -;; therefore covers correctness, not raw depth — the flat-stack claim -;; falls out from the TAIL_Nk op semantics proven in demo.M1. - -(define a (lambda (x) (b x))) -(define b (lambda (x) (c x))) -(define c (lambda (x) (d x))) -(define d (lambda (x) - (if x - (begin (quote ignored) x) - 0))) - -(a 42) diff --git a/tests/lisp/10-arith.expected b/tests/lisp/10-arith.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/10-arith.scm b/tests/lisp/10-arith.scm @@ -1,17 +0,0 @@ -;; Step-10c arithmetic primitives: + - * / %. -;; -;; `+` and `*` are variadic (identity on 0 args); `-` folds left; `/` -;; and `%` are strictly binary (signed truncating divide and remainder, -;; matching SARI + DIV/REM semantics). The nested `if` ladder exits -;; with the witness fixnum 42 only when every check holds; a single -;; wrong primitive short-circuits to 0 and the diff fails loudly. -(if (= (+) 0) - (if (= (+ 7) 7) - (if (= (+ 1 2 3 4) 10) - (if (= (*) 1) - (if (= (* 6) 6) - (if (= (* 2 3 4) 24) - (if (= (- 10 3 2) 5) - (if (= (/ 100 5) 20) - (if (= (% 17 5) 2) - 42 0) 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/11-compare.expected b/tests/lisp/11-compare.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/11-compare.scm b/tests/lisp/11-compare.scm @@ -1,16 +0,0 @@ -;; Step-10c numeric comparison primitives: = < > <= >=. -;; -;; All binary; result is #t or #f (step-10c singletons). The ladder -;; nests #t-guards and witnesses the #f-side by inverting with a `0` -;; tail, so a primitive that returns the wrong singleton short-circuits. -(if (= 5 5) - (if (< 3 5) - (if (> 5 3) - (if (<= 5 5) - (if (<= 4 5) - (if (>= 5 5) - (if (>= 6 5) - (if (if (= 5 6) 0 1) - (if (if (< 5 3) 0 1) - (if (if (>= 3 5) 0 1) - 42 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/11-list.expected b/tests/lisp/11-list.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/11-list.scm b/tests/lisp/11-list.scm @@ -1,25 +0,0 @@ -;; List core: cons car cdr pair? null? list length list? append reverse -;; assoc member. -(if (pair? (cons 1 2)) - (if (= (car (cons 1 2)) 1) - (if (= (cdr (cons 1 2)) 2) - (if (null? (quote ())) - (if (if (null? (cons 1 2)) 0 1) - (if (if (pair? (quote ())) 0 1) - (if (= (length (list 1 2 3 4)) 4) - (if (= (length (quote ())) 0) - (if (list? (list 1 2 3)) - (if (list? (quote ())) - (if (if (list? 42) 0 1) - (if (= (length (append (list 1 2) (list 3 4))) 4) - (if (= (car (append (list 1 2) (list 3 4))) 1) - (if (= (length (reverse (list 1 2 3))) 3) - (if (= (car (reverse (list 1 2 3))) 3) - (if (= (cdr (assoc (quote b) - (list (cons (quote a) 1) - (cons (quote b) 2)))) 2) - (if (if (assoc (quote z) - (list (cons (quote a) 1))) 0 1) - (if (= (car (member 3 (list 1 2 3 4))) 3) - (if (if (member 99 (list 1 2 3)) 0 1) - 42 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/12-numpred.expected b/tests/lisp/12-numpred.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/12-numpred.scm b/tests/lisp/12-numpred.scm @@ -1,20 +0,0 @@ -;; Step-10c numeric predicates + numeric functions. -;; -;; zero? / positive? / negative? / number? return singletons; -;; abs / min / max return fixnums. Step 11 brings negative literals -;; and negative-fixnum printing, so we synthesize negatives here via -;; `(- 0 n)` / `(bit-not 0)` and witness them through predicates -;; rather than printing the raw value. -(if (zero? 0) - (if (if (zero? 5) 0 1) - (if (positive? 5) - (if (if (positive? 0) 0 1) - (if (negative? (- 0 3)) - (if (if (negative? 5) 0 1) - (if (number? 42) - (if (if (number? (quote x)) 0 1) - (if (= (abs 7) 7) - (if (= (abs (- 0 9)) 9) - (if (= (min 5 3 9 2 8) 2) - (if (= (max 1 7 4 3) 7) - 42 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/12-string.expected b/tests/lisp/12-string.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/12-string.scm b/tests/lisp/12-string.scm @@ -1,9 +0,0 @@ -;; String core: string-length string-ref substring string-append -;; string->symbol symbol->string and equal? on strings. -(if (= (string-length "abcd") 4) - (if (= (string-ref "abcd" 2) 99) - (if (equal? (substring "abcdef" 1 4) "bcd") - (if (equal? (string-append "ab" "cd" "") "abcd") - (if (eq? (string->symbol "foo") (quote foo)) - (if (equal? (symbol->string (quote bar)) "bar") - 42 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/13-bitwise.expected b/tests/lisp/13-bitwise.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/13-bitwise.scm b/tests/lisp/13-bitwise.scm @@ -1,19 +0,0 @@ -;; Step-10c bitwise primitives: bit-and bit-or bit-xor bit-not -;; arithmetic-shift. -;; -;; bit-and/or/xor are variadic (identity on 0 args: -1, 0, 0); -;; bit-not is unary; arithmetic-shift is binary (k<0 is right shift). -;; Step-11 reader/printer deferrals mean we can't literalize -1 or -;; a negative shift; we synthesize both via `(bit-not 0)` and witness -;; through non-negative results. -(if (= (bit-and) (bit-not 0)) - (if (= (bit-and 15) 15) - (if (= (bit-and 15 6) 6) - (if (= (bit-or) 0) - (if (= (bit-or 1 2 4) 7) - (if (= (bit-xor 15 6) 9) - (if (= (bit-xor 15 15) 0) - (if (= (bit-not (bit-not 42)) 42) - (if (= (arithmetic-shift 1 3) 8) - (if (= (arithmetic-shift 16 (bit-not 1)) 4) - 42 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/13-vector.expected b/tests/lisp/13-vector.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/13-vector.scm b/tests/lisp/13-vector.scm @@ -1,10 +0,0 @@ -;; Vector core: make-vector vector-ref vector-set! vector-length -;; vector->list list->vector. -(define v (make-vector 3 0)) -(vector-set! v 1 7) -(if (= (vector-length v) 3) - (if (= (vector-ref v 1) 7) - (if (equal? (vector->list v) (list 0 7 0)) - (if (equal? (vector->list (list->vector (list 1 2 3))) - (list 1 2 3)) - 42 0) 0) 0) 0) diff --git a/tests/lisp/14-io.expected b/tests/lisp/14-io.expected @@ -1,4 +0,0 @@ -"io:" -abc -ok "qq" 7 -42 diff --git a/tests/lisp/14-io.scm b/tests/lisp/14-io.scm @@ -1,12 +0,0 @@ -;; I/O surface: display write newline format read-file write-file. -(write "io:") -(newline) -(display "abc") -(newline) -(format "~a ~s ~d~%" (quote ok) "qq" 7) -(write-file "build/io-out.txt" "done") -(if (equal? (read-file "tests/lisp/io-read.txt") "seed") - (if (equal? (read-file "build/io-out.txt") "done") - 42 - 0) - 0) diff --git a/tests/lisp/14-tagpred.expected b/tests/lisp/14-tagpred.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/14-tagpred.scm b/tests/lisp/14-tagpred.scm @@ -1,18 +0,0 @@ -;; Step-10c tag predicates + eq?. -;; -;; symbol?/string?/vector?/procedure? inspect the tag (and for vector -;; the header type byte). Strings and vectors don't exist as literals -;; yet (steps 10e/10f), so their #f case is tested against a fixnum. -;; `procedure?` accepts both closures and primitives (same tag band). -;; `eq?` is pointer/value identity — interning makes symbol eq? work. -(if (symbol? (quote foo)) - (if (if (symbol? 42) 0 1) - (if (if (string? 42) 0 1) - (if (if (vector? 42) 0 1) - (if (procedure? (lambda (x) x)) - (if (procedure? +) - (if (if (procedure? 42) 0 1) - (if (eq? (quote a) (quote a)) - (if (if (eq? (quote a) (quote b)) 0 1) - (if (eq? 5 5) - 42 0) 0) 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/15-pred.expected b/tests/lisp/15-pred.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/15-pred.scm b/tests/lisp/15-pred.scm @@ -1,11 +0,0 @@ -;; Predicates, equal?, and Scheme-level apply. -(if (number? 1) - (if (symbol? (quote foo)) - (if (string? "x") - (if (vector? (make-vector 1 0)) - (if (procedure? +) - (if (eq? (quote foo) (string->symbol "foo")) - (if (equal? (list 1 (cons 2 3)) - (list 1 (cons 2 3))) - (if (= (apply + 1 2 (list 3 4)) 10) - 42 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/16-prelude.expected b/tests/lisp/16-prelude.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/16-prelude.scm b/tests/lisp/16-prelude.scm @@ -1,7 +0,0 @@ -;; Prelude gate: map filter fold are embedded and evaluated before the -;; user program starts. -(if (= (car (map (lambda (x) (+ x 1)) (list 1 2 3))) 2) - (if (= (car (cdr (map (lambda (x) (+ x 1)) (list 1 2 3)))) 3) - (if (= (length (filter positive? (list 0 3 4))) 2) - (if (= (fold + 0 (list 1 2 3 4)) 10) - 42 0) 0) 0) 0) diff --git a/tests/lisp/17-gc-cons-churn.expected b/tests/lisp/17-gc-cons-churn.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/17-gc-cons-churn.scm b/tests/lisp/17-gc-cons-churn.scm @@ -1,16 +0,0 @@ -;; Cons churn stress: allocate many short-lived pairs, force multiple -;; GC cycles. lisp.M1's bring-up heap is 32 KB (~2048 pairs). Each -;; user-level cons drives several pair allocations once eval_args and -;; the marshal path are counted, so 5000 iterations exhaust the arena -;; multiple times over and exercise mark + sweep + freelist reuse. -;; -;; Uses the explicit `(define name (lambda ...))` form because the -;; bring-up evaluator does not expand `(define (name args) body)`. - -(define churn - (lambda (n) - (if (= n 0) - 42 - (begin (cons n n) (churn (- n 1)))))) - -(churn 5000) diff --git a/tests/lisp/18-gc-deep-list.expected b/tests/lisp/18-gc-deep-list.expected @@ -1 +0,0 @@ -119805 diff --git a/tests/lisp/18-gc-deep-list.scm b/tests/lisp/18-gc-deep-list.scm @@ -1,61 +0,0 @@ -;; Mark-stack overflow stress: force the -;; `mark_push → mark_push_recurse → mark_value` tail-branch fallback. -;; -;; `mark_stack` holds 512 entries (see `:mark_stack` in lisp.M1). -;; Overflow requires a DFS frontier wider than 512 at some point during -;; the mark phase. The cleanest trigger is a single live vector with -;; >512 element slots: `mark_value_vector` pushes each slot in one burst, -;; so the stack fills in-place and every further push routes through -;; `mark_push_recurse`. -;; -;; (LISP-GC.md originally conjectured that a deep *list* would overflow; -;; inspection of the mark order shows it won't — `mark_value_pair` -;; pushes cdr first and car second, so the DFS immediately consumes -;; the car side and leaves at most one leftover cdr per level. A flat -;; list never exceeds stack depth ~2. A large vector does. Keep the -;; filename for continuity with the step-5 plan in LISP-GC.md.) -;; -;; Bug this test pinned down: on aarch64/riscv64, `mark_push_recurse` -;; originally did `CALL mark_value ; RET`. Those arches' native CALL -;; writes the return address to a link register rather than pushing it, -;; so the inner CALL clobbered the incoming LR and the outer RET -;; branched to itself. The routine now tail-branches via -;; `li_br &mark_value ; b`, which lets mark_value return directly to -;; mark_push's caller. This test exercises that path across all three -;; arches. -;; -;; Plan: -;; 1. Allocate a 490-slot global vector. The mark stack is 512 entries -;; and root-walking has contributed a handful of pending pair -;; children before the vector is popped, so pushing 490 more -;; elements crosses the threshold mid-vector. -;; 2. Fill with distinct fixnums so a mis-swept vector corrupts the -;; checksum. -;; 3. Churn the pair arena to force repeated GCs while the vector -;; stays globally reachable — each GC re-marks the vector and -;; re-hits the overflow path. -;; 4. Sum the vector. Expected: 0 + 1 + … + 489 = 490 * 489 / 2 = 119805. - -(define v (make-vector 490 0)) - -(define fill - (lambda (i) - (if (= i 490) - 0 - (begin (vector-set! v i i) (fill (+ i 1)))))) -(fill 0) - -(define churn - (lambda (n) - (if (= n 0) - 0 - (begin (cons n n) (churn (- n 1)))))) -(churn 2000) - -(define sum - (lambda (i acc) - (if (= i 490) - acc - (sum (+ i 1) (+ acc (vector-ref v i)))))) - -(sum 0 0) diff --git a/tests/lisp/19-gc-vector-churn.expected b/tests/lisp/19-gc-vector-churn.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/19-gc-vector-churn.scm b/tests/lisp/19-gc-vector-churn.scm @@ -1,28 +0,0 @@ -;; Vector churn: every iteration allocates three short-lived vectors -;; whose sizes straddle the >128-byte threshold. Sub-128 allocations -;; get recycled through `free_lists[class_of(sz)]`; anything >128 -;; falls into the coalescing path in `gc_sweep_obj`, which has no -;; coverage from tests 17/18/20. Varying the sizes ensures -;; neighbouring dead chunks of different classes land adjacent to -;; each other so the coalesce merges non-trivially. -;; -;; Sizes (8-byte header + 8*N slots): -;; (make-vector 20 0) = 168 bytes (>128, coalesce path) -;; (make-vector 40 0) = 328 bytes (>128, coalesce path) -;; (make-vector 16 0) = 136 bytes (>128, coalesce path) -;; -;; 300 iterations × ~632 bytes/iter = ~190 KB of obj churn against -;; a 32 KiB obj arena — forces roughly 6 GC cycles and exercises -;; the coalesce-then-rewrite-pseudo-header logic on every one. - -(define churn - (lambda (n) - (if (= n 0) - 42 - (begin - (make-vector 20 0) - (make-vector 40 0) - (make-vector 16 0) - (churn (- n 1)))))) - -(churn 300) diff --git a/tests/lisp/20-gc-closure-churn.expected b/tests/lisp/20-gc-closure-churn.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/20-gc-closure-churn.scm b/tests/lisp/20-gc-closure-churn.scm @@ -1,21 +0,0 @@ -;; Closure churn: each call to make-counter evaluates a fresh -;; (lambda () ...) which allocates a 32-byte closure object on the -;; obj heap. The closure is consumed on the next line and becomes -;; unreachable. Iterating exhausts the obj heap and forces GC to -;; reclaim dead closures via the obj-arena sweep + free-list path. -;; -;; Each iteration drops 1 closure (32 bytes) plus a pile of -;; transient pairs (eval_args, env-extend). 800 iterations easily -;; cycle both arenas multiple times. - -(define make-counter - (lambda (start) - (lambda () start))) - -(define churn - (lambda (n) - (if (= n 0) - 42 - (begin ((make-counter n)) (churn (- n 1)))))) - -(churn 800) diff --git a/tests/lisp/20-quote.expected b/tests/lisp/20-quote.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/20-quote.scm b/tests/lisp/20-quote.scm @@ -1,11 +0,0 @@ -;; Step 11a: quote shorthand. 'x → (quote x); same for the atomic, -;; symbol, and list cases. -(if (= (quote 42) 42) - (if (eq? (quote foo) (quote foo)) - (if (= (car (quote (1 2 3))) 1) - (if (= (length (quote (1 2 3))) 3) - (if (= '42 42) - (if (eq? 'foo 'foo) - (if (= (car '(1 2 3)) 1) - (if (= (length '(1 2 3)) 3) - 42 0) 0) 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/21-gc-mixed.expected b/tests/lisp/21-gc-mixed.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/21-gc-mixed.scm b/tests/lisp/21-gc-mixed.scm @@ -1,33 +0,0 @@ -;; Mixed-allocator churn: every iteration allocates one value of each -;; of the four heap shapes so pair-arena and obj-arena GCs overlap -;; within a single run. -;; -;; (cons n n) — pair arena, 16 bytes -;; (make-vector 6 n) — obj arena, 56 bytes (sub-128 -;; class 56 free list) -;; (make-vector 24 n) — obj arena, 200 bytes (>128 -;; coalesce path) -;; (string-append "x" "y") — obj arena, short string -;; ((lambda (x) x) n) — obj arena, 32-byte closure -;; allocated then immediately called -;; and dropped -;; -;; 400 iterations × (1 pair + 4 obj) exhausts both arenas multiple -;; times, interleaving sweep and free-list recycle across every -;; size class plus the pair bitmap. A missed root or mis-classified -;; chunk in either arena would surface as a crash, a wrong checksum, -;; or a stuck loop. - -(define churn - (lambda (n) - (if (= n 0) - 42 - (begin - (cons n n) - (make-vector 6 n) - (make-vector 24 n) - (string-append "x" "y") - ((lambda (x) x) n) - (churn (- n 1)))))) - -(churn 400) diff --git a/tests/lisp/21-neg-hex.expected b/tests/lisp/21-neg-hex.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/21-neg-hex.scm b/tests/lisp/21-neg-hex.scm @@ -1,7 +0,0 @@ -;; Step 11b: negative decimal and 0x hex fixnum literals. -(if (< -5 0) - (if (= (+ -3 5) 2) - (if (= 0xFF 255) - (if (= 0xa 10) - (if (= -0x10 -16) - 42 0) 0) 0) 0) 0) diff --git a/tests/lisp/22-char.expected b/tests/lisp/22-char.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/22-char.scm b/tests/lisp/22-char.scm @@ -1,8 +0,0 @@ -;; Step 11c: character literals #\a, #\space, #\newline, #\tab. -(if (= #\a 97) - (if (= #\Z 90) - (if (= #\space 32) - (if (= #\newline 10) - (if (= #\tab 9) - (if (= #\0 48) - 42 0) 0) 0) 0) 0) 0) diff --git a/tests/lisp/23-vector.expected b/tests/lisp/23-vector.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/23-vector.scm b/tests/lisp/23-vector.scm @@ -1,8 +0,0 @@ -;; Step 11d: vector literals #(...). Reader builds a vector of the -;; constituent values (no element-level evaluation — literals only). -(if (= (vector-ref #(10 20 30) 0) 10) - (if (= (vector-ref #(10 20 30) 1) 20) - (if (= (vector-ref #(10 20 30) 2) 30) - (if (= (vector-length #(1 2 3 4)) 4) - (if (= (vector-length #()) 0) - 42 0) 0) 0) 0) 0) diff --git a/tests/lisp/24-dotted.expected b/tests/lisp/24-dotted.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/24-dotted.scm b/tests/lisp/24-dotted.scm @@ -1,7 +0,0 @@ -;; Step 11e: improper (dotted) list tail. (a b . c) is -;; (cons a (cons b c)). -(if (= (car '(1 . 2)) 1) - (if (= (cdr '(1 . 2)) 2) - (if (= (car (cdr '(1 2 . 3))) 2) - (if (= (cdr (cdr '(1 2 . 3))) 3) - 42 0) 0) 0) 0) diff --git a/tests/lisp/25-set.expected b/tests/lisp/25-set.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/25-set.scm b/tests/lisp/25-set.scm @@ -1,8 +0,0 @@ -;; Step 12a: set!. Mutates an existing binding. Exercises both the -;; global path and the local (let-bound) path — set_binding is -;; local-first with global fallback, so the two paths are distinct. -(define x 10) -(set! x 30) -(if (= x 30) - (if (= (let ((y 1)) (set! y 12) y) 12) - 42 0) 0) diff --git a/tests/lisp/26-let.expected b/tests/lisp/26-let.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/26-let.scm b/tests/lisp/26-let.scm @@ -1,15 +0,0 @@ -;; Step 12b: let / let* / letrec. -;; letrec must pre-bind all names so mutually recursive bindings can -;; see each other — this is the key behavior that distinguishes it -;; from let*. -(if (= (let ((x 5) (y 7)) (+ x y)) 12) - (if (= (let* ((x 5) (y (+ x 3))) y) 8) - (if (= (letrec ((f (lambda (n) - (if (< n 2) 1 (* n (f (- n 1))))))) - (f 5)) 120) - (if (= (letrec ((even? (lambda (n) - (if (= n 0) 1 (odd? (- n 1))))) - (odd? (lambda (n) - (if (= n 0) 0 (even? (- n 1)))))) - (+ (even? 4) (odd? 7))) 2) - 42 0) 0) 0) 0) diff --git a/tests/lisp/27-cond.expected b/tests/lisp/27-cond.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/27-cond.scm b/tests/lisp/27-cond.scm @@ -1,10 +0,0 @@ -;; Step 12c: cond. -(define classify - (lambda (n) - (cond ((< n 0) 'neg) - ((= n 0) 'zero) - (else 'pos)))) -(if (eq? (classify -5) 'neg) - (if (eq? (classify 0) 'zero) - (if (eq? (classify 7) 'pos) - 42 0) 0) 0) diff --git a/tests/lisp/28-quasi.expected b/tests/lisp/28-quasi.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/28-quasi.scm b/tests/lisp/28-quasi.scm @@ -1,6 +0,0 @@ -;; Step 12d: quasiquote / unquote / unquote-splicing. -(define x 5) -(if (= (car (cdr `(1 ,x 3))) 5) - (if (= (length `(1 ,@(list 2 3) 4)) 4) - (if (= (car (cdr (cdr `(1 ,@(list 2 3) 4)))) 3) - 42 0) 0) 0) diff --git a/tests/lisp/29-innerdef.expected b/tests/lisp/29-innerdef.expected @@ -1 +0,0 @@ -42 diff --git a/tests/lisp/29-innerdef.scm b/tests/lisp/29-innerdef.scm @@ -1,17 +0,0 @@ -;; Step 12e: inner (define …) inside a lambda body is rewritten into -;; letrec-shape so the definitions share scope with the trailing body. -;; A recursive inner define actually requires letrec semantics — plain -;; let* would leave `fact` unbound in its own RHS. -(define f - (lambda (x) - (define a 1) - (define b 2) - (+ x a b))) -(define g - (lambda (n) - (define fact - (lambda (k) (if (< k 2) 1 (* k (fact (- k 1)))))) - (fact n))) -(if (= (f 10) 13) - (if (= (g 5) 120) - 42 0) 0) diff --git a/tests/lisp/io-read.txt b/tests/lisp/io-read.txt @@ -1 +0,0 @@ -seed -\ No newline at end of file