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, 118 insertions, 116 deletions

diff --git a/csc/codegen-test.csc b/csc/codegen-test.csc
index 03f6b11..ef1c88b 100644
--- a/csc/codegen-test.csc
+++ b/csc/codegen-test.csc
@@ -1,130 +1,132 @@
-(import (scheme base)
-        (only (csc gensym)
-          gensym)
-        (only (csc ir2)
-          *globals*
-          make-apply
-          make-branch
-          make-closure
-          make-constant
-          make-fix
-          make-label
-          make-library-ref
-          make-primitive
-          make-variable)
-        (only (csc loop)
-          loop
-          return)
-        (only (csc match)
-          match)
-        (only (csc testing)
-          assert-equal
-          test)
-        (csc codegen))
+(define-library (csc codegen-test)
+  (import (scheme base)
+          (only (csc gensym)
+            gensym)
+          (only (csc ir2)
+            *globals*
+            make-apply
+            make-branch
+            make-closure
+            make-constant
+            make-fix
+            make-label
+            make-library-ref
+            make-primitive
+            make-variable)
+          (only (csc loop)
+            loop
+            return)
+          (only (csc match)
+            match)
+          (only (csc testing)
+            assert-equal
+            test)
+          (csc codegen))
+  (begin
 
 
-(define (test-var)
-  (make-variable (gensym)))
+    (define (test-var)
+      (make-variable (gensym)))
 
 
-(define (test-label)
-  (make-label (gensym)))
+    (define (test-label)
+      (make-label (gensym)))
 
 
-(test codegen-apply
-  (define p (test-var))
-  (assert-equal
-    '((label init)
-      (peek (local 1) (local 0) (const 5))
-      (mov (local 2) (local 1))
-      (mov (local 1) (const 10))
-      (jmp (local 2)))
-    (ir2->ir3
-      (make-fix '()
-        (make-primitive 'peek (list *globals* (make-constant 5)) (list p)
-          (make-apply p (list (make-constant 10))))))))
+    (test codegen-apply
+      (define p (test-var))
+      (assert-equal
+        '((label init)
+          (peek (local 1) (local 0) (const 5))
+          (mov (local 2) (local 1))
+          (mov (local 1) (const 10))
+          (jmp (local 2)))
+        (ir2->ir3
+          (make-fix '()
+            (make-primitive 'peek (list *globals* (make-constant 5)) (list p)
+              (make-apply p (list (make-constant 10))))))))
 
 
-(test codegen-call-global
-  (define p (test-var))
-  (assert-equal
-    '((label init)
-      (peek (local 1) (local 0) (global cons (csc based)))
-      (mov (local 3) (local 1))
-      (mov (local 1) (const 5))
-      (mov (local 2) (const ()))
-      (jmp (local 3)))
-    (ir2->ir3
-      (make-fix '()
-        (make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p)
-          (make-apply p (list (make-constant 5) (make-constant '()))))))))
+    (test codegen-call-global
+      (define p (test-var))
+      (assert-equal
+        '((label init)
+          (peek (local 1) (local 0) (global cons (csc based)))
+          (mov (local 3) (local 1))
+          (mov (local 1) (const 5))
+          (mov (local 2) (const ()))
+          (jmp (local 3)))
+        (ir2->ir3
+          (make-fix '()
+            (make-primitive 'peek (list *globals* (make-library-ref 'cons '(csc based))) (list p)
+              (make-apply p (list (make-constant 5) (make-constant '()))))))))
 
 
-(test codegen-call-known
-  (define f (test-label))
-  (define ret (test-var))
-  (assert-equal
-    '((label 0)
-      (mov (local 2) (local 1))
-      (jmp (local 2))
-      (label init)
-      (mov (local 1) (label 0))
-      (jmp (label 0)))
-    (ir2->ir3
-      (make-fix
-        (list (make-closure f (list ret)
-                (make-apply ret (list ret))))
-        (make-apply f (list f))))))
+    (test codegen-call-known
+      (define f (test-label))
+      (define ret (test-var))
+      (assert-equal
+        '((label 0)
+          (mov (local 2) (local 1))
+          (jmp (local 2))
+          (label init)
+          (mov (local 1) (label 0))
+          (jmp (label 0)))
+        (ir2->ir3
+          (make-fix
+            (list (make-closure f (list ret)
+                    (make-apply ret (list ret))))
+            (make-apply f (list f))))))
 
 
-(test codegen-permute
-  (define f (test-label))
-  (define g (test-label))
-  (define f1 (test-var))
-  (define f2 (test-var))
-  (define g1 (test-var))
-  (define g2 (test-var))
-  (define g3 (test-var))
-  (assert-equal
-    '((label 0)
-      (mov (local 127) (local 1))
-      (mov (local 1) (local 2))
-      (mov (local 2) (local 127))
-      (mov (local 3) (const 0))
-      (jmp (label 1))
-      (label 1)
-      (mov (local 2) (local 1))
-      (mov (local 1) (local 3))
-      (jmp (label 0))
-      (label init)
-      (mov (local 1) (const 0))
-      (mov (local 2) (const 1))
-      (jmp (label 0)))
-    (ir2->ir3
-      (make-fix
-        (list (make-closure f (list f1 f2)
-                (make-apply g (list f2 f1 (make-constant 0))))
-              (make-closure g (list g1 g2 g3)
-                (make-apply f (list g3 g1))))
-        (make-apply f (list (make-constant 0) (make-constant 1)))))))
+    (test codegen-permute
+      (define f (test-label))
+      (define g (test-label))
+      (define f1 (test-var))
+      (define f2 (test-var))
+      (define g1 (test-var))
+      (define g2 (test-var))
+      (define g3 (test-var))
+      (assert-equal
+        '((label 0)
+          (mov (local 127) (local 1))
+          (mov (local 1) (local 2))
+          (mov (local 2) (local 127))
+          (mov (local 3) (const 0))
+          (jmp (label 1))
+          (label 1)
+          (mov (local 2) (local 1))
+          (mov (local 1) (local 3))
+          (jmp (label 0))
+          (label init)
+          (mov (local 1) (const 0))
+          (mov (local 2) (const 1))
+          (jmp (label 0)))
+        (ir2->ir3
+          (make-fix
+            (list (make-closure f (list f1 f2)
+                    (make-apply g (list f2 f1 (make-constant 0))))
+                  (make-closure g (list g1 g2 g3)
+                    (make-apply f (list g3 g1))))
+            (make-apply f (list (make-constant 0) (make-constant 1)))))))
 
 
-(test codegen-branch
-  (define p (test-var))
-  (assert-equal
-    '((label init)
-      (peek (local 1) (local 0) (const 1))
-      (jmpif (const #t) (label 0))
-      (mov (local 2) (local 1))
-      (mov (local 1) (const 10))
-      (jmp (local 2))
-      (label 0)
-      (mov (local 2) (local 1))
-      (mov (local 1) (const 5))
-      (jmp (local 2)))
-    (ir2->ir3
-      (make-fix '()
-        (make-primitive 'peek (list *globals* (make-constant 1)) (list p)
-          (make-branch (make-constant #t)
-            (make-apply p (list (make-constant 5)))
-            (make-apply p (list (make-constant 10)))))))))
+    (test codegen-branch
+      (define p (test-var))
+      (assert-equal
+        '((label init)
+          (peek (local 1) (local 0) (const 1))
+          (jmpif (const #t) (label 0))
+          (mov (local 2) (local 1))
+          (mov (local 1) (const 10))
+          (jmp (local 2))
+          (label 0)
+          (mov (local 2) (local 1))
+          (mov (local 1) (const 5))
+          (jmp (local 2)))
+        (ir2->ir3
+          (make-fix '()
+            (make-primitive 'peek (list *globals* (make-constant 1)) (list p)
+              (make-branch (make-constant #t)
+                (make-apply p (list (make-constant 5)))
+                (make-apply p (list (make-constant 10)))))))))))