
;; Note: This file must be utf-8. Confirm you see lambda -> "λ"

(import (core) (test-lite))

(format #t "Test Examples of Revised 6 Report on the Algorithmic Language Scheme\n\n")

(test-begin "1.2 Expressions")
(test-equal "expr 1" #t => #t)
(test-equal "expr 2" (+ 23 42) => 65)
(test-equal "expr 3" (+ 14 (* 23 42)) => 980)
(test-end)

(test-begin "1.3 Variables and binding")
(test-equal "let" (let ((x 23) (y 42)) (+ x y)) => 65)
(test-end)

(test-begin "1.4 Definitions")
(test-eval! (define x 23))
(test-eval! (define y 42))
(test-equal "top-level" (+ x y) => 65)
(test-equal "let 1" (let ((y 43)) (+ x y)) => 66)
(test-equal "let 2" (let ((y 43)) (let ((y 44)) (+ x y))) => 67)
(test-end)

(test-begin "1.6 Procedures")
(test-eval! (define (f x) (+ x 42)))
(test-equal "proc 1" (f 23) => 65)
(test-eval! (define (g p x) (p x)))
(test-equal "proc 2" (g f 23) => 65)
(test-eval! (define (h op x y) (op x y)))
(test-equal "proc 3" (h + 23 42) => 65)
(test-equal "proc 4" (h * 23 42) => 966)
(test-equal "proc 5" ((lambda (x) (+ x 42)) 23) => 65)
(test-end)

(test-begin "1.8 Assignment")
(test-equal "set!" (let ((x 23)) (set! x 42) x) => 42)
(test-end)

(test-begin "1.9 Derived forms and macros")
(test-equal "let 1" (let ((x 23) (y 42)) (+ x y)) => 65)
(test-equal "let 2" ((lambda (x y) (+ x y)) 23 42) => 65)
(test-eval! (define (f1 x) (+ x 42)))
(test-eval! (define f2 (lambda (x) (+ x 42))))
(test-eval! (begin
              (define-syntax def (syntax-rules () ((def f (p ...) body) (define (f p ...) body))))
              (def f3 (x) (+ x 42))))
(test-equal "define" (= (f1 23) (f2 23) (f3 23)) => #t)
(test-end)

(test-begin "1.10 Syntactic data and datum values")
(test-equal "quote 1" '23 => 23)
(test-equal "quote 2" '#t => #t)
(test-equal "quote 3" 'foo => foo)
(test-equal "quote 4" '(1 2 3) => (1 2 3))
(test-equal "quote 5" '#(1 2 3) => #(1 2 3))
(test-equal "quote 6" `(+ 23 42) => (+ 23 42))
(test-equal "quote 7" `(define (f x) (+ x 42)) => (define (f x) (+ x 42)))
(test-end)

(test-begin "1.11 Continuations")
(test-equal "call/cc"
            (+ 1 (call-with-current-continuation
                  (lambda (escape)
                    (+ 2 (escape 3)))))
            => 4)
(test-end)

(test-begin "1.12 Libraries")
;; add port for testing
(test-eval! (library (hello)
              (export hello-world)
              (import (rnrs base)
                      (rnrs io simple))
              (define (hello-world port)
                (display "Hello World" port)
                (newline port))))
(test-eval! (import (hello)))
(test-equal "library"
            (let-values (((port proc) (open-string-output-port)))
              (hello-world port)
              (proc))
            => "Hello World\n")
(test-end)

;; "1.13 Top-level programs" go separate file

(test-begin "4.2.4 Identifiers")
(test-equal "id 1" (symbol? 'lambda) => #t)
(test-equal "id 2" (symbol? 'q) => #t)
(test-equal "id 3" (symbol? 'soup) => #t)
(test-equal "id 4" (symbol? 'list->vector) => #t)
(test-equal "id 5" (symbol? '+) => #t)
(test-equal "id 6" (symbol? 'V17a) => #t)
(test-equal "id 7" (symbol? '<=) => #t)
(test-equal "id 8" (symbol? 'a34kTMNs) => #t)
(test-equal "id 9" (symbol? '->-) => #t)
(test-equal "id 10" (symbol? 'the-word-recursion-has-many-meanings) => #t)
(test-equal "id 11" (identifier? (syntax lambda)) => #t)
(test-equal "id 12" (identifier? (syntax q)) => #t)
(test-equal "id 13" (identifier? (syntax soup)) => #t)
(test-equal "id 14" (identifier? (syntax list->vector)) => #t)
(test-equal "id 15" (identifier? (syntax +)) => #t)
(test-equal "id 16" (identifier? (syntax V17a)) => #t)
(test-equal "id 17" (identifier? (syntax <=)) => #t)
(test-equal "id 18" (identifier? (syntax a34kTMNs)) => #t)
(test-equal "id 19" (identifier? (syntax ->-)) => #t)
(test-equal "id 20" (identifier? (syntax the-word-recursion-has-many-meanings)) => #t)
(test-end)

(test-begin "4.2.6 Characters")
(test-equal "a" (char? #\a) => #t)
(test-equal "A" (char? #\A) => #t)
(test-equal "(" (char? #\() => #t)
(test-equal " " (char? #\ ) => #t)
(test-equal "nul" (char->integer #\nul) => #x0000)
(test-equal "alarm" (char->integer #\alarm) => #x0007)
(test-equal "backsapce" (char->integer #\backspace) => #x0008)
(test-equal "tab" (char->integer #\tab) => #x0009)
(test-equal "linefeed" (char->integer #\linefeed) => #x000A)
(test-equal "newline" (char->integer #\newline) => #x000A)
(test-equal "vtab" (char->integer #\vtab) => #x000B)
(test-equal "page" (char->integer #\page) => #x000C)
(test-equal "return" (char->integer #\return) => #x000D)
(test-equal "esc" (char->integer #\esc) => #x001B)
(test-equal "space" (char->integer #\space) => #x0020)
(test-equal "delete" (char->integer #\delete) => #x007F)
(test-equal "hex2U" (char->integer #\xFF) => #x00FF)
(test-equal "hex4" (char->integer #\x03BB) => #x03BB)
(test-equal "hex8" (char->integer #\x00006587) => #x6587)
(test-equal "lambda" (char->integer #\λ) => #x03BB)
(test-lexical-exception "lex exn 1" (get-datum (open-string-input-port "#\\x0001z")))
(test-lexical-exception "lex exn 2" (get-datum (open-string-input-port "#\\λx")))
(test-lexical-exception "lex exn 3" (get-datum (open-string-input-port "#\\alarmx")))
(test-equal "alarm & x"
            (call-with-port
                (open-string-input-port "#\\alarm x")
                (lambda (port)
                  (list (get-datum port) (get-datum port))))
            => (#\alarm x))
(test-lexical-exception "lex exn 4" (get-datum (open-string-input-port "#\\Alarm")))
(test-lexical-exception "lex exn 5" (get-datum (open-string-input-port "#\\alert")))
(test-equal "hex1" (char->integer #\xA) => #x000A)
(test-equal "hex2L" (char->integer #\xff) => #x00FF)
(test-equal "x & ff"
            (call-with-port
                (open-string-input-port "#\\x ff")
                (lambda (port)
                  (list (get-datum port) (get-datum port))))
            => (#\x ff))
(test-equal "x & (ff)"
            (call-with-port
                (open-string-input-port "#\\x (ff)")
                (lambda (port)
                  (list (get-datum port) (get-datum port))))
            => (#\x (ff)))
(test-lexical-exception "lex exn 6" (get-datum (open-string-input-port "#\\(x)")))
(test-lexical-exception "lex exn 7" (get-datum (open-string-input-port "#\\(x")))
(test-equal "( & (x)"
            (call-with-port
                (open-string-input-port "#\\((x)")
                (lambda (port)
                  (list (get-datum port) (get-datum port))))
            => (#\( (x)))

(test-lexical-exception "lex exn 8" (get-datum (open-string-input-port "#\\x00110000")))
(test-equal "hex9" (char->integer #\x000000001) => #x0001)
(test-lexical-exception "lex exn 9" (get-datum (open-string-input-port "#\\xD800")))
(test-end)

(test-begin "4.2.7 Strings")
(test-equal "esc" (string->list "\a\b\t\n\v\f\r\"\\\      
     \x41;Z")
            => (#\alarm #\backspace #\tab #\linefeed #\vtab #\page #\return #\" #\\ #\A #\Z))
(test-equal "str 1" 
            (string->list "abc")
            => (#\a #\b #\c))
(test-equal "str 2" 
            (string->list "\x41;bc")
            => (#\A #\b #\c))
(test-equal "str 3" 
            (string->list "\x41; bc")
            => (#\A #\space #\b #\c))
(test-equal "str 4" 
            (char->integer (car (string->list "\x41bc;")))
            => #x41BC)
(test-equal "str 5" (get-datum (open-string-input-port (string #\" #\\ #\x #\4 #\1 #\; #\"))) => "A") ; "\x41;"
(test-lexical-exception "lex exn 1" (get-datum (open-string-input-port (string #\" #\\ #\x #\4 #\1 #\")))) ; "\x41"
(test-lexical-exception "lex exn 2" (get-datum (open-string-input-port (string #\" #\\ #\x #\; #\")))) ; "\x;"
(test-lexical-exception "lex exn 3" (get-datum (open-string-input-port (string #\" #\\ #\x #\4 #\1 #\b #\x #\; #\")))) ; "\x42bx;"
(test-equal "str 6" "\x00000041;" => "A")
(test-equal "str 6" (char->integer (car (string->list "\x0010FFFF;"))) => #x10FFFF)
(test-lexical-exception "lex exn 4" (get-datum (open-string-input-port (string #\" #\\ #\x #\0 #\0 #\1 #\1 #\0 #\0 #\0 #\0 #\; #\")))) ; "\x00110000;"
(test-equal "str 7" (char->integer (car (string->list "\x000000001;"))) => #x0001)
(test-lexical-exception "lex exn 4" (get-datum (open-string-input-port (string #\" #\\ #\x #\D #\8 #\0 #\0 #\; #\")))) ; "\xD800;"
(test-equal "str 8"
            (string->list
"A
bc"
) => (#\A #\linefeed #\b #\c))
(test-end)

(test-begin "4.2.8  Numbers")
(test-equal "precision 1" 3.1415926535898F0 => 3.1415926535898)
(test-equal "precision 2" 0.6L0 => 0.6)
(test-equal "precision 3" 1.1|53 => 1.1)
(test-eval! (define (precision)
              (do ((n 0 (+ n 1))
                   (x 1.0 (/ x 2.0)))
                  ((= 1.0 (+ 1.0 x)) n))))
(test-equal "precision 3" (>= (precision) 53) => #t)
(test-equal "inf 1" (number->string (/ 1.0 0.0)) => "+inf.0")
(test-equal "inf 2" (number->string (/ -1.0 0.0)) => "-inf.0")
(test-equal "nan" (number->string (/ 0.0 0.0)) => "+nan.0")
(test-end)

(test-begin "4.3.2 Pairs and lists")
(test-equal "list" '(a . (b . (c . (d . (e . ()))))) => (a b c d e))
(test-end)

(test-begin "4.3.3 Vectors")
(test-equal "vector" '#(0 (2 2 2 2) "Anna") => #(0 (2 2 2 2) "Anna"))
(test-violation "vector exn 1" #(0 (2 2 2 2) "Anna"))
(test-end)

(test-begin "4.3.4 Bytevectors")
(test-equal "bytevector" '#vu8(2 24 123) => #vu8(2 24 123))
(test-equal "bytevector" #vu8(2 24 123) => #vu8(2 24 123))
(test-end)

(test-begin "4.3.5 Abbreviations")
(test-equal "abbrev 1" (get-datum (open-string-input-port "'datum")) => (quote datum))
(test-equal "abbrev 2" (get-datum (open-string-input-port "`datum")) => (quasiquote datum))
(test-equal "abbrev 3" (get-datum (open-string-input-port ",datum")) => (unquote datum))
(test-equal "abbrev 4" (get-datum (open-string-input-port ",@datum")) => (unquote-splicing datum))
(test-equal "abbrev 5" (get-datum (open-string-input-port "#'datum")) => (syntax datum))
(test-equal "abbrev 6" (get-datum (open-string-input-port "#`datum")) => (quasisyntax datum))
(test-equal "abbrev 7" (get-datum (open-string-input-port "#,datum")) => (unsyntax datum))
(test-equal "abbrev 8" (get-datum (open-string-input-port "#,@datum")) => (unsyntax-splicing datum))
(test-end)

(test-begin "6.6 Evaluation examples")
(test-equal "*" (* 5 8) => 40)
(test-violation "D800" (integer->char #xD800))
(test-equal "atan" (atan -inf.0) => -1.5707963267948965)
(test-end)

(test-begin "7.3 Examples")
;; add for testing
(test-eval! (library (capture)
              (export get-port get-output)
              (import (rnrs))
              (define (get-port) capture-port)
              (define (get-output) (capture-proc))
              (define capture-port)
              (define capture-proc)
              (let-values (((port proc) (open-string-output-port)))
                (set! capture-port port)
                (set! capture-proc proc))))
(test-eval! (library (stack)
              (export make push! pop! empty!)
              (import (rnrs) (rnrs mutable-pairs))

              (define (make) (list '()))
              (define (push! s v) (set-car! s (cons v (car s))))
              (define (pop! s) (let ([v (caar s)])
                                 (set-car! s (cdar s))
                                 v))
              (define (empty! s) (set-car! s '()))))
(test-eval! (library (balloons)
              (export make push pop)
              (import (rnrs) (capture))

              (define (make w h) (cons w h))
              (define (push b amt)
                (cons (- (car b) amt) (+ (cdr b) amt)))
              (define (pop b) (display "Boom! " (get-port))
                (display (* (car b) (cdr b)) (get-port))
                (newline (get-port)))))
(test-eval! (library (party)
              ;; Total exports:
              ;; make, push, push!, make-party, pop!
              (export (rename (balloon:make make)
                              (balloon:push push))
                      push!
                      make-party
                      (rename (party-pop! pop!)))
              (import (rnrs)
                      (only (stack) make push! pop!) ; not empty!
                      (prefix (balloons) balloon:))

              ;; Creates a party as a stack of balloons,
              ;; starting with two balloons
              (define (make-party)
                (let ([s (make)]) ; from stack
                  (push! s (balloon:make 10 10))
                  (push! s (balloon:make 12 9))
                  s))
              (define (party-pop! p)
                (balloon:pop (pop! p)))))
(test-eval! (library (main)
              (export)
              (import (rnrs) (party))

              (define p (make-party))
              (pop! p)        ; displays "Boom! 108"
              (push! p (push (make 5 5) 1))
              (pop! p))       ; displays "Boom! 24"
            )
(test-equal "lib 1" (begin (import (capture)) (get-output)) => "Boom! 108\nBoom! 24\n")
;;Examples for macros and phases:
(test-eval! (library (my-helpers id-stuff)
              (export find-dup)
              (import (rnrs))

              (define (find-dup l)
                (and (pair? l)
                     (let loop ((rest (cdr l)))
                       (cond
                        [(null? rest) (find-dup (cdr l))]
                        [(bound-identifier=? (car l) (car rest))
                         (car rest)]
                        [else (loop (cdr rest))]))))))
(test-eval! (library (my-helpers values-stuff)
              (export mvlet)
              (import (rnrs) (for (my-helpers id-stuff) expand))

              (define-syntax mvlet
                (lambda (stx)
                  (syntax-case stx ()
                    [(_ [(id ...) expr] body0 body ...)
                     (not (find-dup (syntax (id ...))))
                     (syntax
                      (call-with-values
                          (lambda () expr)
                          (lambda (id ...) body0 body ...)))])))))
(test-eval! (library (let-div)
              (export let-div)
              (import (rnrs)
                      (my-helpers values-stuff)
                      (rnrs r5rs))

              (define (quotient+remainder n d)
                (let ([q (quotient n d)])
                  (values q (- n (* q d)))))
              (define-syntax let-div
                (syntax-rules ()
                  [(_ n d (q r) body0 body ...)
                   (mvlet [(q r) (quotient+remainder n d)]
                          body0 body ...)]))))
(test-equal "lib 2" (begin (import (let-div)) (let-div 200 3 (quo rem) (list quo rem))) => (66 2))
(test-end)

(test-begin "9.1 Primitive expression types")
(test-equal "num" 145932 => 145932)
(test-equal "bool" #t => #t)
(test-equal "str" "abc" => "abc")
(test-equal "byte" #vu8(2 24 123)  => #vu8(2 24 123) )
(test-eval! (define x 28))
(test-equal "var" x => 28)
(test-equal "expr 1" (+ 3 4) => 7)
(test-equal "expr 2" ((if #f + *) 3 4)  => 12)
(test-end)

(test-begin "10 Expansion process")
(test-syntax-violation "restriction 1"
                       (let ()
                         (define define 17)
                         (list define)))
(test-syntax-violation "restriction 2"
                       (let-syntax ([def0 (syntax-rules ()
                                            [(_ x) (define x 0)])])
                         (let ([z 3])
                           (def0 z)
                           (define def0 list)
                           (list z))))
(test-syntax-violation "restriction 3"
                       (let ()
                         (define-syntax foo
                           (lambda (e)
                             (+ 1 2)))
                         (define + 2)
                         (foo)))
(test-equal "expr 1"
            (let ([x 5])
              (define lambda list)
              (lambda x x))
            => (5 5))
(test-equal "expr 2"
            (let-syntax ([def0 (syntax-rules ()
                                 [(_ x) (define x 0)])])
              (let ([z 3])
                (define def0 list)
                (def0 z)
                (list z))) 
            => (3))
(test-equal "expr 3"
            (let ()
              (define-syntax foo
                (lambda (e)
                  (let ([+ -]) (+ 1 2))))
              (define + 2)
              (foo)) 
            => -1)
(test-equal "expr 4"
            ((lambda (x)
               (define-syntax defun
                 (syntax-rules ()
                   [(_ x a e) (define x (lambda a e))]))
               (defun even? (n) (or (= n 0) (odd? (- n 1))))
               (define-syntax odd?
                 (syntax-rules () [(_ n) (not (even? n))]))
               (odd? (if (odd? x) (* x x) x))) 
             4)
            => #f)
(test-end)

(test-begin "11.2.1 Variable definitions")
(test-eval! (define add3 (lambda (x) (+ x 3))))
(test-equal "def 1" (add3 3) => 6)
(test-eval! (define first car))
(test-equal "def 2" (first '(1 2)) => 1)
(test-end)

(test-begin "11.2.2 Syntax definitions")
(test-equal "stx 1"
            (let ()
              (define even?
                (lambda (x)
                  (or (= x 0) (odd? (- x 1)))))
              (define-syntax odd?
                (syntax-rules ()
                  ((odd?  x) (not (even? x)))))
              (even? 10))
            => #t)
(test-equal "stx 2"
            (let ()
              (define-syntax bind-to-zero
                (syntax-rules ()
                  ((bind-to-zero id) (define id 0))))
              (bind-to-zero x)
              x)
            => 0)
(test-end)

(test-begin "11.3 Bodies")
(test-equal "body 1"
            (let ((x 5))
              (define foo (lambda (y) (bar x y)))
              (define bar (lambda (a b) (+ (* a b) a)))
              (foo (+ x 3)))
            => 45)
(test-equal "body 2"
            (let ((x 5))
              (letrec* ((foo (lambda (y) (bar x y)))
                        (bar (lambda (a b) (+ (* a b) a))))
                (foo (+ x 3))))
            => 45)
(test-end)

(test-begin "11.4.1 Quotation")
(test-equal "quote 1" (quote a)  => a)
(test-equal "quote 2" (quote #(a b c)) => #(a b c))
(test-equal "quote 3" (quote (+ 1 2)) => (+ 1 2))
(test-equal "quote 4" '"abc" => "abc")
(test-equal "quote 5" '145932 => 145932)
(test-equal "quote 6" 'a => a)
(test-equal "quote 7" '#(a b c) => #(a b c))
(test-equal "quote 8" '() => ())
(test-equal "quote 9" '(+ 1 2) => (+ 1 2))
(test-equal "quote 10" '(quote a) => (quote a))
(test-equal "quote 11" ''a => (quote a))
(test-end)

(test-begin "11.4.2 Procedures")
(test-equal "proc 1" (procedure? (lambda (x) (+ x x))) => #t)
(test-equal "proc 2" ((lambda (x) (+ x x)) 4) => 8)
(test-equal "proc 3"
            ((lambda (x)
                        (define (p y)
                          (+ y 1))
                        (+ (p x) x))
                      5)
            => 11)
(test-eval! (define reverse-subtract (lambda (x y) (- y x))))
(test-equal "proc 4" (reverse-subtract 7 10) => 3)
(test-eval! (define add4 (let ((x 4)) (lambda (y) (+ x y)))))
(test-equal "proc 5" (add4 6) => 10)
(test-equal "proc 6" ((lambda x x) 3 4 5 6) => (3 4 5 6))
(test-equal "proc 7" ((lambda (x y . z) z) 3 4 5 6) => (5 6)) 
(test-end)

(test-begin "11.4.3 Conditionals")
(test-equal "if 1" (if (> 3 2) 'yes 'no) => yes)
(test-equal "if 2" (if (> 2 3) 'yes 'no) => no)
(test-equal "if 3"(if (> 3 2) (- 3 2) (+ 3 2)) => 1)
(test-equal "if 4"(unspecified? (if #f #f)) => #t)
(test-end)

(test-begin "11.4.4 Assignments")
(test-equal "set!"
            (let ((x 2))
              (+ x 1)
              (set! x 4)
              (+ x 1))
            => 5)
(test-end)

(test-begin "11.4.5 Derived conditionals")
(test-equal "cond 1"
            (cond ((> 3 2) 'greater)
                  ((< 3 2) 'less))
            => greater)
(test-equal "cond 2"
            (cond ((> 3 3) 'greater)
                  ((< 3 3) 'less)
                  (else 'equal))
            => equal)
(test-equal "cond 3"
            (cond ('(1 2 3) => cadr)
                  (else #f))
            => 2)
(test-equal "case 1"
            (case (* 2 3)
              ((2 3 5 7) 'prime)
              ((1 4 6 8 9) 'composite))
            => composite)
(test-equal "case 2"
            (unspecified?
             (case (car '(c d))
               ((a) 'a)
               ((b) 'b)))
            => #t)
(test-equal "case 3"
            (case (car '(c d))
              ((a e i o u) 'vowel)
              ((w y) 'semivowel)
              (else 'consonant))
            => consonant)
(test-equal "and 1" (and (= 2 2) (> 2 1)) => #t)
(test-equal "and 2" (and (= 2 2) (< 2 1)) => #f)
(test-equal "and 3" (and 1 2 'c '(f g)) => (f g))
(test-equal "and 4" (and) => #t)
(test-equal "or 1" (or (= 2 2) (> 2 1)) => #t)
(test-equal "or 2" (or (= 2 2) (< 2 1)) => #t)
(test-equal "or 3" (or #f #f #f) => #f)
(test-equal "or 4" (or '(b c) (/ 3 0)) => (b c))
(test-eval! (define-syntax and
              (syntax-rules ()
                ((and) #t)
                ((and test) test)
                ((and test1 test2 ...)
                 (if test1 (and test2 ...) #f)))))
(test-eval! (define-syntax or
              (syntax-rules ()
                ((or) #f)
                ((or test) test)
                ((or test1 test2 ...)
                 (let ((x test1))
                   (if x x (or test2 ...)))))))

(test-equal "stx and 1" (and (= 2 2) (> 2 1)) => #t)
(test-equal "stx and 2" (and (= 2 2) (< 2 1)) => #f)
(test-equal "stx and 3" (and 1 2 'c '(f g)) => (f g))
(test-equal "stx and 4" (and) => #t)
(test-equal "stx or 1" (or (= 2 2) (> 2 1)) => #t)
(test-equal "stx or 2" (or (= 2 2) (< 2 1)) => #t)
(test-equal "stx or 3" (or #f #f #f) => #f)
(test-equal "stx or 4" (or '(b c) (/ 3 0)) => (b c))
(test-end)

(test-begin "11.4.6 Binding constructs")
(test-equal "let 1" 
            (let ((x 2) (y 3))
              (* x y))
            => 6)
(test-equal "let 2"
            (let ((x 2) (y 3))
              (let ((x 7)
                    (z (+ x y)))
                (* z x)))
            => 35)
(test-equal "let & let*"
            (let ((x 2) (y 3))
              (let* ((x 7)
                     (z (+ x y)))
                (* z x)))
            => 70)
(test-equal "letrec"
            (letrec ((even?
                      (lambda (n)
                        (if (zero? n)
                            #t
                            (odd? (- n 1)))))
                     (odd?
                      (lambda (n)
                        (if (zero? n)
                            #f
                            (even? (- n 1))))))
              (even? 88))
            => #t)
(test-equal "letrec*"
            (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)
(test-equal "let-values 1"
            (let-values (((a b) (values 1 2))
                         ((c d) (values 3 4)))
              (list a b c d))
            => (1 2 3 4))
(test-equal "let-values 2"
            (let-values (((a b . c) (values 1 2 3 4)))
              (list a b c))
            => (1 2 (3 4)))
(test-equal "let & let-values"
            (let ((a 'a) (b 'b) (x 'x) (y 'y))
              (let-values (((a b) (values x y))
                           ((x y) (values a b)))
                (list a b x y)))
            => (x y a b))
(test-equal "let & let*-values"
            (let ((a 'a) (b 'b) (x 'x) (y 'y))
              (let*-values (((a b) (values x y))
                            ((x y) (values a b)))
                (list a b x y)))
            => (x y x y))
(test-syntax-violation "exn 1" (let ((a 1)(a 2)) a))
(test-syntax-violation "exn 2" (letrec ((a 1)(a 2)) a))
(test-syntax-violation "exn 3" (letrec* ((a 1)(a 2)) a))
(test-assertion-violation "exn 4" (letrec ((a b)(b 1)) b))
(test-assertion-violation "exn 5" (letrec* ((a b)(b 1)) b))
(test-syntax-violation "exn 6" (let-values (((a a) (values 1 2)) ((b c) (values 3 4))) (list a b c)))
(test-syntax-violation "exn 7" (let-values (((a b) (values 1 2)) ((a c) (values 3 4))) (list a b c)))
(test-end)

(test-begin "11.4.7 Sequencing")
(test-eval! (define x 0))
(test-equal "begin" (begin (set! x 5) (+ x 1)) => 6)
(test-end)

(test-begin "11.5 Equivalence predicates")
(test-equal "eqv 1" (eqv? 'a 'a) => #t)
(test-equal "eqv 2" (eqv? 'a 'b) => #f)
(test-equal "eqv 3" (eqv? 2 2) => #t)
(test-equal "eqv 4" (eqv? '() '()) => #t)
(test-equal "eqv 5" (eqv? 100000000 100000000) => #t)
(test-equal "eqv 6" (eqv? (cons 1 2) (cons 1 2)) => #f)
(test-equal "eqv 7" (eqv? (lambda () 1) (lambda () 2)) => #f)
(test-equal "eqv 8" (eqv? #f 'nil) => #f)
(test-eval! (define gen-counter
              (lambda ()
                (let ((n 0))
                  (lambda () (set! n (+ n 1)) n)))))
(test-equal "eqv 9"
            (let ((g (gen-counter)))
              (eqv? (gen-counter) (gen-counter)))
            => #f)
(test-equal "eqv 10" 
            (letrec ((f (lambda () (if (eqv? f g) 'f 'both)))
                     (g (lambda () (if (eqv? f g) 'g 'both))))
              (eqv? f g))
            =>  #f)
(test-equal "eqv 11" (let ((x '(a))) (eqv? x x)) => #t)
(test-equal "eq 1" (eq? 'a 'a) => #t)
(test-equal "eq 2" (eq? (list 'a) (list 'a)) => #f)
(test-equal "eq 3" (eq? '() '()) => #t)
(test-equal "eq 4" (eq? car car) => #t)
(test-equal "eq 5" (let ((x '(a))) (eq? x x)) => #t)
(test-equal "equal 1" (equal? 'a 'a) => #t)
(test-equal "equal 2" (equal? '(a) '(a)) => #t)
(test-equal "equal 3" (equal? '(a (b) c) '(a (b) c)) => #t)
(test-equal "equal 4" (equal? "abc" "abc") => #t)
(test-equal "equal 5" (equal? 2 2) => #t)
(test-equal "equal 6" (equal? (make-vector 5 'a) (make-vector 5 'a)) => #t)
(test-equal "equal 7" (equal? '#vu8(1 2 3 4 5) (u8-list->bytevector '(1 2 3 4 5))) => #t)
(test-equal "equal 8" (let* ((x (list 'a))
                   (y (list 'a))
                   (z (list x y)))
              (list (equal? z (list y x))
                    (equal? z (list x x))))
            => (#t #t))
(test-eval! (begin
              (define lst (list 1 2 (list 3 4) 5 6))
              (set-cdr! (cdr (caddr lst)) lst)
              (define a1 (list lst lst lst))
              (set-cdr! (cddr a1) a1)
              (define a2 (list lst))
              (set-cdr! a2 a2)))
(test-equal "inf equal 1" (equal? lst lst) => #t)
(test-equal "inf equal 2" (equal? a1 a1) => #t)
(test-equal "inf equal 3" (equal? a2 a2) => #t)
(test-equal "inf equal 4" (equal? lst a2) => #f)
(test-equal "inf equal 5" (equal? a1 lst) => #f)
(test-equal "inf equal 6" (equal? a2 a1) => #t)
(test-equal "inf equal 7" (equal? a1 a2) => #t)
(test-equal "inf equal 8" (equal? (cons a2 a1) (cons a1 a2)) => #t)
(test-end)

(test-begin "11.6 Procedure predicate")
(test-equal "proc 1" (procedure? car) => #t)
(test-equal "proc 2" (procedure? 'car) => #f)
(test-equal "proc 3" (procedure? (lambda (x) (* x x))) => #t)
(test-equal "proc 4" (procedure? '(lambda (x) (* x x))) => #f)
(test-end)

(test-begin "11.7.3.1 Integer division")
(test-equal "div 1" (div 123 10) => 12)
(test-equal "mod 1" (mod 123 10) => 3)
(test-equal "div 2" (div 123 -10) => -12)
(test-equal "mod 2" (mod 123 -10) => 3)
(test-equal "div 3" (div -123 10) => -13)
(test-equal "mod 3" (mod -123 10) => 7)
(test-equal "div 4" (div -123 -10) => 13)
(test-equal "mod 4" (mod -123 -10) => 7)
(test-equal "div0 1" (div0 123 10) => 12)
(test-equal "mod0 1" (mod0 123 10) => 3)
(test-equal "div0 2" (div0 123 -10) => -12)
(test-equal "mod0 2" (mod0 123 -10) => 3)
(test-equal "div0 3" (div0 -123 10) => -12)
(test-equal "mod0 3" (mod0 -123 10) => -3)
(test-equal "div0 4" (div0 -123 -10) => 12)
(test-equal "mod0 4" (mod0 -123 -10) => -3)
(test-end)

(test-begin "11.7.4.1 Numerical type predicates")
(test-equal "num type 1" (complex? 3+4i) => #t)
(test-equal "num type 2" (complex? 3) => #t)
(test-equal "num type 3" (real? 3) => #t)
(test-equal "num type 4" (real? -2.5+0.0i) => #f)
(test-equal "num type 5" (real? -2.5+0i) => #t)
(test-equal "num type 6" (real? -2.5) => #t)
(test-equal "num type 7" (real? #e1e10) => #t)
(test-equal "num type 8" (rational? 6/10) => #t)
(test-equal "num type 9" (rational? 6/3) => #t)
(test-equal "num type 10" (rational? 2) => #t)
(test-equal "num type 11" (integer? 3+0i) => #t)
(test-equal "num type 12" (integer? 3.0) => #t)
(test-equal "num type 13" (integer? 8/4) => #t)
(test-equal "num type 14" (number? +nan.0) => #t)
(test-equal "num type 15" (complex? +nan.0) => #t)
(test-equal "num type 16" (real? +nan.0) => #t)
(test-equal "num type 17" (rational? +nan.0) => #f)
(test-equal "num type 18" (complex? +inf.0) => #t)
(test-equal "num type 19" (real? -inf.0) => #t)
(test-equal "num type 20" (rational? -inf.0) => #f)
(test-equal "num type 21" (integer? -inf.0) => #f)
(test-equal "num type 22" (real-valued? +nan.0) => #t)
(test-equal "num type 23" (real-valued? +nan.0+0i) => #t)
(test-equal "num type 24" (real-valued? -inf.0) => #t)
(test-equal "num type 25" (real-valued? 3) => #t)
(test-equal "num type 26" (real-valued? -2.5+0.0i) => #t)
(test-equal "num type 27" (real-valued? -2.5+0i) => #t)
(test-equal "num type 28" (real-valued? -2.5) => #t)
(test-equal "num type 29" (real-valued? #e1e10) => #t)
(test-equal "num type 30" (rational-valued? +nan.0) => #f)
(test-equal "num type 31" (rational-valued? -inf.0) => #f)
(test-equal "num type 32" (rational-valued? 6/10) => #t)
(test-equal "num type 33" (rational-valued? 6/10+0.0i) => #t)
(test-equal "num type 34" (rational-valued? 6/10+0i) => #t)
(test-equal "num type 35" (rational-valued? 6/3) => #t)
(test-equal "num type 36" (integer-valued? 3+0i) => #t)
(test-equal "num type 37" (integer-valued? 3+0.0i) => #t)
(test-equal "num type 38" (integer-valued? 3.0) => #t)
(test-equal "num type 39" (integer-valued? 3.0+0.0i) => #t)
(test-equal "num type 40" (integer-valued? 8/4) => #t)
(test-equal "num type 41" (exact? 5) => #t)
(test-equal "num type 42" (inexact? +inf.0) => #t)
(test-end)

(test-begin "11.7.4.3 Arithmetic operations")
(test-equal "opr 1" (= +inf.0 +inf.0) => #t)
(test-equal "opr 2" (= -inf.0 +inf.0) => #f)
(test-equal "opr 3" (= -inf.0 -inf.0) => #t)
(test-equal "opr 4" (< -inf.0 10.1 +inf.0) => #t)
(test-equal "opr 5" (> +inf.0 10.1 -inf.0) => #t)
(test-equal "opr 6" (= +nan.0 10+1i) => #f)
(test-equal "opr 7" (< +nan.0 10.1) => #f)
(test-equal "opr 8" (> +nan.0 10.1) => #f)
(test-equal "opr 9" (zero? +0.0) => #t)
(test-equal "opr 10" (zero? -0.0) => #t)
(test-equal "opr 11" (zero? +nan.0) => #f)
(test-equal "opr 12" (positive? +inf.0) => #t)
(test-equal "opr 13" (negative? -inf.0) => #t)
(test-equal "opr 14" (positive? +nan.0) => #f)
(test-equal "opr 15" (negative? +nan.0) => #f)
(test-equal "opr 16" (finite? +inf.0) => #f)
(test-equal "opr 17" (finite? 5) => #t)
(test-equal "opr 18" (finite? 5.0) => #t)
(test-equal "opr 19" (infinite? 5.0) => #f)
(test-equal "opr 20" (infinite? +inf.0) => #t)
(test-equal "opr 21" (max 3 4) => 4)
(test-equal "opr 22" (max 3.9 4) => 4.0)
(test-equal "opr 23" (max +inf.0 1.01) => +inf.0)
(test-equal "opr 24" (min -inf.0 1.01) => -inf.0)                                                 
(test-equal "opr 25" (+ 3 4) => 7)
(test-equal "opr 26" (+ 3) => 3)
(test-equal "opr 27" (+) => 0)
(test-equal "opr 28" (+ +inf.0 +inf.0) => +inf.0)
(test-equal "opr 29" (nan? (+ +inf.0 -inf.0)) => #t)
(test-equal "opr 30" (* 4) => 4)
(test-equal "opr 31" (*) => 1)
(test-equal "opr 32" (* 5 +inf.0) => +inf.0)
(test-equal "opr 33" (* -5 +inf.0) => -inf.0)
(test-equal "opr 34" (* +inf.0 +inf.0) => +inf.0)
(test-equal "opr 35" (* +inf.0 -inf.0) => -inf.0)
(test-equal "opr 36" (* 0 +inf.0) => 0)
(test-equal "opr 37" (* 0 +nan.0) => 0)
(test-equal "opr 38" (* 1.0 0) => 0)
(test-equal "opr 39" (+ +inf.0 1.01) => +inf.0)
(test-equal "opr 40" (+ -inf.0 1.01) => -inf.0)
(test-equal "opr 41" (+ +inf.0 1.01) => +inf.0)
(test-equal "opr 42" (+ -inf.0 1.01) => -inf.0)
(test-equal "opr 43" (+ +inf.0 1.01) => +inf.0)
(test-equal "opr 44" (+ -inf.0 1.01) => -inf.0)                               
(test-equal "opr 45" (nan? (+ +nan.0 1.01)) => #t)
(test-equal "opr 46" (nan? (* +nan.0 1.01)) => #t)
(test-equal "opr 47" (+ 0.0 -0.0) => 0.0)
(test-equal "opr 48" (+ -0.0 0.0) => 0.0)
(test-equal "opr 49" (+ 0.0 0.0) => 0.0)
(test-equal "opr 50" (+ -0.0 -0.0) => -0.0)
(test-equal "opr 51" (- 3 4) => -1)
(test-equal "opr 52" (- 3 4 5) => -6)
(test-equal "opr 53" (- 3) => -3)
(test-equal "opr 54" (nan? (- +inf.0 +inf.0)) => #t)
(test-equal "opr 55" (- 0.0) => -0.0)
(test-equal "opr 56" (- -0.0) => 0.0)
(test-equal "opr 57" (- 0.0 -0.0) => 0.0)
(test-equal "opr 58" (- -0.0 0.0) => -0.0)
(test-equal "opr 59" (- 0.0 0.0) => 0.0)
(test-equal "opr 60" (- -0.0 -0.0) => 0.0)
(test-equal "opr 61" (/ 3 4 5) => 3/20)
(test-equal "opr 62" (/ 3) => 1/3)
(test-equal "opr 63" (/ 0.0) => +inf.0)
(test-equal "opr 64" (/ 1.0 0) => +inf.0)
(test-equal "opr 65" (/ -1 0.0) => -inf.0)
(test-equal "opr 66" (/ +inf.0) => 0.0)
(test-assertion-violation (/ 0 0))
(test-assertion-violation (/ 3 0))
(test-equal "opr 67" (/ 0 3.5) => 0.0)
(test-equal "opr 68" (nan? (/ 0 0.0)) => #t)
(test-equal "opr 69" (nan? (/ 0.0 0)) => #t)
(test-equal "opr 70" (nan? (/ 0.0 0.0)) => #t)
(test-equal "opr 71" (abs -7) => 7)
(test-equal "opr 72" (abs -inf.0) => +inf.0)
(test-equal "opr 73" (gcd 32 -36) => 4)
(test-equal "opr 74" (gcd) => 0)
(test-equal "opr 75" (lcm 32 -36) => 288)
(test-equal "opr 76" (lcm 32.0 -36) => 288.0)
(test-equal "opr 77" (lcm) => 1)
(test-equal "opr 78" (numerator (/ 6 4)) => 3)
(test-equal "opr 79" (denominator (/ 6 4)) => 2)
(test-equal "opr 80" (denominator (inexact (/ 6 4))) => 2.0)
(test-equal "opr 81" (floor -4.3) => -5.0)
(test-equal "opr 82" (ceiling -4.3) => -4.0)
(test-equal "opr 83" (truncate -4.3) => -4.0)
(test-equal "opr 84" (round -4.3) => -4.0)
(test-equal "opr 85" (floor 3.5) => 3.0)
(test-equal "opr 86" (ceiling 3.5) => 4.0)
(test-equal "opr 87" (truncate 3.5) => 3.0)
(test-equal "opr 88" (round 3.5) => 4.0)
(test-equal "opr 89" (round 7/2) => 4)
(test-equal "opr 90" (round 7) => 7)
(test-equal "opr 91" (floor +inf.0) => +inf.0)
(test-equal "opr 92" (ceiling -inf.0) => -inf.0)
(test-equal "opr 93" (nan? (round +nan.0)) => #t)
(test-equal "opr 94" (rationalize (exact .3) 1/10) => 1/3)
(test-equal "opr 95" (rationalize .3 1/10) => #i1/3)  
(test-equal "opr 96" (rationalize +inf.0 3) => +inf.0)
(test-equal "opr 97" (nan? (rationalize +inf.0 +inf.0)) => #t)
(test-equal "opr 98" (rationalize 3 +inf.0) => 0.0)
(test-equal "opr 99" (exp +inf.0) => +inf.0)
(test-equal "opr 100" (exp -inf.0) => 0.0)
(test-equal "opr 101" (log +inf.0) => +inf.0)
(test-equal "opr 102" (log 0.0) => -inf.0)
(test-assertion-violation "log exn" (log 0))
(test-equal "opr 103" (log -inf.0) => +inf.0+3.141592653589793i)
(test-equal "opr 104" (atan -inf.0) => -1.5707963267948965) 
(test-equal "opr 105" (atan +inf.0) => 1.5707963267948965) 
(test-equal "opr 106" (log -1.0+0.0i) => 0.0+3.141592653589793i) 
(test-equal "opr 107" (log -1.0-0.0i) => 0.0-3.141592653589793i) 
(test-equal "opr 108" (sqrt -5) => 0.0+2.23606797749979i) 
(test-equal "opr 109" (sqrt +inf.0) => +inf.0)
(test-equal "opr 110" (sqrt -inf.0) => +inf.0i)
(test-equal "opr 111" (call-with-values (lambda () (exact-integer-sqrt 4)) list) => (2 0))
(test-equal "opr 112" (call-with-values (lambda () (exact-integer-sqrt 5)) list) => (2 1))
(test-equal "opr 113" (expt 5 3) => 125)
(test-equal "opr 114" (expt 5 -3) => 1/125)
(test-equal "opr 115" (expt 5 0) => 1)
(test-equal "opr 116" (expt 0 5) => 0)
(test-equal "opr 117" (expt 0 5+.0000312i) => 0.0) ; fix errarum in R6RS (fujita)
(test-equal "opr unspec 1" (number->string (expt 0 -5)) => "+nan.0+nan.0i")
(test-equal "opr unspec 2" (number->string (expt 0 -5+.0000312i)) => "+nan.0+nan.0i")
(test-equal "opr 118" (expt 0 0) => 1)
(test-equal "opr 119" (expt 0.0 0.0) => 1.0)
(test-equal "opr 120" (make-rectangular 1.1 2.2) => 1.1+2.2i) 
(test-equal "opr 121" (make-polar 1.1 2.2)  => 1.1@2.2)  
(test-equal "opr 122" (real-part 1.1+2.2i) => 1.1) 
(test-equal "opr 123" (imag-part 1.1+2.2i) => 2.2) 
(test-equal "opr 124" (magnitude 1.1@2.2) => 1.1) 
(test-equal "opr 125" (angle 1.1@2.2) => 2.2) 
(test-equal "opr 126" (angle -1.0) => 3.141592653589793) 
(test-equal "opr 127" (angle -1.0+0.0i) => 3.141592653589793) 
(test-equal "opr 128" (angle -1.0-0.0i) => -3.141592653589793) 
(test-equal "opr 129" (angle +inf.0) => 0.0)
(test-equal "opr 130" (angle -inf.0) => 3.141592653589793) 
(test-equal "opr 131" (magnitude (make-rectangular 1.0 +inf.0)) => +inf.0)
(test-equal "opr 132" (magnitude (make-rectangular +inf.0 1.0)) => +inf.0)
(test-equal "opr 133" (magnitude (make-rectangular 1.0 -inf.0)) => +inf.0)
(test-equal "opr 134" (magnitude (make-rectangular -inf.0 1.0)) => +inf.0)
(test-equal "opr 135" (angle -1) => 3.141592653589793)                   
(test-end)

(test-begin "11.7.4.4 Numerical Input and Output")
(test-equal "num str 1" (string->number "100") => 100)
(test-equal "num str 2" (string->number "100" 16) => 256)
(test-equal "num str 3" (string->number "1e2") => 100.0)
(test-equal "num str 4" (string->number "0/0") => #f)
(test-equal "num str 5" (string->number "+inf.0") => +inf.0)
(test-equal "num str 6" (string->number "-inf.0") => -inf.0)
(test-equal "num str 7" (nan? (string->number "+nan.0")) => #t)
(test-end)

(test-begin "11.8 Booleans")
(test-equal "bool 1" (not #t) => #f)
(test-equal "bool 2" (not 3) =>  #f)
(test-equal "bool 3" (not (list 3)) => #f)
(test-equal "bool 4" (not #f) => #t)
(test-equal "bool 5" (not '()) => #f)
(test-equal "bool 6" (not (list)) => #f)
(test-equal "bool 7" (not 'nil) => #f)
(test-equal "bool 8" (boolean? #f) => #t)
(test-equal "bool 9" (boolean? 0) => #f)
(test-equal "bool 10" (boolean? '()) => #f)
(test-equal "bool 11" (boolean=? #t #t) => #t)
(test-equal "bool 12" (boolean=? #f #f) => #t)
(test-equal "bool 13" (boolean=? #t #f) => #f)
(test-equal "bool 14" (boolean=? #f #t) => #f)
(test-end)

(test-begin "11.9 Pairs and lists")
(test-equal "pair 1" (pair? '(a . b)) => #t)
(test-equal "pair 2" (pair? '(a b c)) => #t)
(test-equal "pair 3" (pair? '()) => #f)
(test-equal "pair 4" (pair? '#(a b)) => #f)
(test-equal "pair 5" (cons 'a '()) => (a))
(test-equal "pair 6" (cons '(a) '(b c d)) => ((a) b c d))
(test-equal "pair 7" (cons "a" '(b c)) => ("a" b c))
(test-equal "pair 8" (cons 'a 3) => (a . 3))
(test-equal "pair 9" (cons '(a b) 'c) => ((a b) . c))
(test-equal "pair 10" (car '(a b c)) => a)
(test-equal "pair 11" (car '((a) b c d)) => (a))
(test-equal "pair 12" (car '(1 . 2)) => 1)
(test-assertion-violation "pair exn 1 " (car '()))               ;  &assertion exception
(test-equal "pair 13" (cdr '((a) b c d)) => (b c d))
(test-equal "pair 14" (cdr '(1 . 2)) => 2)
(test-assertion-violation "pair exn 1" (cdr '()))               ;  &assertion exception                                    
(test-equal "list 1" (null? '()) => #t)
(test-equal "list 2" (null? '(1 . 2)) => #f)
(test-equal "list 3" (list? '(a b c)) => #t)
(test-equal "list 4" (list? '()) => #t)
(test-equal "list 5" (list? '(a . b)) => #f)
(test-equal "list 6" (list 'a (+ 3 4) 'c) => (a 7 c))
(test-equal "list 7" (list) => ())
(test-equal "list 8" (length '(a b c)) => 3)
(test-equal "list 9" (length '(a (b) (c d e))) => 3)
(test-equal "list 10" (length '()) => 0)
(test-equal "list 11" (append '(x) '(y)) => (x y))
(test-equal "list 12" (append '(a) '(b c d)) => (a b c d))
(test-equal "list 13" (append '(a (b)) '((c))) => (a (b) (c)))
(test-equal "list 14" (append '(a b) '(c . d)) => (a b c . d))
(test-equal "list 15" (append '() 'a) => a)
(test-equal "list 16" (reverse '(a b c)) => (c b a))
(test-equal "list 17" (reverse '(a (b c) d (e (f)))) => ((e (f)) d (b c) a))
(test-equal "list 18" (list-tail '(a b c d) 2) => (c d))
(test-equal "list 19" (list-ref '(a b c d) 2) => c)
(test-equal "map 1" (map cadr '((a b) (d e) (g h))) => (b e h))
(test-equal "map 2" (map (lambda (n) (expt n n)) '(1 2 3 4 5)) => (1 4 27 256 3125))
(test-equal "map 3" (map + '(1 2 3) '(4 5 6)) => (5 7 9))
(test-equal "map 4" 
            (let ((count 0))
              (map (lambda (ignored)
                     (set! count (+ count 1))
                     count)
                   '(a b)))
            => (1 2)); or (2 1)
(test-equal "map 5"
            (let ((v (make-vector 5)))
              (for-each (lambda (i)
                          (vector-set! v i (* i i)))
                        '(0 1 2 3 4))
              v)
            => #(0 1 4 9 16))
(test-equal "for-each 1" (unspecified? (for-each (lambda (x) x) '(1 2 3 4))) => #t)
(test-equal "for-each 2" (unspecified? (for-each even? '())) => #t)
(test-assertion-violation "map exn 1" (map list '(1 2 3) '(1 2 3 4)))
(test-assertion-violation "for-each exn 2" (for-each list '(1 2 3) '(1 2 3 4)))
(test-end)

(test-begin "11.10 Symbols")
(test-equal "symbol 1" (symbol? 'foo) => #t)
(test-equal "symbol 2" (symbol? (car '(a b))) => #t)
(test-equal "symbol 3" (symbol? "bar") => #f)
(test-equal "symbol 4" (symbol? 'nil) => #t)
(test-equal "symbol 5" (symbol? '()) => #f)
(test-equal "symbol 6" (symbol? #f) => #f)
(test-equal "symbol 7" (symbol->string 'flying-fish) => "flying-fish")
(test-equal "symbol 8" (symbol->string 'Martin) => "Martin")
(test-equal "symbol 9" (symbol->string (string->symbol "Malvina")) => "Malvina" )
(test-equal "symbol 10" (eq? 'mISSISSIppi 'mississippi) => #f)
(test-equal "symbol 11" (string->symbol "mISSISSIppi") => mISSISSIppi)
(test-equal "symbol 12" (eq? 'bitBlt (string->symbol "bitBlt")) => #t)
(test-equal "symbol 13" (eq? 'JollyWog (string->symbol (symbol->string 'JollyWog))) => #t)
(test-equal "symbol 14" (string=? "K. Harper, M.D." (symbol->string (string->symbol "K. Harper, M.D."))) => #t)
(test-end)

(test-begin "11.11 Characters")
(test-equal "char 1" (integer->char 32) => #\space)
(test-equal "char 2" (char->integer (integer->char 5000)) => 5000)
(test-assertion-violation "char exn 1" (integer->char #xD800))
(test-equal "char 3" (char<? #\z #\ß) => #t)
(test-equal "char 4" (char<? #\z #\Z) => #f)
(test-end)
                           
(test-begin "11.12 Strings")
(test-equal "str 1" (string<? "z" "ß") => #t)
(test-equal "str 2" (string<? "z" "zz") => #t)
(test-equal "str 3" (string<? "z" "Z") => #f)
(test-end)

(test-begin "11.13 Vectors")
(test-equal "vect 1" '#(0 (2 2 2 2) "Anna") => #(0 (2 2 2 2) "Anna"))
(test-equal "vect 2" (vector 'a 'b 'c) => #(a b c))
(test-equal "vect 3" (vector-ref '#(1 1 2 3 5 8 13 21) 5) => 8)
(test-equal "vect 4" 
            (let ((vec (vector 0 '(2 2 2 2) "Anna")))
              (vector-set! vec 1 '("Sue" "Sue"))
              vec)
            => #(0 ("Sue" "Sue") "Anna"))
(test-assertion-violation "vect 5" (vector-set! '#(0 1 2) 1 "doe"))
(test-equal "vect 6" (vector->list '#(dah dah didah)) => (dah dah didah))
(test-equal "vect 7" (list->vector '(dididit dah)) => #(dididit dah))
(test-end)

(test-begin "11.14 Errors and violations")
(test-eval! (define (fac n)
              (if (not (integer-valued? n))
                  (assertion-violation
                   'fac "non-integral argument" n))
              (if (negative? n)
                  (assertion-violation
                   'fac "negative argument" n))
              (letrec
                  ((loop (lambda (n r)
                           (if (zero? n)
                               r
                               (loop (- n 1) (* r n))))))
                (loop n 1))))
(test-equal "fac 1" (fac 5) => 120)
(test-assertion-violation "fac exn 1" (fac 4.5))
(test-assertion-violation "fac exn 2" (fac -3))
(test-end)

(test-begin "11.15 Control features")
(test-equal "ctrl 1" (apply + (list 3 4)) => 7)
(test-eval! (define compose
              (lambda (f g)
                (lambda args
                  (f (apply g args))))))
(test-equal "ctrl 2" ((compose sqrt *) 12 75) => 30)
(test-equal "ctrl 3" 
            (call-with-current-continuation
             (lambda (exit)
               (for-each (lambda (x)
                           (if (negative? x)
                               (exit x)))
                         '(54 0 37 -3 245 19))
               #t))
            => -3)
(test-eval! (define list-length
              (lambda (obj)
                (call-with-current-continuation
                 (lambda (return)
                   (letrec ((r
                             (lambda (obj)
                               (cond ((null? obj) 0)
                                     ((pair? obj)
                                      (+ (r (cdr obj)) 1))
                                     (else (return #f))))))
                     (r obj)))))))
(test-equal "ctrl 4" (list-length '(1 2 3 4)) => 4)
(test-equal "ctrl 5" (list-length '(a b . c)) => #f)
(test-equal "ctrl 6" (call-with-current-continuation procedure?) => #t)
(test-equal "ctrl 7" (call-with-values (lambda () (values 4 5)) (lambda (a b) b)) => 5)
(test-equal "ctrl 8" (call-with-values * -) => -1)
(test-equal "ctrl 9"
            (let ((path '())
                  (c #f))
              (let ((add (lambda (s)
                           (set! path (cons s path)))))
                (dynamic-wind
                 (lambda () (add 'connect))
                 (lambda ()
                   (add (call-with-current-continuation
                         (lambda (c0)
                           (set! c c0)
                           'talk1))))
                 (lambda () (add 'disconnect)))
                (if (< (length path) 4)
                    (c 'talk2)
                    (reverse path))))
            => (connect talk1 disconnect connect talk2 disconnect))

(test-equal "ctrl 10"
            (let ((n 0))
              (call-with-current-continuation
               (lambda (k)
                 (dynamic-wind
                  (lambda ()
                    (set! n (+ n 1))
                    (k))
                  (lambda ()
                    (set! n (+ n 2)))
                  (lambda ()
                    (set! n (+ n 4))))))
              n)
            => 1)

(test-equal "ctrl 11" 
            (let ((n 0))
              (call-with-current-continuation
               (lambda (k)
                 (dynamic-wind
                  values
                  (lambda ()
                    (dynamic-wind
                     values
                     (lambda ()
                       (set! n (+ n 1))
                       (k))
                     (lambda ()
                       (set! n (+ n 2))
                       (k))))
                  (lambda ()
                    (set! n (+ n 4))))))
              n)
            => 7)
(test-end)

(test-begin "11.16 Iteration")
(test-equal "iter 1" (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)))
(test-end)

(test-begin "11.17 Quasiquotation")
(test-equal "qq 1" `(list ,(+ 1 2) 4) => (list 3 4))
(test-equal "qq 2" (let ((name 'a)) `(list ,name ',name)) => (list a (quote a)))
(test-equal "qq 3" `(a ,(+ 1 2) ,@(map abs '(4 -5 6)) b) => (a 3 4 5 6 b))
(test-equal "qq 4" `(( foo ,(- 10 3)) ,@(cdr '(c)) . ,(car '(cons))) => ((foo 7) . cons))
(test-equal "qq 5" `#(10 5 ,(sqrt 4) ,@(map sqrt '(16 9)) 8) => #(10 5 2 4 3 8))
(test-equal "qq 6"
            (let ((name 'foo))
              `((unquote name name name)))
            => (foo foo foo))
(test-equal "qq 7"
            (let ((name '(foo)))
              `((unquote-splicing name name name)))
            => (foo foo foo))
(test-equal "qq 8"
            (let ((q '((append x y) (sqrt 9))))
              ``(foo ,,@q))
            => `(foo (unquote (append x y) (sqrt 9))))
(test-equal "qq 9"
            (let ((x '(2 3))
                  (y '(4 5)))
              `(foo (unquote (append x y) (sqrt 9))))
            => (foo (2 3 4 5) 3))
(test-equal "qq 10"
            `(a `(b ,(+ 1 2) ,(foo ,(+ 1 3) d) e) f)
            => (a `(b ,(+ 1 2) ,(foo 4 d) e) f))
(test-equal "qq 11"
            (let ((name1 'x)
                  (name2 'y))
              `(a `(b ,,name1 ,',name2 d) e))
            => (a `(b ,x ,'y d) e))
                   
(test-eval! (begin 
             (define make (lambda () (let ((a 3)) `((1 2) ,a ,4 ,'five 6))))
             (define e1 (make))
             (define e2 (make))))
(test-equal "qq lit 1" (eq? e1 e2) => #f)
(test-equal "qq lit 2" (eq? (car e1) (car e2)) => #t)
(test-equal "qq lit 3" (eq? (cddddr e1) (cddddr e2)) => #t)
(test-end)

(test-begin "11.18 Binding constructs for syntactic keywords")
(test-equal "stx 1"
            (let-syntax ((when (syntax-rules ()
                                 ((when test stmt1 stmt2 ...)
                                  (if test
                                      (begin stmt1
                                        stmt2 ...))))))
              (let ((if #t))
                (when if (set! if 'now))
                if))
            => now)
(test-equal "stx 2"
            (let ((x 'outer))
              (let-syntax ((m (syntax-rules () ((m) x))))
                (let ((x 'inner))
                  (m))))
            => outer)

(test-equal "stx 3"
            (let ()
              (let-syntax
                  ((def (syntax-rules ()
                          ((def stuff ...) (define stuff ...)))))
                (def foo 42))
              foo)
            => 42)
(test-equal "stx 4"
            (let ()
              (let-syntax ())
              5)
            => 5)
(test-equal "stx 5"
            (letrec-syntax
             ((my-or (syntax-rules ()
                       ((my-or) #f)
                       ((my-or e) e)
                       ((my-or e1 e2 ...)
                        (let ((temp e1))
                          (if temp
                              temp
                              (my-or e2 ...)))))))
             (let ((x #f)
                   (y 7)
                   (temp 8)
                   (let odd?)
                   (if even?))
               (my-or x
                      (let temp)
                      (if y)
                      y)))
            => 7)
(test-equal "stx 6"
            (let ((f (lambda (x) (+ x 1))))
              (let-syntax ((f (syntax-rules ()
                                ((f x) x)))
                           (g (syntax-rules ()
                                ((g x) (f x)))))
                (list (f 1) (g 1))))
            => (1 2))
(test-equal "stx 7"
            (let ((f (lambda (x) (+ x 1))))
              (letrec-syntax ((f (syntax-rules ()
                                   ((f x) x)))
                              (g (syntax-rules ()
                                   ((g x) (f x)))))
                             (list (f 1) (g 1))))
            => (1 1))
(test-end)

(test-begin "11.19 Macro transformers")
(test-eval! (define-syntax be-like-begin
              (syntax-rules ()
                ((be-like-begin name)
                 (define-syntax name
                   (syntax-rules ()
                     ((name expr (... ...))
                      (begin expr (... ...)))))))))
(test-eval! (be-like-begin sequence))
(test-equal "mac 1" (sequence 1 2 3 4) => 4)
(test-equal "mac 2"
            (let ((=> #f))
              (cond (#t => 'ok)))
            => ok)
(test-eval! (define p (cons 4 5)))
(test-eval! (define-syntax p.car (identifier-syntax (car p))))
(test-equal "mac 3" p.car => 4)
(test-syntax-violation "mac 4" (set! p.car 15))
(test-eval! (define p (cons 4 5)))
(test-eval! (define-syntax p.car
              (identifier-syntax
                (_ (car p))
                ((set! _ e) (set-car! p e)))))
(test-eval! (set! p.car 15))
(test-equal "mac 5" p.car => 15)
(test-equal "mac 6" p => (15 . 5))
(test-end)
                             
