From 0efcf22ed43938a686b1e369c0545c3a58de0b97 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 15 Mar 2011 20:09:34 -0600 Subject: [PATCH] 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 --- collects/racket/generator.rkt | 60 ++++-- .../scribblings/reference/sequences.scrbl | 191 ++++++++++-------- collects/tests/racket/generator.rktl | 61 ++++++ collects/tests/racket/mzlib-tests.rktl | 1 + 4 files changed, 214 insertions(+), 99 deletions(-) create mode 100644 collects/tests/racket/generator.rktl diff --git a/collects/racket/generator.rkt b/collects/racket/generator.rkt index 8932b797ac..4d04d0f885 100644 --- a/collects/racket/generator.rkt +++ b/collects/racket/generator.rkt @@ -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)))) diff --git a/collects/scribblings/reference/sequences.scrbl b/collects/scribblings/reference/sequences.scrbl index 38f082d3ba..263ee7dfde 100644 --- a/collects/scribblings/reference/sequences.scrbl +++ b/collects/scribblings/reference/sequences.scrbl @@ -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,91 +476,68 @@ 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 () (let loop ([x '(a b c)]) (if (null? x) - 0 - (begin - (yield (car x)) - (loop (cdr x))))))) + 0 + (begin + (yield (car x)) + (loop (cdr x))))))) (g) (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] diff --git a/collects/tests/racket/generator.rktl b/collects/tests/racket/generator.rktl new file mode 100644 index 0000000000..8c591f79c7 --- /dev/null +++ b/collects/tests/racket/generator.rktl @@ -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) + diff --git a/collects/tests/racket/mzlib-tests.rktl b/collects/tests/racket/mzlib-tests.rktl index 5305a069b0..5c362d947a 100644 --- a/collects/tests/racket/mzlib-tests.rktl +++ b/collects/tests/racket/mzlib-tests.rktl @@ -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")