add #:break' and #:final' to `for' forms

Support for break clauses complicates expansion to `for/fold/derived';
a new `syntax/for-body' library provides a helper for macros that need
to split a `for'-style body into a prefix part and wrappable part.

collects/data/gvector.rkt

@@ -1,7 +1,8 @@
 #lang racket/base
 ;; written by ryanc
 (require (for-syntax racket/base
-                     unstable/wrapc)
+                     unstable/wrapc
+                     syntax/for-body)
          racket/contract/base
          racket/dict
          racket/vector)
@@ -158,22 +159,26 @@
 (define-syntax (for/gvector stx)
   (syntax-case stx ()
     [(_ (clause ...) . body)
+     (with-syntax ([((pre-body ...) post-body) (split-for-body stx #'body)])
        (quasisyntax/loc stx
          (let ([gv (make-gvector)])
            (for/fold/derived #,stx () (clause ...)
-           (call-with-values (lambda () . body)
+            pre-body ...
+            (call-with-values (lambda () . post-body)
               (lambda args (apply gvector-add! gv args) (values))))
-         gv))]))
+           gv)))]))
 
 (define-syntax (for*/gvector stx)
   (syntax-case stx ()
     [(_ (clause ...) . body)
+     (with-syntax ([((pre-body ...) post-body) (split-for-body stx #'body)])
        (quasisyntax/loc stx
          (let ([gv (make-gvector)])
            (for*/fold/derived #,stx () (clause ...)
-           (call-with-values (lambda () . body)
+            pre-body ...
+            (call-with-values (lambda () . post-body)
               (lambda args (apply gvector-add! gv args) (values))))
-         gv))]))
+           gv)))]))
 
 (struct gvector (vec n)
   #:mutable

collects/racket/private/for.rkt

@@ -29,6 +29,7 @@
              for/hasheqv for*/hasheqv
 
              for/fold/derived for*/fold/derived
+             (for-syntax split-for-body)
 
              (rename *in-range in-range)
              (rename *in-naturals in-naturals)
@@ -1280,19 +1281,127 @@
       [(_ [orig-stx . _] . _)
        (raise-syntax-error #f "bad syntax" #'orig-stx)]))
 
+  (define-syntax (for/foldX/derived/break stx)
+    (syntax-case stx ()
+      [(_ [orig-stx nested? emit? ()] ([id init] ...) (clause ...) body ...)
+       (ormap (lambda (form)
+                (or (eq? (syntax-e form) '#:break)
+                    (eq? (syntax-e form) '#:final)))
+              (syntax->list #'(clause ... body ...)))
+       ;; Add an accumulator for short-circuiting
+       (with-syntax ([body
+                      (let loop ([bodys (syntax->list #'(body ...))] [accum null])
+                        (cond
+                         [(null? bodys)
+                          (if (null? accum)
+                              (raise-syntax-error #f "missing final body expression" #'orig-stx)
+                              #`(let-values ([(id ...) (let () #,@(reverse accum))])
+                                  (values stop-after? id ...)))]
+                         [(or (eq? '#:break (syntax-e (car bodys)))
+                              (eq? '#:final (syntax-e (car bodys))))
+                          (let ([break? (eq? '#:break (syntax-e (car bodys)))])
+                            (if (null? (cdr bodys))
+                                (raise-syntax-error #f 
+                                                    (format "missing expression after ~a" (syntax-e (car bodys)))
+                                                    #'orig-stx (car bodys))
+                                #`(let ()
+                                    #,@(reverse accum)
+                                    #,(if break?
+                                          #`(if #,(cadr bodys)
+                                                (values #t id ...)
+                                                (let () #,(loop (cddr bodys) null)))
+                                          #`(let ([stop-after? (or #,(cadr bodys) stop-after?)])
+                                              #,(loop (cddr bodys) null))))))]
+                         [else (loop (cdr bodys) (cons (car bodys) accum))]))]
+                     [(limited-for-clause ...)
+                      ;; If nested, wrap all binding clauses. Otherwise, wrap
+                      ;; only the first and the first after each keyword clause:
+                      (let loop ([fcs (syntax->list #'(clause ...))] [wrap? #t])
+                        (cond
+                         [(null? fcs) null]
+                         [(eq? '#:break (syntax-e (car fcs)))
+                          (when (null? (cdr fcs))
+                            (raise-syntax-error #f "no expression after #:break" #'orig-stx (car fcs)))
+                          (list* #'#:when #'#t
+                                 #`[stop? (*in-value #,(cadr fcs))]
+                                 #'#:when #'#t
+                                 #`[stop-after? (*in-value (or stop-after? stop?))]
+                                 #'#:unless #'stop?
+                                 (loop (cddr fcs) #t))]
+                         [(eq? '#:final (syntax-e (car fcs)))
+                          (when (null? (cdr fcs))
+                            (raise-syntax-error #f "no expression after #:break" #'orig-stx (car fcs)))
+                          (list* #'#:when #'#t
+                                 #`[stop-after? (*in-value (or #,(cadr fcs) stop-after?))]
+                                 #'#:when #'#t
+                                 (loop (cddr fcs) #t))]
+                         [(keyword? (syntax-e (car fcs)))
+                          (if (null? (cdr fcs))
+                              fcs
+                              (list* (car fcs) (cadr fcs) (loop (cddr fcs) #t)))]
+                         [(not wrap?)
+                          (cons (car fcs) (loop (cdr fcs) #f))]
+                         [else
+                          (define fc (car fcs))
+                          (define wrapped-fc
+                            (syntax-case fc ()
+                              [[ids rhs]
+                               (or (identifier? #'ids)
+                                   (let ([l (syntax->list #'ids)])
+                                     (and l (andmap identifier? l))))
+                               (syntax/loc fc [ids (stop-after
+                                                    rhs
+                                                    (lambda x stop-after?))])]
+                              [_ fc]))
+                          (cons wrapped-fc
+                                (loop (cdr fcs) (syntax-e #'nested?)))]))])
+         #'(let-values ([(stop? id ...) 
+                         (for/foldX/derived [orig-stx nested? emit? ()] ([stop-after? #f] [id init] ...) 
+                                            (limited-for-clause ...) 
+                                            body)])
+             (values id ...)))]
+      [(_ . rest)
+       #'(for/foldX/derived . rest)]))
+
   (define-syntax for/fold/derived
     (syntax-rules ()
       [(_ orig-stx . rest)
-       (for/foldX/derived [orig-stx #f #f ()] . rest)]))
+       (for/foldX/derived/break [orig-stx #f #f ()] . rest)]))
 
   (define-syntax for*/fold/derived
     (syntax-rules ()
       [(_ orig-stx . rest)
-       (for/foldX/derived [orig-stx #t #f ()] . rest)]))
+       (for/foldX/derived/break [orig-stx #t #f ()] . rest)]))
 
   ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   ;;  derived `for' syntax
 
+  (define-for-syntax (split-for-body stx body-stx)
+    (let ([lst (syntax->list body-stx)])
+      (if lst
+          (let loop ([exprs lst] [pre-kw null] [post-kw null])
+            (cond
+             [(null? exprs)
+              (if (null? post-kw)
+                  (raise-syntax-error #f
+                                      (format "missing body form after ~a clause" (syntax-e (cadr pre-kw)))
+                                      stx
+                                      (cadr pre-kw))
+                  (list (reverse pre-kw) (reverse post-kw)))]
+             [(memq (syntax-e (car exprs)) '(#:break #:final))
+              (if (pair? (cdr exprs))
+                  (loop (cddr exprs) 
+                        (append (list* (cadr exprs) (car exprs) post-kw)
+                                pre-kw)
+                        null)
+                  (raise-syntax-error #f
+                                      (format "missing expression after ~a" (syntax-e (car exprs)))
+                                      stx
+                                      (car exprs)))]
+             [else
+              (loop (cdr exprs) pre-kw (cons (car exprs) post-kw))]))
+          (raise-syntax-error #f "bad syntax" stx))))
+
   (define-for-syntax (for-variant-stx stx derived-id-stx fold-bind-stx wrap rhs-wrap combine)
     (with-syntax ([derived-id derived-id-stx]
                   [fold-bind fold-bind-stx])
@@ -1309,18 +1418,23 @@
                                      (andmap identifier? (or (syntax->list #'ids) '(#f))))
                                  (cons #`[ids #,(rhs-wrap #'rhs)]
                                        (loop (cdr bs)))]
-                                [#:when (cons (car bs)
+                                [kw
+                                 (memq (syntax-e #'kw) '(#:when #:unless #:break #:final))
+                                 (cons (car bs)
                                        (if (null? (cdr bs))
                                            null
                                            (cons (cadr bs) (loop (cddr bs)))))]
                                 [_
                                  ;; a syntax error; let the /derived form
                                  ;; handle it, and no need to wrap any more:
-                                 bs])))])
+                                 bs])))]
+                       [((middle-expr ...) (end-expr ...))
+                        (split-for-body stx #'(expr1 expr ...))])
            (quasisyntax/loc stx
              #,(wrap (quasisyntax/loc stx
                        (derived-id #,stx fold-bind (bind ...)
-                                   #,(combine (syntax/loc stx (let () expr1 expr ...))))))))]
+                                   middle-expr ...
+                                   #,(combine (syntax/loc stx (let () end-expr ...))))))))]
         ;; Let `derived-id' complain about the missing bindings and body expression:
         [(_ . rest)
          #`(derived-id #,stx fold-bind . rest)])))
@@ -1372,7 +1486,8 @@
     (syntax-case stx ()
       [(_ (for-clause ...) body ...)
        (with-syntax ([orig-stx orig-stx]
-                     [for_/fold/derived for_/fold/derived-stx])
+                     [for_/fold/derived for_/fold/derived-stx]
+                     [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))])
          (syntax/loc stx
            (let-values ([(vec i)
                          (for_/fold/derived
@@ -1380,10 +1495,11 @@
                           ([vec (make-vector 16)]
                            [i 0])
                           (for-clause ...) 
+                          middle-body ...
                           (let ([new-vec (if (eq? i (unsafe-vector-length vec))
                                              (grow-vector vec)
                                              vec)])
-                            (unsafe-vector-set! new-vec i (let () body ...))
+                            (unsafe-vector-set! new-vec i (let () last-body ...))
                             (values new-vec (unsafe-fx+ i 1))))])
              (shrink-vector vec i))))]
       [(_ #:length length-expr #:fill fill-expr (for-clause ...) body ...)
@@ -1415,6 +1531,7 @@
                               [_ fc]))
                           (cons wrapped-fc
                                 (loop (cdr fcs) wrap-all?))]))]
+                     [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))]
                      [for_/vector for_/vector-stx]
                      [for_/fold/derived for_/fold/derived-stx])
          (syntax/loc stx
@@ -1427,7 +1544,8 @@
                   orig-stx 
                   ([i 0])
                   (limited-for-clause ...)
-                (vector-set! v i (let () body ...))
+                  middle-body ...
+                  (vector-set! v i (let () last-body ...))
                   (add1 i)))
                v))))]
       [(_ #:length length-expr (for-clause ...) body ...)

collects/racket/private/pre-base.rkt

@@ -167,7 +167,8 @@
                               define-:vector-like-gen
                               make-in-vector-like
                               stream? stream-ref stream-empty? stream-first stream-rest
-                              prop:stream in-stream empty-stream make-do-stream)
+                              prop:stream in-stream empty-stream make-do-stream
+                              split-for-body)
              (all-from "kernstruct.rkt")
              #%top-interaction
 

collects/racket/private/vector-wraps.rkt

@@ -54,7 +54,8 @@
        (syntax-case stx ()
          [(for*/fXvector (for-clause ...) body ...)
           (with-syntax ([orig-stx orig-stx]
-                        [for_/fold/derived for_/fold/derived-stx])
+                        [for_/fold/derived for_/fold/derived-stx]
+                        [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))])
             (syntax/loc stx
               (let-values ([(vec i)
                             (for_/fold/derived
@@ -62,10 +63,11 @@
                              ([vec (make-fXvector 16)]
                               [i 0])
                              (for-clause ...) 
+                             middle-body ...
                              (let ([new-vec (if (eq? i (unsafe-fXvector-length vec))
                                                 (grow-fXvector vec)
                                                 vec)])
-                               (unsafe-fXvector-set! new-vec i (let () body ...))
+                               (unsafe-fXvector-set! new-vec i (let () last-body ...))
                                (values new-vec (unsafe-fx+ i 1))))])
                 (shrink-fXvector vec i))))]
          [(for*/fXvector #:length length-expr #:fill fill-expr (for-clause ...) body ...)
@@ -93,10 +95,11 @@
                                   (syntax/loc fc [ids (stop-after
                                                        rhs
                                                        (lambda x
-                                                         (= i len)))])]
+                                                         (unsafe-fx= i len)))])]
                                  [_ fc]))
                              (cons wrapped-fc
                                    (loop (cdr fcs) wrap-all?))]))]
+                        [((middle-body ...) (last-body ...)) (split-for-body stx #'(body ...))]
                         [for_/fXvector for_/fXvector-stx]
                         [for_/fold/derived for_/fold/derived-stx])
             (syntax/loc stx
@@ -110,7 +113,8 @@
                        orig-stx 
                        ([i 0])
                        (limited-for-clause ...)
-                       (fXvector-set! v i (let () body ...))
+                       middle-body ...
+                       (fXvector-set! v i (let () last-body ...))
                        (add1 i)))
                     v)))))]
       [(_ #:length length-expr (for-clause ...) body ...)

collects/racket/set.rkt

@@ -1,5 +1,6 @@
 #lang racket/base
-(require (for-syntax racket/base)
+(require (for-syntax racket/base
+                     syntax/for-body)
          racket/serialize
          racket/pretty
          racket/contract/base
@@ -332,10 +333,12 @@
 
 (define-syntax-rule (define-for for/fold/derived for/set set)
   (define-syntax (for/set stx)
+    (...
      (syntax-case stx ()
        [(_ bindings . body)
+        (with-syntax ([((pre-body ...) post-body) (split-for-body stx #'body)])
           (quasisyntax/loc stx
-         (for/fold/derived #,stx ([s (set)]) bindings (set-add s (let () . body))))])))
+            (for/fold/derived #,stx ([s (set)]) bindings pre-body ... (set-add s (let () . post-body)))))]))))
 
 (define-for for/fold/derived for/set set)
 (define-for for*/fold/derived for*/set set)

collects/scribblings/guide/for.scrbl

@@ -413,6 +413,74 @@ list, and also works with multiple-valued sequences:
 ]
 
 
+@section{Breaking an Iteration}
+
+An even more complete syntax of @racket[for] is
+
+@specform/subs[
+(for (clause ...)
+  body-or-break ... body)
+([clause [id sequence-expr]
+         (code:line #:when boolean-expr)
+         (code:line #:unless boolean-expr)
+         break]
+ [body-or-break body break]
+ [break  (code:line #:break boolean-expr)
+         (code:line #:final boolean-expr)])
+]{}
+
+That is, a @racket[#:break] or @racket[#:final] clause can
+be included among the binding clauses and body of the iteration. Among
+the binding clauses, @racket[#:break] is like @racket[#:unless]
+but when its @racket[_boolean-expr] is true, all sequences within the
+@racket[for] are stopped. Among the @racket[_body]s,
+@racket[#:break] has the same effect on sequences when its
+@racket[_boolean-expr] is true, and it also prevents later
+@racket[_body]s from evaluation in the current iteration.
+
+For example, while using @racket[#:when] between clauses effectively
+skips later sequences as well as the body,
+
+@interaction[
+(for ([book '("Guide" "Story" "Reference")]
+      #:unless (equal? book "Story")
+      [chapter '("Intro" "Details" "Conclusion")])
+  (printf "~a ~a\n" book chapter))
+]
+
+using @racket[#:break] causes the entire @racket[for] iteration
+to terminate:
+
+@interaction[
+(for ([book '("Guide" "Story" "Reference")]
+      #:break (equal? book "Story")
+      [chapter '("Intro" "Details" "Conclusion")])
+  (printf "~a ~a\n" book chapter))
+(for* ([book '("Guide" "Story" "Reference")]
+       [chapter '("Intro" "Details" "Conclusion")])
+  #:break (and (equal? book "Story")
+               (equal? chapter "Conclusion"))
+  (printf "~a ~a\n" book chapter))
+]
+
+A @racket[#:final] clause is similar to @racket[#:break],
+but it does not immediately terminate the iteration. Instead, it
+allows at most one more element to be drawn for each sequence and at
+most one more evaluation of the @racket[_body]s.
+
+
+@interaction[
+(for* ([book '("Guide" "Story" "Reference")]
+       [chapter '("Intro" "Details" "Conclusion")])
+  #:final (and (equal? book "Story")
+               (equal? chapter "Conclusion"))
+  (printf "~a ~a\n" book chapter))
+(for ([book '("Guide" "Story" "Reference")]
+      #:final (equal? book "Story")
+      [chapter '("Intro" "Details" "Conclusion")])
+  (printf "~a ~a\n" book chapter))
+]
+
 @section[#:tag "for-performance"]{Iteration Performance}
 
 Ideally, a @racket[for] iteration should run as fast as a loop that

collects/scribblings/reference/for.scrbl

@@ -13,16 +13,23 @@ The @racket[for] iteration forms are based on SRFI-42
 
 @section{Iteration and Comprehension Forms}
 
-@defform/subs[(for (for-clause ...) body ...+)
+@defform/subs[(for (for-clause ...) body-or-break ... body)
               ([for-clause [id seq-expr]
                            [(id ...) seq-expr]
                            (code:line #:when guard-expr)
-                           (code:line #:unless guard-expr)])
+                           (code:line #:unless guard-expr)
+                           break-clause]
+               [break-clause (code:line #:break guard-expr)
+                             (code:line #:final guard-expr)]
+               [body-or-break body
+                              bleak-clause])
               #:contracts ([seq-expr sequence?])]{
 
-Iteratively evaluates @racket[body]. The @racket[for-clause]s
+Iteratively evaluates @racket[body]s. The @racket[for-clause]s
 introduce bindings whose scope includes @racket[body] and that
 determine the number of times that @racket[body] is evaluated.
+A @racket[break-clause] either among the @racket[for-clause]s
+of @racket[body]s stops further iteration.
 
 In the simple case, each @racket[for-clause] has one of its first two
 forms, where @racket[[id seq-expr]] is a shorthand for @racket[[(id)
@@ -61,6 +68,19 @@ using the remaining @racket[for-clauses]. A @racket[for-clause] of
 the form @racket[#:unless guard-expr] corresponds to the same transformation
 with @racket[unless] in place of @racket[when].
 
+A @racket[#:break guard-expr] clause is similar to a
+@racket[#:unless guard-expr] clause, but when @racket[#:break]
+avoids evaluation of the @racket[body]s, it also effectively ends all
+sequences within the @racket[for] form.  A @racket[#:final
+guard-expr] clause is similar to @racket[#:break guard-expr], but
+instead of immediately ending sequences and skipping the
+@racket[body]s, it allows at most one more element from each later
+sequence and at most one more evaluation of the following
+@racket[body]s. Among the @racket[body]s, besides stopping the
+iteration and preventing later @racket[body] evaluations, a
+@racket[#:break guard-expr] or @racket[#:final guard-expr]
+clause starts a new internal-definition context.
+
 @examples[
 (for ([i '(1 2 3)]
       [j "abc"]
@@ -69,13 +89,28 @@ with @racket[unless] in place of @racket[when].
   (display (list i j k)))
 (for ([(i j) #hash(("a" . 1) ("b" . 20))])
   (display (list i j)))
+(for ([i '(1 2 3)]
+      [j "abc"]
+      #:break (not (odd? i))
+      [k #2(#t #f)])
+  (display (list i j k)))
+(for ([i '(1 2 3)]
+      [j "abc"]
+      #:final (not (odd? i))
+      [k #2(#t #f)])
+  (display (list i j k)))
+(for ([i '(1 2 3)]
+      [j "abc"]
+      [k #2(#t #f)])
+  #:break (not (or (odd? i) k))
+  (display (list i j k)))
 (for ()
   (display "here"))
 (for ([i '()])
   (error "doesn't get here"))
 ]}
 
-@defform[(for/list (for-clause ...) body ...+)]{ Iterates like
+@defform[(for/list (for-clause ...) body-or-break ... body)]{ Iterates like
 @racket[for], but that the last expression in the @racket[body]s must
 produce a single value, and the result of the @racket[for/list]
 expression is a list of the results in order.
@@ -89,12 +124,17 @@ element.
            #:when (odd? i)
            [k #2(#t #f)])
   (list i j k))
+(for/list ([i '(1 2 3)]
+           [j "abc"]
+           #:break (not (odd? i))
+           [k #2(#t #f)])
+  (list i j k))
 (for/list () 'any)
 (for/list ([i '()])
   (error "doesn't get here"))
 ]}
 
-@defform/subs[(for/vector maybe-length (for-clause ...) body ...+)
+@defform/subs[(for/vector maybe-length (for-clause ...) body-or-break ... body)
               ([maybe-length (code:line)
                              (code:line #:length length-expr)
                              (code:line #:length length-expr #:fill fill-expr)])
@@ -127,9 +167,9 @@ mutate a shared vector.}
 
 
 @deftogether[(
-@defform[(for/hash (for-clause ...) body ...+)]
+@defform[(for/hash (for-clause ...) body-or-break ... body)]
-@defform[(for/hasheq (for-clause ...) body ...+)]
+@defform[(for/hasheq (for-clause ...) body-or-break ... body)]
-@defform[(for/hasheqv (for-clause ...) body ...+)]
+@defform[(for/hasheqv (for-clause ...) body-or-break ... body)]
 )]{
 
 Like @racket[for/list], but the result is an immutable @tech{hash
@@ -146,7 +186,7 @@ the iteration.
 ]}
 
 
-@defform[(for/and (for-clause ...) body ...+)]{ Iterates like
+@defform[(for/and (for-clause ...) body-or-break ... body)]{ Iterates like
 @racket[for], but when last expression of @racket[body] produces
 @racket[#f], then iteration terminates, and the result of the
 @racket[for/and] expression is @racket[#f]. If the @racket[body]
@@ -159,11 +199,14 @@ result from the last evaluation of @racket[body].
   (i . < . 3))
 (for/and ([i '(1 2 3 4)])
   i)
+(for/and ([i '(1 2 3 4)])
+  #:break (= i 3)
+  i)
 (for/and ([i '()])
   (error "doesn't get here"))
 ]}
 
-@defform[(for/or (for-clause ...) body ...+)]{ Iterates like
+@defform[(for/or (for-clause ...) body-or-break ... body)]{ Iterates like
 @racket[for], but when last expression of @racket[body] produces
 a value other than @racket[#f], then iteration terminates, and
 the result of the @racket[for/or] expression is the same
@@ -181,7 +224,7 @@ result of the @racket[for/or] expression is
 ]}
 
 @deftogether[(
-@defform[(for/sum (for-clause ...) body ...+)]
+@defform[(for/sum (for-clause ...) body-or-break ... body)]
 )]{
 
 Iterates like @racket[for], but each result of the last @racket[body]
@@ -193,7 +236,7 @@ is accumulated into a result with @racket[+].
 
 
 @deftogether[(
-@defform[(for/product (for-clause ...) body ...+)]
+@defform[(for/product (for-clause ...) body-or-break ... body)]
 )]{
 
 Iterates like @racket[for], but each result of the last @racket[body]
@@ -204,7 +247,7 @@ is accumulated into a result with @racket[*].
 ]}
 
 
-@defform[(for/lists (id ...) (for-clause ...) body ...+)]{
+@defform[(for/lists (id ...) (for-clause ...) body-or-break ... body)]{
 
 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
@@ -213,7 +256,7 @@ the lists accumulated so far in the @racket[for-clause]s and
 @racket[body]s.}
 
 
-@defform[(for/first (for-clause ...) body ...+)]{ Iterates like
+@defform[(for/first (for-clause ...) body-or-break ... body)]{ Iterates like
 @racket[for], but after @racket[body] is evaluated the first
 time, then the iteration terminates, and the @racket[for/first]
 result is the (single) result of @racket[body]. If the
@@ -228,7 +271,7 @@ result is the (single) result of @racket[body]. If the
   (error "doesn't get here"))
 ]}
 
-@defform[(for/last (for-clause ...) body ...+)]{ Iterates like
+@defform[(for/last (for-clause ...) body-or-break ... body)]{ Iterates like
 @racket[for], but the @racket[for/last] result is the (single)
 result of the last evaluation of @racket[body]. If the
 @racket[body] is never evaluated, then the result of the
@@ -242,7 +285,8 @@ result of the last evaluation of @racket[body]. If the
   (error "doesn't get here"))
 ]}
 
-@defform[(for/fold ([accum-id init-expr] ...) (for-clause ...) . body)]{
+@defform[(for/fold ([accum-id init-expr] ...) (for-clause ...)
+           body-or-break ... body)]{
 
 Iterates like @racket[for]. Before iteration starts, the
 @racket[init-expr]s are evaluated to produce initial accumulator
@@ -261,7 +305,7 @@ accumulator values.
   (values (+ sum i) (cons (sqrt i) rev-roots)))
 ]}
 
-@defform[(for* (for-clause ...) body ...+)]{
+@defform[(for* (for-clause ...) body-or-break ... body)]{
 Like @racket[for], but with an implicit @racket[#:when #t] between
 each pair of @racket[for-clauses], so that all sequence iterations are
 nested.
@@ -273,19 +317,20 @@ nested.
 ]}
 
 @deftogether[(
-@defform[(for*/list (for-clause ...) body ...+)]
+@defform[(for*/list (for-clause ...) body-or-break ... body)]
-@defform[(for*/lists (id ...) (for-clause ...) body ...+)]
+@defform[(for*/lists (id ...) (for-clause ...) body-or-break ... body)]
-@defform[(for*/vector maybe-length (for-clause ...) body ...+)]
+@defform[(for*/vector maybe-length (for-clause ...) body-or-break ... body)]
-@defform[(for*/hash (for-clause ...) body ...+)]
+@defform[(for*/hash (for-clause ...) body-or-break ... body)]
-@defform[(for*/hasheq (for-clause ...) body ...+)]
+@defform[(for*/hasheq (for-clause ...) body-or-break ... body)]
-@defform[(for*/hasheqv (for-clause ...) body ...+)]
+@defform[(for*/hasheqv (for-clause ...) body-or-break ... body)]
-@defform[(for*/and (for-clause ...) body ...+)]
+@defform[(for*/and (for-clause ...) body-or-break ... body)]
-@defform[(for*/or (for-clause ...) body ...+)]
+@defform[(for*/or (for-clause ...) body-or-break ... body)]
-@defform[(for*/sum (for-clause ...) body ...+)]
+@defform[(for*/sum (for-clause ...) body-or-break ... body)]
-@defform[(for*/product (for-clause ...) body ...+)]
+@defform[(for*/product (for-clause ...) body-or-break ... body)]
-@defform[(for*/first (for-clause ...) body ...+)]
+@defform[(for*/first (for-clause ...) body-or-break ... body)]
-@defform[(for*/last (for-clause ...) body ...+)]
+@defform[(for*/last (for-clause ...) body-or-break ... body)]
-@defform[(for*/fold ([accum-id init-expr] ...) (for-clause ...) body ...+)]
+@defform[(for*/fold ([accum-id init-expr] ...) (for-clause ...)
+           body-or-break ... body)]
 )]{
 
 Like @racket[for/list], etc., but with the implicit nesting of
@@ -301,7 +346,8 @@ Like @racket[for/list], etc., but with the implicit nesting of
 @section{Deriving New Iteration Forms}
 
 @defform[(for/fold/derived orig-datum
-           ([accum-id init-expr] ...) (for-clause ...) body ...+)]{
+           ([accum-id init-expr] ...) (for-clause ...) 
+           body-or-break ... body)]{
 
 Like @racket[for/fold], but the extra @racket[orig-datum] is used as the
 source for all syntax errors.
@@ -331,7 +377,8 @@ source for all syntax errors.
 }
 
 @defform[(for*/fold/derived orig-datum
-           ([accum-id init-expr] ...) (for-clause ...) body ...+)]{
+           ([accum-id init-expr] ...) (for-clause ...) 
+           body-or-break ... body)]{
 Like @racket[for*/fold], but the extra @racket[orig-datum] is used as the source for all syntax errors.
 
 @mz-examples[#:eval for-eval

collects/syntax/for-body.rkt

@@ -0,0 +1,4 @@
+#lang racket/base
+
+(require (for-template racket/private/for))
+(provide split-for-body)

collects/syntax/scribblings/for-body.scrbl

@@ -0,0 +1,21 @@
+#lang scribble/manual
+@(require (for-label racket/base
+                     syntax/quote))
+
+@title{Parsing @racket[for] Bodies}
+
+@defmodule[syntax/for-body]{The @racketmodname[syntax/for-body] module
+provides a helper function for @racket[for]-like syntactic forms that
+wrap the body of the form while expanding to another @racket[for]-like
+form, and the wrapper should apply only after the last
+@racket[#:break] or @racket[#:final] clause in the body.}
+
+@defproc[(split-for-body [stx syntax?] [body-stxes syntax?]) syntax?]{
+
+The @racket[body-stxes] argument must have the form
+@racket[(_pre-body ... _post-body ...)], and it is rewritten into
+@racket[((_pre-body ...) (_post-body ...))] such that
+@racket[(_post-body ...)] is as large as possible without containing a
+@racket[#:break] or @racket[#:final] clause.
+
+The @racket[stx] argument is used only for reporting syntax errors.}

collects/syntax/scribblings/syntax.scrbl

@@ -17,6 +17,8 @@
 
 @include-section["reader-helpers.scrbl"]
 
+@include-section["for-body.scrbl"]
+
 @include-section["srcloc.scrbl"]
 
 @include-section["quote.scrbl"]

collects/tests/racket/flonum.rktl

@@ -31,6 +31,12 @@
 (test (flvector 1.0 2.0 3.0 -10.0 -10.0)
       'for/flvector-fill
       (for/flvector #:length 5 #:fill -10.0 ([i 3]) (+ i 1.0)))
+(test (flvector 1.0 2.0 3.0 0.0 0.0)
+      'for/flvector-fill
+      (for/flvector #:length 5 ([i 5]) #:break (= i 3) (+ i 1.0)))
+(test (flvector 1.0 2.0 3.0 4.0 0.0)
+      'for/flvector-fill
+      (for/flvector #:length 5 ([i 5]) #:final (= i 3) (+ i 1.0)))
 
 ;; for*/flvector test
 (let ((flv (flvector 0.0 0.0 0.0 0.0 1.0 2.0 0.0 2.0 4.0))

collects/tests/racket/for.rktl

@@ -156,6 +156,37 @@
              #f
              (lambda (pos val1 val2) (not (string=? val2 "4")))))
 
+
+(test '(1 2 3)
+      'three
+      (for/list ([i 10])
+        #:break (= i 3)
+        (add1 i)))
+(test '(1 2 3 4)
+      'three
+      (for/list ([i 10])
+        #:final (= i 3)
+        (add1 i)))
+
+;; Make sure that breaking a sequence stops before consuming another element:
+(test '(("1" "2" "3" "4" "5" "6" "7" "8" "9") . 10)
+      'producer
+      (let ([c 0])
+        (cons
+         (for/list ([i (in-producer (lambda () (set! c (add1 c)) c) #f)]) 
+           #:break (= i 10)
+           (number->string i))
+         c)))
+(test '(("1" "2" "3" "4" "5" "6" "7" "8" "9") . 10)
+      'producer
+      (let ([c 0])
+        (cons
+         (for*/list ([j '(0)]
+                     [i (in-producer (lambda () (set! c (add1 c)) c) #f)])
+           #:break (= i 10)
+           (number->string i))
+         c)))
+
 ;; Basic sanity checks.
 (test '#(1 2 3 4) 'for/vector (for/vector ((i (in-range 4))) (+ i 1)))
 (test '#(1 2 3 4) 'for/vector-fast (for/vector #:length 4 ((i (in-range 4))) (+ i 1)))

collects/tests/racket/set.rktl

@@ -131,6 +131,13 @@
 
 (test (set 1 2 3) 'for/set (for/set ([i '(0 1 2)]) (add1 i)))
 
+(test (set 1 2 3) 'for/set (for/set ([i '(0 1 2 3 4)]) 
+                                    #:break (= i 3)
+                                    (add1 i)))
+(test (set 1 2 3) 'for/set (for/set ([i '(0 1 2 3 4)]) 
+                                    #:final (= i 2)
+                                    (add1 i)))
+
 ;; ----------------------------------------
 
 (report-errs)

doc/release-notes/racket/HISTORY.txt

@@ -1,6 +1,8 @@
 Version 5.3.0.24
 Added PLTCOMPILEDROOTS and --compiled/-R command-line flag
-Added `reroot-path'
+Added reroot-path
+Added #:break and #:final clauses to for forms
+syntax/for-body: added
 racket/set: added set-first and set-rest, sets are streams
 
 Version 5.3.0.23