* [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding
@ 2020-03-06 10:41 Ludovic Courtès
2020-03-06 10:53 ` [bug#39945] [PATCH 1/1] gexp: Add 'with-parameters' Ludovic Courtès
2020-03-06 11:06 ` [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding Mathieu Othacehe
0 siblings, 2 replies; 4+ messages in thread
From: Ludovic Courtès @ 2020-03-06 10:41 UTC (permalink / raw)
To: 39945; +Cc: Ludovic Courtès
Hello Guix!
This patch adds a new ‘with-parameters’ form. It is like ‘parameterize’
except that it takes effect when a file-like object is lowered, as in:
;; Return coreutils for i686.
(with-parameters ((%current-system "i686-linux"))
coreutils)
‘with-parameters’ is necessary because if you would use ‘parameterize’
in the example above, it wouldn’t have any effect at all: the dynamic
binding would be installed at the wrong time.
It works for any SRFI-39 parameter, though ‘%current-system’ is my main
use case. It makes it possible to have gexps or manifests that include
things explicitly targeting a given system. (For instance, I’d like to
have a manifest for release-critical things that explicitly pins the
targeted systems.)
Note that ‘with-parameters’ applies to file-like objects; it is _not_ a
property of the gexp itself. So one cannot, for example, write:
(with-parameters ((%current-system "i686-linux"))
#~(a b c d))
I feel like it’s better this way, though it could be confusing.
Thoughts?
Besides, ‘with-parameters’ is the dual of what was discussed at
<https://issues.guix.gnu.org/issue/29296>.
Thanks,
Ludo’.
Ludovic Courtès (1):
gexp: Add 'with-parameters'.
.dir-locals.el | 1 +
doc/guix.texi | 19 ++++++++++++++++
guix/gexp.scm | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++
tests/gexp.scm | 28 ++++++++++++++++++++++++
4 files changed, 107 insertions(+)
--
2.25.1
^ permalink raw reply [flat|nested] 4+ messages in thread
* [bug#39945] [PATCH 1/1] gexp: Add 'with-parameters'.
2020-03-06 10:41 [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding Ludovic Courtès
@ 2020-03-06 10:53 ` Ludovic Courtès
2020-03-06 11:06 ` [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding Mathieu Othacehe
1 sibling, 0 replies; 4+ messages in thread
From: Ludovic Courtès @ 2020-03-06 10:53 UTC (permalink / raw)
To: 39945; +Cc: Ludovic Courtès
* guix/gexp.scm (<parameterized>): New record type.
(with-parameters): New macro.
(compile-parameterized): New gexp compiler.
* tests/gexp.scm ("with-parameters for %current-system")
("with-parameters + file-append"): New tests.
* doc/guix.texi (G-Expressions): Document it.
---
.dir-locals.el | 1 +
doc/guix.texi | 19 ++++++++++++++++
guix/gexp.scm | 59 ++++++++++++++++++++++++++++++++++++++++++++++++++
tests/gexp.scm | 28 ++++++++++++++++++++++++
4 files changed, 107 insertions(+)
diff --git a/.dir-locals.el b/.dir-locals.el
index 5ce3fbc9a5..1976f7e60d 100644
--- a/.dir-locals.el
+++ b/.dir-locals.el
@@ -83,6 +83,7 @@
(eval . (put 'wrap-program 'scheme-indent-function 1))
(eval . (put 'with-imported-modules 'scheme-indent-function 1))
(eval . (put 'with-extensions 'scheme-indent-function 1))
+ (eval . (put 'with-parameters 'scheme-indent-function 1))
(eval . (put 'with-database 'scheme-indent-function 2))
(eval . (put 'call-with-transaction 'scheme-indent-function 2))
diff --git a/doc/guix.texi b/doc/guix.texi
index fab9159530..9ad6db7fc0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8021,6 +8021,25 @@ the second case, the resulting script contains a @code{(string-append
@dots{})} expression to construct the file name @emph{at run time}.
@end deffn
+@deffn {Scheme Syntax} with-parameters ((@var{parameter} @var{value}) @dots{}) @var{exp}
+This macro is similar to the @code{parameterize} form for
+dynamically-bound @dfn{parameters} (@pxref{Parameters,,, guile, GNU
+Guile Reference Manual}). The key difference is that it takes effect
+when the file-like object returned by @var{exp} is lowered to a
+derivation or store item.
+
+A typical use of @code{with-parameters} is to force the system in effect
+for a given object:
+
+@lisp
+(with-parameters ((%current-system "i686-linux"))
+ coreutils)
+@end lisp
+
+The example above returns an object that corresponds to the i686 build
+of Coreutils, regardless of the current value of @code{%current-system}.
+@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 c4f4e80209..d3e1b34dac 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -82,6 +82,9 @@
raw-derivation-file
raw-derivation-file?
+ with-parameters
+ parameterized?
+
load-path-expression
gexp-modules
@@ -520,6 +523,62 @@ SUFFIX."
(base (expand base lowered output)))
(string-append base (string-concatenate suffix)))))))
+;; Representation of SRFI-39 parameter settings in the dynamic scope of an
+;; object lowering.
+(define-record-type <parameterized>
+ (parameterized bindings thunk)
+ parameterized?
+ (bindings parameterized-bindings) ;list of parameter/value pairs
+ (thunk parameterized-thunk)) ;thunk
+
+(define-syntax-rule (with-parameters ((param value) ...) body ...)
+ "Bind each PARAM to the corresponding VALUE for the extent during which BODY
+is lowered. Consider this example:
+
+ (with-parameters ((%current-system \"x86_64-linux\"))
+ coreutils)
+
+It returns a <parameterized> object that ensures %CURRENT-SYSTEM is set to
+x86_64-linux when COREUTILS is lowered."
+ (parameterized (list (list param (lambda () value)) ...)
+ (lambda ()
+ body ...)))
+
+(define-gexp-compiler compile-parameterized <parameterized>
+ compiler =>
+ (lambda (parameterized system target)
+ (match (parameterized-bindings parameterized)
+ (((parameters values) ...)
+ (let ((fluids (map parameter-fluid parameters))
+ (thunk (parameterized-thunk parameterized)))
+ ;; Install the PARAMETERS for the dynamic extent of THUNK.
+ (with-fluids* fluids
+ (map (lambda (thunk) (thunk)) values)
+ (lambda ()
+ ;; Special-case '%current-system' and '%current-target-system' to
+ ;; make sure we get the desired effect.
+ (let ((system (if (memq %current-system parameters)
+ (%current-system)
+ system))
+ (target (if (memq %current-target-system parameters)
+ (%current-target-system)
+ target)))
+ (lower-object (thunk) system #:target target))))))))
+
+ expander => (lambda (parameterized lowered output)
+ (match (parameterized-bindings parameterized)
+ (((parameters values) ...)
+ (let ((fluids (map parameter-fluid parameters))
+ (thunk (parameterized-thunk parameterized)))
+ ;; Install the PARAMETERS for the dynamic extent of THUNK.
+ (with-fluids* fluids
+ (map (lambda (thunk) (thunk)) values)
+ (lambda ()
+ ;; Delegate to the expander of the wrapped object.
+ (let* ((base (thunk))
+ (expand (lookup-expander base)))
+ (expand base lowered output)))))))))
+
\f
;;;
;;; Inputs & outputs.
diff --git a/tests/gexp.scm b/tests/gexp.scm
index 7c8985d846..904b1a687a 100644
--- a/tests/gexp.scm
+++ b/tests/gexp.scm
@@ -284,6 +284,34 @@
(((thing "out"))
(eq? thing file))))))
+(test-assertm "with-parameters for %current-system"
+ (mlet* %store-monad ((system -> (match (%current-system)
+ ("aarch64-linux" "x86_64-linux")
+ (_ "aarch64-linux")))
+ (drv (package->derivation coreutils system))
+ (obj -> (with-parameters ((%current-system system))
+ coreutils))
+ (result (lower-object obj)))
+ (return (string=? (derivation-file-name drv)
+ (derivation-file-name result)))))
+
+(test-assert "with-parameters + file-append"
+ (let* ((system (match (%current-system)
+ ("aarch64-linux" "x86_64-linux")
+ (_ "aarch64-linux")))
+ (drv (package-derivation %store coreutils system))
+ (param (make-parameter 7))
+ (exp #~(here we go #$(with-parameters ((%current-system system)
+ (param 42))
+ (if (= (param) 42)
+ (file-append coreutils "/bin/touch")
+ %bootstrap-guile)))))
+ (match (gexp->sexp* exp)
+ (('here 'we 'go (? string? result))
+ (string=? result
+ (string-append (derivation->output-path drv)
+ "/bin/touch"))))))
+
(test-assert "ungexp + ungexp-native"
(let* ((exp (gexp (list (ungexp-native %bootstrap-guile)
(ungexp coreutils)
--
2.25.1
^ permalink raw reply related [flat|nested] 4+ messages in thread
* [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding
2020-03-06 10:41 [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding Ludovic Courtès
2020-03-06 10:53 ` [bug#39945] [PATCH 1/1] gexp: Add 'with-parameters' Ludovic Courtès
@ 2020-03-06 11:06 ` Mathieu Othacehe
2020-03-12 17:34 ` bug#39945: " Ludovic Courtès
1 sibling, 1 reply; 4+ messages in thread
From: Mathieu Othacehe @ 2020-03-06 11:06 UTC (permalink / raw)
To: 39945; +Cc: ludo
Hey!
> Thoughts?
>
> Besides, ‘with-parameters’ is the dual of what was discussed at
> <https://issues.guix.gnu.org/issue/29296>.
Super nice! Maybe you could add a test-case involving
%current-target-system but otherwise this LGTM.
Do you think we could use this to get around this issue we discussed
there:
https://lists.gnu.org/archive/html/guix-devel/2019-12/msg00099.html.
Thanks,
Mathieu
^ permalink raw reply [flat|nested] 4+ messages in thread
end of thread, other threads:[~2020-03-12 17:35 UTC | newest]
Thread overview: 4+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2020-03-06 10:41 [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding Ludovic Courtès
2020-03-06 10:53 ` [bug#39945] [PATCH 1/1] gexp: Add 'with-parameters' Ludovic Courtès
2020-03-06 11:06 ` [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding Mathieu Othacehe
2020-03-12 17:34 ` bug#39945: " Ludovic Courtès
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/guix.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.