From d9190abbd20f15ea5b55abdd51e1376f05055850 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Sun, 12 Nov 2023 22:47:43 +0100 Subject: [PATCH] gexp: Add compiler for . * guix/gexp.scm (gexp-input-compiler): New procedure. * tests/gexp.scm ("gexp references non-existent output") ("gexp-input, as first-class input"): New tests. * doc/guix.texi (G-Expressions): Document it. Reviewed-by: Maxim Cournoyer Change-Id: I95b58d6e4d77a54364026b4324fbb00125a9402e --- doc/guix.texi | 38 ++++++++++++++++++++++++++++++++++++++ guix/gexp.scm | 19 ++++++++++++++++++- tests/gexp.scm | 24 ++++++++++++++++++++++++ 3 files changed, 80 insertions(+), 1 deletion(-) diff --git a/doc/guix.texi b/doc/guix.texi index b742a3d5b2..a760d627eb 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -12197,6 +12197,11 @@ This is like the form above, but referring explicitly to the @var{output} of @var{obj}---this is useful when @var{obj} produces multiple outputs (@pxref{Packages with Multiple Outputs}). +Sometimes a gexp unconditionally refers to the @code{"out"} output, but +the user of that gexp would still like to insert a reference to another +output. The @code{gexp-input} procedure aims to address that. +@xref{gexp-input}. + @item #+@var{obj} @itemx #+@var{obj}:output @itemx (ungexp-native @var{obj}) @@ -12590,6 +12595,39 @@ The example above returns an object that corresponds to the i686 build of Coreutils, regardless of the current value of @code{%current-system}. @end defmac +@anchor{gexp-input} +@deffn {Procedure} gexp-input @var{obj} [@var{output}] [#:native? #f] +Return a @dfn{gexp input} record for the given @var{output} of file-like +object @var{obj}, with @code{#:native?} determining whether this is a +native reference (as with @code{ungexp-native}) or not. + +This procedure is helpful when you want to pass a reference to a +specific output of an object to some procedure that may not know about +that output. For example, assume you have this procedure, which takes +one file-like object: + +@lisp +(define (make-symlink target) + (computed-file "the-symlink" + #~(symlink #$target #$output))) +@end lisp + +Here @code{make-symlink} can only ever refer to the default output of +@var{target}---the @code{"out"} output (@pxref{Packages with Multiple +Outputs}). To have it refer to, say, the @code{"lib"} output of the +@code{hwloc} package, you can call it like so: + +@lisp +(make-symlink (gexp-input hwloc "lib")) +@end lisp + +You can also compose it like any other file-like object: + +@lisp +(make-symlink + (file-append (gexp-input hwloc "lib") "/lib/libhwloc.so")) +@end lisp +@end deffn Of course, in addition to gexps embedded in ``host'' code, there are also modules containing build tools. To make it clear that they are diff --git a/guix/gexp.scm b/guix/gexp.scm index 0fe4f1c98a..a7f4256d24 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014-2022 Ludovic Courtès +;;; Copyright © 2014-2023 Ludovic Courtès ;;; Copyright © 2018 Clément Lassieur ;;; Copyright © 2018 Jan Nieuwenhuizen ;;; Copyright © 2019, 2020 Mathieu Othacehe @@ -775,6 +775,23 @@ (define* (gexp-input thing ;convenience procedure whether this should be considered a \"native\" input or not." (%gexp-input thing output native?)) +;; Allow s to be used within gexps. This is useful when willing +;; to force a specific reference to an object, as in (gexp-input hwloc "bin"), +;; which forces a reference to the "bin" output of 'hwloc' instead of leaving +;; it up to the recipient to pick the right output. +(define-gexp-compiler gexp-input-compiler + compiler => (lambda (obj system target) + (match obj + (($ thing output native?) + (lower-object thing system + #:target (and (not native?) target))))) + expander => (lambda (obj lowered output/ignored) + (match obj + (($ thing output native?) + (let ((expand (or (lookup-expander thing) + (lookup-expander lowered)))) + (expand thing lowered output)))))) + ;; Reference to one of the derivation's outputs, for gexps used in ;; derivations. (define-record-type diff --git a/tests/gexp.scm b/tests/gexp.scm index 0e3c446576..871e5f7abb 100644 --- a/tests/gexp.scm +++ b/tests/gexp.scm @@ -393,6 +393,30 @@ (define (match-input thing) (list item)) (null? (lowered-gexp-inputs lexp))))) +(test-equal "gexp references non-existent output" + "no-default-output" + (guard (c ((derivation-missing-output-error? c) + (derivation-name (derivation-error-derivation c)))) + (let* ((obj (computed-file "no-default-output" + #~(mkdir #$output:bar))) + (exp #~(symlink #$obj #$output)) + (drv (run-with-store %store (lower-gexp exp)))) + (pk 'oops! drv #f)))) + +(test-assert "gexp-input, as first-class input" + ;; Insert a record in a gexp as a way to specify which output + ;; of OBJ should be used. + (let* ((obj (computed-file "foo" #~(mkdir #$output:bar))) + (exp #~(list #$(gexp-input obj "bar"))) + (drv (run-with-store %store (lower-object obj))) + (item (derivation->output-path drv "bar")) + (lexp (run-with-store %store (lower-gexp exp)))) + (and (match (lowered-gexp-inputs lexp) + ((input) + (eq? (derivation-input-derivation input) drv))) + (equal? (lowered-gexp-sexp lexp) + `(list ,item))))) + (test-assertm "with-parameters for %current-system" (mlet* %store-monad ((system -> (match (%current-system) ("aarch64-linux" "x86_64-linux")