r7rs-tests-z80.scm (7966 bytes)
1 ; r7rs-tests.scm -- conformance subset, run on the emulated chip by: host.lisp test 2 ; Each line: EXPR ==> printed result. Most cases are the examples of R7RS-small 3 ; (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 ; 4.1.1 variables, 4.1.2 literals 5 (define x 28) ==> x 6 x ==> 28 7 (quote a) ==> a 8 'a ==> a 9 '(+ 1 2) ==> (+ 1 2) 10 '() ==> () 11 '#t ==> #t 12 145932 ==> 145932 13 #t ==> #t 14 #false ==> #f 15 ; 4.1.3 procedure calls 16 (+ 3 4) ==> 7 17 ((if #f + *) 3 4) ==> 12 18 ; 4.1.4 lambda 19 ((lambda (x) (+ x x)) 4) ==> 8 20 (define reverse-subtract (lambda (x y) (- y x))) ==> reverse-subtract 21 (reverse-subtract 7 10) ==> 3 22 (define add4 (let ((x 4)) (lambda (y) (+ x y)))) ==> add4 23 (add4 6) ==> 10 24 ((lambda x x) 3 4 5 6) ==> (3 4 5 6) 25 ((lambda (x y . z) z) 3 4 5 6) ==> (5 6) 26 ; 4.1.5 if 27 (if (> 3 2) 'yes 'no) ==> yes 28 (if (> 2 3) 'yes 'no) ==> no 29 (if (> 3 2) (- 3 2) (+ 3 2)) ==> 1 30 ; 4.1.6 set! 31 (define y 2) ==> y 32 (+ y 1) ==> 3 33 (set! y 4) 34 (+ y 1) ==> 5 35 ; 4.2.1 cond, case, and, or, when, unless 36 (cond ((> 3 2) 'greater) ((< 3 2) 'less)) ==> greater 37 (cond ((> 3 3) 'greater) ((< 3 3) 'less) (else 'equal)) ==> equal 38 (cond ((assv 'b '((a 1) (b 2))) => cadr) (else #f)) ==> 2 39 (case (* 2 3) ((2 3 5 7) 'prime) ((1 4 6 8 9) 'composite)) ==> composite 40 (case (car '(c d)) ((a e i o u) 'vowel) ((w y) 'semivowel) (else 'consonant)) ==> consonant 41 (and (= 2 2) (> 2 1)) ==> #t 42 (and (= 2 2) (< 2 1)) ==> #f 43 (and 1 2 'c '(f g)) ==> (f g) 44 (and) ==> #t 45 (or (= 2 2) (> 2 1)) ==> #t 46 (or (= 2 2) (< 2 1)) ==> #t 47 (or #f #f #f) ==> #f 48 (or (memq 'b '(a b c)) (/ 3 0)) ==> (b c) 49 (when (= 1 1) 'a 'b) ==> b 50 (unless (= 1 1) 'a 'b) ==> 51 ; 4.2.2 binding constructs 52 (let ((x 2) (y 3)) (* x y)) ==> 6 53 (let ((x 2) (y 3)) (let ((x 7) (z (+ x y))) (* z x))) ==> 35 54 (let ((x 2) (y 3)) (let* ((x 7) (z (+ x y))) (* z x))) ==> 70 55 (letrec ((even? (lambda (n) (if (zero? n) #t (odd? (- n 1))))) (odd? (lambda (n) (if (zero? n) #f (even? (- n 1)))))) (even? 88)) ==> #t 56 (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 57 ; 4.2.3 sequencing 58 (define x 0) ==> x 59 (begin (set! x 5) (+ x 1)) ==> 6 60 ; 4.2.4 iteration 61 (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)) 62 (let ((x '(1 3 5 7 9))) (do ((x x (cdr x)) (sum 0 (+ sum (car x)))) ((null? x) sum))) ==> 25 63 ; 5.3 definitions, internal definitions 64 (define add3 (lambda (x) (+ x 3))) ==> add3 65 (add3 3) ==> 6 66 (define first car) ==> first 67 (first '(1 2)) ==> 1 68 (let ((x 5)) (define foo (lambda (y) (bar x y))) (define bar (lambda (a b) (+ (* a b) a))) (foo (+ x 3))) ==> 45 69 ; 6.1 equivalence 70 (eqv? 'a 'a) ==> #t 71 (eqv? 'a 'b) ==> #f 72 (eqv? 2 2) ==> #t 73 (eqv? '() '()) ==> #t 74 (eqv? 100000000 100000000) ==> #t 75 (eqv? (cons 1 2) (cons 1 2)) ==> #f 76 (eqv? (lambda () 1) (lambda () 2)) ==> #f 77 (eqv? #f 'nil) ==> #f 78 (let ((p (lambda (x) x))) (eqv? p p)) ==> #t 79 (eq? 'a 'a) ==> #t 80 (eq? (list 'a) (list 'a)) ==> #f 81 (eq? '() '()) ==> #t 82 (eq? car car) ==> #t 83 (let ((x '(a))) (eq? x x)) ==> #t 84 (equal? 'a 'a) ==> #t 85 (equal? '(a) '(a)) ==> #t 86 (equal? '(a (b) c) '(a (b) c)) ==> #t 87 (equal? 2 2) ==> #t 88 ; 6.2 numbers (exact integers only) 89 (integer? 3) ==> #t 90 (number? 'a) ==> #f 91 (= 1 1 1) ==> #t 92 (< 1 2 3) ==> #t 93 (< 1 3 2) ==> #f 94 (>= 3 3 1) ==> #t 95 (zero? 0) ==> #t 96 (positive? -5) ==> #f 97 (odd? 7) ==> #t 98 (even? 0) ==> #t 99 (max 3 4) ==> 4 100 (min 3 4 -1) ==> -1 101 (+ 3 4) ==> 7 102 (+ 3) ==> 3 103 (+) ==> 0 104 (* 4) ==> 4 105 (*) ==> 1 106 (- 3 4) ==> -1 107 (- 3 4 5) ==> -6 108 (- 3) ==> -3 109 (abs -7) ==> 7 110 (quotient 17 5) ==> 3 111 (remainder 17 5) ==> 2 112 (modulo 17 5) ==> 2 113 (modulo 17 -5) ==> -3 114 (remainder 17 -5) ==> 2 115 (modulo -17 5) ==> 3 116 (remainder -17 5) ==> -2 117 (gcd 32 -36) ==> 4 118 (gcd) ==> 0 119 (lcm 32 -36) ==> 288 120 (lcm) ==> 1 121 (square 42) ==> 1764 122 ; 6.3 booleans 123 #t ==> #t 124 '#f ==> #f 125 (not #t) ==> #f 126 (not 3) ==> #f 127 (not (list 3)) ==> #f 128 (not #f) ==> #t 129 (not '()) ==> #f 130 (not (list)) ==> #f 131 (not 'nil) ==> #f 132 (boolean? #f) ==> #t 133 (boolean? 0) ==> #f 134 (boolean? '()) ==> #f 135 ; 6.4 pairs and lists 136 (define x (list 'a 'b 'c)) ==> x 137 (define y x) ==> y 138 (list? y) ==> #t 139 (set-cdr! x 4) 140 x ==> (a . 4) 141 (eqv? x y) ==> #t 142 y ==> (a . 4) 143 (list? y) ==> #f 144 (pair? '(a . b)) ==> #t 145 (pair? '(a b c)) ==> #t 146 (pair? '()) ==> #f 147 (cons 'a '()) ==> (a) 148 (cons '(a) '(b c d)) ==> ((a) b c d) 149 (cons 'a 3) ==> (a . 3) 150 (cons '(a b) 'c) ==> ((a b) . c) 151 (car '(a b c)) ==> a 152 (car '((a) b c d)) ==> (a) 153 (car '(1 . 2)) ==> 1 154 (cdr '((a) b c d)) ==> (b c d) 155 (cdr '(1 . 2)) ==> 2 156 (list? '(a b c)) ==> #t 157 (list? '()) ==> #t 158 (list? '(a . b)) ==> #f 159 (make-list 2 3) ==> (3 3) 160 (list 'a (+ 3 4) 'c) ==> (a 7 c) 161 (list) ==> () 162 (length '(a b c)) ==> 3 163 (length '(a (b) (c d e))) ==> 3 164 (length '()) ==> 0 165 (append '(x) '(y)) ==> (x y) 166 (append '(a) '(b c d)) ==> (a b c d) 167 (append '(a (b)) '((c))) ==> (a (b) (c)) 168 (append '(a b) '(c . d)) ==> (a b c . d) 169 (append '() 'a) ==> a 170 (reverse '(a b c)) ==> (c b a) 171 (reverse '(a (b c) d (e (f)))) ==> ((e (f)) d (b c) a) 172 (list-tail '(a b c d) 2) ==> (c d) 173 (list-ref '(a b c d) 2) ==> c 174 (memq 'a '(a b c)) ==> (a b c) 175 (memq 'b '(a b c)) ==> (b c) 176 (memq 'a '(b c d)) ==> #f 177 (memq (list 'a) '(b (a) c)) ==> #f 178 (member (list 'a) '(b (a) c)) ==> ((a) c) 179 (memv 101 '(100 101 102)) ==> (101 102) 180 (define e '((a 1) (b 2) (c 3))) ==> e 181 (assq 'a e) ==> (a 1) 182 (assq 'b e) ==> (b 2) 183 (assq 'd e) ==> #f 184 (assq (list 'a) '(((a)) ((b)) ((c)))) ==> #f 185 (assoc (list 'a) '(((a)) ((b)) ((c)))) ==> ((a)) 186 (assv 5 '((2 3) (5 7) (11 13))) ==> (5 7) 187 (list-copy '(1 2 3)) ==> (1 2 3) 188 ; 6.5 symbols 189 (symbol? 'foo) ==> #t 190 (symbol? (car '(a b))) ==> #t 191 (symbol? 'nil) ==> #t 192 (symbol? '()) ==> #f 193 (symbol=? 'a 'a) ==> #t 194 ; 6.10 control features 195 (procedure? car) ==> #t 196 (procedure? 'car) ==> #f 197 (procedure? (lambda (x) (* x x))) ==> #t 198 (procedure? '(lambda (x) (* x x))) ==> #f 199 (apply + (list 3 4)) ==> 7 200 (apply + 1 2 '(3 4)) ==> 10 201 (map cadr '((a b) (d e) (g h))) ==> (b e h) 202 (map + '(1 2 3) '(10 20 30)) ==> (11 22 33) 203 (map (lambda (n) (* n n)) '(1 2 3 4 5)) ==> (1 4 9 16 25) 204 (let ((v '())) (for-each (lambda (x) (set! v (cons x v))) '(1 2 3)) v) ==> (3 2 1) 205 ; proper tail calls (3.5): a loop of 20000 iterations runs in constant stack 206 (define (count n) (if (= n 0) 'done (count (- n 1)))) ==> count 207 (count 20000) ==> done 208 ; 6.7 strings (regression: a string literal with spaces must read as one string) 209 "hello world" ==> "hello world" 210 (string? "a b") ==> #t 211 (string-length "a b c") ==> 5 212 (string->list "ab") ==> (97 98) 213 "say \"hi\" \\ ok" ==> "say \"hi\" \\ ok" 214 (equal? "a b" "a b") ==> #t 215 (begin (display "a b") 'x) ==> a bx 216 ; 6.8 vectors 217 (make-vector 3 0) ==> #(0 0 0) 218 (let ((v (make-vector 3 #t))) (vector-set! v 1 #f) v) ==> #(#t #f #t) 219 (vector-ref '#(1 2 3) 2) ==> 3 220 (vector-length (make-vector 7 1)) ==> 7 221 (vector->list (vector 1 2 3)) ==> (1 2 3) 222 ; sqrt/floor on exact integers 223 (sqrt 16) ==> 4 224 (floor (sqrt 500)) ==> 22 225 (floor 7) ==> 7 226 ; regression: a reported sieve program, a docstring body, vectors, do, when, named let 227 (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 228 (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) 229 (length (sieve-of-eratosthenes 500)) ==> 95