packages: Pass `system' around.

* guix/packages.scm (package-source-derivation): Add `system'
  parameter.  Pass it to METHOD.
  (package-derivation)[expand-input]: Pass SYSTEM to
  `package-derivation' and `package-source-derivation'.

* distro/packages/base.scm (package-with-bootstrap-guile)[boot]: Pass
  SYSTEM to FETCH.
master
Ludovic Courtès 2012-10-25 23:41:15 +02:00
parent ae39d1b233
commit b642e4b853
2 changed files with 14 additions and 9 deletions

View File

@ -1424,9 +1424,11 @@ $out/bin/guile --version~%"
"Return a variant of SOURCE, an <origin> instance, whose method uses "Return a variant of SOURCE, an <origin> instance, whose method uses
%BOOTSTRAP-GUILE to do its job." %BOOTSTRAP-GUILE to do its job."
(define (boot fetch) (define (boot fetch)
(lambda* (store url hash-algo hash #:optional name) (lambda* (store url hash-algo hash
#:optional name #:key system)
(fetch store url hash-algo hash (fetch store url hash-algo hash
#:guile %bootstrap-guile))) #:guile %bootstrap-guile
#:system system)))
(let ((orig-method (origin-method source))) (let ((orig-method (origin-method source)))
(origin (inherit source) (origin (inherit source)

View File

@ -164,11 +164,13 @@ representation."
"Return the full name of PACKAGE--i.e., `NAME-VERSION'." "Return the full name of PACKAGE--i.e., `NAME-VERSION'."
(string-append (package-name package) "-" (package-version package))) (string-append (package-name package) "-" (package-version package)))
(define (package-source-derivation store source) (define* (package-source-derivation store source
"Return the derivation path for SOURCE, a package source." #:optional (system (%current-system)))
"Return the derivation path for SOURCE, a package source, for SYSTEM."
(match source (match source
(($ <origin> uri method sha256 name) (($ <origin> uri method sha256 name)
(method store uri 'sha256 sha256 name)))) (method store uri 'sha256 sha256 name
#:system system))))
(define (transitive-inputs inputs) (define (transitive-inputs inputs)
(let loop ((inputs inputs) (let loop ((inputs inputs)
@ -238,10 +240,10 @@ recursively."
;; references to derivation paths or store paths. ;; references to derivation paths or store paths.
(match-lambda (match-lambda
(((? string? name) (? package? package)) (((? string? name) (? package? package))
(list name (package-derivation store package))) (list name (package-derivation store package system)))
(((? string? name) (? package? package) (((? string? name) (? package? package)
(? string? sub-drv)) (? string? sub-drv))
(list name (package-derivation store package) (list name (package-derivation store package system)
sub-drv)) sub-drv))
(((? string? name) (((? string? name)
(and (? string?) (? derivation-path?) drv)) (and (? string?) (? derivation-path?) drv))
@ -253,7 +255,7 @@ recursively."
;; source. ;; source.
(list name (intern file))) (list name (intern file)))
(((? string? name) (? origin? source)) (((? string? name) (? origin? source))
(list name (package-source-derivation store source))) (list name (package-source-derivation store source system)))
((and i ((? string? name) (? procedure? proc) sub-drv ...)) ((and i ((? string? name) (? procedure? proc) sub-drv ...))
;; This form allows PROC to make a SYSTEM-dependent choice. ;; This form allows PROC to make a SYSTEM-dependent choice.
@ -291,7 +293,8 @@ recursively."
(apply builder (apply builder
store (package-full-name package) store (package-full-name package)
(and source (package-source-derivation store source)) (and source
(package-source-derivation store source system))
inputs inputs
#:outputs outputs #:system system #:outputs outputs #:system system
(if (procedure? args) (if (procedure? args)