1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
|
; Part of Scheme 48 1.9. See file COPYING for notices and license.
; Authors: Mike Sperber
(define-record-type async-channel :async-channel
(really-make-async-channel in-channel out-channel)
async-channel?
(in-channel async-channel-in-channel)
(out-channel async-channel-out-channel))
(define (make-async-channel)
(let ((in-channel (make-channel))
(out-channel (make-channel)))
(spawn
(lambda ()
(let ((queue (make-queue)))
(let loop ()
(if (queue-empty? queue)
(begin
(enqueue! queue (receive in-channel))
(loop))
(select
(wrap (receive-rv in-channel)
(lambda (message)
(enqueue! queue message)
(loop)))
(wrap (send-rv out-channel (queue-head queue))
(lambda (ignore)
(dequeue! queue)
(loop)))))))))
(really-make-async-channel in-channel
out-channel)))
(define (send-async channel message)
(send (async-channel-in-channel channel) message))
(define (receive-async-rv channel)
(receive-rv (async-channel-out-channel channel)))
(define (receive-async channel)
(sync (receive-async-rv channel)))
|
