aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2025-02-23 20:30:38 +0000
committerChristopher Baines <mail@cbaines.net>2025-02-23 20:30:38 +0000
commit4677f141067d9c97bb3e4689af075626f40fe4bd (patch)
treead8847cd02ca33635618dcb926ab8b0d204cb1a2
parent9d55fe7e17d8a3dd4b0572cb7756c9b33733f084 (diff)
downloadbuild-coordinator-4677f141067d9c97bb3e4689af075626f40fe4bd.tar
build-coordinator-4677f141067d9c97bb3e4689af075626f40fe4bd.tar.gz
Memoize the read derivation
-rw-r--r--guix-build-coordinator/client-communication.scm52
1 files changed, 29 insertions, 23 deletions
diff --git a/guix-build-coordinator/client-communication.scm b/guix-build-coordinator/client-communication.scm
index a3ad502..e7eeb33 100644
--- a/guix-build-coordinator/client-communication.scm
+++ b/guix-build-coordinator/client-communication.scm
@@ -524,30 +524,36 @@
`(,build-coordinator
,derivation-file
#:read-drv
- ,(lambda (derivation-file)
- (with-exception-handler
- (lambda (exn)
- (log-msg
- (build-coordinator-logger build-coordinator)
- 'WARN
- "exception substituting derivation " derivation-file
- ": " exn)
- (raise-exception exn))
- (lambda ()
- (with-exception-handler
- (lambda (exn)
- (backtrace)
- (raise-exception exn))
- (lambda ()
- (retry-on-error
+ ,(let ((memoized-drv #f))
+ (lambda (derivation-file)
+ (or
+ memoized-drv
+ (with-exception-handler
+ (lambda (exn)
+ (log-msg
+ (build-coordinator-logger build-coordinator)
+ 'WARN
+ "exception substituting derivation " derivation-file
+ ": " exn)
+ (raise-exception exn))
+ (lambda ()
+ (with-exception-handler
+ (lambda (exn)
+ (backtrace)
+ (raise-exception exn))
(lambda ()
- (read-drv/substitute derivation-file))
- #:times 2
- #:delay 3
- #:error-hook
- (lambda _
- (metric-increment read-drv-error-count-metric))))))
- #:unwind? #t))
+ (let ((result
+ (retry-on-error
+ (lambda ()
+ (read-drv/substitute derivation-file))
+ #:times 2
+ #:delay 3
+ #:error-hook
+ (lambda _
+ (metric-increment read-drv-error-count-metric)))))
+ (set! memoized-drv result)
+ result))))
+ #:unwind? #t))))
,@(let ((priority (assoc-ref body "priority")))
(if priority
`(#:priority ,priority)