; Composable coroutines for Scheme
; See demo below

(define (new-view)
  (let ((view (cons 'coroutine-view #f)))   ; create the view
    (set-cdr! view (new-coro view #f))  ; create and attach the main coroutine
    view))

(define (view-check view)
  (if (not (eqv? (car view) 'coroutine-view))
      (error "argument should be a coroutine-view")))

(define (coro-check view)
  (if (not (eqv? (car view) 'coroutine))
      (error "argument should be a coroutine")))

(define (new-coro view proc)
  (view-check view)
  (cons 'coroutine (cons view proc)))

(define (view-current-coro view)
  (view-check view)
  (cdr view))

(define (view-set-current-coro! view coro)
  (view-check view)
  (set-cdr! view coro))

(define (coro-view coro)
  (coro-check coro)
  (car (cdr coro)))

(define (coro-proc coro)
  (coro-check coro)
  (cdr (cdr coro)))

(define (coro-set-proc! coro proc)
  (coro-check coro)
  (set-cdr! (cdr coro) proc))

(define (switch coro x)
  (coro-check coro)
  (let* ((view (coro-view coro))
         (sourcecoro (view-current-coro view))
         (proc (coro-proc coro)))
    (if (eqv? coro sourcecoro)
        ; target coroutine is already the current one
        x
        ; else switch to the target coroutine
        (begin
          (coro-set-proc! coro #f)
          (view-set-current-coro! view coro)
          (call-with-current-continuation
              (lambda (cc)
                (coro-set-proc! sourcecoro cc)
                (proc x)    ; jump into the coro
                (error "coroutine should not return")))))))

; ____________________________________________________________

(define (generate-integers outer n)
  (define (one-two-three inner)
    (switch inner 1)
    (switch outer n)
    (switch inner 3))
  (let ((innergen (new-generator one-two-three)))
    (switch outer (+ n (innergen)))
    (switch outer (+ n (innergen))))
  (generate-integers outer (* n 2)))

(define (demo gencoro n)
  (if (= n 0)
      (print "done")
      (begin
        (print (gencoro))
        (demo gencoro (- n 1)))))

(define (new-generator proc)
  (let* ((view1 (new-view))
         (gencoro (new-coro view1 proc)))
    (lambda () (switch gencoro (view-current-coro view1)))))

(print "starting")
(demo (new-generator (lambda (outer) (generate-integers outer 50))) 20)

(quit)