Support getting resource pool stats

This commit is contained in:
Christopher Baines 2023-07-09 18:06:00 +01:00
parent 7251c7d653
commit 899bd1387e
1 changed files with 23 additions and 0 deletions

View File

@ -35,6 +35,7 @@
make-resource-pool
call-with-resource-from-pool
with-resource-from-pool
resource-pool-stats
parallel-via-fibers
par-map&
@ -158,6 +159,23 @@
(cons resource available)
;; 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
(simple-format
(current-error-port)
@ -255,6 +273,11 @@ available. Return the resource once PROC has returned."
pool
(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)
(let ((reply (make-channel)))
(spawn-fiber