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\n")
(format #t "WHY: ~a\n")

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

Kudos to @Sylwester for a great answer.

The difficult part is making yield available to the generator function. datum->syntax creates a syntax object, and requires you to provide another syntax object from which the context for the new object is taken. In this case, we can use stx which has the same context as the function passed into the macro.

If people find it helpful, I use a simpler version:

(define-syntax (set-continuation! stx)
  "Simplifies the common continuation idiom
    (call/cc (λ (k) (set! name k) <do stuff>))"
  (syntax-case stx ()
    [(_ name . body)
     #`(call/cc (λ (k)
                  (set! name k)
                  . body))]))

(define-syntax (make-generator stx)
  "Creates a Python-like generator. 
   Functions passed in can use the `yield` keyword to return values 
   while temporarily suspending operation and returning to where they left off
   the next time they are called."
  (syntax-case stx ()
    [(_ fn)
     #`(let ((resume #f)
             (break #f))
         (define #,(datum->syntax stx 'yield)
           (λ (v)
             (set-continuation! resume
               (break v))))
         (λ ()
           (if resume
               (resume #f)
               (set-continuation! break
                 (fn)
                 'done))))]))

An example of its usage:

(define countdown
  (make-generator
   (λ ()
     (for ([n (range 5 0 -1)])
           (yield n)))))

(countdown)
=> 5
...
(countdown)
=> 1
(countdown)
=> 'done
(countdown)
=> 'done

Answer 2

One approach is here. If you are using guile, you should use prompts (they are about two orders of magnitude faster than using full continuations with guile):

How to implement Python-style generator in Scheme (Racket or ChezScheme)?

Answer 3

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