Continue work on continuation passing style.

1 files changed, 60 insertions, 7 deletions

diff --git a/csc/cps.csc b/csc/cps.csc
index bd4f088..26e0591 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -1,26 +1,79 @@
 (define-library (csc cps)
   (export
     ir1->ir2)
-  (import (only (csc ir1)
-            make-constant
+  (import (only (csc gensym) gensym)
+          (only (csc hash-map)
+            alist->map
+            insert
+            merge)
+          (only (csc ir1)
             constant?
             lexical-ref?
-            library-ref?)
+            lexical-set-expression
+            lexical-set-ref
+            lexical-set?
+            library-define-expression
+            library-define-ref
+            library-define?
+            library-ref?
+            make-constant
+            make-lexical-ref)
           (only (csc ir2)
             make-atom
-            make-tail)
+            make-kargs
+            make-ktail
+            make-update)
           (scheme base))
   (begin
 
 
-    (define (to-cps expr continuation)
+    (define (make-soup . l)
+      (alist->map (lambda (x) x) < l))
+
+
+    (define (new-ref)
+      (make-lexical-ref 'generated-symbol (gensym)))
+
+
+    (define-syntax cps-merge
+      (syntax-rules ()
+        ((cps-merge new-continuations sub-cps)
+          (let-values (((expr soup) sub-cps))
+            (values expr (merge soup new-continuations))))))
+
+
+    (define (to-cps expr continuation next-id)
       (cond
         ((or (constant? expr)
              (lexical-ref? expr)
              (library-ref? expr))
-          (make-atom expr continuation))
+          (values (make-atom expr continuation) (make-soup)))
+        ((lexical-set? expr)
+          (let ((id (next-id))
+                (ref (new-ref)))
+            (cps-merge
+              (make-soup (cons id (make-kargs (list ref)
+                                    (make-update (lexical-set-ref expr) ref continuation))))
+              (to-cps (lexical-set-expression expr) id next-id))))
+        ((library-define? expr)
+          (let ((id (next-id))
+                (ref (new-ref)))
+            (cps-merge
+              (make-soup (cons id (make-kargs (list ref)
+                                    (make-update (library-define-ref expr) ref continuation))))
+              (to-cps (library-define-expression expr) id next-id))))
         (else (error "unexpected type in to-cps" expr))))
 
 
+    ; Returns a map from integers to CPS continuations.
+    ; By convention the continuation at key 0 is the entrypoint.
     (define (ir1->ir2 program)
-      (to-cps program (make-tail)))))
+      (define current-continuation-id 0)
+      (define (next-id)
+        (set! current-continuation-id (+ 1 current-continuation-id))
+        current-continuation-id)
+      (define ktail (next-id))
+      (define-values (expr m) (to-cps program ktail next-id))
+      (set! m (insert m ktail (make-ktail)))
+      (set! m (insert m 0 (make-kargs '() expr)))
+      m)))