From 886d04425e5a087816979b8a96b1e706693b5f93 Mon Sep 17 00:00:00 2001 From: jgart via Guix-patches via Date: Thu, 21 Oct 2021 17:40:55 -0400 Subject: guix: packages: Add comment on license field. * guix/packages/packages.scm (): Add comment about the type that the license field expects as part of a package record. Signed-off-by: Tobias Geerinckx-Rice --- guix/packages.scm | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 8c3a0b0b7b..e5a9d08bce 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -473,7 +473,7 @@ lexical scope of its body." (synopsis package-synopsis) ; one-line description (description package-description) ; one or two paragraphs - (license package-license) + (license package-license) ; instance or list (home-page package-home-page) (supported-systems package-supported-systems ; list of strings (default %supported-systems)) -- cgit v1.2.3 From fb368f4e760777e399aa58b08b89df1832fda8ba Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 1 Oct 2021 10:49:22 +0200 Subject: packages: Add 'package-development-inputs'. * guix/packages.scm (package-development-inputs): New procedure. * guix/scripts/environment.scm (package-environment-inputs): Use it. * tests/packages.scm ("package-development-inputs") ("package-development-inputs, cross-compilation"): New tests. * doc/guix.texi (package Reference): Document it. --- doc/guix.texi | 41 +++++++++++++++++++++++++++++++++++++++++ guix/packages.scm | 10 ++++++++++ guix/scripts/environment.scm | 2 +- tests/packages.scm | 14 ++++++++++++++ 4 files changed, 66 insertions(+), 1 deletion(-) (limited to 'guix/packages.scm') diff --git a/doc/guix.texi b/doc/guix.texi index b1a1e71055..31b8cd7069 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -6848,6 +6848,47 @@ cross-compiling: It is an error to refer to @code{this-package} outside a package definition. @end deffn +@cindex development inputs, of a package +@cindex implicit inputs, of a package +Sometimes you will want to obtain the list of inputs needed to +@emph{develop} a package---all the inputs that are visible when the +package is compiled. This is what the @code{package-development-inputs} +procedure returns. + +@deffn {Scheme Procedure} package-development-inputs @var{package} @ + [@var{system}] [#:target #f] +Return the list of inputs required by @var{package} for development +purposes on @var{system}. When @var{target} is true, return the inputs +needed to cross-compile @var{package} from @var{system} to +@var{triplet}, where @var{triplet} is a triplet such as +@code{"aarch64-linux-gnu"}. + +Note that the result includes both explicit inputs and implicit +inputs---inputs automatically added by the build system (@pxref{Build +Systems}). Let us take the @code{hello} package to illustrate that: + +@lisp +(use-modules (gnu packages base) (guix packages)) + +hello +@result{} # + +(package-direct-inputs hello) +@result{} () + +(package-development-inputs hello) +@result{} (("source" @dots{}) ("tar" #) @dots{}) +@end lisp + +In this example, @code{package-direct-inputs} returns the empty list, +because @code{hello} has zero explicit dependencies. Conversely, +@code{package-development-inputs} includes inputs implicitly added by +@code{gnu-build-system} that are required to build @code{hello}: tar, +gzip, GCC, libc, Bash, and more. To visualize it, @command{guix graph +hello} would show you explicit inputs, whereas @command{guix graph -t +bag hello} would include implicit inputs (@pxref{Invoking guix graph}). +@end deffn + Because packages are regular Scheme objects that capture a complete dependency graph and associated build procedures, it is often useful to write procedures that take a package and return a modified version diff --git a/guix/packages.scm b/guix/packages.scm index e5a9d08bce..b99689b9a4 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -153,6 +153,7 @@ bag-transitive-host-inputs bag-transitive-build-inputs bag-transitive-target-inputs + package-development-inputs package-closure default-guile @@ -1070,6 +1071,15 @@ dependencies are known to build on SYSTEM." (%current-system (bag-system bag))) (transitive-inputs (bag-target-inputs bag)))) +(define* (package-development-inputs package + #:optional (system (%current-system)) + #:key target) + "Return the list of inputs required by PACKAGE for development purposes on +SYSTEM. When TARGET is true, return the inputs needed to cross-compile +PACKAGE from SYSTEM to TRIPLET, where TRIPLET is a triplet such as +\"aarch64-linux-gnu\"." + (bag-transitive-inputs (package->bag package system target))) + (define* (package-closure packages #:key (system (%current-system))) "Return the closure of PACKAGES on SYSTEM--i.e., PACKAGES and the list of packages they depend on, recursively." diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index 6958bd6238..418f11c37e 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -82,7 +82,7 @@ package." packages for PACKAGE." ;; Remove non-package inputs such as origin records. (filter-map input->manifest-entry - (bag-transitive-inputs (package->bag package)))) + (package-development-inputs package))) (define (show-help) (display (G_ "Usage: guix environment [OPTION]... PACKAGE... [-- COMMAND...] diff --git a/tests/packages.scm b/tests/packages.scm index 3756877270..266b5aeb7a 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -353,6 +353,20 @@ (package-transitive-supported-systems d) (package-transitive-supported-systems e)))) +(test-assert "package-development-inputs" + ;; Note: Due to propagated inputs, 'package-development-inputs' returns a + ;; couple more inputs, such as 'linux-libre-headers'. + (lset<= equal? + `(("source" ,(package-source hello)) ,@(standard-packages)) + (package-development-inputs hello))) + +(test-assert "package-development-inputs, cross-compilation" + (lset<= equal? + `(("source" ,(package-source hello)) + ,@(standard-cross-packages "mips64el-linux-gnu" 'host) + ,@(standard-cross-packages "mips64el-linux-gnu" 'target)) + (package-development-inputs hello #:target "mips64el-linux-gnu"))) + (test-assert "package-closure" (let-syntax ((dummy-package/no-implicit (syntax-rules () -- cgit v1.2.3 From b7b0ac85443c719a616edee6963578e58396f339 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 26 Oct 2021 10:46:12 +0200 Subject: packages: Optimize 'package-transitive-supported-systems'. With this change, the wall-clock time of: ./pre-inst-env guile -c '(use-modules (gnu) (guix)(ice-9 time)) (time (pk (fold-packages (lambda (p r)(supported-package? p)(+ 1 r)) 0)))' goes from 3.2s to 2.0s, a 37% improvement. * guix/packages.scm (package-transitive-supported-systems): Change 'supported-systems' to 'supported-systems-procedure', returning an 'mlambdaq' instead of the original 'mlambda'. Add 'procs'. Adjust body accordingly. --- guix/packages.scm | 39 ++++++++++++++++++++++++++------------- 1 file changed, 26 insertions(+), 13 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index b99689b9a4..780c6ddb65 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -1018,23 +1018,36 @@ in INPUTS and their transitive propagated inputs." (define package-transitive-supported-systems (let () - (define supported-systems - (mlambda (package system) - (parameterize ((%current-system system)) - (fold (lambda (input systems) - (match input - ((label (? package? package) . _) - (lset-intersection string=? systems - (supported-systems package system))) - (_ - systems))) - (package-supported-systems package) - (bag-direct-inputs (package->bag package)))))) + (define (supported-systems-procedure system) + (define supported-systems + (mlambdaq (package) + (parameterize ((%current-system system)) + (fold (lambda (input systems) + (match input + ((label (? package? package) . _) + (lset-intersection string=? systems + (supported-systems package))) + (_ + systems))) + (package-supported-systems package) + (bag-direct-inputs (package->bag package)))))) + + supported-systems) + + (define procs + ;; Map system strings to one-argument procedures. This allows these + ;; procedures to have fast 'eq?' memoization on their argument. + (make-hash-table)) (lambda* (package #:optional (system (%current-system))) "Return the intersection of the systems supported by PACKAGE and those supported by its dependencies." - (supported-systems package system)))) + (match (hash-ref procs system) + (#f + (hash-set! procs system (supported-systems-procedure system)) + (package-transitive-supported-systems package system)) + (proc + (proc package)))))) (define* (supported-package? package #:optional (system (%current-system))) "Return true if PACKAGE is supported on SYSTEM--i.e., if PACKAGE and all its -- cgit v1.2.3 From e171182a20962c4119e12439b92bbbfd59b1495e Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 18 Oct 2021 17:49:55 +0200 Subject: packages: Optionally validate Texinfo markup at expansion time. * guix/packages.scm (validate-texinfo): New macro. ()[synopsis, description]: Add 'sanitize' property. --- guix/packages.scm | 52 +++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 49 insertions(+), 3 deletions(-) (limited to 'guix/packages.scm') diff --git a/guix/packages.scm b/guix/packages.scm index 780c6ddb65..4b6098bb8d 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -49,6 +49,7 @@ #:use-module (srfi srfi-35) #:use-module (rnrs bytevectors) #:use-module (web uri) + #:autoload (texinfo) (texi-fragment->stexi) #:re-export (%current-system %current-target-system search-path-specification) ;for convenience @@ -438,6 +439,49 @@ lexical scope of its body." (lambda (s) #,location))) body ...)))))) +(define-syntax validate-texinfo + (let ((validate? (getenv "GUIX_UNINSTALLED"))) + (define ensure-thread-safe-texinfo-parser! + ;; Work around for Guile <= 3.0.7. + (let ((patched? (or (> (string->number (major-version)) 3) + (> (string->number (minor-version)) 0) + (> (string->number (micro-version)) 7))) + (next-token-of/thread-safe + (lambda (pred port) + (let loop ((chars '())) + (match (read-char port) + ((? eof-object?) + (list->string (reverse! chars))) + (chr + (let ((chr* (pred chr))) + (if chr* + (loop (cons chr* chars)) + (begin + (unread-char chr port) + (list->string (reverse! chars))))))))))) + (lambda () + (unless patched? + (set! (@@ (texinfo) next-token-of) next-token-of/thread-safe) + (set! patched? #t))))) + + (lambda (s) + "Raise a syntax error when passed a literal string that is not valid +Texinfo. Otherwise, return the string." + (syntax-case s () + ((_ str) + (string? (syntax->datum #'str)) + (if validate? + (catch 'parser-error + (lambda () + (ensure-thread-safe-texinfo-parser!) + (texi-fragment->stexi (syntax->datum #'str)) + #'str) + (lambda _ + (syntax-violation 'package "invalid Texinfo markup" #'str))) + #'str)) + ((_ obj) + #'obj))))) + ;; A package. (define-record-type* package make-package @@ -472,9 +516,11 @@ lexical scope of its body." (replacement package-replacement ; package | #f (default #f) (thunked) (innate)) - (synopsis package-synopsis) ; one-line description - (description package-description) ; one or two paragraphs - (license package-license) ; instance or list + (synopsis package-synopsis + (sanitize validate-texinfo)) ; one-line description + (description package-description + (sanitize validate-texinfo)) ; one or two paragraphs + (license package-license) ; instance or list (home-page package-home-page) (supported-systems package-supported-systems ; list of strings (default %supported-systems)) -- cgit v1.2.3