Improvements in macros and IR1.

We're omitting libraries for now, and I'll add them in later.

1 files changed, 14 insertions, 82 deletions

diff --git a/csc/macros-test.csc b/csc/macros-test.csc
index 6529e58..4bdc3f1 100644
--- a/csc/macros-test.csc
+++ b/csc/macros-test.csc
@@ -7,16 +7,8 @@
           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
+          ir1=?
           void?)
         (only (csc testing)
           assert-equal
@@ -24,69 +16,14 @@
         (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
+  (assert-equal ir1=?
     (make-constant '(test 1 2 3))
     (expand '(quote (test 1 2 3)) builtins-environment)))
 
 
 (test builtin-syntax-rules-literal
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 1)
     (expand
       '(builtin-let-syntax
@@ -101,7 +38,7 @@
 
 
 (test builtin-syntax-rules-underscore
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 0)
     (expand
       '(builtin-let-syntax
@@ -113,7 +50,7 @@
 
 
 (test builtin-syntax-rules-substitution
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -125,7 +62,7 @@
 
 
 (test builtin-syntax-rules-nil
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 1)
     (expand
       '(builtin-let-syntax
@@ -138,7 +75,7 @@
 
 
 (test builtin-syntax-rules-improper-list
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 1)
     (expand
       '(builtin-let-syntax
@@ -150,7 +87,7 @@
 
 
 (test builtin-syntax-rules-quoted
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 'a)
     (expand
       '(builtin-let-syntax
@@ -162,7 +99,7 @@
 
 
 (test builtin-syntax-rules-constant
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 2)
     (expand
       '(builtin-let-syntax
@@ -176,7 +113,7 @@
 
 
 (test builtin-syntax-rules-ellipsis
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -188,7 +125,7 @@
 
 
 (test builtin-syntax-rules-ellipsis-improper
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -200,7 +137,7 @@
 
 
 (test builtin-syntax-rules-ellipsis-zip
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant '((1 . 3) (2 . 4)))
     (expand
       '(builtin-let-syntax
@@ -213,7 +150,7 @@
 
 
 (test builtin-syntax-rules-ellipsis-nested
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant '(1 2 3 4 5))
     (expand
       '(builtin-let-syntax
@@ -226,7 +163,7 @@
 
 
 (test builtin-syntax-rules-ellipsis-custom
-  (assert-equal
+  (assert-equal ir1=?
     (make-constant 5)
     (expand
       '(builtin-let-syntax
@@ -235,8 +172,3 @@
              ((foo x :::) (x :::))))
          (foo quote 5))
       builtins-environment)))
-
-
-(test builtin-lambda-simple
-  (assert-equal
-    (make-lambda