Merge branch 'master' into staging

34 files changed, 1624 insertions, 217 deletions

diff --git a/guix/build-system/elm.scm b/guix/build-system/elm.scm
new file mode 100644
index 0000000000..f5321f811b
--- /dev/null
+++ b/guix/build-system/elm.scm
@@ -0,0 +1,206 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;;
+;;; 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 build-system elm)
+  #:use-module (guix store)
+  #:use-module (guix utils)
+  #:use-module (guix packages)
+  #:use-module (guix gexp)
+  #:use-module (guix monads)
+  #:use-module (guix search-paths)
+  #:use-module (guix git-download)
+  #:use-module (guix build-system)
+  #:use-module (guix build-system gnu)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
+  #:export (elm->package-name
+            guix-package->elm-name
+            infer-elm-package-name
+            elm-package-origin
+            %elm-build-system-modules
+            %elm-default-modules
+            elm-build
+            elm-build-system))
+
+(define (elm->package-name name)
+  "Given the NAME of an Elm package, return a Guix-style package name."
+  (let ((converted
+         (string-join (string-split (string-downcase name) #\/) "-")))
+    (if (string-prefix? "elm-" converted)
+        converted
+        (string-append "elm-" converted))))
+
+(define (guix-package->elm-name package)
+  "Given an Elm PACKAGE, return the possibly-inferred upstream name, or #f the
+upstream name is not specified and can't be inferred."
+  (or (assoc-ref (package-properties package) 'upstream-name)
+      (infer-elm-package-name (package-name package))))
+
+(define (infer-elm-package-name guix-name)
+  "Given the GUIX-NAME of an Elm package, return the inferred upstream name,
+or #f if it can't be inferred.  If the result is not #f, supplying it to
+'elm->package-name' would produce GUIX-NAME.
+
+See also 'guix-package->elm-name', which respects the 'upstream-name'
+property."
+  (define (parts-join part0 parts)
+    (string-join (cons part0 parts) "-"))
+  (match (string-split guix-name #\-)
+    (("elm" "explorations" part0 parts ...)
+     (string-append "elm-explorations/"
+                    (parts-join part0 parts)))
+    (("elm" owner part0 parts ...)
+     (string-append owner "/" (parts-join part0 parts)))
+    (("elm" repo)
+     (string-append "elm/" repo))
+    (_
+     #f)))
+
+(define (elm-package-origin elm-name version hash)
+  "Return an origin for the Elm package with upstream name ELM-NAME at the
+given VERSION with sha256 checksum HASH."
+  ;; elm requires this very specific repository structure and tagging regime
+  (origin
+    (method git-fetch)
+    (uri (git-reference
+          (url (string-append "https://github.com/" elm-name))
+          (commit version)))
+    (file-name (git-file-name (elm->package-name elm-name) version))
+    (sha256 hash)))
+
+(define %elm-build-system-modules
+  ;; Build-side modules imported by default.
+  `((guix build elm-build-system)
+    (guix build json)
+    (guix build union)
+    ,@%gnu-build-system-modules))
+
+(define %elm-default-modules
+  ;; Modules in scope in the build-side environment.
+  '((guix build elm-build-system)
+    (guix build utils)
+    (guix build json)
+    (guix build union)))
+
+(define (default-elm)
+  "Return the default Elm package for builds."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((elm (resolve-interface '(gnu packages elm))))
+    (module-ref elm 'elm-sans-reactor)))
+
+(define (default-elm-core)
+  "Return the default elm-core package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((elm (resolve-interface '(gnu packages elm))))
+    (module-ref elm 'elm-core)))
+
+(define (default-elm-json)
+  "Return the default elm-json package."
+  ;; Lazily resolve the binding to avoid a circular dependency.
+  (let ((elm (resolve-interface '(gnu packages elm))))
+    (module-ref elm 'elm-json)))
+
+(define* (lower name
+                #:key source inputs native-inputs outputs system target
+                (implicit-elm-package-inputs? #t)
+                (elm (default-elm))
+                #:allow-other-keys
+                #:rest arguments)
+  "Return a bag for NAME."
+  (define private-keywords
+    '(#:target #:implicit-elm-package-inputs? #:elm #:inputs #:native-inputs))
+  (cond
+   (target
+    ;; Cross-compilation is not yet supported.  It should be easy, though,
+    ;; since the build products are all platform-independent.
+    #f)
+   (else
+    (bag
+      (name name)
+      (system system)
+      (host-inputs
+       `(,@(if source
+               `(("source" ,source))
+               '())
+         ,@inputs
+         ("elm" ,elm)
+         ,@(cond
+            (implicit-elm-package-inputs?
+             ;; These are needed for elm-build-system even if not actually
+             ;; needed by the package being built.  But "elm/json" is often
+             ;; present in practice, and "elm/core" always is: only add the
+             ;; default packages if no suitable inputs have been given
+             ;; explicitly.
+             (filter-map
+              (match-lambda
+                ((name get-default)
+                 (cond
+                  ((find (match-lambda
+                           ((_ pkg . _)
+                            (equal? name (guix-package->elm-name pkg))))
+                         inputs)
+                   #f)
+                  (else
+                   `(,name ,(get-default))))))
+              `(("elm/core" ,default-elm-core)
+                ("elm/json" ,default-elm-json))))
+            (else
+             '()))
+         ;; TODO: probably don't need most of (standard-packages)
+         ,@(standard-packages)))
+      (outputs outputs)
+      (build elm-build)
+      (arguments (strip-keyword-arguments private-keywords arguments))))))
+
+(define* (elm-build name inputs
+                    #:key
+                    source
+                    (tests? #t)
+                    (phases '%standard-phases)
+                    (outputs '("out"))
+                    (search-paths '())
+                    (system (%current-system))
+                    (guile #f)
+                    (imported-modules %elm-build-system-modules)
+                    (modules %elm-default-modules))
+  "Build SOURCE using ELM."
+  (define builder
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@(sexp->gexp modules))
+          (elm-build #:name #$name
+                     #:source #+source
+                     #:system #$system
+                     #:tests? #$tests?
+                     #:phases #$phases
+                     #:outputs #$(outputs->gexp outputs)
+                     #:search-paths '#$(sexp->gexp
+                                        (map search-path-specification->sexp
+                                             search-paths))
+                     #:inputs #$(input-tuples->gexp inputs)))))
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    (gexp->derivation name builder
+                      #:system system
+                      #:guile-for-build guile)))
+
+(define elm-build-system
+  (build-system
+    (name 'elm)
+    (description "The Elm build system")
+    (lower lower)))
diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index e82a9ca65c..94a293da13 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -28,6 +28,7 @@
   #:use-module (guix build-system)
   #:use-module (guix build-system gnu)
   #:use-module (guix packages)
+  #:use-module (guix platform)
   #:use-module (ice-9 match)
   #:export (%linux-module-build-system-modules
             linux-module-build
@@ -50,8 +51,7 @@
     (module-ref module 'linux-libre)))
 
 (define (system->arch system)
-  (let ((module (resolve-interface '(gnu packages linux))))
-    ((module-ref module 'system->linux-architecture) system)))
+  (platform-linux-architecture (lookup-platform-by-target-or-system system)))
 
 (define (make-linux-module-builder linux)
   (package
diff --git a/guix/build/elm-build-system.scm b/guix/build/elm-build-system.scm
new file mode 100644
index 0000000000..02d7c029dd
--- /dev/null
+++ b/guix/build/elm-build-system.scm
@@ -0,0 +1,380 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;;
+;;; 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 build elm-build-system)
+  #:use-module ((guix build gnu-build-system) #:prefix gnu:)
+  #:use-module (guix build utils)
+  #:use-module (guix build json)
+  #:use-module (guix build union)
+  #:use-module (ice-9 ftw)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 popen)
+  #:use-module (ice-9 vlist)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
+  #:export (%standard-phases
+            patch-application-dependencies
+            patch-json-string-escapes
+            read-offline-registry->vhash
+            elm-build))
+
+;;; Commentary:
+;;;
+;;; Elm draws a sharp distinction between "projects" with `{"type":"package"}`
+;;; vs. `{"type":"application"}` in the "elm.json" file: see
+;;; <https://github.com/elm/compiler/blob/master/docs/elm.json/package.md> and
+;;; <https://github.com/elm/compiler/blob/master/docs/elm.json/application.md>.
+;;; For now, `elm-build-system` is designed for "package"s: packaging
+;;; "application"s requires ad-hoc replacements for some phases---but see
+;;; `patch-application-dependencies`, which helps to work around a known issue
+;;; discussed below.  It would be nice to add more streamlined support for
+;;; "application"s one we have more experience building them in Guix.  For
+;;; example, we could incorporate the `uglifyjs` advice from
+;;; <https://github.com/elm/compiler/blob/master/hints/optimize.md>.
+;;;
+;;; We want building an Elm "package" to produce:
+;;;
+;;;   - a "docs.json" file with extracted documentation; and
+;;;
+;;;   - an "artifacts.dat" file with compilation results for use in building
+;;;     "package"s and "application"s.
+;;;
+;;; Unfortunately, there isn't an entry point to the Elm compiler that builds
+;;; those files directly.  Building with `elm make` does something different,
+;;; more oriented toward development, testing, and building "application"s.
+;;; We work around this limitation by staging the "package" we're building as
+;;; though it were already installed in ELM_HOME, generating a trivial Elm
+;;; "application" that depends on the "package", and building the
+;;; "application", which causes the files for the "package" to be built.
+;;;
+;;; Much of the ceremony involved is to avoid using `elm` in ways that would
+;;; make it try to do network IO beyond the bare minimum functionality for
+;;; which we've patched a replacement into our `elm`.  On the other hand, we
+;;; get to take advantage of the very regular structure required of Elm
+;;; packages.
+;;;
+;;; *Known issue:* Elm itself supports multiple versions of "package"s
+;;; coexisting simultaneously under ELM_HOME, but we do not support this yet.
+;;; Sometimes, parallel versions coexisting causes `elm` to try to write to
+;;; built "artifacts.dat" files.  For now, two workarounds are possible:
+;;;
+;;;  - Use `patch-application-dependencies` to rewrite an "application"'s
+;;;    "elm.json" file to refer to the versions of its inputs actually
+;;;    packaged in Guix.
+;;;
+;;;  - Use a Guix package transformation to rewrite your "application"'s
+;;;    dependencies recursively, so that only one version of each Elm
+;;;    "package" is included in your "application"'s build environment.
+;;;
+;;; Patching `elm` more extensively---perhaps adding an `elm guix`
+;;; subcommand`---might let us address these issues more directly.
+;;;
+;;; Code:
+;;;
+
+(define %essential-elm-packages
+  ;; elm/json isn't essential in a fundamental sense,
+  ;; but it's required for a {"type":"application"},
+  ;; which we are generating to trigger the build
+  '("elm/core" "elm/json"))
+
+(define* (target-elm-version #:optional elm)
+  "Return the version of ELM or whichever 'elm' is in $PATH.
+Return #false if it cannot be determined."
+  (let* ((pipe (open-pipe* OPEN_READ
+                           (or elm "elm")
+                           "--version"))
+         (line (read-line pipe)))
+    (and (zero? (close-pipe pipe))
+         (string? line)
+         line)))
+
+(define* (prepare-elm-home #:key native-inputs inputs #:allow-other-keys)
+  "Set the ELM_HOME environment variable and populate the indicated directory
+with the union of the Elm \"package\" inputs.  Also, set GUIX_ELM_VERSION to
+the version of the Elm compiler in use."
+  (let* ((elm (search-input-file (or native-inputs inputs) "/bin/elm"))
+         (elm-version (target-elm-version elm)))
+    (setenv "GUIX_ELM_VERSION" elm-version)
+    (mkdir "../elm-home")
+    (with-directory-excursion "../elm-home"
+      (union-build elm-version
+                   (search-path-as-list
+                    (list (string-append "share/elm/" elm-version))
+                    (map cdr inputs))
+                   #:create-all-directories? #t)
+      (setenv "ELM_HOME" (getcwd)))))
+
+(define* (stage #:key native-inputs inputs  #:allow-other-keys)
+  "Extract the installable files from the Elm \"package\" into a staging
+directory and link it into the ELM_HOME tree.  Also, set GUIX_ELM_PKG_NAME and
+GUIX_ELM_PKG_VERSION to the name and version, respectively, of the Elm package
+being built, as defined in its \"elm.json\" file."
+  (let* ((elm-version (getenv "GUIX_ELM_VERSION"))
+         (elm-home (getenv "ELM_HOME"))
+         (info (match (call-with-input-file "elm.json" read-json)
+                 (('@ . alist) alist)))
+         (name (assoc-ref info "name"))
+         (version (assoc-ref info "version"))
+         (rel-dir (string-append elm-version "/packages/" name "/" version))
+         (staged-dir (string-append elm-home "/../staged/" rel-dir)))
+    (setenv "GUIX_ELM_PKG_NAME" name)
+    (setenv "GUIX_ELM_PKG_VERSION" version)
+    (mkdir-p staged-dir)
+    (mkdir-p (string-append elm-home "/" (dirname rel-dir)))
+    (symlink staged-dir
+             (string-append elm-home "/" rel-dir))
+    (copy-recursively "src" (string-append staged-dir "/src"))
+    (install-file "elm.json" staged-dir)
+    (install-file "README.md" staged-dir)
+    (when (file-exists? "LICENSE")
+      (install-file "LICENSE" staged-dir))))
+
+(define (patch-json-string-escapes file)
+  "Work around a bug in the Elm compiler's JSON parser by attempting to
+replace REVERSE-SOLIDUS--SOLIDUS escape sequences in FILE with unescaped
+SOLIDUS characters."
+  ;; https://github.com/elm/compiler/issues/2255
+  (substitute* file
+    (("\\\\/")
+     "/")))
+
+(define (directory-list dir)
+  "Like DIRECTORY-LIST from 'racket/base': lists the contents of DIR, not
+including the special \".\" and \"..\" entries."
+  (scandir dir (lambda (f)
+                 (not (member f '("." ".."))))))
+
+(define* (make-offline-registry-file #:key inputs #:allow-other-keys)
+  "Generate an \"offline-package-registry.json\" file and set
+GUIX_ELM_OFFLINE_REGISTRY_FILE to its path, cooperating with a patch to `elm`
+to avoid attempting to download a list of all published Elm package names and
+versions from the internet."
+  (let* ((elm-home (getenv "ELM_HOME"))
+         (elm-version (getenv "GUIX_ELM_VERSION"))
+         (registry-file
+          (string-append elm-home "/../offline-package-registry.json"))
+         (registry-alist
+          ;; here, we don't need to look up entries, so we build the
+          ;; alist directly, rather than using a vhash
+          (with-directory-excursion
+              (string-append elm-home "/" elm-version "/packages")
+            (append-map (lambda (org)
+                          (with-directory-excursion org
+                            (map (lambda (repo)
+                                   (cons (string-append org "/" repo)
+                                         (directory-list repo)))
+                                 (directory-list "."))))
+                        (directory-list ".")))))
+    (call-with-output-file registry-file
+      (lambda (out)
+        (write-json `(@ ,@registry-alist) out)))
+    (patch-json-string-escapes registry-file)
+    (setenv "GUIX_ELM_OFFLINE_REGISTRY_FILE" registry-file)))
+
+(define (read-offline-registry->vhash)
+  "Return a vhash mapping Elm \"package\" names to lists of available version
+strings."
+  (alist->vhash
+   (match (call-with-input-file (getenv "GUIX_ELM_OFFLINE_REGISTRY_FILE")
+            read-json)
+     (('@ . alist) alist))))
+
+(define (find-indirect-dependencies registry-vhash root-pkg root-version)
+  "Return the recursive dependencies of ROOT-PKG, an Elm \"package\" name, at
+version ROOT-VERSION as an alist mapping Elm \"package\" names to (single)
+versions.  The resulting alist will not include entries for
+%ESSENTIAL-ELM-PACKAGES or for ROOT-PKG itself.  The REGISTRY-VHASH is used in
+conjunction with the ELM_HOME environment variable to find dependencies."
+  (with-directory-excursion
+      (string-append (getenv "ELM_HOME")
+                     "/" (getenv "GUIX_ELM_VERSION")
+                     "/packages")
+    (define (get-dependencies pkg version acc)
+      (let* ((elm-json-alist
+              (match (call-with-input-file
+                         (string-append pkg "/" version "/elm.json")
+                       read-json)
+                (('@ . alist) alist)))
+             (deps-alist
+              (match (assoc-ref elm-json-alist "dependencies")
+                (('@ . alist) alist)))
+             (deps-names
+              (filter-map (match-lambda
+                            ((name . range)
+                             (and (not (member name %essential-elm-packages))
+                                  name)))
+                          deps-alist)))
+        (fold register-dependency acc deps-names)))
+    (define (register-dependency pkg acc)
+      ;; Using vhash-cons unconditionally would add duplicate entries,
+      ;; which would then cause problems when we must emit JSON.
+      ;; Plus, we can avoid needlessly duplicating work.
+      (if (vhash-assoc pkg acc)
+          acc
+          (match (vhash-assoc pkg registry-vhash)
+            ((_ version . _)
+             ;; in the rare case that multiple versions are present,
+             ;; just picking an arbitrary one seems to work well enough for now
+             (get-dependencies pkg version (vhash-cons pkg version acc))))))
+    (vlist->list
+     (get-dependencies root-pkg root-version vlist-null))))
+
+(define* (patch-application-dependencies #:key inputs #:allow-other-keys)
+  "Rewrites the \"elm.json\" file in the working directory---which must be of
+`\"type\":\"application\"`, not `\"type\":\"package\"`---to refer to the
+dependency versions actually provided via Guix.  The
+GUIX_ELM_OFFLINE_REGISTRY_FILE environment variable is used to find available
+versions."
+  (let* ((registry-vhash (read-offline-registry->vhash))
+         (rewrite-dep-version
+          (match-lambda
+            ((name . _)
+             (cons name (match (vhash-assoc name registry-vhash)
+                          ((_ version) ;; no dot
+                           version))))))
+         (rewrite-direct/indirect
+          (match-lambda
+            ;; a little checking to avoid confusing misuse with "package"
+            ;; project dependencies, which have a different shape
+            (((and key (or "direct" "indirect"))
+              '@ . alist)
+             `(,key @ ,@(map rewrite-dep-version alist)))))
+         (rewrite-json-section
+          (match-lambda
+            (((and key (or "dependencies" "test-dependencies"))
+              '@ . alist)
+             `(,key @ ,@(map rewrite-direct/indirect alist)))
+            ((k . v)
+             (cons k v))))
+         (rewrite-elm-json
+          (match-lambda
+            (('@ . alist)
+             `(@ ,@(map rewrite-json-section alist))))))
+    (with-atomic-file-replacement "elm.json"
+      (lambda (in out)
+        (write-json (rewrite-elm-json (read-json in))
+                    out)))
+    (patch-json-string-escapes "elm.json")))
+
+(define* (configure #:key native-inputs inputs #:allow-other-keys)
+  "Generate a trivial Elm \"application\" with a direct dependency on the Elm
+\"package\" currently being built."
+  (let* ((info (match (call-with-input-file "elm.json" read-json)
+                 (('@ . alist) alist)))
+         (name (getenv "GUIX_ELM_PKG_NAME"))
+         (version (getenv "GUIX_ELM_PKG_VERSION"))
+         (elm-home (getenv "ELM_HOME"))
+         (registry-vhash (read-offline-registry->vhash))
+         (app-dir (string-append elm-home "/../fake-app")))
+    (mkdir-p (string-append app-dir "/src"))
+    (with-directory-excursion app-dir
+      (call-with-output-file "elm.json"
+        (lambda (out)
+          (write-json
+           `(@ ("type" . "application")
+               ("source-directories" "src") ;; intentionally no dot
+               ("elm-version" . ,(getenv "GUIX_ELM_VERSION"))
+               ("dependencies"
+                @ ("direct"
+                   @ ,@(map (lambda (pkg)
+                              (match (vhash-assoc pkg registry-vhash)
+                                ((_ pkg-version . _)
+                                 (cons pkg
+                                       (if (equal? pkg name)
+                                           version
+                                           pkg-version)))))
+                            (if (member name %essential-elm-packages)
+                                %essential-elm-packages
+                                (cons name %essential-elm-packages))))
+                  ("indirect"
+                   @ ,@(if (member name %essential-elm-packages)
+                           '()
+                           (find-indirect-dependencies registry-vhash
+                                                       name
+                                                       version))))
+               ("test-dependencies"
+                @ ("direct" @)
+                  ("indirect" @)))
+           out)))
+      (patch-json-string-escapes  "elm.json")
+      (with-output-to-file "src/Main.elm"
+        ;; the most trivial possible elm program
+        (lambda ()
+          (display "module Main exposing (..)
+main : Program () () ()
+main = Platform.worker
+ { init = \\_ -> ( (), Cmd.none )
+ , update = \\_ -> \\_ -> ( (), Cmd.none )
+ , subscriptions = \\_ -> Sub.none }"))))))
+
+(define* (build #:key native-inputs inputs #:allow-other-keys)
+  "Run `elm make` to build the Elm \"application\" generated by CONFIGURE."
+  (with-directory-excursion (string-append (getenv "ELM_HOME") "/../fake-app")
+    (invoke (search-input-file (or native-inputs inputs) "/bin/elm")
+            "make"
+            "src/Main.elm")))
+
+(define* (check #:key tests? #:allow-other-keys)
+  "Does nothing, because the `elm-test` executable has not yet been packaged
+for Guix."
+  (when tests?
+    (display "elm-test has not yet been packaged for Guix\n")))
+
+(define* (install #:key outputs #:allow-other-keys)
+  "Installs the contents of the directory generated by STAGE, including any
+files added by BUILD, to the Guix package output."
+  (copy-recursively
+   (string-append (getenv "ELM_HOME") "/../staged")
+   (string-append (assoc-ref outputs "out") "/share/elm")))
+
+(define* (validate-compiled #:key outputs #:allow-other-keys)
+  "Checks that the files \"artifacts.dat\" and \"docs.json\" have been
+installed."
+  (let ((base (string-append "/share/elm/"
+                             (getenv "GUIX_ELM_VERSION")
+                             "/packages/"
+                             (getenv "GUIX_ELM_PKG_NAME")
+                             "/"
+                             (getenv "GUIX_ELM_PKG_VERSION")))
+        (expected '("artifacts.dat" "docs.json")))
+    (for-each (lambda (name)
+                (search-input-file outputs (string-append base "/" name)))
+              expected)))
+
+(define %standard-phases
+  (modify-phases gnu:%standard-phases
+    (add-after 'unpack 'prepare-elm-home prepare-elm-home)
+    (delete 'bootstrap)
+    (add-after 'patch-source-shebangs 'stage stage)
+    (add-after 'stage 'make-offline-registry-file make-offline-registry-file)
+    (replace 'configure configure)
+    (delete 'patch-generated-file-shebangs)
+    (replace 'build build)
+    (replace 'check check)
+    (replace 'install install)
+    (add-before 'validate-documentation-location 'validate-compiled
+      validate-compiled)))
+
+(define* (elm-build #:key inputs (phases %standard-phases)
+                    #:allow-other-keys #:rest args)
+  "Builds the given Elm project, applying all of the PHASES in order."
+  (apply gnu:gnu-build #:inputs inputs #:phases phases args))
diff --git a/guix/cpu.scm b/guix/cpu.scm
index a44cd082f1..83e7dc615c 100644
--- a/guix/cpu.scm
+++ b/guix/cpu.scm
@@ -62,31 +62,51 @@
       (lambda (port)
         (let loop ((vendor #f)
                    (family #f)
-                   (model #f))
+                   (model #f)
+                   (flags (set)))
           (match (read-line port)
             ((? eof-object?)
-             #f)
+             (cpu (utsname:machine (uname))
+                  vendor family model flags))
+            ;; vendor for x86_64 and i686
             ((? (prefix? "vendor_id") str)
              (match (string-tokenize str)
                (("vendor_id" ":" vendor)
-                (loop vendor family model))))
+                (loop vendor family model flags))))
+            ;; vendor for aarch64 and armhf
+            ((? (prefix? "CPU implementer") str)
+             (match (string-tokenize str)
+               (("CPU" "implementer" ":" vendor)
+                (loop vendor family model flags))))
+            ;; family for x86_64 and i686
             ((? (prefix? "cpu family") str)
              (match (string-tokenize str)
                (("cpu" "family" ":" family)
-                (loop vendor (string->number family) model))))
+                (loop vendor (string->number family) model flags))))
+            ;; model for x86_64 and i686
             ((? (prefix? "model") str)
              (match (string-tokenize str)
                (("model" ":" model)
-                (loop vendor family (string->number model)))
+                (loop vendor family (string->number model) flags))
                (_
-                (loop vendor family model))))
+                (loop vendor family model flags))))
+            ;; model for aarch64 and armhf
+            ((? (prefix? "CPU part") str)
+             (match (string-tokenize str)
+               (("CPU" "part" ":" model)
+                (loop vendor family (string->number (string-drop model 2) 16) flags))))
+            ;; flags for x86_64 and i686
             ((? (prefix? "flags") str)
              (match (string-tokenize str)
                (("flags" ":" flags ...)
-                (cpu (utsname:machine (uname))
-                     vendor family model (list->set flags)))))
+                (loop vendor family model (list->set flags)))))
+            ;; flags for aarch64 and armhf
+            ((? (prefix? "Features") str)
+             (match (string-tokenize str)
+               (("Features" ":" flags ...)
+                (loop vendor family model (list->set flags)))))
             (_
-             (loop vendor family model))))))))
+             (loop vendor family model flags))))))))
 
 (define (cpu->gcc-architecture cpu)
   "Return the architecture name, suitable for GCC's '-march' flag, that
@@ -191,6 +211,57 @@ corresponds to CPU, a record as returned by 'current-cpu'."
          ;; TODO: Recognize CENTAUR/CYRIX/NSC?
 
          "x86_64"))
+    ("aarch64"
+     ;; Transcribed from GCC's list of aarch64 processors in aarch64-cores.def
+     ;; What to do with big.LITTLE cores?
+     (match (cpu-vendor cpu)
+       ("0x41"
+        (match (cpu-model cpu)
+          ((or #xd02 #xd04 #xd03 #xd07 #xd08 #xd09)
+           "armv8-a")
+          ((or #xd05 #xd0a #xd0b #xd0e #xd0d #xd41 #xd42 #xd4b #xd46 #xd43 #xd44 #xd41 #xd0c #xd4a)
+           "armv8.2-a")
+          (#xd40
+           "armv8.4-a")
+          (#xd15
+           "armv8-r")
+          ((or #xd46 #xd47 #xd48 #xd49 #xd4f)
+           "armv9-a")))
+       ("0x42"
+        "armv8.1-a")
+       ("0x43"
+        (match (cpu-model cpu)
+          ((or #x0a0 #x0a1 #x0a2 #x0a3)
+           "armv8-a")
+          (#x0af
+           "armv8.1-a")
+          ((or #x0b0 #x0b1 #x0b2 #x0b3 #x0b4 #x0b5)
+           "armv8.2-a")
+          (#x0b8
+           "armv8.3-a")))
+       ("0x46"
+        "armv8.2-a")
+       ("0x48"
+        "armv8.2-a")
+       ("0x50"
+        "armv8-a")
+       ("0x51"
+        (match (cpu-model cpu)
+          (#xC00
+           "armv8-a")
+          (#x516
+           "armv8.1-a")
+          (#xC01
+           "armv8.4-a")))
+       ("0x53"
+        "armv8-a")
+       ("0x68"
+        "armv8-a")
+       ("0xC0"
+        "armv8.6-a")
+       (_
+        "armv8-a"))
+     "armv8-a")
     (architecture
-     ;; TODO: AArch64.
+     ;; TODO: More architectures
      architecture)))
diff --git a/guix/http-client.scm b/guix/http-client.scm
index a367c41afa..9138a627ac 100644
--- a/guix/http-client.scm
+++ b/guix/http-client.scm
@@ -296,6 +296,7 @@ returning."
                                   #f #f base64url-alphabet))))
 
 (define* (http-fetch/cached uri #:key (ttl (%http-cache-ttl)) text?
+                            (headers '((user-agent . "GNU Guile")))
                             (write-cache dump-port)
                             (cache-miss (const #t))
                             (log-port (current-error-port))
@@ -307,21 +308,27 @@ Call WRITE-CACHE with the HTTP input port and the cache output port to write
 the data to cache.  Call CACHE-MISS with URI just before fetching data from
 URI.
 
+HEADERS is an alist of extra HTTP headers, to which cache-related headers are
+added automatically as appropriate.
+
 TIMEOUT specifies the timeout in seconds for connection establishment.
 
 Write information about redirects to LOG-PORT."
-  (let ((file (cache-file-for-uri uri)))
+  (let* ((uri (if (string? uri)
+                  (string->uri uri)
+                  uri))
+         (file (cache-file-for-uri uri)))
     (define (update-cache cache-port)
       (define cache-time
         (and cache-port
              (stat:mtime (stat cache-port))))
 
-      (define headers
-        `((user-agent . "GNU Guile")
-          ,@(if cache-time
-                `((if-modified-since
-                   . ,(time-utc->date (make-time time-utc 0 cache-time))))
-                '())))
+      (define extended-headers
+        (if cache-time
+            `((if-modified-since
+               . ,(time-utc->date (make-time time-utc 0 cache-time)))
+              ,@headers)
+            headers))
 
       ;; Update the cache and return an input port.
       (guard (c ((http-get-error? c)
@@ -332,7 +339,8 @@ Write information about redirects to LOG-PORT."
                      (raise c))))
         (let ((port (http-fetch uri #:text? text?
                                 #:log-port log-port
-                                #:headers headers #:timeout timeout)))
+                                #:headers extended-headers
+                                #:timeout timeout)))
           (cache-miss uri)
           (mkdir-p (dirname file))
           (when cache-port
diff --git a/guix/import/elm.scm b/guix/import/elm.scm
new file mode 100644
index 0000000000..74902b8617
--- /dev/null
+++ b/guix/import/elm.scm
@@ -0,0 +1,210 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;;
+;;; 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 import elm)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
+  #:use-module (ice-9 vlist)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (guix utils)
+  #:use-module (guix base32)
+  #:use-module (guix hash)
+  #:use-module (guix http-client)
+  #:use-module (guix memoization)
+  #:use-module (guix diagnostics)
+  #:use-module (guix i18n)
+  #:use-module ((guix ui) #:select (display-hint))
+  #:use-module ((guix build utils)
+                #:select ((package-name->name+version
+                           . hyphen-package-name->name+version)
+                          find-files
+                          invoke))
+  #:use-module (guix import utils)
+  #:use-module (guix git)
+  #:use-module (guix import json)
+  #:autoload   (gcrypt hash) (hash-algorithm sha256)
+  #:use-module (json)
+  #:use-module (guix packages)
+  #:use-module (guix upstream)
+  #:use-module ((guix licenses) #:prefix license:)
+  #:use-module (guix build-system elm)
+  #:export (elm-recursive-import
+            %elm-package-registry
+            %current-elm-checkout
+            elm->guix-package))
+
+(define %registry-url
+  ;; It is much nicer to fetch this small (< 40 KB gzipped)
+  ;; file once than to do many HTTP requests.
+  "https://package.elm-lang.org/all-packages")
+
+(define %elm-package-registry
+  ;; This is a parameter to support both testing and memoization.
+  ;; In pseudo-code, it has the contract:
+  ;;     (parameter/c (-> json/c)
+  ;;                  (promise/c (vhash/c string? (listof string?))))
+  ;; To set the parameter, provide a thunk that returns a value suitable
+  ;; as an argument to 'json->registry-vhash'.  Accessing the parameter
+  ;; returns a promise wrapping the resulting vhash.
+  (make-parameter
+   (lambda ()
+     (cond
+      ((json-fetch %registry-url #:http-fetch http-fetch/cached))
+      (else
+       (raise (formatted-message
+               (G_ "error downloading Elm package registry from ~a")
+               %registry-url)))))
+   (lambda (thunk)
+     (delay (json->registry-vhash (thunk))))))
+
+(define (json->registry-vhash jsobject)
+  "Parse the '(json)' module's representation of the Elm package registry to a
+vhash mapping package names to lists of available versions, sorted from latest
+to oldest."
+  (fold (lambda (entry vh)
+          (match entry
+            ((name . vec)
+             (vhash-cons name
+                         (sort (vector->list vec) version>?)
+                         vh))))
+        vlist-null
+        jsobject))
+
+(define (json->direct-dependencies jsobject)
+  "Parse the '(json)' module's representation of an 'elm.json' file's
+'dependencies' or 'test-dependencies' field to a list of strings naming direct
+dependencies, handling both the 'package' and 'application' grammars."
+  (cond
+   ;; *unspecified*
+   ((not (pair? jsobject))
+    '())
+   ;; {"type":"application"}
+   ((every (match-lambda
+             (((or "direct" "indirect") (_ . _) ...)
+              #t)
+             (_
+              #f))
+           jsobject)
+    (map car (or (assoc-ref jsobject "direct") '())))
+   ;; {"type":"package"}
+   (else
+    (map car jsobject))))
+
+;; <project-info> handles both {"type":"package"} and {"type":"application"}
+(define-json-mapping <project-info> make-project-info project-info?
+  json->project-info
+  (dependencies project-info-dependencies
+                "dependencies" json->direct-dependencies)
+  (test-dependencies project-info-test-dependencies
+                     "test-dependencies" json->direct-dependencies)
+  ;; "synopsis" and "license" may be missing for {"type":"application"}
+  (synopsis project-info-synopsis
+            "summary" (lambda (x)
+                        (if (string? x)
+                            x
+                            "")))
+  (license project-info-license
+           "license" (lambda (x)
+                       (if (string? x)
+                           (spdx-string->license x)
+                           #f))))
+
+(define %current-elm-checkout
+  ;; This is a parameter for testing purposes.
+  (make-parameter
+   (lambda (name version)
+     (define-values (checkout _commit _relation)
+       ;; Elm requires that packages use this very specific format
+       (update-cached-checkout (string-append "https://github.com/" name)
+                               #:ref `(tag . ,version)))
+     checkout)))
+
+(define (make-elm-package-sexp name version)
+  "Return two values: the `package' s-expression for the Elm package with the
+given NAME and VERSION, and a list of Elm packages it depends on."
+  (define checkout
+    ((%current-elm-checkout) name version))
+  (define info
+    (call-with-input-file (string-append checkout "/elm.json")
+      json->project-info))
+  (define dependencies
+    (project-info-dependencies info))
+  (define test-dependencies
+    (project-info-test-dependencies info))
+  (define guix-name
+    (elm->package-name name))
+  (values
+   `(package
+      (name ,guix-name)
+      (version ,version)
+      (source (elm-package-origin
+               ,name
+               version ;; no ,
+               (base32
+                ,(bytevector->nix-base32-string
+                  (file-hash* checkout
+                              #:algorithm (hash-algorithm sha256)
+                              #:recursive? #t)))))
+      (build-system elm-build-system)
+      ,@(maybe-propagated-inputs (map elm->package-name dependencies))
+      ,@(maybe-inputs (map elm->package-name test-dependencies))
+      (home-page ,(string-append "https://package.elm-lang.org/packages/"
+                                 name "/" version))
+      (synopsis ,(project-info-synopsis info))
+      (description
+       ;; Try to use the first paragraph of README.md (which Elm requires),
+       ;; or fall back to synopsis otherwise.
+       ,(beautify-description
+         (match (chunk-lines (call-with-input-file
+                                 (string-append checkout "/README.md")
+                               read-lines))
+           ((_ par . _)
+            (string-join par " "))
+           (_
+            (project-info-synopsis info)))))
+      ,@(let ((inferred-name (infer-elm-package-name guix-name)))
+          (if (equal? inferred-name name)
+              '()
+              `((properties '((upstream-name . ,name))))))
+      (license ,(project-info-license info)))
+   (append dependencies test-dependencies)))
+
+(define elm->guix-package
+  (memoize
+   (lambda* (package-name #:key repo version)
+     "Fetch the metadata for PACKAGE-NAME, an Elm package registered at
+package.elm.org, and return two values: the `package' s-expression
+corresponding to that package (or #f on failure) and a list of Elm
+dependencies."
+     (cond
+      ((vhash-assoc package-name (force (%elm-package-registry)))
+       => (match-lambda
+            ((_found latest . _versions)
+             (make-elm-package-sexp package-name (or version latest)))))
+      (else
+       (values #f '()))))))
+
+(define* (elm-recursive-import package-name #:optional version)
+  (recursive-import package-name
+                    #:version version
+                    #:repo->guix-package elm->guix-package
+                    #:guix-name elm->package-name))
diff --git a/guix/import/json.scm b/guix/import/json.scm
index 0c98bb25b8..ae00ee929e 100644
--- a/guix/import/json.scm
+++ b/guix/import/json.scm
@@ -35,13 +35,16 @@
             json->scheme-file))
 
 (define* (json-fetch url
+                     #:key
+                     (http-fetch http-fetch)
                      ;; Note: many websites returns 403 if we omit a
                      ;; 'User-Agent' header.
-                     #:key (headers `((user-agent . "GNU Guile")
-                                      (Accept . "application/json"))))
+                     (headers `((user-agent . "GNU Guile")
+                                (Accept . "application/json"))))
   "Return a representation of the JSON resource URL (a list or hash table), or
 #f if URL returns 403 or 404.  HEADERS is a list of HTTP headers to pass in
-the query."
+the query.  HTTP-FETCH is called to perform the request: for example, to
+enable caching, supply 'http-fetch/cached'."
   (guard (c ((and (http-get-error? c)
                   (let ((error (http-get-error-code c)))
                     (or (= 403 error)
diff --git a/guix/import/utils.scm b/guix/import/utils.scm
index 9cadbb3d5f..26eebfece5 100644
--- a/guix/import/utils.scm
+++ b/guix/import/utils.scm
@@ -11,6 +11,7 @@
 ;;; Copyright © 2021 Sarah Morgensen <iskarian@mgsn.dev>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2022 Alice Brenon <alice.brenon@ens-lyon.fr>
+;;; Copyright © 2022 Kyle Meyer <kyle@kyleam.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -132,7 +133,7 @@ of the string VERSION is replaced by the symbol 'version."
   "Convert STR, a SPDX formatted license identifier, to a license object.
    Return #f if STR does not match any known identifiers."
   ;; https://spdx.org/licenses/
-  ;; The psfl, gfl1.0, nmap, repoze
+  ;; The gfl1.0, nmap, repoze
   ;; licenses doesn't have SPDX identifiers
   ;;
   ;; Please update guix/licenses.scm when modifying
@@ -143,14 +144,17 @@ of the string VERSION is replaced by the symbol 'version."
     ;; or "GPL-N-or-later" as appropriate.  Likewise for LGPL
     ;; and AGPL
     ("AGPL-1.0"                    'license:agpl1)
+    ("AGPL-1.0-only"               'license:agpl1)
     ("AGPL-3.0"                    'license:agpl3)
     ("AGPL-3.0-only"               'license:agpl3)
     ("AGPL-3.0-or-later"           'license:agpl3+)
     ("Apache-1.1"                  'license:asl1.1)
     ("Apache-2.0"                  'license:asl2.0)
+    ("APSL-2.0"                    'license:apsl2)
     ("BSL-1.0"                     'license:boost1.0)
     ("0BSD"                        'license:bsd-0)
-    ("BSD-2-Clause-FreeBSD"        'license:bsd-2)
+    ("BSD-2-Clause"                'license:bsd-2)
+    ("BSD-2-Clause-FreeBSD"        'license:bsd-2)     ;flagged as deprecated on spdx
     ("BSD-3-Clause"                'license:bsd-3)
     ("BSD-4-Clause"                'license:bsd-4)
     ("CC0-1.0"                     'license:cc0)
@@ -161,17 +165,30 @@ of the string VERSION is replaced by the symbol 'version."
     ("CC-BY-SA-3.0"                'license:cc-by-sa3.0)
     ("CC-BY-SA-4.0"                'license:cc-by-sa4.0)
     ("CDDL-1.0"                    'license:cddl1.0)
+    ("CDDL-1.1"                    'license:cddl1.1)
+    ("CECILL-2.1"                  'license:cecill)
+    ("CECILL-B"                    'license:cecill-b)
     ("CECILL-C"                    'license:cecill-c)
     ("Artistic-2.0"                'license:artistic2.0)
     ("ClArtistic"                  'license:clarified-artistic)
+    ("copyleft-next-0.3.0"         'license:copyleft-next)
     ("CPL-1.0"                     'license:cpl1.0)
     ("EPL-1.0"                     'license:epl1.0)
+    ("EPL-2.0"                     'license:epl2.0)
+    ("EUPL-1.2"                    'license:eupl1.2)
     ("MIT"                         'license:expat)
+    ("MIT-0"                       'license:expat-0)
     ("FTL"                         'license:freetype)
+    ("FreeBSD-DOC"                 'license:freebsd-doc)
     ("Freetype"                    'license:freetype)
+    ("FSFAP"                       'license:fsf-free)
+    ("FSFUL"                       'license:fsf-free)
     ("GFDL-1.1"                    'license:fdl1.1+)
+    ("GFDL-1.1-or-later"           'license:fdl1.1+)
     ("GFDL-1.2"                    'license:fdl1.2+)
+    ("GFDL-1.2-or-later"           'license:fdl1.2+)
     ("GFDL-1.3"                    'license:fdl1.3+)
+    ("GFDL-1.3-or-later"           'license:fdl1.3+)
     ("Giftware"                    'license:giftware)
     ("GPL-1.0"                     'license:gpl1)
     ("GPL-1.0-only"                'license:gpl1)
@@ -204,14 +221,24 @@ of the string VERSION is replaced by the symbol 'version."
     ("LGPL-3.0-only"               'license:lgpl3)
     ("LGPL-3.0+"                   'license:lgpl3+)
     ("LGPL-3.0-or-later"           'license:lgpl3+)
+    ("LPPL-1.0"                    'license:lppl)
+    ("LPPL-1.1"                    'license:lppl)
+    ("LPPL-1.2"                    'license:lppl1.2)
+    ("LPPL-1.3a"                   'license:lppl1.3a)
+    ("LPPL-1.3c"                   'license:lppl1.3c)
+    ("MirOS"                       'license:miros)
     ("MPL-1.0"                     'license:mpl1.0)
     ("MPL-1.1"                     'license:mpl1.1)
     ("MPL-2.0"                     'license:mpl2.0)
     ("MS-PL"                       'license:ms-pl)
     ("NCSA"                        'license:ncsa)
+    ("OGL-UK-1.0"                  'license:ogl-psi1.0)
     ("OpenSSL"                     'license:openssl)
     ("OLDAP-2.8"                   'license:openldap2.8)
+    ("OPL-1.0"                     'license:opl1.0+)
     ("CUA-OPL-1.0"                 'license:cua-opl1.0)
+    ("PSF-2.0"                     'license:psfl)
+    ("OSL-2.1"                     'license:osl2.1)
     ("QPL-1.0"                     'license:qpl)
     ("Ruby"                        'license:ruby)
     ("SGI-B-2.0"                   'license:sgifreeb2.0)
@@ -220,6 +247,9 @@ of the string VERSION is replaced by the symbol 'version."
     ("TCL"                         'license:tcl/tk)
     ("Unlicense"                   'license:unlicense)
     ("Vim"                         'license:vim)
+    ("W3C"                         'license:w3c)
+    ("WTFPL"                       'license:wtfpl2)
+    ("wxWindow"                    'license:wxwindows3.1+)         ;flagged as deprecated on spdx
     ("X11"                         'license:x11)
     ("ZPL-2.1"                     'license:zpl2.1)
     ("Zlib"                        'license:zlib)
diff --git a/guix/inferior.scm b/guix/inferior.scm
index 6949bb3687..54200b75e4 100644
--- a/guix/inferior.scm
+++ b/guix/inferior.scm
@@ -141,7 +141,11 @@ regular file port (socket).
 This is equivalent to (open-pipe* OPEN_BOTH ...) except that the result is a
 regular file port that can be passed to 'select' ('open-pipe*' returns a
 custom binary port)."
-  (match (socketpair AF_UNIX SOCK_STREAM 0)
+  ;; Make sure the sockets are close-on-exec; failing to do that, a second
+  ;; inferior (for instance) would inherit the underlying file descriptor, and
+  ;; thus (close-port PARENT) in the original process would have no effect:
+  ;; the REPL process wouldn't get EOF on standard input.
+  (match (socketpair AF_UNIX (logior SOCK_STREAM SOCK_CLOEXEC) 0)
     ((parent . child)
      (match (primitive-fork)
        (0
diff --git a/guix/licenses.scm b/guix/licenses.scm
index 82ca44f42e..3b820ae07e 100644
--- a/guix/licenses.scm
+++ b/guix/licenses.scm
@@ -19,6 +19,7 @@
 ;;; Copyright © 2021 Felix Gruber <felgru@posteo.net>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;; Copyright © 2021 Noisytoot <noisytoot@disroot.org>
+;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -57,7 +58,7 @@
             epl1.0
             epl2.0
             eupl1.2
-            expat
+            expat expat-0
             freetype
             freebsd-doc
             giftware
@@ -315,6 +316,13 @@ at URI, which may be a file:// URI pointing the package's tree."
            "http://directory.fsf.org/wiki/License:Expat"
            "https://www.gnu.org/licenses/license-list.html#Expat"))
 
+(define expat-0
+  (license "Expat No Attribution"
+           ;; Note: There is a later formulation of the same license at
+           ;; <https://github.com/aws/mit-0>.
+           "https://romanrm.net/mit-zero"
+           "Expat license with the attribution paragraph removed."))
+
 (define freetype
   (license "Freetype"
            "http://directory.fsf.org/wiki/License:Freetype"
diff --git a/guix/lint.scm b/guix/lint.scm
index e535eb8158..375f189335 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1348,7 +1348,11 @@ descriptions maintained upstream."
                                  (formatted-message-arguments c))))
                  (make-warning package
                                (G_ "failed to create ~a derivation: ~a")
-                               (list system str)))))
+                               (list system str))))
+              (else
+               (make-warning package
+                             (G_ "failed to create ~a derivation: ~a")
+                             (list system c))))
       (parameterize ((%graft? #f))
         (package-derivation store package system #:graft? #f)
 
diff --git a/guix/packages.scm b/guix/packages.scm
index a79b36d03d..7ee65e9b6b 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1618,6 +1618,11 @@ and return it."
                                  (&package-error
                                   (package package))))))))))))
 
+(define %package-graft-cache
+  ;; Cache mapping <package> records to <graft> records, for packages that
+  ;; have a replacement.
+  (allocate-store-connection-cache 'package-graft-cache))
+
 (define (input-graft system)
   "Return a monadic procedure that, given a package with a graft, returns a
 graft, and #f otherwise."
@@ -1626,9 +1631,8 @@ graft, and #f otherwise."
       (((? package? package) output)
        (let ((replacement (package-replacement package)))
          (if replacement
-             ;; XXX: We should use a separate cache instead of abusing the
-             ;; object cache.
-             (mcached (mlet %store-monad ((orig (package->derivation package system
+             (mcached eq? (=> %package-graft-cache)
+                      (mlet %store-monad ((orig (package->derivation package system
                                                                      #:graft? #f))
                                           (new  (package->derivation replacement system
                                                                      #:graft? #t)))
@@ -1637,7 +1641,7 @@ graft, and #f otherwise."
                                   (origin-output output)
                                   (replacement new)
                                   (replacement-output output))))
-                      package 'graft output system)
+                      package output system)
              (return #f))))
       (_
        (return #f)))))
diff --git a/guix/platform.scm b/guix/platform.scm
new file mode 100644
index 0000000000..361241cb2e
--- /dev/null
+++ b/guix/platform.scm
@@ -0,0 +1,139 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@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 platform)
+  #:use-module (guix discovery)
+  #:use-module (guix memoization)
+  #:use-module (guix records)
+  #:use-module (guix ui)
+  #:use-module (srfi srfi-1)
+  #:export (platform
+            platform?
+            platform-target
+            platform-system
+            platform-linux-architecture
+            platform-glibc-dynamic-linker
+
+            platform-modules
+            platforms
+            lookup-platform-by-system
+            lookup-platform-by-target
+            lookup-platform-by-target-or-system
+            platform-system->target
+            platform-target->system
+
+            systems
+            targets))
+
+
+;;;
+;;; Platform record.
+;;;
+
+;; Description of a platform supported by GNU Guix.
+;;
+;; The 'target' field must be a valid GNU triplet as defined here:
+;; https://www.gnu.org/software/autoconf/manual/autoconf-2.68/html_node/Specifying-Target-Triplets.html.
+;; It is used for cross-compilation purposes.
+;;
+;; The 'system' field is the name of the corresponding system as defined in
+;; the (gnu packages bootstrap) module.  It can be for instance
+;; "aarch64-linux" or "armhf-linux".  It is used to emulate a different host
+;; architecture, for instance i686-linux on x86_64-linux-gnu, or armhf-linux
+;; on x86_64-linux, using the QEMU binfmt transparent emulation mechanism.
+;;
+;; The 'linux-architecture' is only relevant if the kernel is Linux.  In that
+;; case, it corresponds to the ARCH variable used when building Linux.
+;;
+;; The 'glibc-dynamic-linker' field is the name of Glibc's dynamic linker for
+;; the corresponding system.
+(define-record-type* <platform> platform make-platform
+  platform?
+  (target               platform-target)
+  (system               platform-system)
+  (linux-architecture   platform-linux-architecture
+                        (default #f))
+  (glibc-dynamic-linker platform-glibc-dynamic-linker))
+
+
+;;;
+;;; Platforms.
+;;;
+
+(define (platform-modules)
+  "Return the list of platform modules."
+  (all-modules (map (lambda (entry)
+                      `(,entry . "guix/platforms"))
+                    %load-path)
+               #:warn warn-about-load-error))
+
+(define platforms
+  ;; The list of publically-known platforms.
+  (memoize
+   (lambda ()
+     (fold-module-public-variables (lambda (obj result)
+                                     (if (platform? obj)
+                                         (cons obj result)
+                                         result))
+                                   '()
+                                   (platform-modules)))))
+
+(define (lookup-platform-by-system system)
+  "Return the platform corresponding to the given SYSTEM."
+  (find (lambda (platform)
+          (let ((s (platform-system platform)))
+            (and (string? s) (string=? s system))))
+        (platforms)))
+
+(define (lookup-platform-by-target target)
+  "Return the platform corresponding to the given TARGET."
+  (find (lambda (platform)
+          (let ((t (platform-target platform)))
+            (and (string? t) (string=? t target))))
+        (platforms)))
+
+(define (lookup-platform-by-target-or-system target-or-system)
+  "Return the platform corresponding to the given TARGET or SYSTEM."
+  (or (lookup-platform-by-target target-or-system)
+      (lookup-platform-by-system target-or-system)))
+
+(define (platform-system->target system)
+  "Return the target matching the given SYSTEM if it exists or false
+otherwise."
+  (let ((platform (lookup-platform-by-system system)))
+    (and=> platform platform-target)))
+
+(define (platform-target->system target)
+  "Return the system matching the given TARGET if it exists or false
+otherwise."
+  (let ((platform (lookup-platform-by-target system)))
+    (and=> platform platform-system)))
+
+
+;;;
+;;; Systems & Targets.
+;;;
+
+(define (systems)
+  "Return the list of supported systems."
+  (delete-duplicates
+   (filter-map platform-system (platforms))))
+
+(define (targets)
+  "Return the list of supported targets."
+  (map platform-target (platforms)))
diff --git a/guix/platforms/arm.scm b/guix/platforms/arm.scm
new file mode 100644
index 0000000000..32c0fbc032
--- /dev/null
+++ b/guix/platforms/arm.scm
@@ -0,0 +1,37 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021 Mathieu Othacehe <othacehe@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 platforms arm)
+  #:use-module (guix platform)
+  #:use-module (guix records)
+  #:export (armv7-linux
+            aarch64-linux))
+
+(define armv7-linux
+  (platform
+   (target "arm-linux-gnueabihf")
+   (system "armhf-linux")
+   (linux-architecture "arm")
+   (glibc-dynamic-linker "/lib/ld-linux-armhf.so.3")))
+
+(define aarch64-linux
+  (platform
+   (target "aarch64-linux-gnu")
+   (system "aarch64-linux")
+   (linux-architecture "arm64")
+   (glibc-dynamic-linker "/lib/ld-linux-aarch64.so.1")))
diff --git a/guix/platforms/mips.scm b/guix/platforms/mips.scm
new file mode 100644
index 0000000000..e6fa9eb292
--- /dev/null
+++ b/guix/platforms/mips.scm
@@ -0,0 +1,29 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@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 platforms mips)
+  #:use-module (guix platform)
+  #:use-module (guix records)
+  #:export (mips64-linux))
+
+(define mips64-linux
+  (platform
+   (target "mips64el-linux-gnu")
+   (system "mips64el-linux")
+   (linux-architecture "mips")
+   (glibc-dynamic-linker "/lib/ld.so.1")))
diff --git a/guix/platforms/powerpc.scm b/guix/platforms/powerpc.scm
new file mode 100644
index 0000000000..9d0b343bc3
--- /dev/null
+++ b/guix/platforms/powerpc.scm
@@ -0,0 +1,37 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@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 platforms powerpc)
+  #:use-module (guix platform)
+  #:use-module (guix records)
+  #:export (powerpc-linux
+            powerpc64le-linux))
+
+(define powerpc-linux
+  (platform
+   (target "powerpc-linux-gnu")
+   (system "powerpc-linux")
+   (linux-architecture "powerpc")
+   (glibc-dynamic-linker "/lib/ld.so.1")))
+
+(define powerpc64le-linux
+  (platform
+   (target "powerpc64le-linux-gnu")
+   (system "powerpc64le-linux")
+   (linux-architecture "powerpc")
+   (glibc-dynamic-linker "/lib/ld64.so.2")))
diff --git a/guix/platforms/riscv.scm b/guix/platforms/riscv.scm
new file mode 100644
index 0000000000..c716c12c12
--- /dev/null
+++ b/guix/platforms/riscv.scm
@@ -0,0 +1,29 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@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 platforms riscv)
+  #:use-module (guix platform)
+  #:use-module (guix records)
+  #:export (riscv64-linux))
+
+(define riscv64-linux
+  (platform
+   (target "riscv64-linux-gnu")
+   (system "riscv64-linux")
+   (linux-architecture "riscv")
+   (glibc-dynamic-linker "/lib/ld-linux-riscv64-lp64d.so.1")))
diff --git a/guix/platforms/x86.scm b/guix/platforms/x86.scm
new file mode 100644
index 0000000000..5338049d6f
--- /dev/null
+++ b/guix/platforms/x86.scm
@@ -0,0 +1,58 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Mathieu Othacehe <othacehe@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 platforms x86)
+  #:use-module (guix platform)
+  #:use-module (guix records)
+  #:export (i686-linux
+            x86_64-linux
+            i686-mingw
+            x86_64-mingw
+            hurd))
+
+(define i686-linux
+  (platform
+   (target "i686-linux-gnu")
+   (system "i686-linux")
+   (linux-architecture "i386")
+   (glibc-dynamic-linker "/lib/ld-linux.so.2")))
+
+(define x86_64-linux
+  (platform
+   (target "x86_64-linux-gnu")
+   (system "x86_64-linux")
+   (linux-architecture "x86_64")
+   (glibc-dynamic-linker "/lib/ld-linux-x86-64.so.2")))
+
+(define i686-mingw
+  (platform
+   (target "i686-w64-mingw32")
+   (system #f)
+   (glibc-dynamic-linker #f)))
+
+(define x86_64-mingw
+  (platform
+   (target "x86_64-w64-mingw32")
+   (system #f)
+   (glibc-dynamic-linker #f)))
+
+(define hurd
+  (platform
+   (target "i586-pc-gnu")
+   (system "i586-gnu")
+   (glibc-dynamic-linker "/lib/ld.so.1")))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 3a547de492..bf50c00a1e 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -462,7 +462,9 @@ denoting a specific output of a package."
                  (propagated-inputs #$(map entry->gexp deps))
                  (search-paths #$(map search-path-specification->sexp
                                       search-paths))
-                 (properties . #$properties)))
+                 #$@(if (null? properties)
+                        #~()
+                        #~((properties . #$properties)))))
       (($ <manifest-entry> name version output package
                            (deps ...) (search-paths ...) _ (properties ...))
        #~(#$name #$version #$output
@@ -470,7 +472,9 @@ denoting a specific output of a package."
                  (propagated-inputs #$(map entry->gexp deps))
                  (search-paths #$(map search-path-specification->sexp
                                       search-paths))
-                 (properties . #$properties)))))
+                 #$@(if (null? properties)
+                        #~()
+                        #~((properties . #$properties)))))))
 
   (match manifest
     (($ <manifest> (entries ...))
diff --git a/guix/scripts/archive.scm b/guix/scripts/archive.scm
index f8678aa5f9..1e961c84e6 100644
--- a/guix/scripts/archive.scm
+++ b/guix/scripts/archive.scm
@@ -93,14 +93,14 @@ Export/import one or more packages from/to the store.\n"))
   (display (G_ "
   -S, --source           build the packages' source derivations"))
   (display (G_ "
-  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
-  (display (G_ "
-      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
-  (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
 
   (newline)
   (show-build-options-help)
+  (newline)
+  (show-cross-build-options-help)
+  (newline)
+  (show-native-build-options-help)
 
   (newline)
   (display (G_ "
@@ -166,14 +166,6 @@ Export/import one or more packages from/to the store.\n"))
          (option '(#\S "source") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'source? #t result)))
-         (option '(#\s "system") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'system arg
-                               (alist-delete 'system result eq?))))
-         (option '("target") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'target arg
-                               (alist-delete 'target result eq?))))
          (option '(#\e "expression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'expression arg result)))
@@ -186,7 +178,9 @@ Export/import one or more packages from/to the store.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
 
-         %standard-build-options))
+         (append %standard-build-options
+                 %standard-cross-build-options
+                 %standard-native-build-options)))
 
 (define (derivation-from-expression store str package-derivation
                                     system source?)
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index d9cdb6e5e0..75bbb701ae 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -21,6 +21,7 @@
 
 (define-module (guix scripts build)
   #:use-module (guix ui)
+  #:use-module (guix colors)
   #:use-module (guix scripts)
   #:autoload   (guix import json) (json->scheme-file)
   #:use-module (guix store)
@@ -47,6 +48,7 @@
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
   #:use-module (gnu packages)
+  #:use-module (guix platform)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module ((guix progress) #:select (current-terminal-columns))
   #:use-module ((guix build syscalls) #:select (terminal-columns))
@@ -54,9 +56,15 @@
   #:export (log-url
 
             %standard-build-options
+            %standard-cross-build-options
+            %standard-native-build-options
+
             set-build-options-from-command-line
             set-build-options-from-command-line*
+
             show-build-options-help
+            show-cross-build-options-help
+            show-native-build-options-help
 
             guix-build
             register-root
@@ -184,6 +192,18 @@ options handled by 'set-build-options-from-command-line', and listed in
   (display (G_ "
       --debug=LEVEL      produce debugging output at LEVEL")))
 
+(define (show-cross-build-options-help)
+  (display (G_ "
+      --list-targets     list available targets"))
+  (display (G_ "
+      --target=TRIPLET   cross-build for TRIPLET--e.g., \"aarch64-linux-gnu\"")))
+
+(define (show-native-build-options-help)
+  (display (G_ "
+      --list-systems     list available systems"))
+  (display (G_ "
+  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\"")))
+
 (define (set-build-options-from-command-line store opts)
   "Given OPTS, an alist as returned by 'args-fold' given
 '%standard-build-options', set the corresponding build options on STORE."
@@ -319,6 +339,59 @@ use '--no-offload' instead~%")))
                         (leave (G_ "not a number: '~a' option argument: ~a~%")
                                name arg)))))))
 
+(define (list-systems)
+  "Print the available systems."
+  (display (G_ "The available systems are:\n"))
+  (newline)
+  (let ((systems*
+         (map (lambda (system)
+                (if (string=? system (%current-system))
+                    (highlight
+                     (string-append system " [current]"))
+                    system))
+              (systems))))
+    (format #t "~{   - ~a ~%~}"
+            (sort systems* string<?))))
+
+(define (list-targets)
+  "Print the available targets."
+  (display (G_ "The available targets are:\n"))
+  (newline)
+  (format #t "~{   - ~a ~%~}"
+          (sort (targets) string<?)))
+
+(define %standard-cross-build-options
+  ;; Build options related to cross builds.
+  (list
+   (option '("list-targets") #f #f
+           (lambda (opt name arg result)
+             (list-targets)
+             (exit 0)))
+   (option '("target") #t #f
+           (lambda (opt name arg result . rest)
+             (let ((t (false-if-exception
+                       (first (member arg (targets))))))
+               (if t
+                   (apply values (alist-cons 'target t result) rest)
+                   (leave (G_ "'~a' is not a supported target~%")
+                          arg)))))))
+
+(define %standard-native-build-options
+  ;; Build options related to native builds.
+  (list
+   (option '("list-systems") #f #f
+           (lambda (opt name arg result)
+             (list-systems)
+             (exit 0)))
+   (option '(#\s "system") #t #f
+           (lambda (opt name arg result . rest)
+             (let ((s (false-if-exception
+                       (first (member arg (systems))))))
+               (if s
+                   (apply values (alist-cons 'system s result) rest)
+                   (leave (G_ "'~a' is not a supported system~%")
+                          arg)))))))
+
 
 ;;;
 ;;; Command-line options.
@@ -353,10 +426,6 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
       --sources[=TYPE]   build source derivations; TYPE may optionally be one
                          of \"package\", \"all\" (default), or \"transitive\""))
   (display (G_ "
-  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
-  (display (G_ "
-      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
-  (display (G_ "
   -d, --derivations      return the derivation paths of the given packages"))
   (display (G_ "
       --check            rebuild items to check for non-determinism issues"))
@@ -374,6 +443,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
   (newline)
   (show-build-options-help)
   (newline)
+  (show-cross-build-options-help)
+  (newline)
+  (show-native-build-options-help)
+  (newline)
   (show-transformation-options-help)
   (newline)
   (display (G_ "
@@ -420,13 +493,6 @@ must be one of 'package', 'all', or 'transitive'~%")
                           (alist-cons 'build-mode (build-mode repair)
                                       result)
                           rest)))
-         (option '(#\s "system") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'system arg result)))
-         (option '("target") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'target arg
-                               (alist-delete 'target result eq?))))
          (option '(#\d "derivations") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'derivations-only? #t result)))
@@ -459,7 +525,9 @@ must be one of 'package', 'all', or 'transitive'~%")
                    (alist-cons 'log-file? #t result)))
 
          (append %transformation-options
-                 %standard-build-options)))
+                 %standard-build-options
+                 %standard-cross-build-options
+                 %standard-native-build-options)))
 
 (define (options->things-to-build opts)
   "Read the arguments from OPTS and return a list of high-level objects to
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 07b54cd89b..3216235937 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -96,8 +96,6 @@ shell'."
   (display (G_ "
       --search-paths     display needed environment variable definitions"))
   (display (G_ "
-  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
-  (display (G_ "
   -r, --root=FILE        make FILE a symlink to the result, and register it
                          as a garbage collector root"))
   (display (G_ "
@@ -145,6 +143,8 @@ COMMAND or an interactive shell in that environment.\n"))
   (newline)
   (show-build-options-help)
   (newline)
+  (show-native-build-options-help)
+  (newline)
   (show-transformation-options-help)
   (newline)
   (display (G_ "
@@ -226,10 +226,6 @@ use '--preserve' instead~%"))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
-         (option '(#\s "system") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'system arg
-                               (alist-delete 'system result eq?))))
          (option '(#\C "container") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'container? #t result)))
@@ -273,7 +269,8 @@ use '--preserve' instead~%"))
                    (alist-cons 'bootstrap? #t result)))
 
          (append %transformation-options
-                 %standard-build-options)))
+                 %standard-build-options
+                 %standard-native-build-options)))
 
 (define (pick-all alist key)
   "Return a list of values in ALIST associated with KEY."
diff --git a/guix/scripts/graph.scm b/guix/scripts/graph.scm
index 535875c858..2f102180c9 100644
--- a/guix/scripts/graph.scm
+++ b/guix/scripts/graph.scm
@@ -39,7 +39,9 @@
                           options->transformation
                           %transformation-options))
   #:use-module ((guix scripts build)
-                #:select (%standard-build-options))
+                #:select (%standard-build-options
+                          %standard-native-build-options
+                          show-native-build-options-help))
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
@@ -504,10 +506,6 @@ package modules, while attempting to retain user package modules."
          (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
-                               (alist-delete 'system result eq?))))
          (find (lambda (option)
                 (member "load-path" (option-names option)))
               %standard-build-options)
@@ -519,7 +517,8 @@ package modules, while attempting to retain user package modules."
                  (lambda args
                    (show-version-and-exit "guix graph")))
 
-         %transformation-options))
+         (append %transformation-options
+                 %standard-native-build-options)))
 
 (define (show-help)
   ;; TRANSLATORS: Here 'dot' is the name of a program; it must not be
@@ -540,8 +539,6 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
       --path             display the shortest path between the given nodes"))
   (display (G_ "
   -e, --expression=EXPR  consider the package EXPR evaluates to"))
-  (display (G_ "
-  -s, --system=SYSTEM    consider the graph for SYSTEM--e.g., \"i686-linux\""))
   (newline)
   (display (G_ "
   -L, --load-path=DIR    prepend DIR to the package module search path"))
@@ -553,6 +550,8 @@ Emit a representation of the dependency graph of PACKAGE...\n"))
   (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
+  (show-native-build-options-help)
+  (newline)
   (show-bug-report-information))
 
 (define %default-options
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 40fa6759ae..fa79f3211e 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
+;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -80,7 +81,7 @@ rather than \\n."
 
 (define importers '("gnu" "pypi" "cpan" "hackage" "stackage" "egg" "elpa"
                     "gem" "go" "cran" "crate" "texlive" "json" "opam"
-                    "minetest"))
+                    "minetest" "elm"))
 
 (define (resolve-importer name)
   (let ((module (resolve-interface
diff --git a/guix/scripts/import/elm.scm b/guix/scripts/import/elm.scm
new file mode 100644
index 0000000000..68dcbf1070
--- /dev/null
+++ b/guix/scripts/import/elm.scm
@@ -0,0 +1,107 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2022 Philip McGrath <philip@philipmcgrath.com>
+;;;
+;;; 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 scripts import elm)
+  #:use-module (guix ui)
+  #:use-module (guix utils)
+  #:use-module (guix scripts)
+  #:use-module (guix import elm)
+  #:use-module (guix scripts import)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-37)
+  #:use-module (srfi srfi-71)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 format)
+  #:export (guix-import-elm))
+
+
+;;;
+;;; Command-line options.
+;;;
+
+(define %default-options
+  '())
+
+(define (show-help)
+  (display (G_ "Usage: guix import elm PACKAGE-NAME
+
+Import and convert the Elm package PACKAGE-NAME.  Optionally, a version
+can be specified after the arobas (@) character.\n"))
+  (display (G_ "
+  -h, --help             display this help and exit"))
+  (display (G_ "
+  -r, --recursive        import packages recursively"))
+  (display (G_ "
+  -V, --version          display version information and exit"))
+  (newline)
+  (show-bug-report-information))
+
+(define %options
+  ;; Specification of the command-line options.
+  (cons* (option '(#\h "help") #f #f
+                 (lambda args
+                   (show-help)
+                   (exit 0)))
+         (option '(#\V "version") #f #f
+                 (lambda args
+                   (show-version-and-exit "guix import elm")))
+         (option '(#\r "recursive") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'recursive #t result)))
+         %standard-import-options))
+
+
+;;;
+;;; Entry point.
+;;;
+
+(define (guix-import-elm . args)
+  (define (parse-options)
+    ;; Return the alist of option values.
+    (parse-command-line args %options (list %default-options)
+                        #:build-options? #f))
+
+  (let* ((opts (parse-options))
+         (args (filter-map (match-lambda
+                             (('argument . value)
+                              value)
+                             (_ #f))
+                           (reverse opts))))
+    (match args
+      ((spec)
+       (with-error-handling
+         (let ((name version (package-name->name+version spec)))
+           (if (assoc-ref opts 'recursive)
+               ;; Recursive import
+               (map (match-lambda
+                      ((and ('package ('name name) . rest) pkg)
+                       `(define-public ,(string->symbol name)
+                          ,pkg))
+                      (_ #f))
+                    (elm-recursive-import name version))
+               ;; Single import
+               (let ((sexp (elm->guix-package name #:version version)))
+                 (unless sexp
+                   (leave (G_ "failed to download meta-data for package '~a'~%")
+                          name))
+                 sexp)))))
+      (()
+       (leave (G_ "too few arguments~%")))
+      ((many ...)
+       (leave (G_ "too many arguments~%"))))))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index 32f0d3abb1..d3ee69840c 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -1244,17 +1244,9 @@ last resort for relocation."
          (option '(#\m "manifest") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'manifest arg result)))
-         (option '(#\s "system") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'system arg
-                               (alist-delete 'system result eq?))))
          (option '("entry-point") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'entry-point arg result)))
-         (option '("target") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'target arg
-                               (alist-delete 'target result eq?))))
          (option '(#\C "compression") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'compressor (lookup-compressor arg)
@@ -1305,13 +1297,19 @@ last resort for relocation."
 
          (append %deb-format-options
                  %transformation-options
-                 %standard-build-options)))
+                 %standard-build-options
+                 %standard-cross-build-options
+                 %standard-native-build-options)))
 
 (define (show-help)
   (display (G_ "Usage: guix pack [OPTION]... PACKAGE...
 Create a bundle of PACKAGE.\n"))
   (show-build-options-help)
   (newline)
+  (show-cross-build-options-help)
+  (newline)
+  (show-native-build-options-help)
+  (newline)
   (show-transformation-options-help)
   (newline)
   (show-deb-format-options)
@@ -1325,10 +1323,6 @@ Create a bundle of PACKAGE.\n"))
   (display (G_ "
   -e, --expression=EXPR  consider the package EXPR evaluates to"))
   (display (G_ "
-  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
-  (display (G_ "
-      --target=TRIPLET   cross-build for TRIPLET--e.g., \"armel-linux-gnu\""))
-  (display (G_ "
   -C, --compression=TOOL compress using TOOL--e.g., \"lzip\""))
   (display (G_ "
   -S, --symlink=SPEC     create symlinks to the profile according to SPEC"))
diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index d007005607..99a6cfaa29 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -10,6 +10,7 @@
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2020 Simon Tournier <zimon.toutoune@gmail.com>
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
+;;; Copyright © 2022 Josselin Poiret <dev@jpoiret.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -203,8 +204,12 @@ non-zero relevance score."
                (match m2
                  ((package2 . score2)
                   (if (= score1 score2)
-                      (string>? (package-full-name package1)
-                                (package-full-name package2))
+                      (if (string=? (package-name package1)
+                                    (package-name package2))
+                          (version>? (package-version package1)
+                                     (package-version package2))
+                          (string>? (package-name package1)
+                                    (package-name package2)))
                       (> score1 score2))))))))))
 
 (define (transaction-upgrade-entry store entry transaction)
@@ -694,10 +699,10 @@ the resulting manifest entry."
   (manifest-entry-with-provenance
    (package->manifest-entry package output)))
 
-(define (options->installable opts manifest transaction)
-  "Given MANIFEST, the current manifest, and OPTS, the result of 'args-fold',
-return an variant of TRANSACTION that accounts for the specified installations
-and upgrades."
+(define (options->installable opts manifest transform transaction)
+  "Given MANIFEST, the current manifest, OPTS, and TRANSFORM, the result of
+'args-fold', return an variant of TRANSACTION that accounts for the specified
+installations, upgrades and transformations."
   (define upgrade?
     (options->upgrade-predicate opts))
 
@@ -714,13 +719,14 @@ and upgrades."
                   (('install . (? package? p))
                    ;; When given a package via `-e', install the first of its
                    ;; outputs (XXX).
-                   (package->manifest-entry* p "out"))
+                   (package->manifest-entry* (transform p) "out"))
                   (('install . (? string? spec))
                    (if (store-path? spec)
                        (store-item->manifest-entry spec)
                        (let-values (((package output)
                                      (specification->package+output spec)))
-                         (package->manifest-entry* package output))))
+                         (package->manifest-entry* (transform package)
+                                                   output))))
                   (('install . obj)
                    (leave (G_ "cannot install non-package object: ~s~%")
                           obj))
@@ -979,16 +985,6 @@ processed, #f otherwise."
   (define profile  (or (assoc-ref opts 'profile) %current-profile))
   (define transform (options->transformation opts))
 
-  (define (transform-entry entry)
-    (let ((item (transform (manifest-entry-item entry))))
-      (manifest-entry-with-transformations
-       (manifest-entry
-         (inherit entry)
-         (item item)
-         (version (if (package? item)
-                      (package-version item)
-                      (manifest-entry-version entry)))))))
-
   (when (equal? profile %current-profile)
     ;; Normally the daemon created %CURRENT-PROFILE when we connected, unless
     ;; it's a version that lacks the fix for <https://bugs.gnu.org/37744>
@@ -1021,16 +1017,12 @@ processed, #f otherwise."
                              (map load-manifest files))))))
            (step1    (options->removable opts manifest
                                          (manifest-transaction)))
-           (step2    (options->installable opts manifest step1))
-           (step3    (manifest-transaction
-                      (inherit step2)
-                      (install (map transform-entry
-                                    (manifest-transaction-install step2)))))
-           (new      (manifest-perform-transaction manifest step3))
+           (step2    (options->installable opts manifest transform step1))
+           (new      (manifest-perform-transaction manifest step2))
            (trans    (if (null? files)
-                         step3
+                         step2
                          (fold manifest-transaction-install-entry
-                               step3
+                               step2
                                (manifest-entries manifest)))))
 
       (warn-about-old-distro)
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 7402782ff3..f01764637b 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -40,8 +40,6 @@
   #:use-module (guix scripts build)
   #:use-module (guix scripts describe)
   #:autoload   (guix build utils) (which mkdir-p)
-  #:use-module ((guix build syscalls)
-                #:select (with-file-lock/no-wait))
   #:use-module (guix git)
   #:use-module (git)
   #:autoload   (gnu packages) (fold-available-packages)
@@ -119,11 +117,12 @@ Download and deploy the latest version of Guix.\n"))
   (display (G_ "
   -v, --verbosity=LEVEL  use the given verbosity LEVEL"))
   (display (G_ "
-  -s, --system=SYSTEM    attempt to build for SYSTEM--e.g., \"i686-linux\""))
-  (display (G_ "
       --bootstrap        use the bootstrap Guile to build the new Guix"))
   (newline)
   (show-build-options-help)
+  (newline)
+  (show-native-build-options-help)
+  (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
@@ -184,10 +183,6 @@ Download and deploy the latest version of Guix.\n"))
                  (lambda (opt name arg result)
                    (alist-cons 'profile (canonicalize-profile arg)
                                result)))
-         (option '(#\s "system") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'system arg
-                               (alist-delete 'system result eq?))))
          (option '(#\n "dry-run") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'dry-run? #t result)))
@@ -208,7 +203,8 @@ Download and deploy the latest version of Guix.\n"))
                  (lambda args
                    (show-version-and-exit "guix pull")))
 
-         %standard-build-options))
+         (append %standard-build-options
+                 %standard-native-build-options)))
 
 (define (warn-about-backward-updates channel start commit relation)
   "Warn about non-forward updates of CHANNEL from START to COMMIT, without
diff --git a/guix/scripts/size.scm b/guix/scripts/size.scm
index e46983382a..5bb970443c 100644
--- a/guix/scripts/size.scm
+++ b/guix/scripts/size.scm
@@ -235,8 +235,6 @@ Report the size of the PACKAGE or STORE-ITEM, with its dependencies.\n"))
   (display (G_ "
       --substitute-urls=URLS
                          fetch substitute from URLS if they are authorized"))
-  (display (G_ "
-  -s, --system=SYSTEM    consider packages for SYSTEM--e.g., \"i686-linux\""))
   ;; TRANSLATORS: "closure" and "self" must not be translated.
   (display (G_ "
       --sort=KEY         sort according to KEY--\"closure\" or \"self\""))
@@ -251,15 +249,13 @@ Report the size of the PACKAGE or STORE-ITEM, with its dependencies.\n"))
   (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
+  (show-native-build-options-help)
+  (newline)
   (show-bug-report-information))
 
 (define %options
   ;; Specifications of the command-line options.
-  (list (option '(#\s "system") #t #f
-                (lambda (opt name arg result)
-                  (alist-cons 'system arg
-                              (alist-delete 'system result eq?))))
-        (option '("substitute-urls") #t #f
+  (cons* (option '("substitute-urls") #t #f
                 (lambda (opt name arg result . rest)
                   (apply values
                          (alist-cons 'substitute-urls
@@ -287,7 +283,8 @@ Report the size of the PACKAGE or STORE-ITEM, with its dependencies.\n"))
                   (exit 0)))
         (option '(#\V "version") #f #f
                 (lambda args
-                  (show-version-and-exit "guix size")))))
+                  (show-version-and-exit "guix size")))
+        %standard-native-build-options))
 
 (define %default-options
   `((system . ,(%current-system))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 73e3c299c1..eaa245eb44 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -66,7 +66,7 @@
                  (device-module-aliases matching-modules)
   #:use-module (gnu system linux-initrd)
   #:use-module (gnu image)
-  #:use-module (gnu platform)
+  #:use-module (guix platform)
   #:use-module (gnu system)
   #:use-module (gnu bootloader)
   #:use-module (gnu system file-systems)
diff --git a/guix/scripts/weather.scm b/guix/scripts/weather.scm
index adba614b8c..b7d8165262 100644
--- a/guix/scripts/weather.scm
+++ b/guix/scripts/weather.scm
@@ -40,6 +40,7 @@
   #:use-module (guix ci)
   #:use-module (guix sets)
   #:use-module (guix graph)
+  #:use-module (guix scripts build)
   #:autoload   (guix scripts graph) (%bag-node-type)
   #:use-module (gnu packages)
   #:use-module (web uri)
@@ -339,18 +340,18 @@ Report the availability of substitutes.\n"))
                          COUNT dependents"))
   (display (G_ "
       --display-missing  display the list of missing substitutes"))
-  (display (G_ "
-  -s, --system=SYSTEM    consider substitutes for SYSTEM--e.g., \"i686-linux\""))
   (newline)
   (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
   -V, --version          display version information and exit"))
   (newline)
+  (show-native-build-options-help)
+  (newline)
   (show-bug-report-information))
 
 (define %options
-  (list  (option '(#\h "help") #f #f
+  (cons* (option '(#\h "help") #f #f
                  (lambda args
                    (show-help)
                    (exit 0)))
@@ -380,9 +381,7 @@ Report the availability of substitutes.\n"))
          (option '("display-missing") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'display-missing? #t result)))
-         (option '(#\s "system") #t #f
-                 (lambda (opt name arg result)
-                   (alist-cons 'system arg result)))))
+         %standard-native-build-options))
 
 (define %default-options
   `((substitute-urls . ,%default-substitute-urls)))
diff --git a/guix/self.scm b/guix/self.scm
index 943bb0b498..9a64051c32 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -887,7 +887,8 @@ itself."
                    ,@(scheme-modules* source "gnu/bootloader")
                    ,@(scheme-modules* source "gnu/system")
                    ,@(scheme-modules* source "gnu/services")
-                   ,@(scheme-modules* source "gnu/machine"))
+                   ,@(scheme-modules* source "gnu/machine")
+                   ,@(scheme-modules* source "guix/platforms/"))
                  (list *core-package-modules* *package-modules*
                        *extra-modules* *core-modules*)
                  #:extensions dependencies
diff --git a/guix/store.scm b/guix/store.scm
index 1d176fb99d..82fca14cd9 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2020 Florian Pelz <pelzflorian@pelzflorian.de>
@@ -33,6 +33,7 @@
   #:use-module (gcrypt hash)
   #:use-module (guix profiling)
   #:autoload   (guix build syscalls) (terminal-columns)
+  #:autoload   (guix build utils) (dump-port)
   #:use-module (rnrs bytevectors)
   #:use-module (ice-9 binary-ports)
   #:use-module ((ice-9 control) #:select (let/ec))
@@ -682,29 +683,6 @@ automatically close the store when the dynamic extent of EXP is left."
   ;; The port where build output is sent.
   (make-parameter (current-error-port)))
 
-(define* (dump-port in out
-                    #:optional len
-                    #:key (buffer-size 16384))
-  "Read LEN bytes from IN (or as much as possible if LEN is #f) and write it
-to OUT, using chunks of BUFFER-SIZE bytes."
-  (define buffer
-    (make-bytevector buffer-size))
-
-  (let loop ((total 0)
-             (bytes (get-bytevector-n! in buffer 0
-                                       (if len
-                                           (min len buffer-size)
-                                           buffer-size))))
-    (or (eof-object? bytes)
-        (and len (= total len))
-        (let ((total (+ total bytes)))
-          (put-bytevector out buffer 0 bytes)
-          (loop total
-                (get-bytevector-n! in buffer 0
-                                   (if len
-                                       (min (- len total) buffer-size)
-                                       buffer-size)))))))
-
 (define %newlines
   ;; Newline characters triggering a flush of 'current-build-output-port'.
   ;; Unlike Guile's 'line, we flush upon #\return so that progress reports
@@ -1362,8 +1340,12 @@ object, only for build requests on EXPECTED-STORE."
         (unresolved things continue)
         (continue #t))))
 
+(define default-cutoff
+  ;; Default cutoff parameter for 'map/accumulate-builds'.
+  (make-parameter 32))
+
 (define* (map/accumulate-builds store proc lst
-                                #:key (cutoff 30))
+                                #:key (cutoff (default-cutoff)))
   "Apply PROC over each element of LST, accumulating 'build-things' calls and
 coalescing them into a single call.
 
@@ -1377,21 +1359,24 @@ CUTOFF is the threshold above which we stop accumulating unresolved nodes."
     (build-accumulator store))
 
   (define-values (result rest)
-    (let loop ((lst lst)
-               (result '())
-               (unresolved 0))
-      (match lst
-        ((head . tail)
-         (match (with-build-handler accumulator
-                  (proc head))
-           ((? unresolved? obj)
-            (if (>= unresolved cutoff)
-                (values (reverse (cons obj result)) tail)
-                (loop tail (cons obj result) (+ 1 unresolved))))
-           (obj
-            (loop tail (cons obj result) unresolved))))
-        (()
-         (values (reverse result) lst)))))
+    ;; Have the default cutoff decay as we go deeper in the call stack to
+    ;; avoid pessimal behavior.
+    (parameterize ((default-cutoff (quotient cutoff 2)))
+      (let loop ((lst lst)
+                 (result '())
+                 (unresolved 0))
+        (match lst
+          ((head . tail)
+           (match (with-build-handler accumulator
+                    (proc head))
+             ((? unresolved? obj)
+              (if (>= unresolved cutoff)
+                  (values (reverse (cons obj result)) tail)
+                  (loop tail (cons obj result) (+ 1 unresolved))))
+             (obj
+              (loop tail (cons obj result) unresolved))))
+          (()
+           (values (reverse result) lst))))))
 
   (match (append-map (lambda (obj)
                        (if (unresolved? obj)
@@ -1793,6 +1778,14 @@ This makes sense only when the daemon was started with '--cache-failures'."
 ;; the 'caches' vector of <store-connection>.
 (define %store-connection-caches (make-atomic-box 0))
 
+(define %max-store-connection-caches
+  ;; Maximum number of caches returned by 'allocate-store-connection-cache'.
+  32)
+
+(define %store-connection-cache-names
+  ;; Mapping of cache ID to symbol.
+  (make-vector %max-store-connection-caches))
+
 (define (allocate-store-connection-cache name)
   "Allocate a new cache for store connections and return its identifier.  Said
 identifier can be passed as an argument to "
@@ -1800,7 +1793,9 @@ identifier can be passed as an argument to "
     (let ((previous (atomic-box-compare-and-swap! %store-connection-caches
                                                   current (+ current 1))))
       (if (= previous current)
-          current
+          (begin
+            (vector-set! %store-connection-cache-names current name)
+            current)
           (loop current)))))
 
 (define %object-cache-id
@@ -1926,16 +1921,37 @@ whether the cache lookup was a hit, and the actual cache (a vhash)."
       (lambda (x y)
         #t)))
 
-(define record-cache-lookup!
-  (cache-lookup-recorder "object-cache" "Store object cache"))
-
-(define-inlinable (lookup-cached-object object keys vhash-fold*)
-  "Return the cached object in the store connection corresponding to OBJECT
+(define recorder-for-cache
+  (let ((recorders (make-vector %max-store-connection-caches)))
+    (lambda (cache-id)
+      "Return a procedure to record lookup stats for CACHE-ID."
+      (match (vector-ref recorders cache-id)
+        ((? unspecified?)
+         (let* ((name (symbol->string
+                       (vector-ref %store-connection-cache-names cache-id)))
+                (description
+                 (string-titlecase
+                  (string-map (match-lambda
+                                (#\- #\space)
+                                (chr chr))
+                              name))))
+           (let ((proc (cache-lookup-recorder name description)))
+             (vector-set! recorders cache-id proc)
+             proc)))
+        (proc proc)))))
+
+(define (record-cache-lookup! cache-id value cache)
+  "Record the lookup of VALUE in CACHE-ID, whose current value is CACHE."
+  (let ((record! (recorder-for-cache cache-id)))
+    (record! value cache)))
+
+(define-inlinable (lookup-cached-object cache-id object keys vhash-fold*)
+  "Return the object in store cache CACHE-ID corresponding to OBJECT
 and KEYS; use VHASH-FOLD* to look for OBJECT in the cache.  KEYS is a list of
 additional keys to match against, and which are compared with 'equal?'.
 Return #f on failure and the cached result otherwise."
   (lambda (store)
-    (let* ((cache (store-connection-cache store %object-cache-id))
+    (let* ((cache (store-connection-cache store cache-id))
 
            ;; Escape as soon as we find the result.  This avoids traversing
            ;; the whole vlist chain and significantly reduces the number of
@@ -1949,40 +1965,50 @@ Return #f on failure and the cached result otherwise."
                                           result))))
                                  #f object
                                  cache))))
-      (record-cache-lookup! value cache)
+      (record-cache-lookup! cache-id value cache)
       (values value store))))
 
 (define* (%mcached mthunk object #:optional (keys '())
                    #:key
+                   (cache %object-cache-id)
                    (vhash-cons vhash-consq)
                    (vhash-fold* vhash-foldq*))
   "Bind the monadic value returned by MTHUNK, which supposedly corresponds to
 OBJECT/KEYS, or return its cached value.  Use VHASH-CONS to insert OBJECT into
 the cache, and VHASH-FOLD* to look it up."
-  (mlet %store-monad ((cached (lookup-cached-object object keys
+  (mlet %store-monad ((cached (lookup-cached-object cache object keys
                                                     vhash-fold*)))
     (if cached
         (return cached)
         (>>= (mthunk)
              (lambda (result)
                (cache-object-mapping object keys result
+                                     #:cache cache
                                      #:vhash-cons vhash-cons))))))
 
 (define-syntax mcached
-  (syntax-rules (eq? equal?)
+  (syntax-rules (eq? equal? =>)
     "Run MVALUE, which corresponds to OBJECT/KEYS, and cache it; or return the
 value associated with OBJECT/KEYS in the store's object cache if there is
 one."
-    ((_ eq? mvalue object keys ...)
+    ((_ eq? (=> cache) mvalue object keys ...)
      (%mcached (lambda () mvalue)
                object (list keys ...)
+               #:cache cache
                #:vhash-cons vhash-consq
                #:vhash-fold* vhash-foldq*))
-    ((_ equal? mvalue object keys ...)
+    ((_ equal? (=> cache) mvalue object keys ...)
      (%mcached (lambda () mvalue)
                object (list keys ...)
+               #:cache cache
                #:vhash-cons vhash-cons
                #:vhash-fold* vhash-fold*))
+    ((_ eq? mvalue object keys ...)
+     (mcached eq? (=> %object-cache-id)
+              mvalue object keys ...))
+    ((_ equal? mvalue object keys ...)
+     (mcached equal? (=> %object-cache-id)
+              mvalue object keys ...))
     ((_ mvalue object keys ...)
      (mcached eq? mvalue object keys ...))))
 
diff --git a/guix/store/deduplication.scm b/guix/store/deduplication.scm
index 370df4a74c..ab982e3b3d 100644
--- a/guix/store/deduplication.scm
+++ b/guix/store/deduplication.scm
@@ -22,7 +22,7 @@
 
 (define-module (guix store deduplication)
   #:use-module (gcrypt hash)
-  #:use-module ((guix build utils) #:hide (dump-port))
+  #:use-module (guix build utils)
   #:use-module (guix build syscalls)
   #:use-module (guix base32)
   #:use-module (srfi srfi-11)
@@ -38,31 +38,6 @@
             dump-file/deduplicate
             copy-file/deduplicate))
 
-;; TODO: Remove once 'dump-port' in (guix build utils) has an optional 'len'
-;; parameter.
-(define* (dump-port in out
-                    #:optional len
-                    #:key (buffer-size 16384))
-  "Read LEN bytes from IN (or as much as possible if LEN is #f) and write it
-to OUT, using chunks of BUFFER-SIZE bytes."
-  (define buffer
-    (make-bytevector buffer-size))
-
-  (let loop ((total 0)
-             (bytes (get-bytevector-n! in buffer 0
-                                       (if len
-                                           (min len buffer-size)
-                                           buffer-size))))
-    (or (eof-object? bytes)
-        (and len (= total len))
-        (let ((total (+ total bytes)))
-          (put-bytevector out buffer 0 bytes)
-          (loop total
-                (get-bytevector-n! in buffer 0
-                                   (if len
-                                       (min (- len total) buffer-size)
-                                       buffer-size)))))))
-
 (define (nar-sha256 file)
   "Gives the sha256 hash of a file and the size of the file in nar form."
   (let-values (((port get-hash) (open-sha256-port)))