[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/06: profiles: Use 'mapm/accumulate-builds'.
From: |
guix-commits |
Subject: |
04/06: profiles: Use 'mapm/accumulate-builds'. |
Date: |
Wed, 25 Mar 2020 11:22:58 -0400 (EDT) |
civodul pushed a commit to branch wip-build-accumulator
in repository guix.
commit 3bd295546f2b18e35fd7c250b9552795062b218a
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 | 57 +++++++++++++++++++++++++++++++------------------------
1 file changed, 32 insertions(+), 25 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 20a2973..7a3961e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -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-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 wip-build-accumulator created (now 5992933), guix-commits, 2020/03/25
- 01/06: DRAFT store: Add 'map/accumulate-builds'., guix-commits, 2020/03/25
- 02/06: guix build: Use 'map/accumulate-builds'., guix-commits, 2020/03/25
- 03/06: DRAFT gexp: 'lower-inputs' uses 'mapm/accumulate-builds'., guix-commits, 2020/03/25
- 04/06: profiles: Use 'mapm/accumulate-builds'.,
guix-commits <=
- 05/06: grafts: Don't rely on substitute info for missing store items., guix-commits, 2020/03/25
- 06/06: '--dry-run' no longer implies '--no-grafts'., guix-commits, 2020/03/25