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.
This commit is contained in:
Eli Barzilay 2013-05-08 13:16:36 -04:00
parent 2d63564a6d
commit c228b13f9f
3 changed files with 79 additions and 34 deletions

View File

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

View File

@ -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?]{

View File

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