r7rs-tests.scm (17351 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") ==> (#\a #\b) 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.0 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 230 ; regressions found by the chibi suite: list? must stop on a circular list; case accepts => 231 (let ((x (list 'a))) (set-cdr! x x) (list? x)) ==> #f 232 (case 5 ((2 3 5 7) => (lambda (p) (* p 10))) (else 'no)) ==> 50 233 (case 'z ((a) 1) (else => (lambda (x) x))) ==> z 234 ; 6.2 numbers: overflow is an error, not a silent wrap (regression) 235 (+ 1073741823 1) ==> overflow 236 (* 100000 100000) ==> overflow 237 (- -1073741824 1) ==> overflow 238 (* 32768 32768) ==> overflow 239 (+ 1073741822 1) ==> 1073741823 240 ; 6.2.6 exact rationals and / 241 (/ 6 4) ==> 3/2 242 (/ 6 3) ==> 2 243 (/ 3) ==> 1/3 244 (/ 3 4 5) ==> 3/20 245 (+ 1/2 1/3) ==> 5/6 246 (* 2/3 3/2) ==> 1 247 (- 1/2) ==> -1/2 248 (- 1/2 1/3) ==> 1/6 249 (= 1/2 2/4) ==> #t 250 (< 1/3 1/2) ==> #t 251 (exact? 1/2) ==> #t 252 (rational? 1/2) ==> #t 253 (integer? 1/2) ==> #f 254 (numerator (/ 6 4)) ==> 3 255 (denominator (/ 6 4)) ==> 2 256 (denominator 5) ==> 1 257 (/ 1 0) ==> division by zero 258 ; 6.2.6 inexact reals (single precision on the M4F FPU) 259 (+ 1.5 2.25) ==> 3.75 260 (* 1.5 2) ==> 3.0 261 -2.5 ==> -2.5 262 1e3 ==> 1000.0 263 (/ 1.0 4) ==> 0.25 264 (< 0.3333 (/ 1 3.0) 0.3334) ==> #t 265 (+ 0.1 0.2) ==> 0.3 266 (- 0.5) ==> -0.5 267 (inexact 1/4) ==> 0.25 268 (exact->inexact 1/2) ==> 0.5 269 (exact 0.5) ==> 1/2 270 (exact 3.0) ==> 3 271 (inexact->exact 0.25) ==> 1/4 272 (inexact? 1.0) ==> #t 273 (exact? 1.0) ==> #f 274 (integer? 3.0) ==> #t 275 (integer? 3.5) ==> #f 276 (exact-integer? 5) ==> #t 277 (exact-integer? 5.0) ==> #f 278 (= 1 1.0) ==> #t 279 (eqv? 1 1.0) ==> #f 280 (eqv? 1.5 1.5) ==> #t 281 (eqv? 1/2 (/ 2 4)) ==> #t 282 (< 1 1.5 2) ==> #t 283 (max 3 2.0) ==> 3.0 284 (min 1 2.0) ==> 1.0 285 (abs -2.5) ==> 2.5 286 (/ 1.0 0) ==> +inf.0 287 (- (/ 1.0 0)) ==> -inf.0 288 (number? 1.5) ==> #t 289 (real? 1/2) ==> #t 290 ; item 2: characters, strings with O(1) access, contiguous vectors, bytevectors 291 #\a ==> #\a 292 #\space ==> #\space 293 (char->integer #\A) ==> 65 294 (integer->char 97) ==> #\a 295 (char? #\a) ==> #t 296 (char? "a") ==> #f 297 (char<? #\a #\b #\c) ==> #t 298 (char-upcase #\a) ==> #\A 299 (char-alphabetic? #\z) ==> #t 300 (char-numeric? #\5) ==> #t 301 (string->list "ab") ==> (#\a #\b) 302 (list->string (list #\h #\i)) ==> "hi" 303 (string-ref "abc" 1) ==> #\b 304 (substring "hello" 1 3) ==> "el" 305 (let ((s (make-string 3 #\x))) (string-set! s 1 #\y) s) ==> "xyx" 306 (string-append "ab" "cd" "e") ==> "abcde" 307 (string<? "abc" "abd") ==> #t 308 (string=? "ab" "ab" "ab") ==> #t 309 (string-copy "abc" 1) ==> "bc" 310 (symbol->string 'abc) ==> "abc" 311 (string->symbol "xyz") ==> xyz 312 (begin (write #\a) (display #\b) 'z) ==> #\abz 313 (vector-length #(1 2 3)) ==> 3 314 (vector->list #(1 2 3)) ==> (1 2 3) 315 (let ((v (make-vector 2000 0))) (let loop ((i 0)) (if (< i 2000) (begin (vector-set! v i i) (loop (+ i 1))))) (vector-ref v 1999)) ==> 1999 316 (equal? #(1 (2) "x") (vector 1 (list 2) "x")) ==> #t 317 (vector-ref #(1 2) 5) ==> index out of range 318 (bytevector 1 2 255) ==> #u8(1 2 255) 319 (bytevector-u8-ref #u8(5 6 7) 1) ==> 6 320 (let ((b (make-bytevector 2 0))) (bytevector-u8-set! b 0 9) b) ==> #u8(9 0) 321 (bytevector-length (make-bytevector 10 0)) ==> 10 322 (bytevector? #u8()) ==> #t 323 (utf8->string #u8(104 105)) ==> "hi" 324 (string->utf8 "AB") ==> #u8(65 66) 325 (let loop ((i 0) (s "")) (if (< i 3000) (loop (+ i 1) (string-append "ab" "cd")) (string-length s))) ==> 4 326 (let ((v (make-vector 100 1))) (let loop ((i 0)) (if (< i 3000) (begin (make-string 10 #\a) (loop (+ i 1))))) (vector-ref v 99)) ==> 1 327 ; item 3: sqrt exact for exact squares, inexact otherwise; rounding on non-integers 328 (sqrt 1/4) ==> 1/2 329 (sqrt 16.0) ==> 4.0 330 (exact? (sqrt 2)) ==> #f 331 (< 1.4142 (sqrt 2) 1.4143) ==> #t 332 (floor -4.3) ==> -5.0 333 (ceiling -4.3) ==> -4.0 334 (truncate -4.3) ==> -4.0 335 (round -4.3) ==> -4.0 336 (floor 3.5) ==> 3.0 337 (ceiling 3.5) ==> 4.0 338 (truncate 3.5) ==> 3.0 339 (round 3.5) ==> 4.0 340 (round 2.5) ==> 2.0 341 (round 7/2) ==> 4 342 (round -7/2) ==> -4 343 (round 7/10) ==> 1 344 (floor -7/2) ==> -4 345 (ceiling -7/2) ==> -3 346 (truncate -7/2) ==> -3 347 (floor 5) ==> 5 348 ; item 4: quasiquote, macros, promises, values, call/cc, dynamic-wind, exceptions, parameters, records 349 `(1 ,(+ 1 1) ,@(list 3 4)) ==> (1 2 3 4) 350 `(a b) ==> (a b) 351 (let ((x 5)) `(x ,x)) ==> (x 5) 352 (let ((xs '(1 2))) `(0 ,@xs 3 . 4)) ==> (0 1 2 3 . 4) 353 (define-syntax swap! (syntax-rules () ((_ a b) (let ((tmp a)) (set! a b) (set! b tmp))))) 354 (let ((x 1) (y 2)) (swap! x y) (list x y)) ==> (2 1) 355 (define-syntax my-or (syntax-rules () ((_) #f) ((_ e) e) ((_ e r ...) (let ((t e)) (if t t (my-or r ...)))))) 356 (my-or #f #f 3) ==> 3 357 (my-or) ==> #f 358 (define-syntax my-let* (syntax-rules () ((_ () body ...) (let () body ...)) ((_ ((x v) rest ...) body ...) (let ((x v)) (my-let* (rest ...) body ...))))) 359 (my-let* ((a 1) (b (+ a 1))) (* a b)) ==> 2 360 (define-syntax for (syntax-rules (in) ((_ x in lst body ...) (for-each (lambda (x) body ...) lst)))) 361 (let ((s 0)) (for x in '(1 2 3) (set! s (+ s x))) s) ==> 6 362 (let-syntax ((foo (syntax-rules () ((_ x) (* x 10))))) (foo 4)) ==> 40 363 (force (delay (+ 1 2))) ==> 3 364 (define count 0) ==> count 365 (define pr (delay (begin (set! count (+ count 1)) count))) ==> pr 366 (list (force pr) (force pr)) ==> (1 1) 367 (promise? (make-promise 5)) ==> #t 368 (force (make-promise 5)) ==> 5 369 (force 7) ==> 7 370 (call-with-values (lambda () (values 1 2)) +) ==> 3 371 (call-with-values (lambda () 5) (lambda (x) (* x x))) ==> 25 372 (let-values (((a b) (values 1 2)) ((c) (values 3))) (list a b c)) ==> (1 2 3) 373 (let-values (((q r) (floor/ 7 2))) (list q r)) ==> (3 1) 374 (let-values (((q r) (truncate/ -7 2))) (list q r)) ==> (-3 -1) 375 (let-values (((s r) (exact-integer-sqrt 17))) (list s r)) ==> (4 1) 376 (define-values (dq dr) (floor/ 17 5)) ==> 377 (list dq dr) ==> (3 2) 378 (call/cc (lambda (k) (+ 1 (k 42)))) ==> 42 379 (+ 1 (call-with-current-continuation (lambda (k) 2))) ==> 3 380 (call/cc (lambda (k) (for-each (lambda (x) (if (> x 2) (k x))) '(1 2 3 4)) 'none)) ==> 3 381 (let ((path '())) (dynamic-wind (lambda () (set! path (cons 'in path))) (lambda () (set! path (cons 'body path))) (lambda () (set! path (cons 'out path)))) (reverse path)) ==> (in body out) 382 (let ((path '())) (call/cc (lambda (k) (dynamic-wind (lambda () (set! path (cons 'in path))) (lambda () (k 'x)) (lambda () (set! path (cons 'out path)))))) (reverse path)) ==> (in out) 383 (guard (e (#t (list 'caught e))) (raise 'boom)) ==> (caught boom) 384 (guard (e ((symbol? e) 'sym) ((string? e) 'str)) (raise "x")) ==> str 385 (guard (e ((error-object? e) (error-object-message e))) (error "bad thing" 1 2)) ==> "bad thing" 386 (guard (e ((error-object? e) (error-object-irritants e))) (error "bad" 1 2)) ==> (1 2) 387 (with-exception-handler (lambda (e) 10) (lambda () (+ 1 (raise-continuable 'oops)))) ==> 11 388 (guard (e (#t 'outer)) (guard (e2 ((string? e2) 'inner)) (raise 'sym))) ==> outer 389 (guard (e (#t (list 'v e))) (+ 1 2)) ==> 3 390 (error "plain" 'x) ==> plain x 391 (define pa (make-parameter 10)) ==> pa 392 (pa) ==> 10 393 (parameterize ((pa 20)) (pa)) ==> 20 394 (pa) ==> 10 395 (define pb (make-parameter 5 (lambda (x) (* x 2)))) ==> pb 396 (pb) ==> 10 397 (parameterize ((pb 3)) (pb)) ==> 6 398 (define-record-type point (make-point x y) point? (x point-x set-point-x!) (y point-y)) 399 (point-x (make-point 1 2)) ==> 1 400 (let ((p (make-point 1 2))) (set-point-x! p 9) (point-x p)) ==> 9 401 (point? (make-point 1 2)) ==> #t 402 (point? 5) ==> #f 403 (define cl (case-lambda ((x) 'one) ((x y) 'two) ((x . r) 'many))) ==> cl 404 (list (cl 1) (cl 1 2) (cl 1 2 3)) ==> (one two many) 405 ; item 5: primitive errors are raisable error objects 406 (guard (e (#t 'caught)) (car 5)) ==> caught 407 (guard (e ((error-object? e) (error-object-message e))) (vector-ref (vector 1) 9)) ==> "index out of range" 408 (guard (e ((error-object? e) (list (error-object-message e) (error-object-irritants e)))) undefined-thing) ==> ("unbound variable" (undefined-thing)) 409 (car 5) ==> not a pair 410 (quote (a ... b)) ==> (a ... b) 411 (quote (1 . 2)) ==> (1 . 2) 412 (length (quote (rest ...))) ==> 2 413 ; item 6: primitives check their argument count 414 (car 1 2) ==> wrong number of arguments 415 (cons 1) ==> wrong number of arguments 416 (apply +) ==> wrong number of arguments 417 (vector-ref (vector 1)) ==> wrong number of arguments 418 (guard (e (#t (quote caught))) (car)) ==> caught 419 ((lambda (x) x)) ==> too few arguments 420 ; item 8: define returns an unspecified value; the REPL only echoes the name 421 (let ((v (begin (define dv 5)))) (eq? v (quote dv))) ==> #f 422 (begin (define dw 6)) ==> 423 (define dz 7) ==> dz 424 (define (dfn a) a) ==> dfn 425 ; item 9: import accepted; string ports, console ports, eof 426 (import (scheme base)) ==> 427 (import (scheme base) (scheme write)) ==> 428 (let ((p (open-output-string))) (write 'abc p) (display " x" p) (get-output-string p)) ==> "abc x" 429 (let ((p (open-output-string))) (write-char #\z p) (write-string "yy" p) (write 1/2 p) (get-output-string p)) ==> "zyy1/2" 430 (let ((p (open-input-string "hi there"))) (list (read-char p) (peek-char p) (read-char p))) ==> (#\h #\i #\i) 431 (read-line (open-input-string "line one\nline two")) ==> "line one" 432 (read (open-input-string "(a b . c)")) ==> (a b . c) 433 (let ((p (open-input-string "1 2"))) (list (read p) (read p) (eof-object? (read p)))) ==> (1 2 #t) 434 (eof-object? (eof-object)) ==> #t 435 (read-string 3 (open-input-string "abcdef")) ==> "abc" 436 (guard (e ((read-error? e) 'bad)) (read (open-input-string ")"))) ==> bad 437 (guard (e ((file-error? e) 'nofile)) (open-input-file "x")) ==> nofile 438 (output-port? (current-output-port)) ==> #t 439 (begin (write-string "hey" (current-output-port)) 'done) ==> heydone 440 (+ 1 2) ==> 3 441 ; regression: an uncaught error inside with-exception-handler must not leave the handler installed 442 443 (with-exception-handler (lambda (e) 0) (lambda () (car 1))) 444 445 (car 5) ==> not a pair 446 447 (dynamic-wind (lambda () #f) (lambda () (car 1)) (lambda () #f)) 448 449 (length *winders*) ==> 0