[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/11: profiles: Use 'mapm/accumulate-builds'.
From: |
guix-commits |
Subject: |
04/11: profiles: Use 'mapm/accumulate-builds'. |
Date: |
Sun, 29 Mar 2020 09:37:07 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit 25af35fa32bf6c991510406a330d4a42bd5beba8
Author: Ludovic Courtès <address@hidden>
AuthorDate: Wed Mar 25 12:45:12 2020 +0100
profiles: Use 'mapm/accumulate-builds'.
* guix/profiles.scm (check-for-collisions): Use 'mapm/accumulate-builds'
to lower manifest entries. Call 'foldm' over the already-lowered entries.
(profile-derivation): Use 'mapm/accumulate-builds' instead of 'mapm'
when calling HOOKS.
---
guix/profiles.scm | 59 +++++++++++++++++++++++++++++++------------------------
1 file changed, 33 insertions(+), 26 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 3a64989..ad9878f 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès
<address@hidden>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès
<address@hidden>
;;; Copyright © 2013 Nikita Karetnikov <address@hidden>
;;; Copyright © 2014, 2016 Alex Kost <address@hidden>
;;; Copyright © 2015 Mark H Weaver <address@hidden>
@@ -280,29 +280,37 @@ file name."
(define lookup
(manifest-entry-lookup manifest))
- (with-monad %store-monad
+ (define candidates
+ (filter-map (lambda (entry)
+ (let ((other (lookup (manifest-entry-name entry)
+ (manifest-entry-output entry))))
+ (and other (list entry other))))
+ (manifest-transitive-entries manifest)))
+
+ (define lower-pair
+ (match-lambda
+ ((first second)
+ (mlet %store-monad ((first (lower-manifest-entry first system
+ #:target target))
+ (second (lower-manifest-entry second system
+ #:target target)))
+ (return (list first second))))))
+
+ ;; Start by lowering CANDIDATES "in parallel".
+ (mlet %store-monad ((lst (mapm/accumulate-builds lower-pair candidates)))
(foldm %store-monad
- (lambda (entry result)
- (match (lookup (manifest-entry-name entry)
- (manifest-entry-output entry))
- ((? manifest-entry? second) ;potential conflict
- (mlet %store-monad ((first (lower-manifest-entry entry system
- #:target
- target))
- (second (lower-manifest-entry second system
- #:target
- target)))
- (if (string=? (manifest-entry-item first)
- (manifest-entry-item second))
- (return result)
- (raise (condition
- (&profile-collision-error
- (entry first)
- (conflict second)))))))
- (#f ;no conflict
- (return result))))
+ (lambda (entries result)
+ (match entries
+ ((first second)
+ (if (string=? (manifest-entry-item first)
+ (manifest-entry-item second))
+ (return result)
+ (raise (condition
+ (&profile-collision-error
+ (entry first)
+ (conflict second))))))))
#t
- (manifest-transitive-entries manifest))))
+ lst)))
(define* (package->manifest-entry package #:optional (output "out")
#:key (parent (delay #f))
@@ -1521,10 +1529,9 @@ are cross-built for TARGET."
#:target target)))
(extras (if (null? (manifest-entries manifest))
(return '())
- (mapm %store-monad
- (lambda (hook)
- (hook manifest))
- hooks))))
+ (mapm/accumulate-builds (lambda (hook)
+ (hook manifest))
+ hooks))))
(define inputs
(append (filter-map (lambda (drv)
(and (derivation? drv)
- branch master updated (3b1886c -> 033df23), guix-commits, 2020/03/29
- 01/11: store: Add 'map/accumulate-builds'., guix-commits, 2020/03/29
- 02/11: guix build: Use 'map/accumulate-builds'., guix-commits, 2020/03/29
- 03/11: gexp: 'lower-inputs' uses 'mapm/accumulate-builds'., guix-commits, 2020/03/29
- 04/11: profiles: Use 'mapm/accumulate-builds'.,
guix-commits <=
- 06/11: grafts: Don't rely on substitute info for missing store items., guix-commits, 2020/03/29
- 05/11: store: Add 'references/cached'., guix-commits, 2020/03/29
- 11/11: packages: Change 'guile-for-grafts' back to 2.0., guix-commits, 2020/03/29
- 09/11: gnu: Add guile3.0-websocket., guix-commits, 2020/03/29
- 08/11: services: shepherd: Mark '.go' derivations as non-substitutable., guix-commits, 2020/03/29
- 10/11: gnu: guile3.0-websocket: Install .go files in the right place., guix-commits, 2020/03/29
- 07/11: '--dry-run' no longer implies '--no-grafts'., guix-commits, 2020/03/29