equal
deleted
inserted
replaced
|
1 #lang scheme |
|
2 |
|
3 (provide yield generator) |
|
4 |
|
5 (define current-yielder |
|
6 (make-parameter |
|
7 (lambda (v) |
|
8 (error 'yield "must be called in the context of a generator")))) |
|
9 |
|
10 (define (yield . vals) |
|
11 (apply (current-yielder) vals)) |
|
12 |
|
13 (define-syntax-rule (generator init-formals body0 body ...) |
|
14 (letrec ((yielder (lambda vals |
|
15 (call-with-current-continuation |
|
16 (lambda (new-inner-k) |
|
17 (set! inner-k new-inner-k) |
|
18 (apply outer-k vals))))) |
|
19 (outer-k #f) |
|
20 (inner-k (lambda init-formals |
|
21 (call-with-values |
|
22 (lambda () |
|
23 (parameterize ((current-yielder yielder)) |
|
24 body0 body ...)) |
|
25 (lambda results |
|
26 (set! inner-k (lambda ignored (error "Generator is terminated"))) |
|
27 (apply outer-k results)))))) |
|
28 (lambda args |
|
29 (call-with-current-continuation |
|
30 (lambda (new-outer-k) |
|
31 (set! outer-k new-outer-k) |
|
32 (apply inner-k args)))))) |