Merge branch 'master' into core-updates

2 files changed, 18 insertions, 53 deletions

diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 9a113b4eb..86b95b407 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -193,33 +193,17 @@ of \"guile\"."
     (map (lambda (spec)
            (match (string-tokenize spec not-equal)
              ((old new)
-              (cons old (specification->package new)))
+              (cons (specification->package old)
+                    (specification->package new)))
              (_
               (leave (_ "invalid replacement specification: ~s~%") spec))))
          replacement-specs))
 
-  (define (rewrite input)
-    (match input
-      ((label (? package? package) outputs ...)
-       (match (assoc-ref replacements (package-name package))
-         (#f  (cons* label (replace package) outputs))
-         (new (cons* label new outputs))))
-      (_
-       input)))
-
-  (define replace
-    (memoize                                      ;XXX: use eq?
-     (lambda (p)
-       (package
-         (inherit p)
-         (inputs (map rewrite (package-inputs p)))
-         (native-inputs (map rewrite (package-native-inputs p)))
-         (propagated-inputs (map rewrite (package-propagated-inputs p)))))))
-
-  (lambda (store obj)
-    (if (package? obj)
-        (replace obj)
-        obj)))
+  (let ((rewrite (package-input-rewriting replacements)))
+    (lambda (store obj)
+      (if (package? obj)
+          (rewrite obj)
+          obj))))
 
 (define %transformations
   ;; Transformations that can be applied to things to build.  The car is the
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index a9fe7d597..953c6243e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -276,36 +276,17 @@ on service '~a':~%")
   "Call MPROC, a monadic procedure in %STORE-MONAD, passing it the list of
 names of services to load (upgrade), and the list of names of services to
 unload."
-  (define (essential? service)
-    (memq service '(root shepherd)))
-
-  (define new-service-names
-    (map (compose first shepherd-service-provision)
-         new-services))
-
-  (let-values (((running stopped) (current-services)))
-    (if (and running stopped)
-        (let* ((to-load
-                ;; Only load services that are either new or currently stopped.
-                (remove (lambda (service)
-                          (memq (first (shepherd-service-provision service))
-                                running))
-                        new-services))
-               (to-unload
-                ;; Unload services that are (1) no longer required, or (2) are
-                ;; in TO-LOAD.
-                (remove essential?
-                        (append (remove (lambda (service)
-                                          (memq service new-service-names))
-                                        (append running stopped))
-                                (filter (lambda (service)
-                                          (memq service stopped))
-                                        (map shepherd-service-canonical-name
-                                             to-load))))))
-          (mproc to-load to-unload))
-        (with-monad %store-monad
-          (warning (_ "failed to obtain list of shepherd services~%"))
-          (return #f)))))
+  (match (current-services)
+    ((services ...)
+     (let-values (((to-unload to-load)
+                   (shepherd-service-upgrade services new-services)))
+       (mproc to-load
+              (map (compose first live-service-provision)
+                   to-unload))))
+    (#f
+     (with-monad %store-monad
+       (warning (_ "failed to obtain list of shepherd services~%"))
+       (return #f)))))
 
 (define (upgrade-shepherd-services os)
   "Upgrade the Shepherd (PID 1) by unloading obsolete services and loading new