author  Tony GarnockJones <tonygarnockjones@gmail.com> 
Tue, 06 Apr 2010 08:11:57 +1200  
changeset 283  94f780251884 
permissions  rwrr 
283
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

1 
#lang scheme 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

2 

94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

3 
(provide yield generator) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

4 

94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

5 
(define currentyielder 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

6 
(makeparameter 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

7 
(lambda (v) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

8 
(error 'yield "must be called in the context of a generator")))) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

9 

94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

10 
(define (yield . vals) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

11 
(apply (currentyielder) vals)) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

12 

94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

13 
(definesyntaxrule (generator initformals body0 body ...) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

14 
(letrec ((yielder (lambda vals 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

15 
(callwithcurrentcontinuation 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

16 
(lambda (newinnerk) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

17 
(set! innerk newinnerk) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

18 
(apply outerk vals))))) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

19 
(outerk #f) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

20 
(innerk (lambda initformals 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

21 
(callwithvalues 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

22 
(lambda () 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

23 
(parameterize ((currentyielder yielder)) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

24 
body0 body ...)) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

25 
(lambda results 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

26 
(set! innerk (lambda ignored (error "Generator is terminated"))) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

27 
(apply outerk results)))))) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

28 
(lambda args 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

29 
(callwithcurrentcontinuation 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

30 
(lambda (newouterk) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

31 
(set! outerk newouterk) 
94f780251884
Bidirectional generator for MzScheme.
Tony GarnockJones <tonygarnockjones@gmail.com>
parents:
diff
changeset

32 
(apply innerk args)))))) 