From d415ccee31d273316247b60d28f359d771bd2957 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Tue, 7 Jun 2016 22:52:02 -0400
Subject: [PATCH] WIP

---
 scheme/cyclone/cps-optimizations.sld | 56 +++++++++++++++++++++++++-
 scheme/cyclone/test-cps.scm          | 60 ++++++----------------------
 2 files changed, 66 insertions(+), 50 deletions(-)

diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld
index 6486af2a..2b2d3f03 100644
--- a/scheme/cyclone/cps-optimizations.sld
+++ b/scheme/cyclone/cps-optimizations.sld
@@ -17,8 +17,8 @@
 ;  can write initial analyze, but can't get too far without being able
 ;  to uniquely ID each lambda
 
-;(define-library (cps-optimizations)
-(define-library (scheme cyclone cps-optimizations)
+(define-library (cps-optimizations)
+;(define-library (scheme cyclone cps-optimizations)
   (import (scheme base)
           (scheme cyclone util)
           (scheme cyclone ast)
@@ -504,6 +504,58 @@
          (all-prim-calls? (cdr exps)))
         (else #f)))
 
+    ;; Find variables passed to a primitive
+    (define (prim-call->arg-variables exp)
+      (filter symbol? (cdr exp)))
+
+    ;; Helper for the next function
+    (define (inline-prim-call? exp ivars args)
+      (call/cc
+        (lambda (return)
+          (inline-ok? exp ivars args (list #f) return)
+          (return #t))))
+
+    ;; Make sure inlining a primitive call will not cause out-of-order execution
+    ;; exp - expression to search
+    ;; ivars - vars to be inlined
+    ;; args - list of variable args (should be small)
+    ;; arg-used - has a variable been used? if this is true and we find an ivar,
+    ;;            it cannot be optimized-out and we have to bail.
+    ;;            This is a cons "box" so it can be mutated.
+    ;; return - call into this continuation to return early
+    (define (inline-ok? exp ivars args arg-used return)
+      (cond
+        ((ref? exp)
+         'TODO)
+        ((ast:lambda? exp)
+         (for-each
+          (lambda (e)
+            (inline-ok? e ivars args arg-used return))
+          (ast:lambda-formals->list exp))
+         (for-each
+          (lambda (e)
+            (inline-ok? e ivars args arg-used return))
+          (ast:lambda-body exp)))
+        ((const? exp) #t)
+        ((quote? exp) #t)
+        ((define? exp)
+         (inline-ok? (define->var exp) ivars args arg-used return)
+         (inline-ok? (define->exp exp) ivars args arg-used return))
+        ((set!? exp)
+         (inline-ok? (set!->var exp) ivars args arg-used return)
+         (inline-ok? (set!->exp exp) ivars args arg-used return))
+        ((if? exp)
+          (inline-ok? (if->condition exp) ivars args arg-used return)
+          (inline-ok? (if->then exp) ivars args arg-used return)
+          (inline-ok? (if->else exp) ivars args arg-used return))
+        ((app? exp)
+         (for-each
+          (lambda (e)
+            (inline-ok? e ivars args arg-used return))
+          (reverse exp))) ;; Ensure args are examined before function
+        (else
+          (error `(Unexpected expression passed to inline prim check ,exp)))))
+
     (define (analyze-cps exp)
       (analyze exp -1) ;; Top-level is lambda ID -1
       (analyze2 exp) ;; Second pass
diff --git a/scheme/cyclone/test-cps.scm b/scheme/cyclone/test-cps.scm
index 2410d410..5a1c1ba2 100644
--- a/scheme/cyclone/test-cps.scm
+++ b/scheme/cyclone/test-cps.scm
@@ -132,58 +132,22 @@
 ;)
 
 (define code
-'((define reg-port
+'((define in-port:read-buf!
    #((record-marker)
      #((record-marker) #f (id args body))
-     #(630
-       (k$812 fp$262)
+     #(621
+       (k$807 ptbl$260)
        ((#((record-marker)
            #((record-marker) #f (id args body))
-           #(629
-             (r$813)
-             ((#((record-marker)
-                 #((record-marker) #f (id args body))
-                 #(628
-                   (r$263)
-                   ((if r$263
-                      (#((record-marker)
-                         #((record-marker) #f (id args body))
-                         #(622 () ((k$812 r$263)))))
-                      (#((record-marker)
-                         #((record-marker) #f (id args body))
-                         #(627
-                           ()
-                           ((list #((record-marker)
-                                    #((record-marker) #f (id args body))
-                                    #(626
-                                      (r$817)
-                                      ((#((record-marker)
-                                          #((record-marker) #f (id args body))
-                                          #(625
-                                            (r$814)
-                                            ((#((record-marker)
-                                                #((record-marker)
-                                                  #f
-                                                  (id args body))
-                                                #(624
-                                                  (r$816)
-                                                  ((#((record-marker)
-                                                      #((record-marker)
-                                                        #f
-                                                        (id args body))
-                                                      #(623
-                                                        (r$815)
-                                                        ((k$812 r$263))))
-                                                    (set! *in-port-table*
-                                                      r$816)))))
-                                              (cons r$263 *in-port-table*)))))
-                                        (set! r$263 r$817)))))
-                                  fp$262
-                                  #f
-                                  1
-                                  0)))))))))
-               r$813))))
-         (assoc fp$262 *in-port-table*)))))))
+           #(619
+             (result$261)
+             ((in-port:set-buf!
+                #((record-marker)
+                  #((record-marker) #f (id args body))
+                  #(618 (r$809) ((k$807 result$261))))
+                ptbl$260
+                #f))))
+         (cadr ptbl$260)))))))
 )
 
 (pretty-print