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

@@ -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 ...)]
+    [(_ formals body0 body ...) 
-    [_ (raise-syntax-error
+     (if (let loop ([formals #'formals])
-        'generator "must have a form of (generator () body ...)")]))
+           (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 (generator? g)
-    (if (memq s '(fresh running suspended done))
+      (g yield-tag)
-      s
+      (raise-type-error 'generator-state "generator" g)))
-      (raise-type-error 'generator-state "generator" g))))
 
 (define-syntax-rule (infinite-generator body0 body ...)
   (generator () (let loop () body0 body ... (loop))))

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
+@defproc[(generator? [v any/c]) boolean?]{
-  @scheme[()] position will hold argument names that are used for the
+  Return @scheme[#t] if @scheme[v] is a @tech{generator},
-  initial generator call.
+  @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
+                      0
-                    (begin
+                      (begin
-                      (yield (car x))
+                       (yield (car x))
-                      (loop (cdr x)))))))
+                       (loop (cdr x)))))))
     (g)
     (g)
     (g)
     (g)
-    (g)]
+    (g)]}
 
-  To use an existing generator as a sequence, use
+@defproc[(yield [v any/c] ...) any]{
-  @scheme[in-producer] with a stop-value known for the generator.
+  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
+  When not in the @tech{dynamic extent} of a @racket[generator],
-    (define my-stop-value (gensym))
+  @racket[infinite-generator], or @racket[in-generator] body,
-    (define my-generator (generator ()
+  @racket[yield] raises @racket[exn:fail] after evaluating its
-                           (let loop ([x '(a b c)])
+  @racket[expr]s.
-                             (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.
 
   @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
+          has not been called yet.}
-          generator.}
     @item{@scheme['suspended] --- Control within the generator has been
           suspended due to a call to @scheme[yield].  The generator can
-          be invoked.}
+          be called.}
-    @item{@scheme['running] --- The generator is currently executing.
+    @item{@scheme['running] --- The generator is currently executing.}
-          This state can only be returned if @scheme[generator-state] is
+    @item{@scheme['done] --- The generator has executed its entire
-          invoked inside the generator.}
+          body and will continue to produce the same result as from
-    @item{@scheme['done] --- The generator has executed its entire body
+          the last call.}]
-          and will not call @scheme[yield] anymore.}]
 
   @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?)]{
+@defproc[(sequence->generator [s sequence?]) (-> any)]{
-  Returns a generator that returns elements from the sequence,
+  Converts a @tech{sequence} to a @tech{generator}. The generator
-  @scheme[s], each time the generator is invoked.}
+  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?)]{
+@defproc[(sequence->repeated-generator [s sequence?]) (-> any)]{
-  Returns a generator that returns elements from the sequence,
+  Like @scheme[sequence->generator], but when @racket[s] has no further
-  @scheme[s], similar to @scheme[sequence->generator] but looping over
+  values, the generator starts the sequence again (so that the
-  the values in the sequence when no more values are left.}
+  generator never stops producing values).}
+
+@close-eval[generator-eval]

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

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