diff options
| -rw-r--r-- | guix/packages.scm | 72 |
1 files changed, 41 insertions, 31 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index 0549771cea..242b912d5d 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -27,6 +27,7 @@ #:use-module (srfi srfi-1) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-11) + #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:re-export (%current-system) @@ -305,41 +306,47 @@ Return the cached result when available." (#f (cache package system thunk))))) -(define* (package-derivation store package - #:optional (system (%current-system))) - "Return the derivation path and corresponding <derivation> object of -PACKAGE for SYSTEM." +(define* (expand-input store package input system #:optional cross-system) + "Expand INPUT, an input tuple, such that it contains only references to +derivation paths or store paths. PACKAGE is only used to provide contextual +information in exceptions." (define (intern file) ;; Add FILE to the store. Set the `recursive?' bit to #t, so that ;; file permissions are preserved. (add-to-store store (basename file) #t "sha256" file)) - (define expand-input - ;; Expand the given input tuple such that it contains only - ;; references to derivation paths or store paths. - (match-lambda - (((? string? name) (? package? package)) - (list name (package-derivation store package system))) - (((? string? name) (? package? package) - (? string? sub-drv)) - (list name (package-derivation store package system) - sub-drv)) - (((? string? name) - (and (? string?) (? derivation-path?) drv)) - (list name drv)) - (((? string? name) - (and (? string?) (? file-exists? file))) - ;; Add FILE to the store. When FILE is in the sub-directory of a - ;; store path, it needs to be added anyway, so it can be used as a - ;; source. - (list name (intern file))) - (((? string? name) (? origin? source)) - (list name (package-source-derivation store source system))) - (x - (raise (condition (&package-input-error - (package package) - (input x))))))) + (define derivation + (if cross-system + (cut package-cross-derivation store <> cross-system system) + (cut package-derivation store <> system))) + + (match input + (((? string? name) (? package? package)) + (list name (derivation package))) + (((? string? name) (? package? package) + (? string? sub-drv)) + (list name (derivation package) + sub-drv)) + (((? string? name) + (and (? string?) (? derivation-path?) drv)) + (list name drv)) + (((? string? name) + (and (? string?) (? file-exists? file))) + ;; Add FILE to the store. When FILE is in the sub-directory of a + ;; store path, it needs to be added anyway, so it can be used as a + ;; source. + (list name (intern file))) + (((? string? name) (? origin? source)) + (list name (package-source-derivation store source system))) + (x + (raise (condition (&package-input-error + (package package) + (input x))))))) +(define* (package-derivation store package + #:optional (system (%current-system))) + "Return the derivation path and corresponding <derivation> object of +PACKAGE for SYSTEM." ;; Compute the derivation and cache the result. Caching is important ;; because some derivations, such as the implicit inputs of the GNU build ;; system, will be queried many, many times in a row. @@ -353,7 +360,9 @@ PACKAGE for SYSTEM." args inputs propagated-inputs native-inputs self-native-input? outputs) (let* ((inputs (package-transitive-inputs package)) - (input-drvs (map expand-input inputs)) + (input-drvs (map (cut expand-input + store package <> system) + inputs)) (paths (delete-duplicates (append-map (match-lambda ((_ (? package? p) _ ...) @@ -371,7 +380,8 @@ PACKAGE for SYSTEM." #:outputs outputs #:system system (args)))))))) -(define* (package-cross-derivation store package) +(define* (package-cross-derivation store package cross-system + #:optional (system (%current-system))) ;; TODO #f) |