From b68b90bc392eed3387b07d22eb3f7a5c7125db8d Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Tue, 26 Jan 2021 20:37:49 +0000
Subject: Try to simplify part of the basic allocator

As there has been exceptions in this area, the required build priority is #f.
---
 guix-build-coordinator/build-allocator.scm | 59 +++++++++++++++++-------------
 1 file changed, 33 insertions(+), 26 deletions(-)

(limited to 'guix-build-coordinator/build-allocator.scm')

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 917a567..6007708 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -307,25 +307,25 @@
         (append ready-builds
                 (push-deferred-builds-to-the-back other-builds))))
 
-    (define (treat-build-as-required build-id required-build-id priority)
-      (let ((required-build-derived-priority
-             (hash-ref derived-build-priorities-hash
-                       required-build-id)))
-        ;; Add an entry to the build-ordering-hints-hash to indicate that
-        ;; required-build-id should happen prior to build-id
-        (hash-set!
-         build-ordering-hints-hash
-         build-id
-         (cons required-build-id
-               (hash-ref build-ordering-hints-hash
-                         build-id
-                         '())))
-
-        (when (> priority required-build-derived-priority)
-          ;; Bump the priority of the build
-          (hash-set! derived-build-priorities-hash
-                     required-build-id
-                     priority))))
+    (define (treat-build-as-required build-id
+                                     priority
+                                     required-build-id
+                                     required-build-derived-priority)
+      ;; Add an entry to the build-ordering-hints-hash to indicate that
+      ;; required-build-id should happen prior to build-id
+      (hash-set!
+       build-ordering-hints-hash
+       build-id
+       (cons required-build-id
+             (hash-ref build-ordering-hints-hash
+                       build-id
+                       '())))
+
+      (when (> priority required-build-derived-priority)
+        ;; Bump the priority of the build
+        (hash-set! derived-build-priorities-hash
+                   required-build-id
+                   priority)))
 
     (when metrics-registry
       (metric-set allocator-considered-builds-metric
@@ -363,16 +363,23 @@
                             (begin
                               (for-each
                                (lambda (build)
-                                 (when (and (not (assq-ref build 'processed))
+                                 (let* ((required-build-id
+                                         (assq-ref build 'uuid))
+                                        (required-build-derived-priority
+                                         (hash-ref derived-build-priorities-hash
+                                                   required-build-id)))
+                                   (when
+                                       (and (not (assq-ref build 'processed))
                                             ;; The build might not be included
                                             ;; in this allocation, so skip it
                                             ;; if it isn't
-                                            (hash-ref derived-build-priorities-hash
-                                                      (assq-ref build 'uuid)))
-                                   (treat-build-as-required
-                                    setup-failure-build-id
-                                    (assq-ref build 'uuid)
-                                    setup-failure-build-derived-priority)))
+                                            (number?
+                                             required-build-derived-priority))
+                                     (treat-build-as-required
+                                      setup-failure-build-id
+                                      setup-failure-build-derived-priority
+                                      required-build-id
+                                      required-build-derived-priority))))
                                builds)
                               #f))))
                     (datastore-list-setup-failure-missing-inputs
-- 
cgit v1.2.3