chez-openbsd/mats/8.ms

;;; 8.ms
;;; Copyright 1984-2017 Cisco Systems, Inc.
;;; 
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;; 
;;; http://www.apache.org/licenses/LICENSE-2.0
;;; 
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

(mat define-syntax
   (begin (define-syntax foo
            (syntax-rules ()
              [(foo a b) (list a b)]))
          #t)
   (error? (expand '(foo)))
   (error? (expand '(foo . a)))
   (error? (expand '(foo a)))
   (error? (expand '(foo a . b)))
   (equal? (foo 3 4) '(3 4))
;;   (equal? (expand-once '(foo 3 4)) '(list 3 4))
   (equal? (foo 3 4) '(3 4))
   (error? (expand '(foo a b . c)))
   (error? (expand '(foo a b c)))
   (begin (define-syntax foo
            (syntax-rules (bar)
              [(foo) '()]
              [(foo (bar x)) x]
              [(foo x) (cons x '())]
              [(foo x y ...) (cons x (foo y ...))]))
          #t)
   (equivalent-expansion? (expand '(foo)) ''())
   (equivalent-expansion? (expand '(foo (bar a))) 'a)
   (equal? (foo 'a) '(a))
;;   (equal? (expand-once '(foo a b c)) '(cons a (foo b c)))
   (equal? (foo 'a 'b 'c) '(a b c))
   (equal? (foo 'a 'b (bar 'c)) '(a b . c))
   (equal? (foo 'a 'b 'c 'd) '(a b c d))
   (equal? (foo 'a 'b 'c (bar 'd)) '(a b c . d))
   (begin (define-syntax foo
            (lambda (x)
              (syntax-case x ()
                [(_ ((x v) ...) e1 e2 ...)
                 (andmap symbol? '(x ...))
                 (syntax ((lambda (x ...) e1 e2 ...) v ...))]
                [(_ ((lambda (x ...) e1 e2 ...) v ...))
                 (= (length '(x ...)) (length '(v ...)))
                 (syntax (foo ((x v) ...) e1 e2 ...))])))
          #t)
   (equal? (foo ((a 3) (b 4)) (cons a b)) '(3 . 4))
   (error? (expand '(foo ((1 b) (c d)) e f g)))
   (error? (expand '(foo ((lambda (a c) e f g) b))))
   (error? (define-syntax foo (syntax-rules (...) [(foo ...) 0])))
  ; no longer an error:
   #;(error? (define-syntax foo (syntax-rules () [(foo x ... y) 0])))
   (error? (define-syntax foo (syntax-rules () [(foo x . ...) 0])))
   (error? (define-syntax foo (syntax-rules () [(foo (...)) 0])))
   (error? (define-syntax foo (syntax-rules () [(foo x x) 0])))
   (begin (define-syntax foo (syntax-rules () [(foo foo) 0])) #t)
   (begin (define-syntax foo
            (lambda (x)
              (syntax-case x ()
                [(_ keys)
                 (with-syntax ([x `,(syntax keys)]) (syntax x))])))
          (equivalent-expansion? (expand '(foo (a b c))) '(a b c)))
   (begin (define-syntax foo ; test exponential "with" time problem
            (lambda (x)
              (syntax-case x ()
                [(_)
                 (with-syntax
                   ([a1 1] [b1 2] [c1 3] [d1 4] [e1 5] [f1 6] [g1 7] [h1 8]
                    [a2 1] [b2 2] [c2 3] [d2 4] [e2 5] [f2 6] [g2 7] [h2 8]
                    [a3 1] [b3 2] [c3 3] [d3 4] [e3 5] [f3 6] [g3 7] [h3 8]
                    [a4 1] [b4 2] [c4 3] [d4 4] [e4 5] [f4 6] [g4 7] [h4 8]
                    [a5 1] [b5 2] [c5 3] [d5 4] [e5 5] [f5 6] [g5 7] [h5 8]
                    [a6 1] [b6 2] [c6 3] [d6 4] [e6 5] [f6 6] [g6 7] [h6 8]
                    [a7 1] [b7 2] [c7 3] [d7 4] [e7 5] [f7 6] [g7 7] [h7 8]
                    [a8 1] [b8 2] [c8 3] [d8 4] [e8 5] [f8 6] [g8 7] [h8 8])
                   (syntax (list a1 b2 c3 d4 e5 f6 g7 h8)))])))
          (equal? (foo) '(1 2 3 4 5 6 7 8)))
   (eqv? (let ()
           (let-syntax () (define x 3) (define y 4))
           (define z (lambda () (+ x y)))
           (z))
         7)
   (eqv? (let ()
           (let-syntax ((a (syntax-rules ()
                             ((_ x v) (define x v))))
                        (b (syntax-rules ()
                             ((_ x v) (define-syntax x
                                        (syntax-rules ()
                                          ((_) v)))))))
             (a x 3)
             (b y 4))
           (define z (lambda () (+ x (y))))
           (z))
         7)
  (eqv?
    (let-syntax ((a (eval '(lambda (x) (let ((x x)) (syntax 3))))))
      (a))
    3)
  (error?
    (begin
      (define-syntax x (let ((a 3)) (identifier-syntax (define a 4))))
      x))
  (error?
    (begin
      (define-syntax x (let ((a 3)) (identifier-syntax (set! a 4))))
      x))
  (error?
    (begin
      (define-syntax x
        (let ((a 3))
          (identifier-syntax
            (fluid-let-syntax ((a (identifier-syntax 4)))
              3))))
      x))
  ;; transformers expressions can reference local keywords
  (eqv?
    (let-syntax ((a (lambda (x) (syntax (lambda (y) (syntax 3))))))
      (let-syntax ((b a))
        b))
    3)
  (eqv?
    (let-syntax ((a (lambda (x) (syntax (lambda (y) (syntax 3))))))
      (letrec-syntax ((b a))
        b))
    3)
  (eqv?
    (let-syntax ((a (lambda (x) (syntax (lambda (y) (syntax 3))))))
      (fluid-let-syntax ((b a))
        b))
    3)
  (eqv?
    (let-syntax ((a (lambda (x) (syntax (lambda (y) (syntax 3))))))
      (let ()
        (define-syntax b a)
        b))
    3)
  (let-syntax ((a (lambda (x) #'(lambda (x) #'3))))
    (define-syntax top-level-b a)
    (eqv? top-level-b 3))
  ;; transformers expressions cannot reference local variables
  (error?
    (let ((a (lambda (x) x)))
      (let-syntax ((b a))
        b)))
  (error?
    (let ((a (lambda (x) x)))
      (letrec-syntax ((b a))
        b)))
  (error?
    (let ((a (lambda (x) x)))
      (fluid-let-syntax ((b a))
        b)))
  (error?
    (let ((a (lambda (x) x)))
      (let ()
        (define-syntax b a)
        b)))
  ;; transformers expressions cannot reference pattern variables
  (error?
    (let-syntax ([foo
                  (lambda (x)
                    (syntax-case x ()
                      [(_ z ...)
                       (let-syntax ([bar (lambda (y) #'(z ...))])
                         (bar))]))])
      (foo + 8 9 10)))
  ;; but can expand into syntax forms containing pattern variable references
  (equal?
    (let-syntax ([foo
                  (lambda (x)
                    (syntax-case x ()
                      [(_ z ...)
                       (let-syntax ([bar (lambda (y) #'#'(z (... ...)))])
                         (bar))]))])
      (foo + 8 9 10))
    27)

  (procedure? (eval (expand '(rec f (lambda (x) x)))))
 ; make sure we're using the right environment for evaluating transformers
  (eq? (let ()
         (define x 3)
         (let-syntax ((x (identifier-syntax (identifier-syntax 4))))
           (define-syntax a x))
         a)
       4)
 ; make sure local-syntax bindings aren't visible outside their scope
  (equal?
    (let ([a 14])
      (module (x y)
        (let-syntax ((a (identifier-syntax 3)))
          (define x a))
        (define y a))
      (cons x y))
    '(3 . 14))
  (begin
    (define $ds-a 14)
    (module ($ds-x $ds-y)
      (letrec-syntax ((a (identifier-syntax 3)))
        (define $ds-x a))
      (define $ds-y $ds-a))
    (equal? (cons $ds-x $ds-y) '(3 . 14)))
 ; make sure both introduced references and defines are scoped the same
  (eq? (let ()
         (define-syntax a (identifier-syntax (begin (define x 3) x)))
         (let () a))
       3)

  (begin
    (define $a 'aaa)
    (define $x 'xxx) 
    (define-syntax $introduce-module
      (identifier-syntax
        (begin (module $a ($x) (define $x 73))
               (import $a)
               (eq? $x 73))))
    $introduce-module)
  (eq? $a 'aaa) ; make sure introduced module binding isn't visible
  (eq? $x 'xxx) ; make sure introduced and imported variable isn't visible
  (eq? (top-level-value '$a) 'aaa)
  (eq? (top-level-value '$x) 'xxx)
  (begin
    (define-syntax $dsmat-foo1
      (lambda (x)
        (syntax-case x ()
          ((_ name arg ...)
           (with-syntax (($... (syntax (... ...))))
             (syntax
               (begin
                 (define $dsmat-y 10)
                 (define-syntax name
                   (lambda (z)
                     (syntax-case z ()
                       ((_ a $...)
                        (syntax (list
                                  $dsmat-y
                                  a $...)))))))))))))
    #t)
  (begin ($dsmat-foo1 $dsmat-bar) #t)
  (error? ($dsmat-bar $dsmat-y))
  (begin (define $dsmat-y 77) #t)
  (equal? ($dsmat-bar $dsmat-y) '(10 77))
  (error? ; misplaced ellipsis
    (with-syntax ([x 3]) #'#(... (x))))
  (error? ; missing ellipsis
    (syntax-case '((1 2) (3 4)) () [((x y) ...) #'(quote (x y ...))]))
  (error? ; missing ellipsis
    (syntax-case '((1 2) (3 4)) () [((v w) ...) #'(quote (v ... w))]))
  (equal?
    (let ()
      (define b)
      (define d)
      (define-syntax a
        (lambda (x)
          (syntax-case x (b c)
            [(_ b) "b"]
            [(_ c) "c"]
            [(_ bar) (free-identifier=? #'bar #'d) "d"]
            [(_ bar) (free-identifier=? #'bar #'e) "e"]
            [(_ bar bee)
             (bound-identifier=? #'bar #'bee)
             (symbol->string (datum bar))]
            [_ "nope"])))
      (list (a b) (a c) (a d) (a e) (a b b) (a c c) (a f)))
    '("b" "c" "d" "e" "b" "c" "nope"))
  (equal?
    (let ()
      (define-syntax letrec
        (lambda (x)
          (syntax-case x ()
            [(_ ((i v) ...) e1 e2 ...)
             (with-syntax ([(t ...) (generate-temporaries #'(i ...))])
               #'(let ([i #f] ...)
                   (let ([t v] ...)
                     (set! i t)
                     ...
                     (let () e1 e2 ...))))])))
      (list
        (letrec ([f (lambda (x)
                      (if (zero? x) 'odd (g (- x 1))))]
                 [g (lambda (x) (if (zero? x) 'even (f (- x 1))))])
          (and (eq? (g 10) 'even)
               (eq? (g 13) 'odd)
               (eq? (f 13) 'even)))
        (letrec ([v 0] [k (call/cc (lambda (x) x))])
          (set! v (+ v 1))
          (k (lambda (x) v)))))
    '(#t 1))
  (equal?
    (let ()
      (define-syntax main ; Anton's example
        (lambda (stx)
          (let ((make-swap
                 (lambda (x y)
                   (with-syntax ((x x) (y y) ((t) (generate-temporaries '(*))))
                     (syntax
                       (let ((t1 x))
                         (set! x y)
                         (set! y t1)))))))
            (syntax-case stx ()
              ((_)
               (with-syntax ((swap (make-swap (syntax s) (syntax t))))
                 (syntax
                   (let ((s 1) (t 2))
                     swap
                     (list s t)))))))))
      (main))
    '(2 1))
 ; make sure second definition of marked id works like set!
  (begin
    (define $ds-b '())
    (define-syntax $ds-a
      (lambda (x)
        #'(begin
            (define q 33)
            (define (f) q)
            (set! $ds-b (cons (f) $ds-b))
            (define q 55)
            (set! $ds-b (cons (f) $ds-b))
            (set! $ds-b (cons q $ds-b))
            #t)))
    #t)
  $ds-a
  (equal? $ds-b '(55 55 33))

 ; check underscore as wildcard
  (equal?
    (let ()
      (define-syntax a
        (lambda (x)
          (syntax-case x ()
            [(_ id e)
             #'(let ()
                 (define-syntax id
                   (lambda (x)
                     (syntax-case x ()
                       [(_ q _) #'(list q '_)])))
                 e)])))
      (a xxx (xxx (cons (xxx 3 (/ 1 0)) 4) (/ 1 0))))
    '(((3 _) . 4) _))

  (equal?
    (let ([b 1] [c 2] [d 3] [e 4] [f 5] [g 6])
      (define-syntax a
        (syntax-rules ()
          [(_ x _ y _ z _)
           (list x y 'z '_)]))
      (a b c d e f g))
    '(1 3 f _))
 ; test syntax-rules fender
  (eqv?
    (let ()
      (define-syntax k
        (syntax-rules ()
          [(_ a b) (identifier? #'a) (let ((a (+ b 1))) (* a b))]))
      (let ([x 4]) (k x (+ x 3))))
    88)
  ; test for mishandling of underscore introduced by syntax-rules
  (equal?
    (let ([_ 3])
      (define-syntax a (lambda (x) (syntax-case x (_) [(k _) 4] [(k x) #'(* x x)])))
      (list (a _)))
    '(4))
  (equal?
    (let ([_ 3])
      (define-syntax a (syntax-rules (_) [(k _) 4] [(k x) (* x x)]))
      (list (a _)))
    '(4))
)

(mat r6rs:syntax-rules
  (equal?
    (let ([b 1] [c 2] [d 3] [e 4] [f 5] [g 6])
      (import (rnrs))
      (define-syntax a
        (syntax-rules ()
          [(_ x _ y _ z _)
           (list x y 'z '_)]))
      (a b c d e f g))
    '(1 3 f _))
  (equal?
    (let ()
      (import (rnrs))
      (define-syntax a
        (syntax-rules (b)
          [(_ b) "yup"]
          [(_ c) (list c)]))
      (list (a b) (a 3)))
    '("yup" (3)))
 ; test syntax-rules fender
  (error?
    (let ()
      (import (rnrs))
      (define-syntax k
        (syntax-rules ()
          [(_ a b) (identifier? #'a) (let ((a (+ b 1))) (* a b))]))
      (let ([x 4]) (k x (+ x 3)))))
  (error?
    (let ()
      (import (rnrs))
      (syntax-rules (_))))
  (error? (syntax-rules (_)))
  (error?
    (let ()
      (import (rnrs))
      (syntax-rules (...))))
  (error? (syntax-rules (...)))
  ; test for mishandling of underscore introduced by syntax-rules
  (equal?
    (let ()
      (import (rnrs))
      (let ([_ 3])
        (define-syntax a (syntax-rules (_) [(k _) 4] [(k x) (* x x)]))
        (list (a _))))
    '(4))
)

(mat definition-not-permitted
 ; top level
  (error? ; definition not permitted
    (let-syntax ((frob (lambda (x) #'(void))))
      (define frob 15)))
  (error? ; definition not permitted
    (let-syntax ((frob (lambda (x) #'(void))))
      (define-syntax frob (identifier-syntax 15))))
  (error? ; definition not permitted
    (let-syntax ((frob (lambda (x) #'(void))))
      (module frob (x) (define x 15))))
  (error? ; definition not permitted
    (let-syntax ((frob (lambda (x) #'(void))))
      (alias frob cons)))
 ; top level module body
  (error? ; definition not permitted
    (module (frob)
      (let-syntax ((frob (lambda (x) #'(void))))
        (define frob -15))))
  (error? ; definition not permitted
    (module (frob)
      (let-syntax ((frob (lambda (x) #'(void))))
        (define-syntax frob (identifier-syntax -15)))))
  (error? ; definition not permitted
    (module (frob)
      (let-syntax ((frob (lambda (x) #'(void))))
        (module frob (x) (define x -15)))))
  (error? ; definition not permitted
    (module (frob)
      (let-syntax ((frob (lambda (x) #'(void))))
        (alias frob cons))))
 ; body
  (error? ; definition not permitted
    (let ()
      (let-syntax ((frob (lambda (x) #'(void))))
        (define frob 'xxx))
      frob))
  (error? ; definition not permitted
    (let ()
      (let-syntax ((frob (lambda (x) #'(void))))
        (define-syntax frob (identifier-syntax 'xxx)))
      frob))
  (error? ; definition not permitted
    (let ()
      (let-syntax ((frob (lambda (x) #'(void))))
        (module frob (x) (define x 'xxx)))
      (import frob)
      x))
  (error? ; definition not permitted
    (let ()
      (let-syntax ((frob (lambda (x) #'(void))))
        (alias frob cons))
      (cons 3 4)))
)

(mat invalid-bindings
  (error? (let-syntax ([x '(global)]) x))
  (error? (letrec-syntax ([x '(global)]) x))
  (error? (fluid-let-syntax ([x '(global)]) x))
  (error? (begin (define-syntax x '(global)) x))
  (error? (let () (define-syntax x '(global)) x))
  (error? (let () (let-syntax ([x '(global)]) x)))
  (error? (let () (letrec-syntax ([x '(global)]) x)))
  (error? (let-syntax ([x '(lexical . #\a)]) x))
  (error? (letrec-syntax ([x '(lexical . #\a)]) x))
  (error? (fluid-let-syntax ([x '(lexical . #\a)]) x))
  (error? (begin (define-syntax x '(lexical . #\a)) x))
  (error? (let () (define-syntax x '(lexical . #\a)) x))
  (error? (let () (let-syntax ([x '(lexical . #\a)]) x)))
  (error? (let () (letrec-syntax ([x '(lexical . #\a)]) x)))
  (error? (let-syntax ([x '(macro . cond)]) x))
  (error? (letrec-syntax ([x '(macro . cond)]) x))
  (error? (fluid-let-syntax ([x '(macro . cond)]) x))
  (error? (begin (define-syntax x '(macro . cond)) x))
  (error? (let () (define-syntax x '(macro . cond)) x))
  (error? (let () (let-syntax ([x '(macro . cond)]) x)))
  (error? (let () (letrec-syntax ([x '(macro . cond)]) x)))
)

(mat generalized-pattern
  (begin
    (define-syntax gp$a (syntax-rules () [(_ x ... y) (list y x ...)]))
    #t)
  (error? gp$a)
  (error? (gp$a))
  (error? (gp$a . b))
  (equal? (gp$a 1 2 3 4 5) '(5 1 2 3 4))
  (equal? (gp$a 1) '(1))
  (equal? (gp$a 1 2) '(2 1))
  (begin
    (define-syntax gp$b
      (lambda (x)
        (syntax-case x ()
          [(_ x ... y) #'(list y x ...)])))
    #t)
  (error? gp$b)
  (error? (gp$b))
  (error? (gp$b . b))
  (equal? (gp$b 1 2 3 4 5) '(5 1 2 3 4))
  (equal? (gp$b 1) '(1))
  (equal? (gp$b 1 2) '(2 1))
  (begin
    (define-syntax gp$c
      (syntax-rules ()
        [(_ x ... y z . w) '((x ...) y z w)]))
    #t)
  (error? (gp$c))
  (error? (gp$c 1))
  (equal? (gp$c 1 2) '(() 1 2 ()))
  (equal? (gp$c 1 2 3 4 5) '((1 2 3) 4 5 ()))
  (equal? (gp$c 1 2 . 3) '(() 1 2 3))
  (equal? (gp$c 1 2 3 4 5 . 6) '((1 2 3) 4 5 6))
  (begin
    (define-syntax gp$d
      (syntax-rules (foo)
        [(_ x ... (y z) . #(foo w1 w2)) '((x ...) y z w1 w2)]))
    #t)
  (error? (gp$d 1 2 . #(foo 6 7)))
  (error? (gp$d 1 2))
  (error? (gp$d 1 2 (3 4)))
  (equal? (gp$d (4 5) . #(foo 6 7)) '(() 4 5 6 7))
  (equal? (gp$d 1 (4 5) . #(foo 6 7)) '((1) 4 5 6 7))
  (equal? (gp$d 1 2 3 (4 5) . #(foo 6 7)) '((1 2 3) 4 5 6 7))
  (begin
    (define-syntax gp$e
      (syntax-rules (rats)
        [(_ x ... . rats) '(x ...)]))
    #t)
  (error? (gp$e))
  (error? (gp$e 1))
  (error? (gp$e 1 2))
  (error? (gp$e rats))
  (equal? (gp$e . rats) '())
  (equal? (gp$e 1 . rats) '(1))
  (equal? (gp$e 1 2 3 4 5 . rats) '(1 2 3 4 5))
  (begin
    (define-syntax gp$f
      (syntax-rules (rats)
        [(_ (x ... y) ...) '(x ... ... y ...)]))
    #t)
  (equal? (gp$f) '())
  (equal? (gp$f (1 2 3 4 5) (6 7 8)) '(1 2 3 4 6 7 5 8))
  (error? 
    (define-syntax gp$g
      (syntax-rules ()
        [(_ x ... y ...) '(x ... y ...)])))
  (begin
    (define-syntax gp$h
      (syntax-rules (rats)
        [(_ #(x ... y) ...) '(x ... ... y ...)]))
    #t)
  (error? (gp$h (1 2 3)))
  (error? (gp$h . 4))
  (equal? (gp$h) '())
  (equal? (gp$h #(1 2 3 4 5) #(6 7 8)) '(1 2 3 4 6 7 5 8))
)

(mat define-integrable
  (begin
    (define-syntax define-integrable
      (lambda (x)
        (define make-residual-name
          (lambda (name)
            (datum->syntax name
              (string->symbol
                (string-append "residual-"
                  (symbol->string (syntax->datum name)))))))
        (syntax-case x (lambda)
          ((_ name (lambda formals form1 form2 ...))
           (identifier? (syntax name))
           (with-syntax ((xname (make-residual-name (syntax name))))
             (syntax
               (begin
                 (define-syntax name
                   (lambda (x)
                     (syntax-case x ()
                       (_ (identifier? x) (syntax xname))
                       ((_ arg (... ...))
                        (syntax
                          ((fluid-let-syntax
                             ((name (identifier-syntax xname)))
                             (lambda formals form1 form2 ...))
                           arg (... ...)))))))
                 (define xname
                   (fluid-let-syntax ((name (identifier-syntax xname)))
                     (lambda formals form1 form2 ...))))))))))
    #t)
  (let ()
    (define-integrable even? (lambda (x) (if (= x 0) #t (odd? (- x 1)))))
    (define-integrable odd? (lambda (x) (if (= x 0) #f (even? (- x 1)))))
    (and (even? 20) (not (odd? 20))))
  (begin
    (define-syntax define-integrable
      (lambda (x)
        (syntax-case x (lambda)
          [(_ name (lambda formals form1 form2 ...))
           (identifier? #'name)
           #'(begin
               (define-syntax name
                 (lambda (x)
                   (syntax-case x ()
                     [_ (identifier? x) #'xname]
                     [(_ arg (... ...))
                      #'((fluid-let-syntax ([name (identifier-syntax xname)])
                           (lambda formals form1 form2 ...))
                          arg
                          (... ...))])))
               (define xname
                 (fluid-let-syntax ([name (identifier-syntax xname)])
                   (lambda formals form1 form2 ...))))])))
    #t)
  (let ()
    (define-integrable even? (lambda (x) (if (= x 0) #t (odd? (- x 1)))))
    (define-integrable odd? (lambda (x) (if (= x 0) #f (even? (- x 1)))))
    (and (even? 20) (not (odd? 20))))
  (begin
    (define-integrable $di-foo
      (lambda (x) (if (list? x) (map $di-foo x) (list x))))
    (define-integrable $di-bar
      (lambda (x) (if (vector? x) (vector-map $di-bar x) (vector ($di-foo x)))))
    (equal?
      (list ($di-bar '#(a b c)) ($di-bar '(1 2 3)))
      '(#(#((a)) #((b)) #((c))) #(((1) (2) (3))))))
)

(mat identifier-syntax
  (eqv?
    (let ([x 0])
      (define-syntax frob
        (identifier-syntax
          [id (begin (set! x (+ x 1)) x)]
          [(set! id v) (set! x v)]))
      (let ([n (+ frob frob frob)])
        (set! frob 15)
        (+ n frob)))
    22)
  (begin
    (module (($is-frob x))
      (define x 'initial-x)
      (define-syntax $is-frob
        (make-variable-transformer
          (lambda (z)
            (syntax-case z (set!)
              [(set! id e)
               (identifier? #'id)
               #'(set! x e)]
              [id (identifier? #'id) #'(vector x)]
              [(_ a b c ...) #'(set! x (list (cons a b) c ...))])))))
    (equal? $is-frob '#(initial-x)))
  (error? ; invalid syntax
    ($is-frob))
  (error? ; invalid syntax
    ($is-frob 3))
  (error? ; invalid syntax
    (set! $is-frob))
  (error? ; invalid syntax
    (set! $is-frob 3 4))
  (equal?
    (begin
      ($is-frob 3 4)
      $is-frob)
    '#(((3 . 4))))
  (equal?
    (begin
      ($is-frob 3 4 5 6 7)
      $is-frob)
    '#(((3 . 4) 5 6 7)))
  (equal?
    (let ()
      (set! $is-frob 55)
      $is-frob)
    '#(55))
  (equal?
    (let ()
      ($is-frob 'q 'p 'doll)
      $is-frob)
    '#(((q . p) doll)))
  (equal?
    (let ([z (void)])
      (set! $is-frob 44)
      (let ([set! (lambda args (set! z args))])
        (set! $is-frob 15)
        (list z $is-frob)))
    '((#(44) 15) #(44)))
)

(mat with-syntax
   (begin (define-syntax foo
            (lambda (x)
              (syntax-case x ()
                [(_ x ...)
                 (with-syntax ([n (length (syntax (x ...)))])
                   (syntax (list n 'x ...)))])))
          #t)
   (equal? (foo 3 2 1) '(3 3 2 1))
   (equal? (foo 3 2 1) '(3 3 2 1))
   (begin (define-syntax foo
            (lambda (x)
              (syntax-case x ()
                [(_ (x ...) ...)
                 (with-syntax
                   (((len ...) (map length (syntax ((x ...) ...))))
                    (((z ...) ...) (map reverse (syntax ((x ...) ...)))))
                   (syntax '((len z ...) ...)))])))
          #t)
   (equal? (foo) '())
   (equal? (foo (a b) (c d e)) '((2 b a) (3 e d c)))
   (error? (expand '(foo . a)))
   (error? (expand '(foo a)))
   (error? (expand '(foo (a b . c) (d e f))))
   (error? (expand '(foo (a b c) . d)))
   (begin (define-syntax foo
            (lambda (x)
              (syntax-case x ()
                [(_ x ...)
                 (with-syntax ([(y1 y2 ...) (syntax (x ...))])
                   (with-syntax ([(z1 z2) (syntax y1)])
                     (syntax '(z2 z1))))])))
          #t)
   (equal? (foo (a b) (c d) (e f)) '(b a))
   (error? (expand '(foo)))       ;oops: "car: incorrect list structure"
   (error? (expand '(foo a b c))) ;oops: "cadr: incorrect list structure"
   (error? (define-syntax foo
             (lambda (x)
               (syntax-case x ()
                 [(_) (with-syntax ([(x x) '(1 2)]) 0)]))))
   (error? (define-syntax foo
             (lambda (x)
               (syntax-case x ()
                 [(_) (with-syntax ([x 1] [x 2]) 0)]))))
   (equal? (with-syntax ((x 3)) #'#&x) '#&3)
   (equal? (with-syntax ((x 3)) #'#(x)) '#(3))
   (equal? (list (with-syntax () (define x 3) x) 4) '(3 4))
   (equal? (list (with-syntax ([q 3]) (define x #'q) x) 4) '(3 4))
   (equal? (list (with-syntax ([q 3] [r 5]) (define x #'q) (cons x #'r)) 4) '((3 . 5) 4))
 )

(mat generate-temporaries
  (error? (generate-temporaries))
  (error? (generate-temporaries '(a b c) '(d e f)))
  (error? (generate-temporaries '(a b . c)))
  (error? (generate-temporaries (let ([x (list 'a 'b 'c)]) (set-cdr! (cddr x) (cdr x)) x)))
  (andmap identifier? (generate-temporaries '(a b c)))
  (= (length (generate-temporaries '(a b c))) 3)
  (andmap identifier? (generate-temporaries #'(a b c)))
  (= (length (generate-temporaries #'(a b c))) 3)
  (andmap identifier? (generate-temporaries (cons 'q #'(1 2 3))))
  (= (length (generate-temporaries (cons 'q #'(1 2 3)))) 4)
 ; make sure generate-temporaries isn't confused by annotations
  (begin
    (let ((op (open-output-file "testfile.ss" 'replace)))
      (pretty-print
        '(begin
           (define-syntax $gt-a
             (lambda (x)
               (syntax-case x ()
                 [(_ x)
                  (with-syntax ([(t1 t2 t3) (generate-temporaries #'(1 1 1))])
                    #'(define x (let ([t1 17] [t2 53] [t3 -10]) (cons* t2 t3 t1))))])))
           ($gt-a $gt-x))
        op)
        (close-output-port op)
        (compile-file "testfile.ss"))
    #t)
  (begin
    (load "testfile.so")
    #t)
  (equal? $gt-x '(53 -10 . 17))
)

(mat syntax->list
  (error? (syntax->list #'a))
  (error? (syntax->list #'(a b . e)))
  (eq? (syntax->list #'()) '())
  (andmap bound-identifier=? (syntax->list #'(a b c)) (list #'a #'b #'c))
  (not (pair? (car (syntax->list #'((a . b))))))
 ; just for comparison
  (pair? (car (syntax->datum #'((a . b)))))
)

(mat syntax->vector
  (error? (syntax->vector #'a))
  (error? (syntax->vector #'(a b . e)))
  (eq? (syntax->vector #'#()) '#())
  (andmap bound-identifier=? (vector->list (syntax->vector #'#(a b c))) (list #'a #'b #'c))
  (not (pair? (vector-ref (syntax->vector #'#((a . b))) 0)))
 ; just for comparison
  (pair? (vector-ref (syntax->datum #'#((a . b))) 0))
)

(mat syntax-errors
  (begin
    (define $do-one
      (lambda (x)
        (collect (collect-maximum-generation)) ; close ports left open by load/compile-file w/mat's error handler
        (let ((op (open-output-file "testfile.ss" 'replace)))
          (fprintf op "   ~%     ")
          (if (string? x)
              (fprintf op "~a~%" x)
              (parameterize ((pretty-initial-indent 5))
                (pretty-print x op)))
          (close-output-port op))
        (load "testfile.ss")))
    #t)

 ; fix "missing definition for exports" error to be like duplicate-id-error
 ; as is, no character position information is given
  (error? ($do-one '(module (y) (define x 3))))

 ; get no character position information for this
  (error? ($do-one '(let () (define x 3) (define-syntax x (identifier-syntax 4)) x)))

 ; these should possibly give position of invalid/duplicate id, not whole form
  (error? ($do-one '(let () (module (x) (define x 3) (define-syntax x (identifier-syntax 4))) x)))

  (error? ($do-one '(module (x) (define x 3) (define-syntax x (identifier-syntax 4)))))

  (error? ($do-one '(letrec ((3 4)) 5)))

  (error? ($do-one '(letrec-syntax ((3 4)) 5)))

 ; these should be okay:
  (error? ($do-one
            '(module (x)
               (module (x) (define a 1) (define a 2) (define x 3) (define x 4)))))

  (error? ($do-one '(a . b)))

  (error? ($do-one '(module (x) (define x 3) (define x 4))))

  (error? ($do-one '(module (x) (module (x) (define x 3) (define x 4)))))

  (error? ($do-one '(letrec ((x 3) (x 4)) x)))

  (error? ($do-one '(letrec-syntax ((x 3) (x 4)) x)))

  (error? ($do-one '(let () (module (x) (define x 3) (define x 4)) x)))

  (error? ($do-one '(let () (define x 3) (define x 4) x)))

  (error? ($do-one '(cond (a . b))))

  (error? ($do-one '(syntax-case (list 'a 'b) (a) ((_ b b) (syntax b)))))

  (error? ($do-one '(syntax-case (list 'a 'b) (a) ((_ a ...) 3 4 5))))

  (error? ($do-one '(syntax-case (list 'a 'b) (a ...) ((_ a ...) 3))))

  (error? ($do-one '(syntax a b)))

  (error? ($do-one '(if a b c d)))

  (error? ($do-one '(letrec ((x 3) (y 4) . (z 5)) (list x y z))))

  (error? ($do-one '(let () ($primitive 4 car))))

  (error? ($do-one '(syntax-case x)))

  (error? ($do-one '(quote a b)))

  (error? ($do-one '(fluid-let-syntax)))

  (error? ($do-one '(letrec-syntax () . 3)))

  (error? ($do-one '(lambda (x x) x)))

  (error? ($do-one '(lambda (x y) . z)))

  (error? ($do-one '(lambda (3) 3)))

  (error? ($do-one '(let ((x 4)) (set! x 3 5) x)))

  (error? ($do-one '(set! x 3 5)))

  (error? ($do-one '(let () (import . x) 3)))

  (error? ($do-one '(import . x)))

  (error? ($do-one '(let () (import (just scheme cons)))))

  (error? ($do-one '(import (just scheme cons))))

  (error? ($do-one '(module ((a . b)) c)))

  (error? ($do-one '(module (a . b) c)))

  (error? ($do-one '(define x y z)))

  (error? ($do-one '(define-syntax x y z)))

  (error? ($do-one '(case-lambda (()))))

  (error? ($do-one '(import m-not-defined)))

  (error? ($do-one '(let () (import m-not-defined) 3)))

  (error? ($do-one '(module () (import m-not-defined))))

  (error? ($do-one '(lambda (x) (define x 3))))

  (begin
    (define-syntax muck (lambda (x) 'x))
    #t)

  (error? ($do-one '(muck)))

  (error? ($do-one '(eval-when (compile load foo) bar)))

  (error? ($do-one '(let ((x 3) (y . 4)) (+ x y))))

  (error? ($do-one '(begin
                        (define-syntax $a
                          (lambda (x)
                            (syntax-case x ()
                              ((_ a b c)
                               (syntax-case #'(a b c) ()
                                 [(_ x y z) (quote (x y z))])))))
                        ($a 1 2 3))))
 ; [
  (error? ($do-one "'(a b (c d])")) ; )

  (error? ($do-one '(let () 
                      (define-syntax a
                        (lambda (x)
                          (syntax-case x ()
                            [a (datum->syntax #'a '(if 1))])))
                      a)))

  (error? ($do-one '(let ()
                      (define-syntax a
                        (syntax-rules ()
                          [(_ m i)
                           (module m (i)
                             (import m1))]))
                      (module m1 (xxx) (define xxx 155))
                      (a m2 xxx)
                      (let () (import m2) xxx))))

  (error? ($do-one '(let ()
                      (define-syntax a
                        (lambda (q)
                          #'(let ()
                              (define x 5)
                              (define-syntax x
                                (identifier-syntax 5))
                              x)))
                      a)))

  (error? ; attempt to assign immutable variable cons
    ($do-one '(begin
                (set! cons list)
                (cons 1 2 3))))

  (error? ; attempt to assign immutable variable x
    ($do-one
       '(begin
          (library ($selib1) (export (rename (a $selib1-a)))
            (import (rnrs))
            (define x 0)
            (define-syntax a 
              (syntax-rules ()
                [(_ n) (begin (set! x (+ x n)) x)])))
          (import ($selib1))
          ($selib1-a 17))))

  (error? ; attempt to assign immutable variable x
    ($do-one
       '(begin
          (library ($selib1) (export (rename (a $selib1-a)))
            (import (rnrs))
            (define x 0)
            (define-syntax a 
              (syntax-rules ()
                [(_) (begin (set! x (+ x 1)) x)])))
          (import ($selib1))
          ($selib1-a))))

  (error?
    (mat/cf
      (begin
        (define-syntax err-test
          (syntax-rules ()
            [(_ a b c) (list 'a 'b 'c)]))
        (err-test "wrong # args"))))

  (error? ($do-one '(let () 3 (module foo ()) 4)))
  (error? ($do-one '(let () 3 (module ()) 4)))
  (error? ($do-one '(let () 3 (import scheme) 4)))
  (error? ($do-one '(let () 3 (import-only scheme) 4)))
  (error? ($do-one '(let () 3 (module . foo) 4)))
  (error? ($do-one '(let () 3 (module) 4)))
  (error? ($do-one '(let () 3 (import . scheme) 4)))
  (error? ($do-one '(let () 3 (import-only . scheme) 4)))

  (error? ($do-one '(let () (define-syntax foo (syntax-rules () [(_ e) (if e)])) (foo 17))))

  (error? ($do-one
            `(let ()
               (define-syntax spam
                 (lambda (x)
                   #`(assert (let-syntax ([q '#,(lambda (x) #f)]) q))))
               spam)))
  (error? ($do-one
            '(let ()
               (define-syntax spam
                 (lambda (x)
                   #`(let-values ([(a b) (let-syntax ([q '#,(lambda (x) 3)]) q)])
                       (list a b))))
               spam)))
  (error? ($do-one
            '(let ()
               (define-syntax spam
                 (lambda (x)
                   #'(let ()
                       (define x 0)
                       (define y 1)
                       (define-property x y sort)
                       (let-values ([(a b c) (values x y)])
                         (list a b)))))
               spam)))
 )

; this is identical to the preceding except that $do-one calls compile-file instead
; of load.
(mat syntax-errors2
  (begin
    (define $do-one
      (lambda (x)
        (collect (collect-maximum-generation)) ; close ports left open by load/compile-file w/mat's error handler
        (let ((op (open-output-file "testfile.ss" 'replace)))
          (fprintf op "   ~%     ")
          (if (string? x)
              (fprintf op "~a~%" x)
              (parameterize ((pretty-initial-indent 5))
                (pretty-print x op)))
          (close-output-port op))
        (compile-file "testfile.ss")
        (load "testfile.so")))
    #t)

 ; fix "missing definition for exports" error to be like duplicate-id-error
 ; as is, no character position information is given
  (error? ($do-one '(module (y) (define x 3))))

 ; get no character position information for this
  (error? ($do-one '(let () (define x 3) (define-syntax x (identifier-syntax 4)) x)))

 ; these should possibly give position of invalid/duplicate id, not whole form
  (error? ($do-one '(let () (module (x) (define x 3) (define-syntax x (identifier-syntax 4))) x)))

  (error? ($do-one '(module (x) (define x 3) (define-syntax x (identifier-syntax 4)))))

  (error? ($do-one '(letrec ((3 4)) 5)))

  (error? ($do-one '(letrec-syntax ((3 4)) 5)))

 ; these should be okay:
  (error? ($do-one
            '(module (x)
               (module (x) (define a 1) (define a 2) (define x 3) (define x 4)))))

  (error? ($do-one '(a . b)))

  (error? ($do-one '(module (x) (define x 3) (define x 4))))

  (error? ($do-one '(module (x) (module (x) (define x 3) (define x 4)))))

  (error? ($do-one '(letrec ((x 3) (x 4)) x)))

  (error? ($do-one '(letrec-syntax ((x 3) (x 4)) x)))

  (error? ($do-one '(let () (module (x) (define x 3) (define x 4)) x)))

  (error? ($do-one '(let () (define x 3) (define x 4) x)))

  (error? ($do-one '(cond (a . b))))

  (error? ($do-one '(syntax-case (list 'a 'b) (a) ((_ b b) (syntax b)))))

  (error? ($do-one '(syntax-case (list 'a 'b) (a) ((_ a ...) 3 4 5))))

  (error? ($do-one '(syntax-case (list 'a 'b) (a ...) ((_ a ...) 3))))

  (error? ($do-one '(syntax a b)))

  (error? ($do-one '(if a b c d)))

  (error? ($do-one '(letrec ((x 3) (y 4) . (z 5)) (list x y z))))

  (error? ($do-one '(let () ($primitive 4 car))))

  (error? ($do-one '(syntax-case x)))

  (error? ($do-one '(quote a b)))

  (error? ($do-one '(fluid-let-syntax)))

  (error? ($do-one '(letrec-syntax () . 3)))

  (error? ($do-one '(lambda (x x) x)))

  (error? ($do-one '(lambda (x y) . z)))

  (error? ($do-one '(lambda (3) 3)))

  (error? ($do-one '(let ((x 4)) (set! x 3 5) x)))

  (error? ($do-one '(set! x 3 5)))

  (error? ($do-one '(let () (import . x) 3)))

  (error? ($do-one '(import . x)))

  (error? ($do-one '(let () (import (just scheme cons)))))

  (error? ($do-one '(import (just scheme cons))))

  (error? ($do-one '(module ((a . b)) c)))

  (error? ($do-one '(module (a . b) c)))

  (error? ($do-one '(define x y z)))

  (error? ($do-one '(define-syntax x y z)))

  (error? ($do-one '(case-lambda (()))))

  (error? ($do-one '(import m-not-defined)))

  (error? ($do-one '(let () (import m-not-defined) 3)))

  (error? ($do-one '(module () (import m-not-defined))))

  (error? ($do-one '(lambda (x) (define x 3))))

  (begin
    (define-syntax muck (lambda (x) 'x))
    #t)

  (error? ($do-one '(muck)))

  (error? ($do-one '(eval-when (compile load foo) bar)))

  (error? ($do-one '(let ((x 3) (y . 4)) (+ x y))))

  (error? ($do-one '(begin
                        (define-syntax $a
                          (lambda (x)
                            (syntax-case x ()
                              ((_ a b c)
                               (syntax-case #'(a b c) ()
                                 [(_ x y z) (quote (x y z))])))))
                        ($a 1 2 3))))
 ; [
  (error? ($do-one "'(a b (c d])")) ; )

  (error? ($do-one '(let () 
                      (define-syntax a
                        (lambda (x)
                          (syntax-case x ()
                            [a (datum->syntax #'a '(if 1))])))
                      a)))

  (error? ($do-one '(let ()
                      (define-syntax a
                        (syntax-rules ()
                          [(_ m i)
                           (module m (i)
                             (import m1))]))
                      (module m1 (xxx) (define xxx 155))
                      (a m2 xxx)
                      (let () (import m2) xxx))))

  (error? ($do-one '(let ()
                      (define-syntax a
                        (lambda (q)
                          #'(let ()
                              (define x 5)
                              (define-syntax x
                                (identifier-syntax 5))
                              x)))
                      a)))

  (error? ; ris #f: attempt to assign immutable variable cons
          ; ris #t: incorrect number of arguments to cons
    ($do-one '(begin
                (set! cons list)
                (set! cons #%cons)
                (cons 1 2 3))))

  (error? ; attempt to assign immutable variable x
    ($do-one
       '(begin
          (library ($selib1) (export (rename (a $selib1-a)))
            (import (rnrs))
            (define x 0)
            (define-syntax a 
              (syntax-rules ()
                [(_ n) (begin (set! x (+ x n)) x)])))
          (import ($selib1))
          ($selib1-a 17))))

  (error? ; attempt to assign immutable variable x
    ($do-one
       '(begin
          (library ($selib1) (export (rename (a $selib1-a)))
            (import (rnrs))
            (define x 0)
            (define-syntax a 
              (syntax-rules ()
                [(_) (begin (set! x (+ x 1)) x)])))
          (import ($selib1))
          ($selib1-a))))

  (error?
    (mat/cf
      (begin
        (define-syntax err-test
          (syntax-rules ()
            [(_ a b c) (list 'a 'b 'c)]))
        (err-test "wrong # args"))))

  (error? ($do-one '(let () 3 (module foo ()) 4)))
  (error? ($do-one '(let () 3 (module ()) 4)))
  (error? ($do-one '(let () 3 (import scheme) 4)))
  (error? ($do-one '(let () 3 (import-only scheme) 4)))
  (error? ($do-one '(let () 3 (module . foo) 4)))
  (error? ($do-one '(let () 3 (module) 4)))
  (error? ($do-one '(let () 3 (import . scheme) 4)))
  (error? ($do-one '(let () 3 (import-only . scheme) 4)))

  (error? ($do-one '(let () (define-syntax foo (syntax-rules () [(_ e) (if e)])) (foo 17))))

  ; make sure we don't get complaints from fasl writer due to procedures in the source
  ; information residualzied for the production of errors
  (error? ($do-one
            `(let ()
               (define-syntax spam
                 (lambda (x)
                   #`(assert (let-syntax ([q '#,(lambda (x) #f)]) q))))
               spam)))
  (error? ($do-one
            '(let ()
               (define-syntax spam
                 (lambda (x)
                   #`(let-values ([(a b) (let-syntax ([q '#,(lambda (x) 3)]) q)])
                       (list a b))))
               spam)))
  (error? ($do-one
            '(let ()
               (define-syntax spam
                 (lambda (x)
                   #'(let ()
                       (define x 0)
                       (define y 1)
                       (define-property x y sort)
                       (let-values ([(a b c) (values x y)])
                         (list a b)))))
               spam)))
 )

(mat define-structure
   (begin
     (define-structure ($tree left node right))
     #t)
   ($tree? (make-$tree 3 4 5))
   (let ((tr (make-$tree 'a 'b 'c)))
      (and (eq? ($tree-left tr) 'a)
           (eq? ($tree-node tr) 'b)
           (eq? ($tree-right tr) 'c)))
   (begin
     (define-structure (pare kar kdr)
        ((original-kar kar) (original-kdr kdr)))
     #t)
   (andmap procedure?
           (list make-pare
                 pare?
                 pare-kar
                 pare-kdr
                 pare-original-kar
                 pare-original-kdr
                 set-pare-kar!
                 set-pare-kdr!
                 set-pare-original-kar!
                 set-pare-original-kdr!))
   (pare? (make-pare 3 4))
   (eq? (pare-kar (make-pare 'a 'b)) 'a)
   (eq? (pare-kdr (make-pare 'a 'b)) 'b)
   (eq? (pare-original-kar (make-pare 'a 'b)) 'a)
   (eq? (pare-original-kdr (make-pare 'a 'b)) 'b)
   (let ((p (make-pare 'a 'b)))
      (set-pare-kar! p 'c)
      (set-pare-kdr! p 'd)
      (and (eq? (pare-kar p) 'c)
           (eq? (pare-kdr p) 'd)
           (eq? (pare-original-kar p) 'a)
           (eq? (pare-original-kdr p) 'b)))
 )

(mat module1
  (begin
    (module $foo ($a) (define $a 4) (define $b 5))
    (import $foo)
    (eq? $a 4))
  (error?
    (begin
      (module $foo ($a) (define $a 4) (define $b 5))
      (import $foo)
      $b))
  (eq? (let ()
         (module $foo ($a) (define $a 4) (define $b 5))
         (import $foo)
         $a)
       4)
  (error?
    (let ()
      (module $foo ($a) (define $a 4) (define $b 5))
      (import $foo)
      $b))
  (begin
    (module $foo ($a)
      (define-syntax $a (identifier-syntax 4))
      (define-syntax $b (identifier-syntax 5)))
    (import $foo)
    (eq? $a 4))
  (error?
    (begin
      (module $foo ($a)
        (define-syntax $a (identifier-syntax 4))
        (define-syntax $b (identifier-syntax 5)))
      (import $foo)
      $b))
  (eq? (let ()
         (module $foo ($a)
           (define-syntax $a (identifier-syntax 4))
           (define-syntax $b (identifier-syntax 5)))
         (import $foo)
         $a)
       4)
  (error?
    (let ()
      (module $foo ($a)
        (define-syntax $a (identifier-syntax 4))
        (define-syntax $b (identifier-syntax 5)))
      (import $foo)
      $b))
  (begin
    (module $foo (($a $b))
      (define-syntax $a (identifier-syntax $b))
      (define $b 400))
    (import $foo)
    (eq? $a 400))
  (error?
    (begin
      (module $foo ($a)
        (define-syntax $a (identifier-syntax $b))
        (define $b 400))
      (import $foo)
      $a))
  (eq? (let ()
         (module $foo (($a $b))
           (define-syntax $a (identifier-syntax $b))
           (define $b 400))
         (import $foo)
         $a)
       400)
  (eq? (let ()
         (module $foo ($a)
           (define-syntax $a (identifier-syntax $b))
           (define $b 400))
         (import $foo)
         $a)
       400)
  (begin
    (define-syntax anonymous-module
      (syntax-rules ()
        ((_ (exp ...) def ...)
         (begin
           (module $tmp (exp ...) def ...)
           (import $tmp)))))
    (anonymous-module ($x) (define $x 3))
    (eq? $x 3))
  (eq? (let () (anonymous-module ($x) (define $x 3)) $x) 3)
  (begin
    (define $y (lambda () $x))
    (anonymous-module ($x) (define $x 3))
    (eq? ($y) 3))
  (eq? (let ()
         (define $y (lambda () $x))
         (anonymous-module ($x) (define $x 3))
         ($y))
       3)
  (begin
    (anonymous-module (ok)
      (define $y 4)
      (define ok (lambda () $y)))
    (define $y (lambda () (ok)))
    (eq? ($y) 4))
 ; was an error before change to treat top-level begin like a <body>
  (begin
    (define $y (lambda () (rats)))
    (anonymous-module (rats)
      (define $y 4)
      (define rats (lambda () $y)))
    (eqv? ($y) 4))
  (eq? (let ()
         (define $y (lambda () ($x)))
         (anonymous-module ($x)
           (define $y 4)
           (define $x (lambda () $y)))
         ($y))
       4)
  (begin
    (anonymous-module ($a)
      (anonymous-module ($a)
        (define $a 3)))
    (eq? $a 3))
  (begin
    (anonymous-module ($a)
      (anonymous-module (($a $b))
        (define-syntax $a (identifier-syntax $b))
        (define $b 77)))
    (eq? $a 77))
  (begin
    (define-syntax defconst
      (syntax-rules ()
        ((_ $x e)
         (anonymous-module (($x t)) 
           (define-syntax $x (identifier-syntax t))
           (define t e)))))
    (defconst $a 3)
    (eq? $a 3))
  (error? (set! $a 4))
  (begin
    (module $qq ($q) (defconst $q 53))
    (eq? (let () (import $qq) $q) 53))
  (error? (let () (import $qq) (set! $q 4)))
  (begin (import $qq) (eq? $q 53))
  (error? (set! $q 4))
 ; repeat last set of tests for built-in anonymous modules
  (begin
    (module ($x) (define $x 3))
    (eq? $x 3))
  (eq? (let () (module ($x) (define $x 3)) $x) 3)
  (begin
    (define $y (lambda () $x))
    (module ($x) (define $x 3))
    (eq? ($y) 3))
  (eq? (let ()
         (define $y (lambda () $x))
         (module ($x) (define $x 3))
         ($y))
       3)
  (begin
    (module (ok)
      (define $y 4)
      (define ok (lambda () $y)))
    (define $y (lambda () (ok)))
    (eq? ($y) 4))
 ; was an error before change to treat top-level begin like a <body>
  (begin
    (define $y (lambda () (mice)))
    (module (mice)
      (define $y 4)
      (define mice (lambda () $y)))
    (eqv? ($y) 4))
  (eq? (let ()
         (define $y (lambda () ($x)))
         (module ($x)
           (define $y 4)
           (define $x (lambda () $y)))
         ($y))
       4)
  (begin
    (module ($a)
      (module ($a)
        (define $a 3)))
    (eq? $a 3))
  (begin
    (module ($a)
      (module (($a $b))
        (define-syntax $a (identifier-syntax $b))
        (define $b 77)))
    (eq? $a 77))
  (begin
    (define-syntax defconst
      (syntax-rules ()
        ((_ $x e)
         (module (($x t)) 
           (define-syntax $x (identifier-syntax t))
           (define t e)))))
    (defconst $a 3)
    (eq? $a 3))
  (error? (set! $a 4))
  (begin
    (module $qq ($q) (defconst $q 53))
    (eq? (let () (import $qq) $q) 53))
  (error? (let () (import $qq) (set! $q 4)))
  (begin (import $qq) (eq? $q 53))
  (error? (set! $q 4))
  (begin
    (module $prom ((del make-$prom) frc)
      (define-syntax del
        (syntax-rules ()
          ((_ exp) (make-$prom (lambda () exp)))))
      (define frc (lambda ($prom) ($prom)))
      (define make-$prom
        (lambda (th)
          (let ([val #f] [forced? #f])
            (lambda ()
              (if forced?
                  val
                  (let ([e (th)]) (set! forced? #t) (set! val e) e)))))))
    (module $tofu ($lazy-let)
      (import $prom)
      (define-syntax $lazy-let
        (lambda (form)
          (syntax-case form ()
            [(_ ((v e) ...) e1 e2 ...)
             #'(let ([v (del e)] ...)
                 (let-syntax ((v (identifier-syntax (frc v))) ...)
                   e1 e2 ...))]))))
    (module $test ($a)
      (import $tofu)
      (define-syntax push!
        (syntax-rules ()
          ((_ $x ls) (set! ls (cons $x ls)))))
      (define $a
        (lambda ()
          (let ((ls '()))
            (let ((w ($lazy-let (($x (begin (push! '$x ls) '$x))
                                 ($y (begin (push! '$y ls) '$y))
                                 ($z (begin (push! '$z ls) '$z)))
                       (if $x (list $x $y) $z))))
              (append w ls))))))
    (equal? (let () (import $test) ($a)) '($x $y $y $x)))
  (begin (import $test) (equal? ($a) '($x $y $y $x)))
  (error? (let () (module () (define $a 3) (define-syntax $a list)) 5))
  (eqv?
    (let ()
      (module $a ($x) (define $x 3) (set! $x (+ $x 1)))
      (import $a)
      $x)
    4)
  (eq? (let ()
         (module $foo ($a)
           (module $a ($b)
             (define-syntax $a (identifier-syntax $b))
             (define-syntax $b (identifier-syntax $c))
             (define $c 7)))
         (import $foo)
         (import $a)
         $b)
       7)
  (eq? (let ()
         (module $foo ($a) (module $a ($x) (define $x 3)))
         (import $foo)
         (import $a)
         $x)
       3)
  (begin
    (module $foo ($a) (module $a ($x) (define $x 3)))
    (import $foo)
    (import $a)
    (eq? $x 3))
  (error?
    (begin
      (module $foo ($a)
        (module $a ($b)
          (define-syntax $a (identifier-syntax $b))
          (define-syntax $b (identifier-syntax $c))
          (define $c 7)))
      (import $foo)
      (import $a)
      $b))
  (begin
    (module $foo ($a)
      (module $a (($b $c))
        (define-syntax $a (identifier-syntax $b))
        (define-syntax $b (identifier-syntax $c))
        (define $c 7)))
    (import $foo)
    (import $a)
    (eq? $b 7))
  (error?
    (begin
      (module $foo ($a)
        (module $a (($b $c))
          (define-syntax $a (identifier-syntax $c))
          (define-syntax $b (identifier-syntax $a))
          (define $c 7)))
      (import $foo)
      (import $a)
      (eq? $b 7)))
  (error?
   (begin
    (module $foo ($a)
      (module $a (($b $a))
        (define-syntax $a (identifier-syntax $c))
        (define-syntax $b (identifier-syntax $a))
        (define $c 7)))
    (import $foo)
    (import $a)
    (eq? $b 7)))
  (begin
    (module $foo ($a)
      (module $a (($b ($a $c)))
        (define-syntax $a (identifier-syntax $c))
        (define-syntax $b (identifier-syntax $a))
        (define $c 7)))
    (import $foo)
    (import $a)
    (eq? $b 7))
  (begin
    (module $foo ($a)
      (module $a (($b $a $c))
        (define-syntax $a (identifier-syntax $c))
        (define-syntax $b (identifier-syntax $a))
        (define $c 7)))
    (import $foo)
    (import $a)
    (eq? $b 7))
  (begin
    (module $foo ($a)
      (module $a (($b $a))
        (module (($a $c))
          (define-syntax $a (identifier-syntax $c))
          (define $c 7))
        (define-syntax $b (identifier-syntax $a))))
    (import $foo)
    (import $a)
    (eq? $b 7))
  (error?
    (begin
      (module $foo ($a)
        (define-syntax $a (identifier-syntax $b))
        (define-syntax $b (identifier-syntax 4)))
      (import $foo)
      $a))
  (eq? (let ()
         (module $foo ($a)
           (define-syntax $a (identifier-syntax $b))
           (define-syntax $b (identifier-syntax $c))
           (define $c 7))
         (import $foo)
         $a)
       7)
  (eq? (let ()
         (module $foo ($y)
           (module $x ($y)
             (define-syntax $y (identifier-syntax $z))
             (define $z 4))
           (import $x))
         (import $foo)
         $y)
       4)
  (eq? (let ()
         (module $foo ($y)
           (module $x (($y $z))
             (define-syntax $y (identifier-syntax $z))
             (define $z 4))
           (import $x))
         (import $foo)
         $y)
       4)
  (error?
    (begin
      (module $foo ($y)
        (module $x ($y)
          (define-syntax $y (identifier-syntax $z))
          (define $z 4))
        (import $x))
      (import $foo)
      $y))
  (begin
    (module $foo ($y)
      (module $x (($y $z))
        (define-syntax $y (identifier-syntax $z))
        (define $z 4))
      (import $x))
    (import $foo)
    (eq? $y 4))
  (eq? (let ()
         (module $foo ($y)
           (module $x ($y $z)
             (define-syntax $y (identifier-syntax $z))
             (define $z 4))
           (import $x))
         (import $foo)
         $y)
       4)
  (error?
    (begin
      (module $foo ($y)
        (module $x ($y $z)
          (define-syntax $y (identifier-syntax $z))
          (define $z 44))
        (import $x))
      (import $foo)
      (eq? $y 44)))
  (begin
    (module $foo ($y)
      (module $x (($y $z) $z)
        (define-syntax $y (identifier-syntax $z))
        (define $z 44))
      (import $x))
    (import $foo)
    (eq? $y 44))
  (begin
    (module $foo (($y $z))
      (module $x ($y $z)
        (define-syntax $y (identifier-syntax $z))
        (define $z 44))
      (import $x))
    (import $foo)
    (eq? $y 44))
  (error?
    (let ()
      (module $foo (($y $z))
        (module (($y $z))
          (define-syntax $y (identifier-syntax $z))
          (define $z 4)))
      (import $foo)
      $y))
  (error? ; undefined export $y
    (let ()
      (module $foo (($y $z))
        (define-syntax $y (identifier-syntax $z))
        (module ($y))
        (define $z 4))
      (import $foo)
      $y))
  (error? ; undefined export $z
    (let ()
      (module $foo ($y)
        (module (($y $z))
          (define-syntax $y (identifier-syntax $z)))
        (define $z 4))
      (import $foo)
      $y))
 ; following demonstrates "recursive" modules
  (equal?
    (let ()
      (module $one ($e)
        (define $e (lambda ($x) (or (zero? $x) ($o (- $x 1))))))
      (module $two ($o)
        (define $o (lambda ($x) (not ($e $x)))))
      (import $one)
      (import $two)
      (map (lambda ($x) (list ($o $x) ($e $x))) '(0 1 2 3 4 5)))
    '((#f #t) (#t #f) (#f #t) (#t #f) (#f #t) (#t #f)))
 ; "recursive" modules don't work at top level ...
  (error?
    (begin
      (module $one ($e)
        (define $e (lambda ($x) (or (zero? $x) ($o (- $x 1))))))
      (module $two ($o)
        (define $o (lambda ($x) (not ($e $x)))))
      (import $one)
      (import $two)
      (map (lambda ($x) ($o $x)) '(0 1 2 3 4 5))))
 ; ... unless encapsulated within a top-level module
  (begin
    (module ($e $o)
      (module $one ($e)
        (define $e (lambda ($x) (or (zero? $x) ($o (- $x 1))))))
      (module $two ($o)
        (define $o (lambda ($x) (not ($e $x)))))
      (import $one)
      (import $two))
    (equal?
      (map (lambda ($x) (list ($o $x) ($e $x))) '(0 1 2 3 4 5))
      '((#f #t) (#t #f) (#f #t) (#t #f) (#f #t) (#t #f))))
 ; the following set of tests, as with many others above, highlights the
 ; difference between the flexibility of local and rigidness of global
 ; export rules.  for the global, we need to explicitly list the implicit
 ; exports; for the global, we do not.
  (eq? (let ()
         (module $a ($alpha)
           (define-syntax $alpha (identifier-syntax $x))
           (module $b ($x) (define $x 3))
           (import $b))
         (import $a)
         $alpha)
       3)
  (error?
    (begin
      (module $a ($alpha)
        (define-syntax $alpha (identifier-syntax $x))
        (module $b ($x) (define $x 3))
        (import $b))
      (import $a)
      $alpha))
  (begin
    (module $a (($alpha $x))
      (define-syntax $alpha (identifier-syntax $x))
      (module $b ($x) (define $x 3))
      (import $b))
    (import $a)
    (eq? $alpha 3))
  (equal?
    (let ()
      (define $x "current outer value of $x")
      (let ()
        (module $a ($alpha)
          (define-syntax $alpha (identifier-syntax $x))
          (module $b ($y) (define $y 445) (define $x 3))
          (import $b))
        (import $a)
        $alpha))
    "current outer value of $x")
  (begin
    (define $x "current outer value of $x")
    (module $a ($alpha)
      (define-syntax $alpha (identifier-syntax $x))
      (module $b ($y) (define $y 445) (define $x 3))
      (import $b))
    (import $a)
    (equal? $alpha "current outer value of $x"))
  (begin
    (define-syntax $beta
      (syntax-rules ()
        ((_ x y)
         (begin
           (module x ($beta-a) (define $beta-a 666))
           (import x)
           (define-syntax y (identifier-syntax $beta-a))))))
    (eqv? (let () ($beta q t) t) 666))
  (error? (let () ($beta q t) $beta-a))
  (begin
    (define-syntax $gamma
      (syntax-rules ()
        ((_ x y)
         (begin
           (module x ($aaa) (define $aaa 666))
           (define y (lambda () (import x) $aaa))))))
    (eq? (let () ($gamma q t) (t)) 666))
  (error? (let () ($gamma q t) (import q) $aaa))
  (begin ($gamma $q $t) #t)
  (eqv? ($t) 666)
  (error? (let () (import $q) $aaa))
  (error? (begin (import $q) (eq? $aaa 666)))
  (error?
    (begin
      (define-syntax a
        (lambda (x)
          (syntax-case x ()
            ((_ e) #'(define x e)))))
      (a 3)))
  (error?
    (begin
      (define-syntax a
        (lambda (x)
          (syntax-case x ()
            ((_ e) #'(define-syntax x e)))))
      (a (identifier-syntax 4))))
  (error?
    (begin
      (define-syntax a
          (lambda (x)
            (syntax-case x ()
              ((_ i e) #'(module x (i) (define i e))))))
      (a b 'c)))
  (error? ; defnie not defined
    (module (y) (import-only (rnrs)) (defnie x 3) (define y 4)))
)

(mat module2
  (begin
    (define-syntax $define-structure
      (lambda (x)
        (define construct-name
          (lambda (template-identifier . args)
            (datum->syntax
              template-identifier
              (string->symbol
                (apply string-append
                       (map (lambda (x)
                              (if (string? x)
                                  x
                                  (symbol->string (syntax->datum x))))
                            args))))))
        (syntax-case x ()
          ((_ (name id1 ...))
           (andmap identifier? (syntax (name id1 ...)))
           (with-syntax
             ((constructor (construct-name (syntax name) "make-" (syntax name)))
              (predicate (construct-name (syntax name) (syntax name) "?"))
              ((access ...)
               (map (lambda (x) (construct-name x (syntax name) "-" x))
                    (syntax (id1 ...))))
              ((assign ...)
               (map (lambda (x)
                      (construct-name x "set-" (syntax name) "-" x "!"))
                    (syntax (id1 ...))))
              (structure-length
               (+ (length (syntax (id1 ...))) 1))
              ((index ...)
               (let f ((i 1) (ids (syntax (id1 ...))))
                  (if (null? ids)
                      '()
                      (cons i (f (+ i 1) (cdr ids)))))))
             (syntax (begin
                       (module name (constructor access ...)
                         (define constructor
                           (lambda (id1 ...)
                             (vector 'name id1 ... )))
                         (define access
                           (lambda (x)
                             (vector-ref x index)))
                         ...)
                       (import name))))))))
    (module $foo ($foos build-$foos)
      ($define-structure ($foos x))
      (define (build-$foos) (make-$foos 3)))
    (let ()
      (import $foo)
      (import $foos)
      (define x (build-$foos))
      (define y (make-$foos 4))
      (equal? (list ($foos-x x) ($foos-x y)) '(3 4))))
  (begin
    (import $foo)
    (import $foos)
    (define $x (build-$foos))
    (define $y (make-$foos 4))
    (equal? (list ($foos-x $x) ($foos-x $y)) '(3 4)))
  (let ()
    (define-syntax $define-structure
      (lambda (x)
        (define construct-name
          (lambda (template-identifier . args)
            (datum->syntax
              template-identifier
              (string->symbol
                (apply string-append
                       (map (lambda (x)
                              (if (string? x)
                                  x
                                  (symbol->string (syntax->datum x))))
                            args))))))
        (syntax-case x ()
          ((_ (name id1 ...))
           (andmap identifier? (syntax (name id1 ...)))
           (with-syntax
             ((constructor (construct-name (syntax name) "make-" (syntax name)))
              (predicate (construct-name (syntax name) (syntax name) "?"))
              ((access ...)
               (map (lambda (x) (construct-name x (syntax name) "-" x))
                    (syntax (id1 ...))))
              ((assign ...)
               (map (lambda (x)
                      (construct-name x "set-" (syntax name) "-" x "!"))
                    (syntax (id1 ...))))
              (structure-length
               (+ (length (syntax (id1 ...))) 1))
              ((index ...)
               (let f ((i 1) (ids (syntax (id1 ...))))
                  (if (null? ids)
                      '()
                      (cons i (f (+ i 1) (cdr ids)))))))
             (syntax (begin
                       (module name (constructor access ...)
                         (define constructor
                           (lambda (id1 ...)
                             (vector 'name id1 ... )))
                         (define access
                           (lambda (x)
                             (vector-ref x index)))
                         ...)
                       (import name))))))))
    (module $foo ($foos build-$foos)
      ($define-structure ($foos x))
      (define (build-$foos) (make-$foos 3)))
    (import $foo)
    (import $foos)
    (let ()
      (define x (build-$foos))
      (define y (make-$foos 4))
      (equal? (list ($foos-x x) ($foos-x y)) '(3 4))))
 )

(mat module3
  (equal? (let ()
            (module foo (thing) (define thing #f))
            (define set (lambda (x) (import foo) (set! thing x)))
            (define get (lambda () (import foo) thing))
            (let ([before (get)])
              (set 37)
              (list before (get))))
          '(#f 37))
  (eqv? (let ()
          (module foo (thing) (define thing #f))
          (define get (lambda () (import foo) thing))
          (import foo)
          (set! thing 37)
          (get))
        37)
  (eqv? (let ()
          (define x 45)
          (define-syntax def (identifier-syntax (define x 123)))
          (define-syntax fof (identifier-syntax (let () def x)))
          fof)
        45)
  (eqv? (let ()
          (define x 45)
          (define-syntax def (identifier-syntax (define x 123)))
          (define-syntax fof (identifier-syntax (let () def x)))
          (let () fof))
        45)
  (eqv? (let ()
          (define x 45)
          (define-syntax fof (identifier-syntax (let () (define x 123) x)))
          (let () fof))
        123)
  (eqv? (let ()
          (define x 45)
          (define-syntax def
            (identifier-syntax
              (begin (define x 123) (set! x (+ x x)))))
          (define-syntax fof (identifier-syntax (let () def x)))
          (let () fof))
        45)
  (eqv? (let ()
          (define x 45)
          (define-syntax def
            (syntax-rules ()
              ((_ id) (define id 123))))
          (define-syntax fof (identifier-syntax (let () (def x) x)))
          (let () fof))
        123)
  (eqv? (let ()
          (define x 45)
          (define-syntax fof
            (identifier-syntax
              (let ()
                (define-syntax def (identifier-syntax (define x 123)))
                def
                x)))
          (let () fof))
        45)
  (eqv? (let ()
          (define x 45)
          (define-syntax def (identifier-syntax (define x 123)))
          (define-syntax ref (identifier-syntax x))
          (let () def ref))
        45)
  (eqv? (let ()
          (define x 45)
          (define-syntax fof
            (identifier-syntax
              (let ()
                (define-syntax def
                  (lambda (x)
                    (syntax-case x ()
                      [id
                       (identifier? #'id)
                       (with-syntax ([var (datum->syntax #'id 'x)])
                         #'(define var 123))])))
                def
                x)))
          (let () fof))
        123)
  (eqv? (let ()
          (define x 45)
          (define-syntax zorpon (identifier-syntax define))
          (define-syntax fof (identifier-syntax (let () (zorpon x 123) x)))
          (let () fof))
        123)
  (eqv? (let ()
          (define x 45)
          (define-syntax def (identifier-syntax (zorpon x 123)))
          (define-syntax fof (identifier-syntax (let () def x)))
          (let () (fluid-let-syntax ((zorpon (identifier-syntax define))) fof)))
        45)
  (equal? (let ()
            (module foo (x) (define x 3))
            (define-syntax blah
              (lambda (x)
                (syntax-case x ()
                  [id
                   (identifier? #'id)
                   (with-syntax ([output
                                  (datum->syntax #'id
                                    '(let () (import foo) x))])
                     #'output)])))
            (cons blah (let () blah)))
        '(3 . 3))
  (equal? (let ()
            (module foo (x) (define x 3))
            (module bar (x) (define x 5))
            (define-syntax get
              (lambda (x)
                (syntax-case x ()
                  [(_ mod)
                   (identifier? #'mod)
                   (with-syntax ([var (datum->syntax #'mod 'x)])
                     #'(let () (import mod) var))])))
            (cons (get bar) (let () (get foo))))
          '(5 . 3))
  (equal? (let ()
            (module foo (x) (define x 3))
            (module bar (x) (define x 5))
            (define-syntax get
              (syntax-rules ()
                ((_ mod id) (let () (import mod) id))))
            (cons (get bar x) (let () (get foo x))))
          '(5 . 3))
  (equal? (let ((x 1))
            (module foo (x) (define x 3))
            (module bar (x) (define x 5))
            (define-syntax get-x
              (syntax-rules ()
                ((_ mod) (let () (import mod) x))))
            (cons (get-x bar) (let () (get-x foo))))
          '(1 . 1))
)

(mat module4
  (equal?
    (let ()
      (define-syntax import*
        (lambda (x)
          (syntax-case x ()
            [(_ mid) #'(import mid)]
            [(_ mid s1 s2 ...)
             (with-syntax ((((id ...) d ...)
                            (let f ((ls #'(s1 s2 ...)))
                              (if (null? ls)
                                  '(())
                                  (let ((rest (f (cdr ls))))
                                    (syntax-case (car ls) (as)
                                      [(as id1 id2)
                                       (cons (cons #'id2 (car rest))
                                             (cons #'(define-syntax id2
                                                       (identifier-syntax id1))
                                                   (cdr rest)))]
                                      [id (identifier? #'id)
                                       (cons (cons #'id (car rest))
                                             (cdr rest))]))))))
               #'(module (id ...) (import mid) d ...))])))
      (module m1 (x y) (define x 'x) (define y 'y))
      (list (let () (import* m1) (cons x y))
            (let () (import* m1 x y) (cons x y))
            (let () (import* m1 x) (define y 'yy) (cons x y))
            (let ((x 'outer)) (import* m1 (as x xx) y) (list* x xx y))))
    '((x . y) (x . y) (x . yy) (outer x . y)))
)

(mat module5
  (begin
    (module $zip (a b c)
      (define a 1)
      (define b 123)
      (define-syntax c (identifier-syntax (list a b))))
    (equal? (let () (import $zip) (list a b c))
            '(1 123 (1 123))))
  (eq? (let () (import-only $zip) a) 1)
  (error? (let () (import-only $zip) (list a b c)))
  (error? (let ((z list)) (import-only $zip) (z a b c)))
  (equal?
    (let ()
      (module bar (q r s)
        (import $zip)
        (define q (lambda () a))
        (define-syntax r (identifier-syntax b))
        (define s (lambda () c)))
      (list
        (let () (import bar) (q))
        (let () (import bar) r)
        (let () (import bar) (s))
        (let () (module (r) (import bar)) r)))
    '(1 123 (1 123) 123))
  (error?
    (let ()
      (module bar (q r s)
        (import $zip)
        (define q (lambda () a))
        (define-syntax r (identifier-syntax b))
        (define s (lambda () c)))
      (let ((q "outer")) (module (r) (import bar)) (q))))
  (begin
    (module $zoom (m1 x)
      (define x "this is x")
      (module m1 (x (z y))
        (define x "this is m1's x")
        (define y "this is m1's y")
        (define-syntax z (identifier-syntax y))))
    (equal? (let () (import $zoom) (let ((q x)) (import m1) (list q x z)))
            '("this is x" "this is m1's x" "this is m1's y")))
  (error? (let () (import $zoom) (define q x) (import m1) (list q x z)))
 ; check that we get the right x even though x (et al.) have
 ; multiple properties in the implementation.
  (begin
    (module $foo (x a b c)
      (define x "this is foo's X")
      (define a "this is foo's A")
      (define b "this is foo's B")
      (define c "this is foo's C"))
    (equal?
      (list (let () (import $foo) (list x a))
            (let () (import $foo) (list b c)))
      '(("this is foo's X" "this is foo's A")
        ("this is foo's B" "this is foo's C"))))
  (error? (let () (import $foo) (import $zip) #t))
)

(mat module6
  (begin
    (define-syntax $from1
      (syntax-rules ()
        ((_ m id)
         (let () (import-only m) id))))
    (define-syntax $from2
      (syntax-rules ()
        ((_ m id)
         (let () (module (id) (import m)) id))))
    (define-syntax $from3
      (syntax-rules ()
        [(_ m id)
         (let ([z (cons 1 2)])
           (let ([id z])
             (import m)
             (let ([t id])
               (if (eq? t z) (errorf 'from "~s undefined" 'id) t))))]))
    (module $frappe (wire (whip egg))
      (define wire 3)
      (define-syntax whip (identifier-syntax egg))
      (define egg 'whites))
    (equal?
      (list (cons ($from1 $frappe wire) ($from1 $frappe whip))
            (cons ($from2 $frappe wire) ($from2 $frappe whip))
            (cons ($from3 $frappe wire) ($from3 $frappe whip)))
      '((3 . whites) (3 . whites) (3 . whites))))
  (equal?
    (let ()
      (module q (m from)
        (module m (f) (define f "this is f"))
        (define-syntax from
          (syntax-rules () [(_ m id) (let () (import-only m) id)])))
      (let () (import-only q) (from m f)))
    "this is f")
  (begin
    (module $q (m from)
      (module m (f) (define f "this is f"))
      (define-syntax from
        (syntax-rules () [(_ m id) (let () (import-only m) id)])))
    (equal? (let () (import-only $q) (from m f)) "this is f"))
  (eqv? (let ()
          (module p ((d m) f)
            (define-syntax d
              (syntax-rules ()
                ((_ e) (m (lambda () e)))))
            (define m (lambda (x) x))
            (define f (lambda (th) (th))))
          (let () (import-only p) (f (d 2))))
        2)
  (begin
    (module $p ((d m) f)
      (define-syntax d
        (syntax-rules ()
          ((_ e) (m (lambda () e)))))
      (define m (lambda (x) x))
      (define f (lambda (th) (th))))
    (eqv? (let () (import-only $p) (f (d 2))) 2))
  (error? (let () (import-only $p) (f (d cons))))
)

(mat module7
  (begin (module ($x) (define $x 3) (set! $x (+ $x $x)))
    (eq? $x 6))
  (eq? (let () (module ($x) (define $x 3) (set! $x (+ $x $x))) $x) 6)
)

(mat module8
  (begin
    (module $m ($a $b)
      (define-syntax $a (identifier-syntax 3))
      (define-syntax $b (identifier-syntax $a)))
    (eq? (let ()
           (import $m)
           (fluid-let-syntax (($a (identifier-syntax 4))) $b))
         4))
  (eq? (let ()
         (import $m)
         (fluid-let-syntax (($a (identifier-syntax 4))) $a))
       4)
  (begin
    (import $m)
    (eq? (fluid-let-syntax (($a (identifier-syntax 4))) $b) 4))
  (begin
    (define-syntax $a
      (syntax-rules ()
        ((_ m y z)
         (begin
           (module m ($crazy-x) (define $crazy-x 3731))
           (import m)
           (define y (lambda () $crazy-x))
           (define-syntax z (identifier-syntax $crazy-x))))))
    #t)
  (begin
    ($a $crazy-p $crazy-q $crazy-r)
    (eq? $crazy-r 3731))
  (error? $crazy-x)
  (eq? ($crazy-q) 3731)
  (eq? $crazy-r 3731)
  (begin
    (define-syntax $a1
      (syntax-rules ()
        ((_ m y)
         (module m
           ($flash-x y)
           (define $flash-x "flash")
           (define y (lambda () $flash-x))))))
    #t)
  (begin ($a1 $flash-p $flash-q) #t)
  (begin (import $flash-p) (procedure? $flash-q))
  (error? $flash-x)
  (equal? ($flash-q) "flash")
  (begin
    (define-syntax $c
      (syntax-rules ()
        ((_ y)
         (begin
           (define-syntax $blast-x (identifier-syntax "blast"))
           (define-syntax y (identifier-syntax $blast-x))))))
    #t)
  (begin ($c $blast-y) (equal? $blast-y "blast"))
  (equal? $blast-y "blast")
  (error? $blast-x)
  (begin
    (define-syntax $b
      (syntax-rules ()
        ((_ y) (begin
                 (define $crud-x "crud")
                 (define y (lambda () $crud-x))))))
    #t)
  (begin ($b $crud-y) (procedure? $crud-y))
  (equal? ($crud-y) "crud")
  (error? $crud-x)
  (begin
    (define-syntax $b2
      (syntax-rules ()
        ((_ x y)
         (begin
           (define-syntax x
             (identifier-syntax
               (begin
                 (define $idiot-x "idiot")
                 $idiot-x)))
           (define y (lambda () $idiot-x))))))
    #t)
  (begin ($b2 $idiot-q $idiot-p) (procedure? $idiot-p))
  (equal? (let () $idiot-q) "idiot")
  (begin $idiot-q #t)
  (error? ($idiot-p))
 ; the following should probably generate an error, but doesn't due to
 ; our change in wraps (we apply only the most recent substitution)
 ; (error?
 ;   (begin
 ;     (define-syntax a
 ;       (lambda (?)
 ;         (with-syntax ((xx ((lambda (x) #'x) 4)))
 ;           #'(module (x) (define xx 3)))))
 ;     a))
  (eq? (let ((junk #f))
         (module (a) (import scheme)
            (define-syntax a
              (lambda (x)
                (syntax-case x (foo car)
                  ((_ foo car bar-lit cons-lit)
                   (and (free-identifier=? #'bar-lit #'bar)
                        (free-identifier=? #'cons-lit #'cons))
                   #''yup)))))
         (module () (import scheme)
           (set! junk (a foo car bar cons)))
         junk)
       'yup)
  (error? (let ((junk #f))
            (module (a) (import scheme)
               (define-syntax a
                 (lambda (x)
                   (syntax-case x (foo car)
                     ((_ foo car bar-lit cons-lit)
                      (and (free-identifier=? #'bar-lit #'bar)
                           (free-identifier=? #'cons-lit #'cons))
                      #''yup)))))
            (module () (import scheme)
              (define car 3)
              (set! junk (a foo car bar cons)))
            junk))
)

(mat module9
  (eq? (let () (import-only r5rs) (cond (else 0))) 0)
  (eq? (let () (import-only r5rs-syntax) (cond (else 0))) 0)
  (eq? (let () (import-only ieee) (cond (else 0))) 0)
  (eq? (let () (import-only scheme) (cond (else 0))) 0)
  (eq? (let () (import-only $system) (cond (else 0))) 0)
  (eq? (eval '(cond (else 0)) (scheme-report-environment 5)) 0)
  (eq? (eval '(cond (else 0)) (null-environment 5)) 0)
  (eq? (eval '(cond (else 0)) (interaction-environment)) 0)
  (eq? (eval '(cond (else 0)) (ieee-environment)) 0)
  (equal?
    (let ()
      (import-only scheme)
      (define-record foo ((immutable a)))
      (foo-a (make-foo 3)))
    3)
  (equal? (let ()
            (module foo (a b)
              (define-syntax a
                (syntax-rules (b)
                  ((_ b) "yup")
                  ((_ c) (list c))))
              (define-syntax b
                (lambda (x)
                  (syntax-error x "misplaced aux keyword"))))
            (let ()
              (import-only foo)
              (a (a b))))
          '("yup"))
  (equal? (let ()
            (import-only scheme)
            `(a b ,(+ 3 4) ,@(list 'd 'e)))
          '(a b 7 d e))
 ; assuming internal-defines-as-letrec* defaults to #t
  (internal-defines-as-letrec*)
 ; following tests assume it's set to #f
  (begin (internal-defines-as-letrec* #f) (not (internal-defines-as-letrec*)))
  (error? ; cookie undefined
    (begin
      (module ($b)
        (module (($b getvar))
          (define getvar (lambda () "it worked"))
          (module (($b cookie tmp))
            (define cookie "secret")
            (define tmp cookie)
            (define-syntax $b
              (identifier-syntax
                (if (eq? tmp cookie) (begin (set! tmp (getvar)) tmp) tmp))))))
      (string=? $b "it worked")))
  (begin (internal-defines-as-letrec* #t) (internal-defines-as-letrec*))
  (begin
    (module ($b)
      (module (($b getvar))
        (define getvar (lambda () "it worked"))
        (module (($b cookie tmp))
          (define tmp)
          (define cookie "secret")
          (define-syntax $b
            (identifier-syntax
              (if (eq? tmp cookie) (begin (set! tmp (getvar)) tmp) tmp)))
          (set! tmp cookie))))
    (string=? $b "it worked"))
  (begin
    (module $foo ($b)
      (module bar (($b getvar))
        (module baz (($b cookie tmp))
          (define cookie "secret")
          (define tmp)
          (define-syntax $b
            (identifier-syntax
              (if (eq? tmp cookie) (begin (set! tmp (getvar)) tmp) tmp)))
          (set! tmp cookie))
        (define getvar (lambda () "this also worked"))
        (import baz))
      (import bar))
    (import $foo)
    (string=? $b "this also worked"))
)

(mat module10
  (begin ; make sure we the right binding is exported
    (module ($module10-foo)
      (define $module10-foo "okay")
      (module () (define $module10-foo 'oh-oh)))
    #t)
  (equal? $module10-foo "okay")
  (begin
    (module ($module10-bar)
      (module () (define $module10-bar 'oh-oh))
      (define $module10-bar "fine"))
    #t)
  (equal? $module10-bar "fine")
  (begin
    (module ($module10-qwerty)
      (module ($module10-qwerty)
        (define $module10-qwerty "dandy")))
    #t)
  (equal? $module10-qwerty "dandy")
  (let ()
    (module (foo)
      (define foo "okay")
      (module () (define foo 'oh-oh)))
    (equal? foo "okay"))
  (let ()
    (module (bar)
      (module () (define bar 'oh-oh))
      (define bar "fine"))
    (equal? bar "fine"))
  (let ()
    (module (qwerty)
      (module (qwerty)
        (define qwerty "dandy")))
    (equal? qwerty "dandy"))
)

(mat module11
  (error? ; identifier out of context
    (module (x y)
      (define x 3)
      (define-syntax y (lambda (z) x))))
  (error? ; identifier out of context
    (let ()
      (module (x y)
        (define x 3)
        (define-syntax y (lambda (z) x)))
      y))
)

(mat with-implicit
  (error? ; invalid syntax
    (with-implicit))
  (error? ; invalid syntax
    (with-implicit foo (bar ...) e1 e2))
  (error? ; invalid syntax
    (with-implicit (a b c)))
  (error? ; invalid syntax
    (with-implicit (a b c) . d))
  (error? ; invalid syntax
    (with-implicit (a b c) d . e))
  (error? ; invalid syntax
    (with-implicit (1 2 3) d e))
  (error? ; invalid syntax
    (with-implicit (a 2 c) d e))
  (error? ; 15 is not an identifier
    (with-syntax ([a 15])
      (with-implicit (a b c) d e)))
  (eqv?
    (let ((borf 'borf-outer))
      (define-syntax frob
        (lambda (x)
          (syntax-case x ()
            [k (with-implicit (k borf) #'borf)])))
      frob)
    'borf-outer)
  (equal?
    (let ([borf 'borf-outer])
      (define-syntax frob
        (lambda (x)
          (syntax-case x ()
            [(k e)
             (with-implicit (k borf)
               #'(let () (define borf 'borf-inner) e))])))
      (list borf (frob (list borf))))
    '(borf-outer (borf-inner)))
  (equal?
    (let ()
      (define-syntax for
        (lambda (x)
          (syntax-case x ()
            [(k (e0 e1 e2) b1 b2 ...)
             (with-implicit (k break continue)
               #'(call/cc
                   (lambda (break)
                     e0
                     (let f ()
                       (when e1
                         (call/cc (lambda (continue) b1 b2 ...))
                         e2
                         (f))))))])))
      (define ls-in) 
      (define ls-out)
      (for ((begin (set! ls-in '(a b c d e f g h i j)) (set! ls-out '()))
            (not (null? ls-in))
            (set! ls-in (cdr ls-in)))
        (when (memq (car ls-in) '(c e)) (continue))
        (set! ls-out (cons (car ls-in) ls-out))
        (when (memq (car ls-in) '(g j)) (break)))
      ls-out)
    '(g f d b a))
)

(mat datum
  (error? (datum))
  (error? (datum a b c))
  (error? (datum . b))
  (equal? (datum (a b c)) '(a b c))
  (equal?
    (let ()
      (define-syntax ralph
        (lambda (x)
          (syntax-case x ()
            [(k a b)
             (fixnum? (datum a))
             (with-syntax ([q (datum->syntax #'k (make-list (datum a) 15))])
               #'(cons b 'q))]
            [(_ a b) #'(cons 'a 'b)])))
      (list (ralph 3 4) (ralph 3.0 4.0)))
    '((4 15 15 15) (3.0 . 4.0)))
)

(mat alias
  (error? ; invalid syntax
    (alias x "y"))
  (error? ; invalid syntax
    (alias 3 x))
  (eq? (let ((x 2)) (alias y x) y) 2)
  (equal?
    (let ((x "x"))          
      (define-syntax fool
        (let ()
          (alias y x)
          (lambda (z) #'y)))
      fool)
    "x")
  (equal?
    (let ()
      (define x "x")
      (alias y x)
      y)
    "x")
  (begin
    (module (($alias-blue blue))
      (define blue "bleu")
      (alias $alias-blue blue))
    (equal? $alias-blue "bleu"))
  (begin
    (define $alias-blot "blot")
    (equal? (let () (alias y $alias-blot) y) "blot"))
  (begin
    (define $alias-f (let () (alias x $alias-blarg) (lambda () x)))
    (procedure? $alias-f))
  (error? ; $alias-blarg not bound
    ($alias-f))
  (begin
    (define $alias-blarg "blarg")
    (equal? ($alias-f) "blarg"))
  (begin
    (define-syntax $alias-blarg (lambda (x) "bloog"))
    (equal? ($alias-f) "blarg"))
  (begin
    (define $alias-g (let () (alias x lambda) (x () "g")))
    (equal? ($alias-g) "g"))
  (begin
    (define $alias-x 3)
    (alias $alias-y $alias-x)
    (eq? $alias-y 3))
  (eq? (let ()
         (define $alias-x 4)
         (alias $alias-y $alias-x)
         $alias-y)
       4)
 ; the following is no longer an error: binding for label is exported
 ; if the alias's identifier is exported
  (begin
    (module ($alias-y)
      (define $alias-x 5)
      (alias $alias-y $alias-x))
    (eq? $alias-y 5))
  (begin
    (module ($alias-y55)
      (define $alias-x55 5)
      (alias $alias-y55 $alias-x55)
      (alias $alias-z55 $alias-x55))
    (eq? $alias-y 5))
  (error? $alias-x55)
  (error? $alias-z55)
  (begin
    (module (($alias-y $alias-x))
      (define $alias-x 6)
      (alias $alias-y $alias-x))
    (eq? $alias-y 6))
  (begin
    (module ($alias-y)
      (module (($alias-y $alias-x))
        (define $alias-x 66)
        (alias $alias-y $alias-x)))
    (eq? $alias-y 66))
  (eq? (let ()
         (module (($alias-y $alias-x))
           (define $alias-x 7)
           (alias $alias-y $alias-x))
         $alias-y)
       7)
  (eq? (let ((x 8))
         (module (y) (alias y x))
         y)
       8)
  (error? ; read-only environment
    (eval '(alias x cons) (scheme-environment)))
  (error? ; read-only environment
    (eval
      '(begin
         (import scheme)
         (alias $alias-cons cons)
         (set! $alias-cons 3))
      (copy-environment (interaction-environment))))
  (error? ; read-only environment
    (eval
      '(begin
         (import scheme)
         (set! cons 3))
      (copy-environment (interaction-environment))))
  (begin
    (module (($i-foo foo))
      (define-record foo ())
      (alias $i-foo foo))
    (define-record $i-bar $i-foo (x))
    ($i-bar? (make-$i-bar 3)))
  (begin
    (module ($i-foo)
      (module m (foo) (define-record foo ()))
      (module g2 (($i-foo g3))
        (module g2 ((g3 foo))
          (import m)
          (alias g3 foo))
        (import g2)
        (alias $i-foo g3))
      (import g2))
    (define-record $i-bar $i-foo (x))
    ($i-bar? (make-$i-bar 3)))
  (begin
    (module $alias-m ($alias:car) (import scheme) (alias $alias:car car))
    (import $alias-m)
    (eqv? ($alias:car '(2.3 4.5 6.7)) 2.3))
  (begin
    (library ($alias-a)
      (export x)
      (import (chezscheme))
      (define y 17)
      (alias x y))
    #t)
  (eqv? (let () (import ($alias-a)) x) 17)
  (error? ; attempt to create an alias to unbound identifier y
    (library ($alias-b)
      (export x)
      (import (chezscheme))
      (alias x y)))
  (error? ; attempt to create an alias to unbound identifier y
    (library ($alias-c)
      (export y)
      (import (chezscheme))
      (alias x y)
      (define y 17)))
  (begin
    (with-output-to-file "testfile-alias-d.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-alias-d)
             (export x)
             (import (chezscheme))
             (alias x y)
             (define y 17))))
      'replace)
    #t)
  (error? ; attempt to create an alias to unbound identifier y
    (compile-file "testfile-alias-d"))
  (error? ; attempt to create an alias to unbound identifier y
    (load "testfile-alias-d.ss"))
  (error? ; attempt to create an alias to unbound identifier y
    (library ($alias-b)
      (export x)
      (import (chezscheme))
      (let () (alias x y) 'hello)))
  (eqv?
    (let ()
      (import-only (chezscheme))
      (define y 17)
      (alias x y)
      x)
    17)
  (error? ; attempt to create an alias to unbound identifier y
    (let ()
      (import-only (chezscheme))
      (alias x y)
      7))
  (error? ; attempt to create an alias to unbound identifier y
    (let ()
      (import-only (chezscheme))
      (alias x y)
      (define y 3)
      7))
  (begin
    (with-output-to-file "testfile-alias-e.ss"
      (lambda ()
        (pretty-print
          '(let ()
             (import-only (chezscheme))
             (alias x y)
             (define y 3)
             7)))
      'replace)
    #t)
  (error? ; attempt to create an alias to unbound identifier y
    (compile-file "testfile-alias-e"))
  (error? ; attempt to create an alias to unbound identifier y
    (load "testfile-alias-e.ss"))
)

(mat extended-import
  (begin
    (module $notscheme (cons car cdr)
      (define cons)
      (define car)
      (define-syntax cdr (identifier-syntax $cdr)))
    #t)
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import scheme)
            (cons car cdr)))))
    (if (= (optimize-level) 3)
        '(#3%cons #3%car #3%cdr)
        '(#2%cons #2%car #2%cdr)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import (only scheme car cdr))
            (cons car cdr)))))
    (if (= (optimize-level) 3)
        '((#3%$top-level-value 'cons) #3%car #3%cdr)
        '((#2%$top-level-value 'cons) #2%car #2%cdr)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import (except scheme car cdr))
            (cons car cdr)))))
    (if (= (optimize-level) 3)
        '(#3%cons (#3%$top-level-value 'car) $cdr)
        '(#2%cons (#2%$top-level-value 'car) $cdr)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import (only (except scheme cdr) car))
            (cons car cdr)))))
    (if (= (optimize-level) 3)
        '((#3%$top-level-value 'cons) #3%car $cdr)
        '((#2%$top-level-value 'cons) #2%car $cdr)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import (add-prefix (only scheme car cdr) scheme:))
            (cons scheme:car cdr)))))
    (if (= (optimize-level) 3)
        '((#3%$top-level-value 'cons) #3%car $cdr)
        '((#2%$top-level-value 'cons) #2%car $cdr)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import (drop-prefix (only scheme car cdr cons) c))
            (ons ar dr)))))
    (if (= (optimize-level) 3)
        '(#3%cons #3%car #3%cdr)
        '(#2%cons #2%car #2%cdr)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import (rename scheme [car xar] [cdr xdr]))
            (cons xar cdr)))))
    (if (= (optimize-level) 3)
        '(#3%cons #3%car $cdr)
        '(#2%cons #2%car $cdr)))
  (equivalent-expansion?
    (parameterize ([#%$suppress-primitive-inlining #f])
      (expand '
        (let ()
          (import $notscheme)
          (let ()
            (import (alias scheme [car xar] [cdr xdr]))
            (cons xar cdr)))))
    (if (= (optimize-level) 3)
        '(#3%cons #3%car #3%cdr)
        '(#2%cons #2%car #2%cdr)))
  ; no glob support yet
  #;(equivalent-expansion?
      (parameterize ([#%$suppress-primitive-inlining #f])
        (expand '
          (let ()
            (import $notscheme)
            (let ()
              (import (glob scheme c*r))
              (cons car cdr)))))
    '(cons #2%car #2%cdr))
  (begin
    (module ($i-foo)
      (module m (foo) (define foo 45))
      (import (add-prefix m $i-)))
    (eq? $i-foo 45))
  (begin
    (library ($s) (export $spam)
      (import (scheme))
      (module m (spam) (define spam 3))
      (import (prefix m $)))
    (import ($s))
    (eqv? $spam 3))
  (begin
    (module ($i-foo)
      (module m (m:$i-foo) (define m:$i-foo 57))
      (import (drop-prefix m m:)))
    (eq? $i-foo 57))
  (begin
    (module ($i-foo)
      (module m (bar) (define bar 63))
      (import (rename m (bar $i-foo))))
    (eq? $i-foo 63))
  (begin
    (module ($i-foo)
      (module m (bar) (define bar 75))
      (import (alias m (bar $i-foo))))
    (eq? $i-foo 75))
  (begin
    (module ($i-x $i-y)
      (module m ($i-x $i-y) (define $i-x "x") (define $i-y "y"))
      (import (rename m ($i-y $i-x) ($i-x $i-y))))
    (equal? (list $i-x $i-y) '("y" "x")))
  (error? ; duplicate identifiers $i-x and $i-y
    (begin
      (module ($i-x $i-y)
        (module m ($i-x $i-y) (define $i-x "x") (define $i-y "y"))
        (import (alias m ($i-x $i-y) ($i-y $i-x))))
      (equal? (list $i-x $i-y) '("y" "x"))))
  (error? ; duplicate identifiers $i-x and $i-y
    (let ()
      (module ($i-x $i-y)
        (module m ($i-x $i-y) (define $i-x "x") (define $i-y "y"))
        (import (alias m ($i-x $i-y) ($i-y $i-x))))
      (equal? (list $i-x $i-y) '("y" "x"))))
  (begin
    (module ($i-foo)
      (module m (foo) (define-record foo ()))
      (import (rename m (foo $i-foo))))
    (define-record $i-bar $i-foo (x))
    ($i-bar? (make-$i-bar 3)))
  (let ()
    (module ($i-foo)
      (module m (foo) (define-record foo ()))
      (import (rename m (foo $i-foo))))
    (define-record $i-bar $i-foo (x))
    ($i-bar? (make-$i-bar 3)))
  (begin
    (module ($i-foo)
      (module m (foo) (module foo ($i-x) (define $i-x 14)))
      (import (rename m (foo $i-foo))))
    (import $i-foo)
    (eq? $i-x 14))
  (let ()
    (module ($i-foo)
      (module m (foo) (module foo ($i-x) (define $i-x 14)))
      (import (rename m (foo $i-foo))))
    (import $i-foo)
    (eq? $i-x 14))
  (error? ; y not visible
    (begin
      (module m (x y) (define x 3) (define y 4))
      (let ((x 5) (y 6)) (import-only (only m x)) y)))
  (error? ; y not visible
    (begin
      (module m (x y) (define x 3) (define y 4))
      (let ((x 5) (y 6))
       ; equivalent of (import-only (only m x)):
        (begin
          (module g0 (x) (import-only m))
          (import-only g0))
        y)))
  (begin ; keep with next
    (define $i-grotto-x 7)
    (define $i-grotto-y 8)
    (define $i-grotto-z 9)
    (equal? (list $i-grotto-x $i-grotto-y $i-grotto-z) '(7 8 9)))
  (begin ; keep with preceding
    (module $i-grotto ($i-grotto-x $i-grotto-y $i-grotto-z)
      (define $i-grotto-x 3)
      (define $i-grotto-y 4)
      (define $i-grotto-z 5))
    (import (only $i-grotto $i-grotto-x))
    (equal? (list $i-grotto-x $i-grotto-y $i-grotto-z) '(3 8 9)))
  (begin
    (import (rename (only scheme car) [car $i-car-from-scheme]))
    (eq? ($i-car-from-scheme '(a b c)) 'a))
  (begin
    (import (only (add-prefix scheme $i-scheme:) $i-scheme:list))
    (equal? ($i-scheme:list 3 4 5) '(3 4 5)))
  (begin
    (import (add-prefix (only scheme list) $i-scheme:))
    (equal? ($i-scheme:list 3 4 5) '(3 4 5)))
)

(mat import ; check import semantics changes May 05
  (begin
    (define $imp-x 0)
    (module $imp-m ($imp-x) (define $imp-x 3))
    (define-syntax $imp-from (syntax-rules () [(_ $imp-m $imp-x) (let () (import $imp-m) $imp-x)]))
    (define-syntax $imp-from-m (syntax-rules () [(_ $imp-x) (let () (import $imp-m) $imp-x)]))
    (define-syntax $imp-x-from (syntax-rules () [(_ $imp-m) (let () (import $imp-m) $imp-x)]))
    (define-syntax $imp-x-from-m (syntax-rules () [(_) (let () (import $imp-m) $imp-x)]))
    (define-syntax $imp-module*
      (syntax-rules ()
        [(_ (x ...) d ...)
         (begin (module t (x ...) d ...) (import t))]))
    (define-syntax $imp-import*
      (syntax-rules () [(_ m) (import m)]))
    #t)
  (eqv? ($imp-from $imp-m $imp-x) 3)
  (eqv? ($imp-from-m $imp-x) 0)
  (eqv? ($imp-x-from $imp-m) 0)
  (eqv? ($imp-x-from-m) 3)
  (eqv? (let () ($imp-from $imp-m $imp-x)) 3)
  (eqv? (let () ($imp-from-m $imp-x)) 0)
  (eqv? (let () ($imp-x-from $imp-m)) 0)
  (eqv? (let () ($imp-x-from-m)) 3)
  (eqv? (let () (module $imp-m ($imp-x) (define $imp-x 4)) ($imp-from $imp-m $imp-x)) 4)
  (eqv? (let () (module $imp-m ($imp-x) (define $imp-x 4)) ($imp-from-m $imp-x)) 0)
  (eqv? (let () (module $imp-m ($imp-x) (define $imp-x 4)) ($imp-x-from $imp-m)) 0)
  (eqv? (let () (module $imp-m ($imp-x) (define $imp-x 4)) ($imp-x-from-m)) 3)
  (eqv? (let () (module m (x) (define x 4)) ($imp-import* m) x) 4)
  (eqv? (let () ($imp-module* (x) (define y 5) (define x (lambda () y))) (x)) 5)
  (equal?
    (let ()
      (define-syntax module*
        (syntax-rules ()
          [(_ (x ...) d ...)
           (begin (module t (x ...) d ...) (import t))]))
      (define-syntax import* (syntax-rules () [(_ m) (import m)]))
      (define x 0)
      (module m (x) (define x 3))
      (define-syntax from (syntax-rules () [(_ m x) (let () (import m) x)]))
      (define-syntax from-m (syntax-rules () [(_ x) (let () (import m) x)]))
      (define-syntax x-from (syntax-rules () [(_ m) (let () (import m) x)]))
      (define-syntax x-from-m (syntax-rules () [(_) (let () (import m) x)]))
      (module* (a) (define b 'bee) (define a (lambda () b)))
      (list
        (let () (module m (x) (define x 4)) (from m x))
        (let () (module m (x) (define x 4)) (from-m x))
        (let () (module m (x) (define x 4)) (x-from m))
        (let () (module m (x) (define x 4)) (x-from-m))
        (let () (import* m) x)
        (a)))
    '(4 0 0 3 3 bee))
  (equal?
    (let ()
      (define-syntax alpha
        (syntax-rules ()
          [(_ m v e)
           (let ()
             (module m (v x)
               (define x 'introduced)
               (define v 'supplied))
             (list e (let () (import m) (list v x))))]))
      (let () (alpha q x (let () (import q) x))))
    '(supplied (supplied introduced)))
  (begin
    (module $imp-list ($imp-null? $imp-car $imp-cdr $imp-cons)
      (import (add-prefix (only scheme null? car cdr cons) $imp-)))
    (define-syntax $imp-a
      (syntax-rules ()
        ((_ x) (define-syntax x
                 (lambda (q)
                   (import (only $imp-list $imp-car))
                   #'$imp-car)))))
    ($imp-a $imp-foo)
    (eqv? $imp-foo #%car))
  (eqv?
    (let ()
      (module rat (fink dog) (define fink 'lestein) (define dog 'cat))
      (define-syntax a
        (syntax-rules ()
          ((_ x) (define-syntax x
                   (lambda (q)
                     (import (only rat fink))
                     #'fink)))))
      (a foo)
      foo)
    'lestein)
  (eqv?
    (let ()
      (module rat (fink dog) (define fink 'lestein) (define dog 'cat))
      (define-syntax a
        (syntax-rules ()
          ((_ x) (define-syntax x
                   (lambda (q)
                     (import (add-prefix rat r:))
                     #'r:fink)))))
      (a foo)
      foo)
    'lestein)
  (eqv?
    (let ()
      (module rat (fink dog) (define fink 'lestein) (define dog 'cat))
      (define-syntax a
        (syntax-rules ()
          ((_ x) (define-syntax x
                   (lambda (q)
                     (import (except rat dog))
                     #'fink)))))
      (a foo)
      foo)
    'lestein)
  (eqv?
    (let ()
      (module m (x) (define x 'x1))
      (define-syntax a
        (lambda (q)
          #'(let ([x 'x2])
              (module n (x) (import m))
              (let () (import n) x))))
      a)
    'x1)
  (eqv?
    (let ()
      (module m (x) (define x 'x1))
      (define-syntax a
        (lambda (q)
          #'(let ([x 'x2])
              (import m)
              x)))
      a)
    'x1)
  (error? ; duplicate definition for x
    (let ()
      (module m (x) (define x 'x1))
      (define-syntax a
        (lambda (q)
          #'(let ()
              (define x 'x2)
              (import m)
              x)))
      a))
  (error? ; duplicate definition for x
    (let ()
      (module m (x) (define x 'x1))
      (define-syntax a
        (lambda (q)
          #'(let ()
              (import m)
              (define x 'x2)
              x)))
      a))
  (equal?
    (let ()
      (import scheme)
      (import scheme)
      car)
    car)
  (error? ; "duplicate definition for car
    (let ()
      (import scheme)
      (import (rename scheme (cdr car)))
      car))
  (error? ; duplicate definition for car
    (let ()
      (module (car) (define car 'edsel))
      (import scheme)
      car))
  (error? ; duplicate definition for car
    (let ()
      (define-syntax a
        (lambda (q)
          #'(let ()
              (module (car) (define car 'edsel))
              (import scheme)
              car)))
      a))
  (equal?
    (let ()
      (define-syntax a
        (lambda (q)
          #'(let ()
              (import scheme)
              (import scheme)
              car)))
      a)
    car)
  (error? ; duplicate definition for x
    (let ()
      (define-syntax a
        (lambda (q)
          #'(let ()
              (define x 5)
              (define-syntax x (identifier-syntax 5))
              x)))
      a))
  (error? ; missing definition for export(s) (xxx).
    (let ()
      (define-syntax a
        (syntax-rules ()
          [(_ m i) (module m (i) (import m1))]))
      (module m1 (xxx) (define xxx 155))
      (a m2 xxx)
      (let () (import m2) xxx)))
  (equal?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))])
      (expand/optimize
        '(let-syntax ([a (lambda (x) #'(let () (import scheme) car))])
           a)))
    (if (= (optimize-level) 3) '#3%car '#2%car))
  (equal?
    (parameterize ([#%$suppress-primitive-inlining #f] [run-cp0 (lambda (cp0 x) (cp0 x))])
      (expand/optimize
        '(let-syntax ([a (syntax-rules ()
                           [(_ x)
                            (define-syntax x
                              (lambda (q)
                                (import scheme)
                                #'car))])])
           (a foo)
           foo)))
    (if (= (optimize-level) 3) '#3%car '#2%car))
  (error? ; read-only environment
    (eval '(import (rnrs)) (scheme-environment)))
  (error? ; invalid context for import
    (let ([x (import)]) x))
 ; check 10/27/2010 change to make sense of multiple modules/libraries
 ; within the same import-only form
  (equal?
    (let ()
      (module m1 (x) (define x box))
      (module m2 (y) (define y 772))
      (let ()
        (import-only m1 m2)
        (x y)))
    '#&772)
  (equal?
    (let ()
      (module m1 (x) (define x box))
      (module m2 (y) (define y 772))
      (let ()
        (import m1 m2)
        (x y)))
    '#&772)
  (error? ; unbound identifier list
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import-only m1 m2)
        (list x y))))
  (equal?
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import m1 m2)
        (list x y)))
    '(29 772))
  (equal?
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import-only scheme m1 m2)
        (list x y)))
    '(29 772))
  (equal?
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import scheme m1 m2)
        (list x y)))
    '(29 772))
  (equal?
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import-only (scheme) m1 m2)
        (list x y)))
    '(29 772))
  (equal?
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import (scheme) m1 m2)
        (list x y)))
    '(29 772))
  (equal?
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import-only m1 m2 (scheme))
        (list x y)))
    '(29 772))
  (equal?
    (let ()
      (module m1 (x) (define x 29))
      (module m2 (y) (define y 772))
      (let ()
        (import m1 m2 (scheme))
        (list x y)))
    '(29 772))
  (begin
    (library ($io A) (export p) (import (rnrs)) (define p 17))
    (library ($io B) (export q) (import (rnrs)) (define q (lambda (x) (cons 'q x))))
    (library ($io C) (export r) (import (chezscheme) ($io B))
      (import-only ($io A) (only (rnrs) define *))
      (define r (* p 2)))
    #t)
  (equal?
    (let ()
      (import-only ($io B) ($io C))
      (q r))
    '(q . 34))
  (error? ; unbound identifier p
    (let ()
      (import ($io A))
      (import-only ($io B) ($io C))
      (q p)))
  (begin
    (library ($io A) (export p) (import (rnrs)) (define p 17))
    (library ($io B) (export q) (import (rnrs)) (define q (lambda (x) (cons 'q x))))
    (library ($io C) (export r) (import (chezscheme) ($io B))
      (import ($io A) (only (rnrs) define *))
      (define r (* p 2)))
    #t)
  (equal?
    (let ()
      (import ($io B) ($io C))
      (q r))
    '(q . 34))
  (equal?
    (let ()
      (import ($io A))
      (import ($io B) ($io C))
      (q p))
    '(q . 17))
  (error? ; unbound identifier p
    (begin
      (library ($io A) (export p) (import (rnrs)) (define p 17))
      (library ($io B) (export q) (import (rnrs)) (define q (lambda (x) (cons 'q x))))
      (library ($io C) (export r) (import (chezscheme) ($io A))
        (import-only ($io B) (only (rnrs) define *))
        (define r (* p 2)))))
  (begin
    (library ($io A) (export p) (import (rnrs)) (define p 17))
    (library ($io B) (export q) (import (rnrs)) (define q (lambda (x) (cons 'q x))))
    (library ($io C) (export r) (import (chezscheme) ($io A))
      (import ($io B) (only (rnrs) define *))
      (define r (* p 2)))
    #t)
  (error? ; unbound identifier *
    (begin
      (library ($io A) (export p) (import (rnrs)) (define p 17))
      (library ($io B) (export q) (import (rnrs)) (define q (lambda (x) (cons 'q x))))
      (library ($io C) (export r) (import (chezscheme) ($io A))
        (import-only ($io B) (only (rnrs) define))
        (define r (* p 2)))))
  (begin
    (library ($io A) (export p) (import (rnrs)) (define p 17))
    (library ($io B) (export q) (import (rnrs)) (define q (lambda (x) (cons 'q x))))
    (library ($io C) (export r) (import (chezscheme) ($io A))
      (import ($io B) (only (rnrs) define))
      (define r (* p 2)))
    #t)
 ; check for let-like semantics for import w/multiple subforms
  (eq?
    (let ()
      (module A (B) (module B (x) (define x 'a-b)))
      (module B (x) (define x 'b))
      (let ()
        (import A B)
        x))
    'b)
  (eq?
    (let ()
      (module A (B) (module B (x) (define x 'a-b)))
      (module B (x) (define x 'b))
      (let ()
        (import-only A B)
        x))
    'b)
)

(mat export ; test stand-alone export form
  (error? ; export outside module or library
    (export))
  (error? ; export outside module or library
    (export cons))
  (error? ; export outside module or library
    (top-level-program
      (import (chezscheme))
      (export)))
  (let ()
    (export)
    #t)
  (error? ; nonempty export outside module or library
    (let ()
      (export cons)
      #t))
  (begin
    (module ()
      (define $ex-x 3)
      (export (rename ($ex-x $ex-y) ($ex-y $ex-x)))
      (define $ex-y 4))
    #t)
  (equal?
    (cons $ex-x $ex-y)
    '(4 . 3))
  (begin
    (library ($ex-A) (export) (import (chezscheme))
      (define $ex-x 7)
      (export (rename ($ex-x $ex-y) ($ex-y $ex-x)))
      (define $ex-y 9))
    #t)
  (equal?
    (let ()
      (import ($ex-A))
      (cons $ex-x $ex-y))
    '(9 . 7))
  (begin
    (import ($ex-A))
    #t)
  (equal?
    (cons $ex-x $ex-y)
    '(9 . 7))
  (equal?
    (let ()
      (module ()
        (define $ex-x 3)
        (export (rename ($ex-x $ex-y) ($ex-y $ex-x)))
        (define $ex-y 4))
      (cons $ex-x $ex-y))
    '(4 . 3))
  (begin
    (module $ex-m (x x)
      (define x 5)
      (export x))
    #t)
  (eqv? (let () (import $ex-m) x) 5)
  (eqv?
    (let ()
      (module (x x)
        (define x 5)
        (export x))
      x)
    5)
  (eqv?
    (let ()
      (module (x)
        (define x 5)
        (export x))
      x)
    5)
  (error? ; duplicate export
    (module (x)
      (define x 15)
      (define y 117)
      (export (rename (y x)))))
  (begin
   ; okay to export id twice as long as it has the same binding
    (library ($ex-B) (export x x) (import (chezscheme))
      (define x 25)
      (export x))
    #t)
  (eqv? (let () (import ($ex-B)) x) 25)
  (begin
   ; okay to export id twice as long as it has the same binding
    (library ($ex-B) (export x (rename (x x))) (import (chezscheme))
      (define x 25)
      (export x))
    #t)
  (eqv? (let () (import ($ex-B)) x) 25)
  (begin
   ; okay to export id twice as long as it has the same binding
    (library ($ex-B) (export x (rename (y x))) (import (chezscheme))
      (define x 25)
      (alias y x)
      (export x))
    #t)
  (eqv? (let () (import ($ex-B)) x) 25)
  (begin
    (library ($ex-B) (export x) (import (chezscheme))
      (define x 35)
      (export x))
    #t)
  (eqv? (let () (import ($ex-B)) x) 35)
  (begin
    (import ($ex-B))
    (eqv? x 35))
  (error? ; duplicate export
    (library ($ex-C) (export x) (import (chezscheme))
      (define x 5)
      (define y 17)
      (export (rename (y x)))))
  (equal?
    (let ()
      (module f ((a x y))
        (import (chezscheme))
        (define x 3)
        (define y 4)
        (define-syntax a (identifier-syntax (cons x y)))
        (export a))
      (import f)
      a)
    '(3 . 4))
  (equal?
    (let ()
      (module m ()
        (define x 3)
        (module m1 (x y)
          (define x 4)
          (define-syntax y (identifier-syntax x))
          (indirect-export y x))
        (export (import m1)))
      (let ()
        (import m)
        (list x y)))
    '(4 4))
  (equal?
    (let ()
      (module m ()
        (define x 3)
        (module m1 (x y)
          (define x 4)
          (define-syntax y (identifier-syntax x))
          (indirect-export y x))
        (export (import (only m1 y)) x))
      (let ()
        (import m)
        (list x y)))
    '(3 4))
  (begin
    (define-syntax $ex-export1
      (syntax-rules ()
        [(_ (m id ...)) (export (import (only m id ...)))]
        [(_ id) (export id)]))
    (define-syntax $ex-export
      (syntax-rules ()
        [(_ frob ...) (begin ($ex-export1 frob) ...)]))
    #t)
  (begin
    (module $ex-mm ()
      ($ex-export)
      (define x 3)
      (module m1 ()
        ($ex-export x y)
        (define x 4)
        (define-syntax y (identifier-syntax x))
        (indirect-export y x))
      ($ex-export (m1 y) x))
    #t)
  (equal?
    (let ()
      (import $ex-mm)
      (list x y))
    '(3 4))
  (equal?
    (let ()
      (module m ()
        ($ex-export)
        (define x 3)
        (module m1 ()
          ($ex-export x y)
          (define x 4)
          (define-syntax y (identifier-syntax x))
          (indirect-export y x))
        ($ex-export (m1 y) x))
      (let ()
        (import m)
        (list x y)))
    '(3 4))
  (begin
    (with-output-to-file "testfile-ex1a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex1a)
             (export q)
             (import (chezscheme))
             (define-syntax q (identifier-syntax 17)))))
      'replace)
    (with-output-to-file "testfile-ex1b.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex1b)
             (export)
             (import (chezscheme))
             (define x 22)
             (export x (import (testfile-ex1a))))))
      'replace)
    (for-each separate-compile '(ex1a ex1b))
    #t)
  (equal?
    (let () (import (testfile-ex1b)) (list x q))
    '(22 17))
  (begin
    (with-output-to-file "testfile-ex2a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex2a)
             (export q)
             (import (chezscheme))
             (define-syntax q (identifier-syntax 17)))))
      'replace)
    (with-output-to-file "testfile-ex2b.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex2b)
             (export)
             (import (chezscheme))
             (define x 22)
             (export (rename (x q)) (import (prefix (rename (testfile-ex2a) (q que)) pi))))))
      'replace)
    (for-each separate-compile '(ex2a ex2b))
    #t)
  (equal?
    (let () (import (testfile-ex2b)) (list q pique))
    '(22 17))
  (begin
    (with-output-to-file "testfile-ex3a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex3a)
             (export q)
             (import (chezscheme))
             (implicit-exports #f)
             (indirect-export a x)
             (define x 17)
             (define-syntax a (identifier-syntax (* x 2)))
             (indirect-export q a)
             (define-syntax q (identifier-syntax (+ a 1))))))
      'replace)
    (with-output-to-file "testfile-ex3b.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex3b)
             (export)
             (import (chezscheme))
             (define x 22)
             (export (rename (x q)) (import (prefix (rename (testfile-ex3a) (q que)) pi))))))
      'replace)
    (for-each separate-compile '(ex3a ex3b))
    #t)
  (equal?
    (let () (import (testfile-ex3b)) (list q pique))
    '(22 35))
  (begin
    (with-output-to-file "testfile-ex4a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex4a)
             (export q)
             (import (chezscheme))
             (implicit-exports #f)
             (define x 17)
             (define-syntax a (identifier-syntax (* x 2)))
             (define-syntax q (identifier-syntax (+ a 1))))))
      'replace)
    (with-output-to-file "testfile-ex4b.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-ex4b)
             (export)
             (import (chezscheme))
             (define x 22)
             (export (rename (x q)) (import (prefix (rename (testfile-ex4a) (q que)) pi))))))
      'replace)
    (for-each separate-compile '(ex4a ex4b))
    #t)
  (error? ; attempt to reference unexported identifier a
    (let () (import (testfile-ex4b)) (list q pique)))
)

(define eval-test
  (lambda (expr)
    (eval expr)
    #t))
(define load-test
  (lambda (expr)
    (with-output-to-file "testfile.ss"
      (lambda () (pretty-print expr))
      'replace)
    (load "testfile.ss")
    #t))
(define compile-test
  (lambda (expr)
    (with-output-to-file "testfile.ss"
      (lambda () (pretty-print expr))
      'replace)
    (compile-file "testfile.ss")
    (load "testfile.so")
    #t))

(define-syntax errmat
  (lambda (x)
    (syntax-case x ()
      [(_ name expr ...)
       (let ([make-name (lambda (x) (datum->syntax #'name (string->symbol (format "~s-~s" x (datum name)))))])
         #`(begin
             (mat #,(make-name 'eval) (error? (eval-test 'expr)) ...)
             (mat #,(make-name 'load) (error? (load-test 'expr)) ...)
             (mat #,(make-name 'compile) (error? (compile-test 'expr)) ...)))])))

(errmat export-errors
 ; attempt to export multiple bindings for x
  (module A ()
    (define x 5)
    (define y 6)
    (export (rename (y x)) x))
 ; attempt to export multiple bindings for x
  (module ()
    (module A ()
      (define x 5)
      (define y 6)
      (export (rename (y x)) x)))
 ; attempt to export multiple bindings for x
  (let ()
    (module A ()
      (define x 5)
      (define y 6)
      (export (rename (y x)) x))
    0)
 ; attempt to export multiple bindings for x
  (library (A) (export) (import (chezscheme))
    (define x 5)
    (define y 6)
    (export (rename (y x)) x))
 ; attempt to export multiple bindings for x
  (module A ()
    (define x 5)
    (define y 6)
    (export x (rename (y x))))
 ; attempt to export multiple bindings for x
  (module ()
    (module A ()
      (define x 5)
      (define y 6)
      (export x (rename (y x)))))
 ; attempt to export multiple bindings for x
  (let ()
    (module A ()
      (define x 5)
      (define y 6)
      (export x (rename (y x))))
    0)
 ; attempt to export multiple bindings for x
  (library (A) (export) (import (chezscheme))
    (define x 5)
    (define y 6)
    (export x (rename (y x))))
 ; attempt to export multiple bindings for x
  (module A ()
    (define x 5)
    (module B (x) (define x 6))
    (export x (import B)))
 ; attempt to export multiple bindings for x
  (module ()
    (module A ()
      (define x 5)
      (module B (x) (define x 6))
      (export x (import B))))
 ; attempt to export multiple bindings for x
  (let ()
    (module A ()
      (define x 5)
      (module B (x) (define x 6))
      (export x (import B)))
    0)
 ; attempt to export multiple bindings for x
  (library (A) (export) (import (chezscheme))
    (define x 5)
    (module B (x) (define x 6))
    (export x (import B)))
 ; attempt to export multiple bindings for x
  (module A ()
    (define x 5)
    (module B (x) (define x 6))
    (export (import B) x))
 ; attempt to export multiple bindings for x
  (module ()
    (module A ()
      (define x 5)
      (module B (x) (define x 6))
      (export (import B) x)))
 ; attempt to export multiple bindings for x
  (let ()
    (module A ()
      (define x 5)
      (module B (x) (define x 6))
      (export (import B) x))
    0)
 ; attempt to export multiple bindings for x
  (library (A) (export) (import (chezscheme))
    (define x 5)
    (module B (x) (define x 6))
    (export (import B) x))
 ; attempt to export multiple bindings for x
  (module A ()
    (module B (x) (define x 6))
    (module C (x) (define x 7))
    (export (import C) (import B)))
 ; attempt to export multiple bindings for x
  (module ()
    (module A ()
      (module B (x) (define x 6))
      (module C (x) (define x 7))
      (export (import C) (import B))))
 ; attempt to export multiple bindings for x
  (let ()
    (module A ()
      (module B (x) (define x 6))
      (module C (x) (define x 7))
      (export (import C) (import B)))
    0)
 ; attempt to export multiple bindings for x
  (library (A) (export) (import (chezscheme))
    (module B (x) (define x 6))
    (module C (x) (define x 7))
    (export (import C) (import B)))
 ; missing import y
  (module A ()
    (module B (x) (define x 6))
    (export (import (only B y))))
 ; missing import y
  (module ()
    (module A ()
      (module B (x) (define x 6))
      (export (import (only B y)))))
 ; missing import y
  (let ()
    (module A ()
      (module B (x) (define x 6))
      (export (import (only B y))))
    0)
 ; missing import y
  (library (A) (export) (import (chezscheme))
    (module B (x) (define x 6))
    (export (import (only B y))))
 ; missing import y
  (module A ()
    (module B (x) (define x 6))
    (export (import (rename B (y z)))))
 ; missing import y
  (module ()
    (module A ()
      (module B (x) (define x 6))
      (export (import (rename B (y z))))))
 ; missing import y
  (let ()
    (module A ()
      (module B (x) (define x 6))
      (export (import (rename B (y z)))))
    0)
 ; missing import y
  (library (A) (export) (import (chezscheme))
    (module B (x) (define x 6))
    (export (import (rename B (y z)))))
 ; library (rename B y z) not found
  (module A ()
    (module B (x) (define x 6))
    (export (import (rename B y z))))
 ; library (rename B y z) not found
  (module ()
    (module A ()
      (module B (x) (define x 6))
      (export (import (rename B y z)))))
 ; library (rename B y z) not found
  (let ()
    (module A ()
      (module B (x) (define x 6))
      (export (import (rename B y z))))
    0)
 ; library (rename B y z) not found
  (library (A) (export) (import (chezscheme))
    (module B (x) (define x 6))
    (export (import (rename B y z))))
 ; missing expected prefix foo: x
  (module A ()
    (module B (x) (define foo:y 5) (define x 6))
    (export (import (drop-prefix B foo:))))
 ; missing expected prefix foo: x
  (module ()
    (module A ()
      (module B (x) (define foo:y 5) (define x 6))
      (export (import (drop-prefix B foo:)))))
 ; missing expected prefix foo: x
  (let ()
    (module A ()
      (module B (x) (define foo:y 5) (define x 6))
      (export (import (drop-prefix B foo:))))
    0)
 ; missing expected prefix foo: x
  (library (A) (export) (import (chezscheme))
    (module B (x) (define foo:y 5) (define x 6))
    (export (import (drop-prefix B foo:))))
)

(mat indirect-export ; test stand-alone indirect-export form
  (error? ; invalid indirect-export syntax
    (module $ie-f (($ie-a x))
      (import (chezscheme))
      (define x '$ie-x)
      (indirect-export ($ie-a y z))
      (define y '$ie-y)
      (define-syntax $ie-a (identifier-syntax (list x y z)))
      (define z '$ie-z)))
  (error? ; export z undefined
    (module $ie-f (($ie-a x))
      (import (chezscheme))
      (define x '$ie-x)
      (indirect-export $ie-a y z)
      (define y '$ie-y)
      (define-syntax $ie-a (identifier-syntax (list x y z)))))
  (begin
    (module $ie-f ($ie-a)
      (import (chezscheme))
      (define-syntax $ie-a (identifier-syntax (list z)))
      (define z '$ie-z))
    #t)
  (error? ; attempt to reference unexported identifier z
    (let () (import $ie-f) $ie-a))
  (begin
    (module $ie-f (($ie-a z))
      (import (chezscheme))
      (define-syntax $ie-a (identifier-syntax (list z)))
      (define z '$ie-z))
    #t)
  (equal?
    (let () (import $ie-f) $ie-a)
    '($ie-z))
  (begin
    (module $ie-f ($ie-a)
      (import (chezscheme))
      (indirect-export $ie-a z)
      (define-syntax $ie-a (identifier-syntax (list z)))
      (define z '$ie-z))
    #t)
  (equal?
    (let () (import $ie-f) $ie-a)
    '($ie-z))
  (begin
    (module $ie-f ()
      (import (chezscheme))
      (export $ie-a)
      (indirect-export $ie-a z)
      (define-syntax $ie-a (identifier-syntax (list z)))
      (define z '$ie-z))
    #t)
  (equal?
    (let () (import $ie-f) $ie-a)
    '($ie-z))
  (begin
    (module $ie-f ()
      (import (chezscheme))
      (indirect-export $ie-a z)
      (export $ie-a)
      (define-syntax $ie-a (identifier-syntax (list z)))
      (define z '$ie-z))
    #t)
  (equal?
    (let () (import $ie-f) $ie-a)
    '($ie-z))
  (begin
    (module $ie-f (($ie-a x))
      (import (chezscheme))
      (define x '$ie-x)
      (indirect-export $ie-a z)
      (define y '$ie-y)
      (define-syntax $ie-a (identifier-syntax (list x y z)))
      (define z '$ie-z)
      (indirect-export $ie-a y))
    #t)
  (equal?
    (let () (import $ie-f) $ie-a)
    '($ie-x $ie-y $ie-z))
  (begin
    (module $ie-g ()
      (define x 3)
      (define y 4)
      (define-syntax a (identifier-syntax (list x y)))
      (alias b a)
      (export a b)
      (indirect-export a x)
      (indirect-export b y))
    #t)
  (equal?
    (let () (import $ie-g) a)
    '(3 4))
  (begin
    (module $ie-h ((cons x))
      (define-property cons car #'x)
      (define x 3))
    #t)
  (eqv?
    (let ()
      (define-syntax ref-prop
        (lambda (x)
          (lambda (r)
            (syntax-case x ()
              [(_ id key) (r #'id #'key)]))))
      (import $ie-h)
      (ref-prop cons car))
    3)
  (begin
    (module $ie-h (cons)
      (define-property cons car #'x)
      (define x 3))
    #t)
  (error? ; unexported identifier x
    (let ()
      (define-syntax ref-prop
        (lambda (x)
          (lambda (r)
            (syntax-case x ()
              [(_ id key) (r #'id #'key)]))))
      (import $ie-h)
      (ref-prop cons car)))
  (begin
    (module $ie-h (cons)
      (implicit-exports #t)
      (define-property cons car #'x)
      (define x 3))
    #t)
  (eqv?
    (let ()
      (define-syntax ref-prop
        (lambda (x)
          (lambda (r)
            (syntax-case x ()
              [(_ id key) (r #'id #'key)]))))
      (import $ie-h)
      (ref-prop cons car))
    3)
  (error? ; undefine export x
    (library ($ie-i)
      (export a)
      (import (chezscheme))
      (define-syntax a (identifier-syntax x))
      (indirect-export a x)))
)

(mat implicit-exports ; test stand-alone implicit-exports form
  (error? ; invalid syntax
    (implicit-exports))
  (error? ; invalid syntax
    (+ (implicit-exports) 3))
  (error? ; invalid syntax
    (+ (implicit-exports yes!) 3))
  (error? ; invalid syntax
    (+ (implicit-exports no way!) 3))
  (error? ; outside of module or library
    (implicit-exports #t))
  (error? ; invalid context for definition
    (+ (implicit-exports #f) 3))
  (begin
    (module $ie-A (a) (import (chezscheme))
      (define-syntax a (identifier-syntax x))
      (define x 3))
    #t)
  (error? ; unexported identifier x
    (let () (import $ie-A) a))
  (begin
    (module $ie-A (a) (import (chezscheme))
      (implicit-exports #t)
      (define-syntax a (identifier-syntax x))
      (define x 3))
    #t)
  (eqv?
    (let () (import $ie-A) a)
    3)
  (begin
    (module $ie-A (a) (import (chezscheme))
      (implicit-exports #f)
      (define-syntax a (identifier-syntax x))
      (define x 3))
    #t)
  (error? ; unexported identifier x
    (let () (import $ie-A) a))
  (begin
    (library ($ie-A) (export a) (import (chezscheme))
      (define-syntax a (identifier-syntax x))
      (define x 3))
    #t)
  (eqv?
    (let () (import ($ie-A)) a)
    3)
  (begin
    (library ($ie-A) (export a) (import (chezscheme))
      (implicit-exports #f)
      (define-syntax a (identifier-syntax x))
      (define x 3))
    #t)
  (error? ; unexported identifier x
    (let () (import ($ie-A)) a))
  (begin
    (library ($ie-A) (export a) (import (chezscheme))
      (implicit-exports #t)
      (define-syntax a (identifier-syntax x))
      (define x 3))
    #t)
  (eqv?
    (let () (import ($ie-A)) a)
    3)
  (begin
    (module $ie-A (a) (import (chezscheme))
      (module (a)
        (define-syntax a (identifier-syntax x))
        (define x 3)))
    #t)
  (error? ; unexported identifier x
    (let () (import $ie-A) a))
  (begin
    (module $ie-A (a) (import (chezscheme))
      (module ((a x))
        (define-syntax a (identifier-syntax x))
        (define x 3)))
    #t)
  (eqv?
    (let () (import $ie-A) a)
    3)
  (begin
    (module $ie-A (a) (import (chezscheme))
      (module (a)
        (implicit-exports #f)
        (define-syntax a (identifier-syntax x))
        (define x 3)))
    #t)
  (error? ; unexported identifier x
    (let () (import $ie-A) a))
  (begin
    (module $ie-A (a) (import (chezscheme))
      (module (a)
        (implicit-exports #t)
        (define-syntax a (identifier-syntax x))
        (define x 3)))
    #t)
  (eqv?
    (let () (import $ie-A) a)
    3)
  (begin
    (module $ie-B (a) (import (chezscheme))
      (define-syntax a (identifier-syntax x))
      (module (x) (module (x (a x)) (define a 4) (define x 3))))
    #t)
  (error? ; unexported identifier x
    (let () (import $ie-B) a))
  (begin
    (module $ie-B (a) (import (chezscheme))
      (define-syntax a (identifier-syntax x))
      (indirect-export a x)
      (module (x) (module (x (a x)) (define a 4) (define x 3))))
    #t)
  (eqv?
    (let () (import $ie-B) a)
    3)
  (begin
    (module $ie-C (a) (import (chezscheme))
      (module ((b x))
        (define-syntax b (identifier-syntax x))
        (define x 3))
      (alias a b))
    #t)
  (eqv?
    (let () (import $ie-C) a)
    3)
  (begin
    (module $ie-C (a) (import (chezscheme))
      (module (b)
        (define-syntax b (identifier-syntax x))
        (define x 3))
      (alias a b))
    #t)
  (error? ; unexported identifier x
    (let () (import $ie-C) a))
  (begin
    (module $ie-C (a) (import (chezscheme))
      (module (b)
        (indirect-export b x)
        (define-syntax b (identifier-syntax x))
        (define x 3))
      (alias a b))
    #t)
  (eqv?
    (let () (import $ie-C) a)
    3)
  (begin
    (module $ie-D (a)
      (module (a (b x))
        (define-syntax b (identifier-syntax (list x)))
        (module (a x)
          (module (b x)
            (define-syntax b (identifier-syntax x))
            (define x 3))
          (alias a b))))
    #t)
  (error? ; unexported identifier x
    (let () (import $ie-D) a))
  (begin
    (module $ie-E (a)
      (import (chezscheme))
      (define-syntax a (identifier-syntax x))
      (alias b a)
      (indirect-export b x)
      (define x 77))
    #t)
 ; this works because the indirect export of x for b
 ; counts as an indirect export of x for a.  perhaps it
 ; shouldn't work.
  (eqv?
    (let () (import $ie-E) a)
    77)
 ; perhaps this shouldn't work either:
  (eqv?
    (let ()
      (define b 3)
      (alias a b)
      (fluid-let-syntax ([b (identifier-syntax 4)])
        a))
    4)
  (begin
    (module $ie-F (a)
      (import (chezscheme))
      (module (a)
        (implicit-exports #f)
        (define-syntax a (identifier-syntax x)))
      (implicit-exports #t)
      (define x 77))
    #t)
  (eqv?
    (let () (import $ie-F) a)
    77)
  (begin
    (module $ie-G (a)
      (implicit-exports #t)
      (module M1 (x)
        (define x 5))
      (module M2 ((a x))
        (implicit-exports #t)
        (import M1)
        (define-syntax a (identifier-syntax x)))
      (import M2))
    #t)
  (eqv?
    (let () (import $ie-G) a)
    5)
  (begin
    (module $ie-H (a)
      (implicit-exports #t)
      (module M1 (x)
        (define x 5))
      (module M2 (a)
        (implicit-exports #t)
        (define-syntax a (let () (import M1) (identifier-syntax x))))
      (import M2))
    #t)
  (eqv?
    (let () (import $ie-H) a)
    5)
  (begin
    (module $ie-I (a)
      (define x 5)
      (indirect-export a x)
      (module M2 (a)
        (define-syntax a (identifier-syntax x)))
      (import M2))
    #t)
  (eqv?
    (let () (import $ie-I) a)
    5)
  (begin
    (module $ie-J (m)
      (implicit-exports #t)
      (module m (e)
        (define f 44)
        (define-syntax e (identifier-syntax f))))
    #t)
  (error? ; unexported identifier f
    (let ()
      (import $ie-J)
      (import m)
      e))
)

(mat marked-top-level-ids
  (begin
    (define-syntax $a
      (syntax-rules ()
        ((_ x e)
         (begin
           (module ($y-marked) (define $y-marked e))
           (define x (lambda () $y-marked))))))
    ($a $one 1)
    ($a $two 2)
    (equal? (list ($one) ($two)) '(1 2)))
  (not (top-level-bound? '$y-marked))
  (begin
    (define-syntax $a
      (syntax-rules ()
        ((_ x e)
         (begin
           (define $y-marked e)
           (define x (lambda () $y-marked))))))
    ($a $one 1)
    ($a $two 2)
    ($a $three 3)
    (equal? (list ($one) ($two) ($three)) '(1 2 3)))
  (not (top-level-bound? '$y-marked))
  (not (top-level-bound? '$y-marked))
  (begin
    (define-syntax $a
      (syntax-rules ()
        ((_ x e)
         (begin
           (define $y-marked e)
           (define-syntax x (identifier-syntax $y-marked))))))
    ($a $one 1)
    ($a $two 2)
    ($a $three 3)
    ($a $four 4)
    (equal? (list $one $two $three $four) '(1 2 3 4)))
  (begin ; once more, with feeling
    (define-syntax $a
      (syntax-rules ()
        ((_ x e)
         (begin
           (define $y-marked e)
           (define-syntax x (identifier-syntax $y-marked))))))
    ($a $one 1)
    ($a $two 2)
    ($a $three 3)
    ($a $four 4)
    (equal? (list $one $two $three $four) '(1 2 3 4)))
  (begin
    (module $foo ($a) (define-syntax $a (identifier-syntax 3)))
    (import $foo)
    (eq? $a 3))
  (begin ; keep with preceding mat
    (define-syntax $a (identifier-syntax 4))
    (eq? $a 4))
 )

(mat top-level-begin
 ; mats to test change to body-like semantics for begin
  (begin
    (define ($foofrah expr ans)
      (with-output-to-file "testfile.ss"
        (lambda () (pretty-print expr))
        'replace)
      (let* ([ss.out (with-output-to-string (lambda () (load "testfile.ss")))]
             [cf.out (with-output-to-string (lambda () (compile-file "testfile.ss")))]
             [so.out (with-output-to-string (lambda () (load "testfile.so")))])
        (let ([actual 
               (list
                 ss.out
                 (substring cf.out
                   (string-length "compiling testfile.ss with output to testfile.so\n")
                   (string-length cf.out))
                 so.out)])
          (unless (equal? actual ans)
            (pretty-print actual)
            (errorf #f "unexpected actual value ~s instead of ~s" actual ans))))
      #t)
    #t)
  ($foofrah
    '(begin
       (define-record-type (a make-a a?) (fields type mapper))
       (define-syntax define-descendant
         (lambda (x)
           (syntax-case x ()
             [(_ parent-id maker type name pred arg ...)
              (with-syntax ([(getter ...) (generate-temporaries #'(arg ...))])
                #'(define-record-type (name maker pred)
                    (parent parent-id)
                    (fields (immutable arg getter) ...)
                    (protocol
                      (lambda (n)
                        (lambda (arg ...)
                          (letrec ([rec ((n 'type (lambda (receiver) (receiver (getter rec) ...))) arg ...)])
                            rec))))))])))
       (define-descendant a make-a subname x x? y z)
       (write ((a-mapper (make-a 3 4)) list)))
    '("(3 4)" "" "(3 4)"))
  ($foofrah
    '(begin
       (eval-when (compile load eval) (write 1))
       (eval-when (compile load eval) (write 2) (write 3))
       (newline))
    '("123\n" "123" "123\n"))
  ($foofrah
    '(begin
       (define (f) (import foo) x1)
       (module foo (x1) (define x1 'x1))
       (pretty-print (f)))
    '("x1\n" "" "x1\n"))
  ($foofrah
    '(begin
       (define x2 'x2)
       (module (y2) (define y2 x2))
       (pretty-print y2)) ;=> x2
    '("x2\n" "" "x2\n"))
  ($foofrah
    '(begin
       (define x3 'x3)
       (module foo (y2) (define y2 x3))
       (import foo)
       (pretty-print y2)) ;=> x3
    '("x3\n" "" "x3\n"))
  ($foofrah
    '(eval-when (compile load)
       (eval-when (compile load eval) (define x4 "x4"))
       (define-syntax a4 (lambda (q) x4))
       (display a4))
    '("" "x4" "x4"))
  ($foofrah
    '(eval-when (compile load eval)
       (define x5 "x5")
       (display x5))
    '("x5" "x5" "x5"))
  (begin
    (define x5 "x5")
    ($foofrah ; keep with preceding test
      '(begin
         (define x5 "x5new")
         (define-syntax a5 (lambda (q) x5))
         (printf "~a ~a\n" a5 x5))
      '("x5 x5new\n" "" "x5new x5new\n")))
  ($foofrah
    '(begin
       (define x6 a6)
       (define-syntax a6 (identifier-syntax 'cool))
       (pretty-print x6))
    '("cool\n" "" "cool\n"))
  (error? ; variable a7 is not bound
    (eval '(begin
             (define x7 a7)
             (define-syntax a7 (identifier-syntax 'cool))
             (define a7 'the-real-deal))))
  ($foofrah
    '(begin
       (define x8 'not-cool)
       (define (f8) x8)
       (define x8 'just-right)
       (pretty-print (f8))) ;=> just-right
    '("just-right\n" "" "just-right\n"))
  ($foofrah
    '(begin
       (define x9 'not-cool)
       (define-syntax a9 (identifier-syntax x9))
       (define x9 'just-right)
       (pretty-print a9)) ;=> just-right
    '("just-right\n" "" "just-right\n"))
  ($foofrah
    '(begin
       (define x10 a10)
       (module m10 (x y)
         (define-syntax x (identifier-syntax 'm10-x))
         (define y a10)
         (define-syntax a10 (identifier-syntax 'm10-y)))
       (library (l10) (export x y) (import (rnrs))
         (define-syntax x (identifier-syntax 'l10-x))
         (define y a10)
         (define-syntax a10 (identifier-syntax 'l10-y)))
       (define-syntax a10 (identifier-syntax 'outer-x10))
       (import (rename m10 (y yy)) (rename (l10) (x xx)))
       (pretty-print (list x y xx yy)))
    '("(m10-x l10-y l10-x m10-y)\n" "" "(m10-x l10-y l10-x m10-y)\n"))
  ($foofrah
    '(begin
       (define-syntax a
         (syntax-rules ()
           [(a q) (begin (define (q) x) (define x 4))]))
       (a zz)
       (pretty-print (zz)))
    '("4\n" "" "4\n"))
  ($foofrah
    '(begin
       (eval-when (compile load eval)
         (module const (get put) 
           (define ht (make-eq-hashtable))
           (define get (lambda (name) (hashtable-ref ht name 0)))
           (define put (lambda (name value) (hashtable-set! ht name value)))))
       (define-syntax dc
         (syntax-rules ()
           [(_ id e) (let () (import const) (put 'id e))]))
       (define-syntax con
         (syntax-rules ()
           [(_ id) (let () (import const) (get 'id))]))
       (dc spam 13)
       (dc b (list (con spam) 's))
       (pretty-print (list (con spam) (con b) (con c))))
    '("(13 (13 s) 0)\n" "" "(13 (13 s) 0)\n"))
  (begin (define const) (define dc) (define con) #t)
  ($foofrah
    '(begin
       (eval-when (compile load eval)
         (module const (get put) 
           (define ht (make-eq-hashtable))
           (define get (lambda (name) (hashtable-ref ht name 0)))
           (define put (lambda (name value) (hashtable-set! ht name value)))))
       (define-syntax dc
         (syntax-rules ()
           [(_ id e) (let () (import const) (put 'id e))]))
       (define-syntax con
         (syntax-rules ()
           [(_ id) (let () (import const) (get 'id))]))
       (eval-when (compile load eval)
         (dc spam 13)
         (dc b (list (con spam) 's)))
       (eval-when (compile load eval)
         (pretty-print (list (con spam) (con b) (con c)))))
    '("(13 (13 s) 0)\n" "(13 (13 s) 0)\n" "(13 (13 s) 0)\n"))
  (begin (define const) (define dc) (define con) #t)
  ($foofrah
    '(begin
       (eval-when (compile load eval)
         (module const (get put) 
           (define ht (make-eq-hashtable))
           (define get (lambda (name) (hashtable-ref ht name 0)))
           (define put (lambda (name value) (hashtable-set! ht name value)))))
       (define-syntax dc
         (syntax-rules ()
           [(_ id e) (eval-when (compile load eval) (let () (import const) (put 'id e)))]))
       (define-syntax con
         (syntax-rules ()
           [(_ id) (eval-when (compile load eval) (let () (import const) (get 'id)))]))
       (dc spam 13)
       (dc b (list (con spam) 's))
       (eval-when (compile load eval)
         (pretty-print (list (con spam) (con b) (con c)))))
    '("(13 (13 s) 0)\n" "(13 (13 s) 0)\n" "(13 (13 s) 0)\n"))
  (begin (define const) (define dc) (define con) #t)
  ($foofrah
    '(begin
       (eval-when (compile eval)
         (module const (get put) 
           (define ht (make-eq-hashtable))
           (define get (lambda (name) (hashtable-ref ht name 0)))
           (define put (lambda (name value) (hashtable-set! ht name value)))))
       (define-syntax dc
         (syntax-rules ()
           [(_ id e) (eval-when (compile eval) (let () (import const) (put 'id e)))]))
       (define-syntax con
         (syntax-rules ()
           [(_ id) (eval-when (compile eval) (let () (import const) (get 'id)))]))
       (dc spam 13)
       (dc b (list (con spam) 's))
       (eval-when (compile eval)
         (pretty-print (list (con spam) (con b) (con c)))))
    '("(13 (13 s) 0)\n" "(13 (13 s) 0)\n" ""))
  (begin (define const) (define dc) (define con) #t)
  ($foofrah
    '(begin
       (define-syntax a
         (identifier-syntax
           (begin
             (eval-when (compile eval)
               (module const (get put) 
                 (define ht (make-eq-hashtable))
                 (define get (lambda (name) (hashtable-ref ht name 0)))
                 (define put (lambda (name value) (hashtable-set! ht name value)))))
             (define-syntax dc
               (syntax-rules ()
                 [(_ id e) (eval-when (compile eval) (let () (import const) (put 'id e)))]))
             (define-syntax con
               (syntax-rules ()
                 [(_ id) (eval-when (compile eval) (let () (import const) (get 'id)))]))
             (dc spam 13)
             (dc b (list (con spam) 's))
             (eval-when (compile eval)
               (pretty-print (list (con spam) (con b) (con c)))))))
       a)
    '("(13 (13 s) 0)\n" "(13 (13 s) 0)\n" ""))
  (begin (define const) (define dc) (define con) #t)
  (begin
    (with-output-to-file "testfile-lib-c.ss"
      (lambda ()
        (pretty-print 
          '(library (testfile-lib-c)
             (export y)
             (import (chezscheme) (testfile-lib-a))
             (define y (lambda () x))
             (printf "invoke c\n"))))
      'replace)
    (with-output-to-file "testfile-test-ac.ss"
      (lambda ()
        (pretty-print 
          '(begin
             (library (testfile-lib-a)
               (export x)
               (import (chezscheme))
               (define x (lambda () 1))
               (printf "invoke a\n"))
             (import (testfile-lib-c) (chezscheme))
             (pretty-print (eq? (y) y)))))
      'replace)
    #t)
  (let ([cf '(lambda (x)
               (parameterize ([compile-imported-libraries #t])
                 (compile-file x)))])
    (separate-compile cf 'test-ac)
    #t)
  (equal?
    (separate-eval '(load "testfile-test-ac.so"))
    "invoke a\ninvoke c\n#f\n")
 ; make sure no local-label bindings make it into compiled wraps
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print 
          '(let-syntax ([a (lambda (x) 0)])
             (define-syntax $foo (lambda (x) #'cons)))))
      'replace)
    (compile-file "testfile")
    (load "testfile.so")
    #t)
  (equal? $foo cons)
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print 
          '(begin
             (define-syntax $foo-a (lambda (x) 0))
             (define-syntax $foo (lambda (x) #'cons)))))
      'replace)
    (compile-file "testfile")
    (load "testfile.so")
    #t)
  (equal? $foo cons)
)

#;
(mat top-level-begin-NOT
 ; these mats test a behavior we have at this point decided against,
 ; in which a syntax object for an identifier imported from a library
 ; via an import is inserted outside the scope of the local import
 ; in a compiled file, thus forcing an implicit import of the library
 ; when the compiled file is loaded.  possibly, the library should be
 ; imported when a reference is actually attempted, but we shouldn't
 ; import eagerly on the off chance that a syntax object will be used
 ; in this manner, because the import will usually be unnecessary.
  (begin
    (with-output-to-file "testfile-tlb-a1.ss"
      (lambda ()
        (pretty-print 
          '(library (testfile-tlb-a1)
             (export tlb-a1-rats)
             (import (rnrs))
             (define-syntax tlb-a1-rats (identifier-syntax 17)))))
      'replace)
    (with-output-to-file "testfile-tlb-a2.ss"
      (lambda ()
        (pretty-print 
          '(define-syntax tlb-a2-foo
             (let ()
               (import (testfile-tlb-a1))
               (lambda (x) #'(cons tlb-a1-rats 2))))))
      'replace)
    (with-output-to-file "testfile-tlb-a3.ss"
      (lambda ()
        (pretty-print 
          '(let-syntax ([silly (lambda (x)
                                 (import (testfile-tlb-a1))
                                 (syntax-case x ()
                                   [(_ id) #'(define-syntax id (identifier-syntax (cons tlb-a1-rats 3)))]))])
             (silly tlb-a3-fluffy))))
      'replace)
    (with-output-to-file "testfile-tlb-a4.ss"
      (lambda ()
        (pretty-print 
          '(module (tlb-a4-pie)
             (import (testfile-tlb-a1))
             (define-syntax tlb-a4-pie
               (lambda (x) #'(cons tlb-a1-rats 4))))))
      'replace)
    (with-output-to-file "testfile-tlb-a5.ss"
      (lambda ()
        (pretty-print 
          '(meta define tlb-a5-spam
             (let () (import (testfile-tlb-a1)) #'(cons tlb-a1-rats 5)))))
      'replace)
    (with-output-to-file "testfile-tlb-a6a.ss"
      (lambda ()
        (pretty-print 
          '(library (testfile-tlb-a6a)
             (export tlb-a6-fop)
             (import (rnrs) (testfile-tlb-a1))
             (define tlb-a6-fop #'(cons tlb-a1-rats 6)))))
      'replace)
    (with-output-to-file "testfile-tlb-a6b.ss"
      (lambda ()
        (pretty-print 
          '(library (testfile-tlb-a6b)
             (export tlb-a6-alpha)
             (import (rnrs) (testfile-tlb-a6a))
             (define-syntax tlb-a6-alpha (lambda (x) tlb-a6-fop)))))
      'replace)
    (with-output-to-file "testfile-tlb-a6c.ss"
      (lambda ()
        (pretty-print '(import (rnrs) (testfile-tlb-a6b)))
        (pretty-print '(write tlb-a6-alpha)))
      'replace)
    (with-output-to-file "testfile-tlb-a7.ss"
      (lambda ()
        (pretty-print 
          '(define-property spam spam (let () (import (testfile-tlb-a1)) #'(cons tlb-a1-rats 7)))))
      'replace)
    (with-output-to-file "testfile-tlb-a8.ss"
      (lambda ()
        (pretty-print 
          '(define tlb-a8-spam (let () (import (testfile-tlb-a1)) #'(cons tlb-a1-rats 8)))))
      'replace)
    (with-output-to-file "testfile-tlb-a9.ss"
      (lambda ()
        (pretty-print 
          '(let ()
             (import (testfile-tlb-a1))
             (set! tlb-a9-spam #'(cons tlb-a1-rats 9)))))
      'replace)
    (with-output-to-file "testfile-tlb-a10.ss"
      (lambda ()
        (pretty-print '(import (scheme) (testfile-tlb-a1)))
        (pretty-print '(define-top-level-value 'tlb-a10-spam #'(cons tlb-a1-rats 10))))
      'replace)
    (let ([cf (lambda (what)
                `(lambda (x)
                   (parameterize ([compile-imported-libraries #t])
                     (,what x))))])
      (separate-compile (cf 'compile-file) 'tlb-a2)
      (separate-compile (cf 'compile-file) 'tlb-a3)
      (separate-compile (cf 'compile-file) 'tlb-a4)
      (separate-compile (cf 'compile-file) 'tlb-a5)
      (separate-compile (cf 'compile-library) 'tlb-a6b)
      (separate-compile (cf 'compile-program) 'tlb-a6c)
      (separate-compile (cf 'compile-file) 'tlb-a7)
      (separate-compile (cf 'compile-file) 'tlb-a8)
      (separate-compile (cf 'compile-file) 'tlb-a9)
      (separate-compile (cf 'compile-program) 'tlb-a10))
    #t)
  (equal?
    (separate-eval '(visit "testfile-tlb-a2.so") '(pretty-print tlb-a2-foo))
    "(17 . 2)\n")
  (equal?
    (separate-eval '(visit "testfile-tlb-a3.so") '(pretty-print tlb-a3-fluffy))
    "(17 . 3)\n")
  (equal?
    (separate-eval '(visit "testfile-tlb-a4.so") '(pretty-print tlb-a4-pie))
    "(17 . 4)\n")
  (equal?
    (separate-eval '(visit "testfile-tlb-a5.so") '(pretty-print (let-syntax ([a (lambda (x) tlb-a5-spam)]) a)))
    "(17 . 5)\n")
  (equal?
    (separate-eval '(revisit "testfile-tlb-a6c.so"))
    "(17 . 6)")
  (equal?
    (separate-eval '(visit "testfile-tlb-a7.so") '(pretty-print (let-syntax ([a (lambda (x) (lambda (r) (r #'spam #'spam)))]) a)))
    "(17 . 7)\n")
  (equal?
    (separate-eval '(revisit "testfile-tlb-a8.so") '(pretty-print (let-syntax ([a (lambda (x) tlb-a8-spam)]) a)))
    "(17 . 8)\n")
  (equal?
    (separate-eval '(revisit "testfile-tlb-a9.so") '(pretty-print (let-syntax ([a (lambda (x) tlb-a9-spam)]) a)))
    "(17 . 9)\n")
 ; don't really want to fix this one:
  (equal?
    (separate-eval '(load-program "testfile-tlb-a10.so") '(pretty-print (let-syntax ([a (lambda (x) tlb-a10-spam)]) a)))
    "(17 . 10)\n")
  (begin
    (with-output-to-file "testfile-tlb-bQ.ss"
      (lambda ()
        (pretty-print 
          '(library (testfile-tlb-bQ)
             (export tlb-bq)
             (import (rnrs))
             (define-syntax tlb-bq (identifier-syntax 17)))))
      'replace)
    (with-output-to-file "testfile-tlb-bA.ss"
      (lambda ()
        (pretty-print 
          '(library (testfile-tlb-bA)
             (export tlb-bset-a! tlb-bget-a)
             (import (rnrs))
             (define a #f)
             (define tlb-bset-a! (lambda (x) (set! a x)))
             (define tlb-bget-a (lambda () a)))))
      'replace)
    (with-output-to-file "testfile-tlb-bP.ss"
      (lambda ()
        (pretty-print '(import (rnrs) (rnrs eval) (testfile-tlb-bQ) (testfile-tlb-bA)))
        (pretty-print '(tlb-bset-a! #'tlb-bq))
        (pretty-print
          '(eval
             '(let ()
                (define-syntax alpha (lambda (x) (tlb-bget-a)))
                (write (cons alpha 'B)))
             (environment '(rnrs) '(testfile-tlb-bA) '(testfile-tlb-bQ)))))
      'replace)
    (let ([cf (lambda (what)
                `(lambda (x)
                   (parameterize ([compile-imported-libraries #t])
                     (,what x))))])
      (separate-compile (cf 'compile-program) 'tlb-bP))
    #t)
  (equal?
    (separate-eval '(load-program "testfile-tlb-bP.so"))
    "(17 . B)")
)

(mat deferred-transformer
 ; don't get caught being lazy on transformer evaluation
  (begin
    (define $ratfink
      (let ([state 0])
        (lambda () (set! state (+ state 1)) (lambda (x) state))))
    (procedure? $ratfink))
  (eqv? (let-syntax ((f ($ratfink)))
          (let-syntax ((g ($ratfink))) g))
        2)
 )

(mat copy-environment
 ; dummy test to set up nondescript record-writer for environments
 ; so that error messages involving environments don't include generated
 ; names that may change from run to run.  the record-writer is reset at
 ; end of this mat.
  (equal?
    (let ([env-rtd (record-rtd (scheme-environment))])
      (set! *saved-record-writer* (record-writer env-rtd))
      (record-writer env-rtd (lambda (x p wr) (display "#<environment>" p)))
      (format "~s" (scheme-environment)))
    "#<environment>")
  (equal?
    (let ([e (copy-environment (scheme-environment))])
      (eval '(define x 17) e)
      (eval '(define-syntax a
               (syntax-rules ()
                 [(_ b c)
                  (begin
                    (define x c)
                    (define-syntax b (identifier-syntax x)))]))
            e)
      (eval '(a foo 33) e)
      (list (eval 'foo e)
            (eval 'x e)
            (top-level-value 'x e)))
    '(33 17 17))
  (equal?
    (let ([e (copy-environment (scheme-environment) #t)])
      (eval '(define x 17) e)
      (eval '(define-syntax a
               (syntax-rules ()
                 [(_ b c)
                  (begin
                    (define x c)
                    (define-syntax b (identifier-syntax x)))]))
            e)
      (eval '(a foo 33) e)
      (list (eval 'foo e)
            (eval 'x e)
            (top-level-value 'x e)))
    '(33 17 17))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (eval '(define x 17) e)
      (eval '(define-syntax a
               (syntax-rules ()
                 [(_ b c)
                  (begin
                    (define x c)
                    (define-syntax b (identifier-syntax x)))]))
            e)
      (eval '(a foo 33) e)
      (list (eval 'foo e)
            (eval 'x e)
            (top-level-value 'x e))))
  (equal?
    (let* ([e1 (copy-environment (scheme-environment))]
           [e2 (copy-environment e1)])
      (define-top-level-value 'list list* e1)
      (list
        (parameterize ([optimize-level 0]) (eval '(list 1 2 3) e1))
        (parameterize ([optimize-level 0]) (eval '(list 1 2 3) e2))))
    '((1 2 . 3) (1 2 3)))
  (equal?
    (let* ([e1 (copy-environment (scheme-environment))]
           [e2 (copy-environment e1)])
      (define-top-level-value 'list list* e1)
      (list
        (parameterize ([optimize-level 0]) (eval '(list 1 2 3) e1))
        (parameterize ([optimize-level 0]) (eval '(list 1 2 3) e2))))
    '((1 2 . 3) (1 2 3)))
  (error?
    (let* ([e1 (copy-environment (scheme-environment))]
           [e2 (copy-environment e1)])
      (set-top-level-value! 'list list* e1)
      (list
        (parameterize ([optimize-level 0]) (eval '(list 1 2 3) e1))
        (parameterize ([optimize-level 0]) (eval '(list 1 2 3) e2)))))
  (equal?
    (let ([e1 (copy-environment (scheme-environment))])
      (define-top-level-value 'curly (lambda (x) (+ x 15)) e1)
      (let ([e2 (copy-environment e1)])
        (define-top-level-value 'curly (lambda (x) (- x 15)) e2)
        (list (eval '(curly 5) e1) (eval '(curly 5) e2))))
    '(20 -10))
  (equal?
    (let ([e1 (copy-environment (scheme-environment))])
      (set-top-level-value! 'curly (lambda (x) (+ x 15)) e1)
      (let ([e2 (copy-environment e1)])
        (set-top-level-value! 'curly (lambda (x) (- x 15)) e2)
        (list (eval '(curly 5) e1) (eval '(curly 5) e2))))
    '(20 -10))
  (equal?
    (let ([e1 (copy-environment (scheme-environment))])
      (define-top-level-value 'curly (lambda (x) (+ x 15)) e1)
      (let ([e2 (copy-environment e1)])
        (define-top-level-value 'curly (lambda (x) (- x 15)) e1)
        (list (eval '(curly 5) e1) (eval '(curly 5) e2))))
    '(-10 20))
  (equal?
    (let ([e1 (copy-environment (scheme-environment))])
      (set-top-level-value! 'curly (lambda (x) (+ x 15)) e1)
      (let ([e2 (copy-environment e1)])
        (set-top-level-value! 'curly (lambda (x) (- x 15)) e1)
        (list (eval '(curly 5) e1) (eval '(curly 5) e2))))
    '(-10 20))
  (equal?
    (let ([e (copy-environment (scheme-environment))])
      (eval '(define let 4) e)
      (define-top-level-value 'let* 6 e)
      (list (top-level-value 'let e)
            (eval '(list let*) e)))
    '(4 (6)))
  (error?
    (let ([e (copy-environment (scheme-environment))])
      (set-top-level-value! letrec 3 e)))
  (error?
    (let ([e (copy-environment (scheme-environment))])
      (set-top-level-value! 'letrec 3 e)))
  (error?
    (let ([e (copy-environment (scheme-environment))])
      (eval '(set! lambda 55) e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (eval '(define cons 55) e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (eval '(set! cons 55) e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (define-top-level-value 'cons 3 e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (set-top-level-value! 'cons 3 e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (define-top-level-value 'frappule 3 e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (set-top-level-value! 'irascible 3 e)))
  (error?
    (let ([e (copy-environment (scheme-environment))])
      (eval 'nonstandard-identifier e)))
  (equal?
    (let ([env-rtd (record-rtd (scheme-environment))])
      (record-writer env-rtd *saved-record-writer*)
      (format "~s" (scheme-environment)))
    "#<environment *scheme*>")
  (equal?
    (let ([e (copy-environment (scheme-environment) #t '())])
      (define-top-level-value 'cons list e)
      (list (eval '(cons 3 4) e) (top-level-bound? 'list e)))
    '((3 4) #f))
  (error?
    (let ([e (copy-environment (scheme-environment) #t '())])
      (eval '(quote 3) e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #t '(scheme))])
      (eval '(import scheme) e)
      (eval '(let ((x 3)) x) e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #t '(import))])
      (eval '(import scheme) e)
      (eval '(let ((x 3)) x) e)))
  (eqv?
    (let ([e (copy-environment (scheme-environment) #t '(import scheme))])
      (eval '(import scheme) e)
      (eval '(let ((x 3)) x) e))
    3)
  (error?
    (let ([e (copy-environment (scheme-environment) #t '(import scheme))])
      (eval '(import scheme) e)
      (set-top-level-value! 'cons 72 e)))
  (begin
    (define $copy-env-tmp1 723)
    (define $copy-env-tmp2 -327)
    (define $copy-env-env
      (copy-environment
        (interaction-environment)
        #t
        (remq 'let*
              (remq 'cons
                    (remq '$copy-env-tmp1
                          (environment-symbols (interaction-environment)))))))
    (environment? $copy-env-env))
  (equal?
    (eval '(let ((x (list 1 2))) (list x x $copy-env-tmp2)) $copy-env-env)
    '(#0=(1 2) #0# -327))
  (error? (eval 'cons $copy-env-env))
  (error? (eval 'let* $copy-env-env))
  (error? (eval '$copy-env-tmp1 $copy-env-env))
  (begin
    (eval '(define + -) $copy-env-env)
    (begin
      (equal? (top-level-value '+ $copy-env-env) -)
      (equal? (eval '+ $copy-env-env) -)
      (equal? (eval '#2%+ $copy-env-env) +)))
  (equal?
    (begin
      (eval '(set! cons 52) $copy-env-env)
      (top-level-value 'cons $copy-env-env))
    52)

 ; verify new (as of csv7.5) copy-environment semantics
  (begin
    (define $ce-e1 (copy-environment (scheme-environment) #t))
    (eval '(module foo (eek) (define eek -7)) $ce-e1)
    (eval '(import foo) $ce-e1)
    (eval '(define-syntax ez (identifier-syntax 'tuary)) $ce-e1)
    (define-top-level-value 'whence 'now $ce-e1)
    #t)
  (equal?
    (eval '(list cons eek whence ez) $ce-e1)
    `(,cons -7 now tuary))
  (begin
    (define $ce-e2 (copy-environment $ce-e1 #t))
    #t)
  (equal?
    (eval '(list cons eek whence ez) $ce-e2)
    `(,cons -7 now tuary))
  (equal?
    (begin
      (eval '(set! eek (* eek 3)) $ce-e1)
      (list (eval '(let () (import foo) eek) $ce-e1)
            (eval '(let () (import foo) eek) $ce-e2)
            (eval 'eek $ce-e1)
            (top-level-value 'eek $ce-e2)))
    '(-21 -21 -21 -21))
  (equal?
    (begin
      (eval '(set! eek (* eek 3)) $ce-e2)
      (list (eval '(let () (import foo) eek) $ce-e1)
            (eval '(let () (import foo) eek) $ce-e2)
            (eval 'eek $ce-e1)
            (top-level-value 'eek $ce-e2)))
    '(-63 -63 -63 -63))
  (equal?
    (begin
      (set-top-level-value! 'eek 99 $ce-e1)
      (list (eval '(let () (import foo) eek) $ce-e1)
            (eval '(let () (import foo) eek) $ce-e2)
            (eval 'eek $ce-e1)
            (top-level-value 'eek $ce-e2)))
    '(99 99 99 99))
  (equal?
    (begin
      (set-top-level-value! 'eek 'ack $ce-e2)
      (list (eval '(let () (import foo) eek) $ce-e1)
            (eval '(let () (import foo) eek) $ce-e2)
            (eval 'eek $ce-e1)
            (top-level-value 'eek $ce-e2)))
    '(ack ack ack ack))
  (equal?
    (begin
      (eval '(set! whence 'later) $ce-e1)
      (list (eval 'whence $ce-e1)
            (top-level-value 'whence $ce-e2)))
    '(later now))
  (equal?
    (begin
      (set-top-level-value! 'whence 'never $ce-e2)
      (list (eval 'whence $ce-e1)
            (top-level-value 'whence $ce-e2)))
    '(later never))
  (error? ; cannot assign immutable variable
    (eval '(set! cons 4) $ce-e1))
  (error? ; cannot assign immutable variable
    (eval '(set! cons 4) $ce-e2))
  (error? ; cannot assign immutable variable
    (set-top-level-value! 'cons 4 $ce-e1))
  (error? ; cannot assign immutable variable
    (set-top-level-value! 'cons 4 $ce-e2))
  (error? ; invalid syntax
    (eval '(set! foo 4) $ce-e1))
  (error? ; invalid syntax
    (eval '(set! foo 4) $ce-e2))
  (error? ; not a variable
    (set-top-level-value! 'foo 4 $ce-e1))
  (error? ; not a variable
    (set-top-level-value! 'foo 4 $ce-e2))
  (error? ; invalid syntax
    (eval '(set! ez 4) $ce-e1))
  (error? ; invalid syntax
    (eval '(set! ez 4) $ce-e2))
  (error? ; not a variable
    (set-top-level-value! 'ez 4 $ce-e1))
  (error? ; not a variable
    (set-top-level-value! 'ez 4 $ce-e2))
  (error? ; invalid syntax
    (eval '(begin (alias ard ez) (set! ard 45)) $ce-e1))
  (equal?
    (let ()
      (define $ce-f1 (eval '(lambda () (list cons eek whence ez)) $ce-e1))
      (define $ce-f2 (eval '(lambda () (list cons eek whence ez)) $ce-e2))
      (define $ce-f3 (eval '(lambda () (list cons (let () (import foo) eek))) $ce-e1))
      (define $ce-f4 (eval '(lambda () (list cons (let () (import foo) eek))) $ce-e2))
      (eval '(define cons 3) $ce-e1)
      (define-top-level-value 'eek 4 $ce-e1)
      (eval '(define whence 5) $ce-e1)
      (define-top-level-value 'ez 6 $ce-e1)
      (define-top-level-value 'cons 'a $ce-e2)
      (eval '(define eek 'b) $ce-e2)
      (define-top-level-value 'whence 'c $ce-e2)
      (eval '(define ez 'd) $ce-e2)
      (list
        ($ce-f1)
        ($ce-f2)
        ($ce-f3)
        ($ce-f4)
        (eval '(list cons eek whence ez) $ce-e1)
        (eval '(list cons eek whence ez) $ce-e2)
        (list cons (eval '(let () (import foo) eek) $ce-e1))
        (list cons (eval '(let () (import foo) eek) $ce-e2))))
    `((,cons ack 5 tuary)
      (,cons ack c tuary)
      (,cons ack)
      (,cons ack)
      (3 4 5 6)
      (a b c d)
      (,cons ack)
      (,cons ack)))
  (equal?
    (let ()
      (eval '(define foo 'not-a-module) $ce-e1)
      (list (eval 'foo $ce-e1)
            (eval '(let () (import foo) eek) $ce-e2)))
    '(not-a-module ack))
  (equal?
    (let ([e (copy-environment (interaction-environment) #f '(cons $ce-e1))])
      (list (eval 'cons e) (eval '$ce-e1 e)))
    (list cons $ce-e1))
  (let ([e1 (copy-environment (scheme-environment) #t '())])
    (define-top-level-value 'darth 'vader e1)
    (let ([e2 (copy-environment e1 #f)])
      (let ([e3 (copy-environment e2 #t)])
        (define (f) (map (lambda (e) (top-level-value 'darth e)) (list e1 e2 e3)))
        (and (equal? (environment-symbols e1) '(darth))
             (equal? (environment-symbols e2) '(darth))
             (equal? (environment-symbols e3) '(darth))
             (equal? (f) '(vader vader vader))
             (eq? (set-top-level-value! 'darth 'maul e1) (void))
             (equal? (f) '(maul vader vader))
             (eq? (set-top-level-value! 'darth 'poodle e3) (void))
             (equal? (f) '(maul vader poodle))))))
 )

(mat environment-mutable?
  (not (environment-mutable? (scheme-environment)))
  (environment-mutable? (interaction-environment))
  (environment-mutable? (copy-environment (scheme-environment)))
 )

(mat trace-define-syntax
  (equivalent-expansion?
    (parameterize ([trace-output-port (open-output-string)]
                   [print-gensym #f])
      (let ([x (expand
                 '(let ()
                    (trace-define-syntax frob
                      (syntax-rules ()
                       [(_ rot gut) (gut rot)]))
                    (frob 17 $tds-foo)))])
        (list x (get-output-string (trace-output-port)))))
    '(($tds-foo 17) "|(frob (frob 17 $tds-foo))\n|($tds-foo 17)\n"))
)

(mat meta
  (error? ; x out of context
    (let () (meta define x 3) x))
  (error? ; x out of context
    (module () (meta define x 3) x))
  (begin
    (module ($meta-z)
      (meta define x #'"jolly")
      (define-syntax y (lambda (z) x))
      (define $meta-z y))
    (equal? $meta-z "jolly"))
  (begin
    (module (mat-meta-bar)
      (module foo (macro-helper a b)
        (meta define table
         ; pretend this is a "big computation":
          (map cons '(#\a #\b #\c) '(1 2 3)))
        (meta define lookup
          (lambda (c)
            (cond [(assq c table) => cdr] [else #f])))
        (meta define macro-helper
          (lambda (x)
            (syntax-case x ()
              [(k c)
               (with-syntax ([n (lookup (datum c))])
                 #'(list '(k c) a n))])))
        (define a 'is)
        (define-syntax b
          (lambda (x) (macro-helper x))))
      (define mat-meta-bar
        (lambda ()
          (import foo)
          (define-syntax d
            (lambda (x) (macro-helper x)))
          (list a (b #\b) (d #\c)))))
      (equal? (mat-meta-bar) '(is ((b #\b) is 2) ((d #\c) is 3))))
  (error? ; lookup out-of-context (in definition of c)
    (begin
      (module (mat-meta-bar)
        (module foo (macro-helper a b c)
          (meta define table
           ; pretend this is a "big computation":
            (map cons '(#\a #\b #\c) '(1 2 3)))
          (meta define lookup
            (lambda (c)
              (cond [(assq c table) => cdr] [else #f])))
          (meta define macro-helper
            (lambda (x)
              (syntax-case x ()
                [(k c)
                 (with-syntax ([n (lookup (datum c))])
                   #'(list '(k c) a n))])))
          (define a 'is)
          (define-syntax b
            (lambda (x) (macro-helper x)))
          (define c
            (lambda (s)
              (map lookup (string->list s)))))
        (define mat-meta-bar
          (lambda ()
            (import foo)
            (define-syntax d
              (lambda (x) (macro-helper x)))
            (list a (b #\b) (c "aq") (d #\c)))))
        (equal? (mat-meta-bar) '(is ((b #\b) is 2) (1 #f) ((d #\c) is 3)))))
  (begin
    (module mat-meta-foo (macro-helper a b)
      (meta define table
       ; pretend this is a "big computation":
        (map cons '(#\a #\b #\c) '(1 2 3)))
      (meta define lookup
        (lambda (c)
          (cond [(assq c table) => cdr] [else #f])))
      (meta define macro-helper
        (lambda (x)
          (syntax-case x ()
            [(k c)
             (with-syntax ([n (lookup (datum c))])
               #'(list '(k c) a n))])))
      (define a 'is)
      (define-syntax b
        (lambda (x) (macro-helper x))))
    #t)
  (equal?
    (let ()
      (define mat-meta-bar1
        (lambda ()
          (import mat-meta-foo)
          (define-syntax d
            (lambda (x) (macro-helper x)))
          (list a (b #\b) (d #\c))))
      (mat-meta-bar1))
    '(is ((b #\b) is 2) ((d #\c) is 3)))
  (begin
    (define mat-meta-bar2
      (lambda ()
        (import mat-meta-foo)
        (define-syntax d
          (lambda (x) (macro-helper x)))
        (list a (b #\b) (d #\c))))
    (procedure? mat-meta-bar2))
  (equal? (mat-meta-bar2) '(is ((b #\b) is 2) ((d #\c) is 3)))
  (error? ; out-of-context (run-time reference to meta variable)
    (let ()
      (module foo (macro-helper a b c)
        (meta define table
         ; pretend this is a "big computation":
          (map cons '(#\a #\b #\c) '(1 2 3)))
        (meta define lookup
          (lambda (c)
            (cond [(assq c table) => cdr] [else #f])))
        (meta define macro-helper
          (lambda (x)
            (syntax-case x ()
              [(k c)
               (with-syntax ([n (lookup (datum c))])
                 #'(list '(k c) a n))])))
        (define a 'is)
        (define-syntax b
          (lambda (x) (macro-helper x)))
        (define c
          (lambda (s)
            (map lookup (string->list s)))))
      (define bar
        (lambda ()
          (import foo)
          (define-syntax d
            (lambda (x) (macro-helper x)))
          (list a (b #\b) (c "aq") (d #\c))))
      (bar)))
  (begin
    (module (mat-meta-q mat-meta-a)
      (meta define mat-meta-q 13)
      (define-syntax mat-meta-a
        (lambda (x)
          (set! mat-meta-q (* mat-meta-q 2))
          (with-syntax ((n mat-meta-q))
            #'(list n (- mat-meta-q 6))))))
    (meta define mat-meta-x (begin (set! mat-meta-q (+ mat-meta-q 4)) mat-meta-q))
    (meta module () (set! mat-meta-q (+ mat-meta-q 10)))
    (define-syntax ans
      (lambda (x)
        (with-syntax ([d (cons (quotient (+ mat-meta-q mat-meta-x) 2) mat-meta-a)])
          #''d)))
    (equal? ans '(35 54 48)))
  (equal?
    (let ()
      (module (mat-meta-q mat-meta-a)
        (meta define mat-meta-q 13)
        (define-syntax mat-meta-a
          (lambda (x)
            (set! mat-meta-q (* mat-meta-q 2))
            (with-syntax ((n mat-meta-q))
              #'(list n (- mat-meta-q 6))))))
      (meta define mat-meta-x (begin (set! mat-meta-q (+ mat-meta-q 4)) mat-meta-q))
      (meta module () (set! mat-meta-q (+ mat-meta-q 10)))
      (define-syntax ans
        (lambda (x)
          (with-syntax ([d (cons (quotient (+ mat-meta-q mat-meta-x) 2) mat-meta-a)])
            #''d)))
      ans)
    '(35 54 48))
  (begin
    (module (mat-meta-zeta) 
      (meta module frobrat (boz) (define boz 3))
      (define-syntax rot (lambda (x) (import frobrat) boz))
      (define mat-meta-zeta rot))
    (eq? mat-meta-zeta 3))
  (begin
    (module (mat-meta-gorp)
      (meta define f (lambda (x) (if (= x 0) '() (cons x (f (- x 1))))))
      (define-syntax mat-meta-gorp
        (lambda (x)
          (syntax-case x ()
            [(_ n)
             (with-syntax ([(num ...) (f (datum n))])
               #'(list num ...))]))))
    (equal? (mat-meta-gorp 5) '(5 4 3 2 1)))
  (error? ; f not bound (referenced in alpha before definition complete)
    (module (mat-meta-gorp)
      (meta define f
        (lambda (x)
          (define-syntax alpha
            (lambda (x)
              (f x) ; f not bound (yet)
              #'()))
          (if (= x 0)
              alpha
              (cons x (f (- x 1))))))
      (define-syntax mat-meta-gorp
        (lambda (x)
          (syntax-case x ()
            [(_ n)
             (with-syntax ([(num ...) (f (datum n))])
               #'(list num ...))])))))
  (begin
    (define-syntax $cftest
      (syntax-rules ()
        [(_ e0 e1 e2)
         (begin
           (collect (collect-maximum-generation)) ; close ports left open by load/compile-file w/mat's error handler
           (let ((op (open-output-file "testfile.ss" 'replace)))
             (pretty-print 'e0 op)
             (close-output-port op))
           (compile-file "testfile.ss")
           (and e1 (begin (load "testfile.ss") e2)))]))
    #t)
  ($cftest
    (begin
      (meta define meta-$bun 3)
      (define meta-$burger 4))
    (equal? meta-$bun 3)
    (equal? meta-$burger 4))
  (error?
    ($cftest
      (meta define meta-$lettuce 3)
      (equal? meta-$bun 3)
      (equal? meta-$burger 4)))
 ; check to make sure meta still works if we change interaction environment
  (eqv?
    (parameterize ([interaction-environment (copy-environment (interaction-environment))])
      (eval '
        (let ()
          (meta define foo 3)
          (meta define bar (* 3 7))
          (define-syntax a (lambda (x) (+ foo bar)))
          a)))
    24)
)

(mat meta2
  (error? ; x out-of-context
    (begin
      (meta define x 3)
      x))
  (begin
    (meta define x 3)
    (define-syntax y (lambda (z) x))
    (eq? y 3))

 ; top-level module tests
  (error? ; x out-of-context
    (module m (x) (meta define x 3) (pretty-print x)))
  (error? ; x out-of-context
    (begin
      (module m (x) (meta define x 3))
      (let () (import m) x)))
  (begin
    (module m (x) (meta define x 3))
    (eq? (let () (import m) (define-syntax y (lambda (z) x)) y) 3))
  (error? ; x out-of-context
    (begin
      (module m (x) (meta define x 3))
      (import m)
      x))
  (begin
    (module mm-m (mm-x) (meta define mm-x 3))
    (import mm-m)
    (define-syntax mm-y (lambda (z) mm-x))
    (eq? mm-y 3))
  (begin
    (module ($meta-z)
      (meta define x #'"jolly")
      (define-syntax y (lambda (z) x))
      (define $meta-z y))
    (equal? $meta-z "jolly"))
  
 ; local tests
  (error? ;=> out-of-context or unbound error
    (let ()
      (module m (x) (meta define x 3) (pretty-print x))
      4))
  (error? ;=> out-of-context or unbound error
    (let ()
      (module m (x) (meta define x 3))
      (let () (import m) x)))
  (eq?
    (let ()
      (module m (x) (meta define x 3))
      (let () (import m) (define-syntax y (lambda (z) x)) y))
    3)
  (let ()
    (module ($meta-z)
      (meta define x #'"jolly")
      (define-syntax y (lambda (z) x))
      (define $meta-z y))
    (equal? $meta-z "jolly"))
  (error? ;=> q out-of-context
    (let ()
      (meta define p 3)
      (define-syntax a
        (lambda (x)
          (meta define q 4)
          `(,#'quote (,p ,q))))
      a))
  (equal?
    (let ()
      (meta define p 3)
      (define-syntax a
        (lambda (x)
          (meta define q 4)
          (define-syntax b (lambda (x) q))
          `(,#'quote (,p ,b))))
      a)
    '(3 4))
  
  (begin
    (define $mm-p "p")
    (define $mm-q "q")
    (define $mm-r "r")
    (meta module
      ($mm-a $mm-b $mm-c)
      (define t '())
      (define $mm-a (lambda (k v) (set! t (cons (cons k v) t)) #'(void)))
      (define $mm-b (lambda (k) (cdr (assq k t))))
      (define-syntax $mm-c
        (lambda (x)
          (syntax-case x (get put)
            [(_ get n) ($mm-b (datum n))]
            [(_ put n v) ($mm-a (datum n) #'v)])))
      (set! t `((1 . ,#'$mm-q) (2 . ,#'$mm-r))))
    ($mm-c put 7 $mm-p)
    (equal?
      (list ($mm-c get 1) ($mm-c get 2) ($mm-c get 7))
      '("q" "r" "p")))
  (equal?
    (let ([p "p!"] [q "q!"] [r "r!"])
      (meta module (a b c)
        (define t '())
        (define a (lambda (k v) (set! t (cons (cons k v) t)) #'(void)))
        (define b (lambda (k) (cdr (assq k t))))
        (define-syntax c
          (lambda (x)
            (syntax-case x (get put)
              [(_ get n) (b (datum n))]
              [(_ put n v) (a (datum n) #'v)])))
        (set! t `((1 . ,#'q) (2 . ,#'r))))
      (c put 7 p)
      (list (c get 1) (c get 2) (c get 7)))
    '("q!" "r!" "p!"))
  
 ; assuming internal-defines-as-letrec* defaults to #t
  (internal-defines-as-letrec*)
 ; following tests assume it's set to #f
  (begin (internal-defines-as-letrec* #f) (not (internal-defines-as-letrec*)))
 ; top-level module tests
  (error? ; undefined variable merry
    (module sam (frodo)
      (define merry 'merry)
      (define frodo (cons merry merry))))
  (error? ; undefined variable frodo
    (module sam (frodo)
      (define merry 'merry)
      (define frodo 'frodo)
      (define pippin (cons frodo frodo))))
  (begin (internal-defines-as-letrec* #t) (internal-defines-as-letrec*))
  (eq? (let ()
         (module (x !y ?y) (define x (call/cc values))
           (define y 0)
           (define !y (lambda (v) (set! y v)))
           (define ?y (lambda () y)))
         (!y (+ (?y) 1))
         (x values)
         (?y))
       1)
  (begin
    (module (x !y ?y)
      (define x (call/cc values))
      (define y 0)
      (define !y (lambda (v) (set! y v)))
      (define ?y (lambda () y)))
    (!y (+ (?y) 1))
    (x values)
    (eq? (?y) 1))
  (begin
    (meta define hobbits '())
    (module ()
      (meta module ()
        (set! hobbits (cons 'merry hobbits)))
      (meta module ()
        (set! hobbits (cons 'lobelia hobbits))
        (set! hobbits (cons 'frodo hobbits))
        (set! hobbits (cons 'bilbo hobbits)))
      (meta begin
        (set! hobbits (cons 'pippin hobbits))))
    (define-syntax hobbit-report
      (lambda (x) `(,#'quote ,(datum->syntax #'* hobbits))))
    (equal? hobbit-report '(pippin bilbo frodo lobelia merry)))
  (let ()
    (meta define hobbits '())
    (module ()
      (meta module ()
        (set! hobbits (cons 'merry hobbits)))
      (meta module ()
        (set! hobbits (cons 'lobelia hobbits))
        (set! hobbits (cons 'frodo hobbits))
        (set! hobbits (cons 'bilbo hobbits)))
      (meta begin
        (set! hobbits (cons 'pippin hobbits))))
    (define-syntax hobbit-report
      (lambda (x) `(,#'quote ,(datum->syntax #'* hobbits))))
    (equal? hobbit-report '(pippin bilbo frodo lobelia merry)))
  (begin
    (meta define $whatsit)
    (meta begin (set! $whatsit #xc7c7c7c7))
    (define-syntax $mm-a (lambda (x) $whatsit))
    (eqv? $mm-a #xc7c7c7c7))
  (error? ; no expr in body
    (let () (meta begin (void))))
  (error? ; invalid meta definition ((void))
    (meta (void)))
  (error? ; invalid meta definition ((void))
    (module () (meta (void))))
  (error? ; invalid meta definition ((void))
    (let () (meta (void))))
  (begin
    (define hobbits '())
    (module ()
      (module ()
        (set! hobbits (cons 'merry hobbits)))
      (module ()
        (set! hobbits (cons 'lobelia hobbits))
        (set! hobbits (cons 'frodo hobbits))
        (set! hobbits (cons 'bilbo hobbits)))
      (set! hobbits (cons 'pippin hobbits)))
    (equal? hobbits '(pippin bilbo frodo lobelia merry)))
  (let ()
    (define hobbits '())
    (module ()
      (module ()
        (set! hobbits (cons 'merry hobbits)))
      (module ()
        (set! hobbits (cons 'lobelia hobbits))
        (set! hobbits (cons 'frodo hobbits))
        (set! hobbits (cons 'bilbo hobbits)))
      (set! hobbits (cons 'pippin hobbits)))
    (equal? hobbits '(pippin bilbo frodo lobelia merry)))
  
 ; assuming internal-defines-as-letrec* true
  (internal-defines-as-letrec*)
  (begin
    (define hobbits '())
    (module sam (frodo)
      (define merry (set! hobbits (cons 'merry hobbits)))
      (define frodo (set! hobbits (cons 'frodo hobbits)))
      (define pippin (set! hobbits (cons 'pippin hobbits))))
    (equal? hobbits '(pippin frodo merry)))
  (let ()
    (define hobbits '())
    (module sam (frodo)
      (define merry (set! hobbits (cons 'merry hobbits)))
      (define frodo (set! hobbits (cons 'frodo hobbits)))
      (define pippin (set! hobbits (cons 'pippin hobbits))))
    (equal? hobbits '(pippin frodo merry)))
  (begin
    (define hobbits '())
    (module sam (frodo)
      (define merry (set! hobbits (cons 'merry hobbits)))
      (module (frodo)
        (define lobelia (set! hobbits (cons 'lobelia hobbits)))
        (define frodo (set! hobbits (cons 'frodo hobbits)))
        (define bilbo (set! hobbits (cons 'bilbo hobbits))))
      (define pippin (set! hobbits (cons 'pippin hobbits))))
    (equal? hobbits '(pippin bilbo frodo lobelia merry)))
  (let ()
    (define hobbits '())
    (module sam (frodo)
      (define merry (set! hobbits (cons 'merry hobbits)))
      (module (frodo)
        (define lobelia (set! hobbits (cons 'lobelia hobbits)))
        (define frodo (set! hobbits (cons 'frodo hobbits)))
        (define bilbo (set! hobbits (cons 'bilbo hobbits))))
      (define pippin (set! hobbits (cons 'pippin hobbits))))
    (equal? hobbits '(pippin bilbo frodo lobelia merry)))
  (begin
    (module sam (frodo)
      (define merry 'merry)
      (define frodo (cons merry merry)))
    (equal? (let () (import sam) frodo) '(merry . merry)))
  (error? ; undefined variable merry
    (module sam (frodo)
      (define frodo (cons merry merry))
      (define merry 'merry)))
  (error? ; undefined variable frodo
    (module sam (frodo)
      (define merry 'merry)
      (define pippin (cons frodo frodo))
      (define frodo 'frodo)))
  (begin
    (module sam (frodo)
      (define merry 'merry)
      (define frodo (lambda () pippin))
      (define pippin (cons frodo frodo)))
    (let () (import sam) (eq? (car (frodo)) frodo)))
  (let ()
    (module (x !y ?y)
      (define x (call/cc values))
      (define y 0)
      (define !y (lambda (v) (set! y v)))
      (define ?y (lambda () y)))
    (!y (+ (?y) 1))
    (x values)
    (eq? (?y) 1))
  (begin
    (module (x !y ?y)
      (define x (call/cc values))
      (define y 0)
      (define !y (lambda (v) (set! y v)))
      (define ?y (lambda () y)))
    (!y (+ (?y) 1))
    (x values)
    (eq? (?y) 1))
  
 ; test for proper evaluation of meta defines and inits at compile-file time,
 ; visit time, revisit time, and load time
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print
          '(meta module $mm-m (a)
             (define q 3)
             (define-syntax qinc! (identifier-syntax (set! q (+ q 1))))
             (define-syntax (a x) qinc! q)
             qinc!
             (set! q (* q q)))))
      'replace)
    (compile-file "testfile")
    #t)
  (eq? (let () (import $mm-m) a) 17)
  (eq? (let () (import $mm-m) a) 18)
  (begin (visit "testfile.so") #t)
  (eq? (let () (import $mm-m) a) 17)
  (eq? (let () (import $mm-m) a) 18)
  (begin (load "testfile.so") #t)
  (eq? (let () (import $mm-m) a) 17)
  (eq? (let () (import $mm-m) a) 18)
  (begin (revisit "testfile.so") #t)
  (eq? (let () (import $mm-m) a) 19)
)

(mat quasisyntax
  (error? ; invalid syntax
    quasisyntax)
  (error? ; invalid syntax
    (quasisyntax))
  (error? ; invalid syntax
    (quasisyntax . a))
  (error? ; invalid syntax
    (quasisyntax a b c))
  (error? ; misplaced
    (unsyntax x))
  (error? ; misplaced
    (unsyntax-splicing x))
  (error? ; misplaced
    (unsyntax x y))
  (error? ; misplaced
    (unsyntax-splicing x y))
  (error? ; misplaced
    (unsyntax))
  (error? ; misplaced
    (unsyntax-splicing))
  (error? ; misplaced
    unsyntax)
  (error? ; misplaced
    unsyntax-splicing)
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`(list #,(length #'(x ...)) 'x ...)])))
         #t)
  (equal? (qs-foo 3 2 1) '(3 3 2 1))
  (equal? (qs-foo 3 2 1) '(3 3 2 1))
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                (quasisyntax (list (unsyntax (length #'(x ...))) 'x ...))])))
         #t)
  (equal? (qs-foo 3 2 1) '(3 3 2 1))
  (equal? (qs-foo 3 2 1) '(3 3 2 1))
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'#`(a #,a b #,@b #,#(#,@#'(x ...)) #,@#(#,#'(x ...)))])))
         #t)
  (equal?
    (qs-foo 3 2 1)
    '(quasisyntax
       (a (unsyntax a) b (unsyntax-splicing b)
          (unsyntax #3(3 2 1)) (unsyntax-splicing #1((3 2 1))))))
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'(a #(#,#'(x ...) #,@#'(x ...) unsyntax unsyntax-splicing ,a ,@b) (a . #,#'(x ...)) . c)])))
         #t)
  (equal?
    (qs-foo 3 2 1)
    '(a #8((3 2 1) 3 2 1 unsyntax unsyntax-splicing ,a ,@b)
        (a 3 2 1)
        .
        c))
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'#(a (#,#'(x ...) #,@#'(x ...) unsyntax unsyntax-splicing ,a ,@b) (a . #,#'(x ...)))])))
         #t)
  (equal?
    (qs-foo 3 2 1)
    '#3(a ((3 2 1) 3 2 1 unsyntax unsyntax-splicing ,a ,@b)
        (a 3 2 1)))
 ; test zero and two+ unsyntax-splicing subforms
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'((unsyntax) 0 (unsyntax #'(a x ... b) #'(x ...)) c)])))
         #t)
  (equal? (qs-foo 3 2 1) '(0 (a 3 2 1 b) (3 2 1) c))
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'#((unsyntax) 0 (unsyntax #'(a x ... b) #'(x ...)) c)])))
         #t)
  (equal? (qs-foo 3 2 1) '#(0 (a 3 2 1 b) (3 2 1) c))
 ; test zero and two+ unsyntax-splicing subforms
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'((unsyntax-splicing) 0 (unsyntax-splicing #'(a x ... b) #'(x ...)) c)])))
         #t)
  (equal? (qs-foo 3 2 1) '(0 a 3 2 1 b 3 2 1 c))
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'#((unsyntax-splicing) 0 (unsyntax-splicing #'(a x ... b) #'(x ...)) c)])))
         #t)
  (equal? (qs-foo 3 2 1) '#(0 a 3 2 1 b 3 2 1 c))
 ; make sure out-of-place unsyntax/unsyntax-splicing keywords are left alone
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...) #`'unsyntax])))
         #t)
  (equal? (qs-foo 3 2 1) 'unsyntax)
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...) #`'unsyntax-splicing])))
         #t)
  (equal? (qs-foo 3 2 1) 'unsyntax-splicing)
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'(a . (unsyntax #'(x ...) #'(x ...)))])))
         #t)
  (equal? (qs-foo 3 2 1) '(a . (unsyntax (syntax (3 2 1)) (syntax (3 2 1)))))
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x ...)
                #`'(a . (unsyntax-splicing #'(x ...)))])))
         #t)
  (equal? (qs-foo 3 2 1) '(a . (unsyntax-splicing (syntax (3 2 1)))))
 ; test noninterference with quasiquote
  (begin (define-syntax qs-foo
           (lambda (x)
             (syntax-case x ()
               [(_ x1 x2 ...)
                #``(a ,@(reverse (list #,@#'(x2 ...))) ,#,#'x1)])))
         #t)
  (equal?
    (qs-foo 3 2 1)
    '(a 1 2 3))
 ; tests adapted from Andre van Tonder posts to srfi 93 discussion
  (equal?
    (let ()
      (define-syntax swap!
        (lambda (e)
          (syntax-case e ()
            [(_ a b)
             (let ([a #'a] [b #'b])
               (quasisyntax
                 (let ([temp (unsyntax a)])
                   (set! (unsyntax a) (unsyntax b))
                   (set! (unsyntax b) temp))))])))
      (let ([temp 1] [set! 2])
        (swap! set! temp)
        (cons temp set!)))
    '(2 . 1))
  (eq?
    (let ()
      (define-syntax case
        (lambda (x)
          (syntax-case x ()
            [(_ e c1 c2 ...)
             (quasisyntax
               (let ([t e])
                 (unsyntax
                   (let f ([c1 #'c1] [cmore #'(c2 ...)])
                     (if (null? cmore)
                         (syntax-case c1 (else)
                           [(else e1 e2 ...) #'(begin e1 e2 ...)]
                           [((k ...) e1 e2 ...)
                            #'(if (memv t '(k ...))
                                  (begin e1 e2 ...))])
                         (syntax-case c1 ()
                           [((k ...) e1 e2 ...)
                            (quasisyntax
                              (if (memv t '(k ...))
                                  (begin e1 e2 ...)
                                  (unsyntax
                                    (f (car cmore)
                                       (cdr cmore)))))]))))))])))
      (case 'a [(b c) 'no] [(d a) 'yes]))
    'yes)
  (eqv?
    (let ()
      (define-syntax let-in-order
        (lambda (form)
          (syntax-case form ()
            [(_ ((i e) ...) e0 e1 ...)
             (let f ([ies #'((i e) ...)] [its #'()])
               (syntax-case ies ()
                 [() (quasisyntax (let (unsyntax its) e0 e1 ...))]
                 [((i e) . ies)
                  (with-syntax ([t (car (generate-temporaries '(t)))])
                    (quasisyntax
                      (let ([t e])
                        (unsyntax
                          (f #'ies
                             (quasisyntax
                               ((i t)
                                 (unsyntax-splicing its))))))))]))])))
      (let-in-order ((x 1) (y 2)) (+ x y)))
    3)
  (equal?
    (let-syntax ([test-ellipses-over-unsyntax
                  (lambda (e)
                    (let ([a #'a])
                      (with-syntax ([(b ...) #'(1 2 3)])
                        (quasisyntax '((b #,a) ...)))))])
      (test-ellipses-over-unsyntax))
    '((1 a) (2 a) (3 a)))
  (equal?
    (let-syntax ([test (lambda (_)
                         (quasisyntax '(list #,(+ 1 2) 4)))])
      (test))
  '(list 3 4))
  (equal?
    (let-syntax ([test (lambda (_)
                         (let ([name #'a])
                           (quasisyntax '(list #,name '#,name))))])
      (test))
    '(list a 'a))
  (equal?
    (let-syntax ([test (lambda (_)
                         (quasisyntax
                           '(a #,(+ 1 2) #,@(map abs '(4 -5 6)) b)))])
      (test))
    '(a 3 4 5 6 b))
  (equal?
    (let-syntax ([test (lambda (_)
                         (quasisyntax
                           '((foo #,(- 10 3))
                              #,@(cdr '(5))
                              .
                              #,(car '(7)))))])
      (test))
    '((foo 7) . 7))
  (equal?
    (let-syntax ([test (lambda (_)
                         (quasisyntax
                           '#(10 5 #,(sqrt 4) #,@(map sqrt '(16 9)) 8)))])
      (test))
    '#(10 5 2 4 3 8))
  (eqv?
    (let-syntax ([test (lambda (_) (quasisyntax #,(+ 2 3)))])
      (test))
    5)
  (equal?
    (let-syntax ([test (lambda (_)
                         (quasisyntax
                           '(a (quasisyntax
                                 (b #,(+ 1 2) #,(foo #,(+ 1 3) d) e))
                               f)))])
      (test))
    '(a (quasisyntax (b #,(+ 1 2) #,(foo 4 d) e)) f))

  (equal?
    (let-syntax ([test (lambda (_)
                         (let ([name1 #'x] [name2 #'y])
                           (quasisyntax
                             '(a (quasisyntax (b #,#,name1 #,#'#,name2 d))
                                 e))))])
      (test))
    '(a (quasisyntax (b #,x #,#'y d)) e))
 ; Bawden's extensions:
  (equal?
    (let-syntax ([test (lambda (_)
                         (quasisyntax '(a (unsyntax 1 2) b)))])
      (test))
    '(a 1 2 b))
  (equal?
    (let-syntax ([test (lambda (_)
                         (quasisyntax
                           '(a (unsyntax-splicing '(1 2) '(3 4)) b)))])
      (test))
    '(a 1 2 3 4 b))
  (equal?
    (let-syntax ([test (lambda (_)
                         (let ([x #'(a b c)])
                           (quasisyntax
                             '(quasisyntax (#,#,x #,@#,x #,#,@x #,@#,@x)))))])
      (test))
    '(quasisyntax
       (#,(a b c)
         #,@(a b c)
         (unsyntax a b c)
         (unsyntax-splicing a b c))))
)

(mat meta-cond
  (begin
    (define $meta-cond-expr
      '(meta-cond
         [(= (optimize-level) 3) $mc-a $mc-b $mc-c]
         [(= (optimize-level) 2) $mc-d]
         [else $mc-e $mc-f]))
    #t)
  (equivalent-expansion?
    (parameterize ([optimize-level 3]) (expand $meta-cond-expr))
    '(begin $mc-a $mc-b $mc-c))
  (equivalent-expansion?
    (parameterize ([optimize-level 2]) (expand $meta-cond-expr))
    '$mc-d)
  (equivalent-expansion?
    (parameterize ([optimize-level 0]) (expand $meta-cond-expr))
    '(begin $mc-e $mc-f))
  (equal?
    (parameterize ([optimize-level 0]) ; should have no effect
      (with-output-to-string
        (lambda ()
          (meta-cond
            [(= (optimize-level) 3) (pretty-print 'level3)]
            [(= (optimize-level) 2) (pretty-print 'level2)]))))
    (case (optimize-level)
      [(2) "level2\n"]
      [(3) "level3\n"]
      [else ""]))
)

(mat make-compile-time-value
  (error? ; incorrect number of arguments
    (let ()
      (define-syntax a
        (lambda (x)
          (lambda (r)
            (r))))
      a))
  (error? ; not an identifier
    (let ()
      (define-syntax a
        (lambda (x)
          (lambda (r)
            (r #'(a)))))
      a))
  (error? ; not an identifier
    (let ()
      (define-syntax a
        (lambda (x)
          (lambda (r)
            (r #'(a) #'frip))))
      a))
  (error? ; not an identifier
    (let ()
      (define-syntax a
        (lambda (x)
          (lambda (r)
            (r #'a "frip"))))
      a))
  (error? ; incorrect number of arguments
    (let ()
      (define-syntax a
        (lambda (x)
          (lambda (r)
            (r #'a #'frip "extra stuff"))))
      a))
  (error? ; not a compile-time value
    (compile-time-value-value 17))
  (begin
    (with-output-to-file "testfile-mctv0.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-mctv0) (export get-ctv get-property) (import (chezscheme))
             (define-syntax get-ctv
               (lambda (x)  
                 (lambda (r)
                   (syntax-case x ()
                     [(_ q) #`'#,(datum->syntax #'* (r #'q))]))))
             (define-syntax get-property
               (lambda (x)  
                 (lambda (r)
                   (syntax-case x ()
                     [(_ q prop) #`'#,(datum->syntax #'* (r #'q #'prop))])))))))
      'replace)
    (for-each separate-compile '(mctv0))
    #t)
  (begin
    (import (testfile-mctv0))
    #t)
  (compile-time-value? (make-compile-time-value 'fred))
  (begin
    (define-syntax frob (make-compile-time-value 'rabf))
    #t)
  (eq? (get-ctv frob) 'rabf)
  (error? ; invalid syntax
    frob)
  (error? ; invalid syntax
    (frob kupe))
  (eq?
    (let ()
      (define-syntax frob (make-compile-time-value 'shuddle))
      (get-ctv frob))
    'shuddle)
  (eq?
    (let-syntax ([frob (make-compile-time-value 'skupo)])
      (get-ctv frob))
    'skupo)
  (equal?
    (let ([frob "not the global frob ..."])
      (list frob (get-ctv frob)))
    '("not the global frob ..." #f))
  (eq? (get-ctv frob) 'rabf)
  (error? ; invalid syntax
    (let ()
      (define-syntax frob (make-compile-time-value 'shuddle))
      frob))
  (error? ; invalid syntax
    (let ()
      (define-syntax frob (make-compile-time-value 'shuddle))
      (frob)))
  (error? ; duplicate definition
    (module mctv-m1 (x)
      (define x 3)
      (define-syntax x (make-compile-time-value 'xxx))))
  (error? ; duplicate definition
    (module mctv-m1 (x)
      (define-syntax x (make-compile-time-value 'xxx))
      (define-syntax x (make-compile-time-value 'xxx))))
  (begin
    (module mctv-m1 (x)
      (define-syntax x (make-compile-time-value 'xxx)))
    #t)
  (eq? (let () (import mctv-m1) (get-ctv x)) 'xxx)
  (begin
    (library (mctv l1) (export x) (import (chezscheme) (testfile-mctv0))
      (define-syntax x (make-compile-time-value 'xow)))
    #t)
  (eq? (let () (import (mctv l1)) (get-ctv x)) 'xow)
  (eq? (compile-time-value-value (top-level-syntax 'x (environment '(mctv l1)))) 'xow)
  (begin
    (with-output-to-file "testfile-mctv1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-mctv1) (export x) (import (chezscheme))
             (define-syntax x (make-compile-time-value 'xuko1)))))
      'replace)
    (for-each separate-compile '(mctv1))
    #t)
  (eq? (let () (import (testfile-mctv1)) (get-ctv x)) 'xuko1)
  (compile-time-value? (top-level-syntax 'x (environment '(testfile-mctv1))))
  (eq? (compile-time-value-value (top-level-syntax 'x (environment '(testfile-mctv1)))) 'xuko1)
  (begin
    (with-output-to-file "testfile-mctv1a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-mctv1a) (export x) (import (chezscheme))
             (define-syntax x (make-compile-time-value 'xuko1)))))
      'replace)
    (for-each separate-compile '(mctv1a))
    #t)
  (eq? (compile-time-value-value (top-level-syntax 'x (environment '(testfile-mctv1a)))) 'xuko1)
  (eq? (let () (import (testfile-mctv1a)) (get-ctv x)) 'xuko1)
  (begin
    (with-output-to-file "testfile-mctv2.ss"
      (lambda ()
        (pretty-print
          '(module mctv-m2 (x)
             (define-syntax x (make-compile-time-value 'xuko2)))))
      'replace)
    (for-each separate-compile '(mctv2))
    (load "testfile-mctv2.so")
    #t)
  (eq? (let () (import mctv-m2) (get-ctv x)) 'xuko2)
  (begin
    (with-output-to-file "testfile-mctv3.ss"
      (lambda ()
        (pretty-print
          '(define-syntax mctv3-x (make-compile-time-value 'xuko3))))
      'replace)
    (for-each separate-compile '(mctv3))
    (load "testfile-mctv3.so")
    #t)
  (eq? (get-ctv mctv3-x) 'xuko3)
  (begin
    (with-output-to-file "testfile-mctv4.ss"
      (lambda ()
        (printf "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (chezscheme) (testfile-mctv0)))
        (pretty-print '(define spod))
        (pretty-print '(define qrtz))
        (pretty-print '(define xptz))
        (pretty-print '(define-syntax x (make-compile-time-value 'xuko4)))
        (pretty-print '(define-property x spod "shuff"))
        (pretty-print '(define-property x qrtz "dmnd"))
        (pretty-print '(printf "~s ~s ~s ~s ~s\n"
                         (get-property get-property spod)
                         (get-property x spod)
                         (get-property x qrtz)
                         (get-property x xptz)
                         (get-ctv x))))
      'replace)
    (for-each (lambda (x) (separate-compile 'compile-program x)) '(mctv4))
    #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (load-program "testfile-mctv4.ss")))
    "#f \"shuff\" \"dmnd\" #f xuko4\n")
  (equal?
    (with-output-to-string
      (lambda ()
        (load-program "testfile-mctv4.so")))
    "#f \"shuff\" \"dmnd\" #f xuko4\n")
  (eqv?
    (let ()
      (define foo 3)
      (define-syntax alpha (make-compile-time-value #'foo))
      (define-syntax beta
        (lambda (x)
          (lambda (r)
            (r #'alpha))))
      (let ()
        (define foo 4)
        beta))
    3)
  (eqv?
    (let ()
      (define foo 3)
      (define-syntax alpha
        (lambda (x)
          (syntax-case x ()
            [(_ id) #'(define-syntax id (make-compile-time-value #'foo))])))
      (let ()
        (define foo 4)
        (alpha beta)
        (define-syntax gamma
          (lambda (x)
            (lambda (r)
              (r #'beta))))
        gamma)) ;=> 3
    3)
  #; ; decided not to have rebuild-macro-output delve into records...
  (eqv?
    (let ()
      (meta define-record-type rats (fields cheese))
      (define foo 3)
      (define-syntax alpha
        (lambda (x)
          (syntax-case x ()
            [(_ id)
             #`(define-syntax id
                 (make-compile-time-value '#,(make-rats #'foo)))])))
      (let ()
        (define foo 4)
        (alpha beta)
        (define-syntax gamma
          (lambda (x)
            (lambda (r)
              #`(let ()
                  (define foo 5)
                  #,(rats-cheese (r #'beta))))))
        gamma))
    3)
  #; ; decided not to have rebuild-macro-output delve into records...
  (eqv?
    (let ()
      (meta define-record-type rats (fields cheese))
      (define foo 3)
      (define-syntax alpha
        (lambda (x)
          (syntax-case x ()
            [(_ id)
             #`(module (id)
                 (define foo 3.5)
                 (define-syntax id
                   (make-compile-time-value '#,(make-rats #'foo))))])))
      (let ()
        (define foo 4)
        (alpha beta)
        (define-syntax gamma
          (lambda (x)
            (lambda (r)
              #`(let ()
                  (define foo 5)
                  #,(rats-cheese (r #'beta))))))
        gamma))
    3.5)
  (eqv?
    (let ()
      (meta define make-rats list)
      (meta define rats-cheese car)
      (define foo 3)
      (define-syntax alpha
        (lambda (x)
          (syntax-case x ()
            [(_ id)
             #`(module (id)
                 (define foo 3.5)
                 (define-syntax id
                   (make-compile-time-value #'#,(make-rats #'foo))))])))
      (let ()
        (define foo 4)
        (alpha beta)
        (define-syntax gamma
          (lambda (x)
            (lambda (r)
              #`(let ()
                  (define foo 5)
                  #,(syntax-case (r #'beta) ()
                      [(foo) #'foo])))))
        gamma))
    3.5)
)

(mat define-property
  (begin
    (library (dp get-property) (export get-property) (import (scheme))
      (define-syntax get-property
        (lambda (x)  
          (lambda (r)
            (syntax-case x ()
              [(_ q prop) #`'#,(datum->syntax #'* (r #'q #'prop))])))))
    (import (dp get-property))
    #t)
  (begin
    (define-property cons frotz 'spamgle)
    (equal?
      (cons (get-property cons frotz) (get-property cons fratz))
      '(spamgle . #f)))
  (equal?
    (cons (get-property cons frotz) (get-property cons fratz))
    '(spamgle . #f))
  (equal?
    (let ()
      (import scheme) 
      (cons (get-property cons frotz) (get-property cons fratz)))
    (if (free-identifier=? #'cons (let () (import scheme) #'cons))
        '(spamgle . #f)
        '(#f . #f)))
  (equal?
    (let ()
      (define-property cons fratz 'yubah)
      (cons (get-property cons frotz) (get-property cons fratz)))
    '(spamgle . yubah))
  (equal?
    (cons (get-property cons frotz) (get-property cons fratz))
    '(spamgle . #f))
 ; restore
  (begin
    (meta-cond
      [(free-identifier=? #'cons (let () (import scheme) #'cons))
       (import (only scheme cons))]
      [else (define cons (let () (import scheme) cons))])
    #t)
  (equal?
    (cons (get-property cons frotz) (get-property cons fratz))
    '(#f . #f))
  (equal?
    (let ()
      (import scheme) 
      (cons (get-property cons frotz) (get-property cons fratz)))
    '(#f . #f))
  (equal?
    (let ()
      (import scheme) 
      (define-property list type "procedure")
      (list (get-property list type) (get-property car type)))
    '("procedure" #f))
  (equal?
    (let ()
      (define list (lambda x x))
      (define-property list type "procedure")
      (list (get-property list type) (get-property car type)))
    '("procedure" #f))
  (error? ; multiple definitions for list
    (let ()
      (define-property list type "procedure")
      (define list (lambda x x))
      (list (get-property list type) (get-property car type))))
  (error? ; multiple definitions for list
    (module m (list)
      (define-property list type "procedure")
      (define list (lambda x x))
      (list (get-property list type) (get-property car type))))
  (error? ; immutable environment
    (eval '(define-property frot rat 3) (scheme-environment)))
  (error? ; immutable environment
    (eval '(define-property cons rat 3) (scheme-environment)))
  (error? ; no visible binding
    (eval '(let () (define-property frot cons 3) 3) (scheme-environment)))
  (error? ; no visible binding
    (eval '(let () (define-property cons rat 3) 3) (scheme-environment)))
  (error? ; no visible binding
    (library (dp err1) (export x) (import (scheme))
      (define-property x cons "frap")))
  (error? ; no visible binding
    (library (dp err1) (export x) (import (scheme))
      (define-property cons frip "frap")))
  (error? ; no visible binding
    (module (x) (import-only (scheme))
      (define-property x cons "frap")))
  (error? ; no visible binding
    (module (x) (import-only (scheme))
      (define-property cons frip "frap")))
  (not (get-property list type))
  (equal?
    (let ()
      (define type)
      (define-property list type "proc")
      (list
        (get-property list type)
        (let () (define type) (get-property list type))))
    '("proc" #f))
  (equal?
    (let ()
      (module (type iface list)
        (define type)
        (define iface)
        (define-property list type "a proc")
        (define-property list iface -1))
      (list
        (get-property list type)
        (get-property list iface)))
    '("a proc" -1))
  (equal?
    (let ()
      (module (type list)
        (define type)
        (define iface)
        (define-property list type "a proc")
        (define-property list iface -1))
      (list
        (get-property list type)
        (get-property list iface)))
    '("a proc" #f))
  (equal?
    (let ()
      (module (iface list)
        (define type)
        (define iface)
        (define-property list type "a proc")
        (define-property list iface -1))
      (list
        (get-property list type)
        (get-property list iface)))
    '(#f -1))
  (equal?
    (let ()
      (module (list)
        (define type)
        (define iface)
        (define-property list type "a proc")
        (define-property list iface -1))
      (list
        (get-property list type)
        (get-property list iface)))
    '(#f #f))
  (equal?
    (let ()
      (module (type iface)
        (define type)
        (define iface)
        (define-property list type "a proc")
        (define-property list iface -1))
      (list
        (get-property list type)
        (get-property list iface)))
    '(#f #f))
  (begin
    (define dp-out (open-output-string))
    (module dp-m1 (x)
      (import (scheme) (dp get-property))
      (define x 444)
      (define-property x frob "x-frob")
      (define-property x spam "x-spam")
      (fprintf dp-out "~s ~s ~s ~s\n"
        (get-property x spam)
        (get-property x frob)
        (get-property x rats)
        x))
    (equal?
      (get-output-string dp-out) 
      "\"x-spam\" \"x-frob\" #f 444\n"))
  (equal?
    (let ()
      (import dp-m1) 
      (list
        (get-property x spam)
        (get-property x frob)
        (get-property x rats)
        x))
    '("x-spam" "x-frob" #f 444))
  (begin
    (define dp-out (open-output-string))
    (module dp-m1 ()
      (import (scheme) (dp get-property))
      (define-property dp-out spam "dp-out-spam")
      (define-property dp-out frob "dp-out-frob")
      (fprintf dp-out "~s ~s ~s\n"
        (get-property dp-out spam)
        (get-property dp-out frob)
        (get-property dp-out rats)))
    (and
      (equal?
        (get-output-string dp-out) 
        "\"dp-out-spam\" \"dp-out-frob\" #f\n")
      (not (get-property dp-out spam))
      (not (get-property dp-out frob))))
  (equal?
    (let ()
      (import dp-m1) 
      (list
        (get-property x spam)
        (get-property x frob)
        (get-property x rats)))
    '(#f #f #f))
  (begin
    (module dp-m1 (m2 (f x y))
      (import (scheme) (dp get-property))
      (define y "yval")
      (define-property y a "y-a")
      (module m2 (x)
        (define x "xval")
        (define-property x a "x-a")
        (define-property y b "y-b"))
      (import m2)
      (define-property x b "x-b")
      (define-syntax f
        (identifier-syntax
          (list (list x (get-property x a) (get-property x b))
                (list y (get-property y a) (get-property y b))))))
    #t)
  (equal?
    (let () (import dp-m1) f)
    '(("xval" "x-a" "x-b") ("yval" "y-a" #f)))
  (equal?
    (let ()
      (import dp-m1)
      (import m2)
      (list
        (get-property x a)
        (get-property x b)
        (get-property x c)
        x))
    '("x-a" #f #f "xval"))
  (begin
    (library (dp l1) (export x spam frob rats) (import (scheme) (dp get-property))
      (define spam)
      (define frob)
      (define rats)
      (define x (make-parameter 444))
      (define-property x spam "x-spam")
      (define-property x frob "x-frob")
      (printf "~s ~s ~s ~s\n"
        (get-property x spam)
        (get-property x frob)
        (get-property x rats)
        (x)))
    #t)
  (begin (define dp-f) #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (set! dp-f
          (eval
            '(lambda ()
               (import (dp l1))
               (printf "~s ~s ~s ~s\n"
                 (get-property x spam)
                 (get-property x frob)
                 (get-property x rats)
                 (x)))))))
    "\"x-spam\" \"x-frob\" #f 444\n")
  (equal?
    (with-output-to-string
      (lambda ()
        (dp-f)))
    "\"x-spam\" \"x-frob\" #f 444\n")
  (begin
    (library (dp l1) (export x spam frob rats) (import (scheme) (dp get-property))
      (define spam)
      (define frob)
      (define rats)
      (define-syntax x
        (identifier-syntax
          (list
            (get-property x spam)
            (get-property x frob)
            (get-property x rats))))
      (define-property x spam "x-spam")
      (define-property x frob "x-frob")
      (printf "~s ~s ~s ~s\n"
        (get-property x spam)
        (get-property x frob)
        (get-property x rats)
        x))
    #t)
  (begin (define dp-f) #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (set! dp-f
          (eval
            '(lambda ()
               (import (dp l1))
               (printf "~s ~s ~s ~s\n"
                 (get-property x spam)
                 (get-property x frob)
                 (get-property x rats)
                 x))))))
    "")
  (equal?
    (with-output-to-string
      (lambda ()
        (dp-f)))
    "\"x-spam\" \"x-frob\" #f (\"x-spam\" \"x-frob\" #f)\n")
  (begin
    (library (dp l1) (export x qq spam frob rats) (import (scheme) (dp get-property))
      (define spam)
      (define frob)
      (define rats)
      (define qq (make-parameter 33))
      (define-syntax x
        (identifier-syntax
          (list
            (get-property x spam)
            (get-property x frob)
            (get-property x rats))))
      (define-property x spam "x-spam")
      (define-property x frob "x-frob")
      (printf "~s ~s ~s ~s\n"
        (get-property x spam)
        (get-property x frob)
        (get-property x rats)
        x))
    #t)
  (begin (define dp-f) #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (set! dp-f
          (eval
            '(lambda ()
               (import (dp l1))
               (printf "~s ~s ~s ~s ~s\n"
                 (get-property x spam)
                 (get-property x frob)
                 (get-property x rats)
                 x (qq)))))))
    "\"x-spam\" \"x-frob\" #f (\"x-spam\" \"x-frob\" #f)\n")
  (equal?
    (with-output-to-string
      (lambda ()
        (dp-f)))
    "\"x-spam\" \"x-frob\" #f (\"x-spam\" \"x-frob\" #f) 33\n")
  (begin
    (library (dp l1) (export qq spam frob rats) (import (scheme) (dp get-property))
      (define spam)
      (define frob)
      (define rats)
      (define qq (make-parameter 77))
      (define x (make-parameter 444))
      (define-property x spam "x-spam")
      (define-property x frob "x-frob")
      (printf "~s ~s ~s ~s\n"
        (get-property x spam)
        (get-property x frob)
        (get-property x rats)
        (x)))
    #t)
  (begin (define dp-f) #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (set! dp-f
          (eval
            '(lambda (x)
               (import (dp l1))
               (printf "~s ~s ~s ~s\n"
                 (get-property x spam)
                 (get-property x frob)
                 (get-property x rats)
                 (qq)))))))
    "\"x-spam\" \"x-frob\" #f 444\n")
  (equal?
    (with-output-to-string
      (lambda ()
        (dp-f 0)))
    "#f #f #f 77\n")
  (begin
    (module (dp-a)
      (module (dp-a)
        (define-syntax dp-a (identifier-syntax 3)))
      (define-property dp-a spam 55))
    (and (eqv? dp-a 3)
         (eqv? (get-property dp-a spam) 55)))
  (begin
    (module (dp-b)
      (module ((dp-b q))
        (define q 3)
        (define-syntax dp-b (identifier-syntax q)))
      (define-property dp-b spam 55))
    (and (eqv? dp-b 3)
         (eqv? (get-property dp-b spam) 55)))
  (let ()
    (module (dp-c)
      (module (dp-c)
        (define-syntax dp-c (identifier-syntax 3)))
      (define-property dp-c spam 55))
    (and (eqv? dp-c 3)
         (eqv? (get-property dp-c spam) 55)))
  (let ()
    (module (dp-c)
      (module ((dp-c q))
        (define q 3)
        (define-syntax dp-c (identifier-syntax q)))
      (define-property dp-c spam 55))
    (and (eqv? dp-c 3)
         (eqv? (get-property dp-c spam) 55)))
  (begin
    (library (dp l2) (export dp-d dp-e spam) (import (scheme))
      (define spam)
      (module (dp-d)
        (module (dp-d)
          (define-syntax dp-d (identifier-syntax 3)))
        (define-property dp-d spam 55))
      (module (dp-e)
        (module ((dp-e q))
          (define q 13)
          (define-syntax dp-e (identifier-syntax q)))
        (define-property dp-e spam 155)))
    (let ()
      (import (dp l2))
      (and (eqv? dp-d 3)
           (eqv? (get-property dp-d spam) 55)
           (eqv? dp-e 13)
           (eqv? (get-property dp-e spam) 155))))
  (begin
    (import (dp l2))
    (and (eqv? dp-d 3)
         (eqv? (get-property dp-d spam) 55)
         (eqv? dp-e 13)
         (eqv? (get-property dp-e spam) 155)))
  (begin
    (with-output-to-file "testfile-dp0.ss"
      (lambda ()
        (pretty-print '(define $dp0-x "dp0-x"))
        (pretty-print '(define-property $dp0-x dp0 17)))
      'replace)
    (with-output-to-file "testfile-dp1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp1)
             (export cons a b spud)
             (import (scheme))
             (define spud)
             (define a "a")
             (define b "b")
             (define-property cons spud "spud-cons")
             (define-property a spud "spud-a")
             (define-property b spud "spud-b"))))
      'replace)
    (with-output-to-file "testfile-dp2.ss"
      (lambda ()
        (pretty-print
          '(module dp2 (cons a b putz)
             (import (scheme))
             (define putz)
             (define a "a")
             (define b "b")
             (define-property cons putz "putz-cons")
             (define-property a putz "putz-a")
             (define-property b putz "putz-b"))))
      'replace)
    (for-each separate-compile '(dp0 dp1 dp2))
    #t)
  (begin (load "testfile-dp0.so") #t)
  (equal? $dp0-x "dp0-x")
  (equal? (get-property $dp0-x dp0) 17)
  (equal?
    (let ()
      (import (testfile-dp1))
      (list (cons a b) (get-property cons spud) (get-property a spud) (get-property b spud)))
    '(("a" . "b") "spud-cons" "spud-a" "spud-b"))
  (begin (load "testfile-dp2.so") #t)
  (equal?
    (let ()
      (import dp2)
      (list (cons a b) (get-property cons putz) (get-property a putz) (get-property b putz)))
    '(("a" . "b") "putz-cons" "putz-a" "putz-b"))
 ; illustrate use of define-property for storing parent record info,
 ; while still allowing the record name to be a variable whose value
 ; is the record type descriptor
  (equal?
    (let ()
      (module (drt)
        (define drt-key)
        (define-syntax drt
          (lambda (x)
            (define construct-name
              (lambda (template-identifier . args)
                (datum->syntax template-identifier
                  (string->symbol
                    (apply string-append
                      (map (lambda (x)
                             (if (string? x)
                                 x
                                 (symbol->string (syntax->datum x))))
                           args))))))
            (define do-drt
              (lambda (rname fname* prtd)
                (with-syntax ([rname rname]
                              [rtd (make-record-type-descriptor
                                     (syntax->datum rname) prtd #f #f #f
                                     (list->vector (map (lambda (fname) `(immutable ,(syntax->datum fname))) fname*)))]
                              [make-rname (construct-name rname "make-" rname)]
                              [rname? (construct-name rname rname "?")]
                              [(rname-fname ...)
                               (map (lambda (fname) (construct-name fname rname "-" fname))
                                    fname*)]
                              [(i ...) (enumerate fname*)])
                  #'(begin
                      (define rname 'rtd)
                      (define rcd (make-record-constructor-descriptor 'rtd #f #f))
                      (define-property rname drt-key 'rtd)
                      (define make-rname (record-constructor rcd))
                      (define rname? (record-predicate 'rtd))
                      (define rname-fname (record-accessor 'rtd i))
                      ...))))
            (syntax-case x (parent)
              [(_ rname fname ...)
               (for-all identifier? #'(rname fname ...))
               (do-drt #'rname #'(fname ...) #f)]
              [(_ rname (parent pname) fname ...)
               (for-all identifier? #'(rname pname fname ...))
               (lambda (r)
                 (let ([prtd (r #'pname #'drt-key)])
                   (unless prtd (syntax-error #'pname "unrecognized parent record typd"))
                   (do-drt #'rname #'(fname ...) prtd)))]))))
      (drt foo x y)
      (drt bar (parent foo) z)
      (let ([b (make-bar 1 2 3)])
        (list
          (record-type-descriptor? foo)
          (record-type-descriptor? bar)
          (foo? b) (bar? b)
          (foo-x b)
          (foo-y b)
          (bar-z b))))
    '(#t #t #t #t 1 2 3))
 ; on no!
  (equal?
    (let ()
      (define type-key)
      (define-syntax declare
        (syntax-rules ()
          [(_ type id)
           (identifier? #'id)
           (define-property id type-key #'type)]))
      (define-syntax type-of
        (lambda (x)
          (syntax-case x ()
            [(_ id)
             (identifier? #'id)
             (lambda (r)
               #`'#,(r #'id #'type-key))])))
      (let ([x 3])
        (define p (lambda (x) x))
        (declare fixnum? x)
        (declare procedure? p)
        (list (type-of x) (type-of p))))
    '(fixnum? procedure?))
 ; make sure library is visited and invoked when needed by
 ; top-level-xxx procedures, even when properties are defined
  (begin
    (with-output-to-file "testfile-dp3.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp3) (export dp3-x frop) (import (chezscheme))
             (define frop)
             (define dp3-x 3)
             (define-property dp3-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp3))
    #t)
  (begin (import (testfile-dp3)) #t)
  (top-level-bound? 'dp3-x)
  (equal? (get-property dp3-x frop) "blob")
  (begin
    (with-output-to-file "testfile-dp4.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp4) (export dp4-x frop) (import (chezscheme))
             (define frop)
             (define dp4-x 3)
             (define-property dp4-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp4))
    #t)
  (begin (import (testfile-dp4)) #t)
  (eqv? (top-level-value 'dp4-x) 3)
  (equal? (get-property dp4-x frop) "blob")
  (begin
    (with-output-to-file "testfile-dp5.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp5) (export dp5-x frop) (import (chezscheme))
             (define frop)
             (define dp5-x 3)
             (define-property dp5-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp5))
    #t)
  (begin (import (testfile-dp5)) #t)
 ; same as last, but reverse order of checks
  (equal? (get-property dp5-x frop) "blob")
  (eqv? (top-level-value 'dp5-x) 3)
  (begin
    (with-output-to-file "testfile-dp6.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp6) (export dp6-x frop) (import (chezscheme))
             (define frop)
             (define-syntax dp6-x (identifier-syntax 3))
             (define-property dp6-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp6))
    #t)
  (begin (import (testfile-dp6)) #t)
  (top-level-syntax? 'dp6-x)
  (equal? (get-property dp6-x frop) "blob")
  (begin
    (with-output-to-file "testfile-dp7.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp7) (export dp7-x frop) (import (chezscheme))
             (define frop)
             (define-syntax dp7-x (identifier-syntax 3))
             (define-property dp7-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp7))
    #t)
  (begin (import (testfile-dp7)) #t)
 ; same as last, but reverse order of checks
  (equal? (get-property dp7-x frop) "blob")
  (top-level-syntax? 'dp7-x)
  (begin
    (with-output-to-file "testfile-dp8.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp8) (export dp8-x frop) (import (chezscheme))
             (define frop)
             (define-syntax dp8-x (identifier-syntax 3))
             (define-property dp8-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp8))
    #t)
  (begin (import (testfile-dp8)) #t)
 ; same as last, but reverse order of checks
  (procedure? (top-level-syntax 'dp8-x))
  (equal? (get-property dp8-x frop) "blob")
  (begin
    (with-output-to-file "testfile-dp9.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp9) (export dp9-x frop) (import (chezscheme))
             (define frop)
             (define-syntax dp9-x (identifier-syntax 3))
             (define-property dp9-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp9))
    #t)
  (begin (import (testfile-dp9)) #t)
  (error? ; not a variable
    (set-top-level-value! 'dp9-x 11))
  (equal? (get-property dp9-x frop) "blob")
  (begin
    (with-output-to-file "testfile-dp10.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp10) (export dp10-x frop) (import (chezscheme))
             (define frop)
             (define dp10-x 3)
             (define-property dp10-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp10))
    #t)
  (begin (import (testfile-dp10)) #t)
  (error? ; immutable
    (set-top-level-value! 'dp10-x 11))
  (equal? (get-property dp10-x frop) "blob")
  (begin
    (with-output-to-file "testfile-dp11.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp11) (export dp11-x frop) (import (chezscheme))
             (define frop)
             (define dp11-x 3)
             (define-property dp11-x frop "blob"))))
      'replace)
    (for-each separate-compile '(dp11))
    #t)
  (begin (import (testfile-dp11)) #t)
  (not (top-level-mutable? 'dp11-x))
  (equal? (get-property dp11-x frop) "blob")
  (equal?
    (syntax-case '(a b c) ()
      [(_ . x)
       (let ()
         (define-property x goofy 'stuff)
         (define-property x amazingly 'unlikely)
         (list (get-property x goofy)
               (get-property x amazingly)
               #'x))])
    '(stuff unlikely (b c)))
 (begin
   (library (docstring)
     (export define-docstring get-docstring)
     (import (chezscheme))
     (define check-docstring
       (lambda (x s)
         (unless (string? s)
           (syntax-error x "invalid docstring definition"))
         s))
     (define-syntax define-docstring
       (lambda (x)
         (syntax-case x ()
           [(_ id expr)
            #`(define-property id check-docstring
                (check-docstring #'#,x expr))])))
     (define-syntax get-docstring
       (lambda (x)
         (lambda (r)
           (syntax-case x ()
             [(_ id)
              (or (r #'id #'check-docstring) "no documentation available")])))))
   #t)
  (equal?
    (let ()
      (import (docstring))
      (define-docstring cons "cons takes three arguments")
      (get-docstring cons))
    "cons takes three arguments")
  (equal?
    (let ()
      (import (docstring))
      (define-docstring else "else is cool")
      (cond [else (get-docstring else)]))
    "else is cool")
  ((lambda (x ls) (and (member x ls) #t))
   (parameterize ([#%$suppress-primitive-inlining #f])
     (expand
       '(let ()
          (import scheme)
          (define-property cons car 3)
          cons)))
   `(#%cons #2%cons #3%cons))
  (begin
    (define dp-x #f)
    (define dp-y #f)
    (define-property dp-x dp-y "xy")
    (define-syntax a
      (lambda (z)
        (define-property dp-x z "xz")
        #'(get-property dp-x dp-y)))
    (equal? a "xy"))
  (begin
    (define dp-x #f)
    (define dp-y #f)
    (define-property dp-x dp-y "outer")
    (define-syntax a
      (lambda (z)
        (define-property dp-x dp-y "inner")
        #'(get-property dp-x dp-y)))
    (not a))
  (equal?
    (let ([x #f] [y #f])
      (define-property x y "xy")
      (define-syntax a
        (lambda (z)
          (define-property x z "xz")
          #'(get-property x y)))
      a)
    "xy")
  (eq?
    (let ([x #f] [y #f])
      (define-property x y "outer")
      (define-syntax a
        (lambda (z)
          (define-property x y "inner")
          #'(get-property x y)))
      a)
    #f)
  (eq?
    (let ([x #f])
      (define-syntax a
        (syntax-rules (x)
          [(_ x) 'yes]
          [(_ y) 'no]))
      (let ()
        (define-property x q 0)
        (a x)))
    'yes)
  (begin
    (library (dp l3) (export x)
      (import (chezscheme))
      (define x 5)
      (define-property x car 17))
    (import (dp l3))
    (and (eqv? x 5) (eqv? (let () (import (chezscheme)) (get-property x car)) 17)))
  (begin
    (library (dp l4) (export sort)
      (import (chezscheme))
      (define-property sort car 53))
    (library (dp l5) (export sort)
      (import (chezscheme))
      (define-property sort cdr 87))
    (import (dp l4))
    (import (dp l5))
    (and (procedure? sort)
         (eq? sort #%sort)
         (eqv? (let () (import (only (chezscheme) car)) (get-property sort car)) 53)
         (eqv? (let () (import (only (chezscheme) cdr)) (get-property sort cdr)) 87)))
  (begin
    (with-output-to-file "testfile-dp12.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-dp12) (export dp12-dq) (import (chezscheme))
             (define-syntax dp12-dq (identifier-syntax "dq"))
             (define-property dp12-dq car "dqp"))))
      'replace)
    (for-each separate-compile '(dp12))
    #t)
  (begin (import (testfile-dp12)) #t)
  (equal? (list dp12-dq (let () (import (chezscheme)) (get-property dp12-dq car))) '("dq" "dqp"))
  (equal?
    (let ()
      (define x 0)
      (module m1 (x) (define-property x car "xcar"))
      (module m2 (x) (define-property x cdr "xcdr"))
      (let ([q1 (let () (import m1) (list x (get-property x car) (get-property x cdr)))]
            [q2 (let () (import m2) (list x (get-property x car) (get-property x cdr)))]
            [q3 (let () (import m1) (import m2) (list x (get-property x car) (get-property x cdr)))]
            [q4 (let () (import m2) (import m1) (list x (get-property x car) (get-property x cdr)))])
        (list x q1 q2 q3 q4 (get-property x car) (get-property x cdr))))
    '(0 (0 "xcar" #f) (0 #f "xcdr") (0 "xcar" "xcdr") (0 "xcar" "xcdr") #f #f))
  (equal?
    (let ()
      (define x 0)
      (module m1 (x) (define-property x car "xcar"))
      (import m1)
      (module m2 (x) (define-property x cdr "xcdr"))
      (import m2)
      (list x (get-property x car) (get-property x cdr)))
    '(0 "xcar" "xcdr"))
  (begin
    (module $dp13 (foo)
      (define foo 17)
      (module ((foo bar))
        (define-property foo cons #'bar)
        (define bar 35)))
    #t)
  (eqv?
    (let ()
      (import $dp13)
      (define-syntax a
        (lambda (x)
          (lambda (r)
            (syntax-case x ()
              [(_ id) (r #'id #'cons)]))))
      (a foo))
    35)
  (eqv?
    (let ()
      (module m (x) (define x 3) (define-property x x 4))
      (import m)
      (get-property x x))
    4)
  (eqv?
    (let ()
      (module m (x) (define x 3) (define-property x x 4))
      (import (alias m (x y)))
      (get-property x x))
    4)
  (eqv?
    (let ()
      (module m (x) (define x 3) (define-property x x 4))
      (import (alias m (x y)))
      (get-property x y))
    4)
  (eqv?
    (let ()
      (module m (x) (define x 3) (define-property x x 4))
      (import (alias m (x y)))
      (get-property y x))
    4)
  (eqv?
    (let ()
      (module m (x) (define x 3) (define-property x x 4))
      (import (alias m (x y)))
      (get-property y y))
    4)
  (eqv?
    (let ()
      (module m (x) (define x 3) (define-property x x 4))
      (import (rename m (x y)))
      (get-property y y))
    4)
  (begin
    (module $dp14 (x) (define x 3) (define-property x x 4))
    #t)
  (eqv?
    (let ()
      (import $dp14)
      (get-property x x))
    4)
  (eqv?
    (let ()
      (import (alias $dp14 (x y)))
      (get-property x x))
    4)
  (eqv?
    (let ()
      (import (alias $dp14 (x y)))
      (get-property x y))
    4)
  (eqv?
    (let ()
      (import (alias $dp14 (x y)))
      (get-property y x))
    4)
  (eqv?
    (let ()
      (import (alias $dp14 (x y)))
      (get-property y y))
    4)
  (eqv?
    (let ()
      (import (rename $dp14 (x y)))
      (get-property y y))
    4)
  (equal?
    (let ([y 14])
      (define k1)
      (define k2)
      (module ()
        (export x (rename (y x)))
        (define x 3)
        (define-property x k1 4)
        (define-property x k2 5)
        (alias y x))
      (list x y (get-property x k1) (get-property x k2) (get-property y k1) (get-property y k2)))
    '(3 14 4 5 #f #f))
  (error? ; attempt to export different bindings for x
    (let ([y 14])
      (define k1)
      (define k2)
      (module ()
        (export x (rename (y x)))
        (define x 3)
        (define-property x k1 4)
        (alias y x)
        (define-property x k2 5))
      (list x y (get-property x k1) (get-property y k2))))
  (begin
    (with-output-to-file "testfile-A.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-A)
             (export $testfile-A-x $testfile-A-prop-id)
             (import (scheme))
             (define $testfile-A-x (cons 'a 'b))
             (define $testfile-A-prop-id)
             (define-property $testfile-A-x $testfile-A-prop-id (cons 'c 'd)))))
      'replace)
    (with-output-to-file "testfile-B.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-B)
             (export)
             (import (scheme) (testfile-A))
             (export (import (testfile-A))))))
      'replace)
    (with-output-to-file "testfile-C.ss"
      (lambda ()
        (pretty-print 
          '(library (testfile-C)
             (export)
             (import (scheme) (testfile-A) (testfile-B))
             (export (import (testfile-A)) (import (testfile-B))))))
      'replace)
    (for-each separate-compile '(A B C))
    #t)
  (equal? 
    (let ()
      (import (testfile-C))
      (list $testfile-A-x (get-property $testfile-A-x $testfile-A-prop-id)))
    '((a . b) (c . d)))
)

(mat library1
  (error? (compile-library "/file/not/there"))
  (error? (load-library "/file/not/there"))
  (error? ; abc is not a string
    (load-library 'abc))
  (error? ; xxx is not a procedure
    (load-library "/file/not/there" 'xxx))
  (error? ; 3 is not a string
    (parameterize ([source-directories '("/tmp" ".")]) (load-library 3)))
  (error? ; 3 is not a string
    (parameterize ([source-directories '("/tmp" ".")]) (load-library 3 values)))
  (begin
    (library ($l1-a) (export $l1-x) (import (scheme))
      (module $l1-x (($l1-a $l1-b) $l1-c $l1-e)
        (define $l1-d 4)
        (define-syntax $l1-a (identifier-syntax (cons $l1-b $l1-y)))
        (define $l1-b 55)
        (define $l1-c (lambda () (* $l1-d $l1-y)))
        (define $l1-f 44)
        (define-syntax $l1-e (identifier-syntax $l1-f)))
      (define $l1-y 14))
    #t)
  (equal?
    (let () (import ($l1-a)) (import $l1-x) (list $l1-a ($l1-c)))
    '((55 . 14) 56))
  (begin
    (import ($l1-a))
    #t)
  (begin
    (import $l1-x)
    #t)
  (equal? $l1-a '(55 . 14))
  (equal? ($l1-c) 56)
  (error? ; unbound variable $l1-b
    $l1-b)
  (error? ; unbound variable $l1-d
    $l1-d)
  (error? ; unbound variable $l1-y
    $l1-y)
  (error? ; unexported identifier $l1-f
    $l1-e)
  (error? ; unbound variable $l1-f
    $l1-f)
  (equal?
    (let () (import ($l1-a)) (import $l1-x) (list $l1-a ($l1-c)))
    '((55 . 14) 56))
  (begin
    (library ($l1-b) (export $l1-x) (import (scheme))
      (module $l1-x ($l1-a $l1-c $l1-e)
        (define $l1-d 4)
        (define $l1-a (lambda () (cons $l1-b $l1-y)))
        (define $l1-b 55)
        (define $l1-c (lambda () (* $l1-d $l1-y)))
        (define $l1-f 44)
        (define $l1-e (lambda () $l1-f)))
      (define $l1-y 14))
    #t)
  (equal?
    (let () (import ($l1-b)) (import $l1-x) (vector ($l1-a) ($l1-c) ($l1-e)))
    '#((55 . 14) 56 44))
  (begin
    (import ($l1-b))
    #t)
  (begin
    (import $l1-x)
    #t)
  (equal? ($l1-a) '(55 . 14))
  (equal? ($l1-c) 56)
  (equal? ($l1-e) 44)
  (error? ; unbound variable $l1-b
    $l1-b)
  (error? ; unbound variable $l1-d
    $l1-d)
  (error? ; unbound variable $l1-y
    $l1-y)
  (error? ; unbound variable $l1-f
    $l1-f)
  (equal?
    (let () (import ($l1-b)) (import $l1-x) (vector ($l1-a) ($l1-c) ($l1-e)))
    '#((55 . 14) 56 44))
  (begin
    (library ($l1-c) (export (rename (q $l1-q) (a:x $l1-x)) $l1-p)
      (import (scheme) (rename ($l1-a) ($l1-x a:x)) (rename ($l1-b) ($l1-x b:x)))
      (import (drop-prefix a:x $l1-) (prefix (drop-prefix b:x $l1-) b:))
      (define-syntax q (identifier-syntax (list a (c) (b:a) (b:c) ($l1-p) (r))))
      (define $l1-p (lambda () (vector a (c) (b:a) (b:c))))
      (define r (lambda () (cons* a (c) (b:a) (b:c)))))
    #t)
  (equal?
    (let () (import ($l1-c)) $l1-q)
    '((55 . 14) 56 (55 . 14) 56
      #4((55 . 14) 56 (55 . 14) 56)
      ((55 . 14) 56 (55 . 14) . 56)))
  (equal?
    (let () (import ($l1-c) ($l1-a)) (import $l1-x) (list $l1-a $l1-q))
    '((55 . 14)
      ((55 . 14) 56 (55 . 14) 56
       #4((55 . 14) 56 (55 . 14) 56)
       ((55 . 14) 56 (55 . 14) . 56))))

  (begin
    (library ($l1-d) (export $l1-x $l1-getx $l1-setx!) (import (scheme))
      (define x 0)
      (define-syntax $l1-x (identifier-syntax x))
      (define $l1-getx (lambda () x))
      (define $l1-setx! (lambda (v) (set! x v))))
    #t)
  (eqv?
    (let () (import ($l1-d)) ($l1-setx! 'hello) ($l1-getx))
    'hello)
  (error? ; unexported identifier x
    (let () (import ($l1-d)) $l1-x))
  (error? ; unexported identifier x
    (expand '(let () (import ($l1-d)) $l1-x)))
  (error? ; immutable variable $l1-x
    (let () (import ($l1-d)) (set! $l1-getx void)))
  (error? ; immutable variable $l1-x
    (expand '(let () (import ($l1-d)) (set! $l1-getx void))))
  (begin
    (import ($l1-d))
    #t)
  (eqv?
    (begin ($l1-setx! 'hello) ($l1-getx))
    'hello)
  (error? ; unexported identifier x
    $l1-x)
  (error? ; unexported identifier x
    (expand '$l1-x))
  (error? ; immutable variable $l1-x
    (set! $l1-getx void))
  (error? ; immutable variable $l1-x
    (expand '(set! $l1-getx void)))

  (error?
    (library ($l1-e) (export $l1-x) (import (scheme))
      (define $l1-x 0)
      (set! $l1-x 1)))
  (error?
    (expand
      '(library ($l1-e) (export $l1-x) (import (scheme))
         (define $l1-x 0)
         (set! $l1-x 1))))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print
          '(library ($l1-f) (export $l1-x $l1-y) (import (scheme))
             (define-syntax $l1-x (identifier-syntax q))
             (define-syntax q
               (begin
                 (printf "An expand-time greeting from $l1-f\n")
                 (lambda (x) 77)))
             (define $l1-y (lambda () (* q 2)))
             (printf "A run-time greeting from $l1-f\n")))
        (pretty-print
          '(library ($l1-g) (export $l1-x $l1-z $l1-w) (import (scheme) ($l1-f))
             (define-syntax $l1-z
               (begin
                 (printf "An expand-time greeting from $l1-g\n")
                 (lambda (x) ($l1-y))))
             (define $l1-w
               (begin
                 (printf "A run-time greeting from $l1-g\n")
                 (lambda (x) (cons* x $l1-x ($l1-y)))))))
        (pretty-print
          '(library ($l1-h) (export $l1-x $l1-y $l1-v) (import (scheme) ($l1-f) ($l1-g))
             (define $l1-v (list $l1-x ($l1-y) $l1-z ($l1-w 13)))
             (printf "A run-time greeting from $l1-h\n"))))
      'replace)
    (compile-file "testfile")
    #t)
 ; look, ma, no need to load...
  (equal?
    (let () (import ($l1-h)) $l1-v)
    '(77 154 154 (13 77 . 154)))
  (begin
    (library ($l1-h) (export $l1-x $l1-y $l1-v) (import (scheme))
      (define $l1-x "these aren't")
      (define $l1-y "the exports")
      (define $l1-v "you're looking for"))
    #t)
  (begin (load "testfile.so") #t)
  (equal?
    (let () (import ($l1-h)) $l1-v)
    '(77 154 154 (13 77 . 154)))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print
          '(library ($l1-f) (export $l1-x $l1-y) (import (scheme))
             (define-syntax $l1-x (identifier-syntax q))
             (define-syntax q
               (begin
                 (printf "An expand-time greeting from $l1-f\n")
                 (lambda (x) 77)))
             (define $l1-y (lambda () (* q 2)))
             (printf "A run-time greeting from $l1-f\n")))
        (pretty-print
          '(library ($l1-g) (export $l1-x $l1-z $l1-w) (import (scheme) ($l1-f))
             (define-syntax $l1-z
               (begin
                 (printf "An expand-time greeting from $l1-g\n")
                 (lambda (x) ($l1-y))))
             (define $l1-w
               (begin
                 (printf "A run-time greeting from $l1-g\n")
                 (lambda (x) (cons* x $l1-z $l1-x ($l1-y)))))))
        (pretty-print
          '(library ($l1-h) (export $l1-x $l1-y $l1-v) (import (scheme) ($l1-f) ($l1-g))
             (define $l1-v (list $l1-x ($l1-y) $l1-z ($l1-w 13)))
             (printf "A run-time greeting from $l1-h\n"))))
      'replace)
    (compile-file "testfile")
    #t)
 ; look, ma, no need to load...
  (equal?
    (let () (import ($l1-h)) $l1-v)
    '(77 154 154 (13 154 77 . 154)))
  (begin
    (library ($l1-h) (export $l1-x $l1-y $l1-v) (import (scheme))
      (define $l1-x "these aren't")
      (define $l1-y "the exports")
      (define $l1-v "you're looking for"))
    #t)
  (begin (load "testfile.so") #t)
  (equal?
    (let () (import ($l1-h)) $l1-v)
    '(77 154 154 (13 154 77 . 154)))

  (error? ; unknown library ($l1-ham)
    (begin
      (library ($l1-spam) (export) (import ($l1-ham)))
      (library ($l1-ham) (export) (import ($l1-spam)))))

  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (pretty-print
          '(library ($l1-i) (export $l1-x $l1-y) (import (scheme))
             (define $l1-x 'i-am-x)
             (define-syntax $l1-y (identifier-syntax 'i-am-y))))
        (pretty-print
          '(library ($l1-j) (export $l1-x $l1-y)
             (import ($l1-i) (only (scheme) errorf))
             (errorf #f "this error shouldn't happen")))
        (pretty-print
          '(library ($l1-k) (export $l1-z) (import (scheme) ($l1-j))
             (define $l1-z (list 'i-am-z $l1-x $l1-y)))))
      'replace)
    (compile-file "testfile")
    #t)
  (equal?
    (let () (import ($l1-k)) $l1-z)
    '(i-am-z i-am-x i-am-y))
  (begin (load "testfile.so") #t)
  (equal?
    (let () (import ($l1-k)) $l1-z)
    '(i-am-z i-am-x i-am-y))

  (begin
    (library ($l1-l) (export $l1-x) (import (scheme))
      (define $l1-x 'i-am-$l1-l.$l1-x))
    #t)
  (eq?
    (let ()
      (import ($l1-l))
      (define-syntax a (lambda (x) #`'#,(datum->syntax #'* $l1-x)))
      a)
    'i-am-$l1-l.$l1-x)

  (begin
    (with-output-to-file "testfile-a1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a1)
             (export $l1-a)
             (import (scheme))
             (define $l1-a 'a1))))
      'replace)
    (with-output-to-file "testfile-b1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b1)
             (export $l1-a $l1-b)
             (import (scheme) (testfile-a1))
             (define $l1-b 'b1))))
      'replace)
    (with-output-to-file "testfile-c1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-c1)
             (export $l1-a $l1-b $l1-c)
             (import (scheme) (testfile-b1))
             (define ($l1-c) (list $l1-a $l1-b 'c1)))))
      'replace)
    (with-output-to-file "testfile-d1.ss"
      (lambda ()
        (pretty-print '(import (scheme) (testfile-b1)))
        (pretty-print '(define ($l1-d) (list $l1-a $l1-b 'd1))))
      'replace)
    (with-output-to-file "testfile-e1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-e1)
             (export $l1-e)
             (import (scheme) (testfile-b1))
             (alias $l1-e $l1-a))))
      'replace)
    (with-output-to-file "testfile-f1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-f1)
             (export $l1-f)
             (import (scheme))
             (define-syntax $l1-f (identifier-syntax "macro-f")))))
      'replace)
    (with-output-to-file "testfile-g1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-g1)
             (export $l1-f)
             (import (scheme) (testfile-f1)))))
      'replace)
    (with-output-to-file "testfile-h1.ss"
      (lambda ()
        (pretty-print '(import (scheme) (testfile-g1)))
        (pretty-print '(define ($l1-h) (list $l1-f))))
      'replace)
    (for-each separate-compile '(a1 b1 c1 d1 e1 f1 g1 h1))
    #t)
  (equal? (begin (load "testfile-d1.so") ($l1-d)) '(a1 b1 d1))
  (begin (import (testfile-c1)) #t)
  (equal? ($l1-c) '(a1 b1 c1))
  (begin (import (testfile-e1)) #t)
  (equal? $l1-e 'a1)
  (equal? (begin (load "testfile-h1.so") ($l1-h)) '("macro-f"))

  (begin
    (with-output-to-file "testfile-a2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a2)
             (export $l1-a)
             (import (scheme))
             (define $l1-a 'a2))))
      'replace)
    (with-output-to-file "testfile-b2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b2)
             (export $l1-a $l1-b)
             (import (scheme) (testfile-a2))
             (define $l1-b 'b2))))
      'replace)
    (with-output-to-file "testfile-c2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-c2)
             (export $l1-a $l1-b $l1-c)
             (import (scheme) (testfile-b2))
             (define ($l1-c) (list $l1-a $l1-b 'c2)))))
      'replace)
    (with-output-to-file "testfile-d2.ss"
      (lambda ()
        (pretty-print '(import (scheme) (testfile-b2)))
        (pretty-print '(define ($l1-d) (list $l1-a $l1-b 'd2))))
      'replace)
    (for-each separate-compile '(a2 b2 c2 d2 a2))
    #t)
  (error? ; expected different compilation instance
          ; program complains about b2 rather than b2 about a2
          ;   now that load-library reloads source when dependency changes
          ;   would be nice if program were reloaded from source as well
    (load "testfile-d2.so"))
  ; no longer fails now that load-library reloads source when dependency changes
  #;(error? ; expected different compilation instance
    (import (testfile-c2)))
  (begin
    (library ($l1-m) (export $l1-x) (import (scheme)) (define $l1-x 333))
    (library ($l1-n) (export $l1-x) (import (scheme)) (import ($l1-m)))
    #t)
  (eqv?
    (let () (import ($l1-n)) $l1-x)
    333)
  (begin
    (define-syntax $from1
      (syntax-rules ()
        ((_ m id)
         (let () (import-only m) id))))
    (define-syntax $from2
      (syntax-rules ()
        ((_ m id)
         (let () (module (id) (import m)) id))))
    (define-syntax $from3
      (syntax-rules ()
        [(_ m id)
         (let ([z (cons 1 2)])
           (let ([id z])
             (import m)
             (let ([t id])
               (if (eq? t z) (errorf 'from "~s undefined" 'id) t))))]))
    (library ($frappe) (export wire whip) (import (scheme))
      (define wire 3)
      (define-syntax whip (identifier-syntax egg))
      (define egg 'whites))
    (equal?
      (list (cons ($from1 ($frappe) wire) ($from1 ($frappe) whip))
            (cons ($from2 ($frappe) wire) ($from2 ($frappe) whip))
            (cons ($from3 ($frappe) wire) ($from3 ($frappe) whip)))
      '((3 . whites) (3 . whites) (3 . whites))))
  (begin
    (library ($q) (export m from) (import (scheme))
      (module m (f) (define f "this is f"))
      (define-syntax from
        (syntax-rules () [(_ m id) (let () (import-only m) id)])))
    (equal? (let () (import-only ($q)) (from m f)) "this is f"))
  (begin
    (library ($p) (export d f) (import (scheme))
      (define-syntax d
        (syntax-rules ()
          ((_ e) (m (lambda () e)))))
      (define m (lambda (x) x))
      (define f (lambda (th) (th))))
    (eqv? (let () (import-only ($p)) (f (d 2))) 2))
 ; this works for libraries because m is implicitly exported
  (eqv? (let () (import-only ($p)) (f (d 1/3))) 1/3)
  (error? ; cons undefined
    (let () (import-only ($p)) (f (d cons))))
  (error? ; invalid syntax
    (library (a) (export x:eval) (import (add-prefix (rnrs eval) x))))
  (error? ; invalid syntax
    (library (a) (export val) (import (drop-prefix (rnrs eval) x))))
  (error? ; invalid syntax
    (library (a) (export meaning) (import (alias (rnrs eval) [eval meaning]))))
  (begin
    (define $l1-q1)
    (define $l1-q2)
    (define-syntax $l1-qlib
      (syntax-rules ()
        [(_ name (export ex ...) (import im ...) body ...)
         (begin
           (library name (export ex ... q)
             (import im ... (rename (only (rnrs) cons) (cons list)))
             (define q list) body ...)
           (let () (import name) (set! $l1-q1 q)))]))
    ($l1-qlib ($l1-libfoo) (export q) (import (rnrs)) (define q list))
    (let () (import ($l1-libfoo)) (set! $l1-q2 q))
    (equal? (list $l1-q1 $l1-q2) (list cons list)))
 ; check for existence of chezscheme library
  (begin
    (library ($l1-r1) (export $l1-x) (import (chezscheme))
      (define $l1-x (sort < '(1 3 2 0 5))))
    (library ($l1-r2) (export $l1-y) (import (chezscheme) ($l1-r1))
      (define $l1-y (cons $l1-x (void))))
    (equal? (let () (import ($l1-r2)) $l1-y) `((0 1 2 3 5) . ,(void))))
  (error? ; invalid context for library form
    (module (a) (library (a) (export) (import))))
  (error? ; invalid syntax for library form
    (module (a) (library a (import) (export x) (define x 3)) (import a) x))
  (error? ; invalid context for top-level-program form
    (module (a) (top-level-program (import))))
  (error? ; invalid syntax for top-level-program form
    (module (a) (top-level-program (display "hello"))))
  (error? ; invalid context for library form
    (lambda () (library (a) (export) (import))))
  (error? ; invalid syntax for library form
    (lambda () (library a (import) (export x) (define x 3)) (import a) x))
  (error? ; invalid context for top-level-program form
    (lambda () (top-level-program (import))))
  (error? ; invalid syntax for top-level-program form
    (lambda () (top-level-program (display "hello"))))
  (error? ; defnie not defined
    (library ($l1-s) (export y) (import (rnrs)) (defnie x 3) (define y 4)))

  (begin
    (library ($l1-s)
      (export m)
      (import (chezscheme))
      (module m (x set-x!)
        (define x 0)
        (define set-x! (lambda () (set! x 1)))))
    #t)
  (error? ; attempt to reference assigned hence unexported
    (let () (import ($l1-s)) (import m) x))
  (error? ; attempt to reference assigned hence unexported
    (let () (import ($l1-s)) (import m) (set! x 2)))
  (error? ; invalid version
    (let () (import-only (chezscheme csv7 (6))) record-field-mutator))
  (equal?
    (let () (import-only (chezscheme csv7)) record-field-mutator)
    csv7:record-field-mutator)

 ; test macros generating libraries
  (begin
    (let-syntax ([make-A (syntax-rules ()
                           [(_) (library (A)
                                  (export $library-x)
                                  (import (chezscheme))
                                  (define $library-x 3))])])
      (make-A))
    #t)
  (error? ; out-of-context library reference (A)
    (equal? (let () (import (A)) $library-x) 3))
  (begin
    (let-syntax ([make-A (lambda (x)
                           (syntax-case x ()
                             [(k) (with-implicit (k A)
                                    #'(library (A)
                                        (export $library-x)
                                        (import (chezscheme))
                                        (define $library-x 3)))]))])
      (make-A))
    #t)
  (error? ; unbound $library-x
    (equal? (let () (import (A)) $library-x) 3))
  (begin
    (let-syntax ([make-A (lambda (x)
                           (syntax-case x ()
                             [(k id ...)
                              (with-implicit (k A)
                                #'(library (A)
                                    (export id ...)
                                    (import (chezscheme))
                                    (define id 3)
                                    ...))]))])
      (make-A $library-x))
    #t)
  (eqv? (let () (import (A)) $library-x) 3)
  (let-syntax ([make-A (syntax-rules ()
                         [(_) (begin
                                (library (A)
                                  (export x)
                                  (import (chezscheme))
                                  (define x 3))
                                (let () (import (A))
                                  (eqv? x 3)))])])
    (make-A))
  (let-syntax ([make-A (syntax-rules ()
                         [(_) (begin
                                (library (A)
                                  (export x)
                                  (import (chezscheme))
                                  (define x 3))
                                (define-syntax q
                                  (syntax-rules ()
                                    [(_) (let ()
                                           (import (A))
                                           x)]))
                                (eqv? (q) 3))])])
    (make-A))

  (begin
    (with-output-to-file "testfile-a14.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a14) (export f) (import (chezscheme))
             (define f (lambda (n) (if (fx= n 0) 1 (fx* n (f (fx- n 1))))))
             (printf "invoked a\n"))))
      'replace)
    (with-output-to-file "testfile-b14.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b14) (export g) (import (chezscheme) (testfile-a14))
             (define g (lambda (n) (f n)))
             (printf "invoked b\n"))))
      'replace)
    (with-output-to-file "testfile-c14.ss"
      (lambda ()
        (pretty-print '(import (chezscheme) (testfile-b14)))
        (pretty-print '(pretty-print (g 10))))
      'replace)
    #t)
  (equal?
    (with-output-to-string
      (lambda () (load "testfile-c14.ss")))
    "invoked a\ninvoked b\n3628800\n")
  ; test for proper propagation and non-propagation of constants across library boundaries
  (begin
    (with-output-to-file "testfile-a15.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a15) (export a b c d e f g fa fb fc fd fe ff fg)
             (import (chezscheme))
             (define-record-type foo (nongenerative) (fields x))
             (define a '())
             (define b 'sym)
             (define c 3/4)
             (define d '(x . y))
             (define e (record-type-descriptor foo))
             (define f (make-foo 3))
             (define g "hello!")
             (define fa (lambda () a))
             (define fb (lambda () b))
             (define fc (lambda () c))
             (define fd (lambda () d))
             (define fe (lambda () e))
             (define ff (lambda () f))
             (define fg (lambda () g)))))
      'replace)
    (with-output-to-file "testfile-b15.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b15) (export a b c d e f g fa fb fc fd fe ff fg)
             (import (chezscheme) (prefix (testfile-a15) %))
             (define a %a)
             (define b %b)
             (define c %c)
             (define d %d)
             (define e %e)
             (define f %f)
             (define g %g)
             (define fa (lambda () (%fa)))
             (define fb (lambda () (%fb)))
             (define fc (lambda () (%fc)))
             (define fd (lambda () (%fd)))
             (define fe (lambda () (%fe)))
             (define ff (lambda () (%ff)))
             (define fg (lambda () (%fg))))))
      'replace)
    (with-output-to-file "testfile-c15.ss"
      (lambda ()
        (pretty-print '(define $c15-ls1
                         (let ()
                           (import (testfile-a15))
                           (list a b c d e f g (fa) (fb) (fc) (fd) (fe) (ff) (fg)))))
        (pretty-print '(define $c15-ls2
                         (let ()
                           (import (testfile-b15))
                           (list a b c d e f g (fa) (fb) (fc) (fd) (fe) (ff) (fg)))))
        (pretty-print '(pretty-print (map eq? $c15-ls1 $c15-ls2)))
        (pretty-print '(pretty-print (map eqv? $c15-ls1 $c15-ls2)))
        (pretty-print '(pretty-print (map equal? $c15-ls1 $c15-ls2))))
      'replace)
    (for-each separate-compile '(a15 b15 c15))
    #t)
  ((lambda (x ls) (and (member x ls) #t))
    (with-output-to-string
      (lambda () (load "testfile-c15.so")))
    '("(#t #t #f #t #t #t #t #t #t #f #t #t #t #t)\n(#t #t #t #t #t #t #t #t #t #t #t #t #t #t)\n(#t #t #t #t #t #t #t #t #t #t #t #t #t #t)\n"
      "(#t #t #t #t #t #t #t #t #t #t #t #t #t #t)\n(#t #t #t #t #t #t #t #t #t #t #t #t #t #t)\n(#t #t #t #t #t #t #t #t #t #t #t #t #t #t)\n"))
  (begin
    (library ($l3) (export f) (import (chezscheme)) (define (f x) x))
    #t)
  (equal?
    (let () (import ($l3)) (f (f 3)))
    3)
  (begin
    ;; (export import-spec ...) empty case
    (library ($empty) (export) (import (chezscheme)) (export (import)))
    #t)
  (begin
    (library ($l4-A) (export a) (import (chezscheme)) (define a 1))
    (library ($l4-B) (export b) (import (chezscheme)) (define b 2))
    #t)
  (equal? '(1 2) (let () (import ($l4-A) ($l4-B)) (list a b)))
  (begin
    ;; (export import-spec ...) multiple imports case
    (library ($l4-C) (export) (import (chezscheme)) (export (import ($l4-A) ($l4-B))))
    (equal? '(1 2) (let () (import ($l4-C)) (list a b))))
 )

(mat library2
  ; test to make sure that libraries needed by the transformers of local
  ; macros are invoked immediately and not required as run-time requirements.
  (begin
    (with-output-to-file "testfile-a3.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a3) (export q) (import (rnrs) (only (scheme) putprop)) (define q 3) (putprop 'testfile-a3 'invoke #t))))
      'replace)
    (with-output-to-file "testfile-b3.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b3) (export x) (import (testfile-a3) (rnrs) (only (scheme) putprop))
             (define x (let () (define-syntax p (lambda (x) (putprop 'testfile-b3 'visit #t) q)) p)))))
      'replace)
    (for-each separate-compile '(a3 b3))
    #t)
  (equal?
    (let ()
      (import (testfile-b3))
      (list x (getprop 'testfile-a3 'invoke #f) (getprop 'testfile-b3 'visit #f)))
    '(3 #f #f))
  (begin
    (with-output-to-file "testfile-a4.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a4) (export q) (import (rnrs) (only (scheme) putprop))
             (define q (lambda (x) (if (= x 0) 1 (* x (q (- x 1))))))
             (putprop 'testfile-a4 'invoke #t))))
      'replace)
    (with-output-to-file "testfile-b4.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b4) (export x) (import (testfile-a4) (rnrs) (only (scheme) putprop))
             (define x (let () (define-syntax p (lambda (x) (putprop 'testfile-b4 'visit #t) (q 3))) (list p (q 4)))))))
      'replace)
    (for-each separate-compile '(a4 b4))
    #t)
  (equal?
    (let ()
      (import (testfile-b4))
      (list x (getprop 'testfile-a4 'invoke #f) (getprop 'testfile-b4 'visit #f)))
    '((6 24) #t #f))
  (begin
    (with-output-to-file "testfile-a5.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a5) (export q) (import (rnrs) (only (scheme) putprop)) (define q 3) (putprop 'testfile-a5 'invoke #t))))
      'replace)
    (with-output-to-file "testfile-b5.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b5) (export x) (import (testfile-a5) (rnrs) (only (scheme) putprop))
             (define x (let-syntax ([p (lambda (x) (putprop 'testfile-b5 'visit #t) q)]) p)))))
      'replace)
    (for-each separate-compile '(a5 b5))
    #t)
  (equal?
    (let ()
      (import (testfile-b5))
      (list x (getprop 'testfile-a5 'invoke #f) (getprop 'testfile-b5 'visit #f)))
    '(3 #f #f))
  (begin
    (with-output-to-file "testfile-a6.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a6) (export q) (import (rnrs) (only (scheme) putprop)) (define q 3) (putprop 'testfile-a6 'invoke #t))))
      'replace)
    (with-output-to-file "testfile-b6.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b6) (export x) (import (testfile-a6) (rnrs) (only (scheme) putprop))
             (let-syntax ([p (lambda (x) (putprop 'testfile-b6 'visit #t) q)]) (define x p)))))
      'replace)
    (for-each separate-compile '(a6 b6))
    #t)
  (equal?
    (let ()
      (import (testfile-b6))
      (list x (getprop 'testfile-a6 'invoke #f) (getprop 'testfile-b6 'visit #f)))
    '(3 #f #f))

 ; test cyclic dependency check
 ; this mat and next four are connected
  (begin
    (with-output-to-file "testfile-a7.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a7) (export x) (import (rnrs) (testfile-b7)) (define x y))))
      'replace)
    (with-output-to-file "testfile-b7.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b7) (export y) (import (rnrs) (testfile-a7)) (define y x))))
      'replace)
    #t)
  (error? ; possible cyclic dependency
    (let () (import (testfile-a7) (testfile-b7)) (list x y)))
  (error? ; possible cyclic dependency
    (let () (import (testfile-b7) (testfile-a7)) (list x y)))
 ; make sure errors didn't leave libraries in a state where they can't be redefined
  (begin
    (with-output-to-file "testfile-a7.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a7) (export x) (import (rnrs) (testfile-b7)) (define x y))))
      'replace)
    (with-output-to-file "testfile-b7.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b7) (export y) (import (rnrs)) (define y 17))))
      'replace)
    #t)
  (equal?
    (let () (import (testfile-a7) (testfile-b7)) (list x y))
    '(17 17))

 ; import cycles
  (error? ; cyclic dependency on import
    (library ($l2-lib1) (export) (import ($l2-lib1))))
  (begin ; make sure we can redefine after cyclic import error
    (library ($l2-lib1) (export a) (import (rnrs)) (define a "a"))
    #t)
  (equal? (let () (import ($l2-lib1)) a) "a")

  (begin
    (delete-file "testfile-a8.so")
    (with-output-to-file "testfile-a8.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a8) (export a) (import (testfile-a8)))))
      'replace)
     #t)
  (error? ; cyclic dependency on import
    (import (testfile-a8)))
  (begin ; make sure we can redefine after cyclic import error
    (with-output-to-file "testfile-a8.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a8) (export cons) (import (rnrs)))))
      'replace)
    #t)
  (equal? (let () (import (testfile-a8)) cons) (let () (import (rnrs)) cons))

  (begin
    (delete-file "testfile.a9.so")
    (with-output-to-file "testfile-a9.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a9) (export a) (import (testfile-a9)))))
      'replace)
    #t)
  (error? ; cyclic dependency on import
    (compile-file "testfile-a9"))
  (begin ; make sure we can redefine after cyclic import error
    (with-output-to-file "testfile-a9.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a9) (export cons) (import (rnrs)))))
      'replace)
    (compile-file "testfile-a9")
    (load "testfile-a9.so")
    #t)
  (equal? (let () (import (testfile-a9)) cons) (let () (import (rnrs)) cons))

  (begin
    (delete-file "testfile-a10.so")
    (delete-file "testfile-b10.so")
    (with-output-to-file "testfile-a10.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a10) (export a) (import (testfile-b10)))))
      'replace)
    (with-output-to-file "testfile-b10.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b10) (export a) (import (testfile-a10)))))
      'replace)
    #t)
  (error? ; cyclic dependency on import (indirect)
    (import (testfile-a10)))
  (begin ; make sure we can redefine after cyclic import error
    (with-output-to-file "testfile-a10.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a10) (export a) (import (testfile-b10)))))
      'replace)
    (with-output-to-file "testfile-b10.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b10) (export a) (import (rnrs)) (define a "eh?"))))
      'replace)
    #t)
  (equal? (let () (import (testfile-a10)) a) "eh?")

 ; invoke cycles
  (begin
    (library ($l2-lib2) (export a)
      (import (rnrs) (rnrs eval))
      (define a (eval 'a (environment '($l2-lib2)))))
    #t)
  (error? ; cyclic dependency on invoke
    (let () (import ($l2-lib2)) a))

  (begin
    (delete-file "testfile-a11.so")
    (delete-file "testfile-b11.so")
    (with-output-to-file "testfile-a11.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a11) (export a) (import (testfile-b11)))))
      'replace)
    (with-output-to-file "testfile-b11.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-b11) (export a)
             (import (rnrs) (rnrs eval))
             (define a (eval 'a (environment '(testfile-a11)))))))
      'replace)
    #t)
  (error? ; cyclic dependency on invoke (indirect)
    (let () (import (testfile-a11)) a))

 ; visit cycles
  (begin
    (delete-file "testfile-a12.so")
    (remprop 'chewie 'ratface)
    (with-output-to-file "testfile-a12.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a12) (export a)
             (import (rnrs) (rnrs eval) (only (scheme) getprop))
             (define-syntax a
               (if (getprop 'chewie 'ratface #f)
                   (eval 'a (environment '(testfile-a12)))
                   (lambda (x) 3))))))
      'replace)
    (separate-compile 'a12)
    (putprop 'chewie 'ratface #t)
    #t)
  (error? ; cyclic dependency on visit
    (let () (import (testfile-a12)) a))
  (begin
    (with-output-to-file "testfile-a13.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a13) (export a)
             (import (rename (rnrs) (cons a))))))
      'replace)
    (separate-compile 'a13)
    #t)
  (equal? (let () (import (testfile-a13)) (a 3 4)) '(3 . 4))
  (error? (library (foo) (export a (rename b a)) (import (rnrs)) (define a 3) (define b 4)))
  (error? (library (foo) (export a (rename (b a))) (import (rnrs)) (define a 3) (define b 4)))
  (error? (library (foo) (exports a) (import (rnrs)) (define a 3)))
  (error? (library (foo) (export a) (imports (rnrs)) (define a 3)))

  (error? ; misplaced library form
    (let ()
      (library (foo)
        (export)
        (import (scheme))
        (library (bar) (export) (import)))))
  (error? ; misplaced library form
    (let () (library (foo) (export) (import))))
  (error? ; misplaced library form
    (+ (library (bar) (export) (import)) 3))

 ; make sure library is visited when needed
  (begin
    (with-output-to-file "testfile-f2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-f2) (export f2-x) (import (rnrs) (rnrs mutable-pairs))
             (define-syntax define-mutable
               (syntax-rules ()
                 [(_ x e)
                  (begin
                    (define t (list e))
                    (define-syntax x
                      (identifier-syntax
                        [_ (car t)]
                        [(set! _ new) (set-car! t new)])))]))
             (define-mutable f2-x 772))))
      'replace)
    (for-each separate-compile '(f2))
    #t)
  (begin
    (define (f2-x-whack! v)
      (import (testfile-f2))
      (set! f2-x v))
    (f2-x-whack! 29)
    #t)
  (eqv? (let () (import (testfile-f2)) f2-x) 29)
  (not (top-level-bound? 'f2-x))
 ; make sure #'x doesn't force library to be visited if x is an exported
 ; keyword or invoked if x is an exported variable
  (begin
    (with-output-to-file "testfile-g2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-g2) (export hit-a hit-x) (import (chezscheme))
             (define hit-a (make-parameter #f))
             (define hit-x (make-parameter #f)))))
      'replace)
    (with-output-to-file "testfile-h2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-h2) (export x a) (import (rnrs) (testfile-g2))
             (define-syntax a (begin (hit-a #t) (lambda (x) 73)))
             (define x (begin (hit-x #t) (list (hit-x) 97))))))
      'replace)
    (for-each separate-compile '(g2 h2))
    #t)
  (let () (import (testfile-g2)) (and (not (hit-a)) (not (hit-x))))
  (let () (import (testfile-g2) (testfile-h2)) (let ([q #'a]) (and (identifier? q) (not (hit-a)) (not (hit-x)))))
  (let () (import (testfile-g2) (testfile-h2)) (let ([q #'x]) (and (identifier? q) (not (hit-a)) (not (hit-x)))))
  (let () (import (testfile-g2) (testfile-h2)) (and (eqv? a 73) (hit-a) (not (hit-x))))
  (let () (import (testfile-g2) (testfile-h2)) (and (equal? x '(#t 97)) (hit-a) (hit-x)))
)

(mat library3
 ; test several-deep invoke-dependency chain
  (begin
    (with-output-to-file "testfile-a3-0.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a3-0)
             (export x0)
             (import (rnrs))
             (define x0 7))))
      'replace)
    (with-output-to-file "testfile-a3-1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a3-1)
             (export x1)
             (import (rnrs) (testfile-a3-0))
             (define x1 (+ x0 1)))))
      'replace)
    (with-output-to-file "testfile-a3-2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a3-2)
             (export x2)
             (import (rnrs) (testfile-a3-1))
             (define x2 (+ x1 2)))))
      'replace)
    (with-output-to-file "testfile-a3-3.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a3-3)
             (export x3)
             (import (rnrs) (testfile-a3-2))
             (define x3 (+ x2 3)))))
      'replace)
    (with-output-to-file "testfile-a3-4.ss"
      (lambda ()
        (pretty-print '(import (rnrs) (testfile-a3-3)))
        (pretty-print '(write (+ x3 4))))
      'replace)
    (separate-compile 'compile-library 'a3-0)
    (separate-compile 'compile-library 'a3-1)
    (separate-compile 'compile-library 'a3-2)
    (separate-compile 'compile-library 'a3-3)
    (separate-compile 'compile-program 'a3-4)
    #t)
  (equal?
    (with-output-to-string
      (lambda () (load-program "testfile-a3-4.so")))
    "17")
  (eqv? (let () (import (testfile-a3-3)) x3) 13)
 ; try begin containing library and top-level program
  (begin
    (with-output-to-file "testfile-a3-5.ss"
      (lambda ()
        (pretty-print
          '(begin
             (library (a3-5 foo)
               (export x)
               (import (rnrs))
               (define x "hello"))
             (top-level-program
               (import (rnrs) (a3-5 foo))
               (display x)))))
      'replace)
    (separate-compile 'a3-5)
    #t)
  (equal?
    (with-output-to-string
      (lambda () (load "testfile-a3-5.so")))
    "hello")
  (equal?
    (with-output-to-string
      (lambda () (load "testfile-a3-5.ss")))
    "hello")
 ; try begin containing two libraries
  (begin
    (with-output-to-file "testfile-a3-6.ss"
      (lambda ()
        (pretty-print
          '(begin
             (library (a3-6 foo)
               (export a x)
               (import (rnrs))
               (define-syntax a (identifier-syntax "boo"))
               (define x "hello"))
             (library (a3-6 bar)
               (export y)
               (import (rnrs) (a3-6 foo))
               (define y (cons a x)))
             (let () (import (a3-6 bar)) (write y)))))
      'replace)
    (separate-compile 'a3-6)
    #t)
  (equal?
    (with-output-to-string
      (lambda () (load "testfile-a3-6.so")))
    "(\"boo\" . \"hello\")")
  (equal?
    (let ()
      (import (a3-6 bar))
      y)
    '("boo" . "hello"))
  (equal?
    (let ()
      (import (a3-6 foo))
      (cons x a))
    '("hello" . "boo"))
 ; import a library in subset-mode system, then outside of subset-mode system
  (begin
    (with-output-to-file "testfile-a3-7.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a3-7)
             (export x)
             (import (rnrs))
             (define x "hello"))))
      'replace)
    #t)
  (equal?
    (parameterize ([subset-mode 'system]) (eval '(let () (import (testfile-a3-7)) x)))
    "hello")
  (equal?
    (let () (import (testfile-a3-7)) x)
    "hello")

  (begin
    (with-output-to-file "testfile-a3-8.ss"
      (lambda ()
        (pretty-print '(printf "outside (testfile-a3-8)\n"))
        (pretty-print
          '(library (testfile-a3-8)
             (export a3-8-x)
             (import (rnrs))
             (define a3-8-x 5)
             (error #f "library should not be invoked"))))
      'replace)
    (with-output-to-file "testfile-a3-9.ss"
      (lambda ()
        (pretty-print 
          '(let ()
             (import (scheme) (testfile-a3-8))
             (printf "inside testfile-a3-9\n"))))
      'replace)
    (with-output-to-file "testfile-a3-10.ss"
      (lambda ()
        (pretty-print '(import (scheme) (testfile-a3-8)))
        (pretty-print '(printf "inside testfile-a3-10\n")))
      'replace)
    (separate-compile 'a3-8)
    (separate-compile 'a3-9)
    (separate-compile 'a3-10)
    #t)
  (equal?
    (with-output-to-string (lambda () (load "testfile-a3-9.so")))
    "inside testfile-a3-9\n")
  (equal?
    (with-output-to-string (lambda () (load "testfile-a3-10.so")))
    "inside testfile-a3-10\n")
)

(mat library4
  ; test reloading of libraries if dependencies have changed
  ; when compile-imported-libraries is true.
  ; first test with compile-imported-libraries true:
  (begin
    (define ($reset-l4-1)
      (for-each delete-file '("testfile-l4-a1.so" "testfile-l4-b1.so" "testfile-l4-c1.so"))
      (with-output-to-file "testfile-l4-a1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-a1) (export x) (import (chezscheme) (testfile-l4-b1) (testfile-l4-c1))
               (include "testfile-l4-d1.ss")
               (define a 'a-object)
               (define x (list a b c d)))))
        'replace)
      (with-output-to-file "testfile-l4-b1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-b1) (export b) (import (chezscheme))
               (define b (list 'b-object)))))
        'replace)
      (with-output-to-file "testfile-l4-c1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-c1) (export c) (import (chezscheme))
               (define-syntax c (lambda (x) #''c-object)))))
        'replace)
      (with-output-to-file "testfile-l4-d1.ss"
        (lambda ()
          (pretty-print
            '(define-syntax d (lambda (x) #''d-object))))
        'replace)
      (with-output-to-file "testfile-l4-p1.ss"
        (lambda ()
          (pretty-print
            '(import (testfile-l4-a1) (chezscheme)))
          (pretty-print
            '(pretty-print x)))
        'replace)
      (let ([s (separate-eval
                 '(compile-imported-libraries #t)
                 '(compile-file-message #f)
                 '(load-program "testfile-l4-p1.ss"))])
        (unless (equal? s "(a-object (b-object) c-object d-object)\n")
          (errorf #f "unexpected separate-eval return value ~s" s)))
      ; ensure different file times for followup updates
      (sleep (make-time 'time-duration 0 (if (embedded?) 3 1)))
      #t)
    #t)
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-a1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-a1) (export x) (import (chezscheme) (testfile-l4-b1) (testfile-l4-c1))
               (include "testfile-l4-d1.ss")
               (define a 'newa-object)
               (define x (list a b c d)))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #t)
        '(compile-file-message #f)
        '(load-program "testfile-l4-p1.ss")))
    "(newa-object (b-object) c-object d-object)\n")
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-b1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-b1) (export b) (import (chezscheme))
               (define b (list 'newb-object)))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #t)
        '(compile-file-message #f)
        '(load-program "testfile-l4-p1.ss")))
    "(a-object (newb-object) c-object d-object)\n")
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-c1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-c1) (export c) (import (chezscheme))
               (define-syntax c (lambda (x) #''newc-object)))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #t)
        '(compile-file-message #f)
        '(load-program "testfile-l4-p1.ss")))
    "(a-object (b-object) newc-object d-object)\n")
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-d1.ss"
        (lambda ()
          (pretty-print
            '(define-syntax d (lambda (x) #''newd-object))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #t)
        '(compile-file-message #f)
        '(load-program "testfile-l4-p1.ss")))
    "(a-object (b-object) c-object newd-object)\n")
  ; now with compile-imported-libraries false
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-a1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-a1) (export x) (import (chezscheme) (testfile-l4-b1) (testfile-l4-c1))
               (include "testfile-l4-d1.ss")
               (define a 'newera-object)
               (define x (list a b c d)))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #f)
        '(compile-file-message #t)
        '(load-program "testfile-l4-p1.ss")))
    "(newera-object (b-object) c-object d-object)\n")
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-b1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-b1) (export b) (import (chezscheme))
               (define b (list 'newerb-object)))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #f)
        '(compile-file-message #t)
        '(load-program "testfile-l4-p1.ss")))
    "(a-object (newerb-object) c-object d-object)\n")
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-c1.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-l4-c1) (export c) (import (chezscheme))
               (define-syntax c (lambda (x) #''newerc-object)))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #f)
        '(compile-file-message #t)
        '(load-program "testfile-l4-p1.ss")))
    "(a-object (b-object) newerc-object d-object)\n")
  ($reset-l4-1)
  (equal?
    (begin
      (with-output-to-file "testfile-l4-d1.ss"
        (lambda ()
          (pretty-print
            '(define-syntax d (lambda (x) #''newerd-object))))
        'replace)
      (separate-eval
        '(compile-imported-libraries #f)
        '(compile-file-message #t)
        '(load-program "testfile-l4-p1.ss")))
    "(a-object (b-object) c-object newerd-object)\n")
)

(mat library5
  ; test for proper runtime library dependencies
  (begin
    (with-output-to-file "testfile-l5-a1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-l5-a1) (export a) (import (chezscheme))
             (define a (cons 3 4)))))
      'replace)
    (with-output-to-file "testfile-l5-b1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-l5-b1) (export a b c) (import (chezscheme) (testfile-l5-a1))
             (define-syntax b (identifier-syntax (vector a)))
             (define c (cons 5 6)))))
      'replace)
    (with-output-to-file "testfile-l5-c1.ss"
      (lambda ()
        (for-each pretty-print
          `((import (chezscheme) (testfile-l5-b1))
            (set-car! a 55)
            (pretty-print (list a b)))))
      'replace)
    (equal?
      (parameterize ([compile-imported-libraries #t])
        (compile-program "testfile-l5-c1"))
      '((testfile-l5-a1))))
  ; delete testfile-l5-b1.{ss,so} to make sure they aren't surreptitiously loaded
  (begin
    (delete-file "testfile-l5-b1.ss")
    (delete-file "testfile-l5-b1.so")
    (and (not (file-exists? "testfile-l5-b1.ss"))
         (not (file-exists? "testfile-l5-b1.so"))))
  (equal?
    (separate-eval '(load-program "testfile-l5-c1.so"))
    "((55 . 4) #((55 . 4)))\n")
)

(mat library6
  ; test for proper handling of visit library dependencies
  (begin
    (with-output-to-file "testfile-l6-a1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-l6-a1) (export a) (import (chezscheme))
             (define a (cons 3 4)))))
      'replace)
    (with-output-to-file "testfile-l6-b1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-l6-b1) (export b-x b-y) (import (chezscheme) (testfile-l6-a1))
             (define-syntax b-x (lambda (x) (car a)))
             (define b-y (cons 5 6)))))
      'replace)
    (with-output-to-file "testfile-l6-c1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-l6-c1) (export c) (import (chezscheme) (testfile-l6-b1))
             (meta define c
               (lambda (x)
                 #`(cons (* #,x #,(car b-y)) (* #,x #,(cdr b-y))))))))
      'replace)
    (with-output-to-file "testfile-l6-prog1.ss"
      (lambda ()
        (pretty-print '(eval-when (visit) (printf "visiting testfile-l6-prog1\n")))
        (pretty-print '(define-syntax M
                         (lambda (x)
                           (import (testfile-l6-c1))
                           (syntax-case x ()
                             [(_ f d) #`(f #,(c (datum d)))]))))
        (pretty-print '(eval-when (revisit) (printf "revisiting testfile-l6-prog1\n")))
        (pretty-print '(pretty-print (M vector 2))))
      'replace)
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #t])
           (compile-file x)))
      "testfile-l6-prog1")
    #t)

  (begin
    (delete-file "testfile-l6-a1.so")
    (delete-file "testfile-l6-a1.ss")
    (and (not (file-exists? "testfile-l6-a1.so"))
         (not (file-exists? "testfile-l6-a1.ss"))))

  (equal?
    (separate-eval '(revisit "testfile-l6-prog1.so"))
    "revisiting testfile-l6-prog1\n#((10 . 12))\n")
)

(mat library7
  (begin
    (mkfile "testfile-l7-a1.ss"
      '(library (testfile-l7-a1) (export a-macro a) (import (chezscheme)) (define-syntax a-macro (identifier-syntax 'aaa)) (define (a x) (+ x (* x x)))))
    (mkfile "testfile-l7-b1.ss"
      '(library (testfile-l7-b1) (export b) (import (chezscheme) (testfile-l7-a1)) (define (b x) (cons 'b a-macro))))
    (mkfile "testfile-l7-c1.ss"
      '(library (testfile-l7-c1) (export c) (import (chezscheme) (testfile-l7-a1)) (define (c x) (cons 'c (a x)))))
    (mkfile "testfile-l7-d1.ss"
      '(library (testfile-l7-d1) (export d) (import (chezscheme) (testfile-l7-a1)) (define (d x) (list 'd a-macro (a x)))))
    (separate-compile
      '(lambda (x) (for-each compile-library x))
      '(list "testfile-l7-a1" "testfile-l7-b1" "testfile-l7-c1" "testfile-l7-d1"))
    #t)
  (equal?
    (separate-eval
      '(let () (import (testfile-l7-b1)) (b 7))
      '(let () (import (testfile-l7-c1)) (c 7))
      '(let () (import (testfile-l7-d1)) (d 7)))
    "(b . aaa)\n(c . 56)\n(d aaa 56)\n")
  (begin
    (separate-compile
      '(lambda (x) (for-each compile-library x))
      '(list "testfile-l7-a1" "testfile-l7-b1" "testfile-l7-c1"))
    #t)
  (equal?
    (separate-eval
      '(let () (import (testfile-l7-b1)) (b 7))
      '(let () (import (testfile-l7-c1)) (c 7))
      ; this should reload from source, since dependency is out-of-date
      '(let () (import (testfile-l7-d1)) (d 7)))
    "(b . aaa)\n(c . 56)\n(d aaa 56)\n")
  (equal?
    (separate-eval
      ; this should reload from source, since dependency is out-of-date
      '(let () (import (testfile-l7-d1)) (d 7))
      '(let () (import (testfile-l7-c1)) (c 7))
      '(let () (import (testfile-l7-b1)) (b 7)))
    "(d aaa 56)\n(c . 56)\n(b . aaa)\n")
  (error? ; expected different compilation instance
    (separate-eval
      '(let () (import (testfile-l7-b1)) (b 7))
      '(let () (import (testfile-l7-c1)) (c 7))
      '(load-library "testfile-l7-d1.so")
      '(let () (import (testfile-l7-d1)) (d 7))))
  (error? ; expected different compilation instance
    (separate-eval
      '(load-library "testfile-l7-d1.so")
      '(let () (import (testfile-l7-d1)) (d 7))))
  (equal?
    (separate-eval
      '(load-library "testfile-l7-b1.ss")
      '(let () (import (testfile-l7-b1)) (b 7))
      ; this should reload from source, since dependency is out-of-date
      '(let () (import (testfile-l7-c1)) (c 7))
      ; this should reload from source, since dependency is out-of-date
      '(let () (import (testfile-l7-d1)) (d 7)))
    "(b . aaa)\n(c . 56)\n(d aaa 56)\n")
  (error? ; expected different compilation instance
    (separate-eval
      '(load-library "testfile-l7-b1.ss")
      '(load-library "testfile-l7-c1.ss")
      '(load-library "testfile-l7-d1.so")
      '(let () (import (testfile-l7-d1)) (d 7))))
  (begin
    (delete-file "testfile-l7-a1.so")
    #t)
  (equal?
    (separate-eval
      '(parameterize ([compile-imported-libraries #t]) (compile-library "testfile-l7-b1.ss"))
      '(let () (import (testfile-l7-b1)) (b 7))
      ; this should reload from source, since dependency is out-of-date
      '(let () (import (testfile-l7-c1)) (c 7))
      '(let () (import (testfile-l7-d1)) (d 7)))
    "compiling testfile-l7-b1.ss with output to testfile-l7-b1.so\ncompiling testfile-l7-a1.ss with output to testfile-l7-a1.so\n(b . aaa)\n(c . 56)\n(d aaa 56)\n")
  (begin
    (delete-file "testfile-l7-a1.so")
    #t)
  (error? ; expected different compilation instance
    (separate-eval
      '(parameterize ([compile-imported-libraries #t]) (compile-library "testfile-l7-b1.ss"))
      '(load-library "testfile-l7-c1.so")
      '(let () (import (testfile-l7-c1)) (c 7))))
  (equal?
    (separate-eval
      '(library (testfile-l7-a1) (export a-macro a) (import (chezscheme)) (define-syntax a-macro (identifier-syntax 'aaa2)) (define (a x) (* x 11)))
      '(let () (import (testfile-l7-b1)) (b 7))
      '(let () (import (testfile-l7-c1)) (c 7))
      '(let () (import (testfile-l7-d1)) (d 7)))
    "(b . aaa2)\n(c . 77)\n(d aaa2 77)\n")
  (error? ; expected different compilation instance
    (separate-eval
      '(library (testfile-l7-a1) (export a-macro a) (import (chezscheme)) (define-syntax a-macro (identifier-syntax 'aaa2)) (define (a x) (* x 11)))
      '(let () (import (testfile-l7-b1)) (b 7))
      '(let () (import (testfile-l7-c1)) (c 7))
      '(load-library "testfile-l7-d1.so")
      '(let () (import (testfile-l7-d1)) (d 7))))
)

(mat library-regression
  ; test that failing invoke code does not result in cyclic dependency problem on re-run
  (equal?
    (separate-eval
      '(begin
         (library (invoke-fail)
           (export x)
           (import (chezscheme))
           (define x #f)
           (error #f "failed to load library (invoke-fail)"))
         (guard (e [else
                     (guard (e2 [else 
                                  (display-condition e) (newline)
                                  (display-condition e2) (newline)])
                       (eval 'x (environment '(chezscheme) '(invoke-fail))))])
           (eval 'x (environment '(chezscheme) '(invoke-fail))))))
    "Exception: failed to load library (invoke-fail)\nException: failed to load library (invoke-fail)\n")

  ; test that true cyclic dependency will always report the same thing
  (equal?
    (separate-eval
      '(begin
         (library (invoke-cyclic)
           (export x y)
           (import (chezscheme))
           (define x #f)
           (define y (eval '(if x 5 10) (environment '(chezscheme) '(invoke-cyclic)))))
         (guard (e [else
                     (guard (e2 [else 
                                  (display-condition e) (newline)
                                  (display-condition e2) (newline)])
                       (eval 'x (environment '(chezscheme) '(invoke-cyclic))))])
           (eval 'x  (environment '(chezscheme) '(invoke-cyclic))))))
    "Exception: cyclic dependency involving invocation of library (invoke-cyclic)\nException: cyclic dependency involving invocation of library (invoke-cyclic)\n")

  (begin
    ; library to help make it easier to cause a failure in the visit-code that
    ; does not lead to failure during compilation of the file.
    (with-output-to-file "testfile-lr-l1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-lr-l1)
             (export make-it-fail)
             (import (chezscheme))
             (define make-it-fail (make-parameter #f (lambda (x) (and x #t)))))))
      'replace)
    ; simple test to define one macro and potentially to raise an error when
    ; defining the second one.
    (with-output-to-file "testfile-lr-l2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-lr-l2)
             (export M1 M2)
             (import (chezscheme) (testfile-lr-l1))
             (define-syntax M1
               (identifier-syntax #f))

             (define-syntax M2
               (if (make-it-fail)
                   (error 'M2 "user requested failure with (make-it-fail) parameter")
                   (lambda (x)
                     (syntax-case x ()
                       [(_ expr) #'expr])))))))
      'replace)
    ; more complete test that attempts to create the various types of things
    ; that can be defined in visit code so that we can verify things are being
    ; properly reset.
    (with-output-to-file "testfile-lr-l3.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-lr-l3)
             (export a b c d e f g h)
             (import (chezscheme) (testfile-lr-l1))

             (module a (x) (define x 5))
             (alias b cons)
             (define-syntax c (make-compile-time-value 5))
             (define d 5)
             (meta define e 5)
             (define-syntax f (identifier-syntax #f))
             (define $g (make-parameter #f))
             (define-syntax g
               (make-variable-transformer
                 (lambda (x)
                   (syntax-case x ()
                     [(set! _ v) #'($g v)]
                     [_ #'($g)]
                     [(_ e* ...) #'(($g) e* ...)]))))
             (define-property f g 10)
             (define-syntax h
               (if (make-it-fail)
                   (error 'h "user requested failure with (make-it-fail) parameter")
                   (lambda (x)
                     (syntax-case x ()
                       [(_ expr) #'expr])))))))
      'replace)
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #t])
           (for-each compile-library x)))
      '(list "testfile-lr-l1" "testfile-lr-l2" "testfile-lr-l3"))
    #t)

  (equal?
    (separate-eval
      '(begin
         (import (testfile-lr-l2) (testfile-lr-l1))
         (make-it-fail #t)
         (guard (e [else
                     (guard (e2
                              [else
                                (display-condition e) (newline)
                                (display-condition e2) (newline)])
                       (eval 'M1 (environment '(testfile-lr-l2))))])
           (eval 'M1 (environment '(testfile-lr-l2))))))
    "Exception in M2: user requested failure with (make-it-fail) parameter\nException in M2: user requested failure with (make-it-fail) parameter\n")

  ; module is defined as part of import code, run time bindings are setup as part of invoke code
  (equal?
    (separate-eval
      '(begin
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         (import a)
         x))
    "5\n")

  ; alias is part of module binding ribcage, set up by import code
  (equal?
    (separate-eval
      '(begin
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         (b 'a 'b)))
    "(a . b)\n")

  ; compile-time-value is set in visit code, should show same error each time it is referenced
  (equal?
    (separate-eval
      '(begin
         (library (lookup)
           (export lookup)
           (import (chezscheme))
           (define-syntax lookup
             (lambda (x)
               (syntax-case x ()
                 [(_ id) (lambda (rho) #`'#,(rho #'id))]
                 [(_ id key) (lambda (rho) #`'#,(rho #'id #'key))]))))
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         (guard (e [else
                     (guard (e2
                              [else
                                (display-condition e) (newline)
                                (display-condition e2) (newline)])
                       (eval '(lookup c) (environment '(testfile-lr-l3) '(lookup))))])
           (eval '(lookup c) (environment '(testfile-lr-l3) '(lookup))))))
    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")

  ; defines are set up as part of invoke code
  (equal?
    (separate-eval
      '(begin
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         d))
    "5\n")

  ; meta defines are set up as part of visit code
  (equal?
    (separate-eval
      '(begin
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         (guard (e [else
                     (guard (e2
                              [else
                                (display-condition e) (newline)
                                (display-condition e2) (newline)])
                       (eval '(let ()
                                (define-syntax get-e
                                  (lambda (x)
                                    (syntax-case x ()
                                      [(_) #`'#,e])))
                                (get-e))
                         (environment '(chezscheme) '(testfile-lr-l3))))])
           (eval '(let ()
                    (define-syntax get-e
                      (lambda (x)
                        (syntax-case x ()
                          [(_) #`'#,e])))
                    (get-e))
             (environment '(chezscheme) '(testfile-lr-l3))))))
    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")

  ; macros are set up as part of visit code
  (equal?
    (separate-eval
      '(begin
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         (guard (e [else
                     (guard (e2
                              [else
                                (display-condition e) (newline)
                                (display-condition e2) (newline)])
                       (eval 'f (environment '(testfile-lr-l3))))])
           (eval 'f (environment '(testfile-lr-l3))))))
    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")

  ; variable transformer macros are set up as part of visit code
  (equal?
    (separate-eval
      '(begin
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         (guard (e [else
                     (guard (e2
                              [else
                                (display-condition e) (newline)
                                (display-condition e2) (newline)])
                       (eval 'g (environment '(testfile-lr-l3))))])
           (eval 'g (environment '(testfile-lr-l3))))))
    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")

  ; properties are setup as part of visit code.
  (equal?
    (separate-eval
      '(begin
         (library (lookup)
           (export lookup)
           (import (chezscheme))
           (define-syntax lookup
             (lambda (x)
               (syntax-case x ()
                 [(_ id) (lambda (rho) #`'#,(rho #'id))]
                 [(_ id key) (lambda (rho) #`'#,(rho #'id #'key))]))))
         (import (testfile-lr-l3) (testfile-lr-l1))
         (make-it-fail #t)
         (guard (e [else
                     (guard (e2
                              [else
                                (display-condition e) (newline)
                                (display-condition e2) (newline)])
                       (eval '(lookup f g) (environment '(testfile-lr-l3) '(lookup))))])
           (eval '(lookup f g) (environment '(testfile-lr-l3) '(lookup))))))
    "Exception in h: user requested failure with (make-it-fail) parameter\nException in h: user requested failure with (make-it-fail) parameter\n")

  ;; re-arm import code if it complains about a library that is not visible
  (begin
    (with-output-to-file "testfile-lr-l4.ss"
      (lambda ()
        (pretty-print
         '(library (testfile-lr-l4)
            (export x)
            (import (chezscheme))
            (define x 123))))
      'replace)
    (with-output-to-file "testfile-lr-p4.ss"
      (lambda ()
        (for-each pretty-print
         '((import (testfile-lr-l4) (scheme))
           (define (run args)
             (guard (c [#t (display-condition c) (newline)])
               (pretty-print (top-level-value (car args) (environment (cdr args))))))
           (when (> x 0) ;; reference export
             (let ([args (map string->symbol (command-line-arguments))])
               (if (= (length args) 2)
                   (begin
                     (run args)
                     (run args))
                   (error #f "expected 2 args")))))))
      'replace)
    (separate-eval
     '(parameterize ([compile-imported-libraries #t] [generate-wpo-files #t])
        (compile-program "testfile-lr-p4.ss")
        (compile-whole-program "testfile-lr-p4.wpo" "testfile-lr-p4-visible" #t)
        (compile-whole-program "testfile-lr-p4.wpo" "testfile-lr-p4-not-visible" #f)))
    (equal?
     (separate-eval
      '(parameterize ([command-line-arguments '("x" "testfile-lr-l4")])
         (load-program "testfile-lr-p4-visible")
         (load-program "testfile-lr-p4-not-visible")))
     (string-append
      "123\n"
      "123\n"
      "Exception in environment: attempt to import invisible library (testfile-lr-l4)\n"
      "Exception in environment: attempt to import invisible library (testfile-lr-l4)\n"))))

(mat invoke-library
  (error? ; invalid library reference
     (invoke-library '(testfile-il1 (<= 3))))
  (error? ; invalid library reference
     (invoke-library '(testfile-il1 (what?))))
  (error? ; invalid library reference
     (invoke-library '()))
  (error? ; invalid library reference
     (invoke-library 'hello))
  (error? ; invalid library reference
     (invoke-library '(3 2 1)))
  (begin
    (mkfile "testfile-il1.ss"
      '(library (testfile-il1 (2)) (export a) (import (chezscheme)) (define a 3) (printf "invoked (testfile-il1)\n")))
    #t)
  (equal?
    (separate-eval
      '(let () (import (testfile-il1)) a))
    "invoked (testfile-il1)\n3\n")
  (equal?
    (separate-eval
      '(invoke-library '(testfile-il1)))
    "invoked (testfile-il1)\n")
  (equal?
    (separate-eval
      '(invoke-library '(testfile-il1))
      '(printf "hello\n")
      '(let () (import (testfile-il1)) a))
    "invoked (testfile-il1)\nhello\n3\n")
  (equal?
    (separate-eval
      '(let () (import (testfile-il1)) a)
      '(printf "hello\n")
      '(invoke-library '(testfile-il1)))
    "invoked (testfile-il1)\n3\nhello\n")
  (begin
    (separate-eval '(compile-library "testfile-il1"))
    #t)
  (delete-file "testfile-il1.ss")
  (equal?
    (separate-eval
      '(let () (import (testfile-il1)) a))
    "invoked (testfile-il1)\n3\n")
  (equal?
    (separate-eval
      '(invoke-library '(testfile-il1)))
    "invoked (testfile-il1)\n")
  (equal?
    (separate-eval
      '(invoke-library '(testfile-il1))
      '(printf "hello\n")
      '(let () (import (testfile-il1)) a))
    "invoked (testfile-il1)\nhello\n3\n")
  (equal?
    (separate-eval
      '(let () (import (testfile-il1)) a)
      '(printf "hello\n")
      '(invoke-library '(testfile-il1)))
    "invoked (testfile-il1)\n3\nhello\n")
  (error? ; version mismatch
    (separate-eval '(invoke-library '(testfile-il1 (3)))))
  (error? ; version mismatch
    (separate-eval
      '(invoke-library '(testfile-il1 ((>= 3))))))
  (equal?
    (separate-eval
      '(invoke-library '(testfile-il1 ((>= 2)))))
    "invoked (testfile-il1)\n")
  (equal?
    (separate-eval
      '(invoke-library '(testfile-il1 (2))))
    "invoked (testfile-il1)\n")
)

(mat cross-library-optimization
  (begin
    (with-output-to-file "testfile-clo-1a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-clo-1a)
             (export f)
             (import (chezscheme))
             (define f (lambda (s) (format "~s!\n" s))))))
      'replace)
    (with-output-to-file "testfile-clo-1b.ss"
      (lambda ()
        (pretty-print
          '(import (chezscheme) (testfile-clo-1a)))
        (pretty-print
          '(display-string (f 'hello))))
      'replace)
    #t)
  (eqv? (compile-library "testfile-clo-1a") (void))
  ; in this case, can't propage f because of the embedded string constant,
  ; so program depends on library at run time
  (equal? (compile-program "testfile-clo-1b") '((testfile-clo-1a)))
  (equal?
    (with-output-to-string
      (lambda () (load-program "testfile-clo-1b.so")))
    "hello!\n")
  (begin
    (with-output-to-file "testfile-clo-2a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-clo-2a)
             (export f)
             (import (chezscheme))
             (define f (lambda (s) (symbol->string s))))))
      'replace)
    (with-output-to-file "testfile-clo-2b.ss"
      (lambda ()
        (pretty-print
          '(import (chezscheme) (testfile-clo-2a)))
        (pretty-print
          '(display-string (f 'hello))))
      'replace)
    #t)
  (eqv? (compile-library "testfile-clo-2a") (void))
  ; in this case, nothing stopping propagation of f,
  ; so program doesn't necessarily depend on library at run time
  (and (member
         (compile-program "testfile-clo-2b")
         '(() ((testfile-clo-2a))))
       #t)
  (equal?
    (with-output-to-string
      (lambda () (load-program "testfile-clo-2b.so")))
    "hello")
  ; testing internal consistency for library w/externally visible side effect, which we don't guarantee
  ; will happen if all runtime references are optimized away
  (begin
    (with-output-to-file "testfile-clo-3a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-clo-3a)
             (export g h)
             (import (chezscheme))
             (define (f) (putprop 'spam 'canned #t))
             (define (g) (getprop 'spam 'canned #f))
             (define (h) (remprop 'spam 'canned))
             (f))))
      'replace)
    (with-output-to-file "testfile-clo-3b.ss"
      (lambda ()
        (pretty-print
          '(import (chezscheme) (testfile-clo-3a)))
        (pretty-print
          '(write (g))))
      'replace)
    #t)
  (equal?
    (let ([libs (parameterize ([compile-imported-libraries #t]) (compile-program "testfile-clo-3b"))])
      (cond
        ; if compiled program depends on the library, the externally visible side effect (putprop) will be done
        [(equal? libs '((testfile-clo-3a)))
         (cons
           (equal? (with-output-to-string (lambda () (load-program "testfile-clo-3b.so"))) "#t")
           (let () (import (testfile-clo-3a)) (g)))]
        ; otherwise not
        [(equal? libs '())
         (cons
           (equal? (with-output-to-string (lambda () (load-program "testfile-clo-3b.so"))) "#f")
           (not (let () (import (testfile-clo-3a)) (g))))]
        [else 'oops]))
    '(#t . #t))
  (equal? (let () (import (testfile-clo-3a)) (h)) (void))
  (not (let () (import (testfile-clo-3a)) (g)))
)

(mat lots-of-libraries
  (begin
    (define (lol-mklibname n) (string->symbol (format "testfile-lol-~d" n)))
    (define (lol-mkvarname n) (string->symbol (format "n~d" n)))
    (define lol-fiblib
      (lambda (n)
        (let fiblib ([n n])
          (if (fx= n 1)
              `((library (testfile-lol-1) (export n1) (import (chezscheme)) (define n1 1))
                (library (testfile-lol-0) (export n0) (import (chezscheme)) (define n0 0)))
              (cons
                `(library (,(lol-mklibname n))
                   (export ,(lol-mkvarname n))
                   (import (chezscheme) (,(lol-mklibname (fx- n 1))) (,(lol-mklibname (fx- n 2))))
                   (define ,(lol-mkvarname n) (+ ,(lol-mkvarname (fx- n 1)) ,(lol-mkvarname (fx- n 2)))))
                (fiblib (fx- n 1)))))))
    #t)
  (eqv?
    (let ([n 10])
      (eval `(begin ,@(reverse (lol-fiblib n)) (let () (import (,(lol-mklibname n))) ,(lol-mkvarname n)))))
    55)
  (begin
    (define lol-n 100)
    (do ([lib* (lol-fiblib lol-n) (cdr lib*)] [n lol-n (fx- n 1)])
        ((null? lib*))
      (with-output-to-file (format "~s.ss" (lol-mklibname n))
        (lambda () (pretty-print (car lib*)))
        'replace))
    (with-output-to-file "testfile-lol-prog.ss"
      (lambda ()
        (for-each pretty-print
          `((import (chezscheme) (,(lol-mklibname lol-n)))
            (pretty-print ,(lol-mkvarname lol-n)))))
      'replace)
    (define $lol-watchdog
      (let ([t (current-time 'time-utc)])
        (let ([time-n 3])
          (separate-eval
            `(parameterize ([compile-imported-libraries #t])
               (compile-library ,(format "~a.ss" (lol-mklibname time-n)))))
          (do ([n 0 (+ n 1)]) ((> n time-n)) (delete-file (format "~a.so" (lol-mklibname n)))))
        (let ([t (time-difference (current-time 'time-utc) t)])
          (let ([t-reasonable
                  (let ([ns (* (+ (* (time-second t) (expt 10 9)) (time-nanosecond t)) lol-n)])
                    (make-time 'time-duration (remainder ns (expt 10 9)) (quotient ns (expt 10 9))))])
            `(let ([t (current-time 'time-utc)])
               (timer-interrupt-handler
                 (let ([t-reasonable (make-time 'time-duration ,(time-nanosecond t-reasonable) ,(time-second t-reasonable))])
                   (lambda ()
                     (unless (time<=? (time-difference (current-time 'time-utc) t) t-reasonable)
                       (errorf #f "unreasonable time elapsed"))
                     (set-timer 10000))))
               ((timer-interrupt-handler)))))))
    #t)
  (string?
    (separate-compile
      `(lambda (x)
         ,$lol-watchdog
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      'lol-prog))
  (equal?
    (separate-eval `(begin ,$lol-watchdog (load-program "testfile-lol-prog.so")))
    (format "~d\n"
      (let fib ([i 1] [n1 1] [n0 0])
        (if (fx= i lol-n)
            n1
            (fib (+ i 1) (+ n1 n0) n1)))))
  ; test rebuild
  (string?
    (separate-compile
      `(lambda (x)
         ,$lol-watchdog
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      'lol-prog))
  ; test maybe rebuild
  (string?
    (separate-compile
      `(lambda (x)
         ,$lol-watchdog
         (parameterize ([compile-imported-libraries #t])
           (maybe-compile-program x)))
      'lol-prog))
)

(mat import-dependencies
  (begin
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 3)))
             (define x (begin (printf "rt\n") 4)))))
      'replace)
    (separate-compile 'compile-library 'a)
    #t)
  (begin
    (with-output-to-file "testfile-m1.ss"
      (lambda ()
        (pretty-print
          '(module (q1)
             (import (testfile-a))
             (define-syntax q1 (identifier-syntax a)))))
      'replace)
    (separate-compile 'compile-file 'm1)
    #t)
  (equal?
    (separate-eval '(load "testfile-m1.so") 'q1)
    "ct\n3\n")
  (begin
    (with-output-to-file "testfile-m2.ss"
      (lambda ()
        (pretty-print
          '(module (q2)
             (import (testfile-a))
             (define-syntax q2 (identifier-syntax x)))))
      'replace)
    (separate-compile 'compile-file 'm2)
    #t)
  (equal?
    (separate-eval '(load "testfile-m2.so") 'q2)
    "rt\n4\n")
  (begin
    (sleep (make-time 'time-duration 1000000 1))
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 33)))
             (define x (begin (printf "rt\n") 44)))))
      'replace)
    (separate-compile 'compile-library 'a)
    (separate-compile 'maybe-compile-file 'm1)
    (separate-compile 'maybe-compile-file 'm2)
    #t)
  (equal?
    (separate-eval '(load "testfile-m1.so") 'q1)
    "ct\n33\n")
  (equal?
    (separate-eval '(load "testfile-m2.so") 'q2)
    "rt\n44\n")
  ; --------
  (begin
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 3)))
             (define x (begin (printf "rt\n") 4)))))
      'replace)
    (separate-compile 'compile-library 'a)
    #t)
  (begin
    (with-output-to-file "testfile-m3.ss"
      (lambda ()
        (pretty-print
          '(define-syntax q3 (let () (import (testfile-a)) (identifier-syntax a)))))
      'replace)
    (separate-compile 'compile-file 'm3)
    #t)
  (equal?
    (separate-eval '(load "testfile-m3.so") 'q3)
    "ct\n3\n")
  (begin
    (with-output-to-file "testfile-m4.ss"
      (lambda ()
        (pretty-print
          '(define-syntax q4 (let () (import (testfile-a)) (identifier-syntax x)))))
      'replace)
    (separate-compile 'compile-file 'm4)
    #t)
  (equal?
    (separate-eval '(load "testfile-m4.so") 'q4)
    "rt\n4\n")
  (begin
    (sleep (make-time 'time-duration 1000000 1))
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 33)))
             (define x (begin (printf "rt\n") 44)))))
      'replace)
    (separate-compile 'compile-library 'a)
    (separate-compile 'maybe-compile-file 'm3)
    (separate-compile 'maybe-compile-file 'm4)
    #t)
  (equal?
    (separate-eval '(load "testfile-m3.so") 'q3)
    "ct\n33\n")
  (equal?
    (separate-eval '(load "testfile-m4.so") 'q4)
    "rt\n44\n")
  ; --------
  (begin
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 3)))
             (define x (begin (printf "rt\n") 4)))))
      'replace)
    (separate-compile 'compile-library 'a)
    #t)
  (begin
    (with-output-to-file "testfile-m5.ss"
      (lambda ()
        (pretty-print
          '(define-property q5 q5 (let () (import (testfile-a)) #'a))))
      'replace)
    (separate-compile 'compile-file 'm5)
    #t)
  (equal?
    (separate-eval
      '(load "testfile-m5.so")
      '(let ()
         (define-syntax ref-prop
           (lambda (x)
             (lambda (r)
               (syntax-case x ()
                 [(_ id key) (r #'id #'key)]))))
         (ref-prop q5 q5)))
    "ct\n3\n")
  (begin
    (with-output-to-file "testfile-m6.ss"
      (lambda ()
        (pretty-print
          '(define-property q6 q6 (let () (import (testfile-a)) #'x))))
      'replace)
    (separate-compile 'compile-file 'm6)
    #t)
  (equal?
    (separate-eval '(load "testfile-m6.so")
      '(let ()
         (define-syntax ref-prop
           (lambda (x)
             (lambda (r)
               (syntax-case x ()
                 [(_ id key) (r #'id #'key)]))))
         (ref-prop q6 q6)))
    "rt\n4\n")
  (begin
    (sleep (make-time 'time-duration 1000000 1))
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 33)))
             (define x (begin (printf "rt\n") 44)))))
      'replace)
    (separate-compile 'compile-library 'a)
    (separate-compile 'maybe-compile-file 'm5)
    (separate-compile 'maybe-compile-file 'm6)
    #t)
  (equal?
    (separate-eval
      '(load "testfile-m5.so")
      '(let ()
         (define-syntax ref-prop
           (lambda (x)
             (lambda (r)
               (syntax-case x ()
                 [(_ id key) (r #'id #'key)]))))
         (ref-prop q5 q5)))
    "ct\n33\n")
  (equal?
    (separate-eval '(load "testfile-m6.so")
      '(let ()
         (define-syntax ref-prop
           (lambda (x)
             (lambda (r)
               (syntax-case x ()
                 [(_ id key) (r #'id #'key)]))))
         (ref-prop q6 q6)))
    "rt\n44\n")
  ; --------
  (begin
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 3)))
             (define x (begin (printf "rt\n") 4)))))
      'replace)
    (separate-compile 'compile-library 'a)
    #t)
  (begin
    (with-output-to-file "testfile-m7.ss"
      (lambda ()
        (pretty-print
          '(meta define q7 (let () (import (testfile-a)) #'a))))
      'replace)
    (separate-compile 'compile-file 'm7)
    #t)
  (equal?
    (separate-eval
      '(load "testfile-m7.so")
      '(let ()
         (define-syntax qq (lambda (x) q7))
         qq))
    "ct\n3\n")
  (begin
    (with-output-to-file "testfile-m8.ss"
      (lambda ()
        (pretty-print
          '(meta define q8 (let () (import (testfile-a)) #'x))))
      'replace)
    (separate-compile 'compile-file 'm8)
    #t)
  (equal?
    (separate-eval
      '(load "testfile-m8.so")
      '(let ()
         (define-syntax qq (lambda (x) q8))
         qq))
    "rt\n4\n")
  (begin
    (sleep (make-time 'time-duration 1000000 1))
    (with-output-to-file "testfile-a.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-a) (export a x) (import (chezscheme))
             (define-syntax a (begin (printf "ct\n") (identifier-syntax 33)))
             (define x (begin (printf "rt\n") 44)))))
      'replace)
    (separate-compile 'compile-library 'a)
    (separate-compile 'maybe-compile-file 'm7)
    (separate-compile 'maybe-compile-file 'm8)
    #t)
  (equal?
    (separate-eval
      '(load "testfile-m7.so")
      '(let ()
         (define-syntax qq (lambda (x) q7))
         qq))
    "ct\n33\n")
  (equal?
    (separate-eval
      '(load "testfile-m8.so")
      '(let ()
         (define-syntax qq (lambda (x) q8))
         qq))
    "rt\n44\n")
)

(mat eval-when-library
  (begin
    (with-output-to-file "testfile-ewl1.ss"
      (lambda ()
        (pretty-print
          '(eval-when ()
             (library (testfile-ewl1)
               (export x)
               (import (rnrs))
               (define-syntax x (identifier-syntax 23))))))
      'replace)
    (with-output-to-file "testfile-ewl2.ss"
      (lambda ()
        (pretty-print
          '(eval-when (eval)
             (library (testfile-ewl2)
               (export x)
               (import (rnrs))
               (define-syntax x (identifier-syntax 23))))))
      'replace)
    (with-output-to-file "testfile-ewl3.ss"
      (lambda ()
        (pretty-print
          '(eval-when (load)
             (library (testfile-ewl3)
               (export x)
               (import (rnrs))
               (define-syntax x (identifier-syntax 23))))))
      'replace)
    (with-output-to-file "testfile-ewl4.ss"
      (lambda ()
        (pretty-print
          '(eval-when (visit)
             (library (testfile-ewl4)
               (export x)
               (import (rnrs))
               (define-syntax x (identifier-syntax 23))))))
      'replace)
    (with-output-to-file "testfile-ewl5.ss"
      (lambda ()
        (pretty-print
          '(eval-when (revisit)
             (library (testfile-ewl5)
               (export x)
               (import (rnrs))
               (define-syntax x (identifier-syntax 23))))))
      'replace)
    (with-output-to-file "testfile-ewl6.ss"
      (lambda ()
        (pretty-print
          '(eval-when (compile)
             (library (testfile-ewl6)
               (export x)
               (import (rnrs))
               (define-syntax x (identifier-syntax 23))))))
      'replace)
    (for-each
      delete-file
      '("testfile-ewl1.so" "testfile-ewl2.so" "testfile-ewl3.so" "testfile-ewl4.so"
         "testfile-ewl5.so" "testfile-ewl6.so"))
    #t)
 ; loading testfile-ewlx.ss did not define library (testfile-ewlx)
  (error? (let ([x 55]) (import (testfile-ewl1)) x))
  (error? (let ([x 55]) (import (testfile-ewl3)) x))
  (error? (let ([x 55]) (import (testfile-ewl4)) x))
  (error? (let ([x 55]) (import (testfile-ewl5)) x))
  (error? (let ([x 55]) (import (testfile-ewl6)) x))
  (begin
    (for-each separate-compile '(ewl1 ewl2 ewl3 ewl4 ewl5 ewl6))
    (for-each load-library
      '("testfile-ewl1.so" "testfile-ewl2.so" "testfile-ewl3.so" "testfile-ewl4.so"
         "testfile-ewl5.so" "testfile-ewl6.so"))
    #t)
 ; loading testfile-ewlx.so did not define library (testfile-ewlx)
 ; actually "testfile-ewlx.ss did not ..." (ss rather than so)
 ;   now that load-library reloads source when dependency changes
  (error? (let ([x 55]) (import (testfile-ewl1)) x))
  (error? (let ([x 55]) (import (testfile-ewl2)) x))
  (error? (let ([x 55]) (import (testfile-ewl6)) x))
  (begin
    (load-library "testfile-ewl2.ss")
    (compile-library "testfile-ewl6")
    #t)
  (eqv? (let ([x 55]) (import (testfile-ewl2)) x) 23)
  (eqv? (let ([x 55]) (import (testfile-ewl3)) x) 23)
  (eqv? (let ([x 55]) (import (testfile-ewl4)) x) 23)
  (eqv? (let ([x 55]) (import (testfile-ewl5)) x) 23)
  (eqv? (let ([x 55]) (import (testfile-ewl6)) x) 23)
)

(mat library-directories
  (error? ; invalid argument
    (library-directories '("a" . hello)))
  (error? ; invalid argument
    (library-directories '("a" . ("src" . "obj"))))
  (error? ; invalid argument
    (library-directories '("a" . (("src")))))
  (error? ; invalid argument
    (library-directories '("a" . (("src" "obj")))))
  (error? ; invalid argument
    (library-directories '("a" . ((("src" "obj"))))))
  (let ([x (library-directories)])
    (and (list? x)
         (andmap (lambda (x) (and (pair? x) (string? (car x)) (string? (cdr x)))) x)))
  (if (windows?)
      (parameterize ([library-directories "a1;boo;c:/;dxxy"])
        (equal? (library-directories) '(("a1" . "a1") ("boo" . "boo") ("c:/" . "c:/") ("dxxy" . "dxxy"))))
      (parameterize ([library-directories "a1:boo:c;/:dxxy"])
        (equal? (library-directories) '(("a1" . "a1") ("boo" . "boo") ("c;/" . "c;/") ("dxxy" . "dxxy")))))
  (if (windows?)
      (parameterize ([library-directories "a1;boo;;boo-obj;c:/;;dxxy"])
        (equal? (library-directories) '(("a1" . "a1") ("boo" . "boo-obj") ("c:/" . "dxxy"))))
      (parameterize ([library-directories "a1:boo::boo-obj:c;/::dxxy"])
        (equal? (library-directories) '(("a1" . "a1") ("boo" . "boo-obj") ("c;/" . "dxxy")))))
  (let ([default (library-directories)])
    (if (windows?)
        (parameterize ([library-directories "a1;boo;c:/;dxxy;"])
          (equal? (library-directories) `(,@'(("a1" . "a1") ("boo" . "boo") ("c:/" . "c:/") ("dxxy" . "dxxy")) ,@default)))
        (parameterize ([library-directories "a1:boo:c;/:dxxy:"])
          (equal? (library-directories) `(,@'(("a1" . "a1") ("boo" . "boo") ("c;/" . "c;/") ("dxxy" . "dxxy")) ,@default)))))
  (begin
    (with-output-to-file "testfile-ld1.ss"
      (lambda ()
        (pretty-print
          `(library (,(string->symbol (cd)) testfile-ld1)
             (export x)
             (import (rnrs))
             (define-syntax x (identifier-syntax 23)))))
      'replace)
    #t)
  (error? ; library not found
    (parameterize ([library-directories '()])
      (eval `(lambda () (import (testfile-ld1)) x))))
  (eqv?
    ((parameterize ([library-directories '()])
       (eval `(lambda () (import (,(string->symbol (cd)) testfile-ld1)) x))))
    23)
)

(mat library-extensions
  (error? ; invalid argument
    (library-extensions '.a1.sls))
  (error? ; invalid argument
    (library-extensions '((".foo"))))
  (error? ; invalid argument
    (library-extensions '((".foo" ".bar"))))
  (error? ; invalid argument
    (library-extensions '(((".junk")))))
  (let ([x (library-extensions)])
    (and (list? x)
         (andmap (lambda (x) (and (pair? x) (string? (car x)) (string? (cdr x)))) x)))
  (if (windows?)
      (parameterize ([library-extensions ".a1.sls;.boo;.crud;.junk"])
        (equal? (library-extensions) '((".a1.sls" . ".a1.so") (".boo" . ".so") (".crud" . ".so") (".junk" . ".so"))))
      (parameterize ([library-extensions ".a1.sls:.boo:.crud:.junk"])
        (equal? (library-extensions) '((".a1.sls" . ".a1.so") (".boo" . ".so") (".crud" . ".so") (".junk" . ".so")))))
  (let ([default (library-extensions)])
    (if (windows?)
        (parameterize ([library-extensions ".a1.sls;.boo;.crud;.junk;"])
          (equal? (library-extensions) `(,@'((".a1.sls" . ".a1.so") (".boo" . ".so") (".crud" . ".so") (".junk" . ".so")) ,@default)))
        (parameterize ([library-extensions ".a1.sls:.boo:.crud:.junk:"])
          (equal? (library-extensions) `(,@'((".a1.sls" . ".a1.so") (".boo" . ".so") (".crud" . ".so") (".junk" . ".so")) ,@default)))))
  (let ([default (library-extensions)])
    (if (windows?)
        (parameterize ([library-extensions ".a1.sls;.boo;;.booso;.crud;;.junk;"])
          (equal? (library-extensions) `(,@'((".a1.sls" . ".a1.so") (".boo" . ".booso") (".crud" . ".junk")) ,@default)))
        (parameterize ([library-extensions ".a1.sls:.boo::.booso:.crud::.junk:"])
          (equal? (library-extensions) `(,@'((".a1.sls" . ".a1.so") (".boo" . ".booso") (".crud" . ".junk")) ,@default)))))
)

(mat library-search-handler
  (procedure? (library-search-handler))
  (eq? (library-search-handler) default-library-search-handler)
  (error? (default-library-search-handler "not-symbol" '(lib) '() '()))
  (error? (default-library-search-handler 'import 'bad-library-name '() '()))
  (error? (default-library-search-handler 'import '(lib) '(("invalid" "path" "list")) '()))
  (error? (default-library-search-handler 'import '(lib) '(("foo" . "bar")) '(("bad") ("extensions"))))
  (error?
   (parameterize ([library-search-handler
                   (lambda (who path dir* all-ext*)
                     (values '(bad source path) #f #f))])
     (eval '(import (foo)))))
  (error?
   (parameterize ([library-search-handler
                   (lambda (who path dir* all-ext*)
                     (values #f '(bad object path) #f))])
     (eval '(import (foo)))))
  (error?
   (parameterize ([library-search-handler
                   (lambda (who path dir* all-ext*)
                     (values #f #f #t))])
     (eval '(import (foo)))))
  (begin
    (mkdir "lsh-testdir")
    (mkdir "lsh-testdir/src1")
    (mkdir "lsh-testdir/src2")
    (mkdir "lsh-testdir/obj")
    #t)
  (begin
    (with-output-to-file "lsh-testdir/src1/lib.ss"
      (lambda ()
        (pretty-print
         '(library (lib) (export a) (import (scheme))
            (define a "src1 provided this a"))))
      'replace)
    (with-output-to-file "lsh-testdir/src2/lib.ss"
      (lambda ()
        (pretty-print
         '(library (lib) (export a) (import (scheme))
            (define a "a from src2"))))
      'replace)
    (with-output-to-file "lsh-testdir/src2/foo.ss"
      (lambda ()
        (pretty-print
         '(library (foo) (export a) (import (scheme) (lib)))))
      'replace)
    (parameterize ([generate-wpo-files #t]
                   [compile-imported-libraries #t]
                   [library-directories '(("src2" . "obj"))])
      (compile-file "lsh-testdir/src2/lib.ss" "lsh-testdir/obj/lib.so")
      (compile-file "lsh-testdir/src2/foo.ss" "lsh-testdir/obj/foo.so"))
    #t)
  (equal?
   "a from src2\n"
   (separate-eval
    '(cd "lsh-testdir")
    '(library-extensions '((".ss" . ".so")))
    '(library-directories '(("src2" . "obj") ("src1" . "obj")))
    '(library-search-handler
      (lambda (who path dir* all-ext*)
        (let-values ([(src-path obj-path obj-exists?)
                      (default-library-search-handler who path dir* all-ext*)])
          (assert (equal? src-path "src2/lib.ss"))
          (assert (equal? obj-path "obj/lib.so"))
          (assert obj-exists?)
          (values src-path obj-path obj-exists?))))
    '(printf "~a\n" (let () (import (lib)) a))))
  (equal?
   "src1 provided this a\n"
   (separate-eval
    '(cd "lsh-testdir")
    '(library-extensions '((".ss" . ".so")))
    '(library-directories '(("src2" . "obj") ("src1" . "obj")))
    '(library-search-handler
      (lambda (who path dir* all-ext*)
        (assert (eq? who 'import))
        (assert (equal? path '(lib)))
        (assert (equal? dir* (library-directories)))
        (assert (equal? all-ext* (library-extensions)))
        ;; switcheroo
        (values "src1/lib.ss" #f #f)))
    '(printf "~a\n" (let () (import (lib)) a))))
  (equal?
   (string-append
    "compiling src1/lib.ss with output to obj/lib-compiled.so\n"
    "src1 provided this a\n")
   (separate-eval
    '(cd "lsh-testdir")
    '(compile-imported-libraries #t)
    '(library-search-handler
      (lambda (who path dir* all-ext*)
        (values "src1/lib.ss" "obj/lib-compiled.so" #f)))
    '(printf "~a\n" (let () (import (lib)) a))))
  ;; the default library-search-handler finds obj/lib.wpo
  ;; so no libraries are needed at run time
  (equal?
    "()\n"
   (separate-eval
    '(cd "lsh-testdir")
    '(library-extensions '((".ss" . ".so")))
    '(library-directories '(("src1" . "obj") ("src2" . "obj")))
    '(compile-whole-library "obj/foo.wpo" "foo.library")))
  (equal?
   "((lib))\n"
   (separate-eval
    '(cd "lsh-testdir")
    '(library-extensions '((".ss" . ".so")))
    '(library-directories '(("src1" . "obj") ("src2" . "obj")))
    '(define (check who path dir*)
       (assert (eq? who 'compile-whole-library))
       (assert (equal? path '(lib)))
       (assert (equal? dir* (library-directories))))
    '(library-search-handler
      (lambda (who path dir* all-ext*)
        (check who path dir*)
        (assert (equal? all-ext* '((".ss" . ".wpo"))))
        ;; default search finds the wpo file, but ...
        (let-values ([(src-path obj-path obj-exists?)
                      (default-library-search-handler who path dir* all-ext*)])
          ;; user reordered library-directories since compiling the wpo file
          (assert (equal? src-path "src1/lib.ss"))
          (assert (equal? obj-path "obj/lib.wpo"))
          (assert obj-exists?))
        ;; ... we install a new handler that returns the object file instead
        (library-search-handler
         (lambda (who path dir* all-ext*)
           (check who path dir*)
           (assert (equal? all-ext* (library-extensions)))
           (values #f "obj/lib.so" #t)))
        ;; ... and report no .wpo file found so we fall back to the
        ;; library-search-handler just installed
        (values #f #f #f)))
    '(compile-whole-library "obj/foo.wpo" "foo.library")))
  (begin
    (rm-rf "lsh-testdir")
    #t)
)

(mat compile-imported-libraries
  (not (compile-imported-libraries))
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (define $cil '())
    (with-output-to-file "testdir/cil1.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil1 $cil))))
        (pretty-print
          '(library (testdir cil1) (export a) (import (rnrs))
             (define x 57388321)
             (define-syntax a (lambda (q) #'x)))))
      'replace)
    (with-output-to-file "testdir/cil2.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil2 $cil))))
        (pretty-print
          '(library (testdir cil2) (export a b f get-y) (import (rnrs) (testdir cil1))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil2)))
        (pretty-print '(f (cons (b) a))))
      'replace)
    #t)
  (equal?
    (parameterize ([compile-imported-libraries #t]
                   [compile-file-message #f]
                   [compile-library-handler
                    (lambda args
                      (printf "hello!\n")
                      (flush-output-port)
                      (apply compile-library args)
                      (printf "goodbye.\n")
                      (flush-output-port))])
      (with-output-to-string
        (lambda ()
          (load-program "testdir/cil"))))
    "hello!\nhello!\ngoodbye.\ngoodbye.\n")
  (file-exists? "testdir/cil1.so")
  (file-exists? "testdir/cil2.so")
  (equal? $cil '(cil1 cil2))
  (equal? (let () (import (testdir cil2)) (get-y)) '((57388321) . 57388321)) 
  (equal? (let () (import (testdir cil2)) (f 772) (get-y)) 772)
  (eq?
    (parameterize ([compile-imported-libraries #t])
      (load-program "testdir/cil"))
    (void))
  (equal? (let () (import (testdir cil2)) (get-y)) '((57388321) . 57388321)) 
  (equal? $cil '(cil1 cil2))
  (begin
    (rm-rf "testdir")
    #t)
 ; once again with extension .ss, to see if position in library-extensions list matters
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (define $cil '())
    (with-output-to-file "testdir/cil3.ss"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil3 $cil))))
        (pretty-print
          '(library (testdir cil3) (export a) (import (rnrs))
             (define x 57388321)
             (define-syntax a (lambda (q) #'x)))))
      'replace)
    (with-output-to-file "testdir/cil4.ss"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil4 $cil))))
        (pretty-print
          '(library (testdir cil4) (export a b f get-y) (import (rnrs) (testdir cil3))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil4)))
        (pretty-print '(f (cons (b) a))))
      'replace)
    #t)
  (eq?
    (parameterize ([compile-imported-libraries #t])
      (load-program "testdir/cil"))
    (void))
  (file-exists? "testdir/cil3.so")
  (file-exists? "testdir/cil4.so")
  (equal? $cil '(cil3 cil4))
  (equal? (let () (import (testdir cil4)) (get-y)) '((57388321) . 57388321)) 
  (equal? (let () (import (testdir cil4)) (f 772) (get-y)) 772)
  (eq?
    (parameterize ([compile-imported-libraries #t])
      (load-program "testdir/cil"))
    (void))
  (equal? (let () (import (testdir cil4)) (get-y)) '((57388321) . 57388321)) 
  (equal? $cil '(cil3 cil4))
  (begin
    (rm-rf "testdir")
    (rm-rf "objdir")
    #t)
 ; try again with different library-directories and library-extensions
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (define $cil '())
    (with-output-to-file "testdir/cil5.ss"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil5 $cil))))
        (pretty-print
          '(library (testdir cil5) (export a) (import (rnrs))
             (define x 57388321)
             (define-syntax a (lambda (q) #'x)))))
      'replace)
    (with-output-to-file "testdir/cil6.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil6 $cil))))
        (pretty-print
          '(library (testdir cil6) (export a b f get-y) (import (rnrs) (testdir cil5))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil6)))
        (pretty-print '(f (cons (b) a))))
      'replace)
    #t)
  (eq?
    (parameterize ([compile-imported-libraries #t]
                   [library-directories '(("." . "objdir"))]
                   [library-extensions '((".sls" . ".bar") (".ss" . ".foo"))])
      (load-program "testdir/cil"))
    (void))
  (file-exists? "objdir/testdir/cil5.foo")
  (file-exists? "objdir/testdir/cil6.bar")
  (equal? $cil '(cil5 cil6))
  (equal? (let () (import (testdir cil6)) (get-y)) '((57388321) . 57388321)) 
  (equal? (let () (import (testdir cil6)) (f 772) (get-y)) 772)
  (eq?
    (parameterize ([compile-imported-libraries #t]
                   [library-directories '(("." . "objdir"))]
                   [library-extensions '((".sls" . ".bar") (".ss" . ".foo"))])
      (load-program "testdir/cil"))
    (void))
  (equal? (let () (import (testdir cil6)) (get-y)) '((57388321) . 57388321)) 
  (equal? $cil '(cil5 cil6))
  (begin
    (rm-rf "testdir")
    (rm-rf "objdir")
    #t)
 ; what if we compile explicitly first?
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (define $cil '())
    (with-output-to-file "testdir/cil7.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil7 $cil))))
        (pretty-print
          '(library (testdir cil7) (export a) (import (rnrs))
             (define x 57388321)
             (define-syntax a (lambda (q) #'x)))))
      'replace)
    (with-output-to-file "testdir/cil8.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil8 $cil))))
        (pretty-print
          '(library (testdir cil8) (export a b f get-y) (import (rnrs) (testdir cil7))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil8)))
        (pretty-print '(f (cons (b) a))))
      'replace)
    (compile-library "testdir/cil7.sls")
    (compile-library "testdir/cil8.sls")
    #t)
  (file-exists? "testdir/cil7.so")
  (file-exists? "testdir/cil8.so")
  (equal? $cil '(cil8 cil7))
  (eq?
    (parameterize ([compile-imported-libraries #t])
      (load-program "testdir/cil"))
    (void))
  (equal? $cil '(cil8 cil7))
  (equal? (let () (import (testdir cil8)) (get-y)) '((57388321) . 57388321)) 
  (begin
    (rm-rf "testdir")
    #t)
 ; what if we compile ahead of time, and put .so in library extensions?
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (define $cil '())
    (with-output-to-file "testdir/cil9.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil9 $cil))))
        (pretty-print
          '(library (testdir cil9) (export a) (import (rnrs))
             (define x 57388321)
             (define-syntax a (lambda (q) #'x)))))
      'replace)
    (with-output-to-file "testdir/cil10.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil10 $cil))))
        (pretty-print
          '(library (testdir cil10) (export a b f get-y) (import (rnrs) (testdir cil9))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil10)))
        (pretty-print '(f (cons (b) a))))
      'replace)
    (compile-library "testdir/cil9.sls")
    (compile-library "testdir/cil10.sls")
    #t)
  (file-exists? "testdir/cil9.so")
  (file-exists? "testdir/cil10.so")
  (equal? $cil '(cil10 cil9))
  (eq?
    (parameterize ([compile-imported-libraries #t]
                   [library-extensions (cons ".so" (library-extensions))])
      (load-program "testdir/cil"))
    (void))
  (equal? $cil '(cil10 cil9))
  (equal? (let () (import (testdir cil10)) (get-y)) '((57388321) . 57388321)) 
  (begin
    (rm-rf "testdir")
    #t)
 ; separate compilation
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (define $cil '())
    (with-output-to-file "testdir/cil11.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil11 $cil))))
        (pretty-print
          '(library (testdir cil11) (export a) (import (rnrs))
             (define x 57388321)
             (define-syntax a (lambda (q) #'x)))))
      'replace)
    (with-output-to-file "testdir/cil12.sls"
      (lambda ()
        (pretty-print '(eval-when (compile) (set! $cil (cons 'cil12 $cil))))
        (pretty-print
          '(library (testdir cil12) (export a b f get-y) (import (rnrs) (testdir cil11))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil.ss"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil12)))
        (pretty-print '(f (cons (b) a))))
      'replace)
    #t)
  (begin
    (separate-compile
      '(lambda (x)
         (set! $cil '())
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      "testdir/cil")
    #t)
  (file-exists? "testdir/cil.so")
  (file-exists? "testdir/cil11.so")
  (file-exists? "testdir/cil12.so")
  (equal? $cil '())
  (equal? (let () (import (testdir cil11)) a) 57388321)
  (eq?
    (parameterize ([compile-imported-libraries #t])
      (load-program "testdir/cil.so"))
    (void))
  (equal? (let () (import (testdir cil12)) (get-y)) '((57388321) . 57388321)) 
  (equal? $cil '())
  (begin
    (rm-rf "testdir")
    #t)
 ; test auto recompilation if dependency is recompiled
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (with-output-to-file "testdir/cil13.sls"
      (lambda ()
        (pretty-print
          '(library (testdir cil13) (export a x) (import (rnrs))
             (define x 73)
             (define-syntax a (lambda (q) #'(+ x 6))))))
      'replace)
    (with-output-to-file "testdir/cil14.sls"
      (lambda ()
        (pretty-print
          '(library (testdir cil14) (export a b f get-y) (import (rnrs) (testdir cil13))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a x)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil-a.ss"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil14)))
        (pretty-print '(f (cons (b) a)))
        (pretty-print '(display (get-y))))
      'replace)
    (with-output-to-file "testdir/cil15.sls"
      (lambda ()
        (pretty-print
          '(library (testdir cil15) (export a x) (import (rnrs))
             (define x 73)
             (define-syntax a (lambda (q) #'(+ x 6))))))
      'replace)
    (with-output-to-file "testdir/cil16.sls"
      (lambda ()
        (pretty-print
          '(library (testdir cil16) (export a b f get-y) (import (rnrs) (testdir cil15))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a x)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil-b.ss"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil16)))
        (pretty-print '(f (cons (b) a)))
        (pretty-print '(display (get-y))))
      'replace)
    (with-output-to-file "testdir/cil17.sls"
      (lambda ()
        (pretty-print
          '(library (testdir cil17) (export a x) (import (rnrs))
             (define x 73)
             (define-syntax a (lambda (q) #'(+ x 6))))))
      'replace)
    (with-output-to-file "testdir/cil18.sls"
      (lambda ()
        (pretty-print
          '(library (testdir cil18) (export a b f get-y) (import (rnrs) (testdir cil17))
             (define y #f)
             (define get-y (lambda () y))
             (define b (lambda () (list a x)))
             (define f (lambda (v) (set! y v))))))
      'replace)
    (with-output-to-file "testdir/cil-c.ss"
      (lambda ()
        (display "#! /usr/bin/env scheme-script\n")
        (pretty-print '(import (rnrs) (testdir cil18)))
        (pretty-print '(f (cons (b) a)))
        (pretty-print '(display (get-y))))
      'replace)
    #t)
 ; compile 'em all in a separate process
  (begin
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      "testdir/cil-a")
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      "testdir/cil-b")
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      "testdir/cil-c")
    #t)
  (file-exists? "testdir/cil-a.so")
  (file-exists? "testdir/cil13.so")
  (file-exists? "testdir/cil14.so")
  (file-exists? "testdir/cil-b.so")
  (file-exists? "testdir/cil15.so")
  (file-exists? "testdir/cil16.so")
  (file-exists? "testdir/cil-c.so")
  (file-exists? "testdir/cil13.so")
  (file-exists? "testdir/cil14.so")
 ; can't test programs' output here, since we don't want
 ; to load the libraries until after the next step
 ; now delete object file or modify source file and recompile
  (begin
   ; ensure a different time stamp
    (delete-file "testdir/cil13.so")
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      "testdir/cil-a")
    (sleep (make-time 'time-duration 0 1))
    (with-output-to-file "testdir/cil15.sls"
      (lambda ()
        (pretty-print
          '(library (testdir cil15) (export a x) (import (rnrs))
             (define x -73)
             (define-syntax a (lambda (q) #'(+ x 6))))))
      'replace)
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #t])
           (compile-program x)))
      "testdir/cil-b")
    (delete-file "testdir/cil17.so")
    (separate-compile
      '(lambda (x)
         (parameterize ([compile-imported-libraries #f]) ; #f here rather than #t should cause failure
           (compile-program x)))
      "testdir/cil-c")
    #t)
  (file-exists? "testdir/cil-a.so")
  (file-exists? "testdir/cil13.so")
  (file-exists? "testdir/cil14.so")
  (file-exists? "testdir/cil-b.so")
  (file-exists? "testdir/cil15.so")
  (file-exists? "testdir/cil16.so")
  ; testdir/cil-c.so exists now that load-library reloads source when dependency changes
  (file-exists? "testdir/cil-c.so")
  (file-exists? "testdir/cil13.so")
  (file-exists? "testdir/cil14.so")
  (file-exists? "testdir/cil-a.so")
  (file-exists? "testdir/cil13.so")
  (file-exists? "testdir/cil14.so")
 ; now test programs' output
  (equal?
    (with-output-to-string
      (lambda () (load-program "testdir/cil-a.so")))
    "((79 73) . 79)")
  (equal?
    (with-output-to-string
      (lambda () (load-program "testdir/cil-b.so")))
    "((-67 -73) . -67)")
  (begin
    (rm-rf "testdir")
    #t)
  ; ---------------------------------------------------------------
  (begin
    (mkdir "testdir")
    #t)
  (begin
    (with-output-to-file "testdir/cil19A.ss"
      (lambda ()
        (pretty-print
          '(library (testdir cil19A)
             (export x)
             (import (chezscheme))
             (define x (make-parameter 13)))))
      'replace)
    (with-output-to-file "testdir/cil19B.ss"
      (lambda ()
        (pretty-print
          '(library (testdir cil19B)
             (export y)
             (import (chezscheme))
            ; importing from within RHS to make sure RHS imports are tracked
             (define y (make-parameter (let () (import (testdir cil19A)) (+ (x) 5)))))))
      'replace)
    (with-output-to-file "testdir/cil19C.ss"
      (lambda ()
        (pretty-print
          '(import (chezscheme) (testdir cil19B)))
        (pretty-print
          '(pretty-print (y))))
      'replace)
    #t)
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "compiling testdir/cil19B.ss with output to testdir/cil19B.so\ncompiling testdir/cil19A.ss with output to testdir/cil19A.so\n18\n")
  (file-exists? "testdir/cil19A.so")
  (file-exists? "testdir/cil19B.so")
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "18\n")
 ; now add an include file
  (begin
    (sleep (make-time 'time-duration 0 1))
    (with-output-to-file "testdir/cil19A1.ss"
      (lambda ()
        (pretty-print
          '(define x (make-parameter 19))))
      'replace)
    (with-output-to-file "testdir/cil19A.ss"
      (lambda ()
        (pretty-print
          '(library (testdir cil19A)
             (export x)
             (import (chezscheme))
             (include "cil19A1.ss"))))
      'replace)
    #t)
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "compiling testdir/cil19A.ss with output to testdir/cil19A.so\ncompiling testdir/cil19B.ss with output to testdir/cil19B.so\n24\n")
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "24\n")
 ; now change first include file to include a second
  (begin
    (sleep (make-time 'time-duration 0 1))
    (with-output-to-file "testdir/cil19A2.ss"
      (lambda ()
        (pretty-print
          '(define x (make-parameter 23))))
      'replace)
    (with-output-to-file "testdir/cil19A1.ss"
      (lambda ()
        (pretty-print
          '(include "cil19A2.ss")))
      'replace)
    #t)
  ; load w/compile-imported-libraries #f---should get old result
  ; not longer now that load-library reloads source when dependency changes
  (equal?
    (separate-eval
      '(compile-imported-libraries #f)
      '(load-program "testdir/cil19C.ss"))
    "28\n"
    #;"24\n")
  ; should get new result with compile-imported-libraries #t
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "compiling testdir/cil19A.ss with output to testdir/cil19A.so\ncompiling testdir/cil19B.ss with output to testdir/cil19B.so\n28\n")
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "28\n")
 ; now change second include file
  (begin
    (sleep (make-time 'time-duration 0 1))
    (with-output-to-file "testdir/cil19A2.ss"
      (lambda ()
        (pretty-print
          '(define x (make-parameter 31))))
      'replace)
    #t)
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "compiling testdir/cil19A.ss with output to testdir/cil19A.so\ncompiling testdir/cil19B.ss with output to testdir/cil19B.so\n36\n")
  (equal?
    (separate-eval
      '(compile-imported-libraries #t)
      '(load-program "testdir/cil19C.ss"))
    "36\n")
  (begin
    (rm-rf "testdir")
    #t)
)

(mat import-notify
  (eq? (import-notify 'yes) (void))
  (eq? (import-notify) #t)
  (begin
    (with-output-to-file "testfile-imno1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-imno1) (export x) (import (rnrs))
             (define x -73))))
      'replace)
    (with-output-to-file "testfile-imno2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-imno2) (export y) (import (rnrs) (testfile-imno1))
             (define y (+ x x)))))
      'replace)
    (separate-compile 'imno1)
    #t)
  (equal?
    (parameterize ([source-directories '(".")]
                   [library-directories '(".")]
                   [console-output-port (open-output-string)])
      (eval '(lambda () (import (testfile-imno2)) y))
      (get-output-string (console-output-port)))
    "import: did not find source file \"testfile-imno2.chezscheme.sls\"\nimport: found source file \"testfile-imno2.ss\"\nimport: did not find corresponding object file \"testfile-imno2.so\"\nimport: loading source file \"testfile-imno2.ss\"\nimport: did not find source file \"testfile-imno1.chezscheme.sls\"\nimport: found source file \"testfile-imno1.ss\"\nimport: found corresponding object file \"testfile-imno1.so\"\nimport: object file is not older\nimport: visiting object file \"testfile-imno1.so\"\nattempting to 'revisit' previously 'visited' \"testfile-imno1.so\" for library (testfile-imno1) run-time info\n")
  (eq? (import-notify #f) (void))
)

(mat rnrs-libraries
  (equal?
    (let ([cons void])
      (let () (import (rnrs base)) (cons 3 4)))
    '(3 . 4))
)

(mat top-level-program
  (equal?
    (with-output-to-string
      (lambda ()
        (eval '(top-level-program (import (scheme))
                 (define-syntax a (identifier-syntax (cons x y)))
                 (define x 55)
                 (printf "x = ~s\n" x)
                 (define y 'yyy)
                 (printf "(a x y) = ~s\n" (list a x y))))))
    "x = 55\n(a x y) = ((55 . yyy) 55 yyy)\n")
  (equal?
    (with-output-to-string
      (lambda ()
        (with-output-to-file "testfile-tlp1.ss"
          (lambda ()
            (pretty-print
              '(library (testfile-tlp1) (export $tlp-x $tlp-y) (import (scheme))
                 (define-syntax $tlp-y
                   (begin
                     (printf "visiting tlp1\n")
                     (identifier-syntax (cons ($tlp-x) (z)))))
                 (define z (make-parameter 'zzz))
                 (define $tlp-x (make-parameter 'xxx))
                 (printf "invoking tlp1\n"))))
          'replace)
        (with-output-to-file "testfile-tlp.ss"
          (lambda ()
            (pretty-print
              '(top-level-program (import (testfile-tlp1) (rnrs) (only (scheme) list printf))
                 (define-syntax a (identifier-syntax (cons x y)))
                 (define x ($tlp-x))
                 (printf "x = ~s\n" x)
                 (define y $tlp-y)
                 (printf "(a x y) = ~s\n" (list a x y)))))
          'replace)
       ; compile in same Scheme process
        (compile-file "testfile-tlp1")
        (compile-file "testfile-tlp")))
    "compiling testfile-tlp1.ss with output to testfile-tlp1.so\nvisiting tlp1\ncompiling testfile-tlp.ss with output to testfile-tlp.so\n")
  (equal?
    (with-output-to-string
      (lambda () (load "testfile-tlp.so")))
    "invoking tlp1\nx = xxx\n(a x y) = ((xxx xxx . zzz) xxx (xxx . zzz))\n")
  (begin
    (with-output-to-file "testfile-tlp2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-tlp2) (export $tlp-x $tlp-y) (import (scheme))
             (define-syntax $tlp-y
               (begin
                 (printf "visiting tlp2\n")
                 (identifier-syntax (cons ($tlp-x) z))))
             (define z 'zzz)
             (define $tlp-x (make-parameter 'xxx))
             (printf "invoking tlp2\n"))))
      'replace)
    (with-output-to-file "testfile-tlp.ss"
      (lambda ()
        (pretty-print
          '(top-level-program (import (testfile-tlp2) (rnrs) (only (scheme) list printf))
             (define-syntax a (identifier-syntax (cons x y)))
             (define x ($tlp-x))
             (printf "x = ~s\n" x)
             (define y $tlp-y)
             (printf "(a x y) = ~s\n" (list a x y)))))
      'replace)
    (for-each separate-compile '(tlp2 tlp))
    #t)
  (equal?
    (with-output-to-string
      (lambda () (load "testfile-tlp.so")))
    "invoking tlp2\nx = xxx\n(a x y) = ((xxx xxx . zzz) xxx (xxx . zzz))\n")
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (for-each pretty-print
          '((import (rnrs))
            (define x 0)
            (define (inc v) (set! x (+ x v)) x)
            (if (inc 3)))))
      'replace)
    #t)
  (error? ; invalid syntax (if (inc 3)) at [not near] line 4, char 1
    (load-program "testfile.ss"))
  (equal?
    (with-output-to-string
      (lambda ()
        (with-output-to-file "testfile-tlp1.ss"
          (lambda ()
            (pretty-print
              '(library (testfile-tlp1) (export $tlp-x $tlp-y) (import (scheme))
                 (define-syntax $tlp-y
                   (begin
                     (printf "visiting tlp1\n")
                     (identifier-syntax (cons ($tlp-x) (z)))))
                 (define z (make-parameter 'zzz))
                 (define $tlp-x (make-parameter 'xxx))
                 (printf "invoking tlp1\n"))))
          'replace)
        (with-output-to-file "testfile-tlp.ss"
          (lambda ()
            (for-each pretty-print
              '((import (testfile-tlp1) (rnrs) (only (scheme) list printf))
                (define-syntax a (identifier-syntax (cons x y)))
                (define x ($tlp-x))
                (printf "x = ~s\n" x)
                (define y $tlp-y)
                (printf "(a x y) = ~s\n" (list a x y)))))
          'replace)
       ; compile in same Scheme process
        (compile-library "testfile-tlp1")
        (compile-program "testfile-tlp")))
    "compiling testfile-tlp1.ss with output to testfile-tlp1.so\nvisiting tlp1\ncompiling testfile-tlp.ss with output to testfile-tlp.so\n")
  (equal?
    (with-output-to-string
      (lambda ()
        (load-library "testfile-tlp1.so")))
    "")
  (equal?
    (with-output-to-string
      (lambda ()
        (load-program "testfile-tlp.so")))
    "invoking tlp1\nx = xxx\n(a x y) = ((xxx xxx . zzz) xxx (xxx . zzz))\n")
 ; load again from source
  (equal?
    (with-output-to-string
      (lambda ()
        (load-library "testfile-tlp1.ss")))
    "visiting tlp1\n")
  (error? ; wrong version of testfile-tlp1
    (load-program "testfile-tlp.so"))
  (equal?
    (with-output-to-string
      (lambda ()
        (load-program "testfile-tlp.ss")))
    "invoking tlp1\nx = xxx\n(a x y) = ((xxx xxx . zzz) xxx (xxx . zzz))\n")
  (begin
    (delete-file "testfile-tlp1.so")
    (delete-file "testfile-tlp.so")
    #t)
  (begin
    (with-output-to-file "testfile-tlp1.ss"
      (lambda ()
        (parameterize ([print-vector-length #t])
          (pretty-print
            '(library (testfile-tlp1) (export $tlp-z) (import (chezscheme))
               (define $tlp-z '#3(1 2))))))
      'replace)
    (with-output-to-file "testfile-tlp.ss"
      (lambda ()
        (parameterize ([print-vector-length #t])
          (for-each pretty-print
            '((import (testfile-tlp1) (chezscheme))
              (pretty-print (equal? $tlp-z '#3(1 2)))))))
      'replace)
    #t)
  (error? ; nonstandard vector-length syntax
    (compile-library "testfile-tlp1"))
  (error? ; nonstandard vector-length syntax
    (compile-program "testfile-tlp"))
  (error? ; nonstandard vector-length syntax
    (load-library "testfile-tlp1.ss"))
  (error? ; nonstandard vector-length syntax
    (load-program "testfile-tlp.ss"))
  (begin
    (with-output-to-file "testfile-tlp1.ss"
      (lambda ()
        (display "#!chezscheme\n")
        (parameterize ([print-vector-length #t])
          (pretty-print
            '(library (testfile-tlp1) (export $tlp-z) (import (chezscheme))
               (define $tlp-z '#3(1 2))))))
      'replace)
    (with-output-to-file "testfile-tlp.ss"
      (lambda ()
        (display "#!chezscheme\n")
        (parameterize ([print-vector-length #t])
          (for-each pretty-print
            '((import (testfile-tlp1) (chezscheme))
              (pretty-print (equal? $tlp-z '#3(1 2)))))))
      'replace)
    #t)
  (equal?
    (begin
      (compile-library "testfile-tlp1")
      (compile-program "testfile-tlp")
      (with-output-to-string
        (lambda ()
          (load-library "testfile-tlp1.so")
          (load-program "testfile-tlp.so"))))
    "#t\n")
  (equal?
    (with-output-to-string
      (lambda ()
        (load-library "testfile-tlp1.ss")
        (load-program "testfile-tlp.ss")))
    "#t\n")
 ; test to make sure compiled top-level-program doesn't try to
 ; load libraries upon which it should not depend
  (equal?
    (begin
      (with-output-to-file "testfile-tlp3.ss"
        (lambda ()
          (pretty-print 
            '(library (testfile-tlp3)
               (export t1-x)
               (import (chezscheme))
               (define t1-x 332211))))
        'replace)
      (with-output-to-file "testfile-tlp4.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-tlp4)
               (export t2-q)
               (import (chezscheme) (testfile-tlp3))
               (define-syntax t2-q (lambda (x) t1-x)))))
        'replace)
      (with-output-to-file "testfile-tlp5.ss"
        (lambda ()
          (pretty-print '(import (chezscheme) (testfile-tlp4)))
          (pretty-print '(pretty-print t2-q)))
        'replace)
      (separate-compile 'compile-library 'tlp3)
      (separate-compile 'compile-library 'tlp4)
      (separate-compile 'compile-program 'tlp5)
      (delete-file "testfile-tlp3.ss")
      (delete-file "testfile-tlp4.ss")
      (delete-file "testfile-tlp3.so")
      (delete-file "testfile-tlp4.so")
      (printf "loading testfile-tlp5.so\n")
      (with-output-to-string
        (lambda ()
          (load-program "testfile-tlp5.so"))))
    "332211\n")
 ; check dependencies returned by compile-program
  (equal?
    (let ()
      (define dep8)
      (with-output-to-file "testfile-tlp6.ss"
        (lambda ()
          (pretty-print 
            '(library (testfile-tlp6)
               (export t1-x)
               (import (chezscheme))
               (define t1-x 332211))))
        'replace)
      (with-output-to-file "testfile-tlp7.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-tlp7)
               (export t2-q)
               (import (chezscheme) (testfile-tlp6))
               (define-syntax t2-q (lambda (x) t1-x)))))
        'replace)
      (with-output-to-file "testfile-tlp8.ss"
        (lambda ()
          (pretty-print '(import (chezscheme) (testfile-tlp7)))
          (pretty-print '(pretty-print t2-q)))
        'replace)
      (compile-library "testfile-tlp6")
      (compile-library "testfile-tlp7")
      (set! dep8 (compile-program "testfile-tlp8"))
      (printf "loading testfile-tlp8.so\n")
      (list
        (with-output-to-string
          (lambda ()
            (load-program "testfile-tlp8.so")))
        dep8))
    '("332211\n" ()))
 ; version of the above where program does depend on something
  (equal?
    (let ()
      (define dep8)
      (with-output-to-file "testfile-tlp9.ss"
        (lambda ()
          (pretty-print 
            '(library (testfile-tlp9)
               (export t1-x)
               (import (chezscheme))
               (define t1-x (make-parameter 332211)))))
        'replace)
      (with-output-to-file "testfile-tlp10.ss"
        (lambda ()
          (pretty-print
            '(library (testfile-tlp10)
               (export t2-q)
               (import (chezscheme) (testfile-tlp9))
               (define-syntax t2-q (identifier-syntax (t1-x))))))
        'replace)
      (with-output-to-file "testfile-tlp11.ss"
        (lambda ()
          (pretty-print '(import (chezscheme) (testfile-tlp10)))
          (pretty-print '(pretty-print t2-q)))
        'replace)
     ; if we don't let the compilation happen implicitly, the filename
     ; for (testfile-tlp9) doesn't get set
      (parameterize ([compile-imported-libraries #t])
        (set! dep8 (compile-program "testfile-tlp11")))
      (printf "loading testfile-tlp11.so\n")
      (list
        (with-output-to-string
          (lambda ()
            (load-program "testfile-tlp11.so")))
        dep8))
    '("332211\n" ((testfile-tlp9))))
  (equal? (library-object-filename '(testfile-tlp9)) "testfile-tlp9.so")
 ; make sure internal module bindings are properly set up before
 ; the body forms are processed
  (begin
    (top-level-program
      (import (chezscheme))
      (module ((a x))
        (define x 3)
        (define-syntax a (identifier-syntax x))
        (putprop 'tlp-spam 'tlp 7))
      a
      (putprop 'tlp-spam 'spam a))
    (and (eqv? (getprop 'tlp-spam 'spam) 3)
         (eqv? (getprop 'tlp-spam 'tlp) 7)
         (remprop 'tlp-spam 'spam)
         (remprop 'tlp-spam 'tlp)
         #t))
  ; make sure we ignore return value(s) of interleaved init expressions
  (equal?
   (with-output-to-string
     (lambda ()
       ; prevent cp0 from fixing the problem
       (parameterize ([run-cp0 (lambda (f x) x)])
         (eval '(top-level-program (import (scheme))
                  (define (f) (printf "hello\n") (values 1 2 3))
                  (f)
                  (define x 'world)
                  (pretty-print x))))))
   "hello\nworld\n")
)

(mat library-meta
  (begin
    (with-output-to-file "testfile-lm-a1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-lm-a1)
             (export a)
             (import (chezscheme))
             (meta define a #'17))))
      'replace)
    (with-output-to-file "testfile-lm-a2.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-lm-a2)
             (export b)
             (import (chezscheme) (testfile-lm-a1))
             (define-syntax b (lambda (q) a)))))
      'replace)
    (for-each separate-compile '(lm-a1 lm-a2))
    #t)
  (equal?
    (let ()
      (import (testfile-lm-a2))
      b)
    17)
  (error? ; attempt to assign unbound variable
    (let ()
      (import (testfile-lm-a1))
      (define-syntax b (lambda (q) (set! a (+ a 1)) a))))
  ; test $visit-library
  (begin
    (with-output-to-file "testfile-lm-b1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-lm-b1)
             (export a)
             (import (chezscheme))
             (meta define a #'17))))
      'replace)
    (with-output-to-file "testfile-lm-b2.ss"
      (lambda ()
        (pretty-print '(import (testfile-lm-b1)))
        (pretty-print '(define-syntax b (lambda (q) a))))
      'replace)
    (for-each separate-compile '(lm-b1 lm-b2))
    #t)
  (equal?
    (with-output-to-string
      (lambda ()
        (parameterize ([trace-output-port (current-output-port)])
          (load "testfile-lm-b2.so"))))
    "")
  (eqv? b 17)
)

(mat library-introspection
  (error? (library-exports 'foo))
  (error? (library-exports '(1 2 3)))
  (error? (library-exports '(probably not a valid loaded library)))
  (error? (library-exports '(probably not a valid loaded library (2 3))))
  (error? (library-exports '(rnrs (six))))
  (error? (library-exports '(rnrs (1))))
  (error? (library-version 'foo))
  (error? (library-version '(1 2 3)))
  (error? (library-version '(probably not a valid loaded library)))
  (error? (library-version '(probably not a valid loaded library ((>= 0)))))
  (error? (library-version '(rnrs (3 . 4))))
  (error? (library-version '(rnrs (1))))
  (error? (library-requirements 'foo))
  (error? (library-requirements '(1 2 3)))
  (error? (library-requirements '(probably not a valid loaded library)))
  (error? (library-requirements '(probably not a valid loaded library (1))))
  (error? (library-requirements '(rnrs (3.0))))
  (error? (library-requirements '(rnrs (1))))
  (error? (library-object-filename 'foo))
  (error? (library-object-filename '(1 2 3)))
  (error? (library-object-filename '(probably not a valid loaded library)))
  (error? (library-object-filename '(probably not a valid loaded library (2 3))))
  (error? (library-object-filename '(rnrs (six))))
  (error? (library-object-filename '(rnrs (1))))

  (error? (library-requirements 'foo (library-requirements-options)))
  (error? (library-requirements '(1 2 3) (library-requirements-options)))
  (error? (library-requirements '(probably not a valid loaded library) (library-requirements-options)))
  (error? (library-requirements '(probably not a valid loaded library (1)) (library-requirements-options)))
  (error? (library-requirements '(rnrs (3.0)) (library-requirements-options)))
  (error? (library-requirements '(rnrs (1)) (library-requirements-options)))

  (enum-set? (library-requirements-options))
  (error? (library-requirements-options . a))
  (error? (library-requirements-options spam))
  (error? (library-requirements-options import spam))

  (error? (library-requirements '(chezscheme) 'import))
  (error? (library-requirements '(chezscheme) '(import)))
  (error? (library-requirements '(chezscheme) '()))

  (begin
    (define set-equal?
      (lambda (s1 s2)
        (and (= (length s1) (length s2))
             (andmap (lambda (x) (member x s2)) s1)
             #t)))
    #t)
  (list? (library-list))
  (andmap list? (library-list))
  (andmap (lambda (x) (andmap symbol? x)) (library-list))
  (begin
    (library (null) (export) (import))
    #t)
  (let ([ls (library-list)])
    (and
      (member '(rnrs) ls)
      (member '(rnrs strings) ls)
      (member '(rnrs io ports) ls)
      (member '(chezscheme) ls)
      (member '(scheme) ls)
      (member '(null) ls))
      #t)
  (null? (library-exports '(null)))
  (set-equal?
    (library-exports '(rnrs mutable-pairs))
    '(set-car! set-cdr!))
  (equal? (sort string<? (map symbol->string (library-exports '(scheme))))
          (sort string<? (map symbol->string (library-exports '(chezscheme)))))
  (equal? (library-version '(rnrs)) '(6))
  (equal? (library-version '(rnrs (6))) '(6))
  (equal? (library-version '(rnrs (or (6) (7)))) '(6))
  (equal? (library-version '(rnrs (or (6) (7)))) '(6))
  (equal? (library-version '(scheme)) '())
  (equal? (library-requirements '(scheme)) '())
  (equal? (library-requirements '(scheme) (library-requirements-options)) '())
  (equal? (library-requirements '(scheme) (library-requirements-options import)) '())
  (equal? (library-requirements '(scheme ())) '())
  (equal? (library-requirements '(rnrs)) '())
  (equal? (library-requirements '(null)) '())
  (not (library-object-filename '(rnrs)))
  (not (library-object-filename '(rnrs (6))))
  (not (library-object-filename '(rnrs (or (6) (7)))))
  (not (library-object-filename '(rnrs (or (6) (7)))))
  (not (library-object-filename '(scheme)))
  (begin
    (library (li1 (3 4 5))
      (export x y)
      (import (chezscheme))
      (define-syntax x (lambda (x) 3))
      (define y (+ x 1)))
    (library (li2 (7 2))
      (export x z w)
      (import (rnrs) (li1 (3)))
      (define z (+ x y))
      (define-syntax w (lambda (q) (* y 2))))
    (library (li2a (7 2))
      (export x z w)
      (import (rnrs) (li1 (3)))
      (define z (+ x x))
      (define-syntax w (lambda (q) (* y 2))))
    #t)
  (and (member '(li1) (library-list))
       (member '(li2) (library-list))
       (member '(li2a) (library-list))
       #t)
  (equal? (library-version '(li1)) '(3 4 5))
  (equal? (library-version '(li2)) '(7 2))
  (equal? (library-version '(li2 ((>= 5)))) '(7 2))
  (equal? (library-version '(li2 (7 (>= 1)))) '(7 2))
  (error? (library-version '(li2 (6))))
  (set-equal? (library-exports '(li1)) '(x y))
  (set-equal? (library-exports '(li2)) '(x z w))
  (set-equal? (library-exports '(li2 ((>= 5)))) '(x z w))
  (set-equal? (library-exports '(li2 (7 (>= 1)))) '(x z w))
  (error? (library-exports '(li2 (6))))
  (not (library-object-filename '(li1)))
  (not (library-object-filename '(li2)))
  (not (library-object-filename '(li2 ((>= 5)))))
  (not (library-object-filename '(li2 (7 (>= 1)))))
  (error? (library-exports '(li2 (6))))
  (set-equal?
    (library-requirements '(li1))
    '((chezscheme)))
  (set-equal?
    (library-requirements '(li2 ((>= 7))))
    '((rnrs (6)) (li1 (3 4 5))))
  (set-equal?
    (library-requirements '(li2))
    '((rnrs (6)) (li1 (3 4 5))))
  (set-equal?
    (library-requirements '(li2) (library-requirements-options import))
    '((rnrs (6)) (li1 (3 4 5))))
  (set-equal?
    (library-requirements '(li2) (library-requirements-options visit@visit))
    '())
  (set-equal?
    (library-requirements '(li2) (library-requirements-options invoke@visit))
    '((li1 (3 4 5))))
  (set-equal?
    (library-requirements '(li2) (library-requirements-options invoke))
    '((li1 (3 4 5))))
  (error? (library-requirements '(li2 (6))))
  (set-equal?
    (library-requirements '(li2a))
    '((rnrs (6)) (li1 (3 4 5))))
  (set-equal?
    (library-requirements '(li2a) (library-requirements-options import))
    '((rnrs (6)) (li1 (3 4 5))))
  (set-equal?
    (library-requirements '(li2a) (library-requirements-options visit@visit))
    '())
  (set-equal?
    (library-requirements '(li2a) (library-requirements-options invoke@visit))
    '((li1 (3 4 5))))
  (set-equal?
    (library-requirements '(li2a) (library-requirements-options invoke))
    '())
  (equal?
    (let ()
      (import (li1) (li2))
      (list x y z w))
    '(3 4 7 8))
 ; make sure requirements haven't changed just because we used the exports
  (set-equal?
    (library-requirements '(li1))
    '((chezscheme)))
  (set-equal?
    (library-requirements '(li2))
    '((rnrs (6)) (li1 (3 4 5))))
  (begin
    (define-syntax $li-a
      (syntax-rules ()
        [(_ name a p)
         (begin
           (library name (export a y) (import (rnrs))
             (define-syntax a (identifier-syntax (cons y 1)))
             (define y 'hello))
           (define p (lambda () (import name) y)))]))
    ($li-a ($li-spam) q $li-get-y)
    #t)
  (eq? ($li-get-y) 'hello)
  (equal? (let () (import ($li-spam)) q) '(hello . 1))
  (eqv? (let ([y 75]) (import ($li-spam)) y) 75)
  (begin
    (with-output-to-file "testfile-li3.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-li3)
             (export x)
             (import (rnrs))
             (define x 3))))
      'replace)
    (with-output-to-file "testfile-li4.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-li4)
             (export x)
             (import (rnrs))
             (define x 3))))
      'replace)
    (with-output-to-file "testfile-li5.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-li5)
             (export x)
             (import (rnrs))
             (define x 3))))
      'replace)
    (separate-compile 'li5)
    #t)
  (equal?
    (parameterize ([compile-imported-libraries #t])
      (eval '(let () (import (testfile-li3)) x))
      (library-object-filename '(testfile-li3)))
    "testfile-li3.so")
  (equal?
    (parameterize ([compile-imported-libraries #f])
      (eval '(let () (import (testfile-li4)) x))
      (library-object-filename '(testfile-li4)))
    #f)
  (equal?
    (begin
      (eval '(let () (import (testfile-li5)) x))
      (library-object-filename '(testfile-li5)))
    "testfile-li5.so")
  (equal?
    (begin
      (load-library "testfile-li3.ss")
      (library-object-filename '(testfile-li3)))
    #f)
  (equal?
    (begin
      (load-library "testfile-li3.so")
      (library-object-filename '(testfile-li3)))
    "testfile-li3.so")
)

(mat rnrs-eval
  (begin
    (define $eval-e1 (environment '(rnrs)))
    (environment? $eval-e1))
  (error? ; variable environment not bound
    (r6rs:eval 'environment $eval-e1))
  (error? ; variable eval not bound
    (r6rs:eval 'eval $eval-e1))
  (eq? (r6rs:eval 'cons $eval-e1) cons)
  (error? ; invalid context for definition
    (r6rs:eval '(define x 4) $eval-e1))
  (error? ; invalid context for definition
    (r6rs:eval '(define foo 4) $eval-e1))
  (error? ; cannot assign cons
    (r6rs:eval '(set! cons 4) $eval-e1))
  (error? ; cannot assign foo
    (r6rs:eval '(set! foo 4) $eval-e1))
  (begin
    (with-output-to-file "testfile-eval1.ss"
      (lambda ()
        (pretty-print
          '(library (testfile-eval1)
             (export canned spam list define quote set!)
             (import (rnrs))
             (define-syntax canned
               (begin
                 (display "testfile-eval1 visit")
                 (newline)
                 (identifier-syntax tuna)))
             (define spam (lambda () (cons 'not canned)))
             (define tuna 'yummy)
             (display "testfile-eval1 invoke")
             (newline))))
      'replace)
    #t)
  (equal?
    (r6rs:eval
      '(list canned (spam))
      (environment '(testfile-eval1)))
    '(yummy (not . yummy)))
  (error? ; cons is not bound
    (r6rs:eval
      '(cons canned (spam))
      (environment '(testfile-eval1))))
  (error? ; invalid context for definition
    (r6rs:eval
      '(define foo 3)
      (environment '(testfile-eval1))))
  (error? ; cannot assign
    (r6rs:eval
      '(set! spam 3)
      (environment '(testfile-eval1))))
  (error? ; cannot assign
    (r6rs:eval
      '(set! foo 3)
      (environment '(testfile-eval1))))
  (error? ; invalid definition in immutable environment
    (let ([env (environment '(testfile-eval1))])
      (eval `(define cons ',vector) env)))
  (equal?
    (let ([env (copy-environment (environment '(testfile-eval1)))])
      (eval `(define cons ',vector) env)
      (r6rs:eval '(cons canned (spam)) env))
    '#(yummy (not . yummy)))
  (eq?
    (r6rs:eval '(let () (import (scheme)) compile)
      (environment '(only (scheme) let import)))
    compile)
)

(mat top-level-syntax-functions
  (error? (top-level-syntax "hello"))
  (error? (top-level-syntax))
  (error? (top-level-syntax 'hello 'hello))
  (error? (top-level-syntax (scheme-environment) (scheme-environment)))
  (error? (top-level-syntax? "hello"))
  (error? (top-level-syntax?))
  (error? (top-level-syntax? 'hello 'hello))
  (error? (top-level-syntax? (scheme-environment) (scheme-environment)))
  (error? (define-top-level-syntax "hello" "hello"))
  (error? (define-top-level-syntax))
  (error? (define-top-level-syntax 15))
  (error? (define-top-level-syntax 'hello 'hello 'hello))
  (error? (define-top-level-syntax (scheme-environment) (scheme-environment) (scheme-environment)))
  (error?
    (let ([e (scheme-environment)])
      (define-top-level-syntax 'p (lambda (x) "hello") e)))
  (error?
    (let ([e (copy-environment (scheme-environment) #f)])
      (define-top-level-syntax 'p void e)))
  (error?
    (let ([e (scheme-environment)])
      (top-level-syntax 'p e)))
  (and (top-level-syntax 'hopenotdefined) #t)
  (and (top-level-syntax 'cons) #t)
  (and (top-level-syntax 'scheme) #t)
  (error? (top-level-syntax 'cond (environment)))
  (top-level-syntax? 'hopenotdefined)
  (top-level-syntax? 'cons)
  (top-level-syntax? 'scheme)
  (not (top-level-syntax? 'cond (environment)))

  (top-level-syntax? 'cond)
  (procedure? (top-level-syntax 'cond))

  (begin
    (define-top-level-syntax '$tls-foo (syntax-rules () [(_ x) (x x)]))
    #t)
  (equal? ($tls-foo list) `(,list))

  (equal?
    (parameterize ([interaction-environment
                    (copy-environment (scheme-environment) #t)])
      (let ([t (syntax-rules () [(_ x y) (* x y)])])
        (eval `(define-syntax cons ',t))
        (eval '(cons 3 4))))
    12)
  (equal?
    (let ([e (environment '(only (scheme) cond))])
      (list
        (top-level-syntax? 'cond e)
        (eq? (top-level-syntax 'cond e) (top-level-syntax 'cond (scheme-environment)))
        (top-level-syntax? 'cdr e)))
    '(#t #t #f))
  (equal?
    (let ([e (copy-environment (environment) #t)])
      (let ([t1 (lambda (x) 17)] [t2 (syntax-rules () [(_ x y) (list y x)])])
        (define-top-level-syntax 'p t1 e)
        (define-top-level-syntax 'q t2 e)
        (list
          (top-level-syntax? 'p e)
          (top-level-syntax? 'q e)
          (top-level-syntax? 'r e)
          (eq? (top-level-syntax 'p e) t1)
          (eq? (top-level-syntax 'q e) t2)
          ((top-level-syntax 'p e) 'p)
          (eval '(q 3 4) e)
          (eval 'p e))))
    '(#t #t #t #t #t 17 (4 3) 17))
 )

(mat annotations
  (error? ; #f is not a string
    (make-source-file-descriptor #f
      (open-bytevector-input-port (string->utf8 "hello"))))
  (error? ; 17 is not a binary-input port
    (make-source-file-descriptor "foo" 17))
  (error? ; #<input port stdin> is not a binary-input port
    (make-source-file-descriptor "foo" (open-string-input-port "oops")))
  (error? ; #<binary input port> does not support port-position and set-port-position!
    (make-source-file-descriptor "foo"
      (make-custom-binary-input-port "foo" (lambda (bv s c) 0) #f #f #f)
      #t))
  (begin
    (define str "(ugh (if \x3b2;))")
    (define bv (string->utf8 str))
    (define ip (open-bytevector-input-port bv))
    (define sfd (make-source-file-descriptor "foo" ip #t))
    #t)
  (not (= (bytevector-length bv) (string-length str)))
  (error? ; sfd is not an sfd
    (make-source-object 'sfd 2 3))
  (error? ; two is not an exact integer
    (make-source-object sfd 'two 3))
  (error? ; three is not an exact integer
    (make-source-object sfd 2 'three))
  (error? ; bfp 3 is not between 0 and efp 2
    (make-source-object sfd 3 2))
  (error? ; bfp -7 not between 0 and efp -3
    (make-source-object sfd -7 -3))
  (error? ; bfp -7 is not between 0 and efp 3
    (make-source-object sfd -7 3))
  (error? ; bfp -7 is not between 0 and efp 3
    (make-source-object sfd -7 3 2 1))
  (error? ; one is not an exact integer
    (make-source-object sfd 1 2 'one 1))
  (error? ; one is not an exact integer
    (make-source-object sfd 1 2 1 'one))
  (error? ; zero is not an exact positive integer
    (make-source-object sfd 1 2 0 1))
  (error? ; zero is not an exact positive integer
    (make-source-object sfd 1 2 1 0))
  (error? ; bfp 3 is not between 0 and efp 2
    (make-source-object sfd 3 2 1 1))
  (begin
    (define source (make-source-object sfd 2 3))
    (define source-at-line-two (make-source-object sfd 3 5 2 1))
    #t)
  (error? ; source is not a source object
    (make-annotation #f 'source #f))
  (begin
    (define a (make-annotation '(if 3) source '(if I were a rich man)))
    (define a-at-line-two (make-annotation '(if 3) source-at-line-two '(if I were a rich man)))
    (define x (datum->syntax #'* a))
    #t)
  (source-file-descriptor? sfd)
  (not (source-file-descriptor? source))
  (source-object? source)
  (source-object? source-at-line-two)
  (not (source-object? sfd))
  (not (source-object? a))
  (annotation? a)
  (not (annotation? source))
  (error? ; #<source> is not an sfd
    (source-file-descriptor-path source))
  (error? ; #<annotation> is not an sfd
    (source-file-descriptor-checksum a))
  (error? ; #<sfd> is not a source object
    (source-object-sfd sfd))
  (error? ; #<annotation> is not a source object
    (source-object-bfp a))
  (error? ; 3 is not a source object
    (source-object-efp 3))
  (error? ; 3 is not a source object
    (source-object-line 3))
  (error? ; 3 is not a source object
    (source-object-column 3))
  (error? ; 3 is not an annotation
    (annotation-expression 3))
  (error? ; #<source> is not an annotation
    (annotation-stripped source))
  (error? ; #<sfd> is not an annotation
    (annotation-source sfd))
  (error? ; #<source> is not an annotation
    (annotation-option-set source))
  (error? ; invalid syntax
    (annotation-options . debug))
  (error? ; invalid syntax
    (annotation-options 3 profile))
  (error? ; invalid option
    (annotation-options fig))
  (error? ; invalid option
    (annotation-options debug fig))
  (error? ; invalid option
    (annotation-options fig profile))
  (equal?
    (source-file-descriptor-path sfd)
    "foo")
  (number? (source-file-descriptor-checksum sfd))
  (eq? (source-object-sfd source) sfd)
  (eq? (source-object-bfp source) 2)
  (eq? (source-object-efp source) 3)
  (eq? (source-object-line source) #f)
  (eq? (source-object-column source) #f)
  (eq? (source-object-sfd source) sfd)
  (eq? (source-object-bfp source-at-line-two) 3)
  (eq? (source-object-efp source-at-line-two) 5)
  (eq? (source-object-line source-at-line-two) 2)
  (eq? (source-object-column source-at-line-two) 1)
  (equal? (annotation-expression a) '(if 3))
  (eq? (annotation-source a) source)
  (equal? (annotation-stripped a) '(if I were a rich man))
  (enum-set=? (annotation-option-set a) (annotation-options debug profile))
  (enum-set=?
    (annotation-option-set (make-annotation '(if 3) source '(if I were a rich man) (annotation-options)))
    (annotation-options))
  (enum-set=?
    (annotation-option-set (make-annotation '(if 3) source '(if I were a rich man) (annotation-options debug)))
    (annotation-options debug))
  (enum-set=?
    (annotation-option-set (make-annotation '(if 3) source '(if I were a rich man) (annotation-options profile)))
    (annotation-options profile))
  (enum-set=?
    (annotation-option-set (make-annotation '(if 3) source '(if I were a rich man) (annotation-options debug profile)))
    (annotation-options debug profile))
  (enum-set=?
    (annotation-option-set (make-annotation '(if 3) source '(if I were a rich man) (annotation-options profile debug)))
    (annotation-options debug profile))
  (eq? (syntax->annotation x) a)
  (not (syntax->annotation #'(a b c)))
  (not (syntax->annotation '(a b c)))
  (not (syntax->annotation #f))
  (error? ; invalid syntax (if I were a rich man) at char 2 of foo
    (expand a))
  (error? ; invalid syntax (if I were a rich man) at line 2, char 1 of foo
    (expand a-at-line-two))
  (error? ; invalid syntax (if I were a rich man) at char 2 of foo
    (eval a))
  (error? ; invalid syntax (if I were a rich man) at char 2, char 1 of foo
    (eval a-at-line-two))
  (error? ; invalid syntax (if I were a rich man) at char 2 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* a))) foo)))
  (error? ; invalid syntax (if I were a rich man) at line 2, char 1 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* a-at-line-two))) foo)))
  (error? ; invalid syntax (if I were a rich man) at char 2 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* (make-annotation '(if 3) source '(if I were a rich man) (annotation-options debug profile))))) foo)))
  (error? ; invalid syntax (if I were a rich man) at line 2, char 1 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* (make-annotation '(if 3) source-at-line-two '(if I were a rich man) (annotation-options debug profile))))) foo)))
  (error? ; invalid syntax (if I were a rich man) at char 2 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* (make-annotation '(if 3) source '(if I were a rich man) (annotation-options debug))))) foo)))
  (error? ; invalid syntax (if I were a rich man)
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* (make-annotation '(if 3) source '(if I were a rich man) (annotation-options profile))))) foo)))
  (error? ; invalid syntax (if I were a rich man)
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* (make-annotation '(if 3) source '(if I were a rich man) (annotation-options))))) foo)))
  (error? ; invalid argument count in call (f) at char 2 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* `(let ([f (lambda (x) x)]) ,(make-annotation '(f) source '(f) (annotation-options debug profile)))))) foo)))
  (error? ; invalid argument count in call (f) at line 2, char 1 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* `(let ([f (lambda (x) x)]) ,(make-annotation '(f) source-at-line-two '(f) (annotation-options debug profile)))))) foo)))
  (error? ; invalid argument count in call (f) at char 2 of foo
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* `(let ([f (lambda (x) x)]) ,(make-annotation '(f) source '(f) (annotation-options debug)))))) foo)))
  (error? ; invalid argument count in call (f)
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* `(let ([f (lambda (x) x)]) ,(make-annotation '(f) source '(f) (annotation-options profile)))))) foo)))
  (error? ; invalid argument count in call (f)
    (eval '(let () (define-syntax foo (lambda (z) (datum->syntax #'* `(let ([f (lambda (x) x)]) ,(make-annotation '(f) source '(f) (annotation-options)))))) foo)))
  (begin
    (profile-clear)
    #t)
  (begin
    (define foo
      (parameterize ([compile-profile #t] [current-eval compile])
        (eval '(lambda ()
                 (define-syntax foo
                   (lambda (z)
                     (datum->syntax #'*
                       (make-annotation
                         `(,(make-annotation '+ (make-source-object sfd 2 3) '+ (annotation-options debug profile))
                            ,(make-annotation '3 (make-source-object sfd 4 5) '3 (annotation-options))
                            ,(make-annotation '44 (make-source-object sfd 8 10) '44 (annotation-options debug)))
                         (make-source-object sfd 1 11)
                         '(+ 3 44)
                         (annotation-options profile)))))
                 foo))))
    #t)
  (equal? (foo) 47)
  (equal?
    (let ([ls (profile-dump-list)])
      (vector
        (find (lambda (x) (equal? (list-head (cdr x) 3) '("foo" 1 11))) ls)
        (find (lambda (x) (equal? (list-head (cdr x) 3) '("foo" 2 3))) ls)
        (find (lambda (x) (equal? (list-head (cdr x) 3) '("foo" 4 5))) ls)
        (find (lambda (x) (equal? (list-head (cdr x) 3) '("foo" 8 10))) ls)))
    '#((1 "foo" 1 11 #f #f)
       (1 "foo" 2 3 #f #f)
       #f
       #f))
  (begin
    (profile-clear)
    #t)
  (begin
    (define ip (transcoded-port ip (native-transcoder)))
    (define-values (x fp) (get-datum/annotations ip sfd 0))
    #t)
  (error? ; #<sfd> is not a textual input port
    (get-datum/annotations sfd sfd 0))
  (error? ; #<input port> is not an sfd
    (get-datum/annotations ip ip 0))
  (error? ; #<sfd> is not a valid file position
    (get-datum/annotations ip sfd sfd))
  (error? ; -5 is not a valid file position
    (get-datum/annotations ip sfd -5))
  (error? ; 5.0 is not a valid file position
    (get-datum/annotations ip sfd 5.0))
  (eqv? fp (string-length str))
  (annotation? x)
  (equal? (annotation-stripped x) (with-input-from-string str read))
  (equal?
    (let f ([x x])
      (and (annotation? x)
           (let ([x (annotation-expression x)])
             (if (list? x)
                 (map f x)
                 x))))
    (with-input-from-string str read))
  (begin
    (define source (annotation-source x))
    #t)
  (source-object? source)
  (eq? (source-object-sfd source) sfd)
  (eqv? (source-object-bfp source) 0)
  (eqv? (source-object-efp source) (string-length str))
  (error? ; not a string
    (source-file-descriptor 'spam 0))
  (error? ; not an exact nonnegative integer
    (source-file-descriptor "spam" -1))
  (error? ; not an exact nonnegative integer
    (source-file-descriptor "spam" 1.0))
  (source-file-descriptor? (source-file-descriptor "spam" #x34534a5))
  (source-file-descriptor? (source-file-descriptor "spam" #x20333333333339999999997834443333337))
  (equal?
    (source-file-descriptor-path (source-file-descriptor "spam" #x20333333333339999999997834443333337))
    "spam")
  (equal?
    (source-file-descriptor-checksum (source-file-descriptor "spam" #x20333333333339999999997834443333337))
    #x20333333333339999999997834443333337)
  (error? ; not an sfd
    (locate-source "spam" 17))
  (error? ; not an exact nonnegative integer
    (locate-source sfd -1))
  (error? ; not an exact nonnegative integer
    (locate-source sfd 'a))
  (let-values ([() (locate-source sfd 7)]) #t)
  (begin
    (with-output-to-file "testfile.ss"
      (lambda ()
        (printf "; bogus exports\n")
        (printf "(module (a 3)\n")
        (printf "  (define a 3))\n"))
      'replace)
    #t)
  (equal?
    (guard (c [(syntax-violation? c)
               (let* ([form (syntax-violation-form c)]
                      [annotation (syntax->annotation form)]
                      [source (annotation-source annotation)])
                 (cons
                   (call-with-values (lambda () (locate-source (source-object-sfd source) (source-object-bfp source))) vector)
                   (call-with-values (lambda () (locate-source (source-object-sfd source) (source-object-efp source))) vector)))])
      (load "testfile.ss"))
    '(#("testfile.ss" 2 12) . #("testfile.ss" 2 13)))
  (equal?
    (let ([sfd (source-file-descriptor (source-file-descriptor-path sfd) (source-file-descriptor-checksum sfd) )])
      (let ([source (make-source-object sfd 2 3)])
        (guard (c [(syntax-violation? c)
                   (let* ([form (syntax-violation-form c)]
                          [annotation (syntax->annotation form)]
                          [source (annotation-source annotation)])
                     (cons
                       (call-with-values (lambda () (locate-source (source-object-sfd source) (source-object-bfp source))) vector)
                       (call-with-values (lambda () (locate-source (source-object-sfd source) (source-object-efp source))) vector)))])
          (load "testfile.ss"))))
    '(#("testfile.ss" 2 12) . #("testfile.ss" 2 13)))

  (error? ; not a source object
   (locate-source-object-source "spam" #t #t))
  (error?
   (current-locate-source-object-source 7))
  (error?
   (current-locate-source-object-source "string"))
  (error? ; not a source object
   ((current-locate-source-object-source) "spam" #t #t))
  (error? ; invalid syntax (if I were a rich man) at line 200, char 17 of foo
   (parameterize ([current-locate-source-object-source
                   (lambda (src start? cache?)
                     (values (source-file-descriptor-path (source-object-sfd src)) 200 17))])
     (expand a)))
 )

(mat annotations-via-recorded-lines
  (error?
   (current-make-source-object 7))
  (error?
   (current-make-source-object "string"))
  (begin
    (define sfd-with-lines
      (let ((op (open-output-file "testfile.ss" 'replace)))
        (display "apple\n  banana\ncoconut" op)
        (close-port op)
        (let* ([ip (open-file-input-port "testfile.ss")]
               [sfd (make-source-file-descriptor "testfile.ss" ip)])
          (close-port ip)
          sfd)))
    (define input-string-with-lines "Apple\n  Banana\nCoconut\nMore")
    (define input-port-with-lines (open-string-input-port input-string-with-lines))
    (define input-port-with-line-pos 0)
    (define (make-make-source-object/get-lines expected-sfd)
      (lambda (sfd bfp efp)
        (if (eq? sfd expected-sfd)
            ;; Gather line and column now:
            (let-values ([(path line col) (locate-source sfd bfp #t)])
              (make-source-object sfd bfp efp line col))
            (error 'recording-make-source-object "reading some other file?"))))
    (define (read-with-lines)
      (parameterize ([current-make-source-object (make-make-source-object/get-lines sfd-with-lines)])
        (let-values ([(v pos) (get-datum/annotations input-port-with-lines sfd-with-lines input-port-with-line-pos)])
          (set! input-port-with-line-pos pos)
          v)))
    #t)
  (begin
    (define line-one (read-with-lines))
    (annotation? line-one))
  (equal? (annotation-stripped line-one) 'Apple)
  (equal? (source-object-bfp (annotation-source line-one)) 0)
  (equal? (source-object-line (annotation-source line-one)) 1)
  (equal? (source-object-column (annotation-source line-one)) 1)
  (begin
    (define line-two (read-with-lines))
    (annotation? line-two))
  (equal? (source-object-bfp (annotation-source line-two)) 8)
  (equal? (source-object-line (annotation-source line-two)) 2)
  (equal? (source-object-column (annotation-source line-two)) 3)
  (begin
    (define line-three (read-with-lines))
    (annotation? line-three))
  (equal? (source-object-bfp (annotation-source line-three)) 15)
  (equal? (source-object-line (annotation-source line-three)) 3)
  (equal? (source-object-column (annotation-source line-three)) 1)
  (annotation? (read-with-lines)) ; 'More
  (eof-object? (read-with-lines))

  ;; Make sure lines are calculated right with input that is longer than
  ;; the file buffer size:
  (begin
    (define input-string-with-lines (string-append
                                     "\""
                                     (make-string (* 2 (file-buffer-size)) #\a)
                                     "\""
                                     "\nend"))
    
    (define input-port-with-lines (open-string-input-port input-string-with-lines))
    (define sfd-with-lines
      (let ((op (open-output-file "testfile.ss" 'replace)))
        (display input-string-with-lines op)
        (close-port op)
        (let* ([ip (open-file-input-port "testfile.ss")]
               [sfd (make-source-file-descriptor "testfile.ss" ip)])
          (close-port ip)
          sfd)))
    (define input-port-with-line-pos 0)
    (define (read-with-lines)
      (parameterize ([current-make-source-object (make-make-source-object/get-lines sfd-with-lines)])
        (let-values ([(v pos) (get-datum/annotations input-port-with-lines sfd-with-lines input-port-with-line-pos)])
          (set! input-port-with-line-pos pos)
          v)))
    (define line-one (read-with-lines))
    (annotation? line-one))
  (string? (annotation-stripped line-one))
  (begin
    (define line-two (read-with-lines))
    (annotation? line-two))
  (equal? (source-object-line (annotation-source line-two)) 2)
  (equal? (source-object-column (annotation-source line-two)) 1)
  )

(mat locate-source-caching
  (begin
   (define (make-expr n)
     `(let ()
        ,@(let loop ([i n])
            (if (zero? i)
                '(#t)
                (cons
                 `(let-values ([(x y z) (values 1 2 3)]) x)
                 (loop (sub1 i)))))))

   (define (time-expr n)
     (with-output-to-file "testfile.ss"
       (lambda ()
         (pretty-print (make-expr n)))
       'truncate)
     (collect)
     (parameterize ([collect-request-handler void])
       (let ([start (current-time)])
         (load "testfile.ss" expand)
         (let ([delta (time-difference (current-time) start)])
           (+ (* #e1e9 (time-second delta))
              (time-nanosecond delta))))))

   (let loop ([tries 3])
     (when (zero? tries)
       (error 'source-cache-test "loading lots of `let-values` forms seems to take too long"))
     (let ([t1000 (time-expr 1000)] [t10000 (time-expr 10000)])
       (or (> (* 20 t1000) t10000)
         (begin
           (printf "t1000 = ~s, t10000 = ~s, t10000 / t1000 = ~s\n" t1000 t10000 (inexact (/ t10000 t1000)))
           (loop (sub1 tries)))))))

  (begin
    (define sfd-to-cache
      (let ((op (open-output-file "testfile.ss" 'replace)))
        (display "apple\n  banana\ncoconut" op)
        (close-port op)
        (let* ([ip (open-file-input-port "testfile.ss")]
               [sfd (make-source-file-descriptor "testfile.ss" ip)])
          (close-port ip)
          sfd)))

    (equal? (call-with-values
             (lambda () (locate-source sfd-to-cache 8 #t))
             (case-lambda
              [(name line col) (list line col)]))
            '(2 3)))

  (begin
    (let ((op (open-output-file "testfile.ss" 'replace)))
      (display "1\n2\n3\n4\n5\n6789" op)
      (close-port op))
    ;; Cache may report the old source line,
    ;; or uncached should report no line:
    (equal? (call-with-values
             (lambda () (locate-source sfd-to-cache 8 #t))
             (case-lambda
              [() '(2 3)] ; report no line same as expected cache
              [(name line col) (list line col)]))
            '(2 3)))

  ;; An uncached lookup defniitely reports no line:
  (equal? (call-with-values
            (lambda () (locate-source sfd-to-cache 8 #f))
            (lambda () 'none))
          'none)

  (begin
    (collect (collect-maximum-generation))
    ;; After collecting the maximum generation, the
    ;; cached information should definitely be gone:
    (equal? (call-with-values
             (lambda () (locate-source sfd-to-cache 8 #t))
             (lambda () 'gone))
            'gone))
  )

(mat include
  (error? ; invalid syntax
    (expand '(include spam)))
  (error? ; invalid syntax
    (parameterize ([source-directories '("../s" "../c")])
      (expand '(include spam))))
 )

(mat extend-syntax
   (begin (extend-syntax (foo)
             [(foo a b) (list a b)])
          #t)
   (equal? (foo 3 4) '(3 4))
   (begin (extend-syntax (foo bar)
             [(foo) '()]
             [(foo (bar x)) x]
             [(foo x) (cons x '())]
             [(foo x y ...) (cons x (foo y ...))])
          #t)
   (equal? (foo 'a 'b 'c 'd) '(a b c d))
   (equal? (foo 'a 'b 'c (bar 'd)) '(a b c . d))
   (begin (extend-syntax (foo)
             [(foo ((x v) ...) e1 e2 ...)
              (andmap symbol? '(x ...))
              ((lambda (x ...) e1 e2 ...) v ...)]
             [(foo ((lambda (x ...) e1 e2 ...) v ...))
              (= (length '(x ...)) (length '(v ...)))
               (foo ((x v) ...) e1 e2 ...)])
          #t)
   (equal? (foo ((a 3) (b 4)) (cons a b)) '(3 . 4))
   (error? (extend-syntax (foo ...) [(foo ...) 0]))
   (error? (extend-syntax (foo) [(foo x ... y) 0]))
   (error? (extend-syntax (foo) [(foo x . ...) 0]))
   (error? (extend-syntax (foo) [(foo (...)) 0]))
   (error? (extend-syntax (foo) [(foo x x) 0]))
   (begin (extend-syntax (foo) [(foo foo) 0]) #t)
   (begin (extend-syntax (foo) [(foo keys) (with ([x `,'keys]) 'x)])
          (equal? (foo (a b c)) '(a b c)))
   (begin (extend-syntax (foo) [(foo x y) '`(x ,@y)])
          (equal? (foo a b) '`(a ,@b)))
   (begin (extend-syntax (foo) ; test exponential "with" time problem
             [(foo)
              (with ([a1 1] [b1 2] [c1 3] [d1 4] [e1 5] [f1 6] [g1 7] [h1 8]
                     [a2 1] [b2 2] [c2 3] [d2 4] [e2 5] [f2 6] [g2 7] [h2 8]
                     [a3 1] [b3 2] [c3 3] [d3 4] [e3 5] [f3 6] [g3 7] [h3 8]
                     [a4 1] [b4 2] [c4 3] [d4 4] [e4 5] [f4 6] [g4 7] [h4 8]
                     [a5 1] [b5 2] [c5 3] [d5 4] [e5 5] [f5 6] [g5 7] [h5 8]
                     [a6 1] [b6 2] [c6 3] [d6 4] [e6 5] [f6 6] [g6 7] [h6 8]
                     [a7 1] [b7 2] [c7 3] [d7 4] [e7 5] [f7 6] [g7 7] [h7 8]
                     [a8 1] [b8 2] [c8 3] [d8 4] [e8 5] [f8 6] [g8 7] [h8 8])
                 '(a1 b2 c3 d4 e5 f6 g7 h8))])
      (equal? (foo) '(1 2 3 4 5 6 7 8)))
   (equal? (letrec* ((x 3) (y (+ x 2))) (list x y)) '(3 5))
 )

(mat with
   (begin (extend-syntax (foo)
             [(foo x ...)
              (with ([n (length '(x ...))])
                 (list n 'x ...))])
          #t)
   (equal? (foo 3 2 1) '(3 3 2 1))
   (begin (extend-syntax (foo)
             [(foo (x ...) ...)
              (list (with ([(y ...)
                            '(x ... (with ([n (length '(x ...))]) n))])
                       (with ([(z ...) (reverse '(y ...))])
                          (list 'z ...)))
                    ...)])
          #t)
   (equal? (foo) '())
   (equal? (foo (a b) (c d e)) '((2 b a) (3 e d c)))
   (begin (extend-syntax (foo)
             [(foo x ...)
              (with ([(y1 y2 ...) '(x ...)])
                 (with ([(z1 z2) 'y1])
                    '(z2 z1)))])
          #t)
   (equal? (foo (a b) (c d) (e f)) '(b a))
 )