diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm index 59ef5d078b..4f90e9e41d 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -3013,9 +3013,10 @@ memoized as a function of '%current-system'." '/memoized)))) #'(begin (define memoized - (mlambda (system) exp)) + (mlambda (system target) exp)) (define-syntax identifier - (identifier-syntax (memoized (%current-system)))))))))) + (identifier-syntax (memoized (%current-system) + (%current-target-system)))))))))) (define/system-dependent linux-libre-headers-boot0 ;; Note: this is wrapped in a thunk to nicely handle circular dependencies diff --git a/guix/profiles.scm b/guix/profiles.scm index 25ff146bdf..58d7e0e450 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -1580,6 +1580,18 @@ This is one of the things to do for the result to be relocatable. When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST are cross-built for TARGET." + (define (call-with-system+target system target thunk) + (mlet* %store-monad ((system0 (set-current-system system)) + (target0 (set-current-target (pk 'set-target target))) + (result (thunk))) + (mbegin %store-monad + (set-current-system system0) + (set-current-target target0) + (return result)))) + + (define-syntax-rule (with-system+target system target exp) + (call-with-system+target system target (lambda () exp))) + (mlet* %store-monad ((system (if system (return system) (current-system))) @@ -1592,9 +1604,12 @@ are cross-built for TARGET." #:target target))) (extras (if (null? (manifest-entries manifest)) (return '()) - (mapm/accumulate-builds (lambda (hook) - (hook manifest)) - hooks)))) + (with-system+target + system + target + (mapm/accumulate-builds (lambda (hook) + (hook manifest)) + hooks))))) (define inputs (append (filter-map (lambda (drv) (and (derivation? drv) @@ -1689,6 +1704,8 @@ are cross-built for TARGET." (match profile (($ name manifest hooks locales? allow-collisions? relative-symlinks?) + (pk 'prof-c system target (%current-target-system)) + ;; (display-backtrace (make-stack #t) (current-error-port) #f 80) (profile-derivation manifest #:name name #:hooks hooks diff --git a/guix/store.scm b/guix/store.scm index 6c7c07fd2d..92158bd658 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1899,7 +1899,10 @@ coalesce them into a single call." (values (map/accumulate-builds store (lambda (obj) (run-with-store store - (mproc obj))) + (mproc obj) + ;; #:system (%current-system) + ;; #:target (%current-target-system) + )) lst) store)))