suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Change `generator' to have a form of (generator () body ...). The empty

Browse Source 
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
This commit is contained in:
Eli Barzilay 2010-04-01 07:45:41 +00:00
parent 6977f08878
commit 581cbb461b
2 changed files with 20 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
collects/scheme/generator.ss
View File

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

12
collects/tests/mzscheme/for.ss
View File

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