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

[Mathieu Othacehe]

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

>From f5d773dc0a627ba6059f1025189d33a9e0d083b5 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <address@hidden>
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

>From 21af4b796fb638c0c70a4b73d9add53ee2e9747e Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <address@hidden>
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