From 279412d316ecd78a96b6c8651ed474d43ced1a23 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 21 Oct 2020 11:42:56 -0600
Subject: [PATCH] cs & schemify: fix [non-]loop detection in lifting pass

When a would-be loop is called in a would-be loop that turns out not
to be a loop due to an intervening non-loop layer, the outer would-be
loop was not detected as a non-loop.
---
 .../racket-test-core/tests/racket/module.rktl | 30 +++++++++++++++++++
 racket/src/cs/schemified/schemify.scm         | 13 +++++---
 racket/src/schemify/lift.rkt                  | 12 ++++++--
 3 files changed, 48 insertions(+), 7 deletions(-)

diff --git a/pkgs/racket-test-core/tests/racket/module.rktl b/pkgs/racket-test-core/tests/racket/module.rktl
index b1dcae80e8..a69b5e0ec9 100644
--- a/pkgs/racket-test-core/tests/racket/module.rktl
+++ b/pkgs/racket-test-core/tests/racket/module.rktl
@@ -3414,4 +3414,34 @@ case of module-leve bindings; it doesn't cover local bindings.
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(module regression-test-for-loop-detection racket/base
+  (provide go)
+  
+  (define (f pick)
+    (let would-be-loop ([v #f])
+      (if (pick)
+          (let not-a-loop ()
+            (if (pick)
+                (let also-would-be-loop ()
+                  (if (pick)
+                      (if (pick)
+                          (also-would-be-loop)
+                          (would-be-loop #t))
+                      null))
+                (if (pick)
+                    (list (not-a-loop))
+                    null)))
+          (would-be-loop v))))
+
+  (define (go)
+    (f (let ([l '(#t #t #t #f #t #f #f)])
+         (lambda ()
+           (begin0
+             (car l)
+             (set! l (cdr l))))))))
+
+(test '() (dynamic-require ''regression-test-for-loop-detection 'go))
+
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 (report-errs)
diff --git a/racket/src/cs/schemified/schemify.scm b/racket/src/cs/schemified/schemify.scm
index f6594de050..eaf56ba7cd 100644
--- a/racket/src/cs/schemified/schemify.scm
+++ b/racket/src/cs/schemified/schemify.scm
@@ -37652,10 +37652,15 @@
                                                               (let ((table_1
                                                                      (call-with-values
                                                                       (lambda ()
-                                                                        (values
-                                                                         id_1
-                                                                         (box
-                                                                          #f)))
+                                                                        (if (unbox
+                                                                             bx_0)
+                                                                          (values
+                                                                           id_1
+                                                                           (box
+                                                                            #f))
+                                                                          (values
+                                                                           id_1
+                                                                           bx_0)))
                                                                       (case-lambda
                                                                        ((key_0
                                                                          val_0)
diff --git a/racket/src/schemify/lift.rkt b/racket/src/schemify/lift.rkt
index 3646787eae..10f487ba65 100644
--- a/racket/src/schemify/lift.rkt
+++ b/racket/src/schemify/lift.rkt
@@ -519,8 +519,14 @@
               [else
                (define new-loop-if-tail
                  (hash-set (for/hasheq ([(id bx) (in-hash loop-if-tail)])
-                             (values id (box #f)))
-                           u-id (box #f)))
+                             ;; If box is set, create a new one to find out if it's
+                             ;; specifically set here. Otherwise, use existing box
+                             ;; to propagate from here to elsewhere
+                             (if (unbox bx)
+                                 (values id (box #f))
+                                 (values id bx)))
+                           u-id
+                           (box #f)))
                (define new-loops
                  (find-loops-in-tail-called rhs lifts new-loop-if-tail loops))
                (cond
@@ -528,7 +534,7 @@
                   new-loops]
                  [else
                   ;; Not a loop, so any reference added in `new-loop-if-tail`
-                  ;; is also to a non-loop
+                  ;; is also a non-loop
                   (for/fold ([loops new-loops]) ([(id bx) (in-hash new-loop-if-tail)])
                     (if (unbox bx)
                         (hash-remove loops id)