coroutine - Implement yield and send in Scheme

Question

I'm trying to port yield and yield from from Python to Scheme.

Here is an implementation I've done:

(define (coroutine routine)
  (let ((current routine)
    (status 'new))
    (lambda* (#:optional value)
      (let ((continuation-and-value
         (call/cc (lambda (return)
            (let ((returner
                   (lambda (value)
                 (call/cc (lambda (next)
                        (return (cons next value)))))))
              (if (equal? status 'new)
                  (begin
                (set! status 'running)
                (current returner))
                  (current (cons value returner)))
              (set! status 'dead))))))
    (if (pair? continuation-and-value)
        (begin (set! current (car continuation-and-value))
           (cdr continuation-and-value))
        continuation-and-value)))))

The problem, with this implementation is that the way it has to be called doesn't looks like Python's yield.

(define why (call/cc (lambda (yield)
               (format #t "love me or leave me!")
               (yield "I leave!")
               ;; the program never reach this part
               (format #t "it probably left :("))))
(format #t "return actually populates WHY variable
")
(format #t "WHY: ~a
")

Among other things, each time I need to-restart the coroutine, I must let a new return variable to be able exit the coroutine. Basically, I find the syntax too verbose. Is there another to have cleaner syntax?

It should be possible to yield and send values to the coroutine. Here is an example of how the coroutine must be used:

(define-coroutine (zrange start step)
  "compute a range of values starting a START with STEP between
   each value. The coroutine must be restarted with 0 or more, which
   is added to the step"
  (let loop ((n start))
    (loop (+ n step (yield n)))))


(coroutine-map (zrange 0 10) '(1 100 1000 10000 100000))
;; => 0 110 1120 11130 111140

In the above, 1 is ignored and then 100, 1000 are send to the generator. I've done an implementation, based on @sylwester code, but I have troubles with the macro:

(define (make-generator procedure)
  (define last-return #f)
  (define last-value #f)
  (define last-continuation (lambda (_) (procedure yield)))

  (define (return value)
    (newline)(display "fuuu")(newline)
    (call/cc (lambda (continuation)
               (set! last-continuation continuation)
               (set! last-value value)
               (last-return value))))
  (lambda* (. rest)  ; ignore arguments
    (call/cc (lambda (yield)
               (set! last-return yield)
               (apply last-continuation rest)))))

(define-syntax define-coroutine
  (syntax-rules ()
    ((_ (name args ...) body ...)
     (define (name args ...)

       (make-generator
        (lambda (yield)
          body ...))))))

(define-coroutine (zrange start step)
  (let loop ((n start))
     (loop (+ n step (yield n)))))

(display (map (zrange 0 10) '(1 100 1000 10000 100000)))

Answer 1

Something like this:

(define (make-generator procedure)
  (define last-return values)
  (define last-value #f)
  (define (last-continuation _) 
    (let ((result (procedure yield))) 
      (last-return result)))

  (define (yield value)
    (call/cc (lambda (continuation)
               (set! last-continuation continuation)
               (set! last-value value)
               (last-return value))))

  (lambda args
    (call/cc (lambda (return)
               (set! last-return return)
               (if (null? args)
                   (last-continuation last-value)
                   (apply last-continuation args))))))

Used like this:

(define test 
 (make-generator
   (lambda (collect)
     (collect 1)
     (collect 5)
     (collect 10)
     #f)))

(test) ; ==> 1
(test) ; ==> 5
(test) ; ==> 10
(test) ; ==> #f (procedure finished)

Now we can wrap the internals into a macro:

(define-syntax (define-coroutine stx)
  (syntax-case stx ()
    ((_ (name . args) . body )
     #`(define (name . args)
         (make-generator 
          (lambda (#,(datum->syntax stx 'yield))
            . body))))))

Notice that define-coroutine is implemented using syntax-case since we need to make yield unhygienic.

(define-coroutine (countdown-from n)
  (let loop ((n n))
    (if (= n 0)
        0
        (loop (- (yield n) 1)))))

(define countdown-from-10 (countdown-from 10))

(define (ignore procedure)
  (lambda ignore
    (procedure)))

(map (ignore countdown-from-10) '(1 1 1 1 1 1)) ; ==> (10 9 8 7 6 5)

;; reset
(countdown-from-10 10)  ; ==> 9
(countdown-from-10)     ; ==> 8
;; reset again
(countdown-from-10 100) ; ==> 99