GNU bug report logs - #39945
[PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 39945 in the body.
You can then email your comments to 39945 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 0/1] Introducing 'with-parameters' for gexp dynamic binding
Date: Fri,  6 Mar 2020 11:41:08 +0100

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

Message #8 received at 39945 <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: 39945 <at> debbugs.gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>
Subject: [PATCH 1/1] gexp: Add 'with-parameters'.
Date: Fri,  6 Mar 2020 11:53:45 +0100

* 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)))))))))
+
 
 ;;;
 ;;; 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

Message #11 received at submit <at> debbugs.gnu.org (full text, mbox):

From: Mathieu Othacehe <m.othacehe <at> gmail.com>
To: guix-patches <at> gnu.org
Cc: Ludovic Courtès <ludo <at> gnu.org>, 39945 <at> debbugs.gnu.org
Subject: Re: [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp
 dynamic binding
Date: Fri, 06 Mar 2020 12:06:58 +0100

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

Message #19 received at 39945-done <at> debbugs.gnu.org (full text, mbox):

From: Ludovic Courtès <ludo <at> gnu.org>
To: Mathieu Othacehe <m.othacehe <at> gmail.com>
Cc: 39945-done <at> debbugs.gnu.org
Subject: Re: [bug#39945] [PATCH 0/1] Introducing 'with-parameters' for gexp
 dynamic binding
Date: Thu, 12 Mar 2020 18:34:03 +0100

Hi Mathieu,

Mathieu Othacehe <m.othacehe <at> gmail.com> skribis:

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

Done and pushed as cf2ac04f13d9266c7c8a2ebd2e85ef593231ac9d.

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

It could be use to achieve the same result as the <native-qemu> package
you proposed:

  #~(… #+(with-parameters ((%current-system %system)) qemu) …)

However, the issue I mentioned before with this approach remain:

  […] now the result of:

    guix system build -s armhf-linux -d …

  would be dependent on the actual system type.  In other words, the
  result would be different if you run it on armhf-linux, if you run it on
  x86_64-linux, or if you run it on i686-linux.  Not great.

Thanks for your feedback!

Ludo’.

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.