From mboxrd@z Thu Jan 1 00:00:00 1970 Received: from eggs.gnu.org ([2001:470:142:3::10]:50887) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ilUxY-00089r-1g for guix-patches@gnu.org; Sun, 29 Dec 2019 04:34:05 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ilUxW-0001FN-J2 for guix-patches@gnu.org; Sun, 29 Dec 2019 04:34:03 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:53269) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ilUxW-0001EX-Eb for guix-patches@gnu.org; Sun, 29 Dec 2019 04:34:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ilUxW-0004JC-8b for guix-patches@gnu.org; Sun, 29 Dec 2019 04:34:02 -0500 Subject: [bug#38612] Pass system and target arguments to gexp->file. Resent-Message-ID: References: <87a77ug6vv.fsf@gmail.com> <8736dl8wxq.fsf@gmail.com> <87d0cipt6z.fsf@gnu.org> <87r20t7r0j.fsf@gmail.com> <87imm468rr.fsf@gmail.com> <87d0cbhsk1.fsf@gnu.org> <87mubej4sq.fsf@gmail.com> <87a77dhce4.fsf@gnu.org> From: Mathieu Othacehe In-reply-to: <87a77dhce4.fsf@gnu.org> Date: Sun, 29 Dec 2019 10:33:20 +0100 Message-ID: <878smvtr1b.fsf@gmail.com> MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+kyle=kyleam.com@gnu.org Sender: "Guix-patches" To: Ludovic =?UTF-8?Q?Court=C3=A8s?= Cc: 38612@debbugs.gnu.org --=-=-= Content-Type: text/plain 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-gexp-Default-to-current-target.patch >From f5d773dc0a627ba6059f1025189d33a9e0d083b5 Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe 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 --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0002-gexp-lower-gexp-Do-not-pass-default-target-to-lower-.patch >From 21af4b796fb638c0c70a4b73d9add53ee2e9747e Mon Sep 17 00:00:00 2001 From: Mathieu Othacehe 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 --=-=-=--