From 52da9c556a170ed8e5f811c3acd56088baf94c80 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sun, 26 Jun 2022 20:14:19 -0700
Subject: 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.
---
 csc/cps.csc | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 58 insertions(+)

(limited to 'csc/cps.csc')

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))))
 
 
-- 
cgit v1.3.1