Merge branch 'master' into core-updates

25 files changed, 712 insertions, 218 deletions

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index ec8b64497f..ab0ae57c6e 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -19,6 +19,7 @@
 (define-module (guix build-system asdf)
   #:use-module (guix store)
   #:use-module (guix utils)
+  #:use-module (guix memoization)
   #:use-module (guix packages)
   #:use-module (guix derivations)
   #:use-module (guix search-paths)
@@ -160,70 +161,69 @@ set up using CL source package conventions."
     (eq? from-build-system (package-build-system pkg)))
 
   (define transform
-    (memoize
-     (lambda (pkg)
-       (define rewrite
-         (match-lambda
-           ((name content . rest)
-            (let* ((is-package? (package? content))
-                   (new-content (if is-package? (transform content) content)))
-              `(,name ,new-content ,@rest)))))
-
-       ;; Special considerations for source packages: CL inputs become
-       ;; propagated, and un-handled arguments are removed.
-
-       (define new-propagated-inputs
-         (if target-is-source?
-             (map rewrite
-                  (append
-                   (filter (match-lambda
-                             ((_ input . _)
-                              (has-from-build-system? input)))
-                           (append (package-inputs pkg)
-                                   ;; The native inputs might be needed just
-                                   ;; to load the system.
-                                   (package-native-inputs pkg)))
-                   (package-propagated-inputs pkg)))
-
-             (map rewrite (package-propagated-inputs pkg))))
-
-       (define (new-inputs inputs-getter)
-         (if target-is-source?
-             (map rewrite
+    (mlambda (pkg)
+      (define rewrite
+        (match-lambda
+          ((name content . rest)
+           (let* ((is-package? (package? content))
+                  (new-content (if is-package? (transform content) content)))
+             `(,name ,new-content ,@rest)))))
+
+      ;; Special considerations for source packages: CL inputs become
+      ;; propagated, and un-handled arguments are removed.
+
+      (define new-propagated-inputs
+        (if target-is-source?
+            (map rewrite
+                 (append
                   (filter (match-lambda
                             ((_ input . _)
-                             (not (has-from-build-system? input))))
-                          (inputs-getter pkg)))
-             (map rewrite (inputs-getter pkg))))
-
-       (define base-arguments
-         (if target-is-source?
-             (strip-keyword-arguments
-              '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file)
-              (package-arguments pkg))
-             (package-arguments pkg)))
-
-       (cond
-        ((and variant-property
-              (assoc-ref (package-properties pkg) variant-property))
-         => force)
-
-        ((has-from-build-system? pkg)
-         (package
-           (inherit pkg)
-           (location (package-location pkg))
-           (name (transform-package-name (package-name pkg)))
-           (build-system to-build-system)
-           (arguments
-            (substitute-keyword-arguments base-arguments
-              ((#:phases phases) (list phases-transformer phases))))
-           (inputs (new-inputs package-inputs))
-           (propagated-inputs new-propagated-inputs)
-           (native-inputs (new-inputs package-native-inputs))
-           (outputs (if target-is-source?
-                        '("out")
-                        (package-outputs pkg)))))
-        (else pkg)))))
+                             (has-from-build-system? input)))
+                          (append (package-inputs pkg)
+                                  ;; The native inputs might be needed just
+                                  ;; to load the system.
+                                  (package-native-inputs pkg)))
+                  (package-propagated-inputs pkg)))
+
+            (map rewrite (package-propagated-inputs pkg))))
+
+      (define (new-inputs inputs-getter)
+        (if target-is-source?
+            (map rewrite
+                 (filter (match-lambda
+                           ((_ input . _)
+                            (not (has-from-build-system? input))))
+                         (inputs-getter pkg)))
+            (map rewrite (inputs-getter pkg))))
+
+      (define base-arguments
+        (if target-is-source?
+            (strip-keyword-arguments
+             '(#:tests? #:asd-file #:lisp #:asd-system-name #:test-asd-file)
+             (package-arguments pkg))
+            (package-arguments pkg)))
+
+      (cond
+       ((and variant-property
+             (assoc-ref (package-properties pkg) variant-property))
+        => force)
+
+       ((has-from-build-system? pkg)
+        (package
+          (inherit pkg)
+          (location (package-location pkg))
+          (name (transform-package-name (package-name pkg)))
+          (build-system to-build-system)
+          (arguments
+           (substitute-keyword-arguments base-arguments
+             ((#:phases phases) (list phases-transformer phases))))
+          (inputs (new-inputs package-inputs))
+          (propagated-inputs new-propagated-inputs)
+          (native-inputs (new-inputs package-native-inputs))
+          (outputs (if target-is-source?
+                       '("out")
+                       (package-outputs pkg)))))
+       (else pkg))))
 
   transform)
 
diff --git a/guix/build/ant-build-system.scm b/guix/build/ant-build-system.scm
index a440daf054..6ce813a001 100644
--- a/guix/build/ant-build-system.scm
+++ b/guix/build/ant-build-system.scm
@@ -197,9 +197,12 @@ repack them.  This is necessary to ensure that archives are reproducible."
            ;; first.
            (with-directory-excursion dir
              (let* ((files (find-files "." ".*" #:directories? #t))
+                    ;; To ensure that the reference scanner can detect all
+                    ;; store references in the jars we disable compression
+                    ;; with the "-0" option.
                     (command (if (file-exists? manifest)
-                                 `("zip" "-X" ,jar ,manifest ,@files)
-                                 `("zip" "-X" ,jar ,@files))))
+                                 `("zip" "-0" "-X" ,jar ,manifest ,@files)
+                                 `("zip" "-0" "-X" ,jar ,@files))))
                (unless (zero? (apply system* command))
                  (error "'zip' failed"))))
            (utime jar 0 0)
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 4490d225e6..609a100538 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -308,10 +308,10 @@ host name without trailing dot."
       (register-tls-record-port record port)
 
       ;; Write HTTP requests line by line rather than byte by byte:
