Merge branch 'staging' into core-updates

24 files changed, 1195 insertions, 675 deletions

diff --git a/guix/build-system/asdf.scm b/guix/build-system/asdf.scm
index a0f4634db0..74a3e47da1 100644
--- a/guix/build-system/asdf.scm
+++ b/guix/build-system/asdf.scm
@@ -1,7 +1,8 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
-;;; Copyright © 2019, 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2019, 2020, 2021, 2022 Guillaume Le Vaillant <glv@posteo.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -202,7 +203,7 @@ set up using CL source package conventions."
       (define base-arguments
         (if target-is-source?
             (strip-keyword-arguments
-             '(#:tests? #:asd-files #:lisp #:asd-systems #:test-asd-file)
+             '(#:tests? #:lisp #:asd-systems #:asd-test-systems #:asd-operation)
              (package-arguments pkg))
             (package-arguments pkg)))
 
@@ -270,9 +271,9 @@ set up using CL source package conventions."
   (lambda* (name inputs
                  #:key source outputs
                  (tests? #t)
-                 (asd-files ''())
                  (asd-systems ''())
-                 (test-asd-file #f)
+                 (asd-test-systems ''())
+                 (asd-operation "load-system")
                  (phases '%standard-phases)
                  (search-paths '())
                  (system (%current-system))
@@ -292,6 +293,11 @@ set up using CL source package conventions."
             `(quote ,(list package-name)))
           asd-systems))
 
+    (define test-systems
+      (if (null? (cadr asd-test-systems))
+          systems
+          asd-test-systems))
+
     (define builder
       (with-imported-modules imported-modules
         #~(begin
@@ -302,9 +308,9 @@ set up using CL source package conventions."
                            (%lisp-type #$lisp-type))
               (asdf-build #:name #$name
                           #:source #+source
-                          #:asd-files #$asd-files
                           #:asd-systems #$systems
-                          #:test-asd-file #$test-asd-file
+                          #:asd-test-systems #$test-systems
+                          #:asd-operation #$asd-operation
                           #:system #$system
                           #:tests? #$tests?
                           #:phases #$phases
diff --git a/guix/build-system/channel.scm b/guix/build-system/channel.scm
new file mode 100644
index 0000000000..6ad377f930
--- /dev/null
+++ b/guix/build-system/channel.scm
@@ -0,0 +1,78 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019-2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix build-system channel)
+  #:use-module ((guix store) #:select (%store-monad store-lift))
+  #:use-module ((guix gexp) #:select (lower-object))
+  #:use-module (guix monads)
+  #:use-module (guix channels)
+  #:use-module (guix build-system)
+  #:export (channel-build-system))
+
+;;; Commentary:
+;;;
+;;; The "channel" build system lets you build Guix instances from channel
+;;; specifications, similar to how 'guix time-machine' would do it, as regular
+;;; packages.
+;;;
+;;; Code:
+
+(define latest-channel-instances*
+  (store-lift latest-channel-instances))
+
+(define* (build-channels name inputs
+                         #:key source system commit
+                         (authenticate? #t)
+                         #:allow-other-keys)
+  (mlet* %store-monad ((instances
+                        (cond ((channel-instance? source)
+                               (return (list source)))
+                              ((channel? source)
+                               (latest-channel-instances*
+                                (list source)
+                                #:authenticate? authenticate?))
+                              ((string? source)
+                               ;; If SOURCE is a store file name, as is the
+                               ;; case when called from (gnu ci), return it as
+                               ;; is.
+                               (return
+                                (list (checkout->channel-instance
+                                       source #:commit commit))))
+                              (else
+                               (mlet %store-monad ((source
+                                                    (lower-object source)))
+                                 (return
+                                  (list (checkout->channel-instance
+                                         source #:commit commit))))))))
+    (channel-instances->derivation instances)))
+
+(define channel-build-system
+  ;; Build system used to "convert" a channel instance to a package.
+  (let ((lower (lambda* (name #:key system source commit (authenticate? #t)
+                              #:allow-other-keys)
+                 (bag
+                   (name name)
+                   (system system)
+                   (build build-channels)
+                   (arguments `(#:source ,source
+                                #:authenticate? ,authenticate?
+                                #:commit ,commit))))))
+    (build-system (name 'channel)
+                  (description "Turn a channel instance into a package.")
+                  (lower lower))))
+
diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm
index db0a916fb2..43ec2fdcb6 100644
--- a/guix/build-system/perl.scm
+++ b/guix/build-system/perl.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2013, 2014, 2015, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2022 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -29,13 +30,17 @@
   #:use-module (ice-9 match)
   #:export (%perl-build-system-modules
             perl-build
+            perl-cross-build
             perl-build-system))
 
 ;; Commentary:
 ;;
 ;; Standard build procedure for Perl packages using the "makefile
 ;; maker"---i.e., "perl Makefile.PL".  This is implemented as an extension of
-;; `gnu-build-system'.
+;; `gnu-build-system'.  Cross-compilation is supported for some simple Perl
+;; packages, but not for any Perl packages that do things like XS (Perl's FFI),
+;; which makes C-style shared libraries, as it is currently not known how to
+;; tell Perl to properly cross-compile.
 ;;
 ;; Code:
 
@@ -59,24 +64,44 @@
                 #:rest arguments)
   "Return a bag for NAME."
   (define private-keywords
-    '(#:target #:perl #:inputs #:native-inputs))
+    `(#:perl #:inputs #:native-inputs
+      ,@(if target '() '(#:target))))
 
-  (and (not target)                               ;XXX: no cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
+  (bag
+    (name name)
+    (system system) (target target)
+    (host-inputs `(,@(if source
+                         `(("source" ,source))
+                         '())
+                   ,@inputs
+                   ;; For interpreters in #! (shebang)
+                   ,@(if target
+                         `(("perl" ,perl))
+                         '())
 
-                        ;; Keep the standard inputs of 'gnu-build-system'.
-                        ,@(standard-packages)))
-         (build-inputs `(("perl" ,perl)
-                         ,@native-inputs))
-         (outputs outputs)
-         (build perl-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+                   ;; Keep the standard inputs of 'gnu-build-system'.
+                   ;; TODO: make this unconditional, putting this into
+                   ;; 'build-inputs'.
+                   ,@(if target
+                         '()
+                         (standard-packages))))
+    (build-inputs `(("perl" ,perl)
+                    ,@native-inputs
+                    ,@(if target
+                          (standard-cross-packages target 'host)
+                          '())
+                    ,@(if target
+                          (standard-packages)
+                          '())))
+    ;; Keep the standard inputs of 'gnu-build-system'.
+    (target-inputs (if target
+                       (standard-cross-packages target 'target)
+                       '()))
+    (outputs outputs)
+    (build (if target
+               perl-cross-build
+               perl-build))
+    (arguments (strip-keyword-arguments private-keywords arguments))))
 
 (define* (perl-build name inputs
                      #:key source
@@ -127,6 +152,69 @@ provides a `Makefile.PL' file as its build system."
     (gexp->derivation name build
                       #:system system
                       #:target #f
+                      #:graft? #f
+                      #:guile-for-build guile)))
+
+(define* (perl-cross-build name #:key
+                           source
+                           target
+                           build-inputs host-inputs target-inputs
+                           (search-paths '())
+                           (native-search-paths '())
+                           (tests? #f) ; usually not possible when cross-compiling
+                           (parallel-build? #t)
+                           (parallel-tests? #t)
+                           (make-maker? #f)
+                           (make-maker-flags ''())
+                           (module-build-flags ''())
+                           (phases '(@ (guix build perl-build-system)
+                                       %standard-phases))
+                           (outputs '("out"))
+                           (system (%current-system))
+                           (build (nix-system->gnu-triplet system))
+                           (guile #f)
+                           (imported-modules %perl-build-system-modules)
+                           (modules '((guix build perl-build-system)
+                                      (guix build utils))))
+  "Cross-build SOURCE to TARGET using PERL, and with INPUTS.  This assumes
+that SOURCE provides a `Makefile.PL' file as its build system and does not use
+XS or similar."
+  (define inputs
+    #~(append #$(input-tuples->gexp host-inputs)
+              #+(input-tuples->gexp target-inputs)))
+  (define builder
+    (with-imported-modules imported-modules
+      #~(begin
+          (use-modules #$@(sexp->gexp modules))
+          (perl-build #:name #$name
+                      #:source #+source
+                      #:search-paths '#$(sexp->gexp
+                                         (map search-path-specification->sexp
+                                              search-paths))
+                      #:native-search-paths
+                      '#$(sexp->gexp
+                          (map search-path-specification->sexp
+                               native-search-paths))
+                      #:make-maker? #$make-maker?
+                      #:make-maker-flags #$make-maker-flags
+                      #:module-build-flags #$(sexp->gexp module-build-flags)
+                      #:phases #$phases
+                      #:build #$build
+                      #:system #$system
+                      #:target #$target
+                      #:test-target "test"
+                      #:tests? #$tests?
+                      #:parallel-build? #$parallel-build?
+                      #:parallel-tests? #$parallel-tests?
+                      #:outputs #$(outputs->gexp outputs)
+                      #:inputs #$inputs
+                      #:native-inputs #+(input-tuples->gexp build-inputs)))))
+  (mlet %store-monad ((guile (package->derivation (or guile (default-guile))
+                                                  system #:graft? #f)))
+    (gexp->derivation name builder
+                      #:system system
+                      #:target target
+                      #:graft? #false
                       #:guile-for-build guile)))
 
 (define perl-build-system
diff --git a/guix/build-system/qt.scm b/guix/build-system/qt.scm
index a0b968cef3..a9bf728f25 100644
--- a/guix/build-system/qt.scm
+++ b/guix/build-system/qt.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2017 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
+;;; Copyright © 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -67,11 +68,19 @@
   (let ((module (resolve-interface '(gnu packages cmake))))
     (module-ref module 'cmake-minimal)))
 
+(define (default-qtbase)
+  "Return the default qtbase package."
+
+  ;; Do not use `@' to avoid introducing circular dependencies.
+  (let ((module (resolve-interface '(gnu packages qt))))
+    (module-ref module 'qtbase-5)))
+
 ;; This barely is a copy from (guix build-system cmake), only adjusted to use
 ;; the variables defined here.
 (define* (lower name
                 #:key source inputs native-inputs outputs system target
                 (cmake (default-cmake))
+                (qtbase (default-qtbase))
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
@@ -87,6 +96,7 @@
                           `(("source" ,source))
                           '())
                     ,@`(("cmake" ,cmake))
+                    ,@`(("qtbase" ,qtbase))
                     ,@native-inputs
                     ,@(if target
                           ;; Use the standard cross inputs of
@@ -112,6 +122,7 @@
 
 (define* (qt-build name inputs
                    #:key
+                   (qtbase (default-qtbase))
                    source (guile #f)
                    (outputs '("out")) (configure-flags ''())
                    (search-paths '())
@@ -150,6 +161,7 @@ provides a 'CMakeLists.txt' file as its build system."
                     #:phases #$(if (pair? phases)
                                    (sexp->gexp phases)
                                    phases)
+                    #:qtbase #+qtbase
                     #:qt-wrap-excluded-outputs #$qt-wrap-excluded-outputs
                     #:qt-wrap-excluded-inputs #$qt-wrap-excluded-inputs
                     #:configure-flags #$configure-flags
@@ -181,6 +193,7 @@ provides a 'CMakeLists.txt' file as its build system."
                          #:key
                          source target
                          build-inputs target-inputs host-inputs
+                         (qtbase (default-qtbase))
                          (guile #f)
                          (outputs '("out"))
                          (configure-flags ''())
@@ -237,6 +250,7 @@ build system."
                                               search-path-specification->sexp
                                               native-search-paths)
                     #:phases #$phases
+                    #:qtbase #+qtbase
                     #:configure-flags #$configure-flags
                     #:make-flags #$make-flags
                     #:out-of-source? #$out-of-source?
diff --git a/guix/build/asdf-build-system.scm b/guix/build/asdf-build-system.scm
index 6186613e52..92154e7d34 100644
--- a/guix/build/asdf-build-system.scm
+++ b/guix/build/asdf-build-system.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
-;;; Copyright © 2020, 2021 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020, 2021, 2022 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -78,16 +79,6 @@
     (,(library-directory object-output)
      :**/ :*.*.*)))
 
-(define (source-asd-file output name asd-file)
-  (string-append (lisp-source-directory output name) "/" asd-file))
-
-(define (find-asd-files output name asd-files)
-  (if (null? asd-files)
-      (find-files (lisp-source-directory output name) "\\.asd$")
-      (map (lambda (asd-file)
-             (source-asd-file output name asd-file))
-           asd-files)))
-
 (define (copy-files-to-output out name)
   "Copy all files from the current directory to OUT.  Create an extra link to
 any system-defining files in the source to a convenient location.  This is
@@ -190,7 +181,7 @@ if it's present in the native-inputs."
     (setenv "XDG_CONFIG_DIRS" (string-append out "/etc")))
   #t)
 
-(define* (build #:key outputs inputs asd-files asd-systems
+(define* (build #:key outputs inputs asd-systems asd-operation
                 #:allow-other-keys)
   "Compile the system."
   (let* ((out (library-output outputs))
@@ -198,26 +189,22 @@ if it's present in the native-inputs."
          (source-path (string-append out (%lisp-source-install-prefix)))
          (translations (wrap-output-translations
                         `(,(output-translation source-path
-                                               out))))
-         (asd-files (find-asd-files out system-name asd-files)))
+                                               out)))))
     (setenv "ASDF_OUTPUT_TRANSLATIONS"
             (replace-escaped-macros (format #f "~S" translations)))
     (setenv "HOME" out) ; ecl's asdf sometimes wants to create $HOME/.cache
-    (compile-systems asd-systems asd-files))
+    (compile-systems asd-systems
+                     (lisp-source-directory out system-name)
+                     asd-operation))
   #t)
 
-(define* (check #:key tests? outputs inputs asd-files asd-systems
-                test-asd-file
+(define* (check #:key tests? outputs inputs asd-test-systems
                 #:allow-other-keys)
   "Test the system."
   (let* ((out (library-output outputs))
-         (system-name (main-system-name out))
-         (asd-files (find-asd-files out system-name asd-files))
-         (test-asd-file
-          (and=> test-asd-file
-                 (cut source-asd-file out system-name <>))))
+         (system-name (main-system-name out)))
     (if tests?
-        (test-system (first asd-systems) asd-files test-asd-file)
+        (test-system asd-test-systems (lisp-source-directory out system-name))
         (format #t "test suite not run~%")))
   #t)
 
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 41583e8143..db0a39084b 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -245,6 +245,54 @@ way."
 (set-exception-printer! 'tls-certificate-error
                         print-tls-certificate-error)
 
+(define (wrap-record-port-for-gnutls<3.7.7 record port)
+  "Return a port that wraps RECORD to ensure that closing it also closes PORT,
+the actual socket port, and its file descriptor.  Make sure it does not
+introduce extra buffering (custom ports are buffered by default as of Guile
+3.0.5).
+
+This wrapper is unnecessary with GnuTLS >= 3.7.7, which can automatically
+close SESSION's file descriptor when RECORD is closed."
+  (define (read! bv start count)
+    (define read
+      (catch 'gnutls-error
+        (lambda ()
+          (get-bytevector-n! record bv start count))
+        (lambda (key err proc . rest)
+          ;; When responding to "Connection: close" requests, some servers
+          ;; close the connection abruptly after sending the response body,
+          ;; without doing a proper TLS connection termination.  Treat it as
+          ;; EOF.  This is fixed in GnuTLS 3.7.7.
+          (if (eq? err error/premature-termination)
+              the-eof-object
+              (apply throw key err proc rest)))))
+
+    (if (eof-object? read)
+        0
+        read))
+  (define (write! bv start count)
+    (put-bytevector record bv start count)
+    (force-output record)
+    count)
+  (define (get-position)
+    (port-position record))
+  (define (set-position! new-position)
+    (set-port-position! record new-position))
+  (define (close)
+    (unless (port-closed? port)
+      (close-port port))
+    (unless (port-closed? record)
+      (close-port record)))
+
+  (define (unbuffered port)
+    (setvbuf port 'none)
+    port)
+
+  (unbuffered
+   (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
+                                         get-position set-position!
+                                         close)))
+
 (define* (tls-wrap port server #:key (verify-certificate? #t))
   "Return PORT wrapped in a TLS connection to SERVER.  SERVER must be a DNS
 host name without trailing dot."
@@ -317,55 +365,13 @@ host name without trailing dot."
           (apply throw args))))
 
     (let ((record (session-record-port session)))
-      (define (read! bv start count)
-        (define read
-          (catch 'gnutls-error
-            (lambda ()
-              (get-bytevector-n! record bv start count))
-            (lambda (key err proc . rest)
-              ;; When responding to "Connection: close" requests, some
-              ;; servers close the connection abruptly after sending the
-              ;; response body, without doing a proper TLS connection
-              ;; termination.  Treat it as EOF.
-              (if (eq? err error/premature-termination)
-                  the-eof-object
-                  (apply throw key err proc rest)))))
-
-        (if (eof-object? read)
-            0
-            read))
-      (define (write! bv start count)
-        (put-bytevector record bv start count)
-        (force-output record)
-        count)
-      (define (get-position)
-        (port-position record))
-      (define (set-position! new-position)
-        (set-port-position! record new-position))
-      (define (close)
-        (unless (port-closed? port)
-          (close-port port))
-        (unless (port-closed? record)
-          (close-port record)))
-
-      (define (unbuffered port)
-        (setvbuf port 'none)
-        port)
-
       (setvbuf record 'block)
-
-      ;; Return a port that wraps RECORD to ensure that closing it also
-      ;; closes PORT, the actual socket port, and its file descriptor.
-      ;; Make sure it does not introduce extra buffering (custom ports
-      ;; are buffered by default as of Guile 3.0.5).
-      ;; XXX: This wrapper would be unnecessary if GnuTLS could
-      ;; automatically close SESSION's file descriptor when RECORD is
-      ;; closed, but that doesn't seem to be possible currently (as of
-      ;; 3.6.9).
-      (unbuffered
-       (make-custom-binary-input/output-port "gnutls wrapped port" read! write!
-                                             get-position set-position!
-                                             close)))))
+      (if (module-defined? (resolve-interface '(gnutls))
+                           'set-session-record-port-close!) ;GnuTLS >= 3.7.7
+          (let ((close-wrapped-port (lambda (_) (close-port port))))
+            (set-session-record-port-close! record close-wrapped-port)
+            record)
+          (wrap-record-port-for-gnutls<3.7.7 record port)))))
 
 (define (ensure-uri uri-or-string)                ;XXX: copied from (web http)
   (cond
@@ -744,6 +750,7 @@ otherwise simply ignore them."
                                          (progress-reporter/file
                                           (uri-abbreviation uri) size)))
               (newline)))
+          (close-port port)
           file)))
       ((ftp)
        (false-if-exception* (ftp-fetch uri file
diff --git a/guix/build/lisp-utils.scm b/guix/build/lisp-utils.scm
index 17d2637f87..646d4a3365 100644
--- a/guix/build/lisp-utils.scm
+++ b/guix/build/lisp-utils.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017 Andy Patterson <ajpatter@uwaterloo.ca>
-;;; Copyright © 2020 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2020, 2022 Guillaume Le Vaillant <glv@posteo.net>
+;;; Copyright © 2022 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -107,38 +108,31 @@ with PROGRAM."
              "--eval" "(quit)"))
     (_ (error "The LISP provided is not supported at this time."))))
 
-(define (compile-systems systems asd-files)
-  "Use a lisp implementation to compile the SYSTEMS using asdf.
-Load ASD-FILES first."
+(define (compile-systems systems directory operation)
+  "Use a lisp implementation to compile the SYSTEMS using asdf."
   (lisp-eval-program
    `((require :asdf)
-     ,@(map (lambda (asd-file)
-              `(asdf:load-asd (truename ,asd-file)))
-            asd-files)
+     (asdf:initialize-source-registry
+      (list :source-registry (list :tree (uiop:ensure-pathname ,directory
+                                                               :truenamize t
+                                                               :ensure-directory t))
+            :inherit-configuration))
      ,@(map (lambda (system)
-              `(asdf:compile-system ,system))
+              (list (string->symbol (string-append "asdf:" operation)) system))
             systems))))
 
-(define (test-system system asd-files test-asd-file)
-  "Use a lisp implementation to test SYSTEM using asdf.  Load ASD-FILES first.
-Also load TEST-ASD-FILE if necessary."
+(define (test-system test-systems directory)
+  "Use a lisp implementation to test the TEST-SYSTEMS using asdf."
   (lisp-eval-program
    `((require :asdf)
-     ,@(map (lambda (asd-file)
-              `(asdf:load-asd (truename ,asd-file)))
-            asd-files)
-     ,@(if test-asd-file
-           `((asdf:load-asd (truename ,test-asd-file)))
-           ;; Try some likely files.
-           (map (lambda (file)
-                  `(when (uiop:file-exists-p ,file)
-                     (asdf:load-asd (truename ,file))))
-                (list
-                 (string-append system "-tests.asd")
-                 (string-append system "-test.asd")
-                 "tests.asd"
-                 "test.asd")))
-     (asdf:test-system ,system))))
+     (asdf:initialize-source-registry
+      (list :source-registry (list :tree (uiop:ensure-pathname ,directory
+                                                               :truenamize t
+                                                               :ensure-directory t))
+            :inherit-configuration))
+     ,@(map (lambda (system)
+              `(asdf:test-system ,system))
+            test-systems))))
 
 (define (string->lisp-keyword . strings)
   "Return a lisp keyword for the concatenation of STRINGS."
diff --git a/guix/build/qt-utils.scm b/guix/build/qt-utils.scm
index b9c5a76f34..b8ecfedd43 100644
--- a/guix/build/qt-utils.scm
+++ b/guix/build/qt-utils.scm
@@ -3,7 +3,7 @@
 ;;; Copyright © 2019, 2020, 2021 Hartmut Goebel <h.goebel@crazy-compilers.com>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
-;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
+;;; Copyright © 2021, 2022 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Brendan Tildesley <mail@brendan.scot>
 ;;;
 ;;; This file is part of GNU Guix.
@@ -26,10 +26,13 @@
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
+  #:use-module (srfi srfi-71)
   #:export (wrap-qt-program
             wrap-all-qt-programs
             %qt-wrap-excluded-inputs))
 
+(define %default-qt-major-version "5")
+
 (define %qt-wrap-excluded-inputs
   '(list "cmake" "extra-cmake-modules" "qttools"))
 
@@ -37,7 +40,9 @@
 ;; facilities for per-application data directories, such as
 ;; /share/quassel. Thus, we include the output directory even if it doesn't
 ;; contain any of the standard subdirectories.
-(define (variables-for-wrapping base-directories output-directory)
+(define* (variables-for-wrapping base-directories output-directory
+                                 #:key
+                                 (qt-major-version %default-qt-major-version))
 
   (define (collect-sub-dirs base-directories file-type subdirectory selectors)
     ;; Append SUBDIRECTORY and each of BASE-DIRECTORIES, and return the subset
@@ -82,17 +87,20 @@
       "/applications" "/cursors" "/fonts" "/icons" "/glib-2.0/schemas"
       "/mime" "/sounds" "/themes" "/wallpapers")
     '("XDG_CONFIG_DIRS" suffix directory "/etc/xdg")
-    ;; The following variables can be extended by the user, but not
-    ;; overridden, to ensure proper operation.
-    '("QT_PLUGIN_PATH" prefix directory "/lib/qt5/plugins")
-    '("QML2_IMPORT_PATH" prefix directory "/lib/qt5/qml")
+    ;; We wrap exactly to avoid potentially mixing Qt5/Qt6 components, which
+    ;; would cause warnings, perhaps problems.
+    `("QT_PLUGIN_PATH" = directory
+      ,(format #f "/lib/qt~a/plugins" qt-major-version))
+    `("QML2_IMPORT_PATH" = directory
+      ,(format #f "/lib/qt~a/qml" qt-major-version))
     ;; QTWEBENGINEPROCESS_PATH accepts a single value, which makes 'exact the
     ;; most suitable environment variable type for it.
-    '("QTWEBENGINEPROCESS_PATH" = regular
-      "/lib/qt5/libexec/QtWebEngineProcess"))))
+    `("QTWEBENGINEPROCESS_PATH" = regular
+      ,(format #f "/lib/qt~a/libexec/QtWebEngineProcess" qt-major-version)))))
 
 (define* (wrap-qt-program* program #:key sh inputs output-dir
-                           qt-wrap-excluded-inputs)
+                           qt-wrap-excluded-inputs
+                           (qt-major-version %default-qt-major-version))
 
   (define input-directories
     (filter-map
@@ -104,12 +112,14 @@
 
   (let ((vars-to-wrap (variables-for-wrapping
                        (cons output-dir input-directories)
-                       output-dir)))
+                       output-dir
+                       #:qt-major-version qt-major-version)))
     (when (not (null? vars-to-wrap))
       (apply wrap-program program #:sh sh vars-to-wrap))))
 
 (define* (wrap-qt-program program-name #:key (sh (which "bash")) inputs output
-                          (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs))
+                          (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
+                          (qt-major-version %default-qt-major-version))
   "Wrap the specified program (which must reside in the OUTPUT's \"/bin\"
 directory) with suitably set environment variables.
 
@@ -118,9 +128,11 @@ is wrapped."
   (wrap-qt-program* (string-append output "/bin/" program-name)
                     #:sh sh
                     #:output-dir output #:inputs inputs
-                    #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs))
+                    #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
+                    #:qt-major-version qt-major-version))
 
 (define* (wrap-all-qt-programs #:key (sh (which "bash")) inputs outputs
+                               qtbase
                                (qt-wrap-excluded-outputs '())
                                (qt-wrap-excluded-inputs %qt-wrap-excluded-inputs)
                                #:allow-other-keys)
@@ -132,6 +144,15 @@ Wrapping is not applied to outputs whose name is listed in
 QT-WRAP-EXCLUDED-OUTPUTS.  This is useful when an output is known not
 to contain any Qt binaries, and where wrapping would gratuitously
 add a dependency of that output on Qt."
+  (define qt-major-version
+    (if qtbase
+        (let ((_ version (package-name->name+version
+                          (strip-store-file-name qtbase))))
+          (first (string-split version #\.)))
+        ;; Provide a fall-back for build systems not having a #:qtbase
+        ;; argument.
+        %default-qt-major-version))
+
   (define (find-files-to-wrap output-dir)
     (append-map
      (lambda (dir)
@@ -151,7 +172,8 @@ add a dependency of that output on Qt."
         (for-each (cut wrap-qt-program* <>
                        #:sh sh
                        #:output-dir output-dir #:inputs inputs
-                       #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs)
+                       #:qt-wrap-excluded-inputs qt-wrap-excluded-inputs
+                       #:qt-major-version qt-major-version)
                   (find-files-to-wrap output-dir))))))
 
   (for-each handle-output outputs))
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index a7401fd73f..eda487f52e 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -8,6 +8,7 @@
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2021 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2022 Oleg Pykhalov <go.wigust@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -49,6 +50,7 @@
             MS_RELATIME
             MS_BIND
             MS_MOVE
+            MS_SHARED
             MS_LAZYTIME
             MNT_FORCE
             MNT_DETACH
@@ -537,6 +539,7 @@ the last argument of `mknod'."
 (define MS_NOATIME         1024)
 (define MS_BIND            4096)
 (define MS_MOVE            8192)
+(define MS_SHARED       1048576)
 (define MS_RELATIME     2097152)
 (define MS_STRICTATIME 16777216)
 (define MS_LAZYTIME    33554432)
diff --git a/guix/channels.scm b/guix/channels.scm
index 689b30e0eb..ad6d3fb8ac 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -77,6 +77,7 @@
             %default-guix-channel
             %default-channels
             guix-channel?
+            repository->guix-channel
 
             channel-instance?
             channel-instance-channel
@@ -202,6 +203,26 @@ introduction, add it."
                (introduction %guix-channel-introduction))
       chan))
 
+(define* (repository->guix-channel directory
+                                   #:key
+                                   (introduction %guix-channel-introduction))
+  "Look for a Git repository in DIRECTORY or its ancestors and return a
+channel that uses that repository and the commit HEAD currently points to; use
+INTRODUCTION as the channel's introduction.  Return #f if no Git repository
+could be found at DIRECTORY or one of its ancestors."
+  (catch 'git-error
+    (lambda ()
+      (with-repository (repository-discover directory) repository
+        (let* ((head   (repository-head repository))
+               (commit (oid->string (reference-target head))))
+          (channel
+           (inherit %default-guix-channel)
+           (url (repository-working-directory repository))
+           (commit commit)
+           (branch (reference-shorthand head))
+           (introduction introduction)))))
+    (const #f)))
+
 (define-record-type <channel-instance>
   (channel-instance channel commit checkout)
   channel-instance?
@@ -1132,7 +1153,11 @@ NEW.  When OLD is omitted or is #f, return all the news entries of CHANNEL."
         (if (and news-file (file-exists? news-file))
             (with-repository checkout repository
               (let* ((news    (call-with-input-file news-file
-                                read-channel-news))
+                                (lambda (port)
+                                  (set-port-encoding! port
+                                                      (or (file-encoding port)
+                                                          "UTF-8"))
+                                  (read-channel-news port))))
                      (entries (map (lambda (entry)
                                      (resolve-channel-news-entry-tag repository
                                                                      entry))
diff --git a/guix/lint.scm b/guix/lint.scm
index 2b89f6a02a..7d6fd5ee7e 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -492,7 +492,7 @@ of a package, and INPUT-NAMES, a list of package specifications such as
             "kdoctools"
             "libtool"
             "m4"
-            "qttools"
+            "qttools-5"
             "yasm" "nasm" "fasm"
             "python-coverage"
             "python-cython"
@@ -507,7 +507,7 @@ of a package, and INPUT-NAMES, a list of package specifications such as
             "scdoc"
             "swig"
             "qmake"
-            "qttools"
+            "qttools-5"
             "texinfo"
             "xorg-server-for-tests"
             "yelp-tools")))
diff --git a/guix/read-print.scm b/guix/read-print.scm
new file mode 100644
index 0000000000..63ff9ca5bd
--- /dev/null
+++ b/guix/read-print.scm
@@ -0,0 +1,696 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2021-2022 Ludovic Courtès <ludo@gnu.org>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix read-print)
+  #:use-module (ice-9 control)
+  #:use-module (ice-9 match)
+  #:use-module (ice-9 rdelim)
+  #:use-module (ice-9 vlist)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (guix i18n)
+  #:use-module ((guix diagnostics)
+                #:select (formatted-message
+                          &fix-hint &error-location
+                          location))
+  #:export (pretty-print-with-comments
+            pretty-print-with-comments/splice
+            read-with-comments
+            read-with-comments/sequence
+            object->string*
+
+            blank?
+
+            vertical-space
+            vertical-space?
+            vertical-space-height
+            canonicalize-vertical-space
+
+            page-break
+            page-break?
+
+            comment
+            comment?
+            comment->string
+            comment-margin?
+            canonicalize-comment))
+
+;;; Commentary:
+;;;
+;;; This module provides a comment-preserving reader and a comment-preserving
+;;; pretty-printer smarter than (ice-9 pretty-print).
+;;;
+;;; Code:
+
+
+;;;
+;;; Comment-preserving reader.
+;;;
+
+(define <blank>
+  ;; The parent class for "blanks".
+  (make-record-type '<blank> '()
+                    (lambda (obj port)
+                      (format port "#<blank ~a>"
+                              (number->string (object-address obj) 16)))
+                    #:extensible? #t))
+
+(define blank? (record-predicate <blank>))
+
+(define <vertical-space>
+  (make-record-type '<vertical-space> '(height)
+                    #:parent <blank>
+                    #:extensible? #f))
+
+(define vertical-space?       (record-predicate <vertical-space>))
+(define vertical-space        (record-type-constructor <vertical-space>))
+(define vertical-space-height (record-accessor <vertical-space> 'height))
+
+(define canonicalize-vertical-space
+  (let ((unit (vertical-space 1)))
+    (lambda (space)
+      "Return a vertical space corresponding to a single blank line."
+      unit)))
+
+(define <page-break>
+  (make-record-type '<page-break> '()
+                    #:parent <blank>
+                    #:extensible? #f))
+
+(define page-break?           (record-predicate <page-break>))
+(define page-break
+  (let ((break ((record-type-constructor <page-break>))))
+    (lambda ()
+      break)))
+
+
+(define <comment>
+  ;; Comments.
+  (make-record-type '<comment> '(str margin?)
+                    #:parent <blank>
+                    #:extensible? #f))
+
+(define comment?        (record-predicate <comment>))
+(define string->comment (record-type-constructor <comment>))
+(define comment->string (record-accessor <comment> 'str))
+(define comment-margin? (record-accessor <comment> 'margin?))
+
+(define* (comment str #:optional margin?)
+  "Return a new comment made from STR.  When MARGIN? is true, return a margin
+comment; otherwise return a line comment.  STR must start with a semicolon and
+end with newline, otherwise an error is raised."
+  (when (or (string-null? str)
+            (not (eqv? #\; (string-ref str 0)))
+            (not (string-suffix? "\n" str)))
+    (raise (condition
+            (&message (message "invalid comment string")))))
+  (string->comment str margin?))
+
+(define char-set:whitespace-sans-page-break
+  ;; White space, excluding #\page.
+  (char-set-difference char-set:whitespace (char-set #\page)))
+
+(define (space? chr)
+  "Return true if CHR is white space, except for page breaks."
+  (char-set-contains? char-set:whitespace-sans-page-break chr))
+
+(define (read-vertical-space port)
+  "Read from PORT until a non-vertical-space character is met, and return a
+single <vertical-space> record."
+  (let loop ((height 1))
+    (match (read-char port)
+      (#\newline (loop (+ 1 height)))
+      ((? eof-object?) (vertical-space height))
+      ((? space?) (loop height))
+      (chr (unread-char chr port) (vertical-space height)))))
+
+(define (read-until-end-of-line port)
+  "Read white space from PORT until the end of line, included."
+  (let loop ()
+    (match (read-char port)
+      (#\newline #t)
+      ((? eof-object?) #t)
+      ((? space?) (loop))
+      (chr (unread-char chr port)))))
+
+(define* (read-with-comments port #:key (blank-line? #t))
+  "Like 'read', but include <blank> objects when they're encountered.  When
+BLANK-LINE? is true, assume PORT is at the beginning of a new line."
+  ;; Note: Instead of implementing this functionality in 'read' proper, which
+  ;; is the best approach long-term, this code is a layer on top of 'read',
+  ;; such that we don't have to rely on a specific Guile version.
+  (define dot (list 'dot))
+  (define (dot? x) (eq? x dot))
+
+  (define (missing-closing-paren-error)
+    (raise (make-compound-condition
+            (formatted-message (G_ "unexpected end of file"))
+            (condition
+             (&error-location
+              (location (match (port-filename port)
+                          (#f #f)
+                          (file (location file
+                                          (port-line port)
+                                          (port-column port))))))
+             (&fix-hint
+              (hint (G_ "Did you forget a closing parenthesis?")))))))
+
+  (define (reverse/dot lst)
+    ;; Reverse LST and make it an improper list if it contains DOT.
+    (let loop ((result '())
+               (lst lst))
+      (match lst
+        (() result)
+        (((? dot?) . rest)
+         (let ((dotted (reverse rest)))
+           (set-cdr! (last-pair dotted) (car result))
+           dotted))
+        ((x . rest) (loop (cons x result) rest)))))
+
+  (let loop ((blank-line? blank-line?)
+             (return (const 'unbalanced)))
+    (match (read-char port)
+      ((? eof-object? eof)
+       eof)                                       ;oops!
+      (chr
+       (cond ((eqv? chr #\newline)
+              (if blank-line?
+                  (read-vertical-space port)
+                  (loop #t return)))
+             ((eqv? chr #\page)
+              ;; Assume that a page break is on a line of its own and read
+              ;; subsequent white space and newline.
+              (read-until-end-of-line port)
+              (page-break))
+             ((char-set-contains? char-set:whitespace chr)
+              (loop blank-line? return))
+             ((memv chr '(#\( #\[))
+              (let/ec return
+                (let liip ((lst '()))
+                  (define item
+                    (loop (match lst
+                            (((? blank?) . _) #t)
+                            (_ #f))
+                          (lambda ()
+                            (return (reverse/dot lst)))))
+                  (if (eof-object? item)
+                      (missing-closing-paren-error)
+                      (liip (cons item lst))))))
+             ((memv chr '(#\) #\]))
+              (return))
+             ((eq? chr #\')
+              (list 'quote (loop #f return)))
+             ((eq? chr #\`)
+              (list 'quasiquote (loop #f return)))
+             ((eq? chr #\,)
+              (list (match (peek-char port)
+                      (#\@
+                       (read-char port)
+                       'unquote-splicing)
+                      (_
+                       'unquote))
+                    (loop #f return)))
+             ((eqv? chr #\;)
+              (unread-char chr port)
+              (string->comment (read-line port 'concat)
+                               (not blank-line?)))
+             (else
+              (unread-char chr port)
+              (match (read port)
+                ((and token '#{.}#)
+                 (if (eq? chr #\.) dot token))
+                (token token))))))))
+
+(define (read-with-comments/sequence port)
+  "Read from PORT until the end-of-file is reached and return the list of
+expressions and blanks that were read."
+  (let loop ((lst '())
+             (blank-line? #t))
+    (match (read-with-comments port #:blank-line? blank-line?)
+      ((? eof-object?)
+       (reverse! lst))
+      ((? blank? blank)
+       (loop (cons blank lst) #t))
+      (exp
+       (loop (cons exp lst) #f)))))
+
+
+;;;
+;;; Comment-preserving pretty-printer.
+;;;
+
+(define-syntax vhashq
+  (syntax-rules (quote)
+    ((_) vlist-null)
+    ((_ (key (quote (lst ...))) rest ...)
+     (vhash-consq key '(lst ...) (vhashq rest ...)))
+    ((_ (key value) rest ...)
+     (vhash-consq key '((() . value)) (vhashq rest ...)))))
+
+(define %special-forms
+  ;; Forms that are indented specially.  The number is meant to be understood
+  ;; like Emacs' 'scheme-indent-function' symbol property.  When given an
+  ;; alist instead of a number, the alist gives "context" in which the symbol
+  ;; is a special form; for instance, context (modify-phases) means that the
+  ;; symbol must appear within a (modify-phases ...) expression.
+  (vhashq
+   ('begin 1)
+   ('case 2)
+   ('cond 1)
+   ('lambda 2)
+   ('lambda* 2)
+   ('match-lambda 1)
+   ('match-lambda* 2)
+   ('define 2)
+   ('define* 2)
+   ('define-public 2)
+   ('define*-public 2)
+   ('define-syntax 2)
+   ('define-syntax-rule 2)
+   ('define-module 2)
+   ('define-gexp-compiler 2)
+   ('let 2)
+   ('let* 2)
+   ('letrec 2)
+   ('letrec* 2)
+   ('match 2)
+   ('when 2)
+   ('unless 2)
+   ('package 1)
+   ('origin 1)
+   ('modify-inputs 2)
+   ('modify-phases 2)
+   ('add-after '(((modify-phases) . 3)))
+   ('add-before '(((modify-phases) . 3)))
+   ('replace '(((modify-phases) . 2)))         ;different from 'modify-inputs'
+   ('substitute* 2)
+   ('substitute-keyword-arguments 2)
+   ('call-with-input-file 2)
+   ('call-with-output-file 2)
+   ('with-output-to-file 2)
+   ('with-input-from-file 2)
+   ('with-directory-excursion 2)
+
+   ;; (gnu system) and (gnu services).
+   ('operating-system 1)
+   ('bootloader-configuration 1)
+   ('mapped-device 1)
+   ('file-system 1)
+   ('swap-space 1)
+   ('user-account 1)
+   ('user-group 1)
+   ('setuid-program 1)
+   ('modify-services 2)
+
+   ;; (gnu home).
+   ('home-environment 1)))
+
+(define %newline-forms
+  ;; List heads that must be followed by a newline.  The second argument is
+  ;; the context in which they must appear.  This is similar to a special form
+  ;; of 1, except that indent is 1 instead of 2 columns.
+  (vhashq
+   ('arguments '(package))
+   ('sha256 '(origin source package))
+   ('base32 '(sha256 origin))
+   ('git-reference '(uri origin source))
+   ('search-paths '(package))
+   ('native-search-paths '(package))
+   ('search-path-specification '())
+
+   ('services '(operating-system))
+   ('set-xorg-configuration '())
+   ('services '(home-environment))))
+
+(define (prefix? candidate lst)
+  "Return true if CANDIDATE is a prefix of LST."
+  (let loop ((candidate candidate)
+             (lst lst))
+    (match candidate
+      (() #t)
+      ((head1 . rest1)
+       (match lst
+         (() #f)
+         ((head2 . rest2)
+          (and (equal? head1 head2)
+               (loop rest1 rest2))))))))
+
+(define (special-form-lead symbol context)
+  "If SYMBOL is a special form in the given CONTEXT, return its number of
+arguments; otherwise return #f.  CONTEXT is a stack of symbols lexically
+surrounding SYMBOL."
+  (match (vhash-assq symbol %special-forms)
+    (#f #f)
+    ((_ . alist)
+     (any (match-lambda
+            ((prefix . level)
+             (and (prefix? prefix context) (- level 1))))
+          alist))))
+
+(define (newline-form? symbol context)
+  "Return true if parenthesized expressions starting with SYMBOL must be
+followed by a newline."
+  (match (vhash-assq symbol %newline-forms)
+    (#f #f)
+    ((_ . prefix)
+     (prefix? prefix context))))
+
+(define (escaped-string str)
+  "Return STR with backslashes and double quotes escaped.  Everything else, in
+particular newlines, is left as is."
+  (list->string
+   `(#\"
+     ,@(string-fold-right (lambda (chr lst)
+                            (match chr
+                              (#\" (cons* #\\ #\" lst))
+                              (#\\ (cons* #\\ #\\ lst))
+                              (_   (cons chr lst))))
+                          '()
+                          str)
+     #\")))
+
+(define (string-width str)
+  "Return the \"width\" of STR--i.e., the width of the longest line of STR."
+  (apply max (map string-length (string-split str #\newline))))
+
+(define (canonicalize-comment comment indent)
+  "Canonicalize COMMENT, which is to be printed at INDENT, ensuring it has the
+\"right\" number of leading semicolons."
+  (if (zero? indent)
+      comment                              ;leave top-level comments unchanged
+      (let ((line (string-trim-both
+                   (string-trim (comment->string comment) (char-set #\;)))))
+        (string->comment (string-append
+                          (if (comment-margin? comment)
+                              ";"
+                              (if (string-null? line)
+                                  ";;"            ;no trailing space
+                                  ";; "))
+                          line "\n")
+                         (comment-margin? comment)))))
+
+(define %not-newline
+  (char-set-complement (char-set #\newline)))
+
+(define (print-multi-line-comment str indent port)
+  "Print to PORT STR as a multi-line comment, with INDENT spaces preceding
+each line except the first one (they're assumed to be already there)."
+
+  ;; While 'read-with-comments' only returns one-line comments, user-provided
+  ;; comments might span multiple lines, which is why this is necessary.
+  (let loop ((lst (string-tokenize str %not-newline)))
+    (match lst
+      (() #t)
+      ((last)
+       (display last port)
+       (newline port))
+      ((head tail ...)
+       (display head port)
+       (newline port)
+       (display (make-string indent #\space) port)
+       (loop tail)))))
+
+(define* (pretty-print-with-comments port obj
+                                     #:key
+                                     (format-comment
+                                      (lambda (comment indent) comment))
+                                     (format-vertical-space identity)
+                                     (indent 0)
+                                     (max-width 78)
+                                     (long-list 5))
+  "Pretty-print OBJ to PORT, attempting to at most MAX-WIDTH character columns
+and assuming the current column is INDENT.  Comments present in OBJ are
+included in the output.
+
+Lists longer than LONG-LIST are written as one element per line.  Comments are
+passed through FORMAT-COMMENT before being emitted; a useful value for
+FORMAT-COMMENT is 'canonicalize-comment'.  Vertical space is passed through
+FORMAT-VERTICAL-SPACE; a useful value of 'canonicalize-vertical-space'."
+  (define (list-of-lists? head tail)
+    ;; Return true if HEAD and TAIL denote a list of lists--e.g., a list of
+    ;; 'let' bindings.
+    (match head
+      ((thing _ ...)                              ;proper list
+       (and (not (memq thing
+                       '(quote quasiquote unquote unquote-splicing)))
+            (pair? tail)))
+      (_ #f)))
+
+  (let loop ((indent indent)
+             (column indent)
+             (delimited? #t)                  ;true if comes after a delimiter
+             (context '())                    ;list of "parent" symbols
+             (obj obj))
+    (define (print-sequence context indent column lst delimited?)
+      (define long?
+        (> (length lst) long-list))
+
+      (let print ((lst lst)
+                  (first? #t)
+                  (delimited? delimited?)
+                  (column column))
+        (match lst
+          (()
+           column)
+          ((item . tail)
+           (define newline?
+             ;; Insert a newline if ITEM is itself a list, or if TAIL is long,
+             ;; but only if ITEM is not the first item.  Also insert a newline
+             ;; before a keyword.
+             (and (or (pair? item) long?
+                      (and (keyword? item)
+                           (not (eq? item #:allow-other-keys))))
+                  (not first?) (not delimited?)
+                  (not (blank? item))))
+
+           (when newline?
+             (newline port)
+             (display (make-string indent #\space) port))
+           (let ((column (if newline? indent column)))
+             (print tail
+                    (keyword? item)      ;keep #:key value next to one another
+                    (blank? item)
+                    (loop indent column
+                          (or newline? delimited?)
+                          context
+                          item)))))))
+
+    (define (sequence-would-protrude? indent lst)
+      ;; Return true if elements of LST written at INDENT would protrude
+      ;; beyond MAX-WIDTH.  This is implemented as a cheap test with false
+      ;; negatives to avoid actually rendering all of LST.
+      (find (match-lambda
+              ((? string? str)
+               (>= (+ (string-width str) 2 indent) max-width))
+              ((? symbol? symbol)
+               (>= (+ (string-width (symbol->string symbol)) indent)
+                   max-width))
+              ((? boolean?)
+               (>= (+ 2 indent) max-width))
+              (()
+               (>= (+ 2 indent) max-width))
+              (_                                  ;don't know
+               #f))
+            lst))
+
+    (define (special-form? head)
+      (special-form-lead head context))
+
+    (match obj
+      ((? comment? comment)
+       (if (comment-margin? comment)
+           (begin
+             (display " " port)
+             (display (comment->string (format-comment comment indent))
+                      port))
+           (begin
+             ;; When already at the beginning of a line, for example because
+             ;; COMMENT follows a margin comment, no need to emit a newline.
+             (unless (= column indent)
+               (newline port)
+               (display (make-string indent #\space) port))
+             (print-multi-line-comment (comment->string
+                                        (format-comment comment indent))
+                                       indent port)))
+       (display (make-string indent #\space) port)
+       indent)
+      ((? vertical-space? space)
+       (unless delimited? (newline port))
+       (let loop ((i (vertical-space-height (format-vertical-space space))))
+         (unless (zero? i)
+           (newline port)
+           (loop (- i 1))))
+       (display (make-string indent #\space) port)
+       indent)
+      ((? page-break?)
+       (unless delimited? (newline port))
+       (display #\page port)
+       (newline port)
+       (display (make-string indent #\space) port)
+       indent)
+      (('quote lst)
+       (unless delimited? (display " " port))
+       (display "'" port)
+       (loop indent (+ column (if delimited? 1 2)) #t context lst))
+      (('quasiquote lst)
+       (unless delimited? (display " " port))
+       (display "`" port)
+       (loop indent (+ column (if delimited? 1 2)) #t context lst))
+      (('unquote lst)
+       (unless delimited? (display " " port))
+       (display "," port)
+       (loop indent (+ column (if delimited? 1 2)) #t context lst))
+      (('unquote-splicing lst)
+       (unless delimited? (display " " port))
+       (display ",@" port)
+       (loop indent (+ column (if delimited? 2 3)) #t context lst))
+      (('gexp lst)
+       (unless delimited? (display " " port))
+       (display "#~" port)
+       (loop indent (+ column (if delimited? 2 3)) #t context lst))
+      (('ungexp obj)
+       (unless delimited? (display " " port))
+       (display "#$" port)
+       (loop indent (+ column (if delimited? 2 3)) #t context obj))
+      (('ungexp-native obj)
+       (unless delimited? (display " " port))
+       (display "#+" port)
+       (loop indent (+ column (if delimited? 2 3)) #t context obj))
+      (('ungexp-splicing lst)
+       (unless delimited? (display " " port))
+       (display "#$@" port)
+       (loop indent (+ column (if delimited? 3 4)) #t context lst))
+      (('ungexp-native-splicing lst)
+       (unless delimited? (display " " port))
+       (display "#+@" port)
+       (loop indent (+ column (if delimited? 3 4)) #t context lst))
+      (((? special-form? head) arguments ...)
+       ;; Special-case 'let', 'lambda', 'modify-inputs', etc. so the second
+       ;; and following arguments are less indented.
+       (let* ((lead    (special-form-lead head context))
+              (context (cons head context))
+              (head    (symbol->string head))
+              (total   (length arguments)))
+         (unless delimited? (display " " port))
+         (display "(" port)
+         (display head port)
+         (unless (zero? lead)
+           (display " " port))
+
+         ;; Print the first LEAD arguments.
+         (let* ((indent (+ column 2
+                                  (if delimited? 0 1)))
+                (column (+ column 1
+                                  (if (zero? lead) 0 1)
+                                  (if delimited? 0 1)
+                                  (string-length head)))
+                (initial-indent column))
+           (define new-column
+             (let inner ((n lead)
+                         (arguments (take arguments (min lead total)))
+                         (column column))
+               (if (zero? n)
+                   (begin
+                     (newline port)
+                     (display (make-string indent #\space) port)
+                     indent)
+                   (match arguments
+                     (() column)
+                     ((head . tail)
+                      (inner (- n 1) tail
+                             (loop initial-indent column
+                                   (= n lead)
+                                   context
+                                   head)))))))
+
+           ;; Print the remaining arguments.
+           (let ((column (print-sequence
+                          context indent new-column
+                          (drop arguments (min lead total))
+                          #t)))
+             (display ")" port)
+             (+ column 1)))))
+      ((head tail ...)
+       (let* ((overflow? (>= column max-width))
+              (column    (if overflow?
+                             (+ indent 1)
+                             (+ column (if delimited? 1 2))))
+              (newline?  (or (newline-form? head context)
+                             (list-of-lists? head tail))) ;'let' bindings
+              (context   (cons head context)))
+         (if overflow?
+             (begin
+               (newline port)
+               (display (make-string indent #\space) port))
+             (unless delimited? (display " " port)))
+         (display "(" port)
+
+         (let* ((new-column (loop column column #t context head))
+                (indent (if (or (>= new-column max-width)
+                                (not (symbol? head))
+                                (sequence-would-protrude?
+                                 (+ new-column 1) tail)
+                                newline?)
+                            column
+                            (+ new-column 1))))
+           (when newline?
+             ;; Insert a newline right after HEAD.
+             (newline port)
+             (display (make-string indent #\space) port))
+
+           (let ((column
+                  (print-sequence context indent
+                                  (if newline? indent new-column)
+                                  tail newline?)))
+             (display ")" port)
+             (+ column 1)))))
+      (_
+       (let* ((str (if (string? obj)
+                       (escaped-string obj)
+                       (object->string obj)))
+              (len (string-width str)))
+         (if (and (> (+ column 1 len) max-width)
+                  (not delimited?))
+             (begin
+               (newline port)
+               (display (make-string indent #\space) port)
+               (display str port)
+               (+ indent len))
+             (begin
+               (unless delimited? (display " " port))
+               (display str port)
+               (+ column (if delimited? 0 1) len))))))))
+
+(define (object->string* obj indent . args)
+  "Pretty-print OBJ with INDENT columns as the initial indent.  ARGS are
+passed as-is to 'pretty-print-with-comments'."
+  (call-with-output-string
+    (lambda (port)
+      (apply pretty-print-with-comments port obj
+             #:indent indent
+             args))))
+
+(define* (pretty-print-with-comments/splice port lst
+                                            #:rest rest)
+  "Write to PORT the expressions and blanks listed in LST."
+  (for-each (lambda (exp)
+              (apply pretty-print-with-comments port exp rest)
+              (unless (blank? exp)
+                (newline port)))
+            lst))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 75bbb701ae..06d9ad1f0c 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -373,8 +373,19 @@ use '--no-offload' instead~%")))
                        (first (member arg (targets))))))
                (if t
                    (apply values (alist-cons 'target t result) rest)
-                   (leave (G_ "'~a' is not a supported target~%")
-                          arg)))))))
+                   (let ((closest (string-closest arg (targets)
+                                                  #:threshold 5)))
+                     (report-error
+                      (G_ "'~a' is not a supported cross-compilation target~%")
+                      arg)
+                     (if closest
+                         (display-hint
+                          (format #f (G_ "Did you mean @code{~a}?
+Try @option{--list-targets} to view available targets.~%")
+                                  closest))
+                         (display-hint (G_ "\
+Try @option{--list-targets} to view available targets.~%")))
+                     (exit 1))))))))
 
 (define %standard-native-build-options
   ;; Build options related to native builds.
@@ -389,8 +400,18 @@ use '--no-offload' instead~%")))
                        (first (member arg (systems))))))
                (if s
                    (apply values (alist-cons 'system s result) rest)
-                   (leave (G_ "'~a' is not a supported system~%")
-                          arg)))))))
+                   (let ((closest (string-closest arg (systems)
+                                                  #:threshold 5)))
+                     (report-error (G_ "'~a' is not a supported system~%")
+                                   arg)
+                     (if closest
+                         (display-hint
+                          (format #f (G_ "Did you mean @code{~a}?
+Try @option{--list-systems} to view available system types.~%")
+                                  closest))
+                         (display-hint (G_ "\
+Try @option{--list-systems} to view available system types.~%")))
+                     (exit 1))))))))
 
 
 ;;;
diff --git a/guix/scripts/describe.scm b/guix/scripts/describe.scm
index 7e4f682053..0c310e3da8 100644
--- a/guix/scripts/describe.scm
+++ b/guix/scripts/describe.scm
@@ -29,7 +29,6 @@
   #:use-module (guix profiles)
   #:autoload   (guix colors) (supports-hyperlinks? hyperlink)
   #:autoload   (guix openpgp) (openpgp-format-fingerprint)
-  #:use-module (git)
   #:autoload   (json builder) (scm->json-string)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -148,40 +147,29 @@ Display information about the channels currently in use.\n"))
   "Display information about the current checkout according to FMT, a symbol
 denoting the requested format.  Exit if the current directory does not lie
 within a Git checkout."
-  (let* ((program    (car (command-line)))
-         (directory  (catch 'git-error
-                       (lambda ()
-                         (repository-discover (dirname program)))
-                       (lambda (key err)
-                         (report-error (G_ "failed to determine origin~%"))
-                         (display-hint (format #f (G_ "Perhaps this
+  (let* ((program (car (command-line)))
+         (channel (repository->guix-channel (dirname program))))
+    (unless channel
+      (report-error (G_ "failed to determine origin~%"))
+      (display-hint (format #f (G_ "Perhaps this
 @command{guix} command was not obtained with @command{guix pull}?  Its version
 string is ~a.~%")
-                                               %guix-version))
-                         (exit 1))))
-         (repository (repository-open directory))
-         (head       (repository-head repository))
-         (commit     (oid->string (reference-target head))))
+                            %guix-version))
+      (exit 1))
+
     (match fmt
       ('human
        (format #t (G_ "Git checkout:~%"))
-       (format #t (G_ "  repository: ~a~%") (dirname directory))
-       (format #t (G_ "  branch: ~a~%") (reference-shorthand head))
-       (format #t (G_ "  commit: ~a~%") commit))
+       (format #t (G_ "  repository: ~a~%") (channel-url channel))
+       (format #t (G_ "  branch: ~a~%") (channel-branch channel))
+       (format #t (G_ "  commit: ~a~%") (channel-commit channel)))
       ('channels
-       (pretty-print `(list ,(channel->code (channel (name 'guix)
-                                                     (url (dirname directory))
-                                                     (commit commit))))))
+       (pretty-print `(list ,(channel->code channel))))
       ('json
-       (display (channel->json (channel (name 'guix)
-                                        (url (dirname directory))
-                                        (commit commit))))
+       (display (channel->json channel))
        (newline))
       ('recutils
-       (channel->recutils (channel (name 'guix)
-                                   (url (dirname directory))
-                                   (commit commit))
-                          (current-output-port))))
+       (channel->recutils channel (current-output-port))))
     (display-package-search-path fmt)))
 
 (define* (display-profile-info profile fmt
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 3216235937..2493134470 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -408,7 +408,14 @@ regexps in WHITE-LIST."
        (lambda ()
          (apply execlp program program args))
        (lambda _
-         ;; Following established convention, exit with 127 upon ENOENT.
+         ;; Report the error from here because the parent process cannot
+         ;; distinguish between the conventional 127 exit code and a process
+         ;; that exited with 127 for other reasons (e.g., "sh -c xyz").
+         (report-error (G_ "~a: command not found~%") program)
+         (suggest-command-name profile command)
+
+         ;; Following established convention, exit with 127 (aka. EX_NOTFOUND)
+         ;; upon ENOENT.
          (primitive-_exit 127))))))
 
 (define (child-shell-environment shell profile manifest)
@@ -581,17 +588,6 @@ command name."
             (display-hint (format #f (G_ "Did you mean '~a'?~%")
                                   closest)))))))))
 
-(define (validate-exit-status profile command status)
-  "When STATUS, an integer as returned by 'waitpid', is 127, raise a \"command
-not found\" error.  Otherwise return STATUS."
-  ;; Most likely, exit value 127 means ENOENT.
-  (when (eqv? (status:exit-val status) 127)
-    (report-error (G_ "~a: command not found~%")
-                  (first command))
-    (suggest-command-name profile command)
-    (exit 1))
-  status)
-
 (define* (launch-environment/fork command profile manifest
                                   #:key pure? (white-list '()))
   "Run COMMAND in a new process with an environment containing PROFILE, with
@@ -604,7 +600,7 @@ regexps in WHITE-LIST."
                            #:white-list white-list))
     (pid (match (waitpid pid)
            ((_ . status)
-            (validate-exit-status profile command status))))))
+            status)))))
 
 (define* (launch-environment/container #:key command bash user user-mappings
                                        profile manifest link-profile? network?
@@ -625,9 +621,6 @@ WHILE-LIST."
     (and (file-exists? (file-system-mapping-source mapping))
          (file-system-mapping->bind-mount mapping)))
 
-  (define (exit/status* status)
-    (exit/status (validate-exit-status profile command status)))
-
   (mlet %store-monad ((reqs (inputs->requisites
                              (list (direct-store-path bash) profile))))
     (return
@@ -684,7 +677,7 @@ WHILE-LIST."
                                       '())
                                   (map file-system-mapping->bind-mount
                                        mappings))))
-       (exit/status*
+       (exit/status
         (call-with-container file-systems
           (lambda ()
             ;; Setup global shell.
diff --git a/guix/scripts/gc.scm b/guix/scripts/gc.scm
index 043273f491..65cd4bdf8b 100644
--- a/guix/scripts/gc.scm
+++ b/guix/scripts/gc.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2013, 2015-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,6 +26,7 @@
                                 profile-generations
                                 generation-number)
   #:autoload   (guix scripts package) (delete-generations)
+  #:autoload   (gnu home) (home-generation-base)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
@@ -260,7 +261,8 @@ is deprecated; use '-D'~%"))
                      (filter-map (lambda (root)
                                    (and (or (zero? (getuid))
                                             (user-owned? root))
-                                        (generation-profile root)))
+                                        (or (generation-profile root)
+                                            (home-generation-base root))))
                                  (gc-roots)))))
       (for-each (lambda (profile)
                   (delete-old-generations store profile pattern))
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index 71ab4b4fed..bd3cfd2dc3 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2014, 2020-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2019, 2022 Ricardo Wurmus <rekado@elephly.net>
@@ -25,7 +25,7 @@
 (define-module (guix scripts import)
   #:use-module (guix ui)
   #:use-module (guix scripts)
-  #:use-module (guix scripts style)
+  #:use-module (guix read-print)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
diff --git a/guix/scripts/lint.scm b/guix/scripts/lint.scm
index c72dc3caad..9920c3ee62 100644
--- a/guix/scripts/lint.scm
+++ b/guix/scripts/lint.scm
@@ -1,7 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2014 Cyril Roelandt <tipecaml@gmail.com>
 ;;; Copyright © 2014, 2015 Eric Bavier <bavier@member.fsf.org>
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013-2020, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2015, 2016 Mathieu Lirzin <mthl@gnu.org>
 ;;; Copyright © 2016 Danny Milosavljevic <dannym+a@scratchpost.org>
 ;;; Copyright © 2016 Hartmut Goebel <h.goebel@crazy-compilers.com>
@@ -108,6 +108,8 @@ run the checkers on all packages.\n"))
                          exclude the specified checkers"))
   (display (G_ "
   -n, --no-network       only run checkers that do not access the network"))
+  (display (G_ "
+  -e, --expression=EXPR  consider the package EXPR evaluates to"))
 
   (display (G_ "
   -L, --load-path=DIR    prepend DIR to the package module search path"))
@@ -161,9 +163,11 @@ run the checkers on all packages.\n"))
                   (exit 0)))
         (option '(#\l "list-checkers") #f #f
                 (lambda (opt name arg result)
-                  (alist-cons 'list?
-                              #t
-                              result)))
+                  (alist-cons 'list? #t result)))
+        (option '(#\e "expression") #t #f
+                (lambda (opt name arg result)
+                  (alist-cons 'expression arg result)))
+
         (option '(#\V "version") #f #f
                 (lambda args
                   (show-version-and-exit "guix lint")))))
@@ -184,8 +188,10 @@ run the checkers on all packages.\n"))
 
   (let* ((opts (parse-options))
          (args (filter-map (match-lambda
-                             (('argument . value)
-                              value)
+                             (('argument . spec)
+                              (specification->package spec))
+                             (('expression . exp)
+                              (read/eval-package-expression exp))
                              (_ #f))
                            (reverse opts)))
          (no-checkers (or (assoc-ref opts 'exclude) '()))
@@ -219,7 +225,7 @@ run the checkers on all packages.\n"))
              (fold-packages (lambda (p r) (run-checkers p checkers
                                                         #:store store)) '()))
             (else
-             (for-each (lambda (spec)
-                         (run-checkers (specification->package spec) checkers
+             (for-each (lambda (package)
+                         (run-checkers package checkers
                                        #:store store))
                        args)))))))))
diff --git a/guix/scripts/style.scm b/guix/scripts/style.scm
index 9fd652beb1..c0b9ea1a28 100644
--- a/guix/scripts/style.scm
+++ b/guix/scripts/style.scm
@@ -37,468 +37,15 @@
   #:use-module (guix utils)
   #:use-module (guix i18n)
   #:use-module (guix diagnostics)
+  #:use-module (guix read-print)
   #:use-module (ice-9 control)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 rdelim)
-  #:use-module (ice-9 vlist)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-37)
-  #:export (pretty-print-with-comments
-            read-with-comments
-            canonicalize-comment
-
-            guix-style))
-
-
-;;;
-;;; Comment-preserving reader.
-;;;
-
-;; A comment.
-(define-record-type <comment>
-  (comment str margin?)
-  comment?
-  (str     comment->string)
-  (margin? comment-margin?))
-
-(define (read-with-comments port)
-  "Like 'read', but include <comment> objects when they're encountered."
-  ;; Note: Instead of implementing this functionality in 'read' proper, which
-  ;; is the best approach long-term, this code is a layer on top of 'read',
-  ;; such that we don't have to rely on a specific Guile version.
-  (define dot (list 'dot))
-  (define (dot? x) (eq? x dot))
-
-  (define (reverse/dot lst)
-    ;; Reverse LST and make it an improper list if it contains DOT.
-    (let loop ((result '())
-               (lst lst))
-      (match lst
-        (() result)
-        (((? dot?) . rest)
-         (let ((dotted (reverse rest)))
-           (set-cdr! (last-pair dotted) (car result))
-           dotted))
-        ((x . rest) (loop (cons x result) rest)))))
-
-  (let loop ((blank-line? #t)
-             (return (const 'unbalanced)))
-    (match (read-char port)
-      ((? eof-object? eof)
-       eof)                                       ;oops!
-      (chr
-       (cond ((eqv? chr #\newline)
-              (loop #t return))
-             ((char-set-contains? char-set:whitespace chr)
-              (loop blank-line? return))
-             ((memv chr '(#\( #\[))
-              (let/ec return
-                (let liip ((lst '()))
-                  (liip (cons (loop (match lst
-                                      (((? comment?) . _) #t)
-                                      (_ #f))
-                                    (lambda ()
-                                      (return (reverse/dot lst))))
-                              lst)))))
-             ((memv chr '(#\) #\]))
-              (return))
-             ((eq? chr #\')
-              (list 'quote (loop #f return)))
-             ((eq? chr #\`)
-              (list 'quasiquote (loop #f return)))
-             ((eq? chr #\,)
-              (list (match (peek-char port)
-                      (#\@
-                       (read-char port)
-                       'unquote-splicing)
-                      (_
-                       'unquote))
-                    (loop #f return)))
-             ((eqv? chr #\;)
-              (unread-char chr port)
-              (comment (read-line port 'concat)
-                       (not blank-line?)))
-             (else
-              (unread-char chr port)
-              (match (read port)
-                ((and token '#{.}#)
-                 (if (eq? chr #\.) dot token))
-                (token token))))))))
-
-;;;
-;;; Comment-preserving pretty-printer.
-;;;
-
-(define-syntax vhashq
-  (syntax-rules (quote)
-    ((_) vlist-null)
-    ((_ (key (quote (lst ...))) rest ...)
-     (vhash-consq key '(lst ...) (vhashq rest ...)))
-    ((_ (key value) rest ...)
-     (vhash-consq key '((() . value)) (vhashq rest ...)))))
-
-(define %special-forms
-  ;; Forms that are indented specially.  The number is meant to be understood
-  ;; like Emacs' 'scheme-indent-function' symbol property.  When given an
-  ;; alist instead of a number, the alist gives "context" in which the symbol
-  ;; is a special form; for instance, context (modify-phases) means that the
-  ;; symbol must appear within a (modify-phases ...) expression.
-  (vhashq
-   ('begin 1)
-   ('lambda 2)
-   ('lambda* 2)
-   ('match-lambda 1)
-   ('match-lambda* 2)
-   ('define 2)
-   ('define* 2)
-   ('define-public 2)
-   ('define*-public 2)
-   ('define-syntax 2)
-   ('define-syntax-rule 2)
-   ('define-module 2)
-   ('define-gexp-compiler 2)
-   ('let 2)
-   ('let* 2)
-   ('letrec 2)
-   ('letrec* 2)
-   ('match 2)
-   ('when 2)
-   ('unless 2)
-   ('package 1)
-   ('origin 1)
-   ('operating-system 1)
-   ('modify-inputs 2)
-   ('modify-phases 2)
-   ('add-after '(((modify-phases) . 3)))
-   ('add-before '(((modify-phases) . 3)))
-   ('replace '(((modify-phases) . 2)))         ;different from 'modify-inputs'
-   ('substitute* 2)
-   ('substitute-keyword-arguments 2)
-   ('call-with-input-file 2)
-   ('call-with-output-file 2)
-   ('with-output-to-file 2)
-   ('with-input-from-file 2)))
-
-(define %newline-forms
-  ;; List heads that must be followed by a newline.  The second argument is
-  ;; the context in which they must appear.  This is similar to a special form
-  ;; of 1, except that indent is 1 instead of 2 columns.
-  (vhashq
-   ('arguments '(package))
-   ('sha256 '(origin source package))
-   ('base32 '(sha256 origin))
-   ('git-reference '(uri origin source))
-   ('search-paths '(package))
-   ('native-search-paths '(package))
-   ('search-path-specification '())))
-
-(define (prefix? candidate lst)
-  "Return true if CANDIDATE is a prefix of LST."
-  (let loop ((candidate candidate)
-             (lst lst))
-    (match candidate
-      (() #t)
-      ((head1 . rest1)
-       (match lst
-         (() #f)
-         ((head2 . rest2)
-          (and (equal? head1 head2)
-               (loop rest1 rest2))))))))
-
-(define (special-form-lead symbol context)
-  "If SYMBOL is a special form in the given CONTEXT, return its number of
-arguments; otherwise return #f.  CONTEXT is a stack of symbols lexically
-surrounding SYMBOL."
-  (match (vhash-assq symbol %special-forms)
-    (#f #f)
-    ((_ . alist)
-     (any (match-lambda
-            ((prefix . level)
-             (and (prefix? prefix context) (- level 1))))
-          alist))))
-
-(define (newline-form? symbol context)
-  "Return true if parenthesized expressions starting with SYMBOL must be
-followed by a newline."
-  (match (vhash-assq symbol %newline-forms)
-    (#f #f)
-    ((_ . prefix)
-     (prefix? prefix context))))
-
-(define (escaped-string str)
-  "Return STR with backslashes and double quotes escaped.  Everything else, in
-particular newlines, is left as is."
-  (list->string
-   `(#\"
-     ,@(string-fold-right (lambda (chr lst)
-                            (match chr
-                              (#\" (cons* #\\ #\" lst))
-                              (#\\ (cons* #\\ #\\ lst))
-                              (_   (cons chr lst))))
-                          '()
-                          str)
-     #\")))
-
-(define (string-width str)
-  "Return the \"width\" of STR--i.e., the width of the longest line of STR."
-  (apply max (map string-length (string-split str #\newline))))
-
-(define (canonicalize-comment c)
-  "Canonicalize comment C, ensuring it has the \"right\" number of leading
-semicolons."
-  (let ((line (string-trim-both
-               (string-trim (comment->string c) (char-set #\;)))))
-    (comment (string-append
-              (if (comment-margin? c)
-                  ";"
-                  (if (string-null? line)
-                      ";;"                        ;no trailing space
-                      ";; "))
-              line "\n")
-             (comment-margin? c))))
-
-(define* (pretty-print-with-comments port obj
-                                     #:key
-                                     (format-comment identity)
-                                     (indent 0)
-                                     (max-width 78)
-                                     (long-list 5))
-  "Pretty-print OBJ to PORT, attempting to at most MAX-WIDTH character columns
-and assuming the current column is INDENT.  Comments present in OBJ are
-included in the output.
-
-Lists longer than LONG-LIST are written as one element per line.  Comments are
-passed through FORMAT-COMMENT before being emitted; a useful value for
-FORMAT-COMMENT is 'canonicalize-comment'."
-  (define (list-of-lists? head tail)
-    ;; Return true if HEAD and TAIL denote a list of lists--e.g., a list of
-    ;; 'let' bindings.
-    (match head
-      ((thing _ ...)                              ;proper list
-       (and (not (memq thing
-                       '(quote quasiquote unquote unquote-splicing)))
-            (pair? tail)))
-      (_ #f)))
-
-  (let loop ((indent indent)
-             (column indent)
-             (delimited? #t)                  ;true if comes after a delimiter
-             (context '())                    ;list of "parent" symbols
-             (obj obj))
-    (define (print-sequence context indent column lst delimited?)
-      (define long?
-        (> (length lst) long-list))
-
-      (let print ((lst lst)
-                  (first? #t)
-                  (delimited? delimited?)
-                  (column column))
-        (match lst
-          (()
-           column)
-          ((item . tail)
-           (define newline?
-             ;; Insert a newline if ITEM is itself a list, or if TAIL is long,
-             ;; but only if ITEM is not the first item.  Also insert a newline
-             ;; before a keyword.
-             (and (or (pair? item) long?
-                      (and (keyword? item)
-                           (not (eq? item #:allow-other-keys))))
-                  (not first?) (not delimited?)
-                  (not (comment? item))))
-
-           (when newline?
-             (newline port)
-             (display (make-string indent #\space) port))
-           (let ((column (if newline? indent column)))
-             (print tail
-                    (keyword? item)      ;keep #:key value next to one another
-                    (comment? item)
-                    (loop indent column
-                          (or newline? delimited?)
-                          context
-                          item)))))))
-
-    (define (sequence-would-protrude? indent lst)
-      ;; Return true if elements of LST written at INDENT would protrude
-      ;; beyond MAX-WIDTH.  This is implemented as a cheap test with false
-      ;; negatives to avoid actually rendering all of LST.
-      (find (match-lambda
-              ((? string? str)
-               (>= (+ (string-width str) 2 indent) max-width))
-              ((? symbol? symbol)
-               (>= (+ (string-width (symbol->string symbol)) indent)
-                   max-width))
-              ((? boolean?)
-               (>= (+ 2 indent) max-width))
-              (()
-               (>= (+ 2 indent) max-width))
-              (_                                  ;don't know
-               #f))
-            lst))
-
-    (define (special-form? head)
-      (special-form-lead head context))
-
-    (match obj
-      ((? comment? comment)
-       (if (comment-margin? comment)
-           (begin
-             (display " " port)
-             (display (comment->string (format-comment comment))
-                      port))
-           (begin
-             ;; When already at the beginning of a line, for example because
-             ;; COMMENT follows a margin comment, no need to emit a newline.
-             (unless (= column indent)
-               (newline port)
-               (display (make-string indent #\space) port))
-             (display (comment->string (format-comment comment))
-                      port)))
-       (display (make-string indent #\space) port)
-       indent)
-      (('quote lst)
-       (unless delimited? (display " " port))
-       (display "'" port)
-       (loop indent (+ column (if delimited? 1 2)) #t context lst))
-      (('quasiquote lst)
-       (unless delimited? (display " " port))
-       (display "`" port)
-       (loop indent (+ column (if delimited? 1 2)) #t context lst))
-      (('unquote lst)
-       (unless delimited? (display " " port))
-       (display "," port)
-       (loop indent (+ column (if delimited? 1 2)) #t context lst))
-      (('unquote-splicing lst)
-       (unless delimited? (display " " port))
-       (display ",@" port)
-       (loop indent (+ column (if delimited? 2 3)) #t context lst))
-      (('gexp lst)
-       (unless delimited? (display " " port))
-       (display "#~" port)
-       (loop indent (+ column (if delimited? 2 3)) #t context lst))
-      (('ungexp obj)
-       (unless delimited? (display " " port))
-       (display "#$" port)
-       (loop indent (+ column (if delimited? 2 3)) #t context obj))
-      (('ungexp-native obj)
-       (unless delimited? (display " " port))
-       (display "#+" port)
-       (loop indent (+ column (if delimited? 2 3)) #t context obj))
-      (('ungexp-splicing lst)
-       (unless delimited? (display " " port))
-       (display "#$@" port)
-       (loop indent (+ column (if delimited? 3 4)) #t context lst))
-      (('ungexp-native-splicing lst)
-       (unless delimited? (display " " port))
-       (display "#+@" port)
-       (loop indent (+ column (if delimited? 3 4)) #t context lst))
-      (((? special-form? head) arguments ...)
-       ;; Special-case 'let', 'lambda', 'modify-inputs', etc. so the second
-       ;; and following arguments are less indented.
-       (let* ((lead    (special-form-lead head context))
-              (context (cons head context))
-              (head    (symbol->string head))
-              (total   (length arguments)))
-         (unless delimited? (display " " port))
-         (display "(" port)
-         (display head port)
-         (unless (zero? lead)
-           (display " " port))
-
-         ;; Print the first LEAD arguments.
-         (let* ((indent (+ column 2
-                                  (if delimited? 0 1)))
-                (column (+ column 1
-                                  (if (zero? lead) 0 1)
-                                  (if delimited? 0 1)
-                                  (string-length head)))
-                (initial-indent column))
-           (define new-column
-             (let inner ((n lead)
-                         (arguments (take arguments (min lead total)))
-                         (column column))
-               (if (zero? n)
-                   (begin
-                     (newline port)
-                     (display (make-string indent #\space) port)
-                     indent)
-                   (match arguments
-                     (() column)
-                     ((head . tail)
-                      (inner (- n 1) tail
-                             (loop initial-indent column
-                                   (= n lead)
-                                   context
-                                   head)))))))
-
-           ;; Print the remaining arguments.
-           (let ((column (print-sequence
-                          context indent new-column
-                          (drop arguments (min lead total))
-                          #t)))
-             (display ")" port)
-             (+ column 1)))))
-      ((head tail ...)
-       (let* ((overflow? (>= column max-width))
-              (column    (if overflow?
-                             (+ indent 1)
-                             (+ column (if delimited? 1 2))))
-              (newline?  (or (newline-form? head context)
-                             (list-of-lists? head tail))) ;'let' bindings
-              (context   (cons head context)))
-         (if overflow?
-             (begin
-               (newline port)
-               (display (make-string indent #\space) port))
-             (unless delimited? (display " " port)))
-         (display "(" port)
-
-         (let* ((new-column (loop column column #t context head))
-                (indent (if (or (>= new-column max-width)
-                                (not (symbol? head))
-                                (sequence-would-protrude?
-                                 (+ new-column 1) tail)
-                                newline?)
-                            column
-                            (+ new-column 1))))
-           (when newline?
-             ;; Insert a newline right after HEAD.
-             (newline port)
-             (display (make-string indent #\space) port))
-
-           (let ((column
-                  (print-sequence context indent
-                                  (if newline? indent new-column)
-                                  tail newline?)))
-             (display ")" port)
-             (+ column 1)))))
-      (_
-       (let* ((str (if (string? obj)
-                       (escaped-string obj)
-                       (object->string obj)))
-              (len (string-width str)))
-         (if (and (> (+ column 1 len) max-width)
-                  (not delimited?))
-             (begin
-               (newline port)
-               (display (make-string indent #\space) port)
-               (display str port)
-               (+ indent len))
-             (begin
-               (unless delimited? (display " " port))
-               (display str port)
-               (+ column (if delimited? 0 1) len))))))))
-
-(define (object->string* obj indent . args)
-  (call-with-output-string
-    (lambda (port)
-      (apply pretty-print-with-comments port obj
-             #:indent indent
-             args))))
+  #:export (guix-style))
 
 
 ;;;
@@ -561,7 +108,7 @@ bailing out~%")
                (exp exp)
                (inputs inputs))
       (match exp
-        (((? comment? head) . rest)
+        (((? blank? head) . rest)
          (loop (cons head result) rest inputs))
         ((head . rest)
          (match inputs
@@ -769,7 +316,8 @@ PACKAGE."
        (object->string* exp
                         (location-column
                          (package-definition-location package))
-                        #:format-comment canonicalize-comment)))))
+                        #:format-comment canonicalize-comment
+                        #:format-vertical-space canonicalize-vertical-space)))))
 
 (define (package-location<? p1 p2)
   "Return true if P1's location is \"before\" P2's."
@@ -782,6 +330,21 @@ PACKAGE."
 
 
 ;;;
+;;; Whole-file formatting.
+;;;
+
+(define* (format-whole-file file #:rest rest)
+  "Reformat all of FILE."
+  (let ((lst (call-with-input-file file read-with-comments/sequence)))
+    (with-atomic-file-output file
+      (lambda (port)
+        (apply pretty-print-with-comments/splice port lst
+               #:format-comment canonicalize-comment
+               #:format-vertical-space canonicalize-vertical-space
+               rest)))))
+
+
+;;;
 ;;; Options.
 ;;;
 
@@ -797,6 +360,9 @@ PACKAGE."
         (option '(#\e "expression") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'expression arg result)))
+        (option '(#\f "whole-file") #f #f
+                (lambda (opt name arg result)
+                  (alist-cons 'whole-file? #t result)))
         (option '(#\S "styling") #t #f
                 (lambda (opt name arg result)
                   (alist-cons 'styling-procedure
@@ -852,6 +418,9 @@ Update package definitions to the latest style.\n"))
                          of 'silent', 'safe', or 'always'"))
   (newline)
   (display (G_ "
+  -f, --whole-file       format the entire contents of the given file(s)"))
+  (newline)
+  (display (G_ "
   -h, --help             display this help and exit"))
   (display (G_ "
   -V, --version          display version information and exit"))
@@ -878,27 +447,35 @@ Update package definitions to the latest style.\n"))
                         #:build-options? #f))
 
   (let* ((opts     (parse-options))
-         (packages (filter-map (match-lambda
-                                 (('argument . spec)
-                                  (specification->package spec))
-                                 (('expression . str)
-                                  (read/eval str))
-                                 (_ #f))
-                               opts))
          (edit     (if (assoc-ref opts 'dry-run?)
                        edit-expression/dry-run
                        edit-expression))
          (style    (assoc-ref opts 'styling-procedure))
          (policy   (assoc-ref opts 'input-simplification-policy)))
     (with-error-handling
-      (for-each (lambda (package)
-                  (style package #:policy policy
-                         #:edit-expression edit))
-                ;; Sort package by source code location so that we start editing
-                ;; files from the bottom and going upward.  That way, the
-                ;; 'location' field of <package> records is not invalidated as
-                ;; we modify files.
-                (sort (if (null? packages)
-                          (fold-packages cons '() #:select? (const #t))
-                          packages)
-                      (negate package-location<?))))))
+      (if (assoc-ref opts 'whole-file?)
+          (let ((files (filter-map (match-lambda
+                                     (('argument . file) file)
+                                     (_ #f))
+                                   opts)))
+            (unless (eq? format-package-definition style)
+              (warning (G_ "'--styling' option has no effect in whole-file mode~%")))
+            (for-each format-whole-file files))
+          (let ((packages (filter-map (match-lambda
+                                        (('argument . spec)
+                                         (specification->package spec))
+                                        (('expression . str)
+                                         (read/eval str))
+                                        (_ #f))
+                                      opts)))
+            (for-each (lambda (package)
+                        (style package #:policy policy
+                               #:edit-expression edit))
+                      ;; Sort package by source code location so that we start
+                      ;; editing files from the bottom and going upward.  That
+                      ;; way, the 'location' field of <package> records is not
+                      ;; invalidated as we modify files.
+                      (sort (if (null? packages)
+                                (fold-packages cons '() #:select? (const #t))
+                                packages)
+                            (negate package-location<?))))))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index bfde0a88ca..be6e839941 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -91,7 +91,6 @@
   #:use-module (ice-9 match)
   #:use-module (rnrs bytevectors)
   #:export (guix-system
-            read-operating-system
 
             service-node-type
             shepherd-service-node-type))
@@ -107,10 +106,6 @@
                       (gnu services)
                       (gnu system shadow))))
 
-(define (read-operating-system file)
-  "Read the operating-system declaration from FILE and return it."
-  (load* file %user-module))
-
 
 ;;;
 ;;; Installation.
diff --git a/guix/self.scm b/guix/self.scm
index d1ccec8a49..fc80e78804 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -929,6 +929,7 @@ itself."
                            (('guix 'scripts 'deploy) #t)
                            (('guix 'scripts 'home . _) #t)
                            (('guix 'scripts 'import . _) #t)
+                           (('guix 'scripts 'gc) #t) ;autoloads (gnu home)
                            (('guix 'pack) #t)
                            (_ #f))
                          (scheme-modules* source "guix/scripts"))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index a6f0f2eb96..1b825a2573 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -162,6 +162,10 @@ server at '~a': ~a")
          ('success
           (session-set! session 'timeout timeout)
           session)
+         ('again
+          (raise (formatted-message (G_ "timeout while connecting \
+to SSH server at '~a'")
+                                    (session-get session 'host))))
          (x
           (match (userauth-gssapi! session)
             ('success
diff --git a/guix/tests/git.scm b/guix/tests/git.scm
index 94f1021c79..d51e49e514 100644
--- a/guix/tests/git.scm
+++ b/guix/tests/git.scm
@@ -73,6 +73,7 @@ Return DIRECTORY on success."
          (mkdir-p (dirname file))
          (call-with-output-file file
            (lambda (port)
+             (set-port-encoding! port "UTF-8")
              (display (if (string? contents)
                           contents
                           (with-repository directory repository
diff --git a/guix/utils.scm b/guix/utils.scm
index 9b277a0092..1a1cf673b8 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -15,6 +15,7 @@
 ;;; Copyright © 2018 Steve Sprang <scs@stevesprang.com>
 ;;; Copyright © 2022 Taiju HIGASHI <higashi@taiju.info>
 ;;; Copyright © 2022 Denis 'GNUtoo' Carikli <GNUtoo@cyberdimension.org>
+;;; Copyright © 2022 Antero Mejr <antero@mailbox.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -101,8 +102,10 @@
             target-ppc64le?
             target-powerpc?
             target-riscv64?
+            target-mips64el?
             target-64bit?
             ar-for-target
+            as-for-target
             cc-for-target
             cxx-for-target
             ld-for-target
@@ -731,6 +734,10 @@ architecture (x86_64)?"
   "Is the architecture of TARGET a 'riscv64' machine?"
   (string-prefix? "riscv64" target))
 
+(define* (target-mips64el? #:optional (target (or (%current-target-system)
+                                                  (%current-system))))
+  (string-prefix? "mips64el-" target))
+
 (define* (target-64bit? #:optional (system (or (%current-target-system)
                                                (%current-system))))
   (any (cut string-prefix? <> system) '("x86_64" "aarch64" "mips64"
@@ -741,6 +748,11 @@ architecture (x86_64)?"
       (string-append target "-ar")
       "ar"))
 
+(define* (as-for-target #:optional (target (%current-target-system)))
+  (if target
+      (string-append target "-as")
+      "as"))
+
 (define* (cc-for-target #:optional (target (%current-target-system)))
   (if target
       (string-append target "-gcc")