1 files changed, 92 insertions, 14 deletions
diff --git a/csc/macros-test.csc b/csc/macros-test.csc
index 4cc8efa..6529e58 100644
--- a/csc/macros-test.csc
+++ b/csc/macros-test.csc
@@ -1,15 +1,88 @@
 (import (scheme base)
-        (only (csc ir1) make-constant)
+        (only (csc ir1)
+          constant-expression
+          constant?
+          lexical-ref-name
+          lexical-ref?
+          lexical-set-expression
+          lexical-set-name
+          lexical-set?
+          library-ref-library
+          library-ref-name
+          library-ref-public?
+          library-ref?
+          library-set-expression
+          library-set-library
+          library-set-name
+          library-set-public?
+          library-set?
+          make-constant
+          void?)
         (only (csc testing)
           assert-equal
           test)
         (csc macros))
 
 
+(define (ir1= x y)
+  (cond
+    ((and (void? x) (void? y)) #t)
+    ((and (constant? x) (constant? y))
+      (equal? (constant-expression x) (constant-expression y)))
+    ((and (lexical-ref? x) (lexical-ref? y))
+      (symbol=? (lexical-ref-name x) (lexical-ref-name y)))
+    ((and (lexical-set? x) (lexical-set? y))
+      (and
+        (symbol=? (lexical-set-name x) (lexical-set-name y))
+        (ir1= (lexical-set-expression x) (lexical-set-expression y))))
+    ((and (library-ref? x) (library-ref? y))
+      (and
+        (equal? (library-ref-library x) (library-ref-library y))
+        (symbol=? (library-ref-name x) (library-ref-name y))
+        (boolean=? (library-ref-public? x) (library-ref-public? y))))
+    ((and (library-set? x) (library-set? y))
+      (and
+        (equal? (library-set-library x) (library-set-library y))
+        (symbol=? (library-set-name x) (library-set-name y))
+        (boolean=? (library-set-public? x) (library-set-public? y))
+        (ir1=? (library-set-expression x) (library-set-expression y))))
+    ((and (toplevel-define? x) (toplevel-define? y))
+      (and
+        (symbol=? (toplevel-define-name x) (toplevel-define-name y))
+        (ir1=? (toplevel-define-expression x) (toplevel-define-expression y))))
+    ((and (if? x) (if? y))
+      (and
+        (ir1=? (if-test x) (if-test y))
+        (ir1=? (if-consequent x) (if-consequent y))
+        (ir1=? (if-alternate x) (if-alternate y))))
+    ((and (call? x) (call? y))
+      (and
+        (ir1=? (call-procedure x) (call-procedure y))
+        (apply (map ir1=? (call-arguments x) (call-arguments y))))
+    ((and (sequence? x) (sequence? y))
+      (and
+        (ir1=? (sequence-head x) (sequence-head y))
+        (ir1=? (sequence-tail x) (sequence-tail y))))
+    ((and (lambda? x) (lambda? y))
+      (ir1=? (lambda-body x) (lambda-body y)))
+    ((and (lambda-case? x) (lambda-case? y))
+      (and
+        (equal? (lambda-case-arguments x) (lambda-case-arguments y))
+        (eq? (lambda-case-rest x) (lambda-case-rest y))
+        (ir1=? (lambda-case-body x) (lambda-case-body y))
+        (or (and (not (lambda-case-alternate x))
+                 (not (lambda-case-alternate y)))
+            (ir1= (lambda-case-alternate x) (lambda-case-alternate y)))))
+    ((and (letrec? x) (letrec? y))
+      (and
+        (boolean=? (letrec-in-order? x) (letrec-in-order? y))
+        (map symbol=? (letrec-names x) (letrec-names y))
+
+
 (test builtin-quote
   (assert-equal
     (make-constant '(test 1 2 3))
-    (expand '(quote (test 1 2 3)) test-environment)))
+    (expand '(quote (test 1 2 3)) builtins-environment)))
 
 
 (test builtin-syntax-rules-literal
@@ -24,7 +97,7 @@
              ((foo b)
                1)))
          (foo b))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-underscore
@@ -36,7 +109,7 @@
            (syntax-rules ()
              ((foo _) 0)))
          (foo ignored))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-substitution
@@ -48,7 +121,7 @@
            (syntax-rules ()
              ((foo x) x)))
          (foo 5))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-nil
@@ -61,7 +134,7 @@
              ((foo x) 0)
              ((foo) 1)))
          (foo))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-improper-list
@@ -73,7 +146,7 @@
            (syntax-rules ()
              ((foo a . b) a)))
          (foo 1 2 3))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-quoted
@@ -85,7 +158,7 @@
            (syntax-rules ()
              ((foo x) (quote x))))
          (foo a))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-constant
@@ -99,7 +172,7 @@
              ((foo "def") 1)
              ((foo "ghi") 2)))
          (foo "ghi"))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-ellipsis
@@ -111,7 +184,7 @@
            (syntax-rules ()
              ((foo x ...) (x ...))))
          (foo quote 5))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-ellipsis-improper
@@ -123,7 +196,7 @@
            (syntax-rules ()
              ((foo x ... . y) (x ... y))))
          (foo quote . 5))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-ellipsis-zip
@@ -136,7 +209,7 @@
              ((zip (x ...) (y ...))
                (quote ((x . y) ...)))))
          (zip (1 2) (3 4)))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-ellipsis-nested
@@ -149,7 +222,7 @@
              ((append (x ...) ...)
                (quote (x ... ...)))))
          (append (1 2) (3 4) () (5)))
-      test-environment)))
+      builtins-environment)))
 
 
 (test builtin-syntax-rules-ellipsis-custom
@@ -161,4 +234,9 @@
            (syntax-rules ::: ()
              ((foo x :::) (x :::))))
          (foo quote 5))
-      test-environment)))
+      builtins-environment)))
+
+
+(test builtin-lambda-simple
+  (assert-equal
+    (make-lambda