Robust coroutines/generators for R6RS

Hi all,

I've made a coroutines library, and I'm wondering if there are any
problems with it or if it could be improved. I made it handle issues
that were not obvious to me at first: the dynamic environment of
raised exceptions and recursive or concurrent use screwing it up.

[I hope Google Groups formats this right.]
=====================================================================
(library (xitomatl coroutines)
(export
make-coroutine
coroutine
case-coroutine
define-coroutine
&coroutine-finished?
&coroutine-finished-coroutine)
(import
(rnrs)
(only (xitomatl define extras) define/?/AV))

;;; Inspired by Will Farr's generators example:
;;; http://wmfarr.blogspot.com/2006/08/one-more-example-of-python-generators.html
;;;
;;; NOTE: These coroutines are not thread/engine safe,
;;; and a coroutine must not call itself.

(define-condition-type &coroutine-finished &condition
make-&coroutine-finished &coroutine-finished?
(coroutine &coroutine-finished-coroutine))

(define/?/AV (make-coroutine [make-proc procedure?])
(letrec*
([yield
(lambda args
(call/cc
(lambda (k)
(set! resume k)
(return (lambda () (apply values args))))))]
[resume
(let ([proc (make-proc yield)])
(unless (procedure? proc)
(AV "make-proc did not return a procedure" proc))
;; The initial resume isn't actually "resuming". It's
what starts
;; the coroutine by calling the procedure which contains
the body
;; of the coroutine.
(lambda args
(with-exception-handler
(lambda (ex)
;; Doing this makes the dynamic environment (e.g.
the
;; exception handlers) of the raise of the
exception
;; from inside proc be that of the current
invocation of
;; the coroutine. Otherwise, it would always be
that
;; of the first invocation.
(return (lambda () (raise ex))))
(lambda () (apply proc args)))
(let ([gf (make-&coroutine-finished coroutine)])
;; Set resume to this so that proc is not re-entered
if the
;; coroutine is invoked again after proc has returned.
(set! resume (lambda args (return (lambda () (raise
gf)))))
;; Raise in the dynamic environment of the current
;; invocation of the coroutine.
(return (lambda () (raise gf))))))]
[return #f]
[coroutine
(lambda args
(when return
(assertion-violation 'coroutine
"illegal recursive or concurrent call" coroutine))
(let ([return-proc (call/cc
(lambda (k)
(set! return k)
(apply resume args)))])
(set! return #f)
(return-proc)))])
coroutine))

(define-syntax case-coroutine/lexical-context
(lambda (stx)
(syntax-case stx ()
[(_ ctxt [frmls b0 b ...] ...)
(with-syntax ([yield (datum->syntax #'ctxt 'yield)])
#'(make-coroutine
(lambda (yield)
(case-lambda [frmls b0 b ...] ...))))])))

;;; NOTE: Matching arguments and selecting a clause only happens
;; the first time the coroutine is called.
(define-syntax case-coroutine
(lambda (stx)
(syntax-case stx ()
[(ctxt [frmls b0 b ...] ...)
#'(case-coroutine/lexical-context ctxt [frmls b0
b ...] ...)])))

(define-syntax coroutine
(lambda (stx)
(syntax-case stx ()
[(ctxt frmls b0 b ...)
#'(case-coroutine/lexical-context ctxt [frmls b0 b ...])])))

(define-syntax define-coroutine
(lambda (stx)
(syntax-case stx ()
[(_ (name . frmls) b0 b ...)
(identifier? #'name)
#'(define name
(case-coroutine/lexical-context name [frmls b0
b ...]))])))

)
=====================================================================

Python-style generators can be made like:

(define (PyG x)
(coroutine ()
(yield x)
(yield x)))


Tests for this library and the (xitomatl define extras) library can be
found at:

https://code.launchpad.net/~derick-eddington/ikarus-libraries/xitomatl

[Ikarus and PLT are currently the only implementations that can run
it.]

Thanks for any feedback.

--
: Derick
----------------------------------------------------------------
.

Relevant Pages

  • Re: NRE committed: PLEASE TEST
    ... to displace an existing proc or command until it completes. ... that [yield] would only effect the proc it was invoked from). ... If the original command has been replaced by a default coroutine, ...
    (comp.lang.tcl)
  • Re: NRE committed: PLEASE TEST
    ... function regardless of whether the proc was evaluated via ... use [coroutine] to create simultaneous invocations, ... IOW, your proposal may look like "let us change [yield], but ir really is "let us change ". ... is whether there's anything within the TCL stack ...
    (comp.lang.tcl)
  • Re: NRE committed: PLEASE TEST
    ... be a proc, and hence you could pass in arguments and have them update ... so you give an argument to the coroutine and it pops out as the ... that a design decision, or a practical limitation? ... foreach arg [info args $proc] { ...
    (comp.lang.tcl)
  • Re: NRE committed: PLEASE TEST
    ... resume only takes a single argument, whereas the original proc ... Creation of a coroutine takes inital arguments - fair enough - and resuming a coroutine also takes an argument. ... From the Tcl script level it is indeed a command, and it does take an optional argument. ...
    (comp.lang.tcl)
  • Re: NRE committed: PLEASE TEST
    ... function regardless of whether the proc was evaluated via ... use [coroutine] to create simultaneous invocations, ... But [yield] would be a ... swap in the new execEnv as the current execution environment, ...
    (comp.lang.tcl)