From 7004f8d7a381fcd2f9c63ae04d99dc67161158f4 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Sat, 25 Jun 2022 16:14:47 -0700
Subject: Continue work on continuation passing style.

---
 csc/ir2.csc | 108 +++++++++++++++++++++++++++++++++++++++++++++++++++++-------
 1 file changed, 97 insertions(+), 11 deletions(-)

(limited to 'csc/ir2.csc')

diff --git a/csc/ir2.csc b/csc/ir2.csc
index 708d7b1..6ab0705 100644
--- a/csc/ir2.csc
+++ b/csc/ir2.csc
@@ -4,28 +4,82 @@
     atom-expression
     atom?
     ir2=?
+    kargs-expression
+    kargs-refs
+    kargs?
+    ktail?
     make-atom
-    make-tail
-    tail?
+    make-kargs
+    make-ktail
+    make-update
+    update-atom
+    update-continuation
+    update-ref
 
     ; Re-exports from IR1.
     constant-expression
     constant?
-    make-constant)
+    lexical-ref-gensym
+    lexical-ref-name
+    lexical-ref?
+    library-ref-library
+    library-ref-name
+    library-ref?
+    make-constant
+    make-lexical-ref
+    lexical-set-expression
+    lexical-set-ref
+    lexical-set?
+    make-lexical-set
+    make-library-ref)
   (import (scheme base)
           (only (csc ir1)
             constant?
             ir1=?
-            make-constant))
+            lexical-ref-gensym
+            lexical-ref-name
+            lexical-ref?
+            lexical-set-expression
+            lexical-set-ref
+            lexical-set?
+            library-ref-library
+            library-ref-name
+            library-ref?
+            make-constant
+            make-lexical-ref
+            make-lexical-set
+            make-library-ref)
+          (only (csc loop)
+            loop
+            return))
   (begin
     ; This library defines the intermediate representation IR2.
     ; It's CPS time bitch.
 
+    ; CPS atom:
+    ;   An atom is a value that can be computed immediately without
+    ;   any subexpressions.
+    ;   Atoms consist of
+    ;     - constant,
+    ;     - lexical-ref,
+    ;     - or library-ref
+
+    ; CPS expressions:
+    ;   CPS expressions are similar to IR1 expressions,
+    ;   but constrained not to have any subexpressions except atoms.
+    ;   And they take a continuation.
+
+    ; CPS continuations
+    ;   There are a few continuations.
+    ;   Continuations are identified by an integer ID into the
+    ;   continuation map.
+    ;   Guile calls this map the "continuation soup".
+
 
     ; CPS expressions.
 
 
-    ; An atom consists of an ir1 expression and a continuation.
+    ; An atom consists of an atom and a continuation.
     (define-record-type <atom>
       (make-atom expression continuation)
       atom?
@@ -33,21 +87,53 @@
       (continuation atom-continuation))
 
 
+    ; Modifies a library or lexically bound variable to the given atom.
+    (define-record-type <update>
+      (make-update ref atom continuation)
+      update?
+      (ref update-ref)
+      (atom update-atom)
+      (continuation update-continuation))
+
+
     ; CPS continuations.
 
 
-    ; tail is the tail continuation.
-    (define-record-type <tail>
-      (make-tail)
-      tail?)
+    ; The tail continuation.
+    (define-record-type <ktail>
+      (make-ktail)
+      ktail?)
+
+
+    ; Binds the incoming values to the given lexically-bound variables
+    ; and then evaluates expression.
+    (define-record-type <kargs>
+      (make-kargs refs expression)
+      kargs?
+      (refs kargs-refs)
+      (expression kargs-expression))
 
 
     (define (ir2=?-sametype x y)
       (cond
         ((and (atom? x) (atom? y))
           (and (ir1=? (atom-expression x) (atom-expression y))
-               (ir2=? (atom-continuation x) (atom-continuation y))))
-        ((and (tail? x) (tail? y)) #t)
+               (= (atom-continuation x) (atom-continuation y))))
+        ((and (update? x) (update? y))
+          (and (ir1=? (update-ref x) (update-ref y))
+               (ir1=? (update-atom x) (update-atom y))
+               (= (update-continuation x) (update-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))
+                 (ir2=? (kargs-expression x) (kargs-expression y)))))
         (else #f)))
 
 
-- 
cgit v1.3.1