From 581cbb461b8f31da88c839291fad8c86254c0438 Mon Sep 17 00:00:00 2001 From: Eli Barzilay Date: Thu, 1 Apr 2010 07:45:41 +0000 Subject: [PATCH] Change `generator' to have a form of (generator () body ...). The empty place will have initial input names, so having this first will make existing code break with an easy to fix syntax error, rather than having confusing failures. (Also made it throw a very clear error message if there is no () now.) svn: r18705 --- collects/scheme/generator.ss | 20 ++++++++++++++------ collects/tests/mzscheme/for.ss | 12 ++++++------ 2 files changed, 20 insertions(+), 12 deletions(-) diff --git a/collects/scheme/generator.ss b/collects/scheme/generator.ss index 79a5939be1..6ad3a93259 100644 --- a/collects/scheme/generator.ss +++ b/collects/scheme/generator.ss @@ -22,7 +22,8 @@ ;; r))) ;; (lambda () (cont))) -;; not using parameterization +;; not using parameterization (old version, doesn't deal with multiple +;; inputs/outputs as the one below) #; (define-syntax-rule (generator body0 body ...) (let ([tag (make-continuation-prompt-tag)]) @@ -51,7 +52,13 @@ (define yield-tag (make-continuation-prompt-tag)) -(define-syntax-rule (generator body0 body ...) +(define-syntax (generator stx) + (syntax-case stx () + [(_ () body0 body ...) #'(generator-old body0 body ...)] + [_ (raise-syntax-error + 'generator "must have a form of (generator () body ...)")])) + +(define-syntax-rule (generator-old body0 body ...) (let ([state 'fresh]) (define (cont) (define (yielder . vs) @@ -95,22 +102,23 @@ (raise-type-error 'generator-state "generator" g)))) (define-syntax-rule (infinite-generator body0 body ...) - (generator (let loop () body0 body ... (loop)))) + (generator () (let loop () body0 body ... (loop)))) (define stop-value (gensym)) (define-sequence-syntax in-generator (syntax-rules () [(_ body0 body ...) - (in-producer (generator body0 body ... stop-value) stop-value)]) + (in-producer (generator () body0 body ... stop-value) stop-value)]) (lambda (stx) (syntax-case stx () [((id ...) (_ body0 body ...)) #'[(id ...) - (in-producer (generator body0 body ... stop-value) stop-value)]]))) + (in-producer (generator () body0 body ... stop-value) + stop-value)]]))) (define (sequence->generator sequence) - (generator (for ([i sequence]) (yield i)))) + (generator () (for ([i sequence]) (yield i)))) (define (sequence->repeated-generator sequence) (sequence->generator (in-cycle sequence))) diff --git a/collects/tests/mzscheme/for.ss b/collects/tests/mzscheme/for.ss index 1d61983e4d..3f9102c384 100644 --- a/collects/tests/mzscheme/for.ss +++ b/collects/tests/mzscheme/for.ss @@ -235,10 +235,10 @@ (for/list ([x (in-generator (helper 0) (helper 1) (helper 2))]) x))) -(let ([g (lambda () (generator (yield 1) (yield 2) (yield 3)))]) +(let ([g (lambda () (generator () (yield 1) (yield 2) (yield 3)))]) (let ([g (g)]) (test '(1 2 3) list (g) (g) (g))) (let ([g (g)]) (test '(1 2 3 10 10) list (g) (g) (g) (g 10) (g))) - (let ([g (generator (yield (yield (yield 1))))]) + (let ([g (generator () (yield (yield (yield 1))))]) (test '(1 2 3 4 4 4) list (g) (g 2) (g 3) (g 4) (g) (g))) (let ([g (g)]) (test '(fresh 1 suspended 2 suspended 3 suspended last done) @@ -247,8 +247,8 @@ (generator-state g) (g) (generator-state g) (g 'last) (generator-state g))) - (letrec ([g (generator (yield (generator-state g)) - (yield (generator-state g)))]) + (letrec ([g (generator () (yield (generator-state g)) + (yield (generator-state g)))]) (test '(fresh running suspended running suspended last done) list (generator-state g) (g) (generator-state g) (g) @@ -257,8 +257,8 @@ (let* ([helper (lambda (pred num) (for ([i (in-range 0 3)]) (yield (pred (+ i num)))))] - [g1 (generator (helper odd? 1) (yield 'odd))] - [g2 (generator (helper even? 1) (yield 'even))]) + [g1 (generator () (helper odd? 1) (yield 'odd))] + [g2 (generator () (helper even? 1) (yield 'even))]) (test '(#t #f #f #t #t #f odd even) 'yield-helper (list (g1) (g2) (g1) (g2) (g1) (g2) (g1) (g2))))