1 files changed, 58 insertions, 0 deletions
diff --git a/csc/cps.csc b/csc/cps.csc
index 55e7e81..0c85707 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -16,6 +16,18 @@
             if-consequent
             if-test
             if?
+            lambda-body
+            lambda-case-alternate
+            lambda-case-arguments
+            lambda-case-body
+            lambda-case-gensyms
+            lambda-case-rest
+            lambda?
+            letrec-expression
+            letrec-gensyms
+            letrec-names
+            letrec-values
+            letrec?
             lexical-ref?
             lexical-set-expression
             lexical-set-ref
@@ -24,8 +36,13 @@
             library-define-ref
             library-define?
             library-ref?
+            make-call
             make-constant
+            make-lambda
+            make-lambda-case
             make-lexical-ref
+            make-lexical-set
+            make-sequence
             sequence-head
             sequence-tail
             sequence?)
@@ -33,9 +50,11 @@
             make-atom
             make-branch
             make-call-closure
+            make-closure
             make-kargs
             make-klabel
             make-ktail
+            make-lambda-args
             make-update)
           (only (csc loop)
             loop
@@ -105,6 +124,45 @@
               (make-klabel
                 (to-cps (sequence-tail expr) continuation add-continuation)))
             add-continuation))
+        ((lambda? expr)
+          (make-closure
+            (loop with tail = (add-continuation (make-ktail))
+                  for lambda-case = (lambda-body expr) then (lambda-case-alternate lambda-case)
+                  while lambda-case
+                  collect (let ((args (lambda-case-arguments lambda-case))
+                                (rest (lambda-case-rest lambda-case)))
+                            (make-lambda-args
+                              (length args)
+                              (not (not rest))
+                              (add-continuation
+                                (make-kargs (map make-lexical-ref
+                                              (append args (list rest))
+                                              (lambda-case-gensyms lambda-case))
+                                  (to-cps (lambda-case-body lambda-case) tail add-continuation))))))
+            continuation))
+        ((letrec? expr)
+          ; We re-write a letrec into a corresponding lambda form.
+          (let ((names (letrec-names expr))
+                (gensyms (letrec-gensyms expr)))
+            (to-cps
+              (make-call
+                (make-lambda
+                  (make-lambda-case
+                    names
+                    #f
+                    gensyms
+                    (make-sequence
+                      (loop for name in names
+                            for gensym in gensyms
+                            for value in (letrec-values expr)
+                            for set = (make-lexical-set (make-lexical-ref name gensym) value)
+                            for body = set then (make-sequence body set)
+                            finally (return body))
+                      (letrec-expression expr))
+                    #f))
+                (map (lambda (x) (make-constant #f)) names))
+              continuation
+              add-continuation)))
         (else (error "unexpected type in to-cps" expr))))