(module prophecy mzscheme (require (lib "async-channel.ss")) (define *done* (let-struct sentinel () (make-sentinel))) (define-struct stop-iteration ()) (define *stop-iteration* (make-stop-iteration)) (define-struct prophecy (channel thread)) (define current-channel (make-parameter #f)) (define (build-prophecy thunk) (let ([ch (make-async-channel)]) (make-prophecy ch (thread (lambda () (parameterize ([current-channel ch]) (dynamic-wind void thunk (lambda () (yield *done*))))))))) (define (yield v) (unless (current-channel) (error 'yield "not in a prophecy context")) (async-channel-put (current-channel) v)) (define (prophecy-next p) (when (eq? (current-channel) (prophecy-channel p)) (error 'prophecy-next "attempt to block prophecy on itself")) (let ([next (async-channel-get (prophecy-channel p))]) (if (eq? next *done*) (raise *stop-iteration*) next))) (define (prophecy->stream p) (let loop () (delay (let ([next (async-channel-get (prophecy-channel p))]) (if (eq? next *done*) null (cons next (loop))))))) (define-syntax :prophecy (syntax-rules () [(_ e0 e1 ...) (build-prophecy (lambda () e0 e1 ...))])) (provide prophecy? stop-iteration?) (provide prophecy-next yield prophecy->stream) (provide (rename :prophecy prophecy) (rename *stop-iteration* stop-iteration)))