diff options
Diffstat (limited to 'guix-build-coordinator/build-allocator.scm')
| -rw-r--r-- | guix-build-coordinator/build-allocator.scm | 68 |
1 files changed, 41 insertions, 27 deletions
diff --git a/guix-build-coordinator/build-allocator.scm b/guix-build-coordinator/build-allocator.scm index e1cb160..dbf09d0 100644 --- a/guix-build-coordinator/build-allocator.scm +++ b/guix-build-coordinator/build-allocator.scm @@ -83,6 +83,8 @@ ;; used as the key, the build_ids given as the value should happen ;; first. (build-ordering-hints-hash + (make-hash-table)) + (builds-ready-to-go-hash (make-hash-table))) (define systems-for-builds @@ -196,34 +198,43 @@ (define deferred-builds-last-count 0) - (let loop ((result '()) - (builds builds-list) - (builds-to-defer '())) - (if (null? builds) - (if (null? builds-to-defer) - result - (if (= (length builds-to-defer) - deferred-builds-last-count) - ;; There can be loops in the graph of missing inputs, so - ;; give up if the ordering doesn't seem to end - (append result builds-to-defer) - (begin (set! deferred-builds-last-count - (length builds-to-defer)) - (loop result - builds-to-defer - '())))) - (let ((build (car builds))) - (if (every (lambda (required-build-id) - (hash-ref seen-builds-hash required-build-id)) - (builds-that-should-happen-first (build-id build))) - (begin - (hash-set! seen-builds-hash (build-id build) #t) - (loop (cons build result) + (define (push-deferred-builds-to-the-back builds-list) + (let loop ((result '()) + (builds builds-list) + (builds-to-defer '())) + (if (null? builds) + (if (null? builds-to-defer) + result + (if (= (length builds-to-defer) + deferred-builds-last-count) + ;; There can be loops in the graph of missing inputs, so + ;; give up if the ordering doesn't seem to end + (append result builds-to-defer) + (begin (set! deferred-builds-last-count + (length builds-to-defer)) + (loop result + builds-to-defer + '())))) + (let ((build (car builds))) + (if (every (lambda (required-build-id) + (hash-ref seen-builds-hash required-build-id)) + (builds-that-should-happen-first (build-id build))) + (begin + (hash-set! seen-builds-hash (build-id build) #t) + (loop (cons build result) + (cdr builds) + builds-to-defer)) + (loop result (cdr builds) - builds-to-defer)) - (loop result - (cdr builds) - (cons build builds-to-defer))))))) + (cons build builds-to-defer))))))) + + (let-values (((ready-builds other-builds) + (partition (lambda (build) + (hash-ref builds-ready-to-go-hash + (assq-ref build 'uuid))) + builds-list))) + (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 @@ -298,6 +309,9 @@ (assq-ref setup-failure 'id))))) (when (every (lambda (x) (eq? x #t)) outputs-should-be-available) + (hash-set! builds-ready-to-go-hash + setup-failure-build-id + #t) ;; At least one build for each missing input has been ;; successful, so delete the setup failure from the list of ;; setup failures in the hash |