Improve CPS.

Goodbye soup. Thanks to "Compiling with Continuations" by Appel.

1 files changed, 13 insertions, 24 deletions

diff --git a/csc/macros.csc b/csc/macros.csc
index ff5b63a..6364e19 100644
--- a/csc/macros.csc
+++ b/csc/macros.csc
@@ -34,7 +34,6 @@
             make-call
             make-constant
             make-lambda
-            make-lambda-case
             make-letrec
             make-lexical-ref
             make-library-define
@@ -698,31 +697,21 @@
                   (make-letrec #t (reverse names) (reverse gensyms) (reverse expressions) (expand-lambda-body-rest body)))))))))
 
 
-    (define (case-lambda-helper form)
-      (syntax-case form
-        ('() '())
-        (((formals . body) . clauses)
-          (let-values (((args rest) (split-args-rest formals)))
-            (make-lambda-case
-              args
-              rest
-              (map
-                (lambda (x) (gensym))
-                (if rest
-                  (cons rest args)
-                  args))
-              (expand-lambda-body body)
-              (case-lambda-helper clauses))))
-        (_ (raise-syntax-error "unexpected form in case-lambda-helper" form))))
-
-
-    (define builtin-case-lambda
+    (define builtin-lambda
       (make-macro-transformer
         (lambda (x)
           (syntax-case x
-            ((_ clause . clauses)
-              (case-lambda-helper (with-wrap (cons clause clauses) x)))
-            (_ (raise-syntax-error "unexpected form in case-lambda" x))))))
+            ((_ formals . body)
+              (let-values (((args rest) (split-args-rest formals)))
+                (make-lambda
+                  (map (lambda (name)
+                         (make-lexical-ref name (gensym)))
+                       args)
+                  (if rest
+                    (make-lexical-ref rest (gensym))
+                    #f)
+                  (expand-lambda-body body))))
+            (_ (raise-syntax-error "unexpected form in lambda" x))))))
 
 
     (define builtin-define
@@ -746,7 +735,7 @@
                 (cons '... (make-library-ref '... '(scheme base)))
                 (cons 'builtin-let-syntax builtin-let-syntax)
                 (cons 'quote builtin-quote)
-                (cons 'case-lambda builtin-case-lambda)
+                (cons 'lambda builtin-lambda)
                 (cons 'builtin-define builtin-define)))
         'main))