-      ;; <https://bugs.gnu.org/22966>.  This is not possible on Guile 2.0.
+      ;; <https://bugs.gnu.org/22966>.  This is possible with Guile >= 2.2.
       (cond-expand
-        (guile-2.0 #f)
-        (else (setvbuf record 'line)))
+        (guile-2.2 (setvbuf record 'line))
+        (else #f))
 
       record)))
 
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 07803ca94f..97f96d99c1 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -90,6 +90,7 @@
             derivation-path->output-paths
             derivation
             raw-derivation
+            invalidate-derivation-caches!
 
             map-derivation
 
@@ -136,7 +137,7 @@
   (env-vars derivation-builder-environment-vars)  ; list of name/value pairs
   (file-name derivation-file-name))               ; the .drv file name
 
-(define-record-type <derivation-output>
+(define-immutable-record-type <derivation-output>
   (make-derivation-output path hash-algo hash recursive?)
   derivation-output?
   (path       derivation-output-path)             ; store path
@@ -144,7 +145,7 @@
   (hash       derivation-output-hash)             ; bytevector | #f
   (recursive? derivation-output-recursive?))      ; Boolean
 
-(define-record-type <derivation-input>
+(define-immutable-record-type <derivation-input>
   (make-derivation-input path sub-derivations)
   derivation-input?
   (path            derivation-input-path)             ; store path
@@ -632,8 +633,26 @@ derivation at FILE."
     (bytevector->base16-string
      (derivation-hash (read-derivation-from-file file)))))
 
+(define (derivation/masked-inputs drv)
+  "Assuming DRV is a regular derivation (not fixed-output), replace the file
+name of each input with that input's hash."
+  (match drv
+    (($ <derivation> outputs inputs sources
+                     system builder args env-vars)
+     (let ((inputs (map (match-lambda
+                          (($ <derivation-input> path sub-drvs)
+                           (let ((hash (derivation-path->base16-hash path)))
+                             (make-derivation-input hash sub-drvs))))
+                        inputs)))
+       (make-derivation outputs
+                        (sort (coalesce-duplicate-inputs inputs)
+                              derivation-input<?)
+                        sources
+                        system builder args env-vars
+                        #f)))))
+
 (define derivation-hash            ; `hashDerivationModulo' in derivations.cc
-  (mlambda (drv)
+  (lambda (drv)
     "Return the hash of DRV, modulo its fixed-output inputs, as a bytevector."
     (match drv
       (($ <derivation> ((_ . ($ <derivation-output> path
@@ -647,27 +666,12 @@ derivation at FILE."
                         (symbol->string hash-algo)
                         ":" (bytevector->base16-string hash)
                         ":" path))))
-      (($ <derivation> outputs inputs sources
-                       system builder args env-vars)
-       ;; A regular derivation: replace the path of each input with that
-       ;; input's hash; return the hash of serialization of the resulting
-       ;; derivation.
-       (let* ((inputs (map (match-lambda
-                             (($ <derivation-input> path sub-drvs)
-                              (let ((hash (derivation-path->base16-hash path)))
-                                (make-derivation-input hash sub-drvs))))
-                           inputs))
-              (drv    (make-derivation outputs
-                                       (sort (coalesce-duplicate-inputs inputs)
-                                             derivation-input<?)
-                                       sources
-                                       system builder args env-vars
-                                       #f)))
-
-         ;; XXX: At this point this remains faster than `port-sha256', because
-         ;; the SHA256 port's `write' method gets called for every single
-         ;; character.
-         (sha256 (derivation->bytevector drv)))))))
+      (_
+
+       ;; XXX: At this point this remains faster than `port-sha256', because
+       ;; the SHA256 port's `write' method gets called for every single
+       ;; character.
+       (sha256 (derivation->bytevector (derivation/masked-inputs drv)))))))
 
 (define* (derivation store name builder args
                      #:key
@@ -838,6 +842,15 @@ output should not be used."
       (hash-set! %derivation-cache file drv*)
       drv*)))
 
+(define (invalidate-derivation-caches!)
+  "Invalidate internal derivation caches.  This is mostly useful for
+long-running processes that know what they're doing.  Use with care!"
+  ;; Typically this is meant to be used by Cuirass and Hydra, which can clear
+  ;; caches when they start evaluating packages for another architecture.
+  (invalidate-memoization! derivation->bytevector)
+  (invalidate-memoization! derivation-path->base16-hash)
+  (hash-clear! %derivation-cache))
+
 (define* (map-derivation store drv mapping
                          #:key (system (%current-system)))
   "Given MAPPING, a list of pairs of derivations, return a derivation based on
diff --git a/guix/gexp.scm b/guix/gexp.scm
index 1929947d95..f005c4d296 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -343,28 +343,34 @@ This is the declarative counterpart of 'text-file'."
      (text-file name content references))))
 
 (define-record-type <computed-file>
-  (%computed-file name gexp options)
+  (%computed-file name gexp guile options)
   computed-file?
   (name       computed-file-name)                 ;string
   (gexp       computed-file-gexp)                 ;gexp
+  (guile      computed-file-guile)                ;<package>
   (options    computed-file-options))             ;list of arguments
 
 (define* (computed-file name gexp
-                        #:key (options '(#:local-build? #t)))
+                        #:key guile (options '(#:local-build? #t)))
   "Return an object representing the store item NAME, a file or directory
 computed by GEXP.  OPTIONS is a list of additional arguments to pass
 to 'gexp->derivation'.
 
 This is the declarative counterpart of 'gexp->derivation'."
-  (%computed-file name gexp options))
+  (%computed-file name gexp guile options))
 
 (define-gexp-compiler (computed-file-compiler (file <computed-file>)
                                               system target)
   ;; Compile FILE by returning a derivation whose build expression is its
   ;; gexp.
   (match file
-    (($ <computed-file> name gexp options)
-     (apply gexp->derivation name gexp options))))
+    (($ <computed-file> name gexp guile options)
+     (if guile
+         (mlet %store-monad ((guile (lower-object guile system
+                                                  #:target target)))
+           (apply gexp->derivation name gexp #:guile-for-build guile
+                  options))
+         (apply gexp->derivation name gexp options)))))
 
 (define-record-type <program-file>
   (%program-file name gexp guile)
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 00e80bc79f..c2a7a33b6a 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -366,6 +366,9 @@ return the corresponding signature URL, or #f it signatures are unavailable."
                                    #f)
                                   (("w32" 'directory . _)
                                    #f)
+                                  (("unstable" 'directory . _)
+                                   ;; As seen at ftp.gnupg.org/gcrypt/pinentry.
+                                   #f)
                                   ((directory 'directory . _)
                                    directory)
                                   (_ #f))
diff --git a/guix/licenses.scm b/guix/licenses.scm
index b07d80076e..269d97c723 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -13,6 +13,7 @@
 ;;; Copyright © 2017 Petter <petter@mykolab.ch>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;; Copyright © 2017 Arun Isaac <arunisaac@systemreboot.net>
+;;; Copyright © 2017 Rutger Helling <rhelling@mykolab.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -91,6 +92,7 @@
             zlib
             fsf-free
             wtfpl2
+            wxwindows3.1+
             fsdg-compatible))
 
 (define-record-type <license>
@@ -581,6 +583,11 @@ at URI, which may be a file:// URI pointing the package's tree."
            "http://www.wtfpl.net"
            "http://www.wtfpl.net/about/"))
 
+(define wxwindows3.1+
+  (license "wxWindows 3.1+"
+           "https://wxwidgets.org/about/licence"
+           "https://www.gnu.org/licenses/license-list.html#Wxwind"))
+
 (define x11
   (license "X11"
            "http://directory.fsf.org/wiki/License:X11"
diff --git a/guix/man-db.scm b/guix/man-db.scm
new file mode 100644
index 0000000000..5d62e0c82d
--- /dev/null
+++ b/guix/man-db.scm
@@ -0,0 +1,200 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix man-db)
+  #:use-module (guix zlib)
+  #:use-module ((guix build utils) #:select (find-files))
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-26)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:export (mandb-entry?
+            mandb-entry-file-name
+            mandb-entry-name
+            mandb-entry-section
+            mandb-entry-synopsis
+            mandb-entry-kind
+
+            mandb-entries
+            write-mandb-database))
+
+;;; Comment:
+;;;
+;;; Scan gzipped man pages and create a man-db database.  The database is
+;;; meant to be used by 'man -k KEYWORD'.
+;;;
+;;; The implementation here aims to be simpler than that of 'man-db', and to
+;;; produce deterministic output.  See <https://bugs.gnu.org/29654>.
+;;;
+;;; Code:
+
+;; Load 'gdbm-ffi' at run time to simplify the job of 'imported-modules' & co.
+(module-autoload! (current-module) '(gdbm) '(gdbm-open GDBM_WRCREAT))
+
+(define-record-type <mandb-entry>
+  (mandb-entry file-name name section synopsis kind)
+  mandb-entry?
+  (file-name mandb-entry-file-name)               ;e.g., "../abiword.1.gz"
+  (name      mandb-entry-name)                    ;e.g., "ABIWORD"
+  (section   mandb-entry-section)                 ;number
+  (synopsis  mandb-entry-synopsis)                ;string
+  (kind      mandb-entry-kind))                   ;'ultimate | 'link
+
+(define (mandb-entry<? entry1 entry2)
+  (match entry1
+    (($ <mandb-entry> file1 name1 section1)
+     (match entry2
+       (($ <mandb-entry> file2 name2 section2)
+        (or (< section1 section2)
+            (string<? (basename file1) (basename file2))))))))
+
+(define abbreviate-file-name
+  (let ((man-file-rx (make-regexp "(.+)\\.[0-9][a-z]?(\\.gz)?$")))
+    (lambda (file)
+      (match (regexp-exec man-file-rx (basename file))
+        (#f
+         (basename file))
+        (matches
+         (match:substring matches 1))))))
+
+(define (entry->string entry)
+  "Return the wire format for ENTRY as a string."
+  (match entry
+    (($ <mandb-entry> file name section synopsis kind)
+     ;; See db_store.c:make_content in man-db for the format.
+     (string-append (abbreviate-file-name file) "\t"
+                    (number->string section) "\t"
+                    (number->string section)
+
+                    ;; Timestamp that we always set to the epoch.
+                    "\t0\t0"
+
+                    ;; See "db_storage.h" in man-db for the different kinds.
+                    "\t"
+                    (case kind
+                      ((ultimate) "A")     ;ultimate man page
+                      ((link)     "B")     ;".so" link to other man page
+                      (else       "A"))    ;something that doesn't matter much
+
+                    "\t-\t-\t"
+
+                    (if (string-suffix? ".gz" file) "gz" "")
+                    "\t"
+
+                    synopsis "\x00"))))
+
+;; The man-db schema version we're compatible with.
+(define %version-key "$version$\x00")
+(define %version-value "2.5.0\x00")
+
+(define (write-mandb-database file entries)
+  "Write ENTRIES to FILE as a man-db database.  FILE is usually
+\".../index.db\", and is a GDBM database."
+  (let ((db (gdbm-open file GDBM_WRCREAT)))
+    (gdbm-set! db %version-key %version-value)
+
+    ;; Write ENTRIES in sorted order so we get deterministic output.
+    (for-each (lambda (entry)
+                (gdbm-set! db
+                           (string-append (mandb-entry-file-name entry)
+                                          "\x00")
+                           (entry->string entry)))
+              (sort entries mandb-entry<?))
+    (gdbm-close db)))
+
+(define (read-synopsis port)
+  "Read from PORT a man page synopsis."
+  (define (section? line)
+    ;; True if LINE starts with ".SH", ".PP", or so.
+    (string-prefix? "." (string-trim line)))
+
+  (define (extract-synopsis str)
+    (match (string-contains str "\\-")
+      (#f "")
+      (index
+       (string-map (match-lambda
+                     (#\newline #\space)
+                     (chr chr))
+                   (string-trim-both (string-drop str (+ 2 index)))))))
+
+  ;; Synopses look like "Command \- Do something.", possibly spanning several
+  ;; lines.
+  (let loop ((lines '()))
+    (match (read-line port 'concat)
+      ((? eof-object?)
+       (extract-synopsis (string-concatenate-reverse lines)))
+      ((? section?)
+       (extract-synopsis (string-concatenate-reverse lines)))
+      (line
+       (loop (cons line lines))))))
+
+(define* (man-page->entry file #:optional (resolve identity))
+  "Parse FILE, a gzipped man page, and return a <mandb-entry> for it."
+  (define (string->number* str)
+    (if (and (string-prefix? "\"" str)
+             (> (string-length str) 1)
+             (string-suffix? "\"" str))
+        (string->number (string-drop (string-drop-right str 1) 1))
+        (string->number str)))
+
+  ;; Note: This works for both gzipped and uncompressed files.
+  (call-with-gzip-input-port (open-file file "r0")
+    (lambda (port)
+      (let loop ((name     #f)
+                 (section  #f)
+                 (synopsis #f)
+                 (kind     'ultimate))
+        (if (and name section synopsis)
+            (mandb-entry file name section synopsis kind)
+            (let ((line (read-line port)))
+              (if (eof-object? line)
+                  (mandb-entry file name (or section 0) (or synopsis "")
+                               kind)
+                  (match (string-tokenize line)
+                    ((".TH" name (= string->number* section) _ ...)
+                     (loop name section synopsis kind))
+                    ((".SH" (or "NAME" "\"NAME\""))
+                     (loop name section (read-synopsis port) kind))
+                    ((".so" link)
+                     (match (and=> (resolve link)
+                                   (cut man-page->entry <> resolve))
+                       (#f
+                        (loop name section synopsis 'link))
+                       (alias
+                        (mandb-entry file
+                                     (mandb-entry-name alias)
+                                     (mandb-entry-section alias)
+                                     (mandb-entry-synopsis alias)
+                                     'link))))
+                    (_
+                     (loop name section synopsis kind))))))))))
+
+(define (man-files directory)
+  "Return the list of man pages found under DIRECTORY, recursively."
+  (find-files directory "\\.[0-9][a-z]?(\\.gz)?$"))
+
+(define (mandb-entries directory)
+  "Return mandb entries for the man pages found under DIRECTORY, recursively."
+  (map (lambda (file)
+         (man-page->entry file
+                          (lambda (link)
+                            (let ((file (string-append directory "/" link
+                                                       ".gz")))
+                              (and (file-exists? file) file)))))
+       (man-files directory)))
diff --git a/guix/memoization.scm b/guix/memoization.scm
index bf3b73d806..086c4cdc56 100644
--- a/guix/memoization.scm
+++ b/guix/memoization.scm
@@ -17,10 +17,52 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix memoization)
-  #:export (memoize
+  #:use-module (guix profiling)
+  #:use-module (ice-9 match)
+  #:autoload   (srfi srfi-1) (count)
+  #:use-module (srfi srfi-9)
+  #:export (invalidate-memoization!
+            memoize
             mlambda
             mlambdaq))
 
+;; Data type representation a memoization cache when profiling is on.
+(define-record-type <cache>
+  (make-cache table lookups hits)
+  cache?
+  (table   cache-table)
+  (lookups cache-lookups set-cache-lookups!)
+  (hits    cache-hits    set-cache-hits!))
+
+(define-syntax-rule (define-lookup-procedure proc get)
+  "Define a lookup procedure PROC.  When profiling is turned off, PROC is set
+to GET; when profiling is on, PROC is a wrapper around GET that keeps tracks
+of lookups and cache hits."
+  (define proc
+    (if (profiled? "memoization")
+        (lambda (cache key default)
+          (let ((result (get (cache-table cache) key default)))
+            (set-cache-lookups! cache (+ 1 (cache-lookups cache)))
+            (unless (eq? result default)
+              (set-cache-hits! cache (+ 1 (cache-hits cache))))
+            result))
+        get)))
+
+(define-syntax-rule (define-update-procedure proc put!)
+  "Define an update procedure PROC.  When profiling is turned off, PROC is
+equal to PUT!; when profiling is on, PROC is a wrapper around PUT and unboxes
+the underlying hash table."
+  (define proc
+    (if (profiled? "memoization")
+        (lambda (cache key value)
+          (put! (cache-table cache) key value))
+        put!)))
+
+(define-lookup-procedure cache-ref hash-ref)
+(define-lookup-procedure cacheq-ref hashq-ref)
+(define-update-procedure cache-set! hash-set!)
+(define-update-procedure cacheq-set! hashq-set!)
+
 (define-syntax-rule (call/mv thunk)
   (call-with-values thunk list))
 (define-syntax-rule (return/mv lst)
@@ -53,10 +95,78 @@ already-cached result."
      (define-cache-procedure name hash-ref hash-set!
        call/mv return/mv))))
 
-(define-cache-procedure cached/mv  hash-ref hash-set!)
-(define-cache-procedure cachedq/mv hashq-ref hashq-set!)
-(define-cache-procedure cached  hash-ref hash-set! call/1 return/1)
-(define-cache-procedure cachedq hashq-ref hashq-set! call/1 return/1)
+(define-cache-procedure cached/mv  cache-ref cache-set!)
+(define-cache-procedure cachedq/mv cacheq-ref cacheq-set!)
+(define-cache-procedure cached  cache-ref cache-set! call/1 return/1)
+(define-cache-procedure cachedq cacheq-ref cacheq-set! call/1 return/1)
+
+(define %memoization-tables
+  ;; Map procedures to the underlying hash table.
+  (make-weak-key-hash-table))
+
+(define %make-hash-table*
+  ;; When profiling is off, this is equivalent to 'make-hash-table'.  When
+  ;; profiling is on, return a hash table wrapped in a <cache> object.
+  (if (profiled? "memoization")
+      (lambda (proc location)
+        (let ((cache (make-cache (make-hash-table) 0 0)))
+          (hashq-set! %memoization-tables proc
+                      (cons cache location))
+          cache))
+      (lambda (proc location)
+        (let ((table (make-hash-table)))
+          (hashq-set! %memoization-tables proc table)
+          table))))
+
+(define-syntax-rule (make-hash-table* proc)
+  (%make-hash-table* proc (current-source-location)))
+
+(define (invalidate-memoization! proc)
+  "Invalidate the memoization cache of PROC."
+  (match (hashq-ref %memoization-tables proc)
+    ((? hash-table? table)
+     (hash-clear! table))
+    (((? cache? cache) . _)
+     (hash-clear! (cache-table cache)))))
+
+(define* (show-memoization-tables #:optional (port (current-error-port)))
+  "Display to PORT statistics about the memoization tables."
+  (define (cache<? p1 p2)
+    (match p1
+      ((cache1 . _)
+       (match p2
+         ((cache2 . _)
+          (< (hash-count (const #t) (cache-table cache1))
+             (hash-count (const #t) (cache-table cache2))))))))
+
+  (define caches
+    (hash-map->list (lambda (key value)
+                      value)
+                    %memoization-tables))
+
+  (match (sort caches (negate cache<?))
+    (((caches . locations) ...)
+     (format port "Memoization: ~a tables, ~a non-empty~%"
+             (length caches)
+             (count (lambda (cache)
+                      (> (hash-count (const #t) (cache-table cache)) 0))
+                    caches))
+     (for-each (lambda (cache location)
+                 (let ((size (hash-count (const #t) (cache-table cache))))
+                   (unless (zero? size)
+                     (format port "  ~a:~a:~a: \t~a entries, ~a lookups, ~a% hits~%"
+                             (assq-ref location 'filename)
+                             (and=> (assq-ref location 'line) 1+)
+                             (assq-ref location 'column)
+                             size
+                             (cache-lookups cache)
+                             (inexact->exact
+                              (round
+                               (* 100. (/ (cache-hits cache)
+                                          (cache-lookups cache) 1.))))))))
+               caches locations))))
+
+(register-profiling-hook! "memoization" show-memoization-tables)
 
 (define (memoize proc)
   "Return a memoizing version of PROC.
@@ -64,11 +174,12 @@ already-cached result."
 This is a generic version of 'mlambda' what works regardless of the arity of
 'proc'.  It is more expensive since the argument list is always allocated, and
 the result is returned via (apply values results)."
-  (let ((cache (make-hash-table)))
-    (lambda args
-      (cached/mv cache args
-                 (lambda ()
-                   (apply proc args))))))
+  (letrec* ((mproc (lambda args
+                     (cached/mv cache args
+                                (lambda ()
+                                  (apply proc args)))))
+            (cache (make-hash-table* mproc)))
+    mproc))
 
 (define-syntax %mlambda
   (syntax-rules ()
@@ -88,19 +199,21 @@ exactly one value."
     ;; allocated.  XXX: We can't really avoid the closure allocation since
     ;; Guile 2.0's compiler will always keep it.
     ((_ cached (arg) body ...)                    ;one argument
-     (let ((cache (make-hash-table))
-           (proc  (lambda (arg) body ...)))
-       (lambda (arg)
-         (cached cache arg (lambda () (proc arg))))))
+     (letrec* ((proc  (lambda (arg) body ...))
+               (mproc (lambda (arg)
+                        (cached cache arg (lambda () (proc arg)))))
+               (cache (make-hash-table* mproc)))
+       mproc))
     ((_ _ (args ...) body ...)                    ;two or more arguments
-     (let ((cache (make-hash-table))
-           (proc  (lambda (args ...) body ...)))
-       (lambda (args ...)
-         ;; XXX: Always use 'cached', which uses 'equal?', to compare the
-         ;; argument lists.
-         (cached cache (list args ...)
-                 (lambda ()
-                   (proc args ...))))))))
+     (letrec* ((proc  (lambda (args ...) body ...))
+               (mproc (lambda (args ...)
+                        ;; XXX: Always use 'cached', which uses 'equal?', to
+                        ;; compare the argument lists.
+                        (cached cache (list args ...)
+                                (lambda ()
+                                  (proc args ...)))))
+               (cache (make-hash-table* mproc)))
+       mproc))))
 
 (define-syntax-rule (mlambda formals body ...)
   "Define a memoizing lambda.  The lambda's arguments are compared with
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 07fe2faa3c..8e3e49e444 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -33,6 +33,7 @@
   #:use-module (guix derivations)
   #:use-module (guix search-paths)
   #:use-module (guix gexp)
+  #:use-module (guix modules)
   #:use-module (guix monads)
   #:use-module (guix store)
   #:use-module (guix sets)
@@ -1114,84 +1115,73 @@ files for the fonts of the @var{manifest} entries."
 (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 gdbm-ffi
+    (module-ref (resolve-interface '(gnu packages guile))
+                'guile-gdbm-ffi))
+
+  (define zlib
+    (module-ref (resolve-interface '(gnu packages compression)) 'zlib))
+
+  (define config.scm
+    (scheme-file "config.scm"
+                 #~(begin
+                     (define-module (guix config)
+                       #:export (%libz))
+
+                     (define %libz
+                       #+(file-append zlib "/lib/libz")))))
+
+  (define modules
+    (cons `((guix config) => ,config.scm)
+          (delete '(guix config)
+                  (source-module-closure `((guix build utils)
+                                           (guix man-db))))))
 
   (define build
-    (with-imported-modules '((guix build utils))
+    (with-imported-modules modules
       #~(begin
-          (use-modules (guix build utils)
+          (add-to-load-path (string-append #$gdbm-ffi "/share/guile/site/"
+                                           (effective-version)))
+
+          (use-modules (guix man-db)
+                       (guix build utils)
                        (srfi srfi-1)
-                       (srfi srfi-19)
-                       (srfi srfi-26))
+                       (srfi srfi-19))
 
-          (define entries
-            (filter-map (lambda (directory)
+          (define (compute-entries)
+            (append-map (lambda (directory)
                           (let ((man (string-append directory "/share/man")))
-                            (and (directory-exists? man)
-                                 man)))
+                            (if (directory-exists? man)
+                                (mandb-entries 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))
+          (format #t "Creating manual page database...~%")
           (force-output)
-          (let* ((start-time (current-time))
-                 (exit-status (system* #+(file-append man-db "/bin/mandb")
-                                       "--quiet" "--create"
-                                       "-C" "man_db.conf"))
-                 (duration (time-difference (current-time) start-time)))
-            (format #t "done in ~,3f s~%"
+          (let* ((start    (current-time))
+                 (entries  (compute-entries))
+                 (_        (write-mandb-database (string-append man-directory
+                                                                "/index.db")
+                                                 entries))
+                 (duration (time-difference (current-time) start)))
+            (format #t "~a entries processed in ~,1f s~%"
+                    (length entries)
                     (+ (time-second duration)
                        (* (time-nanosecond duration) (expt 10 -9))))
-            (force-output)
-            (zero? exit-status)))))
+            (force-output)))))
 
   (gexp->derivation "manual-database" build
+
+                    ;; Work around GDBM 1.13 issue whereby uninitialized bytes
+                    ;; get written to disk:
+                    ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=29654#23>.
+                    #:env-vars `(("MALLOC_PERTURB_" . "1"))
+
                     #:local-build? #t))
 
 (define %default-profile-hooks
diff --git a/guix/profiling.scm b/guix/profiling.scm
new file mode 100644
index 0000000000..753fc6c22e
--- /dev/null
+++ b/guix/profiling.scm
@@ -0,0 +1,52 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix profiling)
+  #:use-module (ice-9 match)
+  #:export (profiled?
+            register-profiling-hook!))
+
+;;; Commentary:
+;;;
+;;; Basic support for Guix-specific profiling.
+;;;
+;;; Code:
+
+(define profiled?
+  (let ((profiled
+         (or (and=> (getenv "GUIX_PROFILING") string-tokenize)
+             '())))
+    (lambda (component)
+      "Return true if COMPONENT profiling is active."
+      (member component profiled))))
+
+(define %profiling-hooks
+  ;; List of profiling hooks.
+  (map (match-lambda
+         ("after-gc"       after-gc-hook)
+         ((or "exit" #f)   exit-hook))
+       (or (and=> (getenv "GUIX_PROFILING_EVENTS") string-tokenize)
+           '("exit"))))
+
+(define (register-profiling-hook! component thunk)
+  "Register THUNK as a profiling hook for COMPONENT, a string such as
+\"rpc\"."
+  (when (profiled? component)
+    (for-each (lambda (hook)
+                (add-hook! hook thunk))
+              %profiling-hooks)))
diff --git a/guix/progress.scm b/guix/progress.scm
index 0ca5c08782..c9c3cd12a0 100644
--- a/guix/progress.scm
+++ b/guix/progress.scm
@@ -178,8 +178,8 @@ width of the bar is BAR-WIDTH."
             (make-string filled #\#)
             (make-string empty #\space))))
 
-(define (erase-in-line port)
-  "Write an ANSI erase-in-line sequence to PORT to erase the whole line and
+(define (erase-current-line port)
+  "Write an ANSI erase-current-line sequence to PORT to erase the whole line and
 move the cursor to the beginning of the line."
   (display "\r\x1b[K" port))
 
@@ -206,7 +206,7 @@ ABBREVIATION used to shorten FILE for display."
                                      (byte-count->string throughput)
                                      (seconds->string elapsed)
                                      (progress-bar %) %)))
-            (erase-in-line log-port)
+            (erase-current-line log-port)
             (display (string-pad-middle left right
                                         (current-terminal-columns))
                      log-port)
@@ -218,7 +218,7 @@ ABBREVIATION used to shorten FILE for display."
                                      (byte-count->string throughput)
                                      (seconds->string elapsed)
                                      (byte-count->string transferred))))
-            (erase-in-line log-port)
+            (erase-current-line log-port)
             (display (string-pad-middle left right
                                         (current-terminal-columns))
                      log-port)
@@ -248,7 +248,7 @@ tasks is performed.  Write PREFIX at the beginning of the line."
     (set! done (+ 1 done))
     (unless (> done total)
       (let* ((ratio (* 100. (/ done total))))
-        (erase-in-line port)
+        (erase-current-line port)
         (if (string-null? prefix)
             (display (progress-bar ratio (current-terminal-columns)) port)
             (let ((width (- (current-terminal-columns)
@@ -263,7 +263,7 @@ tasks is performed.  Write PREFIX at the beginning of the line."
             (set! done 0)))
    (report report-progress)
    (stop (lambda ()
-           (erase-in-line port)
+           (erase-current-line port)
            (unless (string-null? prefix)
              (display prefix port)
              (newline port))
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index a569848ae3..a359f405fe 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -53,6 +53,7 @@
   ;; Alist of default option values.
   `((system . ,(%current-system))
     (substitutes? . #t)
+    (build-hook? . #t)
     (graft? . #t)
     (verbosity . 0)))
 
diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm
index 9ffffe8ccd..4c85929858 100644
--- a/guix/scripts/copy.scm
+++ b/guix/scripts/copy.scm
@@ -150,6 +150,7 @@ Copy ITEMS to or from the specified host over SSH.\n"))
 (define %default-options
   `((system . ,(%current-system))
     (substitutes? . #t)
+    (build-hook? . #t)
     (graft? . #t)
     (verbosity . 0)))
 
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index e1b7feecfa..d2568e6a7d 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -178,6 +178,7 @@ COMMAND or an interactive shell in that environment.\n"))
 (define %default-options
   `((system . ,(%current-system))
     (substitutes? . #t)
+    (build-hook? . #t)
     (graft? . #t)
     (verbosity . 0)))
 
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 378a47d113..a31d2236b0 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -78,6 +78,21 @@ Invoke the garbage collector.\n"))
   (newline)
   (show-bug-report-information))
 
+(define argument->verify-options
+  (let ((not-comma (char-set-complement (char-set #\,)))
+        (validate  (lambda (option)
+                     (unless (memq option '(repair contents))
+                       (leave (G_ "~a: invalid '--verify' option~%")
+                              option)))))
+    (lambda (arg)
+      "Turn ARG into a list of symbols denoting '--verify' options."
+      (if arg
+          (let ((lst (map string->symbol
+                          (string-tokenize arg not-comma))))
+            (for-each validate lst)
+            lst)
+          '()))))
+
 (define %options
   ;; Specification of the command-line options.
   (list (option '(#\h "help") #f #f
@@ -112,16 +127,12 @@ Invoke the garbage collector.\n"))
                   (alist-cons 'action 'optimize
                               (alist-delete 'action result))))
         (option '("verify") #f #t
-                (let ((not-comma (char-set-complement (char-set #\,))))
-                  (lambda (opt name arg result)
-                    (let ((options (if arg
-                                       (map string->symbol
-                                            (string-tokenize arg not-comma))
-                                       '())))
-                      (alist-cons 'action 'verify
-                                  (alist-cons 'verify-options options
-                                              (alist-delete 'action
-                                                            result)))))))
+                (lambda (opt name arg result)
+                  (let ((options (argument->verify-options arg)))
+                    (alist-cons 'action 'verify
+                                (alist-cons 'verify-options options
+                                            (alist-delete 'action
+                                                          result))))))
         (option '("list-dead") #f #f
                 (lambda (opt name arg result)
                   (alist-cons 'action 'list-dead
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index 1b43b0a63c..4ec3267007 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -7,6 +7,7 @@
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2017 Alex Kost <alezost@gmail.com>
 ;;; Copyright © 2017 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -881,10 +882,16 @@ the NIST server non-fatal."
                                      (or (and=> (package-source package)
                                                 origin-patches)
                                          '())))
+              (known-safe (or (assq-ref (package-properties package)
+                                        'lint-hidden-cve)
+                              '()))
               (unpatched (remove (lambda (vuln)
-                                   (find (cute string-contains
-                                           <> (vulnerability-id vuln))
-                                         patches))
+                                   (let ((id (vulnerability-id vuln)))
+                                     (or
+                                       (find (cute string-contains
+                                                   <> id)
+                                             patches)
+                                       (member id known-safe))))
                                  vulnerabilities)))
          (unless (null? unpatched)
            (emit-warning package
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index ebd0bf783d..7e114fa2c9 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -629,6 +630,32 @@ machine."
       (for-each assert-node-can-import nodes names sockets)
       (for-each assert-node-can-export nodes names sockets))))
 
+(define (check-machine-status machine-file pred)
+  "Print the load of each machine matching PRED in MACHINE-FILE."
+  (define (build-machine=? m1 m2)
+    (and (string=? (build-machine-name m1) (build-machine-name m2))
+         (= (build-machine-port m1) (build-machine-port m2))))
+
+  ;; A given build machine may appear several times (e.g., once for
+  ;; "x86_64-linux" and a second time for "i686-linux"); test them only once.
+  (let ((machines (filter pred
+                          (delete-duplicates (build-machines machine-file)
+                                             build-machine=?))))
+    (info (G_ "getting status of ~a build machines defined in '~a'...~%")
+          (length machines) machine-file)
+    (for-each (lambda (machine)
+                (let* ((node (make-node (open-ssh-session machine)))
+                       (uts (node-eval node '(uname))))
+                  (format #t "~a~%  kernel: ~a ~a~%  architecture: ~a~%\
+  host name: ~a~%  normalized load: ~a~%"
+                          (build-machine-name machine)
+                          (utsname:sysname uts) (utsname:release uts)
+                          (utsname:machine uts)
+                          (utsname:nodename uts)
+                          (parameterize ((current-error-port (%make-void-port "rw+")))
+                                        (machine-load machine)))))
+              machines)))
+
 
 ;;;
 ;;; Entry point.
@@ -691,6 +718,18 @@ machine."
                        (()     (values %machine-file (const #t)))
                        (x      (leave (G_ "wrong number of arguments~%"))))))
          (check-machine-availability (or file %machine-file) pred))))
+    (("status" rest ...)
+     (with-error-handling
+       (let-values (((file pred)
+                     (match rest
+                       ((file regexp)
+                        (values file
+                                (compose (cut string-match regexp <>)
+                                         build-machine-name)))
+                       ((file) (values file (const #t)))
+                       (()     (values %machine-file (const #t)))
+                       (x      (leave (G_ "wrong number of arguments~%"))))))
+         (check-machine-status (or file %machine-file) pred))))
     (("--version")
      (show-version-and-exit "guix offload"))
     (("--help")
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 21fea446a6..a22258d5a6 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -262,6 +262,7 @@ the image."
   `((format . tarball)
     (system . ,(%current-system))
     (substitutes? . #t)
+    (build-hook? . #t)
     (graft? . #t)
     (verbosity . 0)
     (symlinks . ())
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index 0a4a07ae2a..617e102d93 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -360,7 +360,8 @@ ENTRIES, a list of manifest entries, in the context of PROFILE."
   ;; Alist of default option values.
   `((verbosity . 0)
     (graft? . #t)
-    (substitutes? . #t)))
+    (substitutes? . #t)
+    (build-hook? . #t)))
 
 (define (show-help)
   (display (G_ "Usage: guix package [OPTION]...
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index be0c168444..64c2196e03 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -89,6 +89,7 @@ Install it by running:
     (ref . (branch . "origin/master"))
     (system . ,(%current-system))
     (substitutes? . #t)
+    (build-hook? . #t)
     (graft? . #t)
     (verbosity . 0)))
 
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index e2ff42693f..36aed3331f 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -674,9 +674,11 @@ any, are available.  Raise an error if they're not."
 and TARGET arguments."
   (with-monad %store-monad
     (gexp->file "bootloader-installer"
-                (with-imported-modules '((guix build utils))
+                (with-imported-modules '((gnu build bootloader)
+                                         (guix build utils))
                   #~(begin
-                      (use-modules (guix build utils)
+                      (use-modules (gnu build bootloader)
+                                   (guix build utils)
                                    (ice-9 binary-ports))
                       (#$installer #$bootloader #$device #$target))))))
 
@@ -856,6 +858,9 @@ Some ACTIONS support additional ARGS.\n"))
   (display (G_ "
   -d, --derivation       return the derivation of the given system"))
   (display (G_ "
+  -e, --expression=EXPR  consider the operating-system EXPR evaluates to
+                         instead of reading FILE, when applicable"))
+  (display (G_ "
       --on-error=STRATEGY
                          apply STRATEGY when an error occurs while reading FILE"))
   (display (G_ "
@@ -893,6 +898,9 @@ Some ACTIONS support additional ARGS.\n"))
          (option '(#\V "version") #f #f
                  (lambda args
                    (show-version-and-exit "guix system")))
+         (option '(#\e "expression") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'expression arg result)))
          (option '(#\d "derivation") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'derivations-only? #t result)))
@@ -942,8 +950,8 @@ Some ACTIONS support additional ARGS.\n"))
   ;; Alist of default option values.
   `((system . ,(%current-system))
     (substitutes? . #t)
-    (graft? . #t)
     (build-hook? . #t)
+    (graft? . #t)
     (verbosity . 0)
     (file-system-type . "ext4")
     (image-size . guess)
@@ -962,11 +970,19 @@ resulting from command-line parsing."
   (let* ((file        (match args
                         (() #f)
                         ((x . _) x)))
+         (expr        (assoc-ref opts 'expression))
          (system      (assoc-ref opts 'system))
-         (os          (if file
-                          (load* file %user-module
-                                 #:on-error (assoc-ref opts 'on-error))
-                          (leave (G_ "no configuration file specified~%"))))
+         (os          (cond
+                       ((and expr file)
+                        (leave
+                         (G_ "both file and expression cannot be specified~%")))
+                       (expr
+                        (read/eval expr))
+                       (file
+                        (load* file %user-module
+                                    #:on-error (assoc-ref opts 'on-error)))
+                       (else
+                        (leave (G_ "no configuration specified~%")))))
 
          (dry?        (assoc-ref opts 'dry-run?))
          (bootloader? (assoc-ref opts 'install-bootloader?))
@@ -1077,7 +1093,8 @@ argument list and OPTS is the option alist."
     ;; Extract the plain arguments from OPTS.
     (let* ((args   (reverse (filter-map (match-pair 'argument) opts)))
            (count  (length args))
-           (action (assoc-ref opts 'action)))
+           (action (assoc-ref opts 'action))
+           (expr   (assoc-ref opts 'expression)))
       (define (fail)
         (leave (G_ "wrong number of arguments for action '~a'~%")
                action))
@@ -1091,7 +1108,8 @@ argument list and OPTS is the option alist."
 
       (case action
         ((build container vm vm-image disk-image reconfigure)
-         (unless (= count 1)
+         (unless (or (= count 1)
+                     (and expr (= count 0)))
            (fail)))
         ((init)
          (unless (= count 2)
diff --git a/guix/store.scm b/guix/store.scm
index f336df85cc..e6e45ba89c 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -25,6 +25,7 @@
   #:use-module (guix base16)
   #:use-module (guix base32)
   #:use-module (guix hash)
+  #:use-module (guix profiling)
   #:autoload   (guix build syscalls) (terminal-columns)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
@@ -794,16 +795,14 @@ bytevector) as its internal buffer, and a thunk to flush this output port."
 
 (define record-operation
   ;; Optionally, increment the number of calls of the given RPC.
-  (let ((profiled (or (and=> (getenv "GUIX_PROFILING") string-tokenize)
-                      '())))
-    (if (member "rpc" profiled)
-        (begin
-          (add-hook! exit-hook show-rpc-profile)
-          (lambda (name)
-            (let ((count (or (hashq-ref %rpc-calls name) 0)))
-              (hashq-set! %rpc-calls name (+ count 1)))))
-        (lambda (_)
-          #t))))
+  (if (profiled? "rpc")
+      (begin
+        (register-profiling-hook! "rpc" show-rpc-profile)
+        (lambda (name)
+          (let ((count (or (hashq-ref %rpc-calls name) 0)))
+            (hashq-set! %rpc-calls name (+ count 1)))))
+      (lambda (_)
+        #t)))
 
 (define-syntax operation
   (syntax-rules ()
diff --git a/guix/ui.scm b/guix/ui.scm
index e40fe576ba..2b7cc3d41a 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -502,6 +502,26 @@ interpreted."
           (x
            (leave (G_ "unknown unit: ~a~%") unit)))))))
 
+(define (display-collision-resolution-hint collision)
+  "Display hints on how to resolve COLLISION, a &profile-collistion-error."
+  (define (top-most-entry entry)
+    (let loop ((entry entry))
+      (match (force (manifest-entry-parent entry))
+        (#f entry)
+        (parent (loop parent)))))
+
+  (let* ((first  (profile-collision-error-entry collision))
+         (second (profile-collision-error-conflict collision))
+         (name1  (manifest-entry-name (top-most-entry first)))
+         (name2  (manifest-entry-name (top-most-entry second))))
+    (if (string=? name1 name2)
+        (display-hint (format #f (G_ "You cannot have two different versions
+or variants of @code{~a} in the same profile.")
+                              name1))
+        (display-hint (format #f (G_ "Try upgrading both @code{~a} and @code{~a},
+or remove one of them from the profile.")
+                              name1 name2)))))
+
 (define (call-with-error-handling thunk)
   "Call THUNK within a user-friendly error handler."
   (define (port-filename* port)
@@ -570,6 +590,7 @@ interpreted."
                              (manifest-entry-output* conflict)
                              (manifest-entry-item conflict))
                (report-parent-entries conflict)
+               (display-collision-resolution-hint c)
                (exit 1)))
             ((nar-error? c)
              (let ((file (nar-error-file c))
@@ -600,7 +621,8 @@ directories:~{ ~a~}~%")
              (format (current-error-port)
                      (G_ "~a: error: ~a~%")
                      (location->string (error-location c))
-                     (gettext (condition-message c) %gettext-domain)))
+                     (gettext (condition-message c) %gettext-domain))
+             (exit 1))
             ((message-condition? c)
              ;; Normally '&message' error conditions have an i18n'd message.
              (leave (G_ "~a~%")
diff --git a/guix/utils.scm b/guix/utils.scm
index fed31f4ca4..92e45de616 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -82,6 +82,7 @@
             version>=?
             version-prefix
             version-major+minor
+            version-major
             guile-version>?
             string-replace-substring
             arguments-from-environment-variable
@@ -497,6 +498,10 @@ For example, (version-prefix \"2.1.47.4.23\" 3) returns \"2.1.47\""
 minor version numbers from version-string."
   (version-prefix version-string 2))
 
+(define (version-major version-string)
+  "Return the major version number as string from the version-string."
+  (version-prefix version-string 1))
+
 (define (version>? a b)
   "Return #t when A denotes a version strictly newer than B."
   (eq? '> (version-compare a b)))