CoRoutines

Problem

In some cases it is desirable to transform a procedure that returns a table (a list, vector or list of lists and so on) into a procedure that returns one element each time it is called. The reason may be that it is not beforehand known how many of the elements actually will be needed. Another reason may be that the table potentially is infinite. A trivial example is:

(require (lib "etc.ss"))
(define (make-lon n) (build-list n identity)) ; list-producer
(make-lon 10) ; --> (0 1 2 3 4 5 6 7 8 9)

(define (make-counter n) ; constructor
 (let ((i 0))
  (lambda ()
   (if (< i n) (let ((r i)) (set! i (add1 i)) r)
    (error "counter exhausted")))))

(define counter (make-counter 10)) ; element-by-element-producer

(counter) ;--> 0
(counter) ;--> 1
(counter) ;--> 2
;etc
(counter) ;--> 9
(counter) ; error: counter exhausted

Notice that (define inf-counter (make-counter +inf.0)) produces an endless counter, although there are more elegant methods to construct such a counter.

In non trivial cases the problem of converting a list-producer into an element-by-element-producer is located in capturing the internal state of the list-producer in order to make known what has already been done and particularly what is still left to be done. In some cases one or more local variables may be sufficient (as in the case of the above counter), but in other cases, a more sophisticated method is required, particularly if the elements to be produced are interconnected by one or more levels of recursive relations. The most general method of capturing the internal state of a procedure is by capturing the continuation of the current stage of the computation. The procedure should 'replace itself' by this continuation right before returning each next element. Such a procedure is called a coroutine. Another approach is the use of streams. This approach is not treated in this recipe.

Rationale

