mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-24 21:38:07 -05:00
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
This commit is contained in:
parent
4771960e5d
commit
d9190abbd2
3 changed files with 80 additions and 1 deletions
|
@ -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
|
@var{output} of @var{obj}---this is useful when @var{obj} produces
|
||||||
multiple outputs (@pxref{Packages with Multiple Outputs}).
|
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}
|
@item #+@var{obj}
|
||||||
@itemx #+@var{obj}:output
|
@itemx #+@var{obj}:output
|
||||||
@itemx (ungexp-native @var{obj})
|
@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}.
|
of Coreutils, regardless of the current value of @code{%current-system}.
|
||||||
@end defmac
|
@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
|
Of course, in addition to gexps embedded in ``host'' code, there are
|
||||||
also modules containing build tools. To make it clear that they are
|
also modules containing build tools. To make it clear that they are
|
||||||
|
|
|
@ -1,5 +1,5 @@
|
||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; 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 Clément Lassieur <clement@lassieur.org>
|
||||||
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
|
;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
|
||||||
;;; Copyright © 2019, 2020 Mathieu Othacehe <m.othacehe@gmail.com>
|
;;; 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."
|
whether this should be considered a \"native\" input or not."
|
||||||
(%gexp-input thing output native?))
|
(%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
|
;; Reference to one of the derivation's outputs, for gexps used in
|
||||||
;; derivations.
|
;; derivations.
|
||||||
(define-record-type <gexp-output>
|
(define-record-type <gexp-output>
|
||||||
|
|
|
@ -393,6 +393,30 @@ (define (match-input thing)
|
||||||
(list item))
|
(list item))
|
||||||
(null? (lowered-gexp-inputs lexp)))))
|
(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"
|
(test-assertm "with-parameters for %current-system"
|
||||||
(mlet* %store-monad ((system -> (match (%current-system)
|
(mlet* %store-monad ((system -> (match (%current-system)
|
||||||
("aarch64-linux" "x86_64-linux")
|
("aarch64-linux" "x86_64-linux")
|
||||||
|
|
Loading…
Reference in a new issue