From c228b13f9f4ece48b8ef749bee30aa202bc996dd Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Wed, 8 May 2013 13:16:36 -0400 Subject: [PATCH] Make the stop value for `in-producer' optional. There are many cases where you just want to use some other tool like `#:break' to stop the iteration, so no need to make up a bogus stop value and no need to spend time checking it. --- collects/racket/private/for.rkt | 65 ++++++++++++------- .../scribblings/reference/sequences.scrbl | 32 +++++++-- collects/tests/racket/for.rktl | 16 +++-- 3 files changed, 79 insertions(+), 34 deletions(-) diff --git a/collects/racket/private/for.rkt b/collects/racket/private/for.rkt index 6dadd5a1d3..8af13b4cb3 100644 --- a/collects/racket/private/for.rkt +++ b/collects/racket/private/for.rkt @@ -1032,21 +1032,26 @@ poses vals))))))))) - (define (in-producer producer stop . more) - (make-do-sequence - (lambda () - (values (if (null? more) - (lambda (_) (producer)) - (lambda (_) (apply producer more))) - void - (void) - #f - (if (procedure? stop) - (if (equal? 1 (procedure-arity stop)) - (lambda (x) (not (stop x))) - (lambda xs (not (apply stop xs)))) - (lambda (x) (not (eq? x stop)))) - #f)))) + (define in-producer + (case-lambda + [(producer) + ;; simple stop-less version + (make-do-sequence (lambda () (values producer void (void) #f #f #f)))] + [(producer stop . more) + (define produce! + (if (null? more) + (lambda (_) (producer)) + (lambda (_) (apply producer more)))) + (define stop? + (cond [(not (procedure? stop)) + (lambda (x) (not (eq? x stop)))] + [(equal? 1 (procedure-arity stop)) + (lambda (x) (not (stop x)))] + [else + (lambda xs (not (apply stop xs)))])) + (make-do-sequence + (lambda () + (values produce! void (void) #f stop? #f)))])) ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; running sequences outside of a loop: @@ -1597,7 +1602,7 @@ (lambda (x) x)) (define-for-variants (for/first for*/first) - ([val #f][stop? #f]) + ([val #f] [stop? #f]) (lambda (x) #`(let-values ([(val _) #,x]) val)) (lambda (rhs) #`(stop-after #,rhs (lambda x stop?))) (lambda (x) #`(values #,x #t))) @@ -1849,11 +1854,11 @@ (:do-in ([(producer*) producer] [(more*) more] ... [(stop?) (let ([s stop]) - (if (procedure? s) - s - (lambda (args) - (and (not (null? args)) - (eq? (car args) s)))))]) + (if (procedure? s) + s + (lambda (args) + (and (not (null? args)) + (eq? (car args) s)))))]) ;; outer check #t ;; loop bindings @@ -1874,7 +1879,7 @@ (with-syntax ([(more* ...) (generate-temporaries #'(more ...))]) #'[(id ...) (:do-in - ;;outer bindings + ;; outer bindings ([(producer*) producer] [(more*) more] ... [(stop?) (let ([s stop]) (if (procedure? s) @@ -1895,7 +1900,21 @@ ;; post guard #t ;; loop args - ())])]))) + ())])] + ;; stop-less versions + [[(id) (_ producer)] + #'[(id) + (:do-in ([(producer*) producer]) #t () #t ([(id) (producer*)]) + #t #t ())]] + [[() (_ producer)] + #'[() + (:do-in ([(producer*) producer]) #t () #t + ([(check) (call-with-values producer* (lambda vs vs))]) + #t #t ())]] + [[(id ...) (_ producer stop more ...)] + #'[(id ...) + (:do-in ([(producer*) producer]) #t () #t ([(id ...) (producer*)]) + #t #t ())]]))) ;; Some iterators that are implemented using `*in-producer' (note: do not use ;; `in-producer', since in this module it is the procedure version). diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index 5a5da08e18..56976670a8 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -374,18 +374,36 @@ each element in the sequence. a sequence. } -@defproc[(in-producer [producer procedure?] [stop any/c] [arg any/c] ...) - sequence?]{ +@defproc*[([(in-producer [producer procedure?]) + sequence?] + [(in-producer [producer procedure?] [stop any/c] [arg any/c] ...) + sequence?])]{ Returns a sequence that contains values from sequential calls to - @racket[producer], providing all @racket[arg]s to every call to - @racket[producer]. A @racket[stop] value returned by - @racket[producer] marks the end of the sequence (and the - @racket[stop] value is not included in the sequence); @racket[stop] - can be a predicate that is applied to the results of + @racket[producer], which would usually use some state to do its work. + + If a @racket[stop] value is not given, the sequence goes on + infinitely, and therefore it common to use it with a finite sequence + or using @racket[#:break] etc. If a @racket[stop] value is given, it + is used to identify a value that marks the end of the sequence (and + the @racket[stop] value is not included in the sequence); + @racket[stop] can be a predicate that is applied to the results of @racket[producer], or it can be a value that is tested against the result of with @racket[eq?]. (The @racket[stop] argument must be a predicate if the stop value is itself a function or if @racket[producer] returns multiple values.) + + If additional @racket[arg]s are specified, they are passed to every + call to @racket[producer]. + + @examples[ + (define (counter) + (define n 0) + (lambda ([d 1]) (set! n (+ d n)) n)) + (for/list ([x (in-producer (counter))] [y (in-range 4)]) x) + (for/list ([x (in-producer (counter))] #:break (= x 5)) x) + (for/list ([x (in-producer (counter) 5)]) x) + (for/list ([x (in-producer (counter) 5 1/2)]) x) + (for/list ([x (in-producer read eof (open-input-string "1 2 3"))]) x)] } @defproc[(in-value [v any/c]) sequence?]{ diff --git a/collects/tests/racket/for.rktl b/collects/tests/racket/for.rktl index ec34868f08..9482bf0230 100644 --- a/collects/tests/racket/for.rktl +++ b/collects/tests/racket/for.rktl @@ -99,6 +99,14 @@ (test-sequence [(a b c) (0 1 2)] (in-indexed '(a b c))) +(let () + (define (counter) (define n 0) (lambda ([d 1]) (set! n (+ d n)) n)) + (test-sequence [(1 2 3 4)] (for/list ([x (in-producer (counter))] [y (in-range 4)]) x)) + (test-sequence [(1 2 3 4)] (for/list ([x (in-producer (counter))] #:break (= x 5)) x)) + (test-sequence [(1 2 3 4)] (for/list ([x (in-producer (counter) 5)]) x)) + (test-sequence [(1/2 1 3/2 2 5/2 3 7/2 4 9/2)] + (for/list ([x (in-producer (counter) 5 1/2)]) x))) + (test-sequence [(1 2 3 4 5)] (parameterize ([current-input-port (open-input-string "1 2 3\n4 5")]) (for/list ([i (in-producer read eof)]) i))) @@ -177,7 +185,7 @@ 'producer (let ([c 0]) (cons - (for/list ([i (in-producer (lambda () (set! c (add1 c)) c) #f)]) + (for/list ([i (in-producer (lambda () (set! c (add1 c)) c))]) #:break (= i 10) (number->string i)) c))) @@ -186,7 +194,7 @@ (let ([c 0]) (cons (for*/list ([j '(0)] - [i (in-producer (lambda () (set! c (add1 c)) c) #f)]) + [i (in-producer (lambda () (set! c (add1 c)) c))]) #:break (= i 10) (number->string i)) c))) @@ -257,7 +265,7 @@ 'producer (let ([c 0]) (cons - (for/vector #:length 10 ([i (in-producer (lambda () (set! c (add1 c)) c) #f)]) + (for/vector #:length 10 ([i (in-producer (lambda () (set! c (add1 c)) c))]) (number->string i)) c))) (test '(#("1" "2" "3" "4" "5" "6" "7" "8" "9" "10") . 10) @@ -265,7 +273,7 @@ (let ([c 0]) (cons (for*/vector #:length 10 ([j '(0)] - [i (in-producer (lambda () (set! c (add1 c)) c) #f)]) + [i (in-producer (lambda () (set! c (add1 c)) c))]) (number->string i)) c)))