packages: Mark the `inputs' field of <package> as thunked.

* guix/packages.scm (<package>)[inputs]: Mark as thunked.
  (package-derivation)[expand-input]: Remove case where the input is a
  procedure.
* tests/packages.scm ("trivial with system-dependent input"): Remove
  `lambda', and use (%current-system).
* gnu/packages/bootstrap.scm (package-from-tarball): Likewise for `inputs'.
  (%bootstrap-glibc, %bootstrap-gcc): Likewise.
* gnu/packages/scheme.scm (mit-scheme): Likewise.
This commit is contained in:
Ludovic Courtès 2013-01-24 23:33:30 +01:00
parent 3b9c002088
commit dd6b9a3790
4 changed files with 67 additions and 86 deletions

View file

@ -99,12 +99,9 @@ (define (package-from-tarball name* source* program-to-test description*)
(zero? (system* (string-append "bin/" ,program-to-test) (zero? (system* (string-append "bin/" ,program-to-test)
"--version")))))))) "--version"))))))))
(inputs (inputs
`(("tar" ,(lambda (system) `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
(search-bootstrap-binary "tar" system))) ("xz" ,(search-bootstrap-binary "xz" (%current-system)))
("xz" ,(lambda (system) ("tarball" ,(bootstrap-origin (source* (%current-system))))))
(search-bootstrap-binary "xz" system)))
("tarball" ,(lambda (system)
(bootstrap-origin (source* system))))))
(synopsis description*) (synopsis description*)
(description #f) (description #f)
(home-page #f))) (home-page #f)))
@ -269,25 +266,22 @@ (define %bootstrap-glibc
(("/[^ ]+/lib/(libc|ld)" _ prefix) (("/[^ ]+/lib/(libc|ld)" _ prefix)
(string-append out "/lib/" prefix)))))))) (string-append out "/lib/" prefix))))))))
(inputs (inputs
`(("tar" ,(lambda (system) `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
(search-bootstrap-binary "tar" system))) ("xz" ,(search-bootstrap-binary "xz" (%current-system)))
("xz" ,(lambda (system) ("tarball" ,(bootstrap-origin
(search-bootstrap-binary "xz" system)))
("tarball" ,(lambda (system)
(bootstrap-origin
(origin (origin
(method url-fetch) (method url-fetch)
(uri (map (cut string-append <> "/" system (uri (map (cut string-append <> "/" (%current-system)
"/20130105/glibc-2.17.tar.xz") "/20130105/glibc-2.17.tar.xz")
%bootstrap-base-urls)) %bootstrap-base-urls))
(sha256 (sha256
(match system (match (%current-system)
("x86_64-linux" ("x86_64-linux"
(base32 (base32
"18kv1z9d8dr1j3hm9w7663kchqw9p6rsx11n1m143jgba2jz6jy3")) "18kv1z9d8dr1j3hm9w7663kchqw9p6rsx11n1m143jgba2jz6jy3"))
("i686-linux" ("i686-linux"
(base32 (base32
"08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88")))))))))) "08hv8i0axwnihrcgbz19x0a7s6zyv3yx38x8r29liwl8h82x9g88")))))))))
(synopsis "Bootstrap binaries and headers of the GNU C Library") (synopsis "Bootstrap binaries and headers of the GNU C Library")
(description #f) (description #f)
(home-page #f))) (home-page #f)))
@ -337,28 +331,24 @@ (define %bootstrap-gcc
(chmod "gcc" #o555)))))) (chmod "gcc" #o555))))))
(inputs (inputs
`(("tar" ,(lambda (system) `(("tar" ,(search-bootstrap-binary "tar" (%current-system)))
(search-bootstrap-binary "tar" system))) ("xz" ,(search-bootstrap-binary "xz" (%current-system)))
("xz" ,(lambda (system) ("bash" ,(search-bootstrap-binary "bash" (%current-system)))
(search-bootstrap-binary "xz" system)))
("bash" ,(lambda (system)
(search-bootstrap-binary "bash" system)))
("libc" ,%bootstrap-glibc) ("libc" ,%bootstrap-glibc)
("tarball" ,(lambda (system) ("tarball" ,(bootstrap-origin
(bootstrap-origin
(origin (origin
(method url-fetch) (method url-fetch)
(uri (map (cut string-append <> "/" system (uri (map (cut string-append <> "/" (%current-system)
"/20130105/gcc-4.7.2.tar.xz") "/20130105/gcc-4.7.2.tar.xz")
%bootstrap-base-urls)) %bootstrap-base-urls))
(sha256 (sha256
(match system (match (%current-system)
("x86_64-linux" ("x86_64-linux"
(base32 (base32
"1x1p7han5crnbw906iwdifykr6grzm0w27dy9gz75j0q1b32i4px")) "1x1p7han5crnbw906iwdifykr6grzm0w27dy9gz75j0q1b32i4px"))
("i686-linux" ("i686-linux"
(base32 (base32
"06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2")))))))))) "06wqs0xxnpw3hn0xjb4c9cs0899p1xwkcysa2rvzhvpra0c5vsg2")))))))))
(synopsis "Bootstrap binaries of the GNU Compiler Collection") (synopsis "Bootstrap binaries of the GNU Compiler Collection")
(description #f) (description #f)
(home-page #f))) (home-page #f)))

View file

@ -22,6 +22,7 @@ (define-module (gnu packages scheme)
#:use-module (guix packages) #:use-module (guix packages)
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module ((guix utils) #:select (%current-system))
#:use-module (gnu packages m4) #:use-module (gnu packages m4)
#:use-module (gnu packages multiprecision) #:use-module (gnu packages multiprecision)
#:use-module (gnu packages emacs) #:use-module (gnu packages emacs)
@ -69,24 +70,24 @@ (define-public mit-scheme
("m4" ,m4) ("m4" ,m4)
("source" ("source"
,(lambda (system)
;; MIT/GNU Scheme is not bootstrappable, so it's recommended to ;; MIT/GNU Scheme is not bootstrappable, so it's recommended to
;; compile from the architecture-specific tarballs, which contain ;; compile from the architecture-specific tarballs, which contain
;; pre-built binaries. It leads to more efficient code than when ;; pre-built binaries. It leads to more efficient code than when
;; building the tarball that contains generated C code instead of ;; building the tarball that contains generated C code instead of
;; those binaries. ;; those binaries.
(origin ,(origin
(method url-fetch) (method url-fetch)
(uri (string-append "mirror://gnu/mit-scheme/stable.pkg/" (uri (string-append "mirror://gnu/mit-scheme/stable.pkg/"
version "/mit-scheme-" version "/mit-scheme-"
version "-" version "-"
(match system (match (%current-system)
("x86_64-linux" "x86-64") ("x86_64-linux" "x86-64")
("i686-linux" "i386") ("i686-linux" "i386")
(_ "c")) (_ "c"))
".tar.gz")) ".tar.gz"))
(sha256 (sha256
(match system (match (%current-system)
("x86_64-linux" ("x86_64-linux"
(base32 (base32
"1wcxm9hyfc53myvlcn93fyqrnnn4scwkknl9hkbp1cphc6mp291x")) "1wcxm9hyfc53myvlcn93fyqrnnn4scwkknl9hkbp1cphc6mp291x"))
@ -95,7 +96,7 @@ (define-public mit-scheme
"0vi760fy550d9db538m0vzbq1mpdncvw9g8bk4lswk0kcdira55z")) "0vi760fy550d9db538m0vzbq1mpdncvw9g8bk4lswk0kcdira55z"))
(_ (_
(base32 (base32
"0pclakzwxbqgy6wqwvs6ml62wgby8ba8xzmwzdwhx1v8wv05yw1j"))))))))) "0pclakzwxbqgy6wqwvs6ml62wgby8ba8xzmwzdwhx1v8wv05yw1j"))))))))
(home-page "http://www.gnu.org/software/mit-scheme/") (home-page "http://www.gnu.org/software/mit-scheme/")
(synopsis "MIT/GNU Scheme, a native code Scheme compiler") (synopsis "MIT/GNU Scheme, a native code Scheme compiler")
(description (description

View file

@ -113,7 +113,7 @@ (define-record-type* <package>
(default '()) (thunked)) (default '()) (thunked))
(inputs package-inputs ; input packages or derivations (inputs package-inputs ; input packages or derivations
(default '())) (default '()) (thunked))
(propagated-inputs package-propagated-inputs ; same, but propagated (propagated-inputs package-propagated-inputs ; same, but propagated
(default '())) (default '()))
(native-inputs package-native-inputs ; native input packages/derivations (native-inputs package-native-inputs ; native input packages/derivations
@ -272,15 +272,6 @@ (define expand-input
(list name (intern file))) (list name (intern file)))
(((? string? name) (? origin? source)) (((? string? name) (? origin? source))
(list name (package-source-derivation store source system))) (list name (package-source-derivation store source system)))
((and i ((? string? name) (? procedure? proc) sub-drv ...))
;; This form allows PROC to make a SYSTEM-dependent choice.
;; XXX: Currently PROC must return a .drv, a store path, a local
;; file name, or an <origin>. If it were allowed to return a
;; package, then `transitive-inputs' and co. would need to be
;; adjusted.
(let ((input (proc system)))
(expand-input (cons* name input sub-drv))))
(x (x
(raise (condition (&package-input-error (raise (condition (&package-input-error
(package package) (package package)

View file

@ -124,9 +124,8 @@ (define-syntax-rule (dummy-package name* extra-fields ...)
(bash (assoc-ref %build-inputs "bash"))) (bash (assoc-ref %build-inputs "bash")))
(zero? (system* bash "-c" (zero? (system* bash "-c"
(format #f "echo hello > ~a" out)))))) (format #f "echo hello > ~a" out))))))
(inputs `(("bash" ,(lambda (system) (inputs `(("bash" ,(search-bootstrap-binary "bash"
(search-bootstrap-binary "bash" (%current-system)))))))
system)))))))
(d (package-derivation %store p))) (d (package-derivation %store p)))
(and (build-derivations %store (list d)) (and (build-derivations %store (list d))
(let ((p (pk 'drv d (derivation-path->output-path d)))) (let ((p (pk 'drv d (derivation-path->output-path d))))