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.
This commit is contained in:
Matthew Flatt
parent
c28d3190b2
commit
fc52248446
|
|
@ -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)
|
||||
(quasisyntax/loc stx
|
||||
(let ([gv (make-gvector)])
|
||||
(for/fold/derived #,stx () (clause ...)
|
||||
(call-with-values (lambda () . body)
|
||||
(lambda args (apply gvector-add! gv args) (values))))
|
||||
gv))]))
|
||||
(with-syntax ([((pre-body ...) post-body) (split-for-body stx #'body)])
|
||||
(quasisyntax/loc stx
|
||||
(let ([gv (make-gvector)])
|
||||
(for/fold/derived #,stx () (clause ...)
|
||||
pre-body ...
|
||||
(call-with-values (lambda () . post-body)
|
||||
(lambda args (apply gvector-add! gv args) (values))))
|
||||
gv)))]))
|
||||
|
||||
(define-syntax (for*/gvector stx)
|
||||
(syntax-case stx ()
|
||||
[(_ (clause ...) . body)
|
||||
(quasisyntax/loc stx
|
||||
(let ([gv (make-gvector)])
|
||||
(for*/fold/derived #,stx () (clause ...)
|
||||
(call-with-values (lambda () . body)
|
||||
(lambda args (apply gvector-add! gv args) (values))))
|
||||
gv))]))
|
||||
(with-syntax ([((pre-body ...) post-body) (split-for-body stx #'body)])
|
||||
(quasisyntax/loc stx
|
||||
(let ([gv (make-gvector)])
|
||||
(for*/fold/derived #,stx () (clause ...)
|
||||
pre-body ...
|
||||
(call-with-values (lambda () . post-body)
|
||||
(lambda args (apply gvector-add! gv args) (values))))
|
||||
gv)))]))
|
||||
|
||||
(struct gvector (vec n)
|
||||
#:mutable
|
||||
|
|
|
|||
|
|
@ -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,22 +1418,27 @@
|
|||
(andmap identifier? (or (syntax->list #'ids) '(#f))))
|
||||
(cons #`[ids #,(rhs-wrap #'rhs)]
|
||||
(loop (cdr bs)))]
|
||||
[#:when (cons (car bs)
|
||||
(if (null? (cdr bs))
|
||||
null
|
||||
(cons (cadr bs) (loop (cddr 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)])))
|
||||
|
||||
|
||||
(define-syntax define-syntax-via-derived
|
||||
(syntax-rules ()
|
||||
[(_ id derived-id fold-bind wrap rhs-wrap combine)
|
||||
|
|
@ -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,21 +1531,23 @@
|
|||
[_ 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
|
||||
(let ([len length-expr])
|
||||
(unless (exact-nonnegative-integer? len)
|
||||
(raise-argument-error 'for_/vector "exact-nonnegative-integer?" len))
|
||||
(let ([v (make-vector len fill-expr)])
|
||||
(unless (zero? len)
|
||||
(for_/fold/derived
|
||||
orig-stx
|
||||
([i 0])
|
||||
(limited-for-clause ...)
|
||||
(vector-set! v i (let () body ...))
|
||||
(add1 i)))
|
||||
v))))]
|
||||
(syntax/loc stx
|
||||
(let ([len length-expr])
|
||||
(unless (exact-nonnegative-integer? len)
|
||||
(raise-argument-error 'for_/vector "exact-nonnegative-integer?" len))
|
||||
(let ([v (make-vector len fill-expr)])
|
||||
(unless (zero? len)
|
||||
(for_/fold/derived
|
||||
orig-stx
|
||||
([i 0])
|
||||
(limited-for-clause ...)
|
||||
middle-body ...
|
||||
(vector-set! v i (let () last-body ...))
|
||||
(add1 i)))
|
||||
v))))]
|
||||
[(_ #:length length-expr (for-clause ...) body ...)
|
||||
(for_/vector #'(fv #:length length-expr #:fill 0 (for-clause ...) body ...)
|
||||
orig-stx for_/vector-stx for_/fold/derived-stx wrap-all?)]))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ...)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
(quasisyntax/loc stx
|
||||
(for/fold/derived #,stx ([s (set)]) bindings (set-add s (let () . body))))])))
|
||||
(...
|
||||
(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 pre-body ... (set-add s (let () . post-body)))))]))))
|
||||
|
||||
(define-for for/fold/derived for/set set)
|
||||
(define-for for*/fold/derived for*/set set)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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/hasheq (for-clause ...) body ...+)]
|
||||
@defform[(for/hasheqv (for-clause ...) body ...+)]
|
||||
@defform[(for/hash (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for/hasheq (for-clause ...) body-or-break ... 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*/lists (id ...) (for-clause ...) body ...+)]
|
||||
@defform[(for*/vector maybe-length (for-clause ...) body ...+)]
|
||||
@defform[(for*/hash (for-clause ...) body ...+)]
|
||||
@defform[(for*/hasheq (for-clause ...) body ...+)]
|
||||
@defform[(for*/hasheqv (for-clause ...) body ...+)]
|
||||
@defform[(for*/and (for-clause ...) body ...+)]
|
||||
@defform[(for*/or (for-clause ...) body ...+)]
|
||||
@defform[(for*/sum (for-clause ...) body ...+)]
|
||||
@defform[(for*/product (for-clause ...) body ...+)]
|
||||
@defform[(for*/first (for-clause ...) body ...+)]
|
||||
@defform[(for*/last (for-clause ...) body ...+)]
|
||||
@defform[(for*/fold ([accum-id init-expr] ...) (for-clause ...) body ...+)]
|
||||
@defform[(for*/list (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/lists (id ...) (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)]
|
||||
@defform[(for*/hasheqv (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/and (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/or (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/sum (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/product (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/first (for-clause ...) body-or-break ... body)]
|
||||
@defform[(for*/last (for-clause ...) body-or-break ... 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
|
||||
|
|
|
|||
4
collects/syntax/for-body.rkt
Normal file
4
collects/syntax/for-body.rkt
Normal file
|
|
@ -0,0 +1,4 @@
|
|||
#lang racket/base
|
||||
|
||||
(require (for-template racket/private/for))
|
||||
(provide split-for-body)
|
||||
21
collects/syntax/scribblings/for-body.scrbl
Normal file
21
collects/syntax/scribblings/for-body.scrbl
Normal file
|
|
@ -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.}
|
||||
|
|
@ -17,6 +17,8 @@
|
|||
|
||||
@include-section["reader-helpers.scrbl"]
|
||||
|
||||
@include-section["for-body.scrbl"]
|
||||
|
||||
@include-section["srcloc.scrbl"]
|
||||
|
||||
@include-section["quote.scrbl"]
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user