[bug#38612] Pass system and target arguments to gexp->file.

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 156 bytes --]


Hello,

The attached patch fixes issues encountered when cross-compiling a
system.  gexps passed to gexp->file were not honoring target argument.

Mathieu

[-- Attachment #2: 0001-gexp-Add-system-and-target-support-to-gexp-file.patch --]
[-- Type: text/x-diff, Size: 3592 bytes --]

From 67c3982503c4d9ab4c77b5df295957abbe60dfeb Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Sat, 14 Dec 2019 17:52:53 +0100
Subject: [PATCH] gexp: Add system and target support to gexp->file.

* guix/gexp.scm (gexp->file): Add system and target arguments and pass them to
gexp->derivation and load-path-expression calls,
(scheme-file-compiler): adapt accordingly to pass system and target arguments.
---
 guix/gexp.scm | 22 +++++++++++++++++-----
 1 file changed, 17 insertions(+), 5 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index a96592ac76..ca436b5a66 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -456,7 +457,10 @@ This is the declarative counterpart of 'gexp->file'."
   ;; Compile FILE by returning a derivation that builds the file.
   (match file
     (($ <scheme-file> name gexp splice?)
-     (gexp->file name gexp #:splice? splice?))))
+     (gexp->file name gexp
+                 #:splice? splice?
+                 #:system system
+                 #:target target))))
 
 ;; Appending SUFFIX to BASE's output file name.
 (define-record-type <file-append>
@@ -1603,7 +1607,9 @@ imported modules in its search path.  Look up EXP's modules in MODULE-PATH."
 (define* (gexp->file name exp #:key
                      (set-load-path? #t)
                      (module-path %load-path)
-                     (splice? #f))
+                     (splice? #f)
+                     (system (%current-system))
+                     target)
   "Return a derivation that builds a file NAME containing EXP.  When SPLICE?
 is true, EXP is considered to be a list of expressions that will be spliced in
 the resulting file.
@@ -1626,10 +1632,14 @@ Lookup EXP's modules in MODULE-PATH."
                                                     exp
                                                     (gexp ((ungexp exp)))))))))
                         #:local-build? #t
-                        #:substitutable? #f)
+                        #:substitutable? #f
+                        #:system system
+                        #:target target)
       (mlet %store-monad ((set-load-path
                            (load-path-expression modules module-path
-                                                 #:extensions extensions)))
+                                                 #:extensions extensions
+                                                 #:system system
+                                                 #:target target)))
         (gexp->derivation name
                           (gexp
                            (call-with-output-file (ungexp output)
@@ -1642,7 +1652,9 @@ Lookup EXP's modules in MODULE-PATH."
                                                       (gexp ((ungexp exp)))))))))
                           #:module-path module-path
                           #:local-build? #t
-                          #:substitutable? #f))))
+                          #:substitutable? #f
+                          #:system system
+                          #:target target))))
 
 (define* (text-file* name #:rest text)
   "Return as a monadic value a derivation that builds a text file containing
-- 
2.24.0

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 78 bytes --]


In the same spirit, here's another patch to fix profile-derivation.

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-profile-derivation-Use-current-system-and-target.patch --]
[-- Type: text/x-diff, Size: 1104 bytes --]

From 964f14a8bbd420f0f9207f1a666badaaaf625e3e Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Sat, 14 Dec 2019 18:39:59 +0100
Subject: [PATCH] profile-derivation: Use current system and target.

* guix/profiles.scm (profile-derivation): Use current system and target.
---
 guix/profiles.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 616605151e..a328e40687 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -1438,7 +1438,8 @@ MANIFEST."
                              (locales? #t)
                              (allow-collisions? #f)
                              (relative-symlinks? #f)
-                             system target)
+                             (system (%current-system))
+                             (target (%current-target-system)))
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST.  The profile includes additional derivations returned by
 the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.
-- 
2.24.0

[bug#38612] Pass system and target arguments to gexp->file.

[Ludovic Courtès]

Hi,

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

>>From 67c3982503c4d9ab4c77b5df295957abbe60dfeb Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Sat, 14 Dec 2019 17:52:53 +0100
> Subject: [PATCH] gexp: Add system and target support to gexp->file.
>
> * guix/gexp.scm (gexp->file): Add system and target arguments and pass them to
> gexp->derivation and load-path-expression calls,
> (scheme-file-compiler): adapt accordingly to pass system and target arguments.

Good catch, LGTM!

Thanks,
Ludo’.

[bug#38612] Pass system and target arguments to gexp->file.

[Ludovic Courtès]

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

> --- a/guix/profiles.scm
> +++ b/guix/profiles.scm
> @@ -1438,7 +1438,8 @@ MANIFEST."
>                               (locales? #t)
>                               (allow-collisions? #f)
>                               (relative-symlinks? #f)
> -                             system target)
> +                             (system (%current-system))
> +                             (target (%current-target-system)))
>    "Return a derivation that builds a profile (aka. 'user environment') with
>  the given MANIFEST.  The profile includes additional derivations returned by
>  the monadic procedures listed in HOOKS--such as an Info 'dir' file, etc.

AFAICS this change is unnecessary and even incorrect: the

  (mlet* %store-monad ((system (if system
                                   (return system)
                                   (current-system)))

trick ensures that we get the system that current at the time of the
monadic bind, whereas your change get the system and target that are
current at the time of the call.

It’s a terrible pitfall, I know…

Thanks,
Ludo’.

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

> Good catch, LGTM!

Pushed, thanks!

Mathieu

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 437 bytes --]


Hello,

> trick ensures that we get the system that current at the time of the
> monadic bind, whereas your change get the system and target that are
> current at the time of the call.
>
> It’s a terrible pitfall, I know…

Ok, then, I used the same trick to read %current-target-system at bind
time. With this trick, target is set to the value passed to the guix
system command (it is #f otherwise).

WDYT?

Mathieu

[-- Attachment #2: 0001-profiles-Fix-profile-derivation-cross-compilation.patch --]
[-- Type: text/x-diff, Size: 2658 bytes --]

From c8b0e65d9b264bd484c7c6571c2ce3d68173b057 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Tue, 24 Dec 2019 15:04:57 +0100
Subject: [PATCH] profiles: Fix profile-derivation cross-compilation.

* guix/store.scm (current-target-system): New exported monadic procedure.
* guix/profiles.scm (profile-derivation): Set target at bind time using the
above procedure.
---
 guix/profiles.scm | 4 ++++
 guix/store.scm    | 7 +++++++
 2 files changed, 11 insertions(+)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 987bab4e7f..d20f06e7b3 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -9,6 +9,7 @@
 ;;; Copyright © 2017 Huang Ying <huang.ying.caritas@gmail.com>
 ;;; Copyright © 2017 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com>
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1459,6 +1460,9 @@ are cross-built for TARGET."
   (mlet* %store-monad ((system (if system
                                    (return system)
                                    (current-system)))
+                       (target (if target
+                                   (return target)
+                                   (current-target-system)))
                        (ok?    (if allow-collisions?
                                    (return #t)
                                    (check-for-collisions manifest system
diff --git a/guix/store.scm b/guix/store.scm
index cf25d347fc..f99fa581a8 100644
--- a/guix/store.scm
+++ b/guix/store.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -159,6 +160,7 @@
             %guile-for-build
             current-system
             set-current-system
+            current-target-system
             text-file
             interned-file
             interned-file-tree
@@ -1816,6 +1818,11 @@ the store."
   (lambda (state)
     (values (%current-system system) state)))
 
+(define-inlinable (current-target-system)
+  ;; Consult the %CURRENT-TARGET-SYSTEM fluid at bind time.
+  (lambda (state)
+    (values (%current-target-system) state)))
+
 (define %guile-for-build
   ;; The derivation of the Guile to be used within the build environment,
   ;; when using 'gexp->derivation' and co.
-- 
2.24.1

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 142 bytes --]


Hello,

Turns out two more patches in the same vein are needed in (gnu services)
and (gnu system). They are attached here.

Thanks,

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-system-operating-system-boot-parameters-file-Fix-cro.patch --]
[-- Type: text/x-diff, Size: 2531 bytes --]

From a05baf4f4328ce2ca6da6860f6e596cd7559a08a Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Tue, 24 Dec 2019 18:24:37 +0100
Subject: [PATCH 1/2] system: operating-system-boot-parameters-file: Fix
 cross-compilation.

* gnu/system.scm (operating-system-boot-parameters-file): Add system and
target arguments and pass them to gexp->file call,
(operating-system-directory-base-entries): pass current system and target to
operating-system-boot-parameters-file procedure.
---
 gnu/system.scm | 17 +++++++++++++----
 1 file changed, 13 insertions(+), 4 deletions(-)

diff --git a/gnu/system.scm b/gnu/system.scm
index abdbb081e6..e7af7e7b47 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -470,7 +470,10 @@ value of the SYSTEM-SERVICE-TYPE service."
   (let ((locale (operating-system-locale-directory os)))
     (mlet %store-monad ((kernel -> (operating-system-kernel os))
                         (initrd -> (operating-system-initrd-file os))
-                        (params    (operating-system-boot-parameters-file os)))
+                        (params    (operating-system-boot-parameters-file
+                                    os
+                                    #:system (%current-system)
+                                    #:target (%current-target-system))))
       (return `(("kernel" ,kernel)
                 ("parameters" ,params)
                 ("initrd" ,initrd)
@@ -1048,8 +1051,12 @@ such as '--root' and '--load' to <boot-parameters>."
     (_
      device)))
 
-(define* (operating-system-boot-parameters-file os
-                                                #:key system-kernel-arguments?)
+(define* (operating-system-boot-parameters-file
+          os
+          #:key
+          system-kernel-arguments?
+          system
+          target)
    "Return a file that describes the boot parameters of OS.  The primary use of
 this file is the reconstruction of GRUB menu entries for old configurations.
 
@@ -1085,7 +1092,9 @@ being stored into the \"parameters\" file)."
                      (device
                       #$(device->sexp (boot-parameters-store-device params)))
                      (mount-point #$(boot-parameters-store-mount-point params))))
-                 #:set-load-path? #f)))
+                 #:set-load-path? #f
+                 #:system system
+                 #:target target)))
 
 (define-gexp-compiler (operating-system-compiler (os <operating-system>)
                                                  system target)
-- 
2.24.1


[-- Attachment #3: 0002-services-Fix-cross-compilation.patch --]
[-- Type: text/x-diff, Size: 2653 bytes --]

From 0ce67afc4f33074e20824751c22ba01cf6a3e184 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Wed, 25 Dec 2019 09:49:53 +0100
Subject: [PATCH 2/2] services: Fix cross-compilation.

* gnu/services.scm (system-derivation): Pass current system and target at bind
time to lower-object,
(compute-boot-script): also pass current system and target at bind time to
gexp->file.
---
 gnu/services.scm | 19 ++++++++++++++-----
 1 file changed, 14 insertions(+), 5 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index e7a3a95e43..e6f8ae0fb0 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
+;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -321,11 +322,15 @@ This is a shorthand for (map (lambda (svc) ...) %base-services)."
 (define (system-derivation mentries mextensions)
   "Return as a monadic value the derivation of the 'system' directory
 containing the given entries."
-  (mlet %store-monad ((entries    mentries)
+  (mlet %store-monad ((system (current-system))
+                      (target (current-target-system))
+                      (entries    mentries)
                       (extensions (sequence %store-monad mextensions)))
     (lower-object
      (file-union "system"
-                 (append entries (concatenate extensions))))))
+                 (append entries (concatenate extensions)))
+     system
+     #:target target)))
 
 (define system-service-type
   ;; This is the ultimate service type, the root of the service DAG.  The
@@ -346,9 +351,13 @@ system profile, boot script, and so on.")))
   ;; order.  That is, user extensions would come first, and extensions added
   ;; by 'essential-services' (e.g., running shepherd) are guaranteed to come
   ;; last.
-  (gexp->file "boot"
-              ;; Clean up and activate the system, then spawn shepherd.
-              #~(begin #$@(reverse gexps))))
+  (mlet %store-monad ((system (current-system))
+                      (target (current-target-system)))
+    (gexp->file "boot"
+                ;; Clean up and activate the system, then spawn shepherd.
+                #~(begin #$@(reverse gexps))
+                #:system system
+                #:target target)))
 
 (define (boot-script-entry mboot)
   "Return, as a monadic value, an entry for the boot script in the system
-- 
2.24.1

[bug#38612] Pass system and target arguments to gexp->file.

[Ludovic Courtès]

Hello,

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

> From c8b0e65d9b264bd484c7c6571c2ce3d68173b057 Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Tue, 24 Dec 2019 15:04:57 +0100
> Subject: [PATCH] profiles: Fix profile-derivation cross-compilation.
>
> * guix/store.scm (current-target-system): New exported monadic procedure.
> * guix/profiles.scm (profile-derivation): Set target at bind time using the
> above procedure.

LGTM!

Does it fix something for you?

Thanks,
Ludo’.

[bug#38612] Pass system and target arguments to gexp->file.

[Ludovic Courtès]

Hello,

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

> From a05baf4f4328ce2ca6da6860f6e596cd7559a08a Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Tue, 24 Dec 2019 18:24:37 +0100
> Subject: [PATCH 1/2] system: operating-system-boot-parameters-file: Fix
>  cross-compilation.
>
> * gnu/system.scm (operating-system-boot-parameters-file): Add system and
> target arguments and pass them to gexp->file call,
> (operating-system-directory-base-entries): pass current system and target to
> operating-system-boot-parameters-file procedure.
> ---
>  gnu/system.scm | 17 +++++++++++++----
>  1 file changed, 13 insertions(+), 4 deletions(-)
>
> diff --git a/gnu/system.scm b/gnu/system.scm
> index abdbb081e6..e7af7e7b47 100644
> --- a/gnu/system.scm
> +++ b/gnu/system.scm
> @@ -470,7 +470,10 @@ value of the SYSTEM-SERVICE-TYPE service."
>    (let ((locale (operating-system-locale-directory os)))
>      (mlet %store-monad ((kernel -> (operating-system-kernel os))
>                          (initrd -> (operating-system-initrd-file os))
> -                        (params    (operating-system-boot-parameters-file os)))
> +                        (params    (operating-system-boot-parameters-file
> +                                    os
> +                                    #:system (%current-system)
> +                                    #:target (%current-target-system))))

In general, in monadic code, we should refer to (current-system) and
(current-target-system), not to the SRFI-39 parameters.

> -(define* (operating-system-boot-parameters-file os
> -                                                #:key system-kernel-arguments?)
> +(define* (operating-system-boot-parameters-file
> +          os
> +          #:key
> +          system-kernel-arguments?
> +          system
> +          target)
>     "Return a file that describes the boot parameters of OS.  The primary use of
>  this file is the reconstruction of GRUB menu entries for old configurations.
>  
> @@ -1085,7 +1092,9 @@ being stored into the \"parameters\" file)."
>                       (device
>                        #$(device->sexp (boot-parameters-store-device params)))
>                       (mount-point #$(boot-parameters-store-mount-point params))))
> -                 #:set-load-path? #f)))
> +                 #:set-load-path? #f
> +                 #:system system
> +                 #:target target)))

By default, ‘gexp->file’ now uses the current system and target, so this
change shouldn’t be necessary if you just want to use those.  Am I
missing something?

The general guideline is that it would be good if only primitives
(monadic procedures in (guix gexp) as well as gexp compilers) would have
an explicit #:system and #:target parameter.

> From 0ce67afc4f33074e20824751c22ba01cf6a3e184 Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Wed, 25 Dec 2019 09:49:53 +0100
> Subject: [PATCH 2/2] services: Fix cross-compilation.
>
> * gnu/services.scm (system-derivation): Pass current system and target at bind
> time to lower-object,
> (compute-boot-script): also pass current system and target at bind time to
> gexp->file.

[...]

>  (define (system-derivation mentries mextensions)
>    "Return as a monadic value the derivation of the 'system' directory
>  containing the given entries."
> -  (mlet %store-monad ((entries    mentries)
> +  (mlet %store-monad ((system (current-system))
> +                      (target (current-target-system))
> +                      (entries    mentries)
>                        (extensions (sequence %store-monad mextensions)))

Please alight the RHS of ‘mlet’ bindings.  :-)

>      (lower-object
>       (file-union "system"
> -                 (append entries (concatenate extensions))))))
> +                 (append entries (concatenate extensions)))
> +     system
> +     #:target target)))

I guess this is needed here because ‘lower-object’ has #:target default
to #f.

> +  (mlet %store-monad ((system (current-system))
> +                      (target (current-target-system)))
> +    (gexp->file "boot"
> +                ;; Clean up and activate the system, then spawn shepherd.
> +                #~(begin #$@(reverse gexps))
> +                #:system system
> +                #:target target)))

This one is unnecessary now that ‘gexp->file’ honors the current system
and target, right?

Thanks,
Ludo’.

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

Hey Ludo,

> LGTM!
>
> Does it fix something for you?

Thanks for your review :) Yes, without this patch, all
operating-system-packages are built for host system instead of target,
when cross-compiling a Guix System.

Mathieu

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

Hey,

> In general, in monadic code, we should refer to (current-system) and
> (current-target-system), not to the SRFI-39 parameters.

Ok!

> By default, ‘gexp->file’ now uses the current system and target, so this
> change shouldn’t be necessary if you just want to use those.  Am I
> missing something?

Well turns out that gexp->file takes #f as default target (as
gexp->script and lower-object).

Using %current-target-system as default target argument (as gexp->sexp)
makes those two patches useless.

Would you have any objection to use %current-target-system as default
target argument in gexp->file and lower-object?

Thanks,

Mathieu

[bug#38612] Pass system and target arguments to gexp->file.

[Ludovic Courtès]

Hello!

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

>> In general, in monadic code, we should refer to (current-system) and
>> (current-target-system), not to the SRFI-39 parameters.
>
> Ok!
>
>> By default, ‘gexp->file’ now uses the current system and target, so this
>> change shouldn’t be necessary if you just want to use those.  Am I
>> missing something?
>
> Well turns out that gexp->file takes #f as default target (as
> gexp->script and lower-object).

Oh, right.

> Using %current-target-system as default target argument (as gexp->sexp)
> makes those two patches useless.
>
> Would you have any objection to use %current-target-system as default
> target argument in gexp->file and lower-object?

As written above, it should default to ‘current-target-system’ rather
than ‘%current-target-system’.  Kind of annoying, but heh…

Also, we should probably get rid of the monadic style in (gnu services).
That would simplify things, but there are compatibility considerations…

Thanks,
Ludo’.

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

[-- Attachment #1: Type: text/plain, Size: 384 bytes --]


Hey Ludo,

Then, here's a patch that set the default target to 'current in
lower-object, gexp->file and gexp->script. Then, (current-target-system)
is used at bind time if target is 'current (same way as gexp->derivation
and lower-gexp).

An additionnal patch is needed because lower-object is called without a
default target in lower-gexp, when lowering extensions.

WDYT?

Mathieu

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-gexp-Default-to-current-target.patch --]
[-- Type: text/x-diff, Size: 7340 bytes --]

From f5d773dc0a627ba6059f1025189d33a9e0d083b5 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Sat, 28 Dec 2019 21:29:06 +0100
Subject: [PATCH 1/2] gexp: Default to current target.

* guix/gexp.scm (lower-object): Set target argument to 'current by default and
look for the current target system at bind time if needed,
(gexp->file): ditto,
(gexp->script): ditto.
---
 guix/gexp.scm | 87 ++++++++++++++++++++++++++++++---------------------
 1 file changed, 51 insertions(+), 36 deletions(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 12331052a6..11d4e86037 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -215,7 +215,7 @@ procedure to expand it; otherwise return #f."
 
 (define* (lower-object obj
                        #:optional (system (%current-system))
-                       #:key target)
+                       #:key (target 'current))
   "Return as a value in %STORE-MONAD the derivation or store item
 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
@@ -225,7 +225,10 @@ OBJ must be an object that has an associated gexp compiler, such as a
      (raise (condition (&gexp-input-error (input obj)))))
     (lower
      ;; Cache in STORE the result of lowering OBJ.
-     (mlet %store-monad ((graft? (grafting?)))
+     (mlet %store-monad ((target (if (eq? target 'current)
+                                     (current-target-system)
+                                     (return target)))
+                         (graft? (grafting?)))
        (mcached (let ((lower (lookup-compiler obj)))
                   (lower obj system target))
                 obj
@@ -1571,16 +1574,19 @@ are searched for in PATH.  Return #f when MODULES and EXTENSIONS are empty."
                        #:key (guile (default-guile))
                        (module-path %load-path)
                        (system (%current-system))
-                       target)
+                       (target 'current))
   "Return an executable script NAME that runs EXP using GUILE, with EXP's
 imported modules in its search path.  Look up EXP's modules in MODULE-PATH."
-  (mlet %store-monad ((set-load-path
-                       (load-path-expression (gexp-modules exp)
-                                             module-path
-                                             #:extensions
-                                             (gexp-extensions exp)
-                                             #:system system
-                                             #:target target)))
+  (mlet* %store-monad ((target (if (eq? target 'current)
+                                   (current-target-system)
+                                   (return target)))
+                       (set-load-path
+                        (load-path-expression (gexp-modules exp)
+                                              module-path
+                                              #:extensions
+                                              (gexp-extensions exp)
+                                              #:system system
+                                              #:target target)))
     (gexp->derivation name
                       (gexp
                        (call-with-output-file (ungexp output)
@@ -1609,7 +1615,7 @@ imported modules in its search path.  Look up EXP's modules in MODULE-PATH."
                      (module-path %load-path)
                      (splice? #f)
                      (system (%current-system))
-                     target)
+                     (target 'current))
   "Return a derivation that builds a file NAME containing EXP.  When SPLICE?
 is true, EXP is considered to be a list of expressions that will be spliced in
 the resulting file.
@@ -1620,36 +1626,45 @@ Lookup EXP's modules in MODULE-PATH."
   (define modules (gexp-modules exp))
   (define extensions (gexp-extensions exp))
 
-  (if (or (not set-load-path?)
-          (and (null? modules) (null? extensions)))
-      (gexp->derivation name
-                        (gexp
-                         (call-with-output-file (ungexp output)
-                           (lambda (port)
-                             (for-each (lambda (exp)
-                                         (write exp port))
-                                       '(ungexp (if splice?
-                                                    exp
-                                                    (gexp ((ungexp exp)))))))))
-                        #:local-build? #t
-                        #:substitutable? #f
-                        #:system system
-                        #:target target)
-      (mlet %store-monad ((set-load-path
-                           (load-path-expression modules module-path
-                                                 #:extensions extensions
-                                                 #:system system
-                                                 #:target target)))
+  (mlet* %store-monad
+      ((target (if (eq? target 'current)
+                   (current-target-system)
+                   (return target)))
+       (no-load-path? -> (or (not set-load-path?)
+                             (and (null? modules)
+                                  (null? extensions))))
+       (set-load-path
+        (or (return no-load-path?)
+            (load-path-expression modules module-path
+                                  #:extensions extensions
+                                  #:system system
+                                  #:target target))))
+    (if no-load-path?
+        (gexp->derivation name
+                          (gexp
+                           (call-with-output-file (ungexp output)
+                             (lambda (port)
+                               (for-each
+                                (lambda (exp)
+                                  (write exp port))
+                                '(ungexp (if splice?
+                                             exp
+                                             (gexp ((ungexp exp)))))))))
+                          #:local-build? #t
+                          #:substitutable? #f
+                          #:system system
+                          #:target target)
         (gexp->derivation name
                           (gexp
                            (call-with-output-file (ungexp output)
                              (lambda (port)
                                (write '(ungexp set-load-path) port)
-                               (for-each (lambda (exp)
-                                           (write exp port))
-                                         '(ungexp (if splice?
-                                                      exp
-                                                      (gexp ((ungexp exp)))))))))
+                               (for-each
+                                (lambda (exp)
+                                  (write exp port))
+                                '(ungexp (if splice?
+                                             exp
+                                             (gexp ((ungexp exp)))))))))
                           #:module-path module-path
                           #:local-build? #t
                           #:substitutable? #f
-- 
2.24.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-gexp-lower-gexp-Do-not-pass-default-target-to-lower-.patch --]
[-- Type: text/x-diff, Size: 1391 bytes --]

From 21af4b796fb638c0c70a4b73d9add53ee2e9747e Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <m.othacehe@gmail.com>
Date: Sat, 28 Dec 2019 21:53:05 +0100
Subject: [PATCH 2/2] gexp: lower-gexp: Do not pass default target to
 lower-object.

Default target argument of lower-object is no longer #f but the current target
system. However, even if %current-target-system is set, we do not want to
cross-compile gexp extensions.

* guix/gexp.scm (lower-gexp): Make sure that extensions are not cross-built by
passing #f as target argument of lower-object.
---
 guix/gexp.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/guix/gexp.scm b/guix/gexp.scm
index 11d4e86037..027701a201 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -756,7 +756,8 @@ derivations--e.g., code evaluated for its side effects."
                        (extensions -> (gexp-extensions exp))
                        (exts     (mapm %store-monad
                                        (lambda (obj)
-                                         (lower-object obj system))
+                                         (lower-object obj system
+                                                       #:target #f))
                                        extensions))
                        (modules+compiled (imported+compiled-modules
                                           %modules system
-- 
2.24.1

[bug#38612] Pass system and target arguments to gexp->file.

[Ludovic Courtès]

Hi!

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

> Then, here's a patch that set the default target to 'current in
> lower-object, gexp->file and gexp->script. Then, (current-target-system)
> is used at bind time if target is 'current (same way as gexp->derivation
> and lower-gexp).
>
> An additionnal patch is needed because lower-object is called without a
> default target in lower-gexp, when lowering extensions.
>
> WDYT?
>
> Mathieu
>
> From f5d773dc0a627ba6059f1025189d33a9e0d083b5 Mon Sep 17 00:00:00 2001
> From: Mathieu Othacehe <m.othacehe@gmail.com>
> Date: Sat, 28 Dec 2019 21:29:06 +0100
> Subject: [PATCH 1/2] gexp: Default to current target.
>
> * guix/gexp.scm (lower-object): Set target argument to 'current by default and
> look for the current target system at bind time if needed,
> (gexp->file): ditto,
> (gexp->script): ditto.

Uh, it’s “the right thing” but it’s getting ugly.  :-/

If we take a step back, what’s the minimal change that would solve the
problem you’re looking at?

Apologies for the back-and-forth, it’s a tricky area!

Thanks,
Ludo’.

[bug#38612] Pass system and target arguments to gexp->file.

[Mathieu Othacehe]

Hey,

> Uh, it’s “the right thing” but it’s getting ugly.  :-/
>
> If we take a step back, what’s the minimal change that would solve the
> problem you’re looking at?
>
> Apologies for the back-and-forth, it’s a tricky area!

I'm glad I can have your support on this topic :)

Here's a small recap of the situation. As you may know I'm trying to get
"guix system build install.scm --target=xxx" to work.

My board needs specific initrd kernel modules to boot. As target is not
passed to lower-object in system-derivation procedure of (gnu services),
raw-initrd will try to locate those (arm specific) modules in the host
x86 kernel, where they do not exist, and fail.

The same thing happens for operating-system-boot-parameters-file which
contains a gexp->file call.

Now, while this problem is quite specific, we need to find a generic
solution to those target issues. Forcing the user of (guix gexp) to pass
a target argument implies the use of monadic style to read
%current-target-system safely.

On the other hand, defaulting to the current target inside (guix gexp)
as proposed in my patch is kinda ugly as you noticed :p

Could %current-target-system be set outside of the monadic context so
that we can access it from wherever we want?

That would also solve the issue I have with canonical-package procedure[1],
that read %current-target-system outside of the monadic context, where
is is always #f.

Thanks for your help,

Mathieu
[1]: https://lists.gnu.org/archive/html/guix-devel/2019-12/msg00353.html