cs: add sync
shortcuts for simple cases
This commit is contained in:
parent
e15eadd106
commit
ae4b101ec5
|
@ -12,7 +12,8 @@
|
||||||
channel-get
|
channel-get
|
||||||
|
|
||||||
channel-put-evt
|
channel-put-evt
|
||||||
channel-put-evt?)
|
channel-put-evt?
|
||||||
|
channel-put-do)
|
||||||
|
|
||||||
(module+ for-sync
|
(module+ for-sync
|
||||||
(provide set-sync-on-channel!))
|
(provide set-sync-on-channel!))
|
||||||
|
@ -194,6 +195,10 @@
|
||||||
(define new-v ((cdr ch+put-proc) old-ch v))
|
(define new-v ((cdr ch+put-proc) old-ch v))
|
||||||
(channel-put old-ch new-v))
|
(channel-put old-ch new-v))
|
||||||
|
|
||||||
|
(define (channel-put-do v)
|
||||||
|
(channel-put (channel-put-evt*-ch v)
|
||||||
|
(channel-put-evt*-v v)))
|
||||||
|
|
||||||
;; ----------------------------------------
|
;; ----------------------------------------
|
||||||
|
|
||||||
(define (not-matching-select-waiter w+b/v)
|
(define (not-matching-select-waiter w+b/v)
|
||||||
|
|
|
@ -166,11 +166,36 @@
|
||||||
;; Just `go`:
|
;; Just `go`:
|
||||||
(go)])))
|
(go)])))
|
||||||
|
|
||||||
(define (sync . args)
|
(define sync
|
||||||
(do-sync 'sync #f args))
|
(case-lambda
|
||||||
|
[(evt)
|
||||||
|
(cond
|
||||||
|
[(semaphore? evt)
|
||||||
|
(semaphore-wait evt)
|
||||||
|
evt]
|
||||||
|
[(channel? evt)
|
||||||
|
(channel-get evt)]
|
||||||
|
[(channel-put-evt? evt)
|
||||||
|
(channel-put-do evt)
|
||||||
|
evt]
|
||||||
|
[else
|
||||||
|
(do-sync 'sync #f (list evt))])]
|
||||||
|
[args
|
||||||
|
(do-sync 'sync #f args)]))
|
||||||
|
|
||||||
(define (sync/timeout timeout . args)
|
(define sync/timeout
|
||||||
(do-sync 'sync/timeout timeout args))
|
(case-lambda
|
||||||
|
[(timeout evt)
|
||||||
|
(cond
|
||||||
|
[(and (semaphore? evt)
|
||||||
|
(eqv? timeout 0))
|
||||||
|
(if (semaphore-try-wait? evt)
|
||||||
|
evt
|
||||||
|
#f)]
|
||||||
|
[else
|
||||||
|
(do-sync 'sync/timeout timeout (list evt))])]
|
||||||
|
[(timeout . args)
|
||||||
|
(do-sync 'sync/timeout timeout args)]))
|
||||||
|
|
||||||
(define (sync/enable-break . args)
|
(define (sync/enable-break . args)
|
||||||
(do-sync 'sync/enable-break #f args #:enable-break? #t))
|
(do-sync 'sync/enable-break #f args #:enable-break? #t))
|
||||||
|
|
Loading…
Reference in New Issue
Block a user