diff options
| author | Christopher Baines <mail@cbaines.net> | 2020-04-29 18:04:23 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2020-04-29 18:04:23 +0100 |
| commit | 7df20c0a9491a17926172e9cdbfcd3dd0c8d24eb (patch) | |
| tree | 23c0218938df746d383937022b9575bbce0ec179 | |
| parent | 8d31cffe95db6c21f3510b93cac3e53e2cd0601c (diff) | |
| download | build-coordinator-7df20c0a9491a17926172e9cdbfcd3dd0c8d24eb.tar build-coordinator-7df20c0a9491a17926172e9cdbfcd3dd0c8d24eb.tar.gz | |
Memoize output-has-successful-build?
This is called for the same outputs multiple times, so memoize the result.
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 24 |
1 files changed, 13 insertions, 11 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index 985263c..729ce3f 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -20,6 +20,7 @@ (define-module (guix-build-coordinator build-allocator) #:use-module (srfi srfi-1) + #:use-module (guix memoization) #:use-module (guix-build-coordinator datastore) #:use-module (guix-build-coordinator coordinator) #:export (basic-build-allocation-strategy)) @@ -41,18 +42,19 @@ (datastore-fetch-setup-failures datastore))) (define (filter-builds-for-agent agent-id) - (define (output-has-successful-build? output) - (log "considering missing input:" output) - (any (lambda (output-build) - (let ((build-successful? - (string=? (or (assq-ref output-build 'result) - "unknown") - "success"))) - (when build-successful? - (log "found successful build:" (assq-ref output-build 'uuid))) + (define output-has-successful-build? + (mlambda (output) + (log "considering missing input:" output) + (any (lambda (output-build) + (let ((build-successful? + (string=? (or (assq-ref output-build 'result) + "unknown") + "success"))) + (when build-successful? + (log "found successful build:" (assq-ref output-build 'uuid))) - build-successful?)) - (datastore-list-builds-for-output datastore output))) + build-successful?)) + (datastore-list-builds-for-output datastore output)))) (define (relevant-setup-failure? setup-failure) (log "setup failure:" setup-failure) |