Modify the project structure.

Now the lib directory contains what will eventually end up on the
user's /usr/lib/csc. When I write make install, it will copy all of
the .csc files from lib into the destination lib directory. This means I
can start working on the standard library in lib/scheme.

1 files changed, 294 insertions, 0 deletions

diff --git a/lib/csc/macros-test.csc b/lib/csc/macros-test.csc
new file mode 100644
index 0000000..531e3e2
--- /dev/null
+++ b/lib/csc/macros-test.csc
@@ -0,0 +1,294 @@
+(define-library (csc macros-test)
+  (import (scheme base)
+          (only (csc gensym)
+            gensym
+            gensym?)
+          (only (csc ir1)
+            %call
+            %call-builtin
+            %constant
+            %define-syntax
+            %if
+            %lambda
+            %letrec
+            %lexical-ref
+            %lexical-set
+            %library-define
+            %library-ref
+            %sequence
+            call-builtin?
+            call?
+            constant?
+            define-syntax?
+            if?
+            lambda?
+            letrec?
+            lexical-ref-name
+            lexical-ref?
+            lexical-set-expression
+            lexical-set?
+            library-define?
+            library-ref?
+            make-call-builtin
+            make-constant
+            make-define-syntax
+            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 call-builtin? %call-builtin)
+        (cons sequence? %sequence)
+        (cons lambda? %lambda)
+        (cons letrec? %letrec)
+        (cons gensym? (lambda (x) 'gensym))
+        (cons macro-transformer? (lambda (x) 'transformer))))
+
+
+    (test builtin-quote
+      (assert-equal
+        (make-constant '(test 1 2 3))
+        (expand-body 'main
+          '((quote (test 1 2 3)))
+          builtins-environment)
+        transform-ir1))
+
+
+    (test builtin-syntax-rules-literal
+      (assert-equal
+        (make-constant 1)
+        (expand-body 'main
+          '((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-body 'main
+          '((let-syntax
+              (foo
+                (syntax-rules ()
+                  ((foo _) 0)))
+              (foo ignored)))
+          builtins-environment)
+        transform-ir1))
+
+
+    (test builtin-syntax-rules-substitution
+      (assert-equal
+        (make-constant 5)
+        (expand-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((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-body 'main
+          '((let-syntax
+              (foo
+                (syntax-rules ::: ()
+                  ((foo x :::) (x :::))))
+              (foo quote 5)))
+          builtins-environment)
+        transform-ir1))
+
+
+    (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-body 'main
+          '((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-body 'main
+          '((lambda (x)
+              (builtin-define a (quote 6))
+              (builtin-define b a)
+              (quote 7)))
+          builtins-environment)
+        transform-ir1))
+
+
+    (test builtin-define-syntax
+      (assert-equal
+        (make-sequence
+          (make-define-syntax 'five 'transformer)
+          (make-constant 5))
+        (expand-body 'main
+          '((define-syntax five
+              (syntax-rules ()
+                ((five _) 5)))
+            (five 6))
+          builtins-environment)
+        transform-ir1))
+
+
+    (test builtin-call-builtin
+      (assert-equal
+        (make-call-builtin 'bbb (list (make-constant 5)))
+        (expand-body 'main
+          '((call-builtin bbb 5))
+          builtins-environment)
+        transform-ir1))))