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

make generators use a parameterized yield function

Browse Source 
svn: r16010
This commit is contained in:
Jon Rafkind 2009-09-14 21:11:07 +00:00
parent 69d9e3fd4f
commit 6137510396
2 changed files with 53 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

44
collects/scheme/generator.ss
View File

@ -6,9 +6,9 @@
(provide yield generator in-generator)
(define-syntax-parameter yield
(lambda (stx)
(raise-syntax-error #f "yield is only bound inside a sequence generator")))
;; (define-syntax-parameter yield
;; (lambda (stx)
;; (raise-syntax-error #f "yield is only bound inside a sequence generator")))
;; (define (procedure->generator proc)
;; (define tag (make-continuation-prompt-tag))
@ -20,18 +20,44 @@
;; r)))
;; (lambda () (cont)))
(define current-yielder
(make-parameter
(lambda (v)
(error 'yield "yield cannot be called when no generator is active"))))
(define (yield value)
((current-yielder) value))
(define yield-tag (make-continuation-prompt-tag))
(define-syntax-rule (generator body0 body ...)
(let ()
(define (cont)
(define (yielder value)
(shift-at yield-tag k (set! cont k) value))
(reset-at yield-tag
(parameterize ([current-yielder yielder])
(let ([retval (begin body0 body ...)])
;; normal return:
(set! cont (lambda () retval))
retval))))
(define (generator) (cont))
generator))
;; not using parameterization
#;
(define-syntax-rule (generator body0 body ...)
(let ([tag (make-continuation-prompt-tag)])
(define yielder
(let ([yield (lambda (value) (shift-at tag k (set! cont k) value))])
yield))
(splicing-syntax-parameterize ([yield (make-rename-transformer #'yielder)])
(define (cont)
(reset-at tag
(let ([retval (begin body0 body ...)])
;; normal return:
(set! cont (lambda () retval))
retval))))
(define (cont)
(reset-at tag
(let ([retval (begin body0 body ...)])
;; normal return:
(set! cont (lambda () retval))
retval))))
(define (generator) (cont))
generator))

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

@ -222,4 +222,22 @@
(for/list ([(x i) (in-indexed (in-generator (yield 1) (yield 2) (yield 3)))])
(list x i)))
(let ([helper (lambda (i)
(yield (add1 i)))])
(test '(1 2 3) 'parameterized-yield
(for/list ([x (in-generator (helper 0) (helper 1) (helper 2))])
x)))
(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))])
(test '(#t #f #f #t #t #f odd even) 'yield-helper
(list (g1) (g2) (g1) (g2) (g1) (g2) (g1) (g2))))
(report-errs)