Improve handling of idle resources in the resource pool

This commit is contained in:
Christopher Baines 2025-02-04 11:13:15 +00:00
parent 893299ba24
commit aadbee0d0e

View file

@ -79,7 +79,7 @@
port))) port)))
(define* (make-resource-pool return-new-resource max-size (define* (make-resource-pool return-new-resource max-size
#:key (min-size max-size) #:key (min-size 0)
(idle-seconds #f) (idle-seconds #f)
(delay-logger (const #f)) (delay-logger (const #f))
(duration-logger (const #f)) (duration-logger (const #f))
@ -375,7 +375,7 @@
(/ (- (get-internal-real-time) internal-time) (/ (- (get-internal-real-time) internal-time)
internal-time-units-per-second)) internal-time-units-per-second))
resources-last-used)) resources-last-used))
(resources-to-destroy (candidate-resources-to-destroy
(filter-map (filter-map
(lambda (resource last-used-seconds) (lambda (resource last-used-seconds)
(if (and (member resource available) (if (and (member resource available)
@ -385,16 +385,28 @@
resources resources
resources-last-used-seconds))) resources-last-used-seconds)))
(when destructor (let* ((available-resources-to-destroy
(for-each (lset-intersection eq?
(lambda (resource) available
(spawn-fiber-to-destroy-resource resource)) candidate-resources-to-destroy))
resources-to-destroy)) (max-resources-to-destroy
(max 0
(- (length resources)
min-size)))
(resources-to-destroy
(take available-resources-to-destroy
(min max-resources-to-destroy
(length available-resources-to-destroy)))))
(when destructor
(for-each
(lambda (resource)
(spawn-fiber-to-destroy-resource resource))
resources-to-destroy))
(loop resources (loop resources
(lset-difference eq? available resources-to-destroy) (lset-difference eq? available resources-to-destroy)
waiters waiters
resources-last-used))) resources-last-used))))
(('destroy reply) (('destroy reply)
(if (null? resources) (if (null? resources)