aboutsummaryrefslogtreecommitdiff
path: root/guix-build-coordinator/build-allocator.scm
diff options
context:
space:
mode:
authorChristopher Baines <mail@cbaines.net>2020-05-11 09:15:35 +0100
committerChristopher Baines <mail@cbaines.net>2020-05-11 09:15:35 +0100
commit237ba68a52e7b532b73d5d228d44155ce72d5d45 (patch)
treed5cfc96cf9e1da2f5475086770b80643fff92757 /guix-build-coordinator/build-allocator.scm
parentc604a4c726e6dcc1fc769294c0107f8fbd266804 (diff)
downloadbuild-coordinator-237ba68a52e7b532b73d5d228d44155ce72d5d45.tar
build-coordinator-237ba68a52e7b532b73d5d228d44155ce72d5d45.tar.gz
Speed up the derivation ordered allocator a little bit
Use EXCEPT, rather than NOT IN to make the SQL query faster. Also, just return and use the build id, rather than a alist.
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
-rw-r--r--guix-build-coordinator/build-allocator.scm43
1 files changed, 20 insertions, 23 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 16b00cd..9b0d304 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -303,7 +303,7 @@
(let* ((agents (datastore-list-agents datastore))
(setup-failures-hash
(datastore-fetch-setup-failures datastore))
- (unprocessed-builds-with-built-inputs
+ (build-ids-for-unprocessed-builds-with-built-inputs
(datastore-list-unprocessed-builds-with-built-inputs datastore)))
(define (filter-builds-for-agent agent-id)
@@ -322,10 +322,9 @@
(else
(error "Unknown setup failure " failure-reason)))))
- (lambda (build)
- (log "build:" (assq-ref build 'uuid))
- (let* ((build-id (assq-ref build 'uuid))
- (setup-failures-for-build
+ (lambda (build-id)
+ (log "build:" build-id)
+ (let* ((setup-failures-for-build
(or (hash-ref setup-failures-hash build-id)
'()))
(relevant-setup-failures
@@ -336,12 +335,12 @@
#t
#f))))
- (define (limit-planned-builds builds)
+ (define (limit-planned-builds build-ids)
(if planned-builds-for-agent-limit
- (if (> (length builds) planned-builds-for-agent-limit)
- (take builds planned-builds-for-agent-limit)
- builds)
- builds))
+ (if (> (length build-ids) planned-builds-for-agent-limit)
+ (take build-ids planned-builds-for-agent-limit)
+ build-ids)
+ build-ids))
(let ((derived-build-priorities-hash
(datastore-fetch-unprocessed-builds-with-propagated-priorities
@@ -349,31 +348,29 @@
(define (build-sorting-function-for-agent agent-id)
(lambda (a b)
- (let ((a-priority (hash-ref derived-build-priorities-hash
- (assq-ref a 'uuid)))
- (b-priority (hash-ref derived-build-priorities-hash
- (assq-ref b 'uuid))))
+ (let ((a-priority (hash-ref derived-build-priorities-hash a))
+ (b-priority (hash-ref derived-build-priorities-hash b)))
(< b-priority a-priority))))
(let ((result
(append-map
(lambda (agent-id)
(log "considering builds for" agent-id)
- (let ((builds-sorted-by-derived-priority
- (sort (filter (filter-builds-for-agent agent-id)
- unprocessed-builds-with-built-inputs)
- (build-sorting-function-for-agent agent-id))))
- (if (null? builds-sorted-by-derived-priority)
+ (let ((build-ids-sorted-by-derived-priority
+ (sort
+ (filter (filter-builds-for-agent agent-id)
+ build-ids-for-unprocessed-builds-with-built-inputs)
+ (build-sorting-function-for-agent agent-id))))
+ (if (null? build-ids-sorted-by-derived-priority)
'()
(let ((builds-for-agent
- (limit-planned-builds builds-sorted-by-derived-priority)))
+ (limit-planned-builds
+ build-ids-sorted-by-derived-priority)))
(map (lambda (build-id ordering)
(list build-id
agent-id
ordering))
- (map (lambda (build)
- (assq-ref build 'uuid))
- builds-for-agent)
+ builds-for-agent
(iota (length builds-for-agent)))))))
(map (lambda (agent)
(assq-ref agent 'uuid))