From b3104a6acde26df58ce73be2934e66fd39bdd8d7 Mon Sep 17 00:00:00 2001 From: Philip McGrath Date: Sun, 28 Oct 2018 17:53:18 -0400 Subject: [PATCH] add #:result clause to for/lists and for*/lists --- .../scribblings/reference/for.scrbl | 25 ++++++++--- pkgs/racket-test-core/tests/racket/for.rktl | 32 +++++++++++++ racket/collects/racket/private/for.rkt | 45 +++++++++++-------- 3 files changed, 79 insertions(+), 23 deletions(-) diff --git a/pkgs/racket-doc/scribblings/reference/for.scrbl b/pkgs/racket-doc/scribblings/reference/for.scrbl index 48a75f9b92..b548f446eb 100644 --- a/pkgs/racket-doc/scribblings/reference/for.scrbl +++ b/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 -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)] diff --git a/pkgs/racket-test-core/tests/racket/for.rktl b/pkgs/racket-test-core/tests/racket/for.rktl index 0c21a97839..10d10b90da 100644 --- a/pkgs/racket-test-core/tests/racket/for.rktl +++ b/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))) diff --git a/racket/collects/racket/private/for.rkt b/racket/collects/racket/private/for.rkt index 3fd3155ddf..120c73757b 100644 --- a/racket/collects/racket/private/for.rkt +++ b/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 ...))]) - (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))