From: Mathieu Othacehe <m.othacehe@gmail.com>
To: "Ludovic Courtès" <ludo@gnu.org>
Cc: 38612@debbugs.gnu.org
Subject: [bug#38612] Pass system and target arguments to gexp->file.
Date: Sun, 29 Dec 2019 10:33:20 +0100 [thread overview]
Message-ID: <878smvtr1b.fsf@gmail.com> (raw)
In-Reply-To: <87a77dhce4.fsf@gnu.org>
[-- 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
next prev parent reply other threads:[~2019-12-29 9:34 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-12-14 17:21 [bug#38612] Pass system and target arguments to gexp->file Mathieu Othacehe
2019-12-15 14:50 ` Mathieu Othacehe
2019-12-20 21:45 ` Ludovic Courtès
2019-12-24 14:11 ` Mathieu Othacehe
2019-12-25 9:42 ` Mathieu Othacehe
2019-12-26 18:04 ` Ludovic Courtès
2019-12-26 18:54 ` Mathieu Othacehe
2019-12-27 18:05 ` Ludovic Courtès
2019-12-29 9:33 ` Mathieu Othacehe [this message]
2019-12-29 22:36 ` Ludovic Courtès
2019-12-30 8:40 ` Mathieu Othacehe
2019-12-26 17:58 ` Ludovic Courtès
2019-12-26 18:19 ` Mathieu Othacehe
2019-12-20 21:41 ` Ludovic Courtès
2019-12-24 14:08 ` Mathieu Othacehe
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=878smvtr1b.fsf@gmail.com \
--to=m.othacehe@gmail.com \
--cc=38612@debbugs.gnu.org \
--cc=ludo@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).