coroutines added by megane on Thu Aug 9 11:06:40 2012

File: mycoroutines.scm
-----

;;(declare (disable-interrupts))
(declare (local))
(module
 mycoroutines
 *
 (import chicken scheme)
 
 (declare (bound-to-procedure *return-cont*
			      yield
			      call-coroutine))
 (define *return-cont* #f)

 (define (yield ret-val)
   (call/cc
    (lambda (c)
      ((the (list -> *) *return-cont*) (list ret-val c)))))


 (: call-coroutine (procedure ((procedure (*) *) *)
 			      (list * (or boolean list))))
 (define (call-coroutine coroutine arg)
   (call/cc
    (lambda (return-cont)
      (set! *return-cont* return-cont)
      (coroutine arg)
      ;; Return #f when coroutine has completely finished. 
      ((the (list -> *) *return-cont*) '(#f #f))))) 
)


File: test.scm
-----

(include "mycoroutines.scm")
(import mycoroutines)

(define (bar)
  (print "bar called")
  (print "got "(yield 'bar)))

(define (foo _)
  (print "foo start")
  (print "got" (yield 1))
  (print "got" (yield 2))
  (bar))

(let* [(c foo)
       (call (lambda (arg)
	       (print "call " arg)
	       (if c
		   (let [(rv (call-coroutine c arg))]
		     (set! c (and rv (cadr rv)))
		     (if (cadr rv)
			 (print "coro returned " (and rv (car rv)))
			 (print "coroutine has ended " arg)))
		   (print "oops" arg))))]
  (call 1)
  (call 2)
  (call 3)
  (call 4))

;; call 1
;; foo start
;; coro returned 1
;; call 2
;; got2
;; coro returned 2
;; call 3
;; got3
;; bar called
;; coro returned bar
;; call 4
;; got 4
;; coroutine has ended 4