* [bug#67172] [PATCH 1/2] gexp: Add compiler for <gexp-input>.
2023-11-14 13:24 [bug#67172] [PATCH 0/2] Turning <gexp-input> into lowerable objects Ludovic Courtès
@ 2023-11-14 13:35 ` Ludovic Courtès
2023-12-04 1:59 ` Maxim Cournoyer
2023-11-14 13:35 ` [bug#67172] [PATCH 2/2] gexp: #:references-graphs accepts and honors <gexp-input> records Ludovic Courtès
1 sibling, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2023-11-14 13:35 UTC (permalink / raw)
To: 67172
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
* 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.
Change-Id: I95b58d6e4d77a54364026b4324fbb00125a9402e
---
doc/guix.texi | 38 ++++++++++++++++++++++++++++++++++++++
guix/gexp.scm | 19 ++++++++++++++++++-
tests/gexp.scm | 26 +++++++++++++++++++++++++-
3 files changed, 81 insertions(+), 2 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9f06f1c325..8492f0ada3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12096,6 +12096,11 @@ G-Expressions
@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})
@@ -12489,6 +12494,39 @@ G-Expressions
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 <ludo@gnu.org>
+;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
@@ -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 <gexp-input>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 <gexp-input>
+ compiler => (lambda (obj system target)
+ (match obj
+ (($ <gexp-input> thing output native?)
+ (lower-object thing system
+ #:target (and (not native?) target)))))
+ expander => (lambda (obj lowered output/ignored)
+ (match obj
+ (($ <gexp-input> 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 <gexp-output>
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 7a90f8dcbf..a3147405d7 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2014-2022 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2014-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2021-2022 Maxime Devos <maximedevos@telenet.be>
;;;
;;; This file is part of GNU Guix.
@@ -393,6 +393,30 @@ (define %extension-package
(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 <gexp-input> 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")
--
2.41.0
^ permalink raw reply related [flat|nested] 6+ messages in thread* [bug#67172] [PATCH 2/2] gexp: #:references-graphs accepts and honors <gexp-input> records.
2023-11-14 13:24 [bug#67172] [PATCH 0/2] Turning <gexp-input> into lowerable objects Ludovic Courtès
2023-11-14 13:35 ` [bug#67172] [PATCH 1/2] gexp: Add compiler for <gexp-input> Ludovic Courtès
@ 2023-11-14 13:35 ` Ludovic Courtès
2023-12-04 2:05 ` Maxim Cournoyer
1 sibling, 1 reply; 6+ messages in thread
From: Ludovic Courtès @ 2023-11-14 13:35 UTC (permalink / raw)
To: 67172
Cc: Ludovic Courtès, Christopher Baines, Josselin Poiret,
Ludovic Courtès, Mathieu Othacehe, Ricardo Wurmus,
Simon Tournier, Tobias Geerinckx-Rice
* guix/gexp.scm (lower-reference-graphs)[tuple->gexp-input]: Add
‘gexp-input?’ case.
(gexp->derivation): Update docstring.
* doc/guix.texi (G-Expressions): Adjust accordingly.
* tests/gexp.scm ("references-file, non-default output"): New test.
Change-Id: I595cb75da0867ab8ab44552887dc06ed1d23315e
---
doc/guix.texi | 7 +++----
guix/gexp.scm | 12 ++++++++----
tests/gexp.scm | 30 ++++++++++++++++++++++++++++++
3 files changed, 41 insertions(+), 8 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 8492f0ada3..5f90ec6eb4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -12213,10 +12213,9 @@ G-Expressions
following forms:
@example
-(@var{file-name} @var{package})
-(@var{file-name} @var{package} @var{output})
-(@var{file-name} @var{derivation})
-(@var{file-name} @var{derivation} @var{output})
+(@var{file-name} @var{obj})
+(@var{file-name} @var{obj} @var{output})
+(@var{file-name} @var{gexp-input})
(@var{file-name} @var{store-item})
@end example
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a7f4256d24..29819878fa 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -934,6 +934,11 @@ (define* (lower-reference-graphs graphs #:key system target)
corresponding <derivation-input> or store item."
(define tuple->gexp-input
(match-lambda
+ (((? gexp-input? input))
+ ;; This case lets users specify the output of interest more
+ ;; conveniently, for instance by passing (gexp-input hwloc "lib") to
+ ;; the 'references-file' procedure.
+ input)
((thing)
(%gexp-input thing "out" (not target)))
((thing output)
@@ -1152,10 +1157,9 @@ (define* (gexp->derivation name exp
When REFERENCES-GRAPHS is true, it must be a list of tuples of one of the
following forms:
- (FILE-NAME PACKAGE)
- (FILE-NAME PACKAGE OUTPUT)
- (FILE-NAME DERIVATION)
- (FILE-NAME DERIVATION OUTPUT)
+ (FILE-NAME OBJ)
+ (FILE-NAME OBJ OUTPUT)
+ (FILE-NAME GEXP-INPUT)
(FILE-NAME STORE-ITEM)
The right-hand-side of each element of REFERENCES-GRAPHS is automatically made
diff --git a/tests/gexp.scm b/tests/gexp.scm
index a3147405d7..481755138e 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -1651,6 +1651,36 @@ (define shebang
read)
refs)))))))
+(test-assertm "references-file, non-default output"
+ (let* ((exp #~(begin
+ (mkdir #$output)
+ (symlink #$%bootstrap-guile #$output:extra)))
+ (computed (computed-file "computed" exp
+ #:guile %bootstrap-guile))
+ (refs1 (references-file computed
+ #:guile %bootstrap-guile))
+ ;; Wrap COMPUTE in 'gexp-input' to get the "extra" output.
+ (refs2 (references-file (gexp-input computed "extra")
+ #:guile %bootstrap-guile)))
+ (mlet* %store-monad ((drv0 (lower-object %bootstrap-guile))
+ (drv1 (lower-object computed))
+ (drv2 (lower-object refs2))
+ (drv3 (lower-object refs1)))
+ (mbegin %store-monad
+ (built-derivations (list drv2 drv3))
+ (mlet %store-monad ((refs ((store-lift requisites)
+ (list (derivation->output-path
+ drv1 "extra")))))
+ (return
+ (and (lset= string=?
+ (call-with-input-file (derivation->output-path drv2)
+ read)
+ refs)
+ (lset= string=?
+ (call-with-input-file (derivation->output-path drv3)
+ read)
+ (list (derivation->output-path drv1))))))))))
+
(test-assert "lower-object & gexp-input-error?"
(guard (c ((gexp-input-error? c)
(gexp-error-invalid-input c)))
--
2.41.0
^ permalink raw reply related [flat|nested] 6+ messages in thread