racket/generator: clean-ups, including planned generalization
- syntax is now (generator formals body ...+) - add `generator?' - remove common run-time code from the `generator' macro expansion - doc fixes - start test suite
This commit is contained in:
parent
056a3fb588
commit
0efcf22ed4
|
@ -5,7 +5,8 @@
|
|||
racket/stxparam racket/splicing)
|
||||
|
||||
(provide yield generator generator-state in-generator infinite-generator
|
||||
sequence->generator sequence->repeated-generator)
|
||||
sequence->generator sequence->repeated-generator
|
||||
generator?)
|
||||
|
||||
;; (define-syntax-parameter yield
|
||||
;; (lambda (stx)
|
||||
|
@ -54,13 +55,35 @@
|
|||
|
||||
(define-syntax (generator stx)
|
||||
(syntax-case stx ()
|
||||
[(_ () body0 body ...) #'(generator-old body0 body ...)]
|
||||
[_ (raise-syntax-error
|
||||
'generator "must have a form of (generator () body ...)")]))
|
||||
[(_ formals body0 body ...)
|
||||
(if (let loop ([formals #'formals])
|
||||
(cond
|
||||
[(null? formals) #t]
|
||||
[(identifier? formals) #t]
|
||||
[(syntax? formals) (loop (syntax-e formals))]
|
||||
[(pair? formals) (and (identifier? (car formals))
|
||||
(loop (cdr formals)))]
|
||||
[else #f]))
|
||||
#'(create-generator (let ([generator
|
||||
(lambda formals
|
||||
body0 body ...)])
|
||||
generator))
|
||||
(raise-syntax-error
|
||||
#f
|
||||
"bad syntax for formal initial arguments"
|
||||
stx
|
||||
#'formals))]
|
||||
[_ (if (identifier? stx)
|
||||
(raise-syntax-error #f "bad syntax" stx)
|
||||
(raise-syntax-error
|
||||
#f
|
||||
(format "use does not have the form (~a formals body ...)"
|
||||
(syntax-e (car (syntax-e stx))))
|
||||
stx))]))
|
||||
|
||||
(define-syntax-rule (generator-old body0 body ...)
|
||||
(define (create-generator start)
|
||||
(let ([state 'fresh])
|
||||
(define (cont)
|
||||
(define (cont . init-formals)
|
||||
(define (yielder . vs)
|
||||
(set! state 'suspended)
|
||||
(shift-at yield-tag k (set! cont k) (apply values vs)))
|
||||
|
@ -68,13 +91,16 @@
|
|||
(reset-at yield-tag
|
||||
(parameterize ([current-yielder yielder])
|
||||
(call-with-values
|
||||
(lambda () (begin body0 body ...))
|
||||
(lambda ()
|
||||
(apply start init-formals))
|
||||
;; get here only on at the end of the generator
|
||||
(lambda rs
|
||||
(set! cont (lambda () (set! state 'done) (apply values rs)))
|
||||
(cont))))))
|
||||
(define (err [what "send a value to"])
|
||||
(error 'generator "cannot ~a a ~a generator" what state))
|
||||
(raise-mismatch-error 'generator
|
||||
(format "cannot ~a a ~a generator: " what state)
|
||||
self))
|
||||
(define generator
|
||||
(case-lambda
|
||||
[() (if (eq? state 'running)
|
||||
|
@ -82,24 +108,28 @@
|
|||
(begin (set! state 'running) (cont)))]
|
||||
;; yield-tag means return the state (see `generator-state' below)
|
||||
[(x) (cond [(eq? x yield-tag) state]
|
||||
[(memq state '(suspended running))
|
||||
[(memq state '(suspended running fresh))
|
||||
(set! state 'running)
|
||||
(cont x)]
|
||||
[else (err)])]
|
||||
[xs (if (memq state '(suspended running))
|
||||
[xs (if (memq state '(suspended running fresh))
|
||||
(begin (set! state 'running) (apply cont xs))
|
||||
(err))]))
|
||||
generator))
|
||||
(define self (make-generator generator))
|
||||
self))
|
||||
|
||||
(define-struct generator (proc)
|
||||
#:property prop:procedure 0
|
||||
#:omit-define-syntaxes)
|
||||
|
||||
;; Get the state -- this is a hack: uses yield-tag as a hidden value that makes
|
||||
;; the generator return its state. Protect against grabbing this tag (eg, with
|
||||
;; (generator-state values)) by inspecting the result (so it can still be
|
||||
;; deceived, but that will be harmless).
|
||||
(define (generator-state g)
|
||||
(let ([s (and (procedure? g) (procedure-arity-includes? g 1) (g yield-tag))])
|
||||
(if (memq s '(fresh running suspended done))
|
||||
s
|
||||
(raise-type-error 'generator-state "generator" g))))
|
||||
(if (generator? g)
|
||||
(g yield-tag)
|
||||
(raise-type-error 'generator-state "generator" g)))
|
||||
|
||||
(define-syntax-rule (infinite-generator body0 body ...)
|
||||
(generator () (let loop () body0 body ... (loop))))
|
||||
|
|
|
@ -46,7 +46,7 @@ built-in datatypes, the sequence datatype includes the following:
|
|||
]
|
||||
|
||||
In addition, @scheme[make-do-sequence] creates a sequence given a thunk
|
||||
that returns procedures to implement a generator, and the
|
||||
that returns procedures to implement a sequence, and the
|
||||
@scheme[prop:sequence] property can be associated with a structure type.
|
||||
|
||||
For most sequence types, extracting elements from a sequence has no
|
||||
|
@ -295,7 +295,7 @@ in the sequence.
|
|||
((any/c) () #:rest list? . ->* . any/c)))])
|
||||
sequence?]{
|
||||
Returns a sequence whose elements are generated by the procedures and
|
||||
initial value returned by the thunk. The generator is defined in terms
|
||||
initial value returned by the thunk. The sequence is defined in terms
|
||||
of a @defterm{position}, which is initialized to the third result of
|
||||
the thunk, and the @defterm{element}, which may consist of multiple
|
||||
values.
|
||||
|
@ -476,22 +476,42 @@ overhead for accessing the resulting sequence.
|
|||
|
||||
@; ----------------------------------------------------------------------
|
||||
@section{Iterator Generators}
|
||||
|
||||
@defmodule[racket/generator]
|
||||
|
||||
A @deftech{generator} is a procedure that returns a sequence of
|
||||
values, incrementing the sequence each time that the generator is
|
||||
called. In particular, the @racket[generator] form implements a
|
||||
generator by evaluating a body that calls @racket[yield] to return
|
||||
values from the generator.
|
||||
|
||||
@(define generator-eval
|
||||
(let ([the-eval (make-base-eval)])
|
||||
(the-eval '(require racket/generator))
|
||||
the-eval))
|
||||
|
||||
@defform[(generator () body ...)]{
|
||||
Creates a function that returns a value through @scheme[yield], each
|
||||
time it is invoked. When the generator runs out of values to yield,
|
||||
the last value it computed will be returned for future invocations of
|
||||
the generator. Generators can be safely nested.
|
||||
|
||||
Note: The first form must be @scheme[()]. In the future, the
|
||||
@scheme[()] position will hold argument names that are used for the
|
||||
initial generator call.
|
||||
@defproc[(generator? [v any/c]) boolean?]{
|
||||
Return @scheme[#t] if @scheme[v] is a @tech{generator},
|
||||
@scheme[#f] otherwise.}
|
||||
|
||||
|
||||
@defform[(generator formals body ...+)]{
|
||||
Creates a @tech{generator}, where @racket[formals] is like the
|
||||
@racket[formals] of @racket[case-lambda] (i.e., the
|
||||
@racket[_kw-formals] of @racket[lambda] restricted to non-optional
|
||||
and non-keyword arguments).
|
||||
|
||||
For the first call to a generator, the arguments are bound to the
|
||||
@racket[formals] and evaluation of @racket[body] starts. During the
|
||||
@tech{dynamic extent} of @racket[body], the generator can return
|
||||
immediately using the @racket[yield] function. A second call to the
|
||||
generator resumes at the @racket[yield] call, producing the
|
||||
arguments of the second call as the results of the @racket[yield],
|
||||
and so on. The eventual results of @racket[body] are supplied to an
|
||||
implicit final @racket[yield]; after that final @racket[yield],
|
||||
calling the generator again returns the same values, but all such
|
||||
calls must provide 0 arguments to the generator.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(define g (generator ()
|
||||
|
@ -505,62 +525,19 @@ overhead for accessing the resulting sequence.
|
|||
(g)
|
||||
(g)
|
||||
(g)
|
||||
(g)]
|
||||
(g)]}
|
||||
|
||||
To use an existing generator as a sequence, use
|
||||
@scheme[in-producer] with a stop-value known for the generator.
|
||||
@defproc[(yield [v any/c] ...) any]{
|
||||
Returns @racket[v]s from a generator, saving the point of execution
|
||||
inside a generator (i.e., within the @tech{dynamic extent} of a
|
||||
@racket[generator] body) to be resumed by the next call to the
|
||||
generator. The results of @racket[yield] are the arguments
|
||||
that are provided to the next call of the generator.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(define my-stop-value (gensym))
|
||||
(define my-generator (generator ()
|
||||
(let loop ([x '(a b c)])
|
||||
(if (null? x)
|
||||
my-stop-value
|
||||
(begin
|
||||
(yield (car x))
|
||||
(loop (cdr x)))))))
|
||||
|
||||
(for/list ([i (in-producer my-generator my-stop-value)])
|
||||
i)]}
|
||||
|
||||
@defform[(infinite-generator body ...)]{
|
||||
Creates a function similar to @scheme[generator] but when the last
|
||||
@scheme[body] is evaluated, the function will re-evaluate all of the bodies
|
||||
in a loop.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(define welcome
|
||||
(infinite-generator
|
||||
(yield 'hello)
|
||||
(yield 'goodbye)))
|
||||
(welcome)
|
||||
(welcome)
|
||||
(welcome)
|
||||
(welcome)]}
|
||||
|
||||
@defproc[(in-generator [expr any?] ...) sequence?]{
|
||||
Returns a generator that can be used as a sequence. The
|
||||
@scheme[in-generator] procedure takes care of the case when
|
||||
@scheme[expr] stops producing values, so when the @scheme[expr]
|
||||
completes, the generator will end.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(for/list ([i (in-generator
|
||||
(let loop ([x '(a b c)])
|
||||
(when (not (null? x))
|
||||
(yield (car x))
|
||||
(loop (cdr x)))))])
|
||||
i)]}
|
||||
|
||||
@defform[(yield expr ...)]{
|
||||
Saves the point of execution inside a generator and returns a value.
|
||||
@scheme[yield] can accept any number of arguments and will return them
|
||||
using @scheme[values].
|
||||
|
||||
Values can be passed back to the generator after invoking
|
||||
@scheme[yield] by passing the arguments to the generator instance.
|
||||
Note that a value cannot be passed back to the generator until after
|
||||
the first @scheme[yield] has been invoked.
|
||||
When not in the @tech{dynamic extent} of a @racket[generator],
|
||||
@racket[infinite-generator], or @racket[in-generator] body,
|
||||
@racket[yield] raises @racket[exn:fail] after evaluating its
|
||||
@racket[expr]s.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(define my-generator (generator () (yield 1) (yield 2 3 4)))
|
||||
|
@ -578,21 +555,62 @@ overhead for accessing the resulting sequence.
|
|||
(pass-values-generator 5)
|
||||
(pass-values-generator 12)]}
|
||||
|
||||
@defproc[(generator-state [g any?]) symbol?]{
|
||||
@defform[(infinite-generator body ...+)]{
|
||||
Like @scheme[generator], but repeats evaluation of the @racket[body]s when
|
||||
the last @racket[body] completes without implicitly @racket[yield]ing.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(define welcome
|
||||
(infinite-generator
|
||||
(yield 'hello)
|
||||
(yield 'goodbye)))
|
||||
(welcome)
|
||||
(welcome)
|
||||
(welcome)
|
||||
(welcome)]}
|
||||
|
||||
@defform[(in-generator body ...+)]{
|
||||
Produces a @tech{sequence} that encapsulates the @tech{generator} formed by
|
||||
@racket[(generator () body ...+)]. The values produced by the
|
||||
generator form the elements of the sequence.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(for/list ([i (in-generator
|
||||
(let loop ([x '(a b c)])
|
||||
(when (not (null? x))
|
||||
(yield (car x))
|
||||
(loop (cdr x)))))])
|
||||
i)]
|
||||
|
||||
To use an existing generator as a sequence, use @scheme[in-producer]
|
||||
with a stop-value known for the generator.
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(define my-stop-value (gensym))
|
||||
(define my-generator (generator ()
|
||||
(let loop ([x '(a b c)])
|
||||
(if (null? x)
|
||||
my-stop-value
|
||||
(begin
|
||||
(yield (car x))
|
||||
(loop (cdr x)))))))
|
||||
|
||||
(for/list ([i (in-producer my-generator my-stop-value)])
|
||||
i)]}
|
||||
|
||||
@defproc[(generator-state [g generator?]) symbol?]{
|
||||
Returns a symbol that describes the state of the generator.
|
||||
|
||||
@itemize[
|
||||
@item{@scheme['fresh] --- The generator has been freshly created and
|
||||
has not been invoked yet. Values cannot be passed to a fresh
|
||||
generator.}
|
||||
has not been called yet.}
|
||||
@item{@scheme['suspended] --- Control within the generator has been
|
||||
suspended due to a call to @scheme[yield]. The generator can
|
||||
be invoked.}
|
||||
@item{@scheme['running] --- The generator is currently executing.
|
||||
This state can only be returned if @scheme[generator-state] is
|
||||
invoked inside the generator.}
|
||||
@item{@scheme['done] --- The generator has executed its entire body
|
||||
and will not call @scheme[yield] anymore.}]
|
||||
be called.}
|
||||
@item{@scheme['running] --- The generator is currently executing.}
|
||||
@item{@scheme['done] --- The generator has executed its entire
|
||||
body and will continue to produce the same result as from
|
||||
the last call.}]
|
||||
|
||||
@examples[#:eval generator-eval
|
||||
(define my-generator (generator () (yield 1) (yield 2)))
|
||||
|
@ -611,11 +629,16 @@ overhead for accessing the resulting sequence.
|
|||
(generator-state introspective-generator)
|
||||
(introspective-generator)]}
|
||||
|
||||
@defproc[(sequence->generator [s sequence?]) (-> any?)]{
|
||||
Returns a generator that returns elements from the sequence,
|
||||
@scheme[s], each time the generator is invoked.}
|
||||
@defproc[(sequence->generator [s sequence?]) (-> any)]{
|
||||
Converts a @tech{sequence} to a @tech{generator}. The generator
|
||||
returns the next element of the sequence each time the generator is
|
||||
invoked, where each element of the sequence must be a single
|
||||
value. When the sequence ends, the generator returns @|void-const|
|
||||
as its final result.}
|
||||
|
||||
@defproc[(sequence->repeated-generator [s sequence?]) (-> any?)]{
|
||||
Returns a generator that returns elements from the sequence,
|
||||
@scheme[s], similar to @scheme[sequence->generator] but looping over
|
||||
the values in the sequence when no more values are left.}
|
||||
@defproc[(sequence->repeated-generator [s sequence?]) (-> any)]{
|
||||
Like @scheme[sequence->generator], but when @racket[s] has no further
|
||||
values, the generator starts the sequence again (so that the
|
||||
generator never stops producing values).}
|
||||
|
||||
@close-eval[generator-eval]
|
||||
|
|
61
collects/tests/racket/generator.rktl
Normal file
61
collects/tests/racket/generator.rktl
Normal file
|
@ -0,0 +1,61 @@
|
|||
|
||||
(load-relative "loadtest.rktl")
|
||||
|
||||
(Section 'generator)
|
||||
|
||||
(require racket/generator)
|
||||
|
||||
(test #f generator? 5)
|
||||
(test #f generator? void)
|
||||
(test #f generator? error)
|
||||
|
||||
(let ([g (generator ()
|
||||
(test 'next 'yield (yield 0))
|
||||
(yield 1)
|
||||
(test 'q 'yield (yield 2 3))
|
||||
3)])
|
||||
(test #t generator? g)
|
||||
(test 'fresh generator-state g)
|
||||
(test 0 g)
|
||||
(test 1 g 'next)
|
||||
(test 'suspended generator-state g)
|
||||
(test-values (list 2 3) (lambda () (g 'x 'y 'z)))
|
||||
(test 'suspended generator-state g)
|
||||
(test 3 g 'q)
|
||||
(test 'done generator-state g)
|
||||
(test 3 g)
|
||||
(test 3 g)
|
||||
(err/rt-test (g 1)))
|
||||
|
||||
(let ([g (infinite-generator (yield 11))])
|
||||
(test 11 g)
|
||||
(test 11 g)
|
||||
(test 11 g)
|
||||
(test 11 g))
|
||||
|
||||
(for ([gi (in-generator (yield 1) (yield 2) (yield 3))]
|
||||
[i (in-naturals)])
|
||||
(test i sub1 gi))
|
||||
|
||||
(let ([g (sequence->generator (in-range 3))])
|
||||
(test 0 g)
|
||||
(test 1 g)
|
||||
(test 2 g)
|
||||
(test (void) g)
|
||||
(test (void) g))
|
||||
|
||||
(let ([g (sequence->repeated-generator (in-range 3))])
|
||||
(test 0 g)
|
||||
(test 1 g)
|
||||
(test 2 g)
|
||||
(test 0 g)
|
||||
(test 1 g)
|
||||
(test 2 g)
|
||||
(test 0 g))
|
||||
|
||||
(let ([g (generator () (values 1 2))])
|
||||
(test-values '(1 2) g)
|
||||
(test-values '(1 2) g))
|
||||
|
||||
(report-errs)
|
||||
|
|
@ -17,6 +17,7 @@
|
|||
(load-in-sandbox "date.rktl")
|
||||
(load-in-sandbox "compat.rktl")
|
||||
(load-in-sandbox "cmdline.rktl")
|
||||
(load-in-sandbox "generator.rktl")
|
||||
(load-in-sandbox "pconvert.rktl")
|
||||
(load-in-sandbox "pretty.rktl")
|
||||
(load-in-sandbox "control.rktl")
|
||||
|
|
Loading…
Reference in New Issue
Block a user