;; Macro to make Scheme look like the book language:
(define-syntax letcc
  (syntax-rules ()
    [(letcc id exp ...)
     (call-with-current-continuation
      (lambda (id) exp ...))]))
;; Scheme continuations are applied like procedures:
(define (continue k v)
  (k v))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Thread implementation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; A list of continuations:
(define thread-queue '())

;; swap-thread! : -> sym
;;  Always returns 'thread, when it eventually returns
(define (swap-thread!)
  (letcc k
    (set! thread-queue (append thread-queue (list k)))
    (start-first-thread!)))
    
;; start-first-thread! : ->
;;  Doesn't return
(define (start-first-thread!)
  (let ([new-k (car thread-queue)])
    (set! thread-queue (cdr thread-queue))
    (continue new-k 'thread)))

;; spawn : (-> val) -> int
(define (spawn thunk)
  (let ([v (letcc k
             (set! thread-queue (append thread-queue 
                                        (list k)))
             'main)])
    (if (eq? v 'thread)
        ;; In child:
        (begin
          (thunk)
          (start-first-thread!))
        ;; In parent:
        1)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Program using cooperative threads
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (f id)
  (letrec ([loop
            (lambda (n)
              (swap-thread!) ;; <<<<< This is the cooperative part
              (if (zero? n)
                  0
                  (begin
                    (eopl:printf "~a: ~a~n" id n)
                    (loop (- n 1)))))])
    (loop 10)))

;; Printouts from threads 1 and 2 will be interleaved:
(spawn (lambda () (f 1)))
(spawn (lambda () (f 4)))
(spawn (lambda () (f 5)))
(f 2)