17 files changed, 410 insertions, 183 deletions
diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm
index 17173f121e..ffed837313 100644
--- a/guix/build-system/python.scm
+++ b/guix/build-system/python.scm
@@ -83,54 +83,43 @@ pre-defined variants of this transformation recorded in the 'properties' field
 of packages.  The property value must be the promise of a package.  This is a
 convenient way for package writers to force the transformation to use
 pre-defined variants."
-  (define transform
-    ;; Memoize the transformations.  Failing to do that, we would build a huge
-    ;; object graph with lots of duplicates, which in turns prevents us from
-    ;; benefiting from memoization in 'package-derivation'.
-    (mlambdaq (p)
-      (let* ((rewrite-if-package
-              (lambda (content)
-                ;; CONTENT may be a file name, in which case it is returned,
-                ;; or a package, which is rewritten with the new PYTHON and
-                ;; NEW-PREFIX.
-                (if (package? content)
-                    (transform content)
-                    content)))
-             (rewrite
-              (match-lambda
-                ((name content . rest)
-                 (append (list name (rewrite-if-package content)) rest)))))
-
-        (cond
-         ;; If VARIANT-PROPERTY is present, use that.
-         ((and variant-property
-               (assoc-ref (package-properties p) variant-property))
-          => force)
-
-         ;; Otherwise build the new package object graph.
-         ((eq? (package-build-system p) python-build-system)
-          (package
-            (inherit p)
-            (location (package-location p))
-            (name (let ((name (package-name p)))
-                    (string-append new-prefix
-                                   (if (string-prefix? old-prefix name)
-                                       (substring name
-                                                  (string-length old-prefix))
-                                       name))))
-            (arguments
-             (let ((python (if (promise? python)
-                               (force python)
-                               python)))
-               (ensure-keyword-arguments (package-arguments p)
-                                         `(#:python ,python))))
-            (inputs (map rewrite (package-inputs p)))
-            (propagated-inputs (map rewrite (package-propagated-inputs p)))
-            (native-inputs (map rewrite (package-native-inputs p)))))
-         (else
-          p)))))
-
-  transform)
+  (define package-variant
+    (if variant-property
+        (lambda (package)
+          (assq-ref (package-properties package)
+                    variant-property))
+        (const #f)))
+
+  (define (transform p)
+    (cond
+     ;; If VARIANT-PROPERTY is present, use that.
+     ((package-variant p)
+      => force)
+
+     ;; Otherwise build the new package object graph.
+     ((eq? (package-build-system p) python-build-system)
+      (package
+        (inherit p)
+        (location (package-location p))
+        (name (let ((name (package-name p)))
+                (string-append new-prefix
+                               (if (string-prefix? old-prefix name)
+                                   (substring name
+                                              (string-length old-prefix))
+                                   name))))
+        (arguments
+         (let ((python (if (promise? python)
+                           (force python)
+                           python)))
+           (ensure-keyword-arguments (package-arguments p)
+                                     `(#:python ,python))))))
+     (else p)))
+
+  (define (cut? p)
+    (or (not (eq? (package-build-system p) python-build-system))
+        (package-variant p)))
+
+  (package-mapping transform cut?))
 
 (define package-with-python2
   ;; Note: delay call to 'default-python2' until after the 'arguments' field
diff --git a/guix/build/cargo-build-system.scm b/guix/build/cargo-build-system.scm
index f11d858749..139b40321f 100644
--- a/guix/build/cargo-build-system.scm
+++ b/guix/build/cargo-build-system.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -116,12 +117,12 @@ directory = '" port)
       (close-pipe port)
       result)))
 
-;; Example dir-name: "/gnu/store/hwlr49riz3la33m6in2n898ly045ylld-rust-rand-0.3.15".
 (define (generate-checksums dir-name src-name)
-  "Given DIR-NAME, checksum all the files in it one by one and put the
-   result into the file \".cargo-checksum.json\" in the same directory.
-   Also includes the checksum of an extra file SRC-NAME as if it was
-   part of the directory DIR-NAME with name \"package\"."
+  "Given DIR-NAME, a store directory, checksum all the files in it one
+by one and put the result into the file \".cargo-checksum.json\" in
+the same directory.  Also includes the checksum of an extra file
+SRC-NAME as if it was part of the directory DIR-NAME with name
+\"package\"."
   (let* ((file-names (find-files dir-name "."))
          (dir-prefix-name (string-append dir-name "/"))
          (dir-prefix-name-len (string-length dir-prefix-name))
diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 42eabfaf19..5c96fe9067 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -75,14 +75,14 @@ definitions for all the SEARCH-PATHS."
       ;;   source ~/.guix-profile/etc/profile ~/.guix-profile
       ;;
       ;; However, when 'source' is used with no arguments, $1 refers to the
-      ;; first positional parameter of the calling scripts, so we can rely on
-      ;; it.
+      ;; first positional parameter of the calling script, so we cannot rely
+      ;; on it.
       (display "\
 # Source this file to define all the relevant environment variables in Bash
 # for this profile.  You may want to define the 'GUIX_PROFILE' environment
 # variable to point to the \"visible\" name of the profile, like this:
 #
-#  GUIX_PROFILE=/path/to/profile
+#  GUIX_PROFILE=/path/to/profile \\
 #  source /path/to/profile/etc/profile
 #
 # When GUIX_PROFILE is undefined, the various environment variables refer
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 5aae1530f4..0529c228a5 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
 ;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -44,8 +45,6 @@
             MNT_EXPIRE
             UMOUNT_NOFOLLOW
             restart-on-EINTR
-            mount
-            umount
             mount-points
             swapon
             swapoff
@@ -83,17 +82,11 @@
 
             PF_PACKET
             AF_PACKET
-            IFF_UP
-            IFF_BROADCAST
-            IFF_LOOPBACK
             all-network-interface-names
             network-interface-names
-            network-interface-flags
             network-interface-netmask
             loopback-network-interface?
             network-interface-address
-            set-network-interface-flags
-            set-network-interface-address
             set-network-interface-netmask
             set-network-interface-up
             configure-network-interface
@@ -149,8 +142,19 @@
 ;;; Commentary:
 ;;;
 ;;; This module provides bindings to libc's syscall wrappers.  It uses the
-;;; FFI, and thus requires a dynamically-linked Guile.  (For statically-linked
-;;; Guile, we instead apply 'guile-linux-syscalls.patch'.)
+;;; FFI, and thus requires a dynamically-linked Guile.
+;;;
+;;; Some syscalls are already defined in statically-linked Guile by applying
+;;; 'guile-linux-syscalls.patch'.
+;;;
+;;; Visibility of syscall's symbols shared between this module and static Guile
+;;; is a bit delicate. It is handled by 'define-as-needed' macro.
+;;;
+;;; This macro is used to export symbols in dynamic Guile context, and to
+;;; re-export them in static Guile context.
+;;;
+;;; This way, even if they don't appear in #:export list, it is safe to use
+;;; syscalls from this module in static or dynamic Guile context.
 ;;;
 ;;; Code:
 
@@ -409,6 +413,25 @@ the returned procedure is called."
         (error (format #f "~a: syscall->procedure failed: ~s"
                        name args))))))
 
+(define-syntax define-as-needed
+  (syntax-rules ()
+    "Define VARIABLE.  If VARIABLE already exists in (guile) then re-export it,
+  otherwise export the newly-defined VARIABLE."
+    ((_ (proc args ...) body ...)
+     (define-as-needed proc (lambda* (args ...) body ...)))
+    ((_ variable value)
+     (begin
+       (when (module-defined? the-scm-module 'variable)
+         (re-export variable))
+
+       (define variable
+         (if (module-defined? the-scm-module 'variable)
+             (module-ref the-scm-module 'variable)
+             value))
+
+       (unless (module-defined? the-scm-module 'variable)
+         (export variable))))))
+
 
 ;;;
 ;;; File systems.
@@ -461,48 +484,50 @@ the returned procedure is called."
 (define MNT_EXPIRE      4)
 (define UMOUNT_NOFOLLOW 8)
 
-(define mount
+(define-as-needed (mount source target type
+                         #:optional (flags 0) options
+                         #:key (update-mtab? #f))
+  "Mount device SOURCE on TARGET as a file system TYPE.
+Optionally, FLAGS may be a bitwise-or of the MS_* <sys/mount.h>
+constants, and OPTIONS may be a string.  When FLAGS contains
+MS_REMOUNT, SOURCE and TYPE are ignored.  When UPDATE-MTAB? is true,
+update /etc/mtab.  Raise a 'system-error' exception on error."
+  ;; XXX: '#:update-mtab?' is not implemented by core 'mount'.
   (let ((proc (syscall->procedure int "mount" `(* * * ,unsigned-long *))))
-    (lambda* (source target type #:optional (flags 0) options
-                     #:key (update-mtab? #f))
-      "Mount device SOURCE on TARGET as a file system TYPE.  Optionally, FLAGS
-may be a bitwise-or of the MS_* <sys/mount.h> constants, and OPTIONS may be a
-string.  When FLAGS contains MS_REMOUNT, SOURCE and TYPE are ignored.  When
-UPDATE-MTAB? is true, update /etc/mtab.  Raise a 'system-error' exception on
-error."
-      (let-values (((ret err)
-                    (proc (if source
-                              (string->pointer source)
-                              %null-pointer)
-                          (string->pointer target)
-                          (if type
-                              (string->pointer type)
-                              %null-pointer)
-                          flags
-                          (if options
-                              (string->pointer options)
-                              %null-pointer))))
-        (unless (zero? ret)
-          (throw 'system-error "mount" "mount ~S on ~S: ~A"
-                 (list source target (strerror err))
-                 (list err)))
-        (when update-mtab?
-          (augment-mtab source target type options))))))
-
-(define umount
-  (let ((proc (syscall->procedure int "umount2" `(* ,int))))
-    (lambda* (target #:optional (flags 0)
-                     #:key (update-mtab? #f))
-      "Unmount TARGET.  Optionally FLAGS may be one of the MNT_* or UMOUNT_*
+    (let-values (((ret err)
+                  (proc (if source
+                            (string->pointer source)
+                            %null-pointer)
+                        (string->pointer target)
+                        (if type
+                            (string->pointer type)
+                            %null-pointer)
+                        flags
+                        (if options
+                            (string->pointer options)
+                            %null-pointer))))
+      (unless (zero? ret)
+        (throw 'system-error "mount" "mount ~S on ~S: ~A"
+               (list source target (strerror err))
+               (list err)))
+      (when update-mtab?
+        (augment-mtab source target type options)))))
+
+(define-as-needed (umount target
+                          #:optional (flags 0)
+                          #:key (update-mtab? #f))
+  "Unmount TARGET.  Optionally FLAGS may be one of the MNT_* or UMOUNT_*
 constants from <sys/mount.h>."
-      (let-values (((ret err)
-                    (proc (string->pointer target) flags)))
-        (unless (zero? ret)
-          (throw 'system-error "umount" "~S: ~A"
-                 (list target (strerror err))
-                 (list err)))
-        (when update-mtab?
-          (remove-from-mtab target))))))
+  ;; XXX: '#:update-mtab?' is not implemented by core 'umount'.
+  (let ((proc (syscall->procedure int "umount2" `(* ,int))))
+    (let-values (((ret err)
+                  (proc (string->pointer target) flags)))
+      (unless (zero? ret)
+        (throw 'system-error "umount" "~S: ~A"
+               (list target (strerror err))
+               (list err)))
+      (when update-mtab?
+        (remove-from-mtab target)))))
 
 (define (mount-points)
   "Return the mounts points for currently mounted file systems."
@@ -537,6 +562,34 @@ constants from <sys/mount.h>."
                  (list device (strerror err))
                  (list err)))))))
 
+(define-as-needed RB_AUTOBOOT    #x01234567)
+(define-as-needed RB_HALT_SYSTEM #xcdef0123)
+(define-as-needed RB_ENABLED_CAD #x89abcdef)
+(define-as-needed RB_DISABLE_CAD 0)
+(define-as-needed RB_POWER_OFF   #x4321fedc)
+(define-as-needed RB_SW_SUSPEND  #xd000fce2)
+(define-as-needed RB_KEXEC       #x45584543)
+
+(define-as-needed (reboot #:optional (cmd RB_AUTOBOOT))
+  (let ((proc (syscall->procedure int "reboot" (list int))))
+    (let-values (((ret err) (proc cmd)))
+      (unless (zero? ret)
+        (throw 'system-error "reboot" "~S: ~A"
+               (list cmd (strerror err))
+               (list err))))))
+
+(define-as-needed (load-linux-module data #:optional (options ""))
+  (let ((proc (syscall->procedure int "init_module"
+                                  (list '* unsigned-long '*))))
+    (let-values (((ret err)
+                  (proc (bytevector->pointer data)
+                        (bytevector-length data)
+                        (string->pointer options))))
+      (unless (zero? ret)
+        (throw 'system-error "load-linux-module" "~A"
+               (list (strerror err))
+               (list err))))))
+
 (define (kernel? pid)
   "Return #t if PID designates a \"kernel thread\" rather than a normal
 user-land process."
@@ -873,9 +926,9 @@ exception if it's already taken."
 
 ;; Flags and constants from <net/if.h>.
 
-(define IFF_UP #x1)                               ;Interface is up
-(define IFF_BROADCAST #x2)                        ;Broadcast address valid.
-(define IFF_LOOPBACK #x8)                         ;Is a loopback net.
+(define-as-needed IFF_UP #x1)                     ;Interface is up
+(define-as-needed IFF_BROADCAST #x2)              ;Broadcast address valid.
+(define-as-needed IFF_LOOPBACK #x8)               ;Is a loopback net.
 
 (define IF_NAMESIZE 16)                           ;maximum interface name size
 
@@ -1022,7 +1075,7 @@ that are not up."
                 (else
                  (loop interfaces))))))))
 
-(define (network-interface-flags socket name)
+(define-as-needed (network-interface-flags socket name)
   "Return a number that is the bit-wise or of 'IFF*' flags for network
 interface NAME."
   (let ((req (make-bytevector ifreq-struct-size)))
@@ -1033,8 +1086,8 @@ interface NAME."
                           (bytevector->pointer req))))
       (if (zero? ret)
 
-          ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the beginning of
-          ;; 'struct ifreq', and it's a short int.
+          ;; The 'ifr_flags' field is IF_NAMESIZE bytes after the
+          ;; beginning of 'struct ifreq', and it's a short int.
           (bytevector-sint-ref req IF_NAMESIZE (native-endianness)
                                (sizeof short))
 
@@ -1050,7 +1103,7 @@ interface NAME."
     (close-port sock)
     (not (zero? (logand flags IFF_LOOPBACK)))))
 
-(define (set-network-interface-flags socket name flags)
+(define-as-needed (set-network-interface-flags socket name flags)
   "Set the flag of network interface NAME to FLAGS."
   (let ((req (make-bytevector ifreq-struct-size)))
     (bytevector-copy! (string->utf8 name) 0 req 0
@@ -1067,7 +1120,7 @@ interface NAME."
                (list name (strerror err))
                (list err))))))
 
-(define (set-network-interface-address socket name sockaddr)
+(define-as-needed (set-network-interface-address socket name sockaddr)
   "Set the address of network interface NAME to SOCKADDR."
   (let ((req (make-bytevector ifreq-struct-size)))
     (bytevector-copy! (string->utf8 name) 0 req 0
diff --git a/guix/download.scm b/guix/download.scm
index 3f9263d757..181bf45813 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -66,7 +66,7 @@
        "ftp://gcc.gnu.org/pub/gcc/"
        ,@(map (cut string-append <> "/gcc") gnu-mirrors))
       (gnupg
-       "ftp://gd.tuwien.ac.at/privacy/gnupg/"
+       "http://gd.tuwien.ac.at/privacy/gnupg/"
        "ftp://mirrors.dotsrc.org/gcrypt/"
        "ftp://mirror.cict.fr/gnupg/"
        "http://artfiles.org/gnupg.org"
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 1b8e43e994..80d8f735b3 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -26,6 +26,8 @@
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
   #:use-module (ice-9 match)
   #:export (gexp
             gexp?
@@ -84,7 +86,13 @@
             gexp-compiler?
             lower-object
 
-            lower-inputs))
+            lower-inputs
+
+            &gexp-error
+            gexp-error?
+            &gexp-input-error
+            gexp-input-error?
+            gexp-error-invalid-input))
 
 ;;; Commentary:
 ;;;
@@ -140,6 +148,14 @@
   (lower      gexp-compiler-lower)
   (expand     gexp-compiler-expand))              ;#f | DRV -> sexp
 
+(define-condition-type &gexp-error &error
+  gexp-error?)
+
+(define-condition-type &gexp-input-error &gexp-error
+  gexp-input-error?
+  (input gexp-error-invalid-input))
+
+
 (define %gexp-compilers
   ;; 'eq?' mapping of record type descriptor to <gexp-compiler>.
   (make-hash-table 20))
@@ -177,8 +193,11 @@ procedure to expand it; otherwise return #f."
 corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true.
 OBJ must be an object that has an associated gexp compiler, such as a
 <package>."
-  (let ((lower (lookup-compiler obj)))
-    (lower obj system target)))
+  (match (lookup-compiler obj)
+    (#f
+     (raise (condition (&gexp-input-error (input obj)))))
+    (lower
+     (lower obj system target))))
 
 (define-syntax define-gexp-compiler
   (syntax-rules (=> compiler expander)
diff --git a/guix/import/cran.scm b/guix/import/cran.scm
index a5f91fe8d2..4d36882cf5 100644
--- a/guix/import/cran.scm
+++ b/guix/import/cran.scm
@@ -424,13 +424,30 @@ dependencies."
 
 (define (bioconductor-package? package)
   "Return true if PACKAGE is an R package from Bioconductor."
-  (and (string-prefix? "r-" (package-name package))
-       (match (and=> (package-source package) origin-uri)
-         ((? string? uri)
-          (string-prefix? "http://bioconductor.org" uri))
-         ((? list? uris)
-          (any (cut string-prefix? "http://bioconductor.org" <>) uris))
-         (_ #f))))
+  (let ((predicate (lambda (uri)
+                     (and (string-prefix? "http://bioconductor.org" uri)
+                          ;; Data packages are not listed in SVN
+                          (not (string-contains uri "/data/annotation/"))))))
+    (and (string-prefix? "r-" (package-name package))
+         (match (and=> (package-source package) origin-uri)
+           ((? string? uri)
+            (predicate uri))
+           ((? list? uris)
+            (any predicate uris))
+           (_ #f)))))
+
+(define (bioconductor-data-package? package)
+  "Return true if PACKAGE is an R data package from Bioconductor."
+  (let ((predicate (lambda (uri)
+                     (and (string-prefix? "http://bioconductor.org" uri)
+                          (string-contains uri "/data/annotation/")))))
+    (and (string-prefix? "r-" (package-name package))
+         (match (and=> (package-source package) origin-uri)
+           ((? string? uri)
+            (predicate uri))
+           ((? list? uris)
+            (any predicate uris))
+           (_ #f)))))
 
 (define %cran-updater
   (upstream-updater
diff --git a/guix/monads.scm b/guix/monads.scm
index 0b0ad239de..317f85d079 100644
--- a/guix/monads.scm
+++ b/guix/monads.scm
@@ -185,8 +185,9 @@ form is (VAR -> VAL), bind VAR to the non-monadic value VAL in the same way as
 
 (define-syntax mbegin
   (syntax-rules (%current-monad)
-    "Bind the given monadic expressions in sequence, returning the result of
-the last one."
+    "Bind MEXP and the following monadic expressions in sequence, returning
+the result of the last expression.  Every expression in the sequence must be a
+monadic expression."
     ((_ %current-monad mexp)
      mexp)
     ((_ %current-monad mexp rest ...)
@@ -204,23 +205,27 @@ the last one."
 
 (define-syntax mwhen
   (syntax-rules ()
-    "When CONDITION is true, evaluate EXP0..EXP* as in an 'mbegin'.  When
-CONDITION is false, return *unspecified* in the current monad."
-    ((_ condition exp0 exp* ...)
+    "When CONDITION is true, evaluate the sequence of monadic expressions
+MEXP0..MEXP* as in an 'mbegin'.  When CONDITION is false, return *unspecified*
+in the current monad.  Every expression in the sequence must be a monadic
+expression."
+    ((_ condition mexp0 mexp* ...)
      (if condition
          (mbegin %current-monad
-           exp0 exp* ...)
+           mexp0 mexp* ...)
          (return *unspecified*)))))
 
 (define-syntax munless
   (syntax-rules ()
-    "When CONDITION is false, evaluate EXP0..EXP* as in an 'mbegin'.  When
-CONDITION is true, return *unspecified* in the current monad."
-    ((_ condition exp0 exp* ...)
+    "When CONDITION is false, evaluate the sequence of monadic expressions
+MEXP0..MEXP* as in an 'mbegin'.  When CONDITION is true, return *unspecified*
+in the current monad.  Every expression in the sequence must be a monadic
+expression."
+    ((_ condition mexp0 mexp* ...)
      (if condition
          (return *unspecified*)
          (mbegin %current-monad
-           exp0 exp* ...)))))
+           mexp0 mexp* ...)))))
 
 (define-syntax define-lift
   (syntax-rules ()
diff --git a/guix/packages.scm b/guix/packages.scm
index 61171b8342..44f2c32fb7 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -31,7 +31,6 @@
   #:use-module (guix memoization)
   #:use-module (guix build-system)
   #:use-module (guix search-paths)
-  #:use-module (guix gexp)
   #:use-module (guix sets)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -99,6 +98,7 @@
             package-transitive-propagated-inputs
             package-transitive-native-search-paths
             package-transitive-supported-systems
+            package-mapping
             package-input-rewriting
             package-source-derivation
             package-derivation
@@ -742,36 +742,53 @@ dependencies are known to build on SYSTEM."
   "Return the \"target inputs\" of BAG, recursively."
   (transitive-inputs (bag-target-inputs bag)))
 
-(define* (package-input-rewriting replacements
-                                  #:optional (rewrite-name identity))
-  "Return a procedure that, when passed a package, replaces its direct and
-indirect dependencies (but not its implicit inputs) according to REPLACEMENTS.
-REPLACEMENTS is a list of package pairs; the first element of each pair is the
-package to replace, and the second one is the replacement.
-
-Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
-package and returns its new name after rewrite."
+(define* (package-mapping proc #:optional (cut? (const #f)))
+  "Return a procedure that, given a package, applies PROC to all the packages
+depended on and returns the resulting package.  The procedure stops recursion
+when CUT? returns true for a given package."
   (define (rewrite input)
     (match input
       ((label (? package? package) outputs ...)
-       (match (assq-ref replacements package)
-         (#f  (cons* label (replace package) outputs))
-         (new (cons* label new outputs))))
+       (let ((proc (if (cut? package) proc replace)))
+         (cons* label (proc package) outputs)))
       (_
        input)))
 
   (define replace
     (mlambdaq (p)
-      ;; Return a variant of P with its inputs rewritten.
-      (package
-        (inherit p)
-        (name (rewrite-name (package-name p)))
-        (inputs (map rewrite (package-inputs p)))
-        (native-inputs (map rewrite (package-native-inputs p)))
-        (propagated-inputs (map rewrite (package-propagated-inputs p))))))
+      ;; Return a variant of P with PROC applied to P and its explicit
+      ;; dependencies, recursively.  Memoize the transformations.  Failing to
+      ;; do that, we would build a huge object graph with lots of duplicates,
+      ;; which in turns prevents us from benefiting from memoization in
+      ;; 'package-derivation'.
+      (let ((p (proc p)))
+        (package
+          (inherit p)
+          (location (package-location p))
+          (inputs (map rewrite (package-inputs p)))
+          (native-inputs (map rewrite (package-native-inputs p)))
+          (propagated-inputs (map rewrite (package-propagated-inputs p)))))))
 
   replace)
 
+(define* (package-input-rewriting replacements
+                                  #:optional (rewrite-name identity))
+  "Return a procedure that, when passed a package, replaces its direct and
+indirect dependencies (but not its implicit inputs) according to REPLACEMENTS.
+REPLACEMENTS is a list of package pairs; the first element of each pair is the
+package to replace, and the second one is the replacement.
+
+Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
+package and returns its new name after rewrite."
+  (define (rewrite p)
+    (match (assq-ref replacements p)
+      (#f  (package
+             (inherit p)
+             (name (rewrite-name (package-name p)))))
+      (new new)))
+
+  (package-mapping rewrite (cut assq <> replacements)))
+
 
 ;;;
 ;;; Package derivations.
@@ -846,7 +863,16 @@ information in exceptions."
      ;; source.
      (list name (intern file)))
     (((? string? name) (? struct? source))
-     (list name (package-source-derivation store source system)))
+     ;; 'package-source-derivation' calls 'lower-object', which can throw
+     ;; '&gexp-input-error'.  However '&gexp-input-error' lacks source
+     ;; location info, so we catch and rethrow here (XXX: not optimal
+     ;; performance-wise).
+     (guard (c ((gexp-input-error? c)
+                (raise (condition
+                        (&package-input-error
+                         (package package)
+                         (input   (gexp-error-invalid-input c)))))))
+       (list name (package-source-derivation store source system))))
     (x
      (raise (condition (&package-input-error
                         (package package)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 795c9447fe..eb172ef450 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
+;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -946,10 +947,88 @@ files for the fonts of the @var{manifest} entries."
                     #:local-build? #t
                     #:substitutable? #f))
 
+(define (manual-database manifest)
+  "Return a derivation that builds the manual page database (\"mandb\") for
+the entries in MANIFEST."
+  (define man-db                                  ;lazy reference
+    (module-ref (resolve-interface '(gnu packages man)) 'man-db))
+
+  (define build
+    #~(begin
+        (use-modules (guix build utils)
+                     (srfi srfi-1)
+                     (srfi srfi-26))
+
+        (define entries
+          (filter-map (lambda (directory)
+                        (let ((man (string-append directory "/share/man")))
+                          (and (directory-exists? man)
+                               man)))
+                      '#$(manifest-inputs manifest)))
+
+        (define manpages-collection-dir
+          (string-append (getenv "PWD") "/manpages-collection"))
+
+        (define man-directory
+          (string-append #$output "/share/man"))
+
+        (define (get-manpage-tail-path manpage-path)
+          (let ((index (string-contains manpage-path "/share/man/")))
+            (unless index
+              (error "Manual path doesn't contain \"/share/man/\":"
+                     manpage-path))
+            (string-drop manpage-path (+ index (string-length "/share/man/")))))
+
+        (define (populate-manpages-collection-dir entries)
+          (let ((manpages (append-map (cut find-files <> #:stat stat) entries)))
+            (for-each (lambda (manpage)
+                        (let* ((dest-file (string-append
+                                           manpages-collection-dir "/"
+                                           (get-manpage-tail-path manpage))))
+                          (mkdir-p (dirname dest-file))
+                          (catch 'system-error
+                            (lambda ()
+                              (symlink manpage dest-file))
+                            (lambda args
+                              ;; Different packages may contain the same
+                              ;; manpage.  Simply ignore the symlink error.
+                              #t))))
+                      manpages)))
+
+        (mkdir-p manpages-collection-dir)
+        (populate-manpages-collection-dir entries)
+
+        ;; Create a mandb config file which contains a custom made
+        ;; manpath. The associated catpath is the location where the database
+        ;; gets generated.
+        (copy-file #+(file-append man-db "/etc/man_db.conf")
+                   "man_db.conf")
+        (substitute* "man_db.conf"
+          (("MANDB_MAP	/usr/man		/var/cache/man/fsstnd")
+           (string-append "MANDB_MAP " manpages-collection-dir " "
+                          man-directory)))
+
+        (mkdir-p man-directory)
+        (setenv "MANPATH" (string-join entries ":"))
+
+        (format #t "creating manual page database for ~a packages...~%"
+                (length entries))
+        (force-output)
+
+        (zero? (system* #+(file-append man-db "/bin/mandb")
+                        "--quiet" "--create"
+                        "-C" "man_db.conf"))))
+
+  (gexp->derivation "manual-database" build
+                    #:modules '((guix build utils)
+                                (srfi srfi-26))
+                    #:local-build? #t))
+
 (define %default-profile-hooks
   ;; This is the list of derivation-returning procedures that are called by
   ;; default when making a non-empty profile.
   (list info-dir-file
+        manual-database
         fonts-dir-file
         ghc-package-cache-file
         ca-certificate-bundle
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 68402fda18..6bb1f72eb9 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -51,7 +51,9 @@
             options->transformation
             show-transformation-options-help
 
-            guix-build))
+            guix-build
+            register-root
+            register-root*))
 
 (define %default-log-urls
   ;; Default base URLs for build logs.
@@ -122,6 +124,9 @@ found.  Return #f if no build log was found."
         (leave (_ "failed to create GC root `~a': ~a~%")
                root (strerror (system-error-errno args)))))))
 
+(define register-root*
+  (store-lift register-root))
+
 (define (package-with-source store p uri)
   "Return a package based on P but with its source taken from URI.  Extract
 the new package's version number from URI."
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 44f490043c..5a6abd00fb 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -79,7 +79,9 @@ existing enviroment variables with additional search paths."
                (let ((current (getenv variable)))
                  (setenv variable
                          (if (and current (not pure?))
-                             (string-append value separator current)
+                             (if separator
+                                 (string-append value separator current)
+                                 value)
                              value)))))
             (evaluate-profile-search-paths profile paths))
 
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 9e91bc22ac..165e4ccf2a 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -280,6 +280,9 @@ the image."
          (option '(#\f "format") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'format (string->symbol arg) result)))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
          (option '(#\s "system") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
@@ -323,6 +326,8 @@ Create a bundle of PACKAGE.\n"))
   (display (_ "
   -f, --format=FORMAT    build a pack in the given FORMAT"))
   (display (_ "
+  -e, --expression=EXPR  consider the package EXPR evaluates to"))
+  (display (_ "
   -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
   (display (_ "
       --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
@@ -349,20 +354,22 @@ Create a bundle of PACKAGE.\n"))
   (define opts
     (parse-command-line args %options (list %default-options)))
 
+  (define maybe-package-argument
+    ;; Given an option pair, return a package, a package/output tuple, or #f.
+    (match-lambda
+      (('argument . spec)
+       (call-with-values
+           (lambda ()
+             (specification->package+output spec))
+         list))
+      (('expression . exp)
+       (read/eval-package-expression exp))
+      (x #f)))
+
   (with-error-handling
     (parameterize ((%graft? (assoc-ref opts 'graft?)))
-      (let* ((dry-run? (assoc-ref opts 'dry-run?))
-             (specs    (filter-map (match-lambda
-                                     (('argument . name)
-                                      name)
-                                     (x #f))
-                                   opts))
-             (packages (map (lambda (spec)
-                              (call-with-values
-                                  (lambda ()
-                                    (specification->package+output spec))
-                                list))
-                            specs))
+      (let* ((dry-run?    (assoc-ref opts 'dry-run?))
+             (packages    (filter-map maybe-package-argument opts))
              (pack-format (assoc-ref opts 'format))
              (name        (string-append (symbol->string pack-format)
                                          "-pack"))
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index ea259f3758..f612dae700 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -91,7 +91,8 @@ if ITEM is not in the store."
                          (* 100. (/ self whole 1.)))))
               (sort profile
                     (match-lambda*
-                      ((($ <profile> _ _ total1) ($ <profile> _ _ total2))
+                      ((($ <profile> name1 self1 total1)
+                        ($ <profile> name2 self2 total2))
                        (> total1 total2)))))
     (format port (_ "total: ~,1f MiB~%") (/ whole MiB 1.))))
 
@@ -200,7 +201,8 @@ the name of a PNG file."
            0
            (sort profiles
                  (match-lambda*
-                   ((($ <profile> _ _ total1) ($ <profile> _ _ total2))
+                   ((($ <profile> name1 self1 total1)
+                     ($ <profile> name2 self2 total2))
                     (> total1 total2))))))
 
   ;; TRANSLATORS: This is the title of a graph, meaning that the graph
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 144a7fd377..b0a794bf8e 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2016, 2017 Chris Marusich <cmmarusich@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -593,7 +593,8 @@ PATTERN, a string.  When PATTERN is #f, display all the system generations."
                          #:key grub? dry-run? derivations-only?
                          use-substitutes? device target
                          image-size full-boot?
-                         (mappings '()))
+                         (mappings '())
+                         (gc-root #f))
   "Perform ACTION for OS.  GRUB? specifies whether to install GRUB; DEVICE is
 the target devices for GRUB; TARGET is the target root directory; IMAGE-SIZE
 is the size of the image to be built, for the 'vm-image' and 'disk-image'
@@ -601,7 +602,10 @@ actions.  FULL-BOOT? is used for the 'vm' action; it determines whether to
 boot directly to the kernel or to the bootloader.
 
 When DERIVATIONS-ONLY? is true, print the derivation file name(s) without
-building anything."
+building anything.
+
+When GC-ROOT is a path, also make that path an indirect root of the build
+output when building a system derivation, such as a disk image."
   (define println
     (cut format #t "~a~%" <>))
 
@@ -665,8 +669,13 @@ building anything."
                       #:grub.cfg (derivation->output-path grub.cfg)
                       #:device device))
             (else
-             ;; All we had to do was to build SYS.
-             (return (derivation->output-path sys))))))))
+             ;; All we had to do was to build SYS and maybe register an
+             ;; indirect GC root.
+             (let ((output (derivation->output-path sys)))
+               (mbegin %store-monad
+                 (mwhen gc-root
+                   (register-root* (list output) gc-root))
+                 (return output)))))))))
 
 (define (export-extension-graph os port)
   "Export the service extension graph of OS to PORT."
@@ -741,6 +750,10 @@ Some ACTIONS support additional ARGS.\n"))
   (display (_ "
       --share=SPEC       for 'vm', share host file system according to SPEC"))
   (display (_ "
+  -r, --root=FILE        for 'vm', 'vm-image', 'disk-image', 'container',
+                         and 'build', make FILE a symlink to the result, and
+                         register it as a garbage collector root"))
+  (display (_ "
       --expose=SPEC      for 'vm', expose host file system according to SPEC"))
   (display (_ "
       --full-boot        for 'vm', make a full boot sequence"))
@@ -797,6 +810,9 @@ Some ACTIONS support additional ARGS.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'system arg
                                (alist-delete 'system result eq?))))
+         (option '(#\r "root") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'gc-root arg result)))
          %standard-build-options))
 
 (define %default-options
@@ -863,7 +879,8 @@ resulting from command-line parsing."
                                                       (_ #f))
                                                     opts)
                              #:grub? grub?
-                             #:target target #:device device))))
+                             #:target target #:device device
+                             #:gc-root (assoc-ref opts 'gc-root)))))
         #:system system))))
 
 (define (process-command command args opts)
diff --git a/guix/ui.scm b/guix/ui.scm
index 345bf490b2..b3c94795fe 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -26,6 +26,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix ui)
+  #:use-module (guix gexp)
   #:use-module (guix utils)
   #:use-module (guix store)
   #:use-module (guix config)
@@ -448,6 +449,10 @@ interpreted."
                       (location->string loc)
                       (package-full-name package)
                       (build-system-name system))))
+            ((gexp-input-error? c)
+             (let ((input (package-error-invalid-input c)))
+               (leave (_ "~s: invalid G-expression input~%")
+                      (gexp-error-invalid-input c))))
             ((profile-not-found-error? c)
              (leave (_ "profile '~a' does not exist~%")
                     (profile-error-profile c)))
diff --git a/guix/utils.scm b/guix/utils.scm
index fb962df8ba..3fefa49607 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -155,7 +155,7 @@ a symbol such as 'xz."
   (match compression
     ((or #f 'none) (values input '()))
     ('bzip2        (filtered-port `(,%bzip2 "-dc") input))
-    ('xz           (filtered-port `(,%xz "-dc -T0") input))
+    ('xz           (filtered-port `(,%xz "-dc" "-T0") input))
     ('gzip         (filtered-port `(,%gzip "-dc") input))
     (else          (error "unsupported compression scheme" compression))))
 
@@ -165,7 +165,7 @@ a symbol such as 'xz."
   (match compression
     ((or #f 'none) (values input '()))
     ('bzip2        (filtered-port `(,%bzip2 "-c") input))
-    ('xz           (filtered-port `(,%xz "-c -T0") input))
+    ('xz           (filtered-port `(,%xz "-c" "-T0") input))
     ('gzip         (filtered-port `(,%gzip "-c") input))
     (else          (error "unsupported compression scheme" compression))))
 
@@ -222,7 +222,7 @@ program--e.g., '(\"--fast\")."
   (match compression
     ((or #f 'none) (values output '()))
     ('bzip2        (filtered-output-port `(,%bzip2 "-c" ,@options) output))
-    ('xz           (filtered-output-port `(,%xz "-c -T0" ,@options) output))
+    ('xz           (filtered-output-port `(,%xz "-c" "-T0" ,@options) output))
     ('gzip         (filtered-output-port `(,%gzip "-c" ,@options) output))
     (else          (error "unsupported compression scheme" compression))))