Support getting resource pool stats
This commit is contained in:
parent
7251c7d653
commit
899bd1387e
1 changed files with 23 additions and 0 deletions
|
|
@ -35,6 +35,7 @@
|
||||||
make-resource-pool
|
make-resource-pool
|
||||||
call-with-resource-from-pool
|
call-with-resource-from-pool
|
||||||
with-resource-from-pool
|
with-resource-from-pool
|
||||||
|
resource-pool-stats
|
||||||
|
|
||||||
parallel-via-fibers
|
parallel-via-fibers
|
||||||
par-map&
|
par-map&
|
||||||
|
|
@ -158,6 +159,23 @@
|
||||||
(cons resource available)
|
(cons resource available)
|
||||||
;; clear waiters, as they've been notified
|
;; clear waiters, as they've been notified
|
||||||
'()))
|
'()))
|
||||||
|
(('stats reply)
|
||||||
|
(let ((stats
|
||||||
|
`((resources . ,(length resources))
|
||||||
|
(available . ,(length available))
|
||||||
|
(waiters . ,(length waiters)))))
|
||||||
|
|
||||||
|
(perform-operation
|
||||||
|
(choice-operation
|
||||||
|
(wrap-operation
|
||||||
|
(put-operation reply stats)
|
||||||
|
(const #t))
|
||||||
|
(wrap-operation (sleep-operation 0.2)
|
||||||
|
(const #f)))))
|
||||||
|
|
||||||
|
(loop resources
|
||||||
|
available
|
||||||
|
waiters))
|
||||||
(unknown
|
(unknown
|
||||||
(simple-format
|
(simple-format
|
||||||
(current-error-port)
|
(current-error-port)
|
||||||
|
|
@ -255,6 +273,11 @@ available. Return the resource once PROC has returned."
|
||||||
pool
|
pool
|
||||||
(lambda (resource) exp ...)))
|
(lambda (resource) exp ...)))
|
||||||
|
|
||||||
|
(define (resource-pool-stats pool)
|
||||||
|
(let ((reply (make-channel)))
|
||||||
|
(put-message pool `(stats ,reply))
|
||||||
|
(get-message reply)))
|
||||||
|
|
||||||
(define (defer-to-parallel-fiber thunk)
|
(define (defer-to-parallel-fiber thunk)
|
||||||
(let ((reply (make-channel)))
|
(let ((reply (make-channel)))
|
||||||
(spawn-fiber
|
(spawn-fiber
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue