diff options
author | Efraim Flashner <efraim@flashner.co.il> | 2021-10-31 12:47:14 +0200 |
---|---|---|
committer | Efraim Flashner <efraim@flashner.co.il> | 2021-10-31 14:49:47 +0200 |
commit | bc5155b952ae8bdbc56aded4d8d39768b4e2a7d4 (patch) | |
tree | 6b55475d86c522543384dea7d1ab66bba32af63e /guix/store.scm | |
parent | dac8d013bd1fc7f57b8ba3582eef6e0e01b23dfd (diff) | |
parent | 4e5000114ec01b5e92a87c52f2a10f9ba7a601c8 (diff) | |
download | guix-patches-bc5155b952ae8bdbc56aded4d8d39768b4e2a7d4.tar guix-patches-bc5155b952ae8bdbc56aded4d8d39768b4e2a7d4.tar.gz |
Merge remote-tracking branch 'origin/master' into core-updates-frozen
Diffstat (limited to 'guix/store.scm')
-rw-r--r-- | guix/store.scm | 18 |
1 files changed, 12 insertions, 6 deletions
diff --git a/guix/store.scm b/guix/store.scm index 89a719bcfc..7388953d15 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1349,11 +1349,14 @@ on the build output of a previous derivation." (things unresolved-things) (continuation unresolved-continuation)) -(define (build-accumulator continue store things mode) - "This build handler accumulates THINGS and returns an <unresolved> object." - (if (= mode (build-mode normal)) - (unresolved things continue) - (continue #t))) +(define (build-accumulator expected-store) + "Return a build handler that accumulates THINGS and returns an <unresolved> +object, only for build requests on EXPECTED-STORE." + (lambda (continue store things mode) + (if (and (eq? store expected-store) + (= mode (build-mode normal))) + (unresolved things continue) + (continue #t)))) (define* (map/accumulate-builds store proc lst #:key (cutoff 30)) @@ -1366,13 +1369,16 @@ CUTOFF is the threshold above which we stop accumulating unresolved nodes." ;; stumbling upon the same .drv build requests with many incoming edges. ;; See <https://bugs.gnu.org/49439>. + (define accumulator + (build-accumulator store)) + (define-values (result rest) (let loop ((lst lst) (result '()) (unresolved 0)) (match lst ((head . tail) - (match (with-build-handler build-accumulator + (match (with-build-handler accumulator (proc head)) ((? unresolved? obj) (if (>= unresolved cutoff) |