source: project/wiki/Python-like generators @ 33586

Last change on this file since 33586 was 33586, checked in by Mario Domenech Goulart, 4 years ago

Python-like generators (wiki): add title as workaround for https://bugs.call-cc.org/ticket/1312

File size: 3.7 KB
Line 
1== Python-like generators in Scheme
2
3<enscript highlight=scheme>
4;;;Python-like generators in Scheme
5 ;;;
6 ;;;Michele Simionato (michele.simionato@gmail.com) May 2005
7 ;;;Adapted from http://c2.com/cgi/wiki?SchemeCoroutineExample
8
9 (define-macro (store/cc! name . body)
10   (let ((k (gensym)))
11    `(call-with-current-continuation
12      (lambda (,k) (set! ,name ,k) ,@body))))
13
14 ; to spare parenthesis, real schemers will hate this one ;)
15 (define-macro (let/ name value . args)
16   `(match-let ((,name ,value)) ,@args))
17
18 ;; the core implementation
19 (define (generator routine)
20   (let/ (current status exit next) (list routine 'suspended #f #f)
21     (match-lambda*
22      (() (if (eq? status 'dead)
23              (error 'dead-generator)
24              (let/ continuation-and-value
25                (store/cc! exit
26                   (let/ yield
27                      (lambda (value)
28                        (store/cc! next
29                           (exit (cons next value))))
30                      (current yield) ; exits from here,
31                      ;; except after the last yield
32                      (set! status 'dead)
33                      (error 'dead-generator)))
34                (if (pair? continuation-and-value)
35                    (begin (set! current (car continuation-and-value))
36                           (cdr continuation-and-value))
37                    continuation-and-value))))
38      (('status?) status)
39      (('dead?) (eq? status 'dead))
40      (('alive?) (not (eq? status 'dead)))
41      (('kill!) (set! status 'dead)))))
42
43 ;; an example
44 (define test
45   (generator (lambda (yield)
46                (yield "HELLO!")
47                (yield "WORLD!"))))
48
49 (test 'status?) ; suspended
50 (test 'dead?) ; #f
51 (test 'alive?) ; #t
52 (test) ; "HELLO!"
53 (test) ; "WORLD!"
54 (test) ; Error: dead-generator
55 (test 'status?) ; dead
56 (test 'dead?) ; #t
57
58 ;; another example:
59
60 (define (list->iterator list)
61   (generator (lambda (yield)
62                (for-each yield list))))
63
64 (define (iterator-empty? iterator)
65   (iterator 'dead?))
66
67 (define my-iterator
68   (list->iterator (list 1 2 3)))
69
70 (my-iterator) ; 1
71 (my-iterator) ; 2
72 (my-iterator) ; 3
73 (iterator-empty? my-iterator) ; #f
74
75</enscript>
76
77This required me to install the low-level-macros egg. And when I pasted the generator routine I got
78
79<enscript highlight=scheme>
80--->       (('kill!) (set! status 'dead)))))
81
82Error: illegal non-atomic object: ()
83inside expression `(match-lambda* ...)'
84
85        Call history:
86
87        <eval>    (##sys#apply ##sys#values args315)
88        <eval>    (apply297 (lambda298 (_253 name value args) (begin254 (quasiquote (match-let (((unquote name) (unquo......
89        <eval>    (##sys#cons (##core#quote match-let) (##sys#cons (##sys#list (##sys#list name value)) args))
90        <eval>    (##sys#cons (##sys#list (##sys#list name value)) args)
91        <eval>    (##sys#list (##sys#list name value))
92        <eval>    (##sys#list name value)
93        <syntax>          [generator] (##core#begin (match-let364 (((current status exit next) (list routine (quote suspended) #f #f))) (m......
94        <syntax>          [generator] (match-let364 (((current status exit next) (list routine (quote suspended) #f #f))) (match-lambda* (()...
95        <syntax>          [generator] (((current status exit next) (list routine (quote suspended) #f #f)))
96        <syntax>          [generator] ((current status exit next) (list routine (quote suspended) #f #f))
97        <syntax>          [generator] (current status exit next)
98        <syntax>          [generator] (list routine (quote suspended) #f #f)
99        <syntax>          [generator] (quote suspended)
100        <syntax>          [generator] (##core#quote suspended)
101        <syntax>          [generator] (match-lambda* (() (if (eq? status (quote dead)) (error (quote dead-generator)) (let/ continuation-a......
102        <syntax>          [generator] (() (if (eq? status (quote dead)) (error (quote dead-generator)) (let/ continuation-and-value (store......        <--
103</enscript>
104
Note: See TracBrowser for help on using the repository browser.