me
/
guix
Archived
1
0
Fork 0

gexp: Add compiler for <gexp-input>.

* 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 <maxim.cournoyer@gmail.com>
Change-Id: I95b58d6e4d77a54364026b4324fbb00125a9402e
Ludovic Courtès 2023-11-12 22:47:43 +01:00
parent 4771960e5d
commit d9190abbd2
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 80 additions and 1 deletions

View File

@ -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

View File

@ -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 @@ x86_64-linux when COREUTILS is lowered."
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>

View File

@ -393,6 +393,30 @@
(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")