Merge branch 'master' into core-updates-frozen

 Conflicts:
	gnu/packages/bioinformatics.scm
	gnu/packages/chez.scm
	gnu/packages/docbook.scm
	gnu/packages/ebook.scm
	gnu/packages/gnome.scm
	gnu/packages/linux.scm
	gnu/packages/networking.scm
	gnu/packages/python-web.scm
	gnu/packages/python-xyz.scm
	gnu/packages/tex.scm
	gnu/packages/version-control.scm
	gnu/packages/xml.scm
	guix/build-system/dune.scm
	guix/build-system/go.scm
	guix/build-system/linux-module.scm
	guix/packages.scm

21 files changed, 510 insertions, 161 deletions

diff --git a/guix/base16.scm b/guix/base16.scm
index 6c15a9f588..9ac964dff0 100644
--- a/guix/base16.scm
+++ b/guix/base16.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2014, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -32,27 +33,28 @@
 
 (define (bytevector->base16-string bv)
   "Return the hexadecimal representation of BV's contents."
-  (define len
-    (bytevector-length bv))
-
-  (let-syntax ((base16-chars (lambda (s)
-                               (syntax-case s ()
-                                 (_
-                                  (let ((v (list->vector
-                                            (unfold (cut > <> 255)
-                                                    (lambda (n)
-                                                      (format #f "~2,'0x" n))
-                                                    1+
-                                                    0))))
-                                    v))))))
-    (define chars base16-chars)
-    (let loop ((i len)
-               (r '()))
-      (if (zero? i)
-          (string-concatenate r)
-          (let ((i (- i 1)))
-            (loop i
-                  (cons (vector-ref chars (bytevector-u8-ref bv i)) r)))))))
+  (define len (bytevector-length bv))
+  (define utf8 (make-bytevector (* len 2)))
+  (let-syntax ((base16-octet-pairs
+                (lambda (s)
+                  (syntax-case s ()
+                    (_
+                     (string->utf8
+                      (string-concatenate
+                       (unfold (cut > <> 255)
+                               (lambda (n)
+                                 (format #f "~2,'0x" n))
+                               1+
+                               0))))))))
+    (define octet-pairs base16-octet-pairs)
+    (let loop ((i 0))
+      (when (< i len)
+        (bytevector-u16-native-set!
+         utf8 (* 2 i)
+         (bytevector-u16-native-ref octet-pairs
+                                    (* 2 (bytevector-u8-ref bv i))))
+        (loop (+ i 1))))
+    (utf8->string utf8)))
 
 (define base16-string->bytevector
   (let ((chars->value (fold (lambda (i r)
diff --git a/guix/base32.scm b/guix/base32.scm
index 49f191ba26..d6c8a02243 100644
--- a/guix/base32.scm
+++ b/guix/base32.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2015, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2015, 2017, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -42,6 +42,19 @@
 ;;;
 ;;; Code:
 
+(define-syntax bit-field
+  (lambda (s)
+    ;; This inline version of 'bit-field' assumes that START and END are
+    ;; literals and pre-computes the mask.  In an ideal world, using 'define'
+    ;; or 'define-inlinable' would be enough, but as of 3.0.7, peval doesn't
+    ;; expand calls to 'expt' (and 'bit-field' is a subr.)
+    (syntax-case s ()
+      ((_ n start end)
+       (let* ((s    (syntax->datum #'start))
+              (e    (syntax->datum #'end))
+              (mask (- (expt 2 (- e s)) 1)))
+         #`(logand (ash n (- start)) #,mask))))))
+
 (define bytevector-quintet-ref
   (let* ((ref  bytevector-u8-ref)
          (ref+ (lambda (bv offset)
diff --git a/guix/build-system/dune.scm b/guix/build-system/dune.scm
index 303b5f76c6..12100fd8e8 100644
--- a/guix/build-system/dune.scm
+++ b/guix/build-system/dune.scm
@@ -61,6 +61,17 @@
                 #:allow-other-keys
                 #:rest arguments)
   "Return a bag for NAME."
+
+  ;; Flags that put dune into reproducible build mode.
+  (define dune-release-flags
+    (if (version>=? (package-version dune) "2.5.0")
+        ;; For dune >= 2.5.0 this is just --release.
+        ''("--release")
+        ;; --release does not exist before 2.5.0.  Replace with flags compatible
+        ;; with our old ocaml4.07-dune (1.11.3)
+        ''("--root" "." "--ignore-promoted-rules" "--no-config"
+           "--profile" "release")))
+
   (define private-keywords
     '(#:target #:dune #:findlib #:ocaml #:inputs #:native-inputs))
 
@@ -80,7 +91,9 @@
            (build-inputs `(("dune" ,dune)
                            ,@(bag-build-inputs base)))
            (build dune-build)
-           (arguments (strip-keyword-arguments private-keywords arguments))))))
+           (arguments (append
+                       `(#:dune-release-flags ,dune-release-flags)
+                       (strip-keyword-arguments private-keywords arguments)))))))
 
 (define* (dune-build name inputs
                      #:key
@@ -91,7 +104,7 @@
                      (out-of-source? #t)
                      (jbuild? #f)
                      (package #f)
-                     (profile "release")
+                     (dune-release-flags ''())
                      (tests? #t)
                      (test-flags ''())
                      (test-target "test")
@@ -131,7 +144,7 @@ provides a 'setup.ml' file as its build system."
                       #:out-of-source? #$out-of-source?
                       #:jbuild? #$jbuild?
                       #:package #$package
-                      #:profile #$profile
+                      #:dune-release-flags #$dune-release-flags
                       #:tests? #$tests?
                       #:test-target #$test-target
                       #:install-target #$install-target
diff --git a/guix/build-system/go.scm b/guix/build-system/go.scm
index 100d1db4b6..b62f2a897b 100644
--- a/guix/build-system/go.scm
+++ b/guix/build-system/go.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2017 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
 ;;; Copyright © 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -30,6 +31,7 @@
   #:use-module (guix packages)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (srfi srfi-1)
   #:export (%go-build-system-modules
             go-build
             go-build-system
@@ -81,6 +83,24 @@ present) if a pseudo-version pattern is not recognized."
 commit hash and its date rather than a proper release tag."
   (regexp-exec %go-pseudo-version-rx version))
 
+(define (go-target target)
+    ;; Parse the nix-system equivalent of the target and set the
+    ;; target for compilation accordingly.
+    (match (string-split (gnu-triplet->nix-system target) #\-)
+      ((arch os)
+       (list (match arch
+               ("aarch64" "arm64")
+               ("armhf" "arm")
+               ("powerpc64le" "ppc64le")
+               ("powerpc64" "ppc64")
+               ("i686" "386")
+               ("x86_64" "amd64")
+               ("mips64el" "mips64le")
+               (_ arch))
+             (match os
+               ((or "mingw32" "cygwin") "windows")
+               (_ os))))))
+
 (define %go-build-system-modules
   ;; Build-side modules imported and used by default.
   `((guix build go-build-system)
@@ -101,22 +121,37 @@ commit hash and its date rather than a proper release tag."
   (define private-keywords
     '(#:target #:go #:inputs #:native-inputs))
 
-  (and (not target)                               ;XXX: no cross-compilation
-       (bag
-         (name name)
-         (system system)
-         (host-inputs `(,@(if source
-                              `(("source" ,source))
-                              '())
-                        ,@inputs
-
-                        ;; Keep the standard inputs of 'gnu-build-system'.
-                        ,@(standard-packages)))
-         (build-inputs `(("go" ,go)
-                         ,@native-inputs))
-         (outputs outputs)
-         (build go-build)
-         (arguments (strip-keyword-arguments private-keywords arguments)))))
+  (bag
+    (name name)
+    (system system)
+    (target target)
+    (build-inputs `(,@(if source
+                        `(("source" ,source))
+                        '())
+                     ,@`(("go" ,go))
+                     ,@native-inputs
+                     ,@(if target '() inputs)
+                     ,@(if target
+                         ;; Use the standard cross inputs of
+                         ;; 'gnu-build-system'.
+                         (standard-cross-packages target 'host)
+                         '())
+                     ;; Keep the standard inputs of 'gnu-build-system'.
+                     ,@(standard-packages)))
+    (host-inputs (if target inputs '()))
+
+    ;; The cross-libc is really a target package, but for bootstrapping
+    ;; reasons, we can't put it in 'host-inputs'.  Namely, 'cross-gcc' is a
+    ;; native package, so it would end up using a "native" variant of
+    ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
+    ;; would use a target variant (built with 'gnu-cross-build'.)
+    (target-inputs (if target
+                     (standard-cross-packages target 'target)
+                     '()))
+
+    (outputs outputs)
+    (build (if target go-cross-build go-build))
+    (arguments (strip-keyword-arguments private-keywords arguments))))
 
 (define* (go-build name inputs
                    #:key
@@ -131,6 +166,8 @@ commit hash and its date rather than a proper release tag."
                    (tests? #t)
                    (allow-go-reference? #f)
                    (system (%current-system))
+                   (goarch (first (go-target (%current-system))))
+                   (goos (last (go-target (%current-system))))
                    (guile #f)
                    (imported-modules %go-build-system-modules)
                    (modules '((guix build go-build-system)
@@ -145,6 +182,8 @@ commit hash and its date rather than a proper release tag."
                     #:system #$system
                     #:phases #$phases
                     #:outputs #$(outputs->gexp outputs)
+                    #:goarch #$goarch
+                    #:goos #$goos
                     #:search-paths '#$(sexp->gexp
                                        (map search-path-specification->sexp
                                             search-paths))
@@ -162,6 +201,98 @@ commit hash and its date rather than a proper release tag."
                       #:system system
                       #:guile-for-build guile)))
 
+(define* (go-cross-build store name
+                         #:key
+                         target native-drvs target-drvs
+                         (phases '(@ (guix build go-build-system)
+                                     %standard-phases))
+                         (outputs '("out"))
+                         (search-paths '())
+                         (native-search-paths '())
+                         (install-source? #t)
+                         (import-path "")
+                         (unpack-path "")
+                         (build-flags ''())
+                         (tests? #f) ; nothing can be done
+                         (allow-go-reference? #f)
+                         (system (%current-system))
+                         (goarch (first (go-target target)))
+                         (goos (last (go-target target)))
+                         (guile #f)
+                         (imported-modules %go-build-system-modules)
+                         (modules '((guix build go-build-system)
+                                    (guix build union)
+                                    (guix build utils))))
+  "Cross-build NAME using GO, where TARGET is a GNU triplet and with INPUTS."
+  (define builder
+    `(begin
+       (use-modules ,@modules)
+       (let ()
+         (define %build-host-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name path)
+                     `(,name . ,path)))
+                  native-drvs))
+
+         (define %build-target-inputs
+           ',(map (match-lambda
+                    ((name (? derivation? drv) sub ...)
+                     `(,name . ,(apply derivation->output-path drv sub)))
+                    ((name (? package? pkg) sub ...)
+                     (let ((drv (package-cross-derivation store pkg
+                                                          target system)))
+                       `(,name . ,(apply derivation->output-path drv sub))))
+                    ((name path)
+                     `(,name . ,path)))
+                  target-drvs))
+
+         (go-build #:name ,name
+                   #:source ,(match (assoc-ref native-drvs "source")
+                                    (((? derivation? source))
+                                     (derivation->output-path source))
+                                    ((source)
+                                     source)
+                                    (source
+                                      source))
+                   #:system ,system
+                   #:phases ,phases
+                   #:outputs %outputs
+                   #:target ,target
+                   #:goarch ,goarch
+                   #:goos ,goos
+                   #:inputs %build-target-inputs
+                   #:native-inputs %build-host-inputs
+                   #:search-paths ',(map search-path-specification->sexp
+                                         search-paths)
+                   #:native-search-paths ',(map
+                                             search-path-specification->sexp
+                                             native-search-paths)
+                   #:install-source? ,install-source?
+                   #:import-path ,import-path
+                   #:unpack-path ,unpack-path
+                   #:build-flags ,build-flags
+                   #:tests? ,tests?
+                   #:allow-go-reference? ,allow-go-reference?
+                   #:inputs %build-inputs))))
+
+    (define guile-for-build
+      (match guile
+             ((? package?)
+              (package-derivation store guile system #:graft? #f))
+             (#f                               ; the default
+              (let* ((distro (resolve-interface '(gnu packages commencement)))
+                     (guile  (module-ref distro 'guile-final)))
+                (package-derivation store guile system #:graft? #f)))))
+
+    (build-expression->derivation store name builder
+                                  #:system system
+                                  #:inputs (append native-drvs target-drvs)
+                                  #:outputs outputs
+                                  #:modules imported-modules
+                                  #:guile-for-build guile-for-build))
+
 (define go-build-system
   (build-system
     (name 'go)
diff --git a/guix/build-system/linux-module.scm b/guix/build-system/linux-module.scm
index 84570b923a..7bafee5a7a 100644
--- a/guix/build-system/linux-module.scm
+++ b/guix/build-system/linux-module.scm
@@ -159,6 +159,7 @@
                              (outputs '("out"))
                              (make-flags ''())
                              (system (%current-system))
+                             (source-directory ".")
                              (guile #f)
                              (substitutable? #t)
                              (imported-modules
@@ -172,6 +173,7 @@
           (use-modules #$@(sexp->gexp modules))
           (linux-module-build #:name #$name
                               #:source #+source
+                              #:source-directory #$source-directory
                               #:search-paths '#$(sexp->gexp
                                                  (map search-path-specification->sexp
                                                       search-paths))
diff --git a/guix/build/download.scm b/guix/build/download.scm
index 54627eefa2..c8ddadfdd4 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -747,15 +747,20 @@ otherwise simply ignore them."
                 content-addressed-mirrors))
 
   (define disarchive-uris
-    (append-map (match-lambda
-                  ((? string? mirror)
-                   (map (match-lambda
-                          ((hash-algo . hash)
-                           (string->uri
-                            (string-append mirror
-                                           (symbol->string hash-algo) "/"
-                                           (bytevector->base16-string hash)))))
-                        hashes)))
+    (append-map (lambda (mirror)
+                  (let ((make-url (match mirror
+                                    ((? string?)
+                                     (lambda (hash-algo hash)
+                                       (string-append
+                                        mirror
+                                        (symbol->string hash-algo) "/"
+                                        (bytevector->base16-string hash))))
+                                    ((? procedure?)
+                                     mirror))))
+                    (map (match-lambda
+                           ((hash-algo . hash)
+                            (string->uri (make-url hash-algo hash))))
+                         hashes)))
                 disarchive-mirrors))
 
   ;; Make this unbuffered so 'progress-report/file' works as expected.  'line
diff --git a/guix/build/dune-build-system.scm b/guix/build/dune-build-system.scm
index 6a0c2593ac..e9ccc71057 100644
--- a/guix/build/dune-build-system.scm
+++ b/guix/build/dune-build-system.scm
@@ -32,23 +32,26 @@
 ;; Code:
 
 (define* (build #:key (build-flags '()) (jbuild? #f)
-                (use-make? #f) (package #f)
-                (profile "release") #:allow-other-keys)
+                (use-make? #f) (package #f) (dune-release-flags '())
+                #:allow-other-keys)
   "Build the given package."
   (let ((program (if jbuild? "jbuilder" "dune")))
     (apply invoke program "build" "@install"
-           (append (if package (list "-p" package) '())
-                   `("--profile" ,profile)
+           (append (if package (list "-p" package)
+                       dune-release-flags)
                    build-flags)))
   #t)
 
 (define* (check #:key (test-flags '()) (test-target "test") tests?
-                  (jbuild? #f) (package #f) #:allow-other-keys)
+                (jbuild? #f) (package #f) (dune-release-flags '())
+                #:allow-other-keys)
   "Test the given package."
   (when tests?
     (let ((program (if jbuild? "jbuilder" "dune")))
       (apply invoke program "runtest" test-target
-             (append (if package (list "-p" package) '()) test-flags))))
+             (append (if package (list "-p" package)
+                         dune-release-flags)
+                     test-flags))))
   #t)
 
 (define* (install #:key outputs (install-target "install") (jbuild? #f)
diff --git a/guix/build/go-build-system.scm b/guix/build/go-build-system.scm
index 227df820db..645d2fe680 100644
--- a/guix/build/go-build-system.scm
+++ b/guix/build/go-build-system.scm
@@ -4,7 +4,7 @@
 ;;; Copyright © 2019 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2020 Jack Hill <jackhill@jackhill.us>
 ;;; Copyright © 2020 Jakub Kądziołka <kuba@kadziolka.net>
-;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2020, 2021 Efraim Flashner <efraim@flashner.co.il>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -131,7 +131,7 @@
 ;;
 ;; Code:
 
-(define* (setup-go-environment #:key inputs outputs #:allow-other-keys)
+(define* (setup-go-environment #:key inputs outputs goos goarch #:allow-other-keys)
   "Prepare a Go build environment for INPUTS and OUTPUTS.  Build a file system
 union of INPUTS.  Export GOPATH, which helps the compiler find the source code
 of the package being built and its dependencies, and GOBIN, which determines
@@ -149,6 +149,22 @@ dependencies, so it should be self-contained."
   ;; GOPATH behavior.
   (setenv "GO111MODULE" "off")
   (setenv "GOBIN" (string-append (assoc-ref outputs "out") "/bin"))
+
+  ;; Make sure we're building for the correct architecture and OS targets
+  ;; that Guix targets.
+  (setenv "GOARCH" goarch)
+  (setenv "GOOS" goos)
+  (match goarch
+    ("arm"
+     (setenv "GOARM" "7"))
+    ((or "mips" "mipsel")
+     (setenv "GOMIPS" "hardfloat"))
+    ((or "mips64" "mips64le")
+     (setenv "GOMIPS64" "hardfloat"))
+    ((or "ppc64" "ppc64le")
+     (setenv "GOPPC64" "power8"))
+    (_ #t))
+
   (let ((tmpdir (tmpnam)))
     (match (go-inputs inputs)
       (((names . directories) ...)
diff --git a/guix/build/linux-module-build-system.scm b/guix/build/linux-module-build-system.scm
index d51d76f94b..729ab6154f 100644
--- a/guix/build/linux-module-build-system.scm
+++ b/guix/build/linux-module-build-system.scm
@@ -49,16 +49,17 @@
   ; TODO: kernel ".config".
   #t)
 
-(define* (build #:key inputs make-flags #:allow-other-keys)
+(define* (build #:key inputs make-flags (source-directory ".") #:allow-other-keys)
   (apply invoke "make" "-C"
          (string-append (assoc-ref inputs "linux-module-builder")
                         "/lib/modules/build")
-         (string-append "M=" (getcwd))
+         (string-append "M=" (getcwd) "/" source-directory)
          (or make-flags '())))
 
 ;; This block was copied from make-linux-libre--only took the "modules_install"
 ;; part.
-(define* (install #:key make-flags inputs native-inputs outputs
+(define* (install #:key make-flags (source-directory ".")
+                  inputs native-inputs outputs
                   #:allow-other-keys)
   (let* ((out (assoc-ref outputs "out"))
          (moddir (string-append out "/lib/modules")))
@@ -67,7 +68,7 @@
     (apply invoke "make" "-C"
             (string-append (assoc-ref inputs "linux-module-builder")
                            "/lib/modules/build")
-            (string-append "M=" (getcwd))
+            (string-append "M=" (getcwd) "/" source-directory)
             ;; Disable depmod because the Guix system's module directory
             ;; is an union of potentially multiple packages.  It is not
             ;; possible to use depmod to usefully calculate a dependency
diff --git a/guix/download.scm b/guix/download.scm
index d60c898c57..85b97a4766 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -369,7 +369,7 @@
   ;; procedure that takes a file name, an algorithm (symbol) and a hash
   ;; (bytevector), and returns a URL or #f.
   '(begin
-     (use-modules (guix base32))
+     (use-modules (guix base16) (guix base32))
 
      (define (guix-publish host)
        (lambda (file algo hash)
@@ -379,12 +379,6 @@
                         file "/" (symbol->string algo) "/"
                         (bytevector->nix-base32-string hash))))
 
-     ;; XXX: (guix base16) appeared in March 2017 (and thus 0.13.0) so old
-     ;; installations of the daemon might lack it.  Thus, load it lazily to
-     ;; avoid gratuitous errors.  See <https://bugs.gnu.org/33542>.
-     (module-autoload! (current-module)
-                       '(guix base16) '(bytevector->base16-string))
-
      (list (guix-publish "ci.guix.gnu.org")
            (lambda (file algo hash)
              ;; 'tarballs.nixos.org' supports several algorithms.
@@ -406,6 +400,8 @@
               (object->string %content-addressed-mirrors)))
 
 (define %disarchive-mirrors
+  ;; TODO: Eventually turn into a procedure that takes a hash algorithm
+  ;; (symbol) and hash (bytevector).
   '("https://disarchive.ngyro.com/"))
 
 (define %disarchive-mirror-file
diff --git a/guix/git.scm b/guix/git.scm
index 9c6f326c36..acc48fd12f 100644
--- a/guix/git.scm
+++ b/guix/git.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2017, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2021 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -223,15 +224,29 @@ corresponding Git object."
              (object-lookup-prefix repository (string->oid commit) len)
              (object-lookup repository (string->oid commit)))))
       (('tag-or-commit . str)
-       (if (or (> (string-length str) 40)
-               (not (string-every char-set:hex-digit str)))
-           (resolve `(tag . ,str))              ;definitely a tag
-           (catch 'git-error
-             (lambda ()
-               (resolve `(tag . ,str)))
-             (lambda _
-               ;; There's no such tag, so it must be a commit ID.
-               (resolve `(commit . ,str))))))
+       (cond ((and (string-contains str "-g")
+                   (match (string-split str #\-)
+                     ((version ... revision g+commit)
+                      (if (and (> (string-length g+commit) 4)
+                               (string-every char-set:digit revision)
+                               (string-every char-set:hex-digit
+                                             (string-drop g+commit 1)))
+                          ;; Looks like a 'git describe' style ID, like
+                          ;; v1.3.0-7-gaa34d4d28d.
+                          (string-drop g+commit 1)
+                          #f))
+                     (_ #f)))
+              => (lambda (commit) (resolve `(commit . ,commit))))
+             ((or (> (string-length str) 40)
+                  (not (string-every char-set:hex-digit str)))
+              (resolve `(tag . ,str)))      ;definitely a tag
+             (else
+              (catch 'git-error
+                (lambda ()
+                  (resolve `(tag . ,str)))
+                (lambda _
+                  ;; There's no such tag, so it must be a commit ID.
+                  (resolve `(commit . ,str)))))))
       (('tag    . tag)
        (let ((oid (reference-name->oid repository
                                        (string-append "refs/tags/" tag))))
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index e9a0179b3d..98d7234098 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Federico Beffa <beffa@fbengineering.ch>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -399,14 +400,20 @@ matching a string against the created regexp."
 
 (define (is-or s) (string=? s "||"))
 
-(define (is-id s port)
+(define (is-id s port loc)
   (let ((cabal-reserved-words
          '("if" "else" "library" "flag" "executable" "test-suite" "custom-setup"
            "source-repository" "benchmark" "common"))
         (spaces (read-while (cut char-set-contains? char-set:blank <>) port))
         (c (peek-char port)))
     (unread-string spaces port)
-    (and (every (cut string-ci<> s <>) cabal-reserved-words)
+    ;; Sometimes the name of an identifier is the same as one of the reserved
+    ;; words, which would normally lead to an error, see
+    ;; <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=25138>.  Unless the word
+    ;; is at the beginning of a line (excluding whitespace), treat is as just
+    ;; another identifier instead of a reserved word.
+    (and (or (not (= (source-location-column loc) (current-indentation)))
+             (every (cut string-ci<> s <>) cabal-reserved-words))
          (and (not (char=? (last (string->list s)) #\:))
               (not (char=? #\: c))))))
 
@@ -568,7 +575,7 @@ LOC is the current port location."
           ((is-none w) (lex-none loc))
           ((is-and w) (lex-and loc))
           ((is-or w) (lex-or loc))
-          ((is-id w port) (lex-id w loc))
+          ((is-id w port loc) (lex-id w loc))
           (else (unread-string w port) #f))))
 
 (define (lex-line port loc)
diff --git a/guix/import/elpa.scm b/guix/import/elpa.scm
index 0a1c414c25..05b4a45f2f 100644
--- a/guix/import/elpa.scm
+++ b/guix/import/elpa.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2020 Martin Becze <mjbecze@riseup.net>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -80,6 +81,7 @@ NAMES (strings)."
   (let ((elpa-archives
          '((gnu . "https://elpa.gnu.org/packages")
            (gnu/http . "http://elpa.gnu.org/packages") ;for testing
+           (nongnu . "https://elpa.nongnu.org/nongnu")
            (melpa-stable . "https://stable.melpa.org/packages")
            (melpa . "https://melpa.org/packages"))))
     (assq-ref elpa-archives repo)))
@@ -257,7 +259,7 @@ RECIPE."
      ((assoc-ref recipe #:commit)
       => (lambda (commit) (cons 'commit commit)))
      (else
-      '(branch . "master"))))
+      '())))
 
   (let-values (((directory commit) (download-git-repository url ref)))
     `(origin
diff --git a/guix/import/go.scm b/guix/import/go.scm
index 4755571209..c6ecdbaffd 100644
--- a/guix/import/go.scm
+++ b/guix/import/go.scm
@@ -485,9 +485,12 @@ build a package."
     (match (select (html->sxml meta-data #:strict? #t))
       (() #f)                           ;nothing selected
       ((('content content-text) ..1)
-       (find (lambda (meta)
-               (string-prefix? (module-meta-import-prefix meta) module-path))
-             (map go-import->module-meta content-text))))))
+       (or
+        (find (lambda (meta)
+                (string-prefix? (module-meta-import-prefix meta) module-path))
+              (map go-import->module-meta content-text))
+        ;; Fallback to the first meta if no import prefixes match.
+        (go-import->module-meta (first content-text)))))))
 
 (define (module-meta-data-repo-url meta-data goproxy)
   "Return the URL where the fetcher which will be used can download the
diff --git a/guix/lint.scm b/guix/lint.scm
index d76a2f5e03..217a0d6696 100644
--- a/guix/lint.scm
+++ b/guix/lint.scm
@@ -1594,7 +1594,11 @@ Disarchive entry refers to non-existent SWH directory '~a'")
                                               #:field 'source)))))))
                    ((? content?)
                     '())))
-               '()))))
+               '()))
+          (_
+           (list (make-warning package
+                               (G_ "unsupported source type")
+                               #:field 'source)))))
       (match-lambda*
         (('swh-error url method response)
          (response->warning url method response))
diff --git a/guix/packages.scm b/guix/packages.scm
index 2349bb4340..863c12d528 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -56,6 +56,7 @@
                %current-target-system
                search-path-specification)         ;for convenience
   #:re-export-and-replace (delete)                ;used as syntactic keyword
+  #:replace ((define-public* . define-public))
   #:export (content-hash
             content-hash?
             content-hash-algorithm
@@ -103,6 +104,7 @@
             package-supported-systems
             package-properties
             package-location
+            package-definition-location
             hidden-package
             hidden-package?
             package-superseded
@@ -388,6 +390,60 @@ not already the case."
          inputs)
         (else (map add-input-label inputs))))
 
+(define-syntax current-location-vector
+  (lambda (s)
+    "Like 'current-source-location' but expand to a literal vector with
+one-indexed line numbers."
+    ;; Storing a literal vector in .go files is more efficient than storing an
+    ;; alist: less initialization code, fewer relocations, etc.
+    (syntax-case s ()
+      ((_)
+       (match (syntax-source s)
+         (#f #f)
+         (properties
+          (let ((file   (assq-ref properties 'filename))
+                (line   (assq-ref properties 'line))
+                (column (assq-ref properties 'column)))
+            (and file line column
+                 #`#(#,file #,(+ 1 line) #,column)))))))))
+
+(define-inlinable (sanitize-location loc)
+  ;; Convert LOC to a vector or to #f.
+  (cond ((vector? loc) loc)
+        ((not loc) loc)
+        (else (vector (location-file loc)
+                      (location-line loc)
+                      (location-column loc)))))
+
+(define-syntax-parameter current-definition-location
+  ;; Location of the encompassing 'define-public'.
+  (const #f))
+
+(define-syntax define-public*
+  (lambda (s)
+    "Like 'define-public' but set 'current-definition-location' for the
+lexical scope of its body."
+    (define location
+      (match (syntax-source s)
+        (#f #f)
+        (properties
+         (let ((line   (assq-ref properties 'line))
+               (column (assq-ref properties 'column)))
+           ;; Don't repeat the file name since it's redundant with 'location'.
+           ;; Encode the whole thing so that it fits in a fixnum on 32-bit
+           ;; platforms, which leaves us 29 bits: 7 bits for COLUMN (which is
+           ;; almost always zero), and 22 bits for LINE.
+           (and line column
+                (logior (ash (logand #x7f column) 22)
+                        (logand (- (expt 2 22) 1) (+ 1 line))))))))
+
+    (syntax-case s ()
+      ((_ prototype body ...)
+       #`(define-public prototype
+           (syntax-parameterize ((current-definition-location
+                                  (lambda (s) #,location)))
+             body ...))))))
+
 ;; A package.
 (define-record-type* <package>
   package make-package
@@ -434,10 +490,12 @@ not already the case."
 
   (properties package-properties (default '()))   ; alist for anything else
 
-  (location package-location
-            (default (and=> (current-source-location)
-                            source-properties->location))
-            (innate)))
+  (location package-location-vector
+            (default (current-location-vector))
+            (innate) (sanitize sanitize-location))
+  (definition-location package-definition-location-code
+                       (default (current-definition-location))
+                       (innate)))
 
 (define (add-input-label input)
   "Add an input label to INPUT."
@@ -473,6 +531,25 @@ not already the case."
                                                        package)
                                                       16)))))
 
+(define (package-location package)
+  "Return the source code location of PACKAGE as a <location> record, or #f if
+it is not known."
+  (match (package-location-vector package)
+    (#f #f)
+    (#(file line column) (location file line column))))
+
+(define (package-definition-location package)
+  "Like 'package-location', but return the location of the definition
+itself--i.e., that of the enclosing 'define-public' form, if any, or #f."
+  (match (package-definition-location-code package)
+    (#f #f)
+    (code
+     (let ((column (bit-extract code 22 29))
+           (line   (bit-extract code 0 21)))
+      (match (package-location-vector package)
+        (#f #f)
+        (#(file _ _) (location file line column)))))))
+
 (define-syntax-rule (package/inherit p overrides ...)
   "Like (package (inherit P) OVERRIDES ...), except that the same
 transformation is done to the package P's replacement, if any.  P must be a bare
diff --git a/guix/scripts/import.scm b/guix/scripts/import.scm
index b369a362d0..40fa6759ae 100644
--- a/guix/scripts/import.scm
+++ b/guix/scripts/import.scm
@@ -3,6 +3,8 @@
 ;;; Copyright © 2014 David Thompson <davet@gnu.org>
 ;;; Copyright © 2018 Kyle Meyer <kyle@kyleam.com>
 ;;; Copyright © 2019 Ricardo Wurmus <rekado@elephly.net>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
+;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -117,7 +119,8 @@ Run IMPORTER with ARGS.\n"))
      (if (member importer importers)
          (let ((print (lambda (expr)
                         (pretty-print expr (newline-rewriting-port
-                                            (current-output-port))))))
+                                            (current-output-port))
+                                      #:max-expr-width 80))))
            (match (apply (resolve-importer importer) args)
              ((and expr (or ('package _ ...)
                             ('let _ ...)
@@ -130,4 +133,9 @@ Run IMPORTER with ARGS.\n"))
                         expressions))
              (x
               (leave (G_ "'~a' import failed~%") importer))))
-         (leave (G_ "~a: invalid importer~%") importer)))))
+         (let ((hint (string-closest importer importers #:threshold 3)))
+           (report-error (G_ "~a: invalid importer~%") importer)
+           (when hint
+             (display-hint
+              (format #f (G_ "Did you mean @code{~a}?~%") hint)))
+           (exit 1))))))
diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index 83bbefd3dc..65eb98e4b2 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2020 Julien Lepiller <julien@lepiller.eu>
 ;;; Copyright © 2020 Efraim Flashner <efraim@flashner.co.il>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2021 Simon Tournier <zimon.toutoune@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1152,6 +1153,13 @@ Some ACTIONS support additional ARGS.\n"))
 ;;; Entry point.
 ;;;
 
+(define actions '("build" "container" "vm" "vm-image" "image" "disk-image"
+                  "reconfigure" "init"
+                  "extension-graph" "shepherd-graph"
+                  "list-generations" "describe"
+                  "delete-generations" "roll-back"
+                  "switch-generation" "search" "docker-image"))
+
 (define (process-action action args opts)
   "Process ACTION, a sub-command, with the arguments are listed in ARGS.
 ACTION must be one of the sub-commands that takes an operating system
@@ -1335,17 +1343,18 @@ argument list and OPTS is the option alist."
 
   (define (parse-sub-command arg result)
     ;; Parse sub-command ARG and augment RESULT accordingly.
-    (if (assoc-ref result 'action)
-        (alist-cons 'argument arg result)
-        (let ((action (string->symbol arg)))
-          (case action
-            ((build container vm vm-image image disk-image reconfigure init
-              extension-graph shepherd-graph
-              list-generations describe
-              delete-generations roll-back
-              switch-generation search docker-image)
-             (alist-cons 'action action result))
-            (else (leave (G_ "~a: unknown action~%") action))))))
+    (cond ((assoc-ref result 'action)
+           (alist-cons 'argument arg result))
+          ((member arg actions)
+           (let ((action (string->symbol arg)))
+             (alist-cons 'action action result)))
+          (else
+           (let ((hint (string-closest arg actions #:threshold 3)))
+             (report-error (G_ "~a: unknown action~%") arg)
+             (when hint
+               (display-hint
+                (format #f (G_ "Did you mean @code{~a}?~%") hint)))
+             (exit 1)))))
 
   (define (match-pair car)
     ;; Return a procedure that matches a pair with CAR.
diff --git a/guix/store.scm b/guix/store.scm
index 0463b0e8fa..89a719bcfc 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1355,14 +1355,16 @@ on the build output of a previous derivation."
       (unresolved things continue)
       (continue #t)))
 
-(define (map/accumulate-builds store proc lst)
+(define* (map/accumulate-builds store proc lst
+                                #:key (cutoff 30))
   "Apply PROC over each element of LST, accumulating 'build-things' calls and
-coalescing them into a single call."
-  (define accumulation-cutoff
-    ;; Threshold above which we stop accumulating unresolved nodes to avoid
-    ;; pessimal behavior where we keep stumbling upon the same .drv build
-    ;; requests with many incoming edges.  See <https://bugs.gnu.org/49439>.
-    30)
+coalescing them into a single call.
+
+CUTOFF is the threshold above which we stop accumulating unresolved nodes."
+
+  ;; The CUTOFF parameter helps avoid pessimal behavior where we keep
+  ;; stumbling upon the same .drv build requests with many incoming edges.
+  ;; See <https://bugs.gnu.org/49439>.
 
   (define-values (result rest)
     (let loop ((lst lst)
@@ -1373,7 +1375,7 @@ coalescing them into a single call."
          (match (with-build-handler build-accumulator
                   (proc head))
            ((? unresolved? obj)
-            (if (> unresolved accumulation-cutoff)
+            (if (>= unresolved cutoff)
                 (values (reverse (cons obj result)) tail)
                 (loop tail (cons obj result) (+ 1 unresolved))))
            (obj
@@ -1390,17 +1392,20 @@ coalescing them into a single call."
      ;; REST is necessarily empty.
      result)
     (to-build
-     ;; We've accumulated things TO-BUILD.  Actually build them and resume the
-     ;; corresponding continuations.
+     ;; We've accumulated things TO-BUILD; build them.
      (build-things store (delete-duplicates to-build))
-     (map/accumulate-builds store
-                            (lambda (obj)
-                              (if (unresolved? obj)
-                                  ;; Pass #f because 'build-things' is now
-                                  ;; unnecessary.
-                                  ((unresolved-continuation obj) #f)
-                                  obj))
-                            (append result rest)))))
+
+     ;; Resume the continuations corresponding to TO-BUILD, and then process
+     ;; REST.
+     (append (map/accumulate-builds store
+                                    (lambda (obj)
+                                      (if (unresolved? obj)
+                                          ;; Pass #f because 'build-things' is now
+                                          ;; unnecessary.
+                                          ((unresolved-continuation obj) #f)
+                                          obj))
+                                    result #:cutoff cutoff)
+         (map/accumulate-builds store proc rest #:cutoff cutoff)))))
 
 (define build-things
   (let ((build (operation (build-things (string-list things)
diff --git a/guix/swh.scm b/guix/swh.scm
index 922d781a7b..a62567dd58 100644
--- a/guix/swh.scm
+++ b/guix/swh.scm
@@ -104,10 +104,9 @@
             vault-reply?
             vault-reply-id
             vault-reply-fetch-url
-            vault-reply-object-id
-            vault-reply-object-type
             vault-reply-progress-message
             vault-reply-status
+            vault-reply-swhid
             query-vault
             request-cooking
             vault-fetch
@@ -391,10 +390,9 @@ FALSE-IF-404? is true, return #f upon 404 responses."
   json->vault-reply
   (id             vault-reply-id)
   (fetch-url      vault-reply-fetch-url "fetch_url")
-  (object-id      vault-reply-object-id "obj_id")
-  (object-type    vault-reply-object-type "obj_type" string->symbol)
   (progress-message vault-reply-progress-message "progress_message")
-  (status         vault-reply-status "status" string->symbol))
+  (status         vault-reply-status "status" string->symbol)
+  (swhid          vault-reply-swhid))
 
 
 ;;;
@@ -540,35 +538,57 @@ directory entries; if it has type 'file, return its <content> object."
   (path "/api/1/origin/save" type "url" url)
   json->save-reply)
 
-(define-query (query-vault id kind)
-  "Ask the availability of object ID and KIND to the vault, where KIND is
-'directory or 'revision.  Return #f if it could not be found, or a
-<vault-reply> on success."
-  ;; <https://docs.softwareheritage.org/devel/swh-vault/api.html#vault-api-ref>
-  ;; There's a single format supported for directories and revisions and for
-  ;; now, the "/format" bit of the URL *must* be omitted.
-  (path "/api/1/vault" (symbol->string kind) id)
-  json->vault-reply)
-
-(define (request-cooking id kind)
-  "Request the cooking of object ID and KIND (one of 'directory or 'revision)
-to the vault.  Return a <vault-reply>."
-  (call (swh-url "/api/1/vault" (symbol->string kind) id)
+(define* (vault-url id kind #:optional (archive-type 'flat))
+  "Return the vault query/cooking URL for ID and KIND.  Normally, ID is an
+SWHID and KIND is #f; the deprecated convention is to set ID to a raw
+directory or revision ID and KIND to 'revision or 'directory."
+  ;; Note: /api/1/vault/directory/ID was deprecated in favor of
+  ;; /api/1/vault/flat/SWHID; this procedure "converts" automatically.
+  (let ((id (match kind
+              ('directory (string-append "swh:1:dir:" id))
+              ('revision  (string-append "swh:1:rev:" id))
+              (#f         id))))
+    (swh-url "/api/1/vault" (symbol->string archive-type) id)))
+
+(define* (query-vault id #:optional kind #:key (archive-type 'flat))
+  "Ask the availability of object ID (an SWHID) to the vault.  Return #f if it
+could not be found, or a <vault-reply> on success.  ARCHIVE-TYPE can be 'flat
+for a tarball containing a directory, or 'git-bare for a tarball containing a
+bare Git repository corresponding to a revision.
+
+Passing KIND (one of 'directory or 'revision) together with a raw revision or
+directory identifier is deprecated."
+  (call (vault-url id kind archive-type)
+        json->vault-reply))
+
+(define* (request-cooking id #:optional kind #:key (archive-type 'flat))
+  "Request the cooking of object ID, an SWHID.  Return a <vault-reply>.
+ARCHIVE-TYPE can be 'flat for a tarball containing a directory, or 'git-bare
+for a tarball containing a bare Git repository corresponding to a revision.
+
+Passing KIND (one of 'directory or 'revision) together with a raw revision or
+directory identifier is deprecated."
+  (call (vault-url id kind archive-type)
         json->vault-reply
         http-post*))
 
-(define* (vault-fetch id kind
-                      #:key (log-port (current-error-port)))
-  "Return an input port from which a bundle of the object with the given ID
-and KIND (one of 'directory or 'revision) can be retrieved, or #f if the
-object could not be found.
-
-For a directory, the returned stream is a gzip-compressed tarball.  For a
-revision, it is a gzip-compressed stream for 'git fast-import'."
-  (let loop ((reply (query-vault id kind)))
+(define* (vault-fetch id
+                      #:optional kind
+                      #:key
+                      (archive-type 'flat)
+                      (log-port (current-error-port)))
+  "Return an input port from which a bundle of the object with the given ID,
+an SWHID, or #f if the object could not be found.
+
+ARCHIVE-TYPE can be 'flat for a tarball containing a directory, or 'git-bare
+for a tarball containing a bare Git repository corresponding to a revision."
+  (let loop ((reply (query-vault id kind
+                                 #:archive-type archive-type)))
     (match reply
       (#f
-       (and=> (request-cooking id kind) loop))
+       (and=> (request-cooking id kind
+                               #:archive-type archive-type)
+              loop))
       (_
        (match (vault-reply-status reply)
          ('done
@@ -588,7 +608,8 @@ revision, it is a gzip-compressed stream for 'git fast-import'."
           (format log-port "SWH vault: failure: ~a~%"
                   (vault-reply-progress-message reply))
           (format log-port "SWH vault: retrying...~%")
-          (loop (request-cooking id kind)))
+          (loop (request-cooking id kind
+                                 #:archive-type archive-type)))
          ((and (or 'new 'pending) status)
           ;; Wait until the bundle shows up.
           (let ((message (vault-reply-progress-message reply)))
@@ -603,7 +624,8 @@ requested bundle cooking, waiting for completion...~%"))
             ;; requests per hour per IP address.)
             (sleep (if (eq? status 'new) 60 30))
 
-            (loop (query-vault id kind)))))))))
+            (loop (query-vault id kind
+                               #:archive-type archive-type)))))))))
 
 
 ;;;
@@ -675,4 +697,7 @@ wait until it becomes available, which could take several minutes."
      (swh-download-directory (revision-directory revision) output
                              #:log-port log-port))
     (#f
+     (format log-port
+             "SWH: revision ~s originating from ~a could not be found~%"
+             reference url)
      #f)))
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 5122baa403..5ae1977cb2 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -270,6 +271,25 @@ strings like \"guile-next=stable-3.0\" meaning that packages are built using
           (rewrite obj)
           obj))))
 
+(define (commit->version-string commit)
+  "Return a string suitable for use in the 'version' field of a package based
+on the given COMMIT."
+  (cond ((and (> (string-length commit) 1)
+              (string-prefix? "v" commit)
+              (char-set-contains? char-set:digit
+                                  (string-ref commit 1)))
+         ;; Probably a tag like "v1.0" or a 'git describe' identifier.
+         (string-drop commit 1))
+        ((not (string-every char-set:hex-digit commit))
+         ;; Pass through tags and 'git describe' style IDs directly.
+         commit)
+        (else
+         (string-append "git."
+                        (if (< (string-length commit) 7)
+                            commit
+                            (string-take commit 7))))))
+
+
 (define (transform-package-source-commit replacement-specs)
   "Return a procedure that, when passed a package, replaces its direct
 dependencies according to REPLACEMENT-SPECS.  REPLACEMENT-SPECS is a list of
@@ -278,15 +298,7 @@ strings like \"guile-next=cabba9e\" meaning that packages are built using
   (define (replace old url commit)
     (package
       (inherit old)
-      (version (if (and (> (string-length commit) 1)
-                        (string-prefix? "v" commit)
-                        (char-set-contains? char-set:digit
-                                            (string-ref commit 1)))
-                   (string-drop commit 1)        ;looks like a tag like "v1.0"
-                   (string-append "git."
-                                  (if (< (string-length commit) 7)
-                                      commit
-                                      (string-take commit 7)))))
+      (version (commit->version-string commit))
       (source (git-checkout (url url) (commit commit)
                             (recursive? #t)))))