Merge branch 'master' into core-updates

 Conflicts:
	gnu/packages/admin.scm
	gnu/packages/commencement.scm
	gnu/packages/guile.scm
	gnu/packages/linux.scm
	gnu/packages/package-management.scm
	gnu/packages/pulseaudio.scm
	gnu/packages/web.scm

15 files changed, 197 insertions, 125 deletions

diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm
index d6613edb33..f59567febb 100644
--- a/guix/build-system/gnu.scm
+++ b/guix/build-system/gnu.scm
@@ -151,8 +151,8 @@ so that they use INPUTS (a thunk) instead of implicit inputs."
         p))
 
   (define (cut? p)
-    (and (eq? (package-build-system p) gnu-build-system)
-         (memq #:implicit-inputs? (package-arguments p))))
+    (or (not (eq? (package-build-system p) gnu-build-system))
+        (memq #:implicit-inputs? (package-arguments p))))
 
   (package-mapping add-explicit-inputs cut?))
 
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 99390bcafc..1f1993a89f 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -683,22 +683,22 @@ When TARGET is true, use it as the cross-compilation target triplet."
     (and (string? obj) (store-path? obj)))
 
   (with-monad %store-monad
-    (mapm %store-monad
-          (match-lambda
-            (((? struct? thing) sub-drv ...)
-             (mlet %store-monad ((obj (lower-object
-                                       thing system #:target target)))
-               (return (match obj
-                         ((? derivation? drv)
-                          (let ((outputs (if (null? sub-drv)
-                                             '("out")
-                                             sub-drv)))
-                            (derivation-input drv outputs)))
-                         ((? store-item? item)
-                          item)))))
-            (((? store-item? item))
-             (return item)))
-          inputs)))
+    (mapm/accumulate-builds
+     (match-lambda
+       (((? struct? thing) sub-drv ...)
+        (mlet %store-monad ((obj (lower-object
+                                  thing system #:target target)))
+          (return (match obj
+                    ((? derivation? drv)
+                     (let ((outputs (if (null? sub-drv)
+                                        '("out")
+                                        sub-drv)))
+                       (derivation-input drv outputs)))
+                    ((? store-item? item)
+                     item)))))
+       (((? store-item? item))
+        (return item)))
+     inputs)))
 
 (define* (lower-reference-graphs graphs #:key system target)
   "Given GRAPHS, a list of (FILE-NAME INPUT ...) lists for use as a
diff --git a/guix/grafts.scm b/guix/grafts.scm
index adc7bfafae..5173a77e58 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -166,22 +166,14 @@ references.  Call REFERENCES to get the list of references."
 (define (references-oracle store input)
   "Return a one-argument procedure that, when passed the output file names of
 INPUT, a derivation input, or their dependencies, returns the list of
-references of that item.  Use either local info or substitute info; build
-INPUT if no information is available."
+references of that item.  Build INPUT if it's not available."
   (define (references* items)
+    ;; Return the references of ITEMS.
     (guard (c ((store-protocol-error? c)
-               ;; As a last resort, build DRV and query the references of the
-               ;; build result.
-
-               ;; Warm up the narinfo cache, otherwise each derivation build
-               ;; will result in one HTTP request to get one narinfo, which is
-               ;; much less efficient than fetching them all upfront.
-               (substitution-oracle store
-                                    (list (derivation-input-derivation input)))
-
+               ;; ITEMS are not in store so build INPUT first.
                (and (build-derivations store (list input))
-                    (map (cut references store <>) items))))
-      (references/substitutes store items)))
+                    (map (cut references/cached store <>) items))))
+      (map (cut references/cached store <>) items)))
 
   (let loop ((items (derivation-input-output-paths input))
              (result vlist-null))
diff --git a/guix/packages.scm b/guix/packages.scm
index ef96b5692f..567240f54e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -444,9 +444,9 @@ derivations."
   (let ((distro (resolve-interface '(gnu packages commencement))))
     (module-ref distro 'guile-final)))
 
-(define (guile-2.0)
-  "Return Guile 2.0."
-  ;; FIXME: This is used as a workaround for <https://bugs.gnu.org/28211> when
+(define (guile-for-grafts)
+  "Return the Guile package used to build grafting derivations."
+  ;; Guile 2.2 would not work due to <https://bugs.gnu.org/28211> when
   ;; grafting packages.
   (let ((distro (resolve-interface '(gnu packages guile))))
     (module-ref distro 'guile-2.0)))
@@ -1031,39 +1031,39 @@ information in exceptions."
                        #:key (graft? (%graft?)))
   "Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
 and return it."
-  (cached (=> %bag-cache)
-          package (list system target graft?)
-          ;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked
-          ;; field values can refer to it.
-          (parameterize ((%current-system system)
-                         (%current-target-system target))
-            (match (if graft?
-                       (or (package-replacement package) package)
-                       package)
-              ((and self
-                    ($ <package> name version source build-system
-                                 args inputs propagated-inputs native-inputs
-                                 outputs))
-               ;; Even though we prefer to use "@" to separate the package
-               ;; name from the package version in various user-facing parts
-               ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
-               ;; prohibits the use of "@", so use "-" instead.
-               (or (make-bag build-system (string-append name "-" version)
-                             #:system system
-                             #:target target
-                             #:source source
-                             #:inputs (append (inputs self)
-                                              (propagated-inputs self))
-                             #:outputs outputs
-                             #:native-inputs (native-inputs self)
-                             #:arguments (args self))
-                   (raise (if target
-                              (condition
-                               (&package-cross-build-system-error
-                                (package package)))
-                              (condition
-                               (&package-error
-                                (package package)))))))))))
+  (let ((package (or (and graft? (package-replacement package))
+                     package)))
+    (cached (=> %bag-cache)
+            package (list system target)
+            ;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked
+            ;; field values can refer to it.
+            (parameterize ((%current-system system)
+                           (%current-target-system target))
+              (match package
+                ((and self
+                      ($ <package> name version source build-system
+                                   args inputs propagated-inputs native-inputs
+                                   outputs))
+                 ;; Even though we prefer to use "@" to separate the package
+                 ;; name from the package version in various user-facing parts
+                 ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
+                 ;; prohibits the use of "@", so use "-" instead.
+                 (or (make-bag build-system (string-append name "-" version)
+                               #:system system
+                               #:target target
+                               #:source source
+                               #:inputs (append (inputs self)
+                                                (propagated-inputs self))
+                               #:outputs outputs
+                               #:native-inputs (native-inputs self)
+                               #:arguments (args self))
+                     (raise (if target
+                                (condition
+                                 (&package-cross-build-system-error
+                                  (package package)))
+                                (condition
+                                 (&package-error
+                                  (package package))))))))))))
 
 (define %graft-cache
   ;; 'eq?' cache mapping package objects to a graft corresponding to their
@@ -1271,7 +1271,7 @@ This is an internal procedure."
                   (()
                    drv)
                   (grafts
-                   (let ((guile (package-derivation store (guile-2.0)
+                   (let ((guile (package-derivation store (guile-for-grafts)
                                                     system #:graft? #f)))
                      ;; TODO: As an optimization, we can simply graft the tip
                      ;; of the derivation graph since 'graft-derivation'
@@ -1297,7 +1297,7 @@ system identifying string)."
                    (graft-derivation store drv grafts
                                      #:system system
                                      #:guile
-                                     (package-derivation store (guile-2.0)
+                                     (package-derivation store (guile-for-grafts)
                                                          system #:graft? #f))))
                 drv))))
 
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 2a838d3a9a..9150886081 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-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))
@@ -1523,10 +1531,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)
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index 80f3b704d7..41a2a42c21 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -183,7 +183,7 @@ Export/import one or more packages from/to the store.\n"))
                                  (alist-delete 'verbosity result)))))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+                   (alist-cons 'dry-run? #t result)))
 
          %standard-build-options))
 
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index af18d8b6f9..79bd84a1a0 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -778,7 +778,7 @@ must be one of 'package', 'all', or 'transitive'~%")
                    (alist-cons 'manifest arg result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+                   (alist-cons 'dry-run? #t result)))
          (option '(#\r "root") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'gc-root arg result)))
@@ -920,8 +920,10 @@ build."
   (with-unbound-variable-handling
    (parameterize ((%graft? graft?))
      (append-map (lambda (system)
-                   (append-map (cut compute-derivation <> system)
-                               things-to-build))
+                   (concatenate
+                    (map/accumulate-builds store
+                                           (cut compute-derivation <> system)
+                                           things-to-build)))
                  systems))))
 
 (define (show-build-log store file urls)
diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm
index 2fa31ecf45..f6f64d0a11 100644
--- a/guix/scripts/copy.scm
+++ b/guix/scripts/copy.scm
@@ -135,7 +135,7 @@ Copy ITEMS to or from the specified host over SSH.\n"))
                                  (alist-delete 'verbosity result)))))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+                   (alist-cons 'dry-run? #t result)))
 
          (option '(#\h "help") #f #f
                  (lambda args
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index f70d41f35c..4466a0c632 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -30,6 +30,7 @@
   #:use-module (guix status)
   #:use-module (ice-9 format)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
@@ -102,7 +103,7 @@ Perform the deployment specified by FILE.\n"))
   "Show the list of machines to deploy, MACHINES."
   (let ((count (length machines)))
     (format (current-error-port)
-            (N_ "The following ~*machine will be deployed:~%"
+            (N_ "The following ~d machine will be deployed:~%"
                 "The following ~d machines will be deployed:~%"
                 count)
             count)
@@ -114,6 +115,27 @@ Perform the deployment specified by FILE.\n"))
              (current-error-port))
     (display "\n\n" (current-error-port))))
 
+(define (deploy-machine* store machine)
+  "Deploy MACHINE, taking care of error handling."
+  (info (G_ "deploying to ~a...~%")
+        (machine-display-name machine))
+
+  (guard (c ((message-condition? c)
+             (report-error (G_ "failed to deploy ~a: ~a~%")
+                           (machine-display-name machine)
+                           (condition-message c)))
+            ((deploy-error? c)
+             (when (deploy-error-should-roll-back c)
+               (info (G_ "rolling back ~a...~%")
+                     (machine-display-name machine))
+               (run-with-store store (roll-back-machine machine)))
+             (apply throw (deploy-error-captured-args c))))
+    (run-with-store store (deploy-machine machine))
+
+    (info (G_ "successfully deployed ~a~%")
+          (machine-display-name machine))))
+
+
 (define (guix-deploy . args)
   (define (handle-argument arg result)
     (alist-cons 'file arg result))
@@ -129,21 +151,7 @@ Perform the deployment specified by FILE.\n"))
         (set-build-options-from-command-line store opts)
         (with-build-handler (build-notifier #:use-substitutes?
                                             (assoc-ref opts 'substitutes?))
-          (for-each (lambda (machine)
-                      (info (G_ "deploying to ~a...~%")
-                            (machine-display-name machine))
-                      (parameterize ((%graft? (assq-ref opts 'graft?)))
-                        (guard (c ((message-condition? c)
-                                   (report-error (G_ "failed to deploy ~a: ~a~%")
-                                                 (machine-display-name machine)
-                                                 (condition-message c)))
-                                  ((deploy-error? c)
-                                   (when (deploy-error-should-roll-back c)
-                                     (info (G_ "rolling back ~a...~%")
-                                           (machine-display-name machine))
-                                     (run-with-store store (roll-back-machine machine)))
-                                   (apply throw (deploy-error-captured-args c))))
-                          (run-with-store store (deploy-machine machine))
-                          (info (G_ "successfully deployed ~a~%")
-                                (machine-display-name machine)))))
-                    machines))))))
+          (parameterize ((%graft? (assq-ref opts 'graft?)))
+            (map/accumulate-builds store
+                                   (cut deploy-machine* store <>)
+                                   machines)))))))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index e6f45d3eba..03f455ab7b 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -254,7 +254,7 @@ use '--preserve' instead~%"))
                    (alist-cons 'ad-hoc? #t result)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+                   (alist-cons 'dry-run? #t result)))
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 9d981c05d6..a4b38735a7 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -823,7 +823,7 @@ last resort for relocation."
 
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+                   (alist-cons 'dry-run? #t result)))
          (option '(#\d "derivation") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'derivation-only? #t result)))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 8af0a7a27e..304084796a 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -487,8 +487,7 @@ kind of search path~%")
                            #f)))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result arg-handler)
-                   (values (alist-cons 'dry-run? #t
-                                       (alist-cons 'graft? #f result))
+                   (values (alist-cons 'dry-run? #t result)
                            #f)))
          (option '(#\v "verbosity") #t #f
                  (lambda (opt name arg result arg-handler)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index dbd02431fe..dfe7ee7ad5 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -168,7 +168,7 @@ Download and deploy the latest version of Guix.\n"))
                                (alist-delete 'system result eq?))))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+                   (alist-cons 'dry-run? #t result)))
          (option '(#\v "verbosity") #t #f
                  (lambda (opt name arg result)
                    (let ((level (string->number* arg)))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 61a3c95dbd..a178761203 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1041,7 +1041,7 @@ Some ACTIONS support additional ARGS.\n"))
 
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
-                   (alist-cons 'dry-run? #t (alist-cons 'graft? #f result))))
+                   (alist-cons 'dry-run? #t result)))
          (option '(#\v "verbosity") #t #f
                  (lambda (opt name arg result)
                    (let ((level (string->number* arg)))
diff --git a/guix/store.scm b/guix/store.scm
index 5dea264811..12f66d0e71 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -106,6 +106,8 @@
             file-mapping->tree
             binary-file
             with-build-handler
+            map/accumulate-builds
+            mapm/accumulate-builds
             build-things
             build
             query-failed-paths
@@ -134,6 +136,7 @@
 
             built-in-builders
             references
+            references/cached
             references/substitutes
             references*
             query-path-info*
@@ -1303,6 +1306,48 @@ deals with \"dynamic dependencies\" such as grafts---derivations that depend
 on the build output of a previous derivation."
   (call-with-build-handler handler (lambda () exp ...)))
 
+;; Unresolved dynamic dependency.
+(define-record-type <unresolved>
+  (unresolved things continuation)
+  unresolved?
+  (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 (map/accumulate-builds store proc lst)
+  "Apply PROC over each element of LST, accumulating 'build-things' calls and
+coalescing them into a single call."
+  (define result
+    (map (lambda (obj)
+           (with-build-handler build-accumulator
+             (proc obj)))
+         lst))
+
+  (match (append-map (lambda (obj)
+                       (if (unresolved? obj)
+                           (unresolved-things obj)
+                           '()))
+                     result)
+    (()
+     result)
+    (to-build
+     ;; We've accumulated things TO-BUILD.  Actually build them and resume the
+     ;; corresponding continuations.
+     (build-things store (delete-duplicates to-build))
+     (map/accumulate-builds store
+                            (lambda (obj)
+                              (if (unresolved? obj)
+                                  ;; Pass #f because 'build-things' is now
+                                  ;; unnecessary.
+                                  ((unresolved-continuation obj) #f)
+                                  obj))
+                            result))))
+
 (define build-things
   (let ((build (operation (build-things (string-list things)
                                         (integer mode))
@@ -1389,6 +1434,13 @@ error if there is no such root."
   ;; would use a cache associated with the daemon connection instead (XXX).
   (make-hash-table 100))
 
+(define (references/cached store item)
+  "Like 'references', but cache results."
+  (or (hash-ref %reference-cache item)
+      (let ((references (references store item)))
+        (hash-set! %reference-cache item references)
+        references)))
+
 (define (references/substitutes store items)
   "Return the list of list of references of ITEMS; the result has the same
 length as ITEMS.  Query substitute information for any item missing from the
@@ -1829,6 +1881,18 @@ taking the store as its first argument."
                           (lambda (store . args)
                             (run-with-store store (apply proc args)))))
 
+(define (mapm/accumulate-builds mproc lst)
+  "Like 'mapm' in %STORE-MONAD, but accumulate 'build-things' calls and
+coalesce them into a single call."
+  (lambda (store)
+    (values (map/accumulate-builds store
+                                   (lambda (obj)
+                                     (run-with-store store
+                                       (mproc obj)))
+                                   lst)
+            store)))
+
+
 ;;
 ;; Store monad operators.
 ;;