commit 950ce66c76e4404fd59b535fc25d93b6ae8d06f5 Spenser Truex <truex@equwal.com> 2026-10-04 08:58:55 +0000 Initial import
NOTES.md | 6 ++ r7rs-tests-z80.scm | 229 +++++++++++++++++++++++++++++++++++++++++++++++++++++ test.sh | 3 +- 3 files changed, 236 insertions(+), 2 deletions(-)
diff --git a/NOTES.md b/NOTES.md index c98141e..6a1a16c 100644 --- a/NOTES.md +++ b/NOTES.md @@ -120,3 +120,9 @@ PORT=4500 z80-lisp # another TCP port for the emulated console `test.sh` runs all three in 41 s. cpmsim runs unthrottled at about 450 MHz of emulated Z80 clock. + +## Conformance file + +`r7rs-tests-z80.scm` is the 205-case suite this port was validated against (the shared suite as of +the merge). The shared suite has since grown cases for number, character and blob features +that only the STM32 Scheme has; the Z80 harness has no per-case timeout, so it keeps its pinned copy. diff --git a/r7rs-tests-z80.scm b/r7rs-tests-z80.scm new file mode 100644 index 0000000..f8610f1 --- /dev/null +++ b/r7rs-tests-z80.scm @@ -0,0 +1,229 @@ +; r7rs-tests.scm -- conformance subset, run on the emulated chip by: host.lisp test +; Each line: EXPR ==> printed result. Most cases are the examples of R7RS-small +; (sections 4.1, 4.2, 5.3, 6.1, 6.2, 6.3, 6.4, 6.10); a line without ==> only has to evaluate. +; 4.1.1 variables, 4.1.2 literals +(define x 28) ==> x +x ==> 28 +(quote a) ==> a +'a ==> a +'(+ 1 2) ==> (+ 1 2) +'() ==> () +'#t ==> #t +145932 ==> 145932 +#t ==> #t +#false ==> #f +; 4.1.3 procedure calls +(+ 3 4) ==> 7 +((if #f + *) 3 4) ==> 12 +; 4.1.4 lambda +((lambda (x) (+ x x)) 4) ==> 8 +(define reverse-subtract (lambda (x y) (- y x))) ==> reverse-subtract +(reverse-subtract 7 10) ==> 3 +(define add4 (let ((x 4)) (lambda (y) (+ x y)))) ==> add4 +(add4 6) ==> 10 +((lambda x x) 3 4 5 6) ==> (3 4 5 6) +((lambda (x y . z) z) 3 4 5 6) ==> (5 6) +; 4.1.5 if +(if (> 3 2) 'yes 'no) ==> yes +(if (> 2 3) 'yes 'no) ==> no +(if (> 3 2) (- 3 2) (+ 3 2)) ==> 1 +; 4.1.6 set! +(define y 2) ==> y +(+ y 1) ==> 3 +(set! y 4) +(+ y 1) ==> 5 +; 4.2.1 cond, case, and, or, when, unless +(cond ((> 3 2) 'greater) ((< 3 2) 'less)) ==> greater +(cond ((> 3 3) 'greater) ((< 3 3) 'less) (else 'equal)) ==> equal +(cond ((assv 'b '((a 1) (b 2))) => cadr) (else #f)) ==> 2 +(case (* 2 3) ((2 3 5 7) 'prime) ((1 4 6 8 9) 'composite)) ==> composite +(case (car '(c d)) ((a e i o u) 'vowel) ((w y) 'semivowel) (else 'consonant)) ==> consonant +(and (= 2 2) (> 2 1)) ==> #t +(and (= 2 2) (< 2 1)) ==> #f +(and 1 2 'c '(f g)) ==> (f g) +(and) ==> #t +(or (= 2 2) (> 2 1)) ==> #t +(or (= 2 2) (< 2 1)) ==> #t +(or #f #f #f) ==> #f +(or (memq 'b '(a b c)) (/ 3 0)) ==> (b c) +(when (= 1 1) 'a 'b) ==> b +(unless (= 1 1) 'a 'b) ==> +; 4.2.2 binding constructs +(let ((x 2) (y 3)) (* x y)) ==> 6 +(let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))) ==> 35 +(let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x))) ==> 70 +(letrec ((even? (lambda (n) (if (zero? n) #t (odd? (- n 1))))) (odd? (lambda (n) (if (zero? n) #f (even? (- n 1)))))) (even? 88)) ==> #t +(letrec* ((p (lambda (x) (+ 1 (q (- x 1))))) (q (lambda (y) (if (zero? y) 0 (+ 1 (p (- y 1)))))) (x (p 5)) (y x)) y) ==> 5 +; 4.2.3 sequencing +(define x 0) ==> x +(begin (set! x 5) (+ x 1)) ==> 6 +; 4.2.4 iteration +(let loop ((numbers '(3 -2 1 6 -5)) (nonneg '()) (neg '())) (cond ((null? numbers) (list nonneg neg)) ((>= (car numbers) 0) (loop (cdr numbers) (cons (car numbers) nonneg) neg)) ((< (car numbers) 0) (loop (cdr numbers) nonneg (cons (car numbers) neg))))) ==> ((6 1 3) (-5 -2)) +(let ((x '(1 3 5 7 9))) (do ((x x (cdr x)) (sum 0 (+ sum (car x)))) ((null? x) sum))) ==> 25 +; 5.3 definitions, internal definitions +(define add3 (lambda (x) (+ x 3))) ==> add3 +(add3 3) ==> 6 +(define first car) ==> first +(first '(1 2)) ==> 1 +(let ((x 5)) (define foo (lambda (y) (bar x y))) (define bar (lambda (a b) (+ (* a b) a))) (foo (+ x 3))) ==> 45 +; 6.1 equivalence +(eqv? 'a 'a) ==> #t +(eqv? 'a 'b) ==> #f +(eqv? 2 2) ==> #t +(eqv? '() '()) ==> #t +(eqv? 100000000 100000000) ==> #t +(eqv? (cons 1 2) (cons 1 2)) ==> #f +(eqv? (lambda () 1) (lambda () 2)) ==> #f +(eqv? #f 'nil) ==> #f +(let ((p (lambda (x) x))) (eqv? p p)) ==> #t +(eq? 'a 'a) ==> #t +(eq? (list 'a) (list 'a)) ==> #f +(eq? '() '()) ==> #t +(eq? car car) ==> #t +(let ((x '(a))) (eq? x x)) ==> #t +(equal? 'a 'a) ==> #t +(equal? '(a) '(a)) ==> #t +(equal? '(a (b) c) '(a (b) c)) ==> #t +(equal? 2 2) ==> #t +; 6.2 numbers (exact integers only) +(integer? 3) ==> #t +(number? 'a) ==> #f +(= 1 1 1) ==> #t +(< 1 2 3) ==> #t +(< 1 3 2) ==> #f +(>= 3 3 1) ==> #t +(zero? 0) ==> #t +(positive? -5) ==> #f +(odd? 7) ==> #t +(even? 0) ==> #t +(max 3 4) ==> 4 +(min 3 4 -1) ==> -1 +(+ 3 4) ==> 7 +(+ 3) ==> 3 +(+) ==> 0 +(* 4) ==> 4 +(*) ==> 1 +(- 3 4) ==> -1 +(- 3 4 5) ==> -6 +(- 3) ==> -3 +(abs -7) ==> 7 +(quotient 17 5) ==> 3 +(remainder 17 5) ==> 2 +(modulo 17 5) ==> 2 +(modulo 17 -5) ==> -3 +(remainder 17 -5) ==> 2 +(modulo -17 5) ==> 3 +(remainder -17 5) ==> -2 +(gcd 32 -36) ==> 4 +(gcd) ==> 0 +(lcm 32 -36) ==> 288 +(lcm) ==> 1 +(square 42) ==> 1764 +; 6.3 booleans +#t ==> #t +'#f ==> #f +(not #t) ==> #f +(not 3) ==> #f +(not (list 3)) ==> #f +(not #f) ==> #t +(not '()) ==> #f +(not (list)) ==> #f +(not 'nil) ==> #f +(boolean? #f) ==> #t +(boolean? 0) ==> #f +(boolean? '()) ==> #f +; 6.4 pairs and lists +(define x (list 'a 'b 'c)) ==> x +(define y x) ==> y +(list? y) ==> #t +(set-cdr! x 4) +x ==> (a . 4) +(eqv? x y) ==> #t +y ==> (a . 4) +(list? y) ==> #f +(pair? '(a . b)) ==> #t +(pair? '(a b c)) ==> #t +(pair? '()) ==> #f +(cons 'a '()) ==> (a) +(cons '(a) '(b c d)) ==> ((a) b c d) +(cons 'a 3) ==> (a . 3) +(cons '(a b) 'c) ==> ((a b) . c) +(car '(a b c)) ==> a +(car '((a) b c d)) ==> (a) +(car '(1 . 2)) ==> 1 +(cdr '((a) b c d)) ==> (b c d) +(cdr '(1 . 2)) ==> 2 +(list? '(a b c)) ==> #t +(list? '()) ==> #t +(list? '(a . b)) ==> #f +(make-list 2 3) ==> (3 3) +(list 'a (+ 3 4) 'c) ==> (a 7 c) +(list) ==> () +(length '(a b c)) ==> 3 +(length '(a (b) (c d e))) ==> 3 +(length '()) ==> 0 +(append '(x) '(y)) ==> (x y) +(append '(a) '(b c d)) ==> (a b c d) +(append '(a (b)) '((c))) ==> (a (b) (c)) +(append '(a b) '(c . d)) ==> (a b c . d) +(append '() 'a) ==> a +(reverse '(a b c)) ==> (c b a) +(reverse '(a (b c) d (e (f)))) ==> ((e (f)) d (b c) a) +(list-tail '(a b c d) 2) ==> (c d) +(list-ref '(a b c d) 2) ==> c +(memq 'a '(a b c)) ==> (a b c) +(memq 'b '(a b c)) ==> (b c) +(memq 'a '(b c d)) ==> #f +(memq (list 'a) '(b (a) c)) ==> #f +(member (list 'a) '(b (a) c)) ==> ((a) c) +(memv 101 '(100 101 102)) ==> (101 102) +(define e '((a 1) (b 2) (c 3))) ==> e +(assq 'a e) ==> (a 1) +(assq 'b e) ==> (b 2) +(assq 'd e) ==> #f +(assq (list 'a) '(((a)) ((b)) ((c)))) ==> #f +(assoc (list 'a) '(((a)) ((b)) ((c)))) ==> ((a)) +(assv 5 '((2 3) (5 7) (11 13))) ==> (5 7) +(list-copy '(1 2 3)) ==> (1 2 3) +; 6.5 symbols +(symbol? 'foo) ==> #t +(symbol? (car '(a b))) ==> #t +(symbol? 'nil) ==> #t +(symbol? '()) ==> #f +(symbol=? 'a 'a) ==> #t +; 6.10 control features +(procedure? car) ==> #t +(procedure? 'car) ==> #f +(procedure? (lambda (x) (* x x))) ==> #t +(procedure? '(lambda (x) (* x x))) ==> #f +(apply + (list 3 4)) ==> 7 +(apply + 1 2 '(3 4)) ==> 10 +(map cadr '((a b) (d e) (g h))) ==> (b e h) +(map + '(1 2 3) '(10 20 30)) ==> (11 22 33) +(map (lambda (n) (* n n)) '(1 2 3 4 5)) ==> (1 4 9 16 25) +(let ((v '())) (for-each (lambda (x) (set! v (cons x v))) '(1 2 3)) v) ==> (3 2 1) +; proper tail calls (3.5): a loop of 20000 iterations runs in constant stack +(define (count n) (if (= n 0) 'done (count (- n 1)))) ==> count +(count 20000) ==> done +; 6.7 strings (regression: a string literal with spaces must read as one string) +"hello world" ==> "hello world" +(string? "a b") ==> #t +(string-length "a b c") ==> 5 +(string->list "ab") ==> (97 98) +"say \"hi\" \\ ok" ==> "say \"hi\" \\ ok" +(equal? "a b" "a b") ==> #t +(begin (display "a b") 'x) ==> a bx +; 6.8 vectors +(make-vector 3 0) ==> #(0 0 0) +(let ((v (make-vector 3 #t))) (vector-set! v 1 #f) v) ==> #(#t #f #t) +(vector-ref '#(1 2 3) 2) ==> 3 +(vector-length (make-vector 7 1)) ==> 7 +(vector->list (vector 1 2 3)) ==> (1 2 3) +; sqrt/floor on exact integers +(sqrt 16) ==> 4 +(floor (sqrt 500)) ==> 22 +(floor 7) ==> 7 +; regression: a reported sieve program, a docstring body, vectors, do, when, named let +(define (sieve-of-eratosthenes n) "Return list of primes up to n." (if (< n 2) '() (let ((marked (make-vector (+ n 1) #t))) (vector-set! marked 0 #f) (vector-set! marked 1 #f) (do ((i 2 (+ i 1))) ((> i (floor (sqrt n)))) (when (vector-ref marked i) (do ((j (* i i) (+ j i))) ((> j n)) (vector-set! marked j #f)))) (let loop ((i 2) (primes '())) (if (> i n) (reverse primes) (loop (+ i 1) (if (vector-ref marked i) (cons i primes) primes))))))) ==> sieve-of-eratosthenes +(sieve-of-eratosthenes 500) ==> (2 3 5 7 11 13 17 19 23 29 31 37 41 43 47 53 59 61 67 71 73 79 83 89 97 101 103 107 109 113 127 131 137 139 149 151 157 163 167 173 179 181 191 193 197 199 211 223 227 229 233 239 241 251 257 263 269 271 277 281 283 293 307 311 313 317 331 337 347 349 353 359 367 373 379 383 389 397 401 409 419 421 431 433 439 443 449 457 461 463 467 479 487 491 499) +(length (sieve-of-eratosthenes 500)) ==> 95 diff --git a/test.sh b/test.sh index 8690c1a..703aab3 100755 --- a/test.sh +++ b/test.sh @@ -2,7 +2,6 @@ # test.sh -- run the three test layers: assembler, kernel words, Lisp conformance. # Each kernel-level layer gets its own fresh emulator. PORT sets the first TCP port. SRC=$(cd "$(dirname "$0")" && pwd) -CORE=${FORTHLISP_CORE:-$SRC/..}; [ -f "$CORE/r7rs-tests.scm" ] || CORE=$SRC/../forthlisp # core repo checkout SBCL=${SBCL:-sbcl} PORT=${PORT:-4470} rc=0 @@ -10,7 +9,7 @@ nice $SBCL --script "$SRC/test-asm.lisp" || rc=1 nice $SBCL --script "$SRC/kernel.lisp" "$SRC/kernel.mos" for t in test-forth test; do P=$(PORT=$PORT "$SRC/emu.sh" "$SRC/kernel.mos") - if [ $t = test ]; then arg=$CORE/r7rs-tests.scm; else arg=; fi + if [ $t = test ]; then arg=$SRC/r7rs-tests-z80.scm; else arg=; fi PORT=$PORT $SBCL --script "$SRC/host.lisp" $t $arg || rc=1 kill $P 2>/dev/null PORT=$((PORT + 1))