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

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

Browse Source
This commit is contained in:
Philip McGrath 2018-10-28 17:53:18 -04:00 committed by Matthew Flatt
parent 6d8596bae3
commit b3104a6acd
3 changed files with 79 additions and 23 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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
as many lists as supplied @racket[id]s. The @racket[id]s are bound to
should produce as many values as given @racket[id]s.
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)]

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

@ -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)))

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

@ -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 ...))])
(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) ...))))]))
(do-without-result-clause stx)]))
(define-syntax (for/lists stx) (do-for/lists #'for/fold/derived stx))
(define-syntax (for*/lists stx) (do-for/lists #'for*/fold/derived stx))