suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add #:result clause to for/fold forms

Browse Source
This commit is contained in:
Andrew Kent 2017-10-17 18:47:04 -04:00
parent 3119c5b732
commit 9e16d3f9c9
3 changed files with 172 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

36
pkgs/racket-doc/scribblings/reference/for.scrbl
View File

@ -309,8 +309,10 @@ 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-or-break ... body)]{
@defform/subs[(for/fold ([accum-id init-expr] ... maybe-result) (for-clause ...)
body-or-break ... body)
([maybe-result (code:line)
(code:line #:result result-expr)])]{
Iterates like @racket[for]. Before iteration starts, the
@racket[init-expr]s are evaluated to produce initial accumulator
@ -319,8 +321,11 @@ for each @racket[accum-id], and the corresponding current accumulator
value is placed into the location. The last expression in
@racket[body] must produce as many values as @racket[accum-id]s, and
those values become the current accumulator values. When iteration
terminates, the results of the @racket[for/fold] expression are the
accumulator values.
terminates, if a @racket[result-expr] is provided then the result of the
@racket[for/fold] is the result of evaluating @racket[result-expr]
(with @racket[accum-id]s in scope and bound to their final values),
otherwise the results of the @racket[for/fold] expression are the
accumulator values.
An @racket[accum-id] and a binding from a @racket[for-clause] can be
the same identifier. In that case, the @racket[accum-id] binding
@ -333,7 +338,19 @@ syntactically, a @racket[for-clause] is closer to to the body).
[rev-roots null])
([i '(1 2 3 4)])
(values (+ sum i) (cons (sqrt i) rev-roots)))
]}
(for/fold ([acc '()]
[seen (hash)]
#:result (reverse acc))
([x (in-list '(0 1 1 2 3 4 4 4))])
(cond
[(hash-ref seen x #f)
(values acc seen)]
[else (values (cons x acc)
(hash-set seen x #t))]))
]
@history[#:changed "6.11.0.1" @elem{Added the @racket[#:result] form.}]}
}
@defform[(for* (for-clause ...) body-or-break ... body)]{
Like @racket[for], but with an implicit @racket[#:when #t] between
@ -359,7 +376,7 @@ nested.
@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 ...)
@defform[(for*/fold ([accum-id init-expr] ... maybe-result) (for-clause ...)
body-or-break ... body)]
)]{
@ -376,7 +393,7 @@ 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 ...)
([accum-id init-expr] ... maybe-result) (for-clause ...)
body-or-break ... body)]{
Like @racket[for/fold], but the extra @racket[orig-datum] is used as the
@ -427,10 +444,12 @@ source for all syntax errors.
[s '(-1 1 1)])
(* n s))
]
@history[#:changed "6.11.0.1" @elem{Added the @racket[#:result] form.}]}
}
@defform[(for*/fold/derived orig-datum
([accum-id init-expr] ...) (for-clause ...)
([accum-id init-expr] ... maybe-result) (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.
@ -459,6 +478,7 @@ Like @racket[for*/fold], but the extra @racket[orig-datum] is used as the source
d)
]
@history[#:changed "6.11.0.1" @elem{Added the @racket[#:result] form.}]}
}
@defform[(define-sequence-syntax id

120
pkgs/racket-test-core/tests/racket/for.rktl
View File

@ -441,6 +441,106 @@
(define k i) #:final (= k 2)
(list i j)))
;; extra tests for #:result
(test '(0 1 2 3 4) 'for/fold-result-clause1
(for/fold ([acc '()]
[seen (hash)]
#:result (reverse acc))
([x (in-list '(0 1 1 2 3 4 4 4))])
(cond
[(hash-ref seen x #f)
(values acc seen)]
[else (values (cons x acc)
(hash-set seen x #t))])))
(test '((4 3 2 1 0) (0 1 2 3 4) ())
'for/fold-result-clause2
(let-values ([(backwards forwards other)
(for/fold ([acc '()]
[seen (hash)]
#:result (values acc (reverse acc) '()))
([x (in-list '(0 1 1 2 3 4 4 4))])
(cond
[(hash-ref seen x #f)
(values acc seen)]
[else (values (cons x acc)
(hash-set seen x #t))]))])
(list backwards forwards other)))
(test '(2 4 6) 'for/fold-result-clause3
(for/fold ([acc '()]
[seen (hash)]
#:result (reverse acc))
([x (in-list '(0 0 1 1 2 2))]
[y (in-list '(2 2 3 3 4 4))])
(define val (+ x y))
(cond
[(hash-ref seen val #f)
(values acc seen)]
[else (values (cons val acc)
(hash-set seen val #t))])))
(test '((6 4 2) (2 4 6) ())
'for/fold-result-clause4
(let-values ([(backwards forwards other)
(for/fold ([acc '()]
[seen (hash)]
#:result (values acc (reverse acc) '()))
([x (in-list '(0 0 1 1 2 2))]
[y (in-list '(2 2 3 3 4 4))])
(define val (+ x y))
(cond
[(hash-ref seen val #f)
(values acc seen)]
[else (values (cons val acc)
(hash-set seen val #t))]))])
(list backwards forwards other)))
(test '(0 1 2 3 4) 'for*/fold-result-clause1
(for*/fold ([acc '()]
[seen (hash)]
#:result (reverse acc))
([x (in-list '(0 1 1 2 3 4 4 4))])
(cond
[(hash-ref seen x #f)
(values acc seen)]
[else (values (cons x acc)
(hash-set seen x #t))])))
(test '((4 3 2 1 0) (0 1 2 3 4) ())
'for*/fold-result-clause2
(let-values ([(backwards forwards other)
(for*/fold ([acc '()]
[seen (hash)]
#:result (values acc (reverse acc) '()))
([x (in-list '(0 1 1 2 3 4 4 4))])
(cond
[(hash-ref seen x #f)
(values acc seen)]
[else (values (cons x acc)
(hash-set seen x #t))]))])
(list backwards forwards other)))
(test '(0 1 3 2 4 5) 'for*/fold-result-clause3
(for*/fold ([acc '()]
[seen (hash)]
#:result (reverse acc))
([xs (in-list '((0 1) (1 0) (3 2) (2 3) (4 5) (5 4)))]
[x (in-list xs)])
(cond
[(hash-ref seen x #f)
(values acc seen)]
[else (values (cons x acc)
(hash-set seen x #t))])))
(test '((5 4 2 3 1 0) (0 1 3 2 4 5) ())
'for*/fold-result-clause4
(let-values ([(backwards forwards other)
(for*/fold ([acc '()]
[seen (hash)]
#:result (values acc (reverse acc) '()))
([xs (in-list '((0 1) (1 0) (3 2) (2 3) (4 5) (5 4)))]
[x (in-list xs)])
(cond
[(hash-ref seen x #f)
(values acc seen)]
[else (values (cons x acc)
(hash-set seen x #t))]))])
(list backwards forwards other)))
;; for should discard any results and return void
(test (void) 'for-0-values (for ([x '(1 2 3)] [y '(a b c)]) (values)))
(test (void) 'for*-0-values (for* ([x '(1 2 3)] [y '(a b c)]) (values)))
@ -576,6 +676,16 @@
#rx".*for/fold:.*expected an identifier to bind.*")
(syntax-test #'(for/fold ([x 42] [x 42]) ([z '()]) 1)
#rx".*for/fold:.*duplicate identifier as accumulator binding.*")
(syntax-test #'(for/fold (#:result 42) bad 1)
#rx".*for/fold:.*bad sequence binding clauses.*")
(syntax-test #'(for/fold (#:result 42) ([42 '()]) 1)
#rx".*for/fold:.*bad sequence binding clause.*")
(syntax-test #'(for/fold ([0 42] [x 42] #:result 42) ([z '()]) 1)
#rx".*for/fold:.*expected an identifier to bind.*")
(syntax-test #'(for/fold ([x 42] [x 42] #:result 42) ([z '()]) 1)
#rx".*for/fold:.*duplicate identifier as accumulator binding.*")
(syntax-test #'(for/fold ([x 42] [x 42] #:wrong-keyword 42) ([z '()]) 1)
#rx".*for/fold:.*invalid accumulator binding clause.*")
(syntax-test #'(for*/fold () bad 1)
#rx".*for\\*/fold:.*bad sequence binding clauses.*")
@ -585,6 +695,16 @@
#rx".*for\\*/fold:.*expected an identifier to bind.*")
(syntax-test #'(for*/fold ([x 42] [x 42]) ([z '()]) 1)
#rx".*for\\*/fold:.*duplicate identifier as accumulator binding.*")
(syntax-test #'(for*/fold (#:result 42) bad 1)
#rx".*for\\*/fold:.*bad sequence binding clauses.*")
(syntax-test #'(for*/fold (#:result 42) ([42 '()]) 1)
#rx".*for\\*/fold:.*bad sequence binding clause.*")
(syntax-test #'(for*/fold ([0 42] [x 42] #:result 42) ([z '()]) 1)
#rx".*for\\*/fold:.*expected an identifier to bind.*")
(syntax-test #'(for*/fold ([x 42] [x 42] #:result 42) ([z '()]) 1)
#rx".*for\\*/fold:.*duplicate identifier as accumulator binding.*")
(syntax-test #'(for*/fold ([x 42] [x 42] #:wrong-keyword 42) ([z '()]) 1)
#rx".*for\\*/fold:.*invalid accumulator binding clause.*")
(syntax-test #'(for/vector ()) #rx".*missing body.*")

26
racket/collects/racket/private/for.rkt
View File

@ -1544,10 +1544,21 @@
(define-syntax (for/fold/derived stx)
(syntax-case stx ()
[(_ orig-stx ([fold-var finid-init] ... #:result result-expr) . rest)
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
(syntax/loc #'orig-stx
(let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #f]
([fold-var finid-init] ...)
(values* fold-var ...)
. rest)])
result-expr))]
[(_ orig-stx ([fold-var finid-init] ...) . rest)
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
(syntax/loc #'orig-stx
(for/foldX/derived/final [orig-stx #f] ([fold-var finid-init] ...) (values* fold-var ...) . rest))]
(for/foldX/derived/final [orig-stx #f]
([fold-var finid-init] ...)
(values* fold-var ...)
. rest))]
[(_ orig-stx (bindings ...) . rst)
(raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
[(_ orig-stx . rst)
@ -1555,10 +1566,21 @@
(define-syntax (for*/fold/derived stx)
(syntax-case stx ()
[(_ orig-stx ([fold-var finid-init] ... #:result result-expr) . rest)
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
(syntax/loc #'orig-stx
(let-values ([(fold-var ...) (for/foldX/derived/final [orig-stx #t]
([fold-var finid-init] ...)
(values* fold-var ...)
. rest)])
result-expr))]
[(_ orig-stx ([fold-var finid-init] ...) . rest)
(check-identifier-bindings #'orig-stx #'(fold-var ...) "accumulator" #t)
(syntax/loc #'orig-stx
(for/foldX/derived/final [orig-stx #t] ([fold-var finid-init] ...) (values* fold-var ...) . rest))]
(for/foldX/derived/final [orig-stx #t]
([fold-var finid-init] ...)
(values* fold-var ...)
. rest))]
[(_ orig-stx (bindings ...) . rst)
(raise-syntax-error #f "invalid accumulator binding clause(s)" #'orig-stx #'(bindings ...))]
[(_ orig-stx . rst)