From c5fcc7d0f5c3f2f596f4d02d5e84283efce7eb52 Mon Sep 17 00:00:00 2001
From: Rose Hogenson <rhogenson@posteo.net>
Date: Tue, 21 Jun 2022 20:14:25 -0700
Subject: More progress on CPS.

---
 csc/cps-test.csc |  18 ++++++++++
 csc/cps.csc      |   8 +++--
 csc/ir2.csc      | 100 ++++++++++++++++++-------------------------------------
 3 files changed, 57 insertions(+), 69 deletions(-)
 create mode 100644 csc/cps-test.csc

(limited to 'csc')

diff --git a/csc/cps-test.csc b/csc/cps-test.csc
new file mode 100644
index 0000000..dd66078
--- /dev/null
+++ b/csc/cps-test.csc
@@ -0,0 +1,18 @@
+(import (scheme base)
+        (only (csc ir2)
+          ir2=?
+          make-atom
+          make-tail
+          make-constant)
+        (only (csc testing)
+          assert-equal
+          test)
+        (csc cps))
+
+
+(test atom-const
+  (assert-equal ir2=?
+    (make-atom
+      (make-constant 5)
+      (make-tail))
+    (ir1->ir2 (make-constant 5))))
diff --git a/csc/cps.csc b/csc/cps.csc
index 561a698..bd4f088 100644
--- a/csc/cps.csc
+++ b/csc/cps.csc
@@ -1,16 +1,19 @@
 (define-library (csc cps)
+  (export
+    ir1->ir2)
   (import (only (csc ir1)
             make-constant
             constant?
             lexical-ref?
             library-ref?)
           (only (csc ir2)
-            (make-atom))
+            make-atom
+            make-tail)
           (scheme base))
   (begin
 
 
-    (define (to-cps expr k)
+    (define (to-cps expr continuation)
       (cond
         ((or (constant? expr)
              (lexical-ref? expr)
@@ -20,3 +23,4 @@
 
 
     (define (ir1->ir2 program)
+      (to-cps program (make-tail)))))
diff --git a/csc/ir2.csc b/csc/ir2.csc
index 46dbad1..708d7b1 100644
--- a/csc/ir2.csc
+++ b/csc/ir2.csc
@@ -1,74 +1,30 @@
 (define-library (csc ir2)
   (export
-    lambda-body
-    lambda-case-alternate
-    lambda-case-arguments
-    lambda-case-body
-    lambda-case-gensyms
-    lambda-case-rest
-    lambda-case?
-    make-lambda-case
+    atom-continuation
+    atom-expression
+    atom?
+    ir2=?
+    make-atom
+    make-tail
+    tail?
 
     ; Re-exports from IR1.
-    call-arguments
-    call-procedure
-    call?
     constant-expression
     constant?
-    if-alternate
-    if-consequent
-    if-test
-    if?
-    lambda?
-    make-call
-    make-constant
-    make-if
-    make-lambda
-    make-sequence
-    make-toplevel-define
-    make-toplevel-ref
-    make-void
-    sequence-head
-    sequence-tail
-    sequence?
-    toplevel-define-expression
-    toplevel-define-name
-    toplevel-define?
-    toplevel-ref-name
-    toplevel-ref?
-    void?)
+    make-constant)
   (import (scheme base)
           (only (csc ir1)
-            call-arguments
-            call-procedure
-            call?
-            constant-expression
             constant?
-            if-alternate
-            if-consequent
-            if-test
-            if?
-            lambda-body
-            lambda?
-            make-call
-            make-constant
-            make-if
-            make-lambda
-            make-sequence
-            make-toplevel-define
-            make-void
-            sequence-head
-            sequence-tail
-            sequence?
-            toplevel-define-expression
-            toplevel-define-name
-            toplevel-define?
-            void?))
+            ir1=?
+            make-constant))
   (begin
     ; This library defines the intermediate representation IR2.
     ; It's CPS time bitch.
 
 
+    ; CPS expressions.
+
+
     ; An atom consists of an ir1 expression and a continuation.
     (define-record-type <atom>
       (make-atom expression continuation)
@@ -77,17 +33,27 @@
       (continuation atom-continuation))
 
 
-    ; <variable> 
-    (define-record-type <variable>
-      (make-variable k var
+    ; CPS continuations.
+
+
+    ; tail is the tail continuation.
+    (define-record-type <tail>
+      (make-tail)
+      tail?)
 
 
-    ; <closure-ref> idx
-    ; Reference to a variable by index in the closure.
-    (define-record-type <closure-ref>
-      (make-closure-ref idx)
-      closure-ref?
-      (idx closure-ref-index))
+    (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)
+        (else #f)))
 
 
-    ; <lambda-case> arguments rest 
+    (define (ir2=? x y)
+      (cond
+        ((ir2=?-sametype x y) #t)
+        ((and (ir2=?-sametype x x) (ir2=?-sametype y y))
+          #f)
+        (else (error "One or more arguments has a type unknown to ir2=?" x y))))))
-- 
cgit v1.3.1