fix `for/fold` binding in the presence of `#:result`

This bug was introduced in 3b5b0a7.  The `fold-var`s incorrectly
scoped over the whole `for/fold` expansion, while the "remaining
weirdness" behavior was that outermost iteration clauses should not
see the `fold-var`s.

Also revert the `for/foldr` change that appears to be incorrect.
Unlike `for/fold`, `for/foldr` does not need to use this approach,
because `fold-var`s are only visible to the body.

Related to #4898.

(cherry picked from commit a220d4da4d846a50f4da93a9771e277241cdaac9)

2 files changed, 151 insertions, 48 deletions

diff --git a/pkgs/racket-test-core/tests/racket/for.rktl b/pkgs/racket-test-core/tests/racket/for.rktl
index 3640d28c2d..1fafa28b4a 100644
--- a/pkgs/racket-test-core/tests/racket/for.rktl
+++ b/pkgs/racket-test-core/tests/racket/for.rktl
@@ -304,12 +304,12 @@
 (test 0 'break-0 (for*/fold ([x 0]) ([x '(1)] #:break #true [y '(3)]) (add1 x)))
 
 (test 2 'break-2 (for*/fold ([x 0]) ([x '(1)]) #:break #false (add1 x)))
-(test 2 'break-2 (for*/fold ([x 0]) ([x '(1)] [y '(3)]) #:break false (add1 x)))
+(test 2 'break-2 (for*/fold ([x 0]) ([x '(1)] [y '(3)]) #:break #false (add1 x)))
 (test 2 'break-2 (for*/fold ([x 0]) ([x '(1)] #:break #false) (add1 x)))
 (test 2 'break-2 (for*/fold ([x 0]) ([x '(1)] [y '(3)] #:break #false) (add1 x)))
 (test 2 'break-2 (for*/fold ([x 0]) ([x '(1)] #:break #false [y '(3)]) (add1 x)))
 
-(test 2 'break-v2 (for*/fold ([x 0]) ([x '(1)] [y (in-value 3)]) #:break false (add1 x)))
+(test 2 'break-v2 (for*/fold ([x 0]) ([x '(1)] [y (in-value 3)]) #:break #false (add1 x)))
 (test 2 'break-v2 (for*/fold ([x 0]) ([x '(1)] [y (in-value 3)] #:break #false) (add1 x)))
 (test 2 'break-v2 (for*/fold ([x 0]) ([x '(1)] #:break #false [y (in-value 3)]) (add1 x)))
 
@@ -1521,5 +1521,110 @@
   (for ([i (in-digits 12)]) i))
 
 ;; ----------------------------------------
