From 4e9a209f434f8722524d471c8b7d6b4f311b6343 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Thu, 10 Mar 2016 23:50:13 -0500
Subject: [PATCH] First start at CPS optimization

---
 scheme/cyclone/transforms.sld | 49 +++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)

diff --git a/scheme/cyclone/transforms.sld b/scheme/cyclone/transforms.sld
index 36cfe385..f48f526f 100644
--- a/scheme/cyclone/transforms.sld
+++ b/scheme/cyclone/transforms.sld
@@ -125,6 +125,7 @@
     wrap-mutables 
     alpha-convert 
     cps-convert 
+    cps-optimize-01
     pos-in-list 
     closure-convert 
   )
@@ -1458,7 +1459,55 @@
             (else
               (cps ast '%halt)))))
     ast-cps))
+;; TODO: use for temporary testing of optimizations
+;    (cps-optimize-01 ast-cps)))
 
+;; CPS optimizations
+
+;; TODO: don't think we can assume lambda body is single expr, if we want
+;;       to do optimizations such as inlining
+(define (cps-optimize-01 exp)
+  (define (opt-lambda exp)
+    (let ((body (car (lambda->exp exp)))) ;; Single expr after CPS
+      (trace:error `(DEBUG 
+        ,exp
+        ,body
+        ,(if (and (pair? body) (app? body) (lambda? (car body)))
+          (list (app->args body)
+                (lambda->formals exp))
+          #f)))
+      (cond
+        ;; Does the function just call its continuation?
+        ((and (pair? body) 
+              (app? body)
+              (lambda? (car body))
+              ;; TODO: need to check body length if we allow >1 expr in a body
+              ;; TODO: not sure this is good enough for all cases
+              (equal? (app->args body)
+                      ;(lambda->formals (car body))
+                      (lambda->formals exp)
+                      ))
+          (cps-optimize-01 (car body)))
+        (else
+          `(lambda ,(lambda->formals exp)
+             ,(cps-optimize-01 (car (lambda->exp exp)))) ;; Assume single expr in lambda body, since after CPS phase
+  ))))
+  (cond
+    ; Core forms:
+    ((const? exp)    exp)
+    ((ref? exp)      exp)
+    ((prim? exp)     exp)
+    ((quote? exp)    exp)
+    ((lambda? exp)   (opt-lambda exp)) 
+    ((set!? exp)     `(set!
+                        ,(set!->var exp) 
+                        ,(cps-optimize-01 (set!->exp exp))))
+    ((if? exp)       `(if ,(cps-optimize-01 (if->condition exp))
+                          ,(cps-optimize-01 (if->then exp))
+                          ,(cps-optimize-01 (if->else exp))))
+    ; Application:
+    ((app? exp)      (map (lambda (e) (cps-optimize-01 e)) exp))
+    (else            (error "CPS optimize unknown expression type: " exp))))
 
 ;; Closure-conversion.
 ;;