add #:result clause to for/lists and for*/lists

pkgs/racket-doc/scribblings/reference/for.scrbl

@@ -258,14 +258,22 @@ is accumulated into a result with @racket[*].
 ]}
 
 
-@defform[(for/lists (id ...) (for-clause ...) body-or-break ... body)]{
+@defform[(for/lists (id ... maybe-result)
+                    (for-clause ...)
+           body-or-break ... body)
+         #:grammar
+         ([maybe-result (code:line) (code:line #:result result-expr)])]{
 
 Similar to @racket[for/list], but the last @racket[body] expression
-should produce as many values as given @racket[id]s, and the result is
+should produce as many values as given @racket[id]s.
-as many lists as supplied @racket[id]s. The @racket[id]s are bound to
+The @racket[id]s are bound to
 the lists accumulated so far in the @racket[for-clause]s and
 @racket[body]s.
 
+If a @racket[result-expr] is provided, it is used as with @racket[for/fold]
+when iteration terminates;
+otherwise, the result is as many lists as supplied @racket[id]s
+
 @examples[
 (for/lists (l1 l2 l3)
            ([i '(1 2 3)]
@@ -277,7 +285,14 @@ the lists accumulated so far in the @racket[for-clause]s and
            ([x '(tvp tofu seitan tvp tofu)]
             #:unless (member x acc))
   x)
-]}
+(for/lists (firsts seconds #:result (list first seconds))
+           ([pr '((1 . 2) (3 . 4) (5 . 6))])
+  (values (car pr) (cdr pr)))
+]
+
+@history[
+ #:changed "7.1.0.2" @elem{Added the @racket[#:result] form.}
+ ]}
 
 
 @defform[(for/first (for-clause ...) body-or-break ... body)]{ Iterates like
@@ -365,7 +380,7 @@ nested.
 
 @deftogether[(
 @defform[(for*/list (for-clause ...) body-or-break ... body)]
-@defform[(for*/lists (id ...) (for-clause ...) body-or-break ... body)]
+@defform[(for*/lists (id ... maybe-result) (for-clause ...) body-or-break ... body)]
 @defform[(for*/vector maybe-length (for-clause ...) body-or-break ... body)]
 @defform[(for*/hash (for-clause ...) body-or-break ... body)]
 @defform[(for*/hasheq (for-clause ...) body-or-break ... body)]

pkgs/racket-test-core/tests/racket/for.rktl

@@ -540,6 +540,38 @@
                         [else (values (cons x acc)
                                       (hash-set seen x #t))]))])
         (list backwards forwards other)))
+(test '((1 3 5) (2 4 6))
+      'for/lists-result-clause1
+      (for/lists (firsts seconds #:result (list firsts seconds))
+                 ([pr '((1 . 2) (3 . 4) (5 . 6))])
+        (values (car pr) (cdr pr))))
+(test '((1 3 5) (2 4 6) ())
+      'for/lists-result-clause2
+      (let-values ([(firsts seconds other)
+                    (for/lists (firsts
+                                seconds
+                                #:result (values firsts seconds '()))
+                               ([pr '((1 . 2) (3 . 4) (5 . 6))])
+                      (values (car pr) (cdr pr)))])
+        (list firsts seconds other)))
+(test '((1 3 5 7 9) (2 4 6 8 10))
+      'for*/lists-result-clause1
+      (for*/lists (firsts seconds #:result (list firsts seconds))
+                  ([lst '(((1 . 2) (3 . 4) (5 . 6))
+                          ((7 . 8) (9 . 10)))]
+                   [pr (in-list lst)])
+        (values (car pr) (cdr pr))))
+(test '((1 3 5 7 9) (2 4 6 8 10) ())
+      'for*/lists-result-clause2
+      (let-values ([(firsts seconds other)
+                    (for*/lists (firsts
+                                 seconds
+                                 #:result (values firsts seconds '()))
+                                ([lst '(((1 . 2) (3 . 4) (5 . 6))
+                                        ((7 . 8) (9 . 10)))]
+                                 [pr (in-list lst)])
+                      (values (car pr) (cdr pr)))])
+        (list firsts seconds other)))
 
 ;; for should discard any results and return void
 (test (void) 'for-0-values (for ([x '(1 2 3)] [y '(a b c)]) (values)))

racket/collects/racket/private/for.rkt

@@ -1826,26 +1826,35 @@
     (for_/vector stx stx #'for*/vector #'for*/fold/derived #t))
 
   (define-for-syntax (do-for/lists for/fold-id stx)
+    (define (do-without-result-clause normalized-stx)
+      (with-syntax ([(_ (id ...) bindings expr1 expr ...)
+                     normalized-stx])
+        (define ids (syntax->list #'(id ...)))
+        (for-each (lambda (id)
+                    (unless (identifier? id)
+                      (raise-syntax-error #f
+                                          "not an identifier"
+                                          stx
+                                          id)))
+                  ids)
+        (with-syntax ([(id2 ...) (generate-temporaries ids)]
+                      [for/fold for/fold-id]
+                      [orig-stx stx])
+          #'(let-values ([(id ...)
+                          (for/fold orig-stx ([id null] ...) bindings
+                            (let-values ([(id2 ...) (let ()
+                                                      expr1
+                                                      expr ...)])
+                              (values* (cons id2 id) ...)))])
+              (values* (alt-reverse id) ...)))))
     (syntax-case stx ()
+      [(_ (id ... #:result result-expr) bindings expr1 expr ...)
+       #`(let-values ([(id ...)
+                       #,(do-without-result-clause
+                          #'(_ (id ...) bindings expr1 expr ...))])
+           result-expr)]
       [(_ (id ...) bindings expr1 expr ...)
-       (let ([ids (syntax->list #'(id ...))])
+       (do-without-result-clause stx)]))
-         (for-each (lambda (id)
-                     (unless (identifier? id)
-                       (raise-syntax-error #f
-                                           "not an identifier"
-                                           stx
-                                           id)))
-                   ids)
-         (with-syntax ([(id2 ...) (generate-temporaries ids)]
-                       [for/fold for/fold-id]
-                       [orig-stx stx])
-           #'(let-values ([(id ...)
-                           (for/fold orig-stx ([id null] ...) bindings
-                                     (let-values ([(id2 ...) (let ()
-                                                               expr1
-                                                               expr ...)])
-                                       (values* (cons id2 id) ...)))])
-               (values* (alt-reverse id) ...))))]))
 
   (define-syntax (for/lists stx) (do-for/lists #'for/fold/derived stx))
   (define-syntax (for*/lists stx) (do-for/lists #'for*/fold/derived stx))