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