Section 9.4 of EOPL provides an excellent introduction into the concept of coroutines. This recipe is meant to be a simpler introduction by using a slightly different approach. Moreover the examples in this recipe are in PLT Scheme (#lang scheme) whereas those of EOPL are in EOPL's own language.

Solution

A coroutine needs four things:

The procedure proper.
A means to return a result to the caller of the coroutine while replacing the coroutine itself by its current continuation. This will be done by a procedure called return.
Because procedure return must replace the coroutine by a continuation, the coroutine cq its continuation must be kept in a variable, say entry. We can update variables. Procedures can only be updated by changing their internal state. Variable entry is this internal state. The initial value of the entry is the procedure proper.
Because the coroutine is not going to return normally, the continuation of its most recent call must be memorized. We use variable exit. (Later we will see that in fact one variable is enough for both the entry and the exit.)

We start with a very simple example: a coroutine that returns the numbers 0, 1 and 2 and refuses to be called more than three times.

(define coroutine
 (letrec
  ((entry ; The initial content of the entry is the procedure proper.
    (lambda ()
     (return 0)
     (return 1)
     (return 2)
     (error "expired coroutine"))) ; Make sure no more calls are accepted.
   (exit "we don't know yet")
   (return
    (lambda (return-value)
     (call-with-current-continuation
      (lambda (cc)
       (set! entry cc)
       (exit return-value)))))
   (coroutine
    (lambda ()
     (call-with-current-continuation
      (lambda (cc)
       (set! exit cc)
       (entry))))))
  coroutine))
(coroutine) ;--> 0
(coroutine) ;--> 1
(coroutine) ;--> 2
(coroutine) ;--> error: expired coroutine

The procedures return and coroutine resemble each other very much. In fact when we give procedure coroutine an argument, say resume-value, we have a perfect symmetry:

variables	procedures	arguments
`entry`	`coroutine`	`resume-value`
`exit`	`return`	`return-value`

(define coroutine
 (letrec
  ((entry                          ; The initial content of the entry is the procedure proper.
    (lambda (first-resume-value)   ; The name 'first-resume-value' is a contradictio in
     (return 0)                    ; terminis, of course. The name has been choosen such as
     (return 1)                    ; to indicate that it is an argument of a coroutine-call,
     (return 2)                    ; particularly the very first one.
     (error "expired coroutine"))) ; Make sure no more calls are accepted.
   (exit "we don't know yet")
   (return
    (lambda (return-value)
     (call-with-current-continuation
      (lambda (cc)
       (set! entry cc)
       (exit return-value)))))
   (coroutine
    (lambda (resume-value)
     (call-with-current-continuation
      (lambda (cc)
        (set! exit cc)
        (entry resume-value))))))
  coroutine))

The arguments first-resume-value and resume-value are not used, but will appear to be useful in one of the examples to follow. Notice that always at least one of the variables entry and exit is outdated. When the coroutine is called, variable exit is updated, but the content of variable entry becomes obsolete as soon as the continuation it contains has been called. When the coroutine returns, variable entry is updated and the exit becomes obsolete immediately after being called. Hence we can use one shared variable for the entry and the exit. We shall call it local-state.

(define coroutine
 (letrec
  ((local-state                    ; The initial content is the procedure proper.
    (lambda (first-resume-value)   ; The name 'first-resume-value' is a contradictio in
     (return 0)                    ; terminis, of course. The name has been choosen such as
     (return 1)                    ; to indicate that it is an argument of a coroutine-call,
     (return 2)                    ; particularly the very first one.
     (error "expired coroutine"))) ; Make sure no more calls are accepted.
   (return
    (lambda (return-value)
     (call-with-current-continuation
      (lambda (cc)
       (let ((old-state local-state))
        (set! local-state cc)
        (old-state return-value))))))
   (coroutine
    (lambda (resume-value)
     (call-with-current-continuation
      (lambda (cc)
       (let ((old-state local-state))
        (set! local-state cc)
       (old-state resume-value)))))))
  coroutine))

Now the two procedures return and coroutine have become alpha-congruent. Hence we need only one of them. We shall call it toggle, because it toggles control between the caller of the coroutine and the coroutine itself.

(define coroutine
 (letrec
  ((local-state                    ; The initial content is the procedure proper.
    (lambda (first-resume-value)   ; The name 'first-resume-value' is a contradictio in
     (toggle 0)                    ; terminis, of course. The name has been choosen such as
     (toggle 1)                    ; to indicate that it is an argument of a coroutine-call,
     (toggle 2)                    ; particularly the very first one.
     (error "expired coroutine"))) ; Make sure no more calls are accepted.
   (toggle
    (lambda (return/resume-value)
     (call-with-current-continuation
      (lambda (cc)
       (let ((old-state local-state))
        (set! local-state cc)
        (old-state return/resume-value)))))))
  toggle))

It is important that the procedure proper does not return normally. It must always return using procedure toggle. If the procedure proper would be allowed to return normally, control would be passed to the continuation of the first coroutine call probably leading to another call of the coroutine and possibly causing an infite loop. But there is a nicer way to finish. In most cases it is desirable that the procedure proper returns a special value indicating that it must no longer be called. Yet the coroutine must disable itself after finishing in order to prevent problems if by mistake the coroutine would be called after having expired. This will be done by procedure finish:

(define coroutine
 (letrec
  ((local-state
    (lambda (first-resume-value) ; The name 'first-resume-value' is a contradictio in
     (toggle 0)                  ; terminis, of course. The name has been choosen such as   
     (toggle 1)                  ; to indicate that it is an argument of a coroutine-call,
     (toggle 2)                  ; particularly the very first one.
     (finish "this marks the expiration of the coroutine")))
   (toggle
    (lambda (resume/return-value)
     (call-with-current-continuation
      (lambda (cc)
       (let ((old-local-state local-state))
        (set! local-state cc)
        (old-local-state resume/return-value))))))
   (finish
    (lambda (finish-mark)
     (let ((last-exit local-state))
      (set! local-state
       (lambda (resume-value)
        (error "expired-coroutine called with resume-value:"
         resume-value)))
      (last-exit finish-mark)))))
  toggle))

Now it is time to prepare a procedure that given a proc-maker, id est a procedure that returns the procedure-proper, constructs a procedure that returns a coroutine-constr, i.e. a procedure that produces specimens of a certain species of coroutines.

Procedure call	Returned value(s)	Remarks
`(make-coroutine-constr proc-maker finisher)`	-> `coroutine-constr`
`(proc-maker return finish constr-arg ...)`	-> `procedure-proper`	the `constr-args` are those given to the coroutine-constr
`(finisher last-return-value ...)`	-> `adapted-last-return-value ...`	the `last-return-values` are those given to proceure finish
`(procedure-proper first-resume-value ...)`	-> `any ...`
`(coroutine-constr constr-arg ...)`	-> `coroutine`	constructor-call
`(return return-value ...)`	-> `resume-value ...`	return-call
`(finish last-return-value ...)`	never returns	finish-call
`(coroutine resume-value ...)`	-> `return-value ...`	coroutine-call

The proc-maker may require data to be processed, but it also requires the procedures toggle and finish. Therefore the proc-maker shall have the arguments toggle and finish possibly followed by more arguments for data that are provided during the construction of the coroutine. Procedure make-coroutine-constr, shown below, has been generalized for multiple resume and return values. A call to procedure finish is implied after normal return from the procedure proper, receiving the value(s) returned by the procedure proper. Procedure make-coroutine-constr takes two arguments, the procedure proper and a terminator. The latter is a procedure that is called by procedure finish with the last return values. Whatever is returned by the terminator is returned to the caller of the coroutine after the coroutine has disabled itself.

(define (make-coroutine-constr proc-maker terminator)
 (lambda constr-args ; args for data provided during the construction of the coroutine
  (letrec
   ((local-state
     (lambda first-resume-values
      (call-with-values
       (lambda () (apply procedure-proper first-resume-values))
       finish)))
    (toggle
     (lambda resume/return-values
      (call-with-current-continuation
       (lambda (cc)
        (let ((old-state local-state))
         (set! local-state cc)
         (apply old-state resume/return-values))))))
    (finish
     (lambda last-return-values
      (let ((last-exit local-state))
       (set! local-state
        (lambda resume-values
         (apply error "expired-coroutine called with resume-values:"
          resume-values)))
       (call-with-values (lambda () (apply terminator last-return-values))
        last-exit))))
    (procedure-proper (apply proc-maker toggle finish constr-args)))
   toggle)))

A coroutine is too heavy a tool for a counter, but, for its simplicity, let's take a coroutine that conses a count to its resume-value. After a predetermined number of calls the coroutine expires while returning #f.

(define make-consing-counter
 (make-coroutine-constr
  (lambda (toggle finish limit)
   (lambda (resume-value)
    (let loop ((i 0))
     (if (>= i limit) (finish) 
      (begin
       (set! resume-value (toggle (cons i resume-value)))
       ; The cons is returned to the caller of the coroutine. When the coroutine
       ; is called again, the continuation of the call to toggle is called with
       ; the resume-value of that coroutine-call. Hence the resume-value of the
       ; next coroutine-call is assigned to variable resume-value.
        (loop (add1 i)))))))
  (lambda x #f))) ; terminator, always returning #f

(define consing-up-to-5 (make-consing-counter 5))

(consing-up-to-5 'aap)  ;--> (0 . aap)
(consing-up-to-5 'noot) ;--> (1 . noot)
(consing-up-to-5 'mies) ;--> (2 . mies)
(consing-up-to-5 'wim)  ;--> (3 . wim)
(consing-up-to-5 'zus)  ;--> (4 . zus)
(consing-up-to-5 'jet)  ;--> #f indicating that the coroutine has expired.
(consing-up-to-5 'teun) ; error:
                        ; expired-coroutine called with resume-values: teun

Coroutines are not necessarily mortal, e.g. as produced by replacing (>= i limit) by #f in the sixth line of the definition of make-consing-counter.

A more realistic example: coroutines for permutations of lists.

This example also shows that coroutines may employ other coroutines, even those of their own species. We start from a list-producing version:

; Form a list of all permutations of a given list. Exchanges of equal elements
; (eq? via memq) are not considered to produce new permutations. Method: Take
; all rotations of the list that have different cars. Cons the car of each
; rotation to every permutation of its cdr. Append the lists obtained for each
; rotation such as to form one single list.
; WARNING: this is not the fastest method of making permutations.

(define (list-permutations list-to-be-permuted)
 (if (null? list-to-be-permuted) '(())
 ; The empty list has one permutation, namely the empty list itself.
 ; We must return a list of permutations, hence '(()).
  (let loop ((list-to-be-permuted list-to-be-permuted) (already-been-at-car '()))
   (let ((rotation (find-rotation list-to-be-permuted already-been-at-car)))
    (if (not rotation) '()
     (let ((kar (car rotation)) (kdr (cdr rotation)))
      (append
       (map (lambda (kdr) (cons kar kdr)) (list-permutations kdr))
       (loop rotation (cons kar already-been-at-car)))))))))

(define (find-rotation list-to-be-rotated already-been-at-car) 
 (let loop ((head list-to-be-rotated) (tail '())) 
  (and (not (null? head)) 
   (or
    (and (not (memq (car head) already-been-at-car)) (append head (reverse tail)))
    ; The reversal of the tail is not necessary.
    ; But without it all names with 'rotation' would be deceptive, of course.
    (loop (cdr head) (cons (car head) tail))))))

(list-permutations '(a a b c)) ; --> 
((a a b c) (a a c b) (a b c a) (a b a c) (a c a b) (a c b a)
 (b c a a) (b a a c) (b a c a) (c a a b) (c a b a) (c b a a))

The accumulated number of cycles of the loop of procedure find-rotation made during one cycle of the loop of procedure list-permutations usually is greater than the length of the list to be permuted. This is not optimal, of course. There are several ways to prevent unnecessary cycles, but they are not shown here, because this problem is not the subject of this recipe and because conversion of procedure find-rotation into a coroutine automatically prevents the rotator from making unnecessary cycles. Conversion into a coroutine:

(define make-permuter
 (make-coroutine-constr
  (lambda (toggle finish list-to-be-permuted)
   (lambda ()
    (if (null? list-to-be-permuted) (toggle '())
     (let ((rotator (make-rotator list-to-be-permuted)))
      (let rotation-loop ()
       (let ((rotation (rotator)))
        (when rotation
         (let ((kar (car rotation)) (kdr-permuter (make-permuter (cdr rotation))))
          (let kdr-permutation-loop ()
           (let ((kdr-permutation (kdr-permuter)))
            (if (not kdr-permutation) (rotation-loop)
             (begin
              (toggle (cons kar kdr-permutation))
              (kdr-permutation-loop)))))))))))))
  (lambda x #f))) ; Terminator always returning #f.

(define make-rotator
 (make-coroutine-constr
  (lambda (toggle finish list-to-be-rotated)
   (lambda ()
    (let loop ((head list-to-be-rotated) (tail '()))
     (cond
      ((null? head) (finish))
      ((memq (car head) tail) (loop (cdr head) (cons (car head) tail)))
      (else (toggle (append head (reverse tail)))
       ; The reversal of the tail is not necessary.
       ; But without it all names with 'rotation' would be deceptive, of course.
       (loop (cdr head) (cons (car head) tail)))))))
  (lambda x #f))) ; Terminator always returning #f.

(define permute-aabc (make-permuter '(a a b c)))

(permute-aabc) ;--> (a a b c)
(permute-aabc) ;--> (a a c b)
(permute-aabc) ;--> (a b c a)
(permute-aabc) ;--> (a b a c)
(permute-aabc) ;--> (a c a b)
(permute-aabc) ;--> (a c b a)
(permute-aabc) ;--> (b c a a)
(permute-aabc) ;--> (b a a c)
(permute-aabc) ;--> (b a c a)
(permute-aabc) ;--> (c a a b)
(permute-aabc) ;--> (c a b a)
(permute-aabc) ;--> (c b a a)
(permute-aabc) ;--> #f ; indicating that the coroutine has expired.

Procedure list-permutations (the list-producer) necessarily allocates separate storage for each permutation. So does the element by element producer permute-aabc. Procedures make-permuter and make-rotator can easily be adapted such as to do the permutations in situ (destructively) requiring less memory, less garbage collection and less processor time. However, only one permutation will be available at any given moment. Below procedure make-rotator is replaced by procedure make-exchanger, whose coroutines exchange the first element of the list to be permuted with one of the other elements (the first time with itself). Therefore the permutations may appear in another order. The list given to make-permuter must be mutable.

(require scheme/mpair)

(define-syntax while
 (syntax-rules ()
  ((while test def/expr ...)
   (let loop ()
    (when test (let () def/expr ... (loop)))))))

(define make-permuter
 (make-coroutine-constr
  (lambda (toggle finish list-to-be-permuted)
   (define (return-and-resume) (toggle #t))
   (lambda ()
    (if (null? list-to-be-permuted) (return-and-resume)
     (let ((exchanger (make-exchanger list-to-be-permuted)))
      (while (exchanger)
       (define kdr-permuter (make-permuter (mcdr list-to-be-permuted)))
       (while (kdr-permuter) (return-and-resume)))))))
  (lambda x #f)))

(define make-exchanger
 (make-coroutine-constr
  (lambda (toggle finish list-to-be-exchanged)
   (define (return-and-resume) (toggle #t))
   (lambda ()
    (let loop ((head list-to-be-exchanged) (tail '()))
     (when (not (null? head))
      (let ((car-head (mcar head)))
       (when (not (mmemq car-head tail))
        (let ((car-list-to-be-exchanged (mcar list-to-be-exchanged)))
         ; make exchange
         (set-mcar! list-to-be-exchanged car-head)
         (set-mcar! head car-list-to-be-exchanged)
         (return-and-resume)
         ; undo exchange
         (set-mcar! list-to-be-exchanged car-list-to-be-exchanged)
         (set-mcar! head car-head)))
        (loop (mcdr head) (mcons car-head tail)))))))
  (lambda x #f)))

The procedures made by make-permuter and make-exchanger do not return lists, because the list is always in variable list-to-be-permuted. They return #t as long as a new permutation cq. new exchange has been found and #f while expiring. As a test:

(let ((list-to-be-permuted (mlist 'a 'a 'b 'c)))
 (let ((permuter (make-permuter list-to-be-permuted)))
  (while (permuter) (printf "~s " list-to-be-permuted)))
 (newline)) ; --> void; displayed (in one line):
(a a b c) (a a c b) (a b a c) (a b c a) (a c b a) (a c a b) 
(b a a c) (b a c a) (b c a a) (c a b a) (c a a b) (c b a a)

When a coroutine calls a continuation of its caller or reversely

When the procedure proper bypasses the toggler and calls a continuation pointing into the caller of the coroutine, contact between the coroutine and its caller is lost because the caller becomes part of the procedure proper. When the caller bypasses the toggler and calls a continuation pointing into the procedure proper, contact between the coroutine and its caller is lost because the procedure proper becomes part of the caller. All continuations always see the most recently stored local state. This state does not make explicit which one is supposed to have control, the caller or the coroutine. Contact can be reestablished though. E.g, if the procedure proper calls a continuation pointing into the caller, contact can be reestablished by making the caller call a continuation pointing into the procedure proper, assuming such a continuation has been made available to the caller.

If a procedure proper tries to call the coroutine it belongs to

If the procedure proper tries to call the coroutine it is part of, the toggler in fact returns control to the caller. Likewise, if the caller tries to call the returner of a coroutine, the toggler in fact returns control to the coroutine. Because this may lead to confusion and to errors that cannot easily be traced, it may be desirable to adapt procedure make-coroutine-constr such as to prohibit the procedure proper from calling the coroutine it belongs to and to prohibit the caller from calling the returner. This can be done in several ways, for instance by maintaining two separate procedures for the coroutine and its returner and adding a variable, say control-state, in which is recorded who is supposed to be in control, the caller or the coroutine. This does not prevent the procedure proper from being recursive.

(define (make-coroutine-constr proc-maker terminator)
 (lambda constr-args ; args for data provided during the construction of the coroutine.
  (letrec
   ((local-state
     (lambda first-resume-values
      (call-with-values
       (lambda () (apply procedure-proper first-resume-values))
       finish)))
    (coroutine
     (lambda resume-values
      (call-with-current-continuation
       (lambda (cc)
        (toggler cc resume-values 'coroutine-call 'inactive 'active)))))
    (return
     (lambda return-values
      (call-with-current-continuation
       (lambda (cc)
        (toggler cc return-values 'return 'active 'inactive)))))
    (finish
     (lambda return-values
      (toggler #f (call-with-values (lambda () (apply terminator return-values)) list)
      'finish 'active 'expired)))
    (toggler
     (lambda (new-local-state r/r-values call-type expected-control-state new-control-state)
      (if (eq? control-state expected-control-state)
       (let ((old-local-state local-state))
        (set! local-state new-local-state)
        (set! control-state new-control-state)
        (apply old-local-state r/r-values))
       (control-state-error call-type expected-control-state r/r-values))))
    (control-state 'inactive) ; other feasible states are: active and expired
    (control-state-error
     (lambda (call-type expected-control-state r/r-values)
      (apply error "Coroutine control-state error."
      `(Call-type: ,call-type
        Current-control-state: ,control-state
        Expected-control-state: ,expected-control-state
        Return/resume-values: ,@r/r-values))))
    (procedure-proper (apply proc-maker return finish constr-args)))
   coroutine)))

CookbookForm
TopicType:	Recipe
ParentTopic:	IdiomRecipes
TopicOrder:	999

Attachment:	Action:	Size:	Date:	Who:	Comment:
cookbookcoroutines.scm	action	13120	21 Apr 2009 - 11:40	JosKoot

PLT Scheme	SISC
Scheme48	SCM
MIT Scheme	scsh
JScheme	Kawa
Chicken	Guile
Bigloo	Tiny
Gambit	LispMe
Gauche	Chez

s c h e m a t i c s : c o o k b o o k

Coroutines

Problem

Rationale

Solution

A more realistic example: coroutines for permutations of lists.

When a coroutine calls a continuation of its caller or reversely

If a procedure proper tries to call the coroutine it belongs to

Comments about this recipe

Contributors

Source code