author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Tue, 25 May 2010 08:09:57 +1200 | |
changeset 285 | 034958cf32d9 |
parent 283 | 94f780251884 |
permissions | -rw-r--r-- |
283
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
1 |
#lang scheme |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
2 |
|
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
3 |
(provide yield generator) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
4 |
|
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
5 |
(define current-yielder |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
6 |
(make-parameter |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
7 |
(lambda (v) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
8 |
(error 'yield "must be called in the context of a generator")))) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
9 |
|
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
10 |
(define (yield . vals) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
11 |
(apply (current-yielder) vals)) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
12 |
|
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
13 |
(define-syntax-rule (generator init-formals body0 body ...) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
14 |
(letrec ((yielder (lambda vals |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
15 |
(call-with-current-continuation |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
16 |
(lambda (new-inner-k) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
17 |
(set! inner-k new-inner-k) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
18 |
(apply outer-k vals))))) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
19 |
(outer-k #f) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
20 |
(inner-k (lambda init-formals |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
21 |
(call-with-values |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
22 |
(lambda () |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
23 |
(parameterize ((current-yielder yielder)) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
24 |
body0 body ...)) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
25 |
(lambda results |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
26 |
(set! inner-k (lambda ignored (error "Generator is terminated"))) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
27 |
(apply outer-k results)))))) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
28 |
(lambda args |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
29 |
(call-with-current-continuation |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
30 |
(lambda (new-outer-k) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
31 |
(set! outer-k new-outer-k) |
94f780251884
Bidirectional generator for MzScheme.
Tony Garnock-Jones <tonygarnockjones@gmail.com>
parents:
diff
changeset
|
32 |
(apply inner-k args)))))) |