Skip some unnecessary prioritisation in the basic allocator

1 files changed, 18 insertions, 2 deletions

diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm
index 614bd0f..2fc1a27 100644
--- a/guix-build-coordinator/build-allocator.scm
+++ b/guix-build-coordinator/build-allocator.scm
@@ -161,6 +161,21 @@
               builds)
           builds))
 
+    (define (limit-processed-sublists lists)
+      (if planned-builds-for-agent-limit
+          (let loop ((remaining-lists lists)
+                     (kept-lists '())
+                     (count 0))
+            (if (or (>= count planned-builds-for-agent-limit)
+                    (null? remaining-lists))
+                (reverse kept-lists)
+                (loop (cdr remaining-lists)
+                      (cons (first remaining-lists)
+                            kept-lists)
+                      (+ count
+                         (length (first remaining-lists))))))
+          lists))
+
     (define (break-builds-in-to-priority-sublists all-builds)
       (define (build-priority build)
         (hash-ref derived-build-priorities-hash
@@ -353,8 +368,9 @@
                     (let ((final-ordered-builds
                            (concatenate
                             (map sort-priority-sublist
-                                 (break-builds-in-to-priority-sublists
-                                  builds-sorted-by-derived-priority)))))
+                                 (limit-processed-sublists
+                                  (break-builds-in-to-priority-sublists
+                                   builds-sorted-by-derived-priority))))))
                       (let ((builds-for-agent
                              (limit-planned-builds final-ordered-builds)))
                         (map (lambda (build-id ordering)