+;; Check more fold variables in outermost iteration clauses
+
+(test '(3 2 1)
+      'for/fold-var-in-outermost
+      (let ([a '(1 2 3)])
+        (for/fold ([a '()])
+                  ([x (in-list a)])
+          (cons x a))))
+
+(test '(1 2 3)
+      'for/fold-var-in-outermost/result
+      (let ([a '(1 2 3)])
+        (for/fold ([a '()]
+                   #:result (reverse a))
+                  ([x (in-list a)])
+          (cons x a))))
+
+(test '(1 2 3)
+      'for/foldr-var-in-outermost
+      (let ([a '(1 2 3)])
+        (for/foldr ([a '()])
+                   ([x (in-list a)])
+          (cons x a))))
+
+(test '(3 2 1)
+      'for/foldr-var-in-outermost/result
+      (let ([a '(1 2 3)])
+        (for/foldr ([a '()]
+                    #:result (reverse a))
+                   ([x (in-list a)])
+          (cons x a))))
+
+(test '(1 2 3)
+      'for/foldr-var-in-outermost/delay
+      (let ([a '(1 2 3)])
+        (force
+         (for/foldr ([a '()]
+                     #:delay)
+                    ([x (in-list a)])
+           (cons x (force a))))))
+
+(test '(3 2 1)
+      'for/foldr-var-in-outermost/delay/result
+      (let ([a '(1 2 3)])
+        (for/foldr ([a '()]
+                    #:delay
+                    #:result (reverse (force a)))
+                   ([x (in-list a)])
+          (cons x (force a)))))
+
+(test '()
+      'for/fold-var-not-in-outermost
+      (let ([a '(1 2 3)])
+        (for/fold ([a '()])
+                  (#:when #t
+                   [x (in-list a)])
+          (cons x a))))
+
+(test '()
+      'for/fold-var-not-in-outermost/result
+      (let ([a '(1 2 3)])
+        (for/fold ([a '()]
+                   #:result (reverse a))
+                  (#:when #t
+                   [x (in-list a)])
+          (cons x a))))
+
+(test '(1 2 3)
+      'for/foldr-var-not-in-outermost
+      (let ([a '(1 2 3)])
+        (for/foldr ([a '()])
+                   (#:when #t
+                    [x (in-list a)])
+          (cons x a))))
+
+(test '(3 2 1)
+      'for/foldr-var-not-in-outermost/result
+      (let ([a '(1 2 3)])
+        (for/foldr ([a '()]
+                    #:result (reverse a))
+                   (#:when #t
+                    [x (in-list a)])
+          (cons x a))))
+
+(test '(1 2 3)
+      'for/foldr-var-not-in-outermost/delay
+      (let ([a '(1 2 3)])
+        (force
+         (for/foldr ([a '()]
+                     #:delay)
+                    (#:when #t
+                     [x (in-list a)])
+           (cons x (force a))))))
+
+(test '(3 2 1)
+      'for/foldr-var-not-in-outermost/delay/result
+      (let ([a '(1 2 3)])
+        (for/foldr ([a '()]
+                    #:delay
+                    #:result (reverse (force a)))
+                   (#:when #t
+                    [x (in-list a)])
+          (cons x (force a)))))
+
+;; ----------------------------------------
 
 (report-errs)
diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt
index 10cb8d98ef..78ad2f36e9 100644
--- a/racket/collects/racket/private/for.rkt
+++ b/racket/collects/racket/private/for.rkt
@@ -1546,26 +1546,26 @@
             ...)
         next-k)))
 
-  (define-for-syntax ((make-inner-recur/foldr/strict int-vars) stx)
+  (define-for-syntax ((make-inner-recur/foldr/strict fold-vars) stx)
     (syntax-case stx ()
       [(_ () [expr ...] next-k)
-       #`(let-values ([#,(map syntax-local-introduce int-vars) next-k])
+       #`(let-values ([#,(map syntax-local-introduce fold-vars) next-k])
            expr ...)]))
 
-  (define-for-syntax ((make-inner-recur/foldr/lazy int-vars delayed-id delayer-id) stx)
+  (define-for-syntax ((make-inner-recur/foldr/lazy fold-vars delayed-id delayer-id) stx)
     (syntax-case stx ()
       [(_ () [expr ...] next-k)
-       (with-syntax ([(int-var ...) (map syntax-local-introduce int-vars)]
+       (with-syntax ([(fold-var ...) (map syntax-local-introduce fold-vars)]
                      [delayed-id (syntax-local-introduce delayed-id)]
                      [delayer-id delayer-id])
          #`(let*-values
                ([(delayed-id) (delayer-id next-k)]
                 #,@(cond
-                     [(= (length int-vars) 1)
-                      #`([(int-var ...) delayed-id])]
+                     [(= (length fold-vars) 1)
+                      #`([(fold-var ...) delayed-id])]
                      [(delayer? (syntax-local-value #'delayer-id (lambda () #f)))
-                      #`([(int-var) (delayer-id (let-values ([(int-var ...) (force delayed-id)])
-                                                   int-var))]
+                      #`([(fold-var) (delayer-id (let-values ([(fold-var ...) (force delayed-id)])
+                                                   fold-var))]
                          ...)]
                      [else #'()]))
              expr ...))]))
@@ -1854,41 +1854,40 @@
                            [delayed-id delayed-id]
                            [delayer-id delayer-id])
                (check-identifier-bindings #'orig-stx #`(fold-var ... delayed-id) "accumulator" (void))
-               (with-syntax ([(int-var ...)
-                              (map (lambda (fold-var)
-                                     (datum->syntax fold-var
-                                                    (string->uninterned-symbol
-                                                     (symbol->string (syntax-e fold-var)))
-                                                    fold-var
-                                                    fold-var))
-                                   (syntax->list #'(fold-var ...)))])
-                 (cond
-                   [right?
-                    (define loop-stx
-                      (quasisyntax/loc #'orig-stx
-                        (for/foldX/derived [orig-stx inner-recur/foldr #,for*? #f ()]
-                          () ([fold-var (make-fold-var 'int-var)] ...)
-                          (done-k-proc)
-                          (done-k-proc)
-                          #f
-                          . rest)))
+               (cond
+                 [right?
+                  (define loop-stx
                     (quasisyntax/loc #'orig-stx
-                      (let ([done-k-proc (lambda () (#%expression (values* fold-init ...)))])
-                        (define-syntax inner-recur/foldr
-                          #,(if delay?
-                                #'(make-inner-recur/foldr/lazy
-                                   (list (quote-syntax int-var) ...)
-                                   (quote-syntax delayed-id)
-                                   (quote-syntax delayer-id))
-                                #'(make-inner-recur/foldr/strict
-                                   (list (quote-syntax int-var) ...))))
-                        #,(if result-expr
-                              ;; Make sure `fold-var`s in `result-expr` are also delayed, if relevant
-                              (let ([result-expr #`(letrec-syntax ([fold-var (make-fold-var 'int-var)] ...)
-                                                     #,result-expr)])
-                                #`(inner-recur/foldr () [#,result-expr] #,loop-stx))
-                              loop-stx)))]
-                   [else
+                      (for/foldX/derived [orig-stx inner-recur/foldr #,for*? #f ()]
+                        ()
+                        ()
+                        (done-k-proc)
+                        (done-k-proc)
+                        #f
+                        . rest)))
+                  (quasisyntax/loc #'orig-stx
+                    (let ([done-k-proc (lambda () (values* fold-init ...))])
+                      (define-syntax inner-recur/foldr
+                        #,(if delay?
+                              #'(make-inner-recur/foldr/lazy
+                                 (list (quote-syntax fold-var) ...)
+                                 (quote-syntax delayed-id)
+                                 (quote-syntax delayer-id))
+                              #'(make-inner-recur/foldr/strict
+                                 (list (quote-syntax fold-var) ...))))
+                      #,(if result-expr
+                            ;; Make sure `fold-var`s in `result-expr` are also delayed, if relevant
+                            #`(inner-recur/foldr () [#,result-expr] #,loop-stx)
+                            loop-stx)))]
+                 [else
+                  (with-syntax ([(int-var ...)
+                                 (map (lambda (fold-var)
+                                        (datum->syntax fold-var
+                                                       (string->uninterned-symbol
+                                                        (symbol->string (syntax-e fold-var)))
+                                                       fold-var
+                                                       fold-var))
+                                      (syntax->list #'(fold-var ...)))])
                     (quasisyntax/loc #'orig-stx
                       (let ([int-var (let ([fold-var fold-init])
                                        fold-var)]
@@ -1902,10 +1901,9 @@
                                      . rest))])
                             (if result-expr
                                 (quasisyntax/loc #'orig-stx
-                                  (letrec-syntax ([fold-var (make-fold-var 'int-var)] ...)
-                                    (let-values ([(fold-var ...) #,loop-stx])
-                                      #,result-expr)))
-                                loop-stx))))]))))]
+                                  (let-values ([(fold-var ...) #,loop-stx])
+                                    #,result-expr))
+                                loop-stx)))))])))]
           [(_ orig-stx . rst)
            (raise-syntax-error #f "bad syntax" #'orig-stx)]))