Fix a potential R7RS issue.

I was using the load procedure to load a program, but by a strict
reading of R7RS, load can only handle expressions and definitions, not
imports. So instead I'm defining each test as a library, and using the
environment procedure to load them at runtime.

1 files changed, 229 insertions, 227 deletions

diff --git a/csc/macros-test.csc b/csc/macros-test.csc
index b2e2f3f..e4451e7 100644
--- a/csc/macros-test.csc
+++ b/csc/macros-test.csc
@@ -1,261 +1,263 @@
-(import (scheme base)
-        (only (csc gensym)
-          gensym
-          gensym?)
-        (only (csc ir1)
-          %call
-          %constant
-          %define-syntax
-          %if
-          %lambda
-          %letrec
-          %lexical-ref
-          %lexical-set
-          %library-define
-          %library-ref
-          %sequence
-          call?
-          constant?
-          define-syntax?
-          if?
-          lambda?
-          letrec?
-          lexical-ref-name
-          lexical-ref?
-          lexical-set-expression
-          lexical-set?
-          library-define?
-          library-ref?
-          make-constant
-          make-lambda
-          make-letrec
-          make-lexical-ref
-          make-library-ref
-          make-sequence
-          sequence?)
-        (only (csc testing)
-          assert-equal
-          test)
-        (csc macros))
+(define-library (csc macros-test)
+  (import (scheme base)
+          (only (csc gensym)
+            gensym
+            gensym?)
+          (only (csc ir1)
+            %call
+            %constant
+            %define-syntax
+            %if
+            %lambda
+            %letrec
+            %lexical-ref
+            %lexical-set
+            %library-define
+            %library-ref
+            %sequence
+            call?
+            constant?
+            define-syntax?
+            if?
+            lambda?
+            letrec?
+            lexical-ref-name
+            lexical-ref?
+            lexical-set-expression
+            lexical-set?
+            library-define?
+            library-ref?
+            make-constant
+            make-lambda
+            make-letrec
+            make-lexical-ref
+            make-library-ref
+            make-sequence
+            sequence?)
+          (only (csc testing)
+            assert-equal
+            test)
+          (csc macros))
+  (begin
 
 
-(define transform-ir1
-  (list
-    (cons constant? %constant)
-    (cons lexical-ref? %lexical-ref)
-    (cons library-ref? %library-ref)
-    (cons lexical-set? %lexical-set)
-    (cons library-define? %library-define)
-    (cons define-syntax? %define-syntax)
-    (cons if? %if)
-    (cons call? %call)
-    (cons sequence? %sequence)
-    (cons lambda? %lambda)
-    (cons letrec? %letrec)
-    (cons gensym? (lambda (x) 'gensym))))
+    (define transform-ir1
+      (list
+        (cons constant? %constant)
+        (cons lexical-ref? %lexical-ref)
+        (cons library-ref? %library-ref)
+        (cons lexical-set? %lexical-set)
+        (cons library-define? %library-define)
+        (cons define-syntax? %define-syntax)
+        (cons if? %if)
+        (cons call? %call)
+        (cons sequence? %sequence)
+        (cons lambda? %lambda)
+        (cons letrec? %letrec)
+        (cons gensym? (lambda (x) 'gensym))))
 
 
-(test builtin-quote
-  (assert-equal
-    (make-constant '(test 1 2 3))
-    (expand '(quote (test 1 2 3)) builtins-environment)
-    transform-ir1))
+    (test builtin-quote
+      (assert-equal
+        (make-constant '(test 1 2 3))
+        (expand '(quote (test 1 2 3)) builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-literal
-  (assert-equal
-    (make-constant 1)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules (a b)
-             ((foo a)
-               0)
-             ((foo b)
-               1)))
-         (foo b))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-literal
+      (assert-equal
+        (make-constant 1)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules (a b)
+                 ((foo a)
+                   0)
+                 ((foo b)
+                   1)))
+             (foo b))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-underscore
-  (assert-equal
-    (make-constant 0)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo _) 0)))
-         (foo ignored))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-underscore
+      (assert-equal
+        (make-constant 0)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo _) 0)))
+             (foo ignored))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-substitution
-  (assert-equal
-    (make-constant 5)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo x) x)))
-         (foo 5))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-substitution
+      (assert-equal
+        (make-constant 5)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo x) x)))
+             (foo 5))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-nil
-  (assert-equal
-    (make-constant 1)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo x) 0)
-             ((foo) 1)))
-         (foo))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-nil
+      (assert-equal
+        (make-constant 1)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo x) 0)
+                 ((foo) 1)))
+             (foo))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-improper-list
-  (assert-equal
-    (make-constant 1)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo a . b) a)))
-         (foo 1 2 3))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-improper-list
+      (assert-equal
+        (make-constant 1)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo a . b) a)))
+             (foo 1 2 3))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-quoted
-  (assert-equal
-    (make-constant 'a)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo x) (quote x))))
-         (foo a))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-quoted
+      (assert-equal
+        (make-constant 'a)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo x) (quote x))))
+             (foo a))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-constant
-  (assert-equal
-    (make-constant 2)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo "abc") 0)
-             ((foo "def") 1)
-             ((foo "ghi") 2)))
-         (foo "ghi"))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-constant
+      (assert-equal
+        (make-constant 2)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo "abc") 0)
+                 ((foo "def") 1)
+                 ((foo "ghi") 2)))
+             (foo "ghi"))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-ellipsis
-  (assert-equal
-    (make-constant 5)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo x ...) (x ...))))
-         (foo quote 5))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-ellipsis
+      (assert-equal
+        (make-constant 5)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo x ...) (x ...))))
+             (foo quote 5))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-ellipsis-improper
-  (assert-equal
-    (make-constant 5)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ()
-             ((foo x ... . y) (x ... y))))
-         (foo quote . 5))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-ellipsis-improper
+      (assert-equal
+        (make-constant 5)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ()
+                 ((foo x ... . y) (x ... y))))
+             (foo quote . 5))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-ellipsis-zip
-  (assert-equal
-    (make-constant '((1 . 3) (2 . 4)))
-    (expand
-      '(builtin-let-syntax
-         (zip
-           (syntax-rules ()
-             ((zip (x ...) (y ...))
-               (quote ((x . y) ...)))))
-         (zip (1 2) (3 4)))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-ellipsis-zip
+      (assert-equal
+        (make-constant '((1 . 3) (2 . 4)))
+        (expand
+          '(builtin-let-syntax
+             (zip
+               (syntax-rules ()
+                 ((zip (x ...) (y ...))
+                   (quote ((x . y) ...)))))
+             (zip (1 2) (3 4)))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-ellipsis-nested
-  (assert-equal
-    (make-constant '(1 2 3 4 5))
-    (expand
-      '(builtin-let-syntax
-         (append
-           (syntax-rules ()
-             ((append (x ...) ...)
-               (quote (x ... ...)))))
-         (append (1 2) (3 4) () (5)))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-ellipsis-nested
+      (assert-equal
+        (make-constant '(1 2 3 4 5))
+        (expand
+          '(builtin-let-syntax
+             (append
+               (syntax-rules ()
+                 ((append (x ...) ...)
+                   (quote (x ... ...)))))
+             (append (1 2) (3 4) () (5)))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-syntax-rules-ellipsis-custom
-  (assert-equal
-    (make-constant 5)
-    (expand
-      '(builtin-let-syntax
-         (foo
-           (syntax-rules ::: ()
-             ((foo x :::) (x :::))))
-         (foo quote 5))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-syntax-rules-ellipsis-custom
+      (assert-equal
+        (make-constant 5)
+        (expand
+          '(builtin-let-syntax
+             (foo
+               (syntax-rules ::: ()
+                 ((foo x :::) (x :::))))
+             (foo quote 5))
+          builtins-environment)
+        transform-ir1))
 
 
-(define (test-ref sym)
-  (make-lexical-ref sym (gensym)))
+    (define (test-ref sym)
+      (make-lexical-ref sym (gensym)))
 
 
-(test builtin-lambda-rest
-  (assert-equal
-    (make-lambda (list
-                   (test-ref 'a)
-                   (test-ref 'b)
-                   (test-ref 'c))
-                 (test-ref 'd)
-                 (make-sequence (make-constant #f) (make-constant 5)))
-    (expand
-      '(lambda
-         (a b c . d) (quote 5))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-lambda-rest
+      (assert-equal
+        (make-lambda (list
+                       (test-ref 'a)
+                       (test-ref 'b)
+                       (test-ref 'c))
+                     (test-ref 'd)
+                     (make-sequence (make-constant #f) (make-constant 5)))
+        (expand
+          '(lambda
+             (a b c . d) (quote 5))
+          builtins-environment)
+        transform-ir1))
 
 
-(test builtin-case-lambda-defines
-  (assert-equal
-    (make-lambda (list (test-ref 'x)) #f
-      (make-letrec #t '(a b) (list (gensym) (gensym))
-        (list (make-constant 6)
-              (test-ref 'a))
-        (make-sequence (make-constant #f) (make-constant 7))))
-    (expand
-      '(lambda (x)
-        (builtin-define a (quote 6))
-        (builtin-define b a)
-        (quote 7))
-      builtins-environment)
-    transform-ir1))
+    (test builtin-case-lambda-defines
+      (assert-equal
+        (make-lambda (list (test-ref 'x)) #f
+          (make-letrec #t '(a b) (list (gensym) (gensym))
+            (list (make-constant 6)
+                  (test-ref 'a))
+            (make-sequence (make-constant #f) (make-constant 7))))
+        (expand
+          '(lambda (x)
+            (builtin-define a (quote 6))
+            (builtin-define b a)
+            (quote 7))
+          builtins-environment)
+        transform-ir1))))