summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
Diffstat (limited to 'guix')
-rw-r--r--guix/packages.scm71
-rw-r--r--guix/utils.scm6
2 files changed, 73 insertions, 4 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index 242b912d5d..6321a58374 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -69,6 +69,8 @@
package-field-location
package-transitive-inputs
+ package-transitive-target-inputs
+ package-transitive-native-inputs
package-transitive-propagated-inputs
package-source-derivation
package-derivation
@@ -268,6 +270,19 @@ with their propagated inputs, recursively."
(package-inputs package)
(package-propagated-inputs package))))
+(define (package-transitive-target-inputs package)
+ "Return the transitive target inputs of PACKAGE---i.e., its direct inputs
+along with their propagated inputs, recursively. This only includes inputs
+for the target system, and not native inputs."
+ (transitive-inputs (append (package-inputs package)
+ (package-propagated-inputs package))))
+
+(define (package-transitive-native-inputs package)
+ "Return the transitive native inputs of PACKAGE---i.e., its direct inputs
+along with their propagated inputs, recursively. This only includes inputs
+for the host system (\"native inputs\"), and not target inputs."
+ (transitive-inputs (package-native-inputs package)))
+
(define (package-transitive-propagated-inputs package)
"Return the propagated inputs of PACKAGE, and their propagated inputs,
recursively."
@@ -354,7 +369,8 @@ PACKAGE for SYSTEM."
;; Bind %CURRENT-SYSTEM so that thunked field values can refer
;; to it.
- (parameterize ((%current-system system))
+ (parameterize ((%current-system system)
+ (%current-target-system #f))
(match package
(($ <package> name version source (= build-system-builder builder)
args inputs propagated-inputs native-inputs self-native-input?
@@ -380,10 +396,57 @@ PACKAGE for SYSTEM."
#:outputs outputs #:system system
(args))))))))
-(define* (package-cross-derivation store package cross-system
+(define* (package-cross-derivation store package target
#:optional (system (%current-system)))
- ;; TODO
- #f)
+ "Cross-build PACKAGE for TARGET (a GNU triplet) from host SYSTEM (a Guix
+system identifying string)."
+ (cached package (cons system target)
+
+ ;; Bind %CURRENT-SYSTEM so that thunked field values can refer
+ ;; to it.
+ (parameterize ((%current-system system)
+ (%current-target-system target))
+ (match package
+ (($ <package> name version source
+ (= build-system-cross-builder builder)
+ args inputs propagated-inputs native-inputs self-native-input?
+ outputs)
+ (let* ((inputs (package-transitive-target-inputs package))
+ (input-drvs (map (cut expand-input
+ store package <>
+ system target)
+ inputs))
+ (host (append (if self-native-input?
+ `(("self" ,package))
+ '())
+ (package-transitive-native-inputs package)))
+ (host-drvs (map (cut expand-input
+ store package <> system)
+ host))
+ (all (append host inputs))
+ (paths (delete-duplicates
+ (append-map (match-lambda
+ ((_ (? package? p) _ ...)
+ (package-search-paths p))
+ (_ '()))
+ all)))
+ (npaths (delete-duplicates
+ (append-map (match-lambda
+ ((_ (? package? p) _ ...)
+ (package-native-search-paths
+ p))
+ (_ '()))
+ all))))
+
+ (apply builder
+ store (package-full-name package) target
+ (and source
+ (package-source-derivation store source system))
+ input-drvs host-drvs
+ #:search-paths paths
+ #:native-search-paths npaths
+ #:outputs outputs #:system system
+ (args))))))))
(define* (package-output store package output
#:optional (system (%current-system)))
diff --git a/guix/utils.scm b/guix/utils.scm
index 25a392e6a8..2478fb6939 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -57,6 +57,7 @@
gnu-triplet->nix-system
%current-system
+ %current-target-system
version-compare
version>?
package-name->name+version
@@ -310,6 +311,11 @@ returned by `config.guess'."
;; By default, this is equal to (gnu-triplet->nix-system %host-type).
(make-parameter %system))
+(define %current-target-system
+ ;; Either #f or a GNU triplet representing the target system we are
+ ;; cross-building to.
+ (make-parameter #f))
+
(define version-compare
(let ((strverscmp
(let ((sym (or (dynamic-func "strverscmp" (dynamic-link))