Finish CPS.

Wow we actually finished CPS. Next is closure conversion, then codegen,
and then we should be able to run some end to end tests. Then we can
look at garbage collection, and from there continue building features
down the long road to self hosting.

1 files changed, 42 insertions, 10 deletions

diff --git a/csc/ir2.csc b/csc/ir2.csc
index fc31ce3..1872b65 100644
--- a/csc/ir2.csc
+++ b/csc/ir2.csc
@@ -10,6 +10,9 @@
     call-closure-args
     call-closure-closure
     call-closure?
+    closure-cases
+    closure-continuation
+    closure?
     ir2=?
     kargs-expression
     kargs-refs
@@ -17,12 +20,18 @@
     klabel-expression
     klabel?
     ktail?
+    lambda-args-kargs
+    lambda-args-nargs
+    lambda-args-rest
+    lambda-args?
     make-atom
     make-branch
     make-call-closure
+    make-closure
     make-kargs
     make-klabel
     make-ktail
+    make-lambda-args
     make-update
     update-atom
     update-continuation
@@ -61,6 +70,7 @@
             make-lexical-ref
             make-lexical-set
             make-library-ref)
+          (only (csc list) all)
           (only (csc loop)
             loop
             return))
@@ -128,6 +138,26 @@
       (continuation call-closure-continuation))
 
 
+    ; One branch of a case-lambda. nargs encodes the number of required
+    ; arguments, and rest is a boolean indicating whether the function takes a
+    ; rest parameter. kargs is a continuation ID pointing to a
+    ; kargs continuation.
+    (define-record-type <lambda-args>
+      (make-lambda-args nargs rest kargs)
+      lambda-args?
+      (nargs lambda-args-nargs)
+      (rest lambda-args-rest)
+      (kargs lambda-args-kargs))
+
+
+    ; A lambda expression.
+    (define-record-type <closure>
+      (make-closure cases continuation)
+      closure?
+      (cases closure-cases)
+      (continuation closure-continuation))
+
+
     ; CPS continuations.
 
 
@@ -171,22 +201,24 @@
                 (y-args (call-closure-args y)))
             (and (ir1=? (call-closure-closure x) (call-closure-closure y))
                  (= (length x-args) (length y-args))
-                 (loop for x-arg in (call-closure-args x)
-                       for y-arg in (call-closure-args y)
-                       unless (ir1=? x-arg y-arg)
-                         return #f
-                       finally (return #t))
+                 (all (lambda (x) x) (map ir1=? x-args y-args))
                  (= (call-closure-continuation x) (call-closure-continuation y)))))
+        ((and (lambda-args? x) (lambda-args? y))
+          (and (= (lambda-args-nargs x) (lambda-args-nargs y))
+               (boolean=? (lambda-args-rest x) (lambda-args-rest y))
+               (= (lambda-args-kargs x) (lambda-args-kargs y))))
+        ((and (closure? x) (closure? y))
+          (let ((x-cases (closure-cases x))
+                (y-cases (closure-cases y)))
+            (and (= (length x-cases) (length y-cases))
+                 (all (lambda (x) x) (map ir2=? x-cases y-cases))
+                 (= (closure-continuation x) (closure-continuation y)))))
         ((and (ktail? x) (ktail? y)) #t)
         ((and (kargs? x) (kargs? y))
           (let ((x-refs (kargs-refs x))
                 (y-refs (kargs-refs y)))
             (and (= (length x-refs) (length y-refs))
-                 (loop for x-ref in x-refs
-                       for y-ref in y-refs
-                       unless (ir1=? x-ref y-ref)
-                         return #f
-                       finally (return #t))
+                 (all (lambda (x) x) (map ir1=? x-refs y-refs))
                  (ir2=? (kargs-expression x) (kargs-expression y)))))
         ((and (klabel? x) (klabel? y))
           (ir2=? (klabel-expression x) (klabel-expression y)))