diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/grafts.scm | 6 | ||||
| -rw-r--r-- | guix/import/cabal.scm | 53 | ||||
| -rw-r--r-- | guix/import/hackage.scm | 2 | ||||
| -rw-r--r-- | guix/import/stackage.scm | 2 | ||||
| -rw-r--r-- | guix/monad-repl.scm | 74 | ||||
| -rw-r--r-- | guix/packages.scm | 14 | ||||
| -rw-r--r-- | guix/profiles.scm | 37 | ||||
| -rw-r--r-- | guix/scripts/environment.scm | 10 | ||||
| -rw-r--r-- | guix/scripts/pack.scm | 8 | ||||
| -rwxr-xr-x | guix/scripts/substitute.scm | 5 | ||||
| -rw-r--r-- | guix/self.scm | 5 | ||||
| -rw-r--r-- | guix/transformations.scm | 25 |
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 |