From ff94309bcce5761bfd22835ef705035fa3acf0a7 Mon Sep 17 00:00:00 2001
From: Justin Ethier <justin.ethier@gmail.com>
Date: Mon, 4 Jun 2018 13:16:40 -0400
Subject: [PATCH] Check continuation for direct rec calls

---
 find-direct-rec-calls.scm            | 12 ++++++++++--
 scheme/cyclone/cps-optimizations.sld | 14 ++++++++++----
 2 files changed, 20 insertions(+), 6 deletions(-)

diff --git a/find-direct-rec-calls.scm b/find-direct-rec-calls.scm
index e092ff58..e9a4dd0e 100644
--- a/find-direct-rec-calls.scm
+++ b/find-direct-rec-calls.scm
@@ -8,6 +8,12 @@
 )
 
   (define (find-direct-recursive-calls exp)
+    ;; Verify the continuation is simple and there is no closure allocation
+    (define (check-cont k)
+      (cond
+        ((ref? k) #t)
+        (else #f)))
+
     (define (check-args args)
       (define (check exp)
         (cond
@@ -35,12 +41,14 @@
        ((define? exp) #f)
        ((set!? exp) #f)
        ((if? exp)       
-        (scan (if->condition exp) def-sym) ;; OK to check??
+        ;;(scan (if->condition exp) def-sym) ;; Not a tail call
         (scan (if->then exp) def-sym)
         (scan (if->else exp) def-sym))
        ((app? exp)
         (when (equal? (car exp) def-sym)
-          (if (check-args (cddr exp)) ;; Skip func and continuation
+          (if (and
+                (check-args (cddr exp))
+                (check-cont (cadr exp)))
             (write `(direct recursive call ,exp))
             (write `(not a direct recursive call ,exp))
          )
diff --git a/scheme/cyclone/cps-optimizations.sld b/scheme/cyclone/cps-optimizations.sld
index 9b5ab417..a4a91785 100644
--- a/scheme/cyclone/cps-optimizations.sld
+++ b/scheme/cyclone/cps-optimizations.sld
@@ -1725,6 +1725,12 @@
 
 ;; Find any top-level functions that call themselves directly
 (define (analyze:find-direct-recursive-calls exp)
+  ;; Verify the continuation is simple and there is no closure allocation
+  (define (check-cont k)
+    (cond
+      ((ref? k) #t)
+      (else #f)))
+
   ;; Check arguments to the top level function to make sure 
   ;; they are "safe" for further optimizations.
   ;; Right now this is very conservative.
@@ -1761,16 +1767,16 @@
      ((app? exp)
       (when (equal? (car exp) def-sym)
         (cond
-         ((check-args (cddr exp)) ;; Skip func and continuation
+         ((and
+            (check-cont (cadr exp))
+            (check-args (cddr exp)))
           (trace:info `("direct recursive call" ,exp))
-          ;; TODO: No, not good enough! consider _list-index from scheme base. At the
-          ;; least we need to account for newly-allocated closures being passed as the cont.
-          ;; But it seems neither that function or foldr is a direct call
           (with-var! def-sym (lambda (var)
             (adbv:set-direct-rec-call! var #t))))
          (else
           (trace:info `("not a direct recursive call" ,exp))))))
      (else #f)))
+
   (if (pair? exp)
       (for-each
         (lambda (exp)