diff options
author | Christopher Baines <mail@cbaines.net> | 2025-02-23 20:30:38 +0000 |
---|---|---|
committer | Christopher Baines <mail@cbaines.net> | 2025-02-23 20:30:38 +0000 |
commit | 4677f141067d9c97bb3e4689af075626f40fe4bd (patch) | |
tree | ad8847cd02ca33635618dcb926ab8b0d204cb1a2 | |
parent | 9d55fe7e17d8a3dd4b0572cb7756c9b33733f084 (diff) | |
download | build-coordinator-4677f141067d9c97bb3e4689af075626f40fe4bd.tar build-coordinator-4677f141067d9c97bb3e4689af075626f40fe4bd.tar.gz |
Memoize the read derivation
-rw-r--r-- | guix-build-coordinator/client-communication.scm | 52 |
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) |