coroutine - Implement yield and send in Scheme -


i'm trying port yield , yield from python scheme.

here 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, implementation way has called doesn't looks python's yield.

(define why (call/cc (lambda (yield)                (format #t "love me or leave me!")                (yield "i leave!")                ;; program never reach part                (format #t "it left :(")))) (format #t "return populates why variable\n") (format #t "why: ~a\n") 

among other things, each time need to-restart coroutine, must let new return variable able exit coroutine. basically, find syntax verbose. there have cleaner syntax?

it should possible yield and send values coroutine. here example of how coroutine must used:

(define-coroutine (zrange start step)   "compute range of values starting start step between    each value. coroutine must restarted 0 or more,    added 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 above, 1 ignored , 100, 1000 send generator. i've done implementation, based on @sylwester code, have troubles 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))) 

something 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 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 can wrap internals macro:

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

notice define-coroutine implemented using syntax-case since need 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 

Comments