Green Threads

green-thread.scm

(import (scheme base)
        (scheme write)
        (srfi 1)
        (gauche partcont))

(define-syntax green-threads
  (syntax-rules ()
    ((_ (yield) a) 
     (reset a (call/pc yield)))
    ((_ (yield) a b ...)
     (reset a (call/pc yield) (green-threads (yield) b ...)))))

(define-syntax thread 
  (syntax-rules ()
    ((_ (args ...) body ...)
     (lambda (args ...)
       (reset
         (shift yield
           (green-threads (yield) body ...)))))))

(define (join . threads)
   (if (not (null? threads))
     (let ((fn (lambda (co) (co))))
       (apply join (filter procedure? (map fn threads))))))

(define (p msg) (display msg) (newline))

(define foo
  (thread ()
    (p "foo 1")
    (p "foo 2")
    (p "foo 3")
    (p "foo 4")
    (p "foo 5")))

(define bar
  (thread ()
    (p "bar 1")
    (p "bar 2")
    (p "bar 3")
    (p "bar 4")
    (p "bar 5")))

(define bazz
  (thread ()
    (p "bazz 1")
    (p "bazz 2")
    (p "bazz 3")
    (p "bazz 4")
    (p "bazz 5")))

(join foo bar bazz)