added "autorequire"; preparing libraries for autorequire
[k8-xscheme:k8-xscheme.git] / lib / coroutine.scm
1 (xs:libinfo coroutine
2   (exports make-coroutine))
3
4 (define (make-coroutine routine)
5   (let ([current routine]
6         [status 'suspended])
7     (lambda args
8       (cond
9         [(null? args)
10          (if (eq? status 'dead)
11              (error "dead coroutine")
12              (let ([continuation-and-value
13                     (call/cc (lambda (return)
14                                (let ([returner
15                                       (lambda (value)
16                                         (call/cc (lambda (next)
17                                                    (return (cons next value)))))])
18                                  (current returner)
19                                  (set! status 'dead))))])
20                (if (pair? continuation-and-value)
21                    (begin
22                      (set! current (car continuation-and-value))
23                      (cdr continuation-and-value))
24                    continuation-and-value)))]
25         ((eq? (car args) 'status?) status)
26         ((eq? (car args) 'dead?) (eq? status 'dead))
27         ((eq? (car args) 'alive?) (not (eq? status 'dead)))
28         ((eq? (car args) 'kill!) (set! status 'dead))
29         (else #f)))))