hans/uni-channel
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Unichannel-wait added.

Browse Source
This commit is contained in:
Hans Dijkema
2026-07-06 15:17:43 +02:00
parent 751099152b
commit e14494f3b3
4 changed files with 29 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files
main.rkt
+13 -2
View File
@@ -18,6 +18,7 @@
uni-channel-get-evt
uni-channel-put-evt
uni-channel-close
uni-channel-wait
uni-channel-closed?
uni-channel-error-get
@@ -26,7 +27,7 @@
(struct uni-channel
(kind impl direction get-proc put-proc try-get-proc get-evt-proc put-evt-proc
close-proc closed-box error-get-proc error-try-get-proc error-evt-proc)
close-proc wait-proc closed-box error-get-proc error-try-get-proc error-evt-proc)
#:property prop:evt
(lambda (ch)
(if (can-get? ch) ((uni-channel-get-evt-proc ch) ch) never-evt)))
@@ -55,6 +56,9 @@
(mark-closed! ch)
(void))
(define (default-wait ch)
(void))
(define (no-error-get ch)
(raise-arguments-error 'uni-channel-error-get "uni-channel has no error channel"
"kind" (uni-channel-kind ch)))
@@ -71,11 +75,12 @@
#:get-evt get-evt-proc
#:put-evt put-evt-proc
#:close close-proc
#:wait wait-proc
#:error-get error-get-proc
#:error-try-get error-try-get-proc
#:error-evt error-evt-proc)
(uni-channel kind impl direction get-proc put-proc try-get-proc get-evt-proc put-evt-proc
close-proc (box #f) error-get-proc error-try-get-proc error-evt-proc))
close-proc wait-proc (box #f) error-get-proc error-try-get-proc error-evt-proc))
(define (make-uni-channel channel)
(cond
@@ -96,6 +101,7 @@
#:get-evt (lambda (_ch) ch)
#:put-evt (lambda (_ch v) (async-channel-put-evt ch v))
#:close default-close
#:wait default-wait
#:error-get no-error-get
#:error-try-get no-error-try-get
#:error-evt no-error-evt))
@@ -110,6 +116,7 @@
#:get-evt (lambda (_ch) ch)
#:put-evt (lambda (_ch v) (handle-evt always-evt (lambda (_) (place-channel-put ch v))))
#:close default-close
#:wait default-wait
#:error-get no-error-get
#:error-try-get no-error-try-get
#:error-evt no-error-evt))
@@ -125,6 +132,7 @@
#:get-evt (lambda (_ch) (port-channel-evt pc))
#:put-evt (lambda (_ch v) (handle-evt always-evt (lambda (_) (port-channel-put pc v))))
#:close (lambda (ch) (mark-closed! ch) (close-port-channel pc))
#:wait (lambda (_ch) (port-channel-wait pc))
#:error-get (lambda (_ch) (port-channel-error-get pc))
#:error-try-get (lambda (_ch) (port-channel-error-try-get pc))
#:error-evt (lambda (_ch) (port-channel-error-evt pc))))
@@ -160,6 +168,9 @@
(unless (uni-channel-closed? ch) ((uni-channel-close-proc ch) ch))
(void))
(define (uni-channel-wait ch)
((uni-channel-wait-proc ch) ch))
(define (uni-channel-closed? ch) (unbox (uni-channel-closed-box ch)))
(define (uni-channel-error-get ch) ((uni-channel-error-get-proc ch) ch))