[PATCH 0/2] gexp: Add 'let-system'

DoneSubmitted by Ludovic Courtès.
Details
5 participants
  • Danny Milosavljevic
  • Ludovic Courtès
  • Mathieu Othacehe
  • Marius Bakke
  • Mathieu Othacehe
Owner
unassigned
Severity
normal
L
L
Ludovic Courtès wrote on 14 Nov 2017 17:18
(address . guix-patches@gnu.org)
20171114161841.8485-1-ludo@gnu.org
Hello!
This patch adds the ‘let-system’ form to (guix gexp), as discussed withMathieu at https://bugs.gnu.org/29281. It allows you to insertsystem-dependent code inside a gexp, as in this example:
#~(system* #+(let-system system (cond ((string-prefix? "armhf-" system) (file-append qemu "/bin/qemu-system-arm")) ((string-prefix? "x86_64-" system) (file-append qemu "/bin/qemu-system-x86_64")) (else (error "dunno!")))) "-net" "user" #$image)
(Using (%current-system) and (%current-target-system) does *not* achievethis, in case you’re wondering, because at the time the gexp is definedthey carry their default value.)
Feedback welcome!
Ludo’.
Ludovic Courtès (2): gexp: Compilers can now return lowerable objects. gexp: Add 'let-system'.
doc/guix.texi | 26 ++++++++++++++ guix/gexp.scm | 105 ++++++++++++++++++++++++++++++++++++++++++++++++--------- tests/gexp.scm | 50 +++++++++++++++++++++++++++ 3 files changed, 165 insertions(+), 16 deletions(-)
-- 2.15.0
L
L
Ludovic Courtès wrote on 14 Nov 2017 17:25
[PATCH 1/2] gexp: Compilers can now return lowerable objects.
(address . 29296@debbugs.gnu.org)
20171114162515.8743-1-ludo@gnu.org
* guix/gexp.scm (lower-object): Iterate if LOWERED is a struct.(lower+expand-object): New procedure.(gexp->sexp): Use it.(define-gexp-compiler): Adjust docstring.--- guix/gexp.scm | 54 +++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 39 insertions(+), 15 deletions(-)
Toggle diff (83 lines)diff --git a/guix/gexp.scm b/guix/gexp.scmindex b9525603e..c2d942c7f 100644--- a/guix/gexp.scm+++ b/guix/gexp.scm@@ -195,24 +195,50 @@ procedure to expand it; otherwise return #f." corresponding to OBJ for SYSTEM, cross-compiling for TARGET if TARGET is true. OBJ must be an object that has an associated gexp compiler, such as a <package>."- (match (lookup-compiler obj)- (#f- (raise (condition (&gexp-input-error (input obj)))))- (lower- (lower obj system target))))+ (let loop ((obj obj))+ (match (lookup-compiler obj)+ (#f+ (raise (condition (&gexp-input-error (input obj)))))+ (lower+ (mlet %store-monad ((lowered (lower obj system target)))+ (if (and (struct? lowered) (not (eq? lowered obj)))+ (loop lowered)+ (return lowered)))))))++(define* (lower+expand-object obj+ #:optional (system (%current-system))+ #:key target (output "out"))+ "Return as a value in %STORE-MONAD the output of object OBJ expands to for+SYSTEM and TARGET. Object such as <package>, <file-append>, or <plain-file>+expand to file names, but it's possible to expand to a plain data type."+ (let loop ((obj obj)+ (expand (and (struct? obj) (lookup-expander obj))))+ (match (lookup-compiler obj)+ (#f+ (raise (condition (&gexp-input-error (input obj)))))+ (lower+ (mlet %store-monad ((lowered (lower obj system target)))+ ;; LOWER might return something that needs to be further lowered.+ (if (struct? lowered)+ ;; If we lack an expander, delegate to that of LOWERED.+ (if (not expand)+ (loop lowered (lookup-expander lowered))+ (return (expand obj lowered output)))+ (return lowered))))))) ;lists, vectors, etc. (define-syntax define-gexp-compiler (syntax-rules (=> compiler expander) "Define NAME as a compiler for objects matching PREDICATE encountered in gexps. -In the simplest form of the macro, BODY must return a derivation for PARAM, an-object that matches PREDICATE, for SYSTEM and TARGET (the latter of which is-#f except when cross-compiling.)+In the simplest form of the macro, BODY must return (1) a derivation for+a record of the specified type, for SYSTEM and TARGET (the latter of which is+#f except when cross-compiling), (2) another record that can itself be+compiled down to a derivation, or (3) an object of a primitive data type. The more elaborate form allows you to specify an expander: - (define-gexp-compiler something something?+ (define-gexp-compiler something-compiler <something> compiler => (lambda (param system target) ...) expander => (lambda (param drv output) ...)) @@ -795,12 +821,10 @@ and in the current monad setting (system type, etc.)" (or n? native?))) refs))) (($ <gexp-input> (? struct? thing) output n?)- (let ((target (if (or n? native?) #f target))- (expand (lookup-expander thing)))- (mlet %store-monad ((obj (lower-object thing system- #:target target)))- ;; OBJ must be either a derivation or a store file name.- (return (expand thing obj output)))))+ (let ((target (if (or n? native?) #f target)))+ (lower+expand-object thing system+ #:target target+ #:output output))) (($ <gexp-input> x) (return x)) (x-- 2.15.0
L
L
Ludovic Courtès wrote on 14 Nov 2017 17:25
[PATCH 2/2] gexp: Add 'let-system'.
(address . 29296@debbugs.gnu.org)
20171114162515.8743-2-ludo@gnu.org
* guix/gexp.scm (<system-binding>): New record type.(let-system): New macro.(system-binding-compiler): New procedure.(default-expander): Add catch-all case.* tests/gexp.scm ("let-system", "let-system, target")("let-system, ungexp-native, target")("let-system, nested"): New tests.* doc/guix.texi (G-Expressions): Document it.--- doc/guix.texi | 26 ++++++++++++++++++++++++++ guix/gexp.scm | 51 ++++++++++++++++++++++++++++++++++++++++++++++++++- tests/gexp.scm | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 126 insertions(+), 1 deletion(-)
Toggle diff (176 lines)diff --git a/doc/guix.texi b/doc/guix.texiindex 098ff5e54..0e795ada6 100644--- a/doc/guix.texi+++ b/doc/guix.texi@@ -4799,6 +4799,32 @@ procedures called from @var{body}@dots{}. Return @code{#t} if @var{obj} is a G-expression. @end deffn +@deffn {Scheme Syntax} let-system @var{system} @var{body}@dots{}+@deffnx {Scheme Syntax} let-system (@var{system} @var{target}) @var{body}@dots{}+Bind @var{system} to the currently targeted system---e.g.,+@code{"x86_64-linux"}---within @var{body}.++In the second case, additionally bind @var{target} to the current+cross-compilation target---a GNU triplet such as+@code{"arm-linux-gnueabihf"}---or @code{#f} if we are not+cross-compiling.++@code{let-system} is useful in the occasional case where the object+spliced into the gexp depends on the target system, as in this example:++@example+#~(system*+ #+(let-system system+ (cond ((string-prefix? "armhf-" system)+ (file-append qemu "/bin/qemu-system-arm"))+ ((string-prefix? "x86_64-" system)+ (file-append qemu "/bin/qemu-system-x86_64"))+ (else+ (error "dunno!"))))+ "-net" "user" #$image)+@end example+@end deffn+ G-expressions are meant to be written to disk, either as code building some derivation, or as plain files in the store. The monadic procedures below allow you to do that (@pxref{The Store Monad}, for morediff --git a/guix/gexp.scm b/guix/gexp.scmindex c2d942c7f..c65c6e5f3 100644--- a/guix/gexp.scm+++ b/guix/gexp.scm@@ -32,6 +32,7 @@ #:export (gexp gexp? with-imported-modules+ let-system gexp-input gexp-input?@@ -169,7 +170,9 @@ returns its output file name of OBJ's OUTPUT." ((? derivation? drv) (derivation->output-path drv output)) ((? string? file)- file)))+ file)+ (obj ;lists, vectors, etc.+ obj))) (define (register-compiler! compiler) "Register COMPILER as a gexp compiler."@@ -262,6 +265,52 @@ The expander specifies how an object is converted to its sexp representation." (return drv))) +;;;+;;; System dependencies.+;;;++;; Binding form for the current system and cross-compilation target.+(define-record-type <system-binding>+ (system-binding proc)+ system-binding?+ (proc system-binding-proc))++(define-syntax let-system+ (syntax-rules ()+ "Introduce a system binding in a gexp. The simplest form is:++ (let-system system+ (cond ((string=? system \"x86_64-linux\") ...)+ (else ...)))++which binds SYSTEM to the currently targeted system. The second form is+similar, but it also shows the cross-compilation target:++ (let-system (system target)+ ...)++Here TARGET is bound to the cross-compilation triplet or #f."+ ((_ (system target) exp0 exp ...)+ (system-binding (lambda (system target)+ exp0 exp ...)))+ ((_ system exp0 exp ...)+ (system-binding (lambda (system target)+ exp0 exp ...)))))++(define-gexp-compiler system-binding-compiler <system-binding>+ compiler => (lambda (binding system target)+ (match binding+ (($ <system-binding> proc)+ (with-monad %store-monad+ ;; PROC is expected to return a lowerable object.+ ;; 'lower-object' takes care of residualizing it to a+ ;; derivation or similar.+ (return (proc system target))))))++ ;; Delegate to the expander of the object returned by PROC.+ expander => #f)++ ;;; ;;; File declarations. ;;;diff --git a/tests/gexp.scm b/tests/gexp.scmindex 5873abdd4..f98d1e70e 100644--- a/tests/gexp.scm+++ b/tests/gexp.scm@@ -258,6 +258,56 @@ (((thing "out")) (eq? thing file)))))) +(test-equal "let-system"+ (list `(begin ,(%current-system) #t) '(system-binding) '())+ (let ((exp #~(begin+ #$(let-system system system)+ #t)))+ (list (gexp->sexp* exp)+ (match (gexp-inputs exp)+ (((($ (@@ (guix gexp) <system-binding>)) "out"))+ '(system-binding))+ (x x))+ (gexp-native-inputs exp))))++(test-equal "let-system, target"+ (list `(list ,(%current-system) #f)+ `(list ,(%current-system) "aarch64-linux-gnu"))+ (let ((exp #~(list #$@(let-system (system target)+ (list system target)))))+ (list (gexp->sexp* exp)+ (gexp->sexp* exp "aarch64-linux-gnu"))))++(test-equal "let-system, ungexp-native, target"+ `(here it is: ,(%current-system) #f)+ (let ((exp #~(here it is: #+@(let-system (system target)+ (list system target)))))+ (gexp->sexp* exp "aarch64-linux-gnu")))++(test-equal "let-system, nested"+ (list `(system* ,(string-append "qemu-system-" (%current-system))+ "-m" "256")+ '()+ '(system-binding))+ (let ((exp #~(system*+ #+(let-system (system target)+ (file-append (@@ (gnu packages virtualization)+ qemu)+ "/bin/qemu-system-"+ system))+ "-m" "256")))+ (list (match (gexp->sexp* exp)+ (('system* command rest ...)+ `(system* ,(and (string-prefix? (%store-prefix) command)+ (basename command))+ ,@rest))+ (x x))+ (gexp-inputs exp)+ (match (gexp-native-inputs exp)+ (((($ (@@ (guix gexp) <system-binding>)) "out"))+ '(system-binding))+ (x x)))))+ (test-assert "ungexp + ungexp-native" (let* ((exp (gexp (list (ungexp-native %bootstrap-guile) (ungexp coreutils)-- 2.15.0
M
M
Mathieu Othacehe wrote on 15 Nov 2017 12:27
(name . Ludovic Courtès)(address . ludo@gnu.org)(address . 29296@debbugs.gnu.org)
87fu9fsrxn.fsf@gmail.com
Hi Ludo,
I must admit i don't have a perfect understanding of what is going on ingexp.scm but your serie LGTM.
When diffing with the initial patch it seems that the entry in.dir-locals.el is gone but it is a minor point.
About the integration of let-system in "system-disk-image", i'm not surehow to proceed. let-system is meant to be used in a gexp but theoperating-system is not defined in a gexp.
Do you have any advice on how to turn os declaration into a gexp so thati can use let-system to parameterize kernel field ?
Thanks,
Mathieu
L
L
Ludovic Courtès wrote on 16 Nov 2017 10:10
(name . Mathieu Othacehe)(address . m.othacehe@gmail.com)(address . 29296@debbugs.gnu.org)
87mv3mk2ql.fsf@gnu.org
Hi Mathieu,
Mathieu Othacehe <m.othacehe@gmail.com> skribis:
Toggle quote (6 lines)> I must admit i don't have a perfect understanding of what is going on in> gexp.scm but your serie LGTM.>> When diffing with the initial patch it seems that the entry in> .dir-locals.el is gone but it is a minor point.
Oops.
Toggle quote (7 lines)> About the integration of let-system in "system-disk-image", i'm not sure> how to proceed. let-system is meant to be used in a gexp but the> operating-system is not defined in a gexp.>> Do you have any advice on how to turn os declaration into a gexp so that> i can use let-system to parameterize kernel field ?
The idea is that you can write:
(kernel (let-system system (if (string-prefix? "arm-" system) linux-libre-arm linux-libre)))
and things will just work.
Now I found a couple of issues. First one is addressed with the patchbelow. Second one is trickier: (file-append (let-system …) …), as isused to compute the kernel file name, doesn’t work due to the way the<file-append> expander works.
I’ll see what I can do.
Thanks,Ludo’.
Toggle diff (21 lines)diff --git a/gnu/system.scm b/gnu/system.scmindex 9e05c4b21..a4804cf86 100644--- a/gnu/system.scm+++ b/gnu/system.scm@@ -876,10 +876,12 @@ listed in OS. The C library expects to find it under (define (kernel->boot-label kernel) "Return a label for the bootloader menu entry that boots KERNEL."- (string-append "GNU with "- (string-titlecase (package-name kernel)) " "- (package-version kernel)- " (beta)"))+ (if (package? kernel)+ (string-append "GNU with "+ (string-titlecase (package-name kernel)) " "+ (package-version kernel)+ " (beta)")+ "GNU GuixSD (beta)")) (define (store-file-system file-systems) "Return the file system object among FILE-SYSTEMS that contains the store."
L
L
Ludovic Courtès wrote on 16 May 00:43 +0200
Re: bug#41120: uvesafb service is unsupported on aarch64
(name . Mathieu Othacehe)(address . othacehe@gnu.org)
87sgg0stt5.fsf@gnu.org
Hi Mathieu,
Mathieu Othacehe <othacehe@gnu.org> skribis:
Toggle quote (3 lines)> Here's a rebased version of Ludo's patch. I'm not sure about the merge> resolution in "lower-object", but otherwise it works fine!
I took another look, and you’re right, it does the job. There were acouple of issues: returning a self-quoting value as in
(let-system s s)
wouldn’t work, and also caching wasn’t quite right (could be seen bycomparing GUIX_PROFILING="add-data-to-store-cache object-cache" beforeand after).
Anyway, it took me much more time than I thought, but it’s here now:
502f609d05 vm: Use 'let-system'. 300a54bb98 utils: 'target-arm32?' & co. take an optional parameter. 644cb40cd8 gexp: Add 'let-system'. d03001a31a gexp: Compilers can now return lowerable objects.
Let me know how it goes!
Ludo’.
Closed
M
M
Mathieu Othacehe wrote on 18 May 14:16 +0200
(name . Ludovic Courtès)(address . ludo@gnu.org)
87o8qlfnff.fsf@gnu.org
Hey Ludo,
Toggle quote (9 lines)> Anyway, it took me much more time than I thought, but it’s here now:>> 502f609d05 vm: Use 'let-system'.> 300a54bb98 utils: 'target-arm32?' & co. take an optional parameter.> 644cb40cd8 gexp: Add 'let-system'.> d03001a31a gexp: Compilers can now return lowerable objects.>> Let me know how it goes!
Thanks a lot, it's a great addition. I plan to use it soon to havekernel/architecture specific services, as I proposed earlier in thisthread.
Mathieu
Closed
D
D
Danny Milosavljevic wrote on 23 May 00:44 +0200
Re: [bug#29296] [PATCH 2/2] gexp: Add 'let-system'.
(name . Ludovic Courtès)(address . ludo@gnu.org)
20200523004434.059d1960@scratchpost.org
Hi Ludo,
maybe a little off-topic, but why do I have to use the following patch onarmhf-linux (*not* cross compiling) in order to stop it from pulling ini686-cross-gcc?
Makes no sense to me at all...
Toggle diff (16 lines)diff --git a/gnu/packages/mes.scm b/gnu/packages/mes.scmindex 347aef0..524b8e8 100644--- a/gnu/packages/mes.scm+++ b/gnu/packages/mes.scm@@ -120,8 +120,9 @@ extensive examples, including parsers for the Javascript and C99 languages.") ((string-prefix? "x86_64-linux" target-system) ;; Use cross-compiler rather than #:system "i686-linux" to get ;; MesCC 64 bit .go files installed ready for use with Guile.- `(("i686-linux-binutils" ,(cross-binutils "i686-unknown-linux-gnu"))- ("i686-linux-gcc" ,(cross-gcc "i686-unknown-linux-gnu"))))+ `( ;("i686-linux-binutils" ,(cross-binutils "i686-unknown-linux-gnu"))+ ;("i686-linux-gcc" ,(cross-gcc "i686-unknown-linux-gnu"))+)) (else '()))) ("graphviz" ,graphviz)
-----BEGIN PGP SIGNATURE-----
iQEzBAEBCgAdFiEEds7GsXJ0tGXALbPZ5xo1VCwwuqUFAl7IVdIACgkQ5xo1VCwwuqXbMwf/dADyXhUuoZzv+Z9Wiqj7hH2lqWmg4usmpUx3ZLAPNti2b24e1KBGO4m68UlSB8A9T2wCZ/kBp1Ivl1B4bSzvQppEIc2Qnov+hb0ic6l7XfC42IvNs3EdQzm8ETj355f7eSdGJyqjgw5Oigc4pPxeV57lKWHNMyCbrD+JUqx2fwxzUM3Xea+BOIjffljPvz38a11OIXnkVwNkLKLCfWV3MBl/IwaPfdIa5r2EcuZK41kMxmMmXZsipxEafCyWDAlewBl6hBnSF1ZUtMuioa44bLx11Ix+evsZ3hnExdlgVd0NGGP/kw1al9QKCdGUv2Jx9ERqsaoKt8+ryJSrKZWiLw===mAwS-----END PGP SIGNATURE-----

M
M
Marius Bakke wrote on 23 May 01:01 +0200
87blmf8thf.fsf@devup.no
Danny Milosavljevic <dannym@scratchpost.org> writes:
Toggle quote (6 lines)> Hi Ludo,>> maybe a little off-topic, but why do I have to use the following patch on> armhf-linux (*not* cross compiling) in order to stop it from pulling in> i686-cross-gcc?
Can you give a little more context? Did this occur after the let-systempatch, or is this when using let-system?
Can you paste the derivation for mes@0.19 in the context this occurs?
Also, please file a new bug report.
Toggle quote (2 lines)> Makes no sense to me at all...
If only all bugs were obvious, our jobs would be so much easier!
Toggle quote (16 lines)> diff --git a/gnu/packages/mes.scm b/gnu/packages/mes.scm> index 347aef0..524b8e8 100644> --- a/gnu/packages/mes.scm> +++ b/gnu/packages/mes.scm> @@ -120,8 +120,9 @@ extensive examples, including parsers for the Javascript and C99 languages.")> ((string-prefix? "x86_64-linux" target-system)> ;; Use cross-compiler rather than #:system "i686-linux" to get> ;; MesCC 64 bit .go files installed ready for use with Guile.> - `(("i686-linux-binutils" ,(cross-binutils "i686-unknown-linux-gnu"))> - ("i686-linux-gcc" ,(cross-gcc "i686-unknown-linux-gnu"))))> + `( ;("i686-linux-binutils" ,(cross-binutils "i686-unknown-linux-gnu"))> + ;("i686-linux-gcc" ,(cross-gcc "i686-unknown-linux-gnu"))> +))> (else> '())))> ("graphviz" ,graphviz)
-----BEGIN PGP SIGNATURE-----
iQEzBAEBCgAdFiEEu7At3yzq9qgNHeZDoqBt8qM6VPoFAl7IWbwACgkQoqBt8qM6VPqZmAf/YsKv3Xx2cklU9UZkQn+QlEuJMm7GEq3hXvkrmIozyFiIYhNLPaFl7TWOEd3dClkZDHiFN4VYFjaLa3q726m0ANrBc2uie/Ri7Xg8L5fqWJLdJgOJ0poPcTk00Qt0jIyaM7THrzHKt7wZN0xeVAFrI/RT0b9A2uDu9vrjPLNikXDS4LsxBaOu+0CL3cQHFdjyc2afHM/4HJPPVUG5g2SvtmEq2TeF8tSmlJv0b7IZeeOPF1JRIWwi5Bkvn6YDA96BlTqbgL33663mcpQHa/1pdbyW/ezVC+DgQmngkEUJFoVWFgvUbknc+O1LzJ7x9rZAMjlj7XzbBmZYvcrdZEE63Q===tSFq-----END PGP SIGNATURE-----
?