This article is relevant in the context of
Search for Yield the Magnificent
Yielding to Magnificence
Other relevant articles include:
Iterators that listen (for Python, by Sidharth Kuruvila)
Implementing a generator in Ruby (by Sidharth Kuruvila)
Implementation of Iterators in C# 2.0
I finally got down to ironing out the issues in the previous (rather hasty) entry about scheme iterators. I have code that is a little better tested.
To sell any idea, you have to demonstrate the value that believers in the idea get, before you discuss the cost. So here is the value –
Iterators support a style of programming where you separate producers of streams of data from consumers of these streams. For example you want to do a certain something on strings of text, irrespective of where the text comes from. In a more general case, iterators are a more powerful programming device, they can be thought of call-tree walkers, they can be thought of the notion of structured programming as applied to continuations. (Refer: Warming up to Iterators, Ruby: Containers, Blocks and Iterators, C#: Create Elegant Code with Anonymous Methods, Iterators, and Partial Classes)
The following is a demonstration of yield (similar to yield in Ruby, C# or Py) as a device to create iterators in scheme. There are some extensions to the idea, so the yield implementation here can do more things than the any of the other implementations can do (refer here for details). The implementation below is however useful in a functional context (its easy to see the use of yield in a imperative context). All of the code snippets below are functional in nature, the actual implementation of iterators need not be, but these internal details are abstracted away from you.
lambda-iter, yield, foreach
Iterators (functions that use yield) are defined using lambda-iter
(define even
(lambda-iter ()
(let loop ((i 0))
(printf "even recieved ~a ~n" (yield i))
(loop (+ i 2)))))
; Using foreach
(foreach (even)
(printf "it = ~a ~n" it) ; ‘it’ is the yielded value
(if (> it 20)
(break 0)) ;break out if we has enough
it) ;return the yielded value to yield
The even above is an produces an infinite stream of even numbers. The parameter to break is the return value of the foreach. ‘it’ is the value of the value that has been yielded. This common to many languages (Groovy, COmega etc). Everything else should be easy to understand.
coroutine, co-move-next, co-value, co-return, co-finished?, co-not-finished?
Iterators can be turned into first class entities as follows –
; Using coroutines explicitely
; Here the control flow mechanism is something we control
(let loop ((co (coroutine (even)))) ;create the corotuine object
(let ((co (co-move-next co))) ; start/advance the execution
(printf "Yielded ~a ~n" (co-value co)) ; print the yielded value
(loop (co-return (co-value co) co)))) ;return the yielded value
There, that’s said, you have all the devices that you need for a yield the magnificent implementation for scheme. There are more things in this implementation to make it useful for general purpose programming, but this much covers all the intellectual content. What follows is some essential documentation after which we have some of the extra forms.
Documentation
lambda-iter
(lambda-iter <params> <body>)
Same as lambda, except that you can do a yield in its body
yield
(yield <value>)
Yields a value to the caller
foreach
(foreach <iterator> <body>)
Takes an iterator and list of expressions, the expressions are invoked everytime the iterator yields. The value yielded is available as ‘it’. The expression can abort from the foreach by calling break. The parameter to break is the return value of the foreach. If the iterator returns, before break is called, the foreach returns the value of the iterator. Tha value of the last evaluated expression in the expression list is the return value into the iterator.
coroutine – wraps the iterators into a coroutine object
coroutine
(coroutine <iterator>)
Wraps the iterator into a first class object and returns it.
co-move-next
(co-move-next <coroutine>)
Executes the iterator in the coroutine, till it yields or till it returns. The new coroutine is returned.
co-value
(co-value <coroutine>)
Retrieves the current value of the coroutine. This might be a yielded value or a return value of the iterator. Functional programmers may want to use the analogy of car and cdr for co-value and co-move-next.
co-return
(co-return <value> <coroutine>)
Sets a return value into the coroutine and returns the new coroutine object. The return value is the value that will be avilavle as the return value of a yield call inside the iterators. Example (let ((a (yield 10)) … ) here the value of a will be the value that was set using a co-return in the coroutine object.
co-finished?, co-not-finished?
(co-finished? <coroutine>)
Returns a bool to indicate if the coroutine has returned. If it has yielded and can potentially do something meaningful for subsequent co-move-next calls, co-finished will return #f. co-not-finished is the complement.
Recursive yields
;; recursive yielding
; yields all combinations of true and false for n bits
(define states
(lambda-iter (n)
(if (eq? n 1)
(begin
(yield '(#f)) (yield '(#t)))
(foreach (states (- n 1))
(yield (cons #f it))
(yield (cons #t it))))))
(foreach (states 5)
(printf "state = ~a ~n" it))
Here is an example of recursive yielding. The states function returns all the values of a bit vector of size ‘n’ bits.
yield-all
yield all is a useful pattern sometimes when you recursively call iterators. Here is a tree walker that is implemented using yield-all and yield.
(define walk-tree
(lambda-iter (tree)
(cond
((null? tree) '())
((atom? tree)
(yield tree))
(else
(yield-all (walk-tree (car tree)))
(yield-all (walk-tree (cdr tree)))))))
(foreach (walk-tree '(1 2 3 (5 6 7) (4 5) 8))
(printf "value ~a~n" it))
There is an intuitive way to think about these sort of programs – each node is a tree yields itself if it is a a leaf (an atom). Else it asks each of its children to yield-all.
Solving the Same-Fringe problem
The same fringe problem is the problem of comparing two trees to see if they have the same leaf values, irrespective of the structure of the trees. One way of solving the same fringe problem is to use the walk-tree defined above and create two couroutines, to represent the two trees that are to be compared.
(define same-fringe
(lambda (t1 t2)
(let loop ((t1 (coroutine (walk-tree t1)))
(t2 (coroutine (walk-tree t2))))
(let ((t1 (co-move-next t1)) (t2 (co-move-next t2)))
(if (and (co-finished? t1) (co-finished? t2))
#t
(if (or (co-finished? t1) (co-finished? t2))
#f
(if (eq? (co-value t1) (co-value t2))
(loop t1 t2)
#f)))))))
The intuitive way of looking at this is that it created two coroutines and advances both of them. If they both finish, then the trees have same fringe. If only one of them have terminated then the trees are not equal with respect to fringe values. If neither of them have terminated and the values they yielded are the same, then we can loop and ask for the next value. As an aside, I find the code above to be far more readable that the equivalent in the Dorai Sitaram text.
coroutines, co-all-move-next, co-all-finished?, co-any-finished?
Here is a solution to the same fringe using some handy helper routines that help with dealing with collections of coroutines. These functions are usually useful only when all the coroutines are similar or related in some way.
(define same-fringe2
(lambda (t1 t2)
(let loop ((ts (coroutines (walk-tree t1) (walk-tree t2))))
(let ((ts (co-all-move-next ts)))
(cond
((co-all-finished? ts) #t)
((co-any-finished? ts) #f)
((eq? (co-value (car ts)) (co-value (cadr ts))) (loop ts))
(else #f))))))
Solving the repmin problem
The repmin problem requires that you trake a tree and construct a new tree where every leaf is replaced by the global minimum leaf value of the original tree. (This is the problem that started this saga off and was the one that none of the C#, Ruby, Py yields could handle)
The solution below can repmin trees not only binary trees, but trees of any arity. This shows of the flexibility of the some of the couroutine list comprehension functions that are available –
;a powerful repmin that works on trees with arbitrary numbers of leaves
(define repmin
(lambda-iter (tr)
(cond
((atom? tr) (yield tr))
((null? tr) '())
(else
(let* ((co-trs (co-all-move-next (map coroutine (map repmin tr))))
(co-vals (co-values co-trs)))
(co-values
(co-all-move-next
(co-all-return (yield (apply min co-vals)) co-trs))))))))
;Test
(define tree1 '(3 ((2)) (3 4) 1))
(printf "Repmin of ~a is ~a ~n" tree1 (foreach (repmin tree1) it))
Documenting the extra forms
yield-all
(yield-all <iterator>)
Equivalent of (foreach <iterator> (yield it))
coroutines
(coroutines <iterator>+)
Create a list of coroutines. Equivalent of (map coroutine <iterator list>)
co-all-finished?
co-none-finished?
co-any-finished?
(co-all-finished <coroutine list>)
co-values
(co-values <coroutine list>)
Returns a list of values, which are the value sof each of the coroutines
co-all-move-next
(co-all-move-next <coroutine list>)
Moves all the coroutines in the list to the next value and returns the new list of coroutines.
co-all-return
(co-all-return <value> <coroutine list>)
Applies a return value to all of the coroutines and returns the new list of coroutines.
co-each-return
(co-each-return <values list> <coroutine list>)
Applies a return value from the values list to each of the coroutines and returns the new list of coroutines.
Implementation
Here is the implementation of coroutine, yield and all the support stuff…
;Roshan James (Mon 10/24/2005)
;call/cc based implementation of Yield the Magnificient for Scheme
;
;Yield the Magnificient:
;http://www.thinkingms.com/pensieve/default,date,2005-10-11.aspx
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;A coroutine is represented by a list of 3 values. The first of these is a
;proc(1), the second is a value(2), the third is a bool(3). According to
;different stages in the lifetime of a coroutine, these have different values.
;
; Values of proc(1)
;1) When a corotuine is created the proc is the 'first lambda'
;2) When the iterator is running, the proc is the continuation of the iterator
;3) When the iterator has returned, the proc is the null-proc.
;
;Values of value(2)
;1) When the coroutine is created, it is simply #t
;2) When the iterator is running, it is the current yielded value
;3) When the iterator has returned, it is the final return value
;
;Values of bool(3)
; The bool of #f after the iterator has returned. Until then the bool is #t.
;
;Coroutines can be sent return values, by replacing value(2) in the list
;before calling co-move-next. Once a coroutine has terminated, co-move-next can be
;called an infinite number of times without having any effect. The return
;value is preserved (all these calls are sent to null-proc).
(define coroutine
(lambda (prod)
(list (lambda (ret) ;first lambda
(letrec ((esc (car ret))
(null-proc (lambda (x)
(cons null-proc (cdr x)))))
(let ((stopped (list null-proc
(prod (lambda (it)
(let ((res (call-with-current-continuation
(lambda (k)
(esc (list k it #t)))))) ; iterator k
(set! esc (car res)) ;Evil!
(cadr res))))
#f)))
(esc stopped))))
#t #t)))
(define co-move-next
(lambda (co)
(call-with-current-continuation
(lambda (esc)
((car co) (list esc (cadr co) (caddr co)))))))
;There is no intellectual content past this point, the rest of the code is required
;to provide abstractions that I thought are are useful from my experince with using
;yield.
(define co-value
(lambda (co) (cadr co)))
(define co-finished?
(lambda (co) (not (caddr co))))
(define co-not-finished?
(lambda (co) (caddr co)))
(define co-return
(lambda (val co) (list (car co) val (caddr co))))
;Some useful macros
;create a producer that has a implicit curried yield
(define-syntax lambda-iter
(lambda (f)
(syntax-case f ()
[(_ (x* ...) body body* ...)
(with-syntax ([yield-syntax (datum->syntax-object (syntax _) 'yield)])
(syntax
(lambda (x* ...)
(lambda (yield-syntax)
body
body* ...))))])))
;can be called in an iterator to yield all the values yielded
;by an iterator it is calling
(define-syntax yield-all
(lambda (f)
(syntax-case f ()
[(_ iter)
(with-syntax ([yield-syntax (datum->syntax-object (syntax _) 'yield)])
(syntax
(iter (lambda (it) (yield-syntax it)))))])))
;a foreach that mostly useful only in an imperative context
(define-syntax foreach
(lambda (f)
(syntax-case f ()
[(_ iter body* ...)
(with-syntax ([it-syntax (datum->syntax-object (syntax _) 'it)]
[break-syntax (datum->syntax-object (syntax _) 'break)])
(syntax
(call-with-current-continuation
(lambda (break-syntax)
(break-syntax (iter
(lambda (it-syntax)
body* ...)))))))])))
;reduce
(define reduce
(lambda (proc ls)
(cond
((null? (cddr ls)) (proc (car ls) (cadr ls)))
(else
(proc (car ls) (reduce proc (cdr ls)))))))
;useful functions for dealing with lists of iterators
(define coroutines
(lambda ls
(map coroutine ls)))
(define co-all-finished?
(lambda (ls)
(reduce (lambda (a b) (and a b))
(map (lambda (iter) (co-finished? iter))
ls))))
(define co-any-finished?
(lambda (ls)
(reduce (lambda (a b) (or a b))
(map (lambda (iter) (co-finished? iter))
ls))))
(define co-none-finished?
(lambda (ls)
(reduce (lambda (a b) (and a b))
(map (lambda (iter) (co-not-finished? iter))
ls))))
(define co-values
(lambda (ls)
(map co-value ls)))
(define co-all-move-next
(lambda (ls)
(map co-move-next ls)))
(define co-all-return
(lambda (ret ls)
(map (lambda (iter) (co-return ret iter)) ls)))
Here are the files for download.
What is the value of all of this?
The value of all of this would be to look at the above as a general way of implementing yield in languages where the approach is to pass a closure from the caller to the callee. Ruby is another language in this category and I believe the Generator class was an attempt to solve this problem.
The real value in all of this is in setting a base for further exploration of the style of programming that yield lends itself to. Is it sufficiently expressive to express all implementation of certain classes of problems? If so, then yield maybe useful as a primitive building block for large classes of control structures in programming languages. If not, all of this was fun anyway. :)
Download