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

Last change on this file since 29091 was 29091, checked in by svnwiki, 7 years ago

Anonymous wiki edit for IP [186.42.79.192]:

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