Write a test for case-lambda.

I'm realizing that I should have started with builtin-exit and
implemented the hard stuff later.

1 files changed, 11 insertions, 5 deletions

diff --git a/csc/ir1.csc b/csc/ir1.csc
index 3826c34..59911ab 100644
--- a/csc/ir1.csc
+++ b/csc/ir1.csc
@@ -161,7 +161,7 @@
     ; corresponding to all arguments: first all of the normal arguments, then
     ; the rest argument if any.
     ;
-    ; body is the name of the clause. If the procedure is called with an
+    ; body is the name of the clause (??). If the procedure is called with an
     ; appropriate number of arguments, body is evaluated in tail position.
     ; Otherwise if there is an alternate, it should be a <lambda-case>
     ; expression, representing the next clause to try. If alternate is nil, an
@@ -191,7 +191,7 @@
       (expression letrec-expression))
 
 
-    (define (ir1=? x y)
+    (define (ir1=?-sametype x y)
       (cond
         ((and (void? x) (void? y)) #t)
         ((and (constant? x) (constant? y))
@@ -233,8 +233,8 @@
             (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)))
+            (or (and (null? (lambda-case-alternate x))
+                     (null? (lambda-case-alternate y)))
                 (ir1=? (lambda-case-alternate x) (lambda-case-alternate y)))))
         ((and (letrec? x) (letrec? y))
           (and
@@ -246,6 +246,12 @@
                   unless (ir1=? x-val y-val) return #f
                   finally (return #t))
             (ir1=? (letrec-expression x) (letrec-expression y))))
-        ((and (ir1=? x x) (ir1=? y y))
+        (else #f)))
+
+
+    (define (ir1=? x y)
+      (cond
+        ((ir1=?-sametype x y) #t)
+        ((and (ir1=?-sametype x x) (ir1=?-sametype y y))
           #f)
         (else (error "One or more arguments has a type unknown to ir1=?" x y))))))