Merge remote-tracking branch 'origin/master' into rust-team

Change-Id: Ic45f7071abd6a02c2ccad411500e5103c8272ffb

12 files changed, 175 insertions, 66 deletions

diff --git a/guix/grafts.scm b/guix/grafts.scm
index 48f4c212f7..f4df513daf 100644
--- a/guix/grafts.scm
+++ b/guix/grafts.scm
@@ -22,7 +22,7 @@
   #:use-module (guix records)
   #:use-module (guix combinators)
   #:use-module (guix derivations)
-  #:use-module ((guix utils) #:select (%current-system))
+  #:use-module ((guix utils) #:select (%current-system target-hurd?))
   #:use-module (guix sets)
   #:use-module (guix gexp)
   #:use-module (srfi srfi-1)
@@ -98,7 +98,9 @@ OUTPUTS of DRV.  This procedure performs \"shallow\" grafting in that GRAFTS
 are not recursively applied to dependencies of DRV."
   (define glibc-locales
     (module-ref (resolve-interface '(gnu packages commencement))
-                'glibc-utf8-locales-final))
+                (if (target-hurd? system)
+                    'glibc-utf8-locales-final/hurd
+                    'glibc-utf8-locales-final)))
 
   (define mapping
     ;; List of store item pairs.
diff --git a/guix/import/cabal.scm b/guix/import/cabal.scm
index fe03c30254..d32c1c15fe 100644
--- a/guix/import/cabal.scm
+++ b/guix/import/cabal.scm
@@ -130,8 +130,17 @@ to the stack."
 
 (define (context-stack-clear!) ((context-stack) 'clear!))
 
-;; Indentation of the line being parsed.
-(define current-indentation (make-parameter 0))
+;; Indentation of the line being parsed and that of the previous line.
+(define current-indentation* (make-parameter 0))
+
+(define previous-indentation (make-parameter 0))
+
+(define* (current-indentation #:optional value)
+  (if value
+    (begin
+      (previous-indentation (current-indentation*))
+      (current-indentation* value))
+    (current-indentation*)))
 
 ;; Signal to reprocess the beginning of line, in case we need to close more
 ;; than one indentation level.
@@ -196,27 +205,13 @@ to the stack."
                 (exprs elif-else)          : (append $1 (list ($2 '(()))))
                 (elif-else)                : (list ($1 '(()))))
    ;; LALR(1) parsers prefer to be left-recursive, which make if-statements slightly involved.
-   ;; XXX: This technically allows multiple else statements.
-   (elif-else   (elif-else ELIF tests OCURLY exprs CCURLY) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
-                (elif-else ELIF tests open exprs close) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
-                (elif-else ELSE OCURLY exprs CCURLY) : (lambda (y) ($1 (list $4)))
-                ;; The 'open' token after 'tests' is shifted after an 'exprs'
-                ;; is found.  This is because, instead of 'exprs' a 'OCURLY'
-                ;; token is a valid alternative.  For this reason, 'open'
-                ;; pushes a <parse-context> with a line indentation equal to
-                ;; the indentation of 'exprs'.
-                ;;
-                ;; Differently from this, without the rule above this
-                ;; comment, when an 'ELSE' token is found, the 'open' token
-                ;; following the 'ELSE' would be shifted immediately, before
-                ;; the 'exprs' is found (because there are no other valid
-                ;; tokens).  The 'open' would therefore create a
-                ;; <parse-context> with the indentation of 'ELSE' and not
-                ;; 'exprs', creating an inconsistency.  We therefore allow
-                ;; mixed style conditionals.
-                (elif-else ELSE open exprs close) : (lambda (y) ($1 (list $4)))
+   (elif        (elif ELIF tests OCURLY exprs CCURLY) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
+                (elif ELIF tests open exprs close) : (lambda (y) ($1 (list (append (list 'if $3 $5) y))))
                 ;; Terminating rule.
                 (if-then) : (lambda (y) (append $1 y)))
+   (elif-else   (elif ELSE OCURLY exprs CCURLY) : (lambda (y) ($1 (list $4)))
+                (elif ELSE open exprs close)    : (lambda (y) ($1 (list $4)))
+                (elif)                          : $1)
    (if-then     (IF tests OCURLY exprs CCURLY) : (list 'if $2 $4)
                 (IF tests open exprs close)    : (list 'if $2 $4))
    (tests       (TEST OPAREN ID CPAREN)        : `(,$1 ,$3)
@@ -237,7 +232,7 @@ to the stack."
                (OPAREN tests CPAREN)           : $2)
    (open       () : (context-stack-push!
                                    (make-parse-context (context layout)
-                                                       (current-indentation))))
+                                                       (+ 1 (previous-indentation)))))
    (close      (VCCURLY))))
 
 (define (peek-next-line-indent port)
@@ -655,7 +650,8 @@ If #f use the function 'port-filename' to obtain it."
   (let ((cabal-parser (make-cabal-parser)))
     (parameterize ((cabal-file-name
                     (or file-name (port-filename port) "standard input"))
-                   (current-indentation 0)
+                   (current-indentation* 0)
+                   (previous-indentation 0)
                    (check-bol? #f)
                    (context-stack (make-stack)))
       (cabal-parser (make-lexer port) (errorp)))))
@@ -869,7 +865,16 @@ the ordering operation and the version."
       (((? string? name) values)
        (list name values))
       ((("import" imports) rest ...)
-       (eval (append (append-map (cut assoc-ref common-stanzas <>) imports)
+       (eval (append (append-map
+                     ;; The imports are (at least sometimes) a list with one string
+                     ;; containing all the names separeted by commas. This splits
+                     ;; those strings to a list of strings in the same format that is
+                     ;; used in common-stanzas.
+                     (cut assoc-ref common-stanzas <>)
+                      (append-map (lambda (imports-string)
+                                    (map (compose string-downcase string-trim-both)
+                                         (string-split imports-string #\,)))
+                                  imports))
                      rest)))
       ((element rest ...)
        (cons (eval element) (eval rest)))
diff --git a/guix/import/hackage.scm b/guix/import/hackage.scm
index 9333bedbbd..bbaee73a06 100644
--- a/guix/import/hackage.scm
+++ b/guix/import/hackage.scm
@@ -335,7 +335,7 @@ the hash of the Cabal file."
         (synopsis ,(cabal-package-synopsis cabal))
         (description ,(beautify-description (cabal-package-description cabal)))
         (license ,(string->license (cabal-package-license cabal))))
-     inputs)))
+     (map upstream-input-name inputs))))
 
 (define* (hackage->guix-package package-name #:key
                                 (include-test-dependencies? #t)
diff --git a/guix/import/stackage.scm b/guix/import/stackage.scm
index 00814c7d46..f801835b33 100644
--- a/guix/import/stackage.scm
+++ b/guix/import/stackage.scm
@@ -92,7 +92,7 @@
   "Return the version of the package with upstream NAME included in PACKAGES."
   (let ((pkg (find (lambda (pkg) (string=? (stackage-package-name pkg) name))
                    packages)))
-    (stackage-package-version pkg)))
+    (and=> pkg stackage-package-version)))
 
 
 ;;;
diff --git a/guix/monad-repl.scm b/guix/monad-repl.scm
index 8a6053edd5..d6b39112b7 100644
--- a/guix/monad-repl.scm
+++ b/guix/monad-repl.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014, 2015, 2016, 2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2016, 2022-2023 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -21,13 +21,15 @@
   #:use-module (guix monads)
   #:use-module (guix utils)
   #:use-module (guix packages)
+  #:autoload   (guix build-system) (bag)
   #:use-module (guix status)
-  #:autoload   (guix gexp) (lower-object)
+  #:autoload   (guix gexp) (gexp gexp? lower-gexp lowered-gexp-sexp lower-object)
   #:use-module ((guix derivations)
                 #:select (derivation?
                           derivation->output-paths built-derivations))
+  #:autoload   (guix read-print) (pretty-print-with-comments)
   #:use-module (ice-9 match)
-  #:use-module (ice-9 pretty-print)
+  #:autoload   (ice-9 pretty-print) (pretty-print)
   #:use-module (system repl repl)
   #:use-module (system repl common)
   #:use-module (system repl command)
@@ -138,4 +140,68 @@ Enter a REPL for values in the store monad."
       (repl-option-set! new 'interp #t)
       (run-repl new))))
 
-;;; monad-repl.scm ends here
+
+;;;
+;;; Viewing package arguments.
+;;;
+
+(define (keyword-argument-value args keyword default)
+  "Return the value associated with KEYWORD in ARGS, a keyword/value sequence,
+or DEFAULT if KEYWORD is missing from ARGS."
+  (let loop ((args args))
+    (match args
+      (()
+       default)
+      ((kw value rest ...)
+       (if (eq? kw keyword)
+           value
+           (loop rest))))))
+
+(define (package-argument-command repl form keyword default)
+  "Implement a command that display KEYWORD, a keyword such as #:phases, in
+the arguments of the package FORM evaluates to.  Return DEFAULT is KEYWORD is
+missing from those arguments."
+  (match (repl-eval repl form)
+    ((? package? package)
+     (let* ((bag* (bag
+                    (inherit (package->bag package))
+                    (build (lambda* (name inputs #:rest args)
+                             (with-monad %store-monad
+                               (return (keyword-argument-value args keyword
+                                                               default))))))))
+       (define phases
+         (parameterize ((%graft? #f))
+           (with-store store
+             (set-build-options store
+                                #:print-build-trace #t
+                                #:print-extended-build-trace? #t
+                                #:multiplexed-build-output? #t)
+             (run-with-store store
+               (mlet %store-monad ((exp (bag->derivation bag*)))
+                 (if (gexp? exp)
+                     (mlet %store-monad ((gexp (lower-gexp exp)))
+                       (return (lowered-gexp-sexp gexp)))
+                     (return exp)))))))
+
+       (run-hook before-print-hook phases)
+       (let ((column (port-column (current-output-port))))
+         (pretty-print-with-comments (current-output-port) phases
+                                     #:indent column)
+         (newline (current-output-port)))))
+    (_
+     (format #t ";; ERROR: This command only accepts package records.~%"))))
+
+(define-meta-command ((phases guix) repl (form))
+  "phases
+Return the build phases of the package defined by FORM."
+  (package-argument-command repl form #:phases #~%standard-phases))
+
+(define-meta-command ((configure-flags guix) repl (form))
+  "configure-flags
+Return the configure flags of the package defined by FORM."
+  (package-argument-command repl form #:configure-flags #~'()))
+
+(define-meta-command ((make-flags guix) repl (form))
+  "make-flags
+Return the make flags of the package defined by FORM."
+  (package-argument-command repl form #:make-flags #~'()))
diff --git a/guix/packages.scm b/guix/packages.scm
index e2e82692ad..930b1a3b0e 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -849,14 +849,15 @@ identifiers.  The result is inferred from the file names of patches."
                                  '()))))
     (append-map patch-vulnerabilities patches)))
 
-(define (%standard-patch-inputs)
+(define (%standard-patch-inputs system)
   (let* ((canonical (module-ref (resolve-interface '(gnu packages base))
                                 'canonical-package))
          (ref       (lambda (module var)
                       ;; Make sure 'canonical-package' is not influenced by
                       ;; '%current-target-system' since we're going to use the
                       ;; native package anyway.
-                      (parameterize ((%current-target-system #f))
+                      (parameterize ((%current-target-system #f)
+                                     (%current-system system))
                         (canonical
                          (module-ref (resolve-interface module) var))))))
     `(("tar"   ,(ref '(gnu packages base) 'tar))
@@ -866,7 +867,12 @@ identifiers.  The result is inferred from the file names of patches."
       ("lzip"  ,(ref '(gnu packages compression) 'lzip))
       ("unzip" ,(ref '(gnu packages compression) 'unzip))
       ("patch" ,(ref '(gnu packages base) 'patch))
-      ("locales" ,(ref '(gnu packages base) 'glibc-utf8-locales)))))
+      ("locales"
+       ,(parameterize ((%current-target-system #f)
+                       (%current-system system))
+          (canonical
+           ((module-ref (resolve-interface '(gnu packages base))
+                        'libc-utf8-locales-for-target))))))))
 
 (define (default-guile)
   "Return the default Guile package used to run the build code of
@@ -909,7 +915,7 @@ specifies modules in scope when evaluating SNIPPET."
   (define lookup-input
     ;; The default value of the 'patch-inputs' field, and thus INPUTS is #f,
     ;; so deal with that.
-    (let ((inputs (or inputs (%standard-patch-inputs))))
+    (let ((inputs (or inputs (%standard-patch-inputs system))))
       (lambda (name)
         (match (assoc-ref inputs name)
           ((package) package)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 5d2fb8dc64..ce2f8337bf 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1000,8 +1000,9 @@ MANIFEST."
     (module-ref (resolve-interface '(gnu packages texinfo)) 'texinfo))
   (define gzip                                    ;lazy reference
     (module-ref (resolve-interface '(gnu packages compression)) 'gzip))
-  (define glibc-utf8-locales                      ;lazy reference
-    (module-ref (resolve-interface '(gnu packages base)) 'glibc-utf8-locales))
+  (define libc-utf8-locales-for-target            ;lazy reference
+    (module-ref (resolve-interface '(gnu packages base))
+                'libc-utf8-locales-for-target))
 
   (define build
     (with-imported-modules '((guix build utils))
@@ -1043,7 +1044,8 @@ MANIFEST."
 
           (setenv "PATH" (string-append #+gzip "/bin")) ;for info.gz files
           (setenv "GUIX_LOCPATH"
-                  #+(file-append glibc-utf8-locales "/lib/locale"))
+                  #+(file-append (libc-utf8-locales-for-target system)
+                                 "/lib/locale"))
 
           (mkdir-p (string-append #$output "/share/info"))
           (exit (every install-info
@@ -1124,8 +1126,9 @@ MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
   ;; See <http://lists.gnu.org/archive/html/guix-devel/2015-02/msg00429.html>
   ;; for a discussion.
 
-  (define glibc-utf8-locales                      ;lazy reference
-    (module-ref (resolve-interface '(gnu packages base)) 'glibc-utf8-locales))
+  (define libc-utf8-locales-for-target  ;lazy reference
+    (module-ref (resolve-interface '(gnu packages base))
+                'libc-utf8-locales-for-target))
 
   (define build
     (with-imported-modules '((guix build utils))
@@ -1159,9 +1162,11 @@ MANIFEST.  Single-file bundles are required by programs such as Git and Lynx."
           ;; Some file names in the NSS certificates are UTF-8 encoded so
           ;; install a UTF-8 locale.
           (setenv "LOCPATH"
-                  (string-append #+glibc-utf8-locales "/lib/locale/"
+                  (string-append #+(libc-utf8-locales-for-target system)
+                                 "/lib/locale/"
                                  #+(version-major+minor
-                                    (package-version glibc-utf8-locales))))
+                                    (package-version
+                                     (libc-utf8-locales-for-target system)))))
           (setlocale LC_ALL "en_US.utf8")
 
           (match (append-map ca-files '#$(manifest-inputs manifest))
@@ -1999,19 +2004,21 @@ are cross-built for TARGET."
                     (and (derivation? drv) (gexp-input drv)))
                   extras))
 
-    (define glibc-utf8-locales                    ;lazy reference
+    (define libc-utf8-locales-for-target ;lazy reference
       (module-ref (resolve-interface '(gnu packages base))
-                  'glibc-utf8-locales))
+                  'libc-utf8-locales-for-target))
 
     (define set-utf8-locale
       ;; Some file names (e.g., in 'nss-certs') are UTF-8 encoded so
       ;; install a UTF-8 locale.
-      #~(begin
-          (setenv "LOCPATH"
-                  #$(file-append glibc-utf8-locales "/lib/locale/"
-                                 (version-major+minor
-                                  (package-version glibc-utf8-locales))))
-          (setlocale LC_ALL "en_US.utf8")))
+      (let ((locales (libc-utf8-locales-for-target
+                      (or system (%current-system)))))
+        #~(begin
+            (setenv "LOCPATH"
+                    #$(file-append locales "/lib/locale/"
+                                   (version-major+minor
+                                    (package-version locales))))
+            (setlocale LC_ALL "en_US.utf8"))))
 
     (define builder
       (with-imported-modules '((guix build profiles)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 6ae3b11e39..1d7a6e198d 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -311,6 +311,9 @@ use '--preserve' instead~%"))
 (define (options/resolve-packages store opts)
   "Return OPTS with package specification strings replaced by manifest entries
 for the corresponding packages."
+  (define system
+    (assoc-ref opts 'system))
+
   (define (manifest-entry=? e1 e2)
     (and (eq? (manifest-entry-item e1) (manifest-entry-item e2))
          (string=? (manifest-entry-output e1)
@@ -327,11 +330,11 @@ for the corresponding packages."
       ((? package? package)
        (if (eq? mode 'ad-hoc-package)
            (list (package->manifest-entry* package))
-           (manifest-entries (package->development-manifest package))))
+           (manifest-entries (package->development-manifest package system))))
       (((? package? package) (? string? output))
        (if (eq? mode 'ad-hoc-package)
            (list (package->manifest-entry* package output))
-           (manifest-entries (package->development-manifest package))))
+           (manifest-entries (package->development-manifest package system))))
       ((lst ...)
        (append-map (cut packages->outputs <> mode) lst))))
 
@@ -345,7 +348,8 @@ for the corresponding packages."
                   (('package 'package (? string? spec))
                    (manifest-entries
                     (package->development-manifest
-                     (transform (specification->package+output spec)))))
+                     (transform (specification->package+output spec))
+                     system)))
                   (('expression mode str)
                    ;; Add all the outputs of the package STR evaluates to.
                    (packages->outputs (read/eval str) mode))
diff --git a/guix/scripts/pack.scm b/guix/scripts/pack.scm
index bdbea49910..8071840de1 100644
--- a/guix/scripts/pack.scm
+++ b/guix/scripts/pack.scm
@@ -137,7 +137,8 @@ dependencies are registered."
 
             ;; Make sure non-ASCII file names are properly handled.
             (setenv "GUIX_LOCPATH"
-                    #+(file-append glibc-utf8-locales "/lib/locale"))
+                    #+(file-append (libc-utf8-locales-for-target (%current-system))
+                                   "/lib/locale"))
             (setlocale LC_ALL "en_US.utf8")
 
             (sql-schema #$schema)
@@ -209,7 +210,10 @@ GLIBC-UT8-LOCALES package."
           (profile-locales? profile))
       #~(begin
           (setenv "GUIX_LOCPATH"
-                  #+(file-append glibc-utf8-locales "/lib/locale"))
+                  #+(file-append (let-system (system target)
+                                   (libc-utf8-locales-for-target
+                                    (or target system)))
+                                 "/lib/locale"))
           (setlocale LC_ALL "en_US.utf8"))
       #~(setenv "GUIX_LOCPATH" "unset for tests")))
 
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index 126f0f9c69..37cd08e289 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -635,8 +635,9 @@ way to download the nar."
   (let loop ((cache-urls cache-urls))
     (match cache-urls
       (()
-       (leave (G_ "failed to find alternative substitute for '~a'~%")
-              (narinfo-path narinfo)))
+       (report-error (G_ "failed to find alternative substitute for '~a'~%")
+                     (narinfo-path narinfo))
+       (display "not-found\n" port))
       ((cache-url rest ...)
        (match (lookup-narinfos cache-url
                                (list (narinfo-path narinfo))
diff --git a/guix/self.scm b/guix/self.scm
index a1f235659d..f378548959 100644
--- a/guix/self.scm
+++ b/guix/self.scm
@@ -73,7 +73,10 @@
       ("po4a"               . ,(ref 'gettext 'po4a))
       ("gettext-minimal"    . ,(ref 'gettext 'gettext-minimal))
       ("gcc-toolchain"      . ,(ref 'commencement 'gcc-toolchain))
-      ("glibc-utf8-locales" . ,(ref 'base 'glibc-utf8-locales))
+      ("glibc-utf8-locales" . ,(delay
+                                 ((module-ref (resolve-interface
+                                               '(gnu packages base))
+                                              'libc-utf8-locales-for-target))))
       ("graphviz"           . ,(ref 'graphviz 'graphviz-minimal))
       ("font-ghostscript"   . ,(ref 'ghostscript 'font-ghostscript))
       ("texinfo"            . ,(ref 'texinfo 'texinfo)))))
diff --git a/guix/transformations.scm b/guix/transformations.scm
index 9cba6bedab..132ccd957a 100644
--- a/guix/transformations.scm
+++ b/guix/transformations.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2021 Marius Bakke <marius@gnu.org>
 ;;; Copyright © 2023 Sarthak Shah <shahsarthakw@gmail.com>
 ;;; Copyright © 2023 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2023 Ekaitz Zarraga <ekaitz@elenq.tech>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -439,7 +440,8 @@ the equal sign."
 actual compiler."
     (define wrapper
       #~(begin
-          (use-modules (ice-9 match))
+          (use-modules (ice-9 match)
+                       (ice-9 string-fun))
 
           (define psabi #$(gcc-architecture->micro-architecture-level
                             micro-architecture))
@@ -486,11 +488,20 @@ actual compiler."
                 (apply
                   execl next
                        (append (cons next arguments)
-                         (if (and (search-next "go")
-                                  (string=? next (search-next "go")))
-                           '()
-                           (list (string-append "-march="
-                                                #$micro-architecture)))))))))))
+                         (cond
+                           ((and (search-next "go")
+                                 (string=? next (search-next "go")))
+                            '())
+                           ((and (search-next "zig")
+                                 (string=? next (search-next "zig")))
+                            `(,(string-append
+                                 ;; https://issues.guix.gnu.org/67075#3
+                                 "-Dcpu="
+                                 (string-replace-substring
+                                   #$micro-architecture "-" "_"))))
+                           (else
+                             (list (string-append "-march="
+                                                  #$micro-architecture))))))))))))
 
     (define program
       (program-file (string-append "tuning-compiler-wrapper-" micro-architecture)
@@ -508,7 +519,7 @@ actual compiler."
                                      (symlink #$program
                                               (string-append bin "/" program)))
                                    '("cc" "gcc" "clang" "g++" "c++" "clang++"
-                                     "go")))))))
+                                     "go" "zig")))))))
 
 (define (build-system-with-tuning-compiler bs micro-architecture)
   "Return a variant of BS, a build system, that ensures that the compiler that