nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

* guix/packages.scm (<package>): Mark `arguments' as thunked.
  (package-derivation): Adjust accordingly.  Parameterize
  %CURRENT-SYSTEM to SYSTEM, so that arguments can refer to it.

* guix/build-system/gnu.scm (package-with-explicit-inputs): Expect
  `package-arguments' to always return a list, and return a list.
  (package-with-extra-configure-variable): Likewise.
  (static-package): Likewise.
* gnu/packages/base.scm (patch, findutils, gcc-4.7, binutils-boot0,
  gcc-boot0, glibc-final-with-bootstrap-bash, cross-gcc-wrapper,
  static-bash-for-glibc, binutils-final, gcc-final): Change `arguments'
  from a lambda to a list, and use (%current-system) as needed.
  (nix-system->gnu-triplet, boot-triplet): Have the first argument
  default to (%current-system).
* gnu/packages/bootstrap.scm (glibc-dynamic-linker): Have `system'
  default to (%current-system).
  (%bootstrap-gcc): Change `arguments' to a list.
* gnu/packages/gawk.scm (gawk): Likewise.
* gnu/packages/m4.scm (m4): Likewise.
* gnu/packages/make-bootstrap.scm (%glibc-for-bootstrap): Likewise, and
  expect `package-arguments' to return a list.
  (%static-inputs, %gcc-static, tarball-package): Likewise.
* gnu/packages/ncurses.scm (ncurses): Likewise.
This commit is contained in:
Ludovic Courtès 2013-01-23 23:21:59 +01:00
parent 9c9da07f4c
commit 21c203a53a
8 changed files with 414 additions and 456 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

75
gnu/packages/base.scm
View File

@ -162,10 +162,10 @@ files (as archives).")
(build-system gnu-build-system)
(native-inputs '()) ; FIXME: needs `ed' for the tests
(arguments
(case-lambda
((system) '(#:tests? #f))
((system cross-system)
'(#:configure-flags '("ac_cv_func_strnlen_working=yes")))))
'(#:tests? #f)
;; TODO: When cross-compiling, add this:
;; '(#:configure-flags '("ac_cv_func_strnlen_working=yes"))
)
(synopsis "GNU Patch, a program to apply differences to files")
(description
"GNU Patch takes a patch file containing a difference listing produced by
@ -235,14 +235,13 @@ You can use the sdiff command to merge two files interactively.")
`(("patch/absolute-paths"
,(search-patch "findutils-absolute-paths.patch"))))
(arguments
(case-lambda
((system)
`(#:patches (list (assoc-ref %build-inputs "patch/absolute-paths"))))
((system cross-system)
;; Work around cross-compilation failure.
`(#:patches (list (assoc-ref %build-inputs "patch/absolute-paths")))
;; TODO: Work around cross-compilation failure.
;; See <http://savannah.gnu.org/bugs/?27299#comment1>.
`(#:configure-flags '("gl_cv_func_wcwidth_works=yes")
,@(arguments cross-system)))))
;; `(#:configure-flags '("gl_cv_func_wcwidth_works=yes")
;; ,@(arguments cross-system))
)
(synopsis "Basic directory searching utilities of the GNU operating
system")
(description
@ -396,7 +395,6 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
("mpfr" ,mpfr)
("mpc" ,mpc))) ; TODO: libelf, ppl, cloog, zlib, etc.
(arguments
(lambda (system)
`(#:out-of-source? #t
#:strip-binaries? ,stripped?
#:configure-flags
@ -418,7 +416,7 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
"-L" libc "/lib "
"-Wl,-dynamic-linker "
"-Wl," libc
,(glibc-dynamic-linker system)))
,(glibc-dynamic-linker)))
'())
,(string-append "BOOT_CFLAGS=-O2 "
,(if stripped? "-g0" "-g"))))
@ -440,7 +438,7 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
(("#define GLIBC_DYNAMIC_LINKER([^ ]*).*$" _ suffix)
(format #f "#define GLIBC_DYNAMIC_LINKER~a \"~a\"~%"
suffix
(string-append libc ,(glibc-dynamic-linker system)))))
(string-append libc ,(glibc-dynamic-linker)))))
;; Tell where to find libstdc++, libc, and `?crt*.o', except
;; `crt{begin,end}.o', which come with GCC.
@ -479,7 +477,7 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
,(if stripped?
"install-strip"
"install"))))
%standard-phases))))))
%standard-phases)))))
(properties `((gcc-libc . ,(assoc-ref inputs "libc"))))
(synopsis "The GNU Compiler Collection")
@ -653,7 +651,8 @@ with the Linux kernel.")
("findutils" ,findutils-boot0)
,@%bootstrap-inputs))
(define* (nix-system->gnu-triplet system #:optional (vendor "unknown"))
(define* (nix-system->gnu-triplet
#:optional (system (%current-system)) (vendor "unknown"))
"Return an a guess of the GNU triplet corresponding to Nix system
identifier SYSTEM."
(let* ((dash (string-index system #\-))
@ -665,10 +664,10 @@ identifier SYSTEM."
"linux-gnu"
os))))
(define boot-triplet
(define* (boot-triplet #:optional (system (%current-system)))
;; Return the triplet used to create the cross toolchain needed in the
;; first bootstrapping stage.
(cut nix-system->gnu-triplet <> "guix"))
(nix-system->gnu-triplet system "guix"))
;; Following Linux From Scratch, build a cross-toolchain in stage 0. That
;; toolchain actually targets the same OS and arch, but it has the advantage
@ -680,12 +679,11 @@ identifier SYSTEM."
(package (inherit binutils)
(name "binutils-cross-boot0")
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f
,@(substitute-keyword-arguments (package-arguments binutils)
((#:configure-flags cf)
`(list ,(string-append "--target=" (boot-triplet system))))))))
`(list ,(string-append "--target=" (boot-triplet)))))))
(inputs %boot0-inputs))))
(define gcc-boot0
@ -693,7 +691,6 @@ identifier SYSTEM."
(package (inherit gcc-4.7)
(name "gcc-cross-boot0")
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f
#:modules ((guix build gnu-build-system)
@ -701,10 +698,9 @@ identifier SYSTEM."
(ice-9 regex)
(srfi srfi-1)
(srfi srfi-26))
,@(substitute-keyword-arguments ((package-arguments gcc-4.7) system)
,@(substitute-keyword-arguments (package-arguments gcc-4.7)
((#:configure-flags flags)
`(append (list ,(string-append "--target="
(boot-triplet system))
`(append (list ,(string-append "--target=" (boot-triplet))
;; No libc yet.
"--without-headers"
@ -765,10 +761,10 @@ identifier SYSTEM."
;; it.
(with-directory-excursion
(string-append out "/lib/gcc/"
,(boot-triplet system)
,(boot-triplet)
"/" ,(package-version gcc-4.7))
(symlink "libgcc.a" "libgcc_eh.a"))))
,phases)))))))
,phases))))))
(inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr))
@ -812,20 +808,19 @@ identifier SYSTEM."
(package (inherit glibc)
(name "glibc-intermediate")
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f
,@(substitute-keyword-arguments (package-arguments glibc)
((#:configure-flags flags)
`(append (list ,(string-append "--host=" (boot-triplet system))
`(append (list ,(string-append "--host=" (boot-triplet))
,(string-append "--build="
(nix-system->gnu-triplet system))
(nix-system->gnu-triplet))
;; Build Sun/ONC RPC support. In particular,
;; install rpc/*.h.
"--enable-obsolete-rpc")
,flags))))))
,flags)))))
(propagated-inputs `(("linux-headers" ,linux-libre-headers-boot0)))
(inputs
`( ;; A native GCC is needed to build `cross-rpcgen'.
@ -847,7 +842,6 @@ that makes it available under the native tool names."
(source #f)
(build-system trivial-build-system)
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:modules ((guix build utils))
#:builder (begin
@ -859,7 +853,7 @@ that makes it available under the native tool names."
(bash (assoc-ref %build-inputs "bash"))
(out (assoc-ref %outputs "out"))
(bindir (string-append out "/bin"))
(triplet ,(boot-triplet system)))
(triplet ,(boot-triplet)))
(mkdir-p bindir)
(with-directory-excursion bindir
(for-each (lambda (tool)
@ -878,9 +872,9 @@ exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
bash
gcc triplet
libc libc
,(glibc-dynamic-linker system))))
,(glibc-dynamic-linker))))
(chmod "gcc" #o555)))))))
(chmod "gcc" #o555))))))
(native-inputs
`(("binutils" ,binutils)
("gcc" ,gcc)
@ -896,9 +890,8 @@ exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(car (assoc-ref %boot1-inputs "bash"))))
(bash (package (inherit bash-light)
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
,@(package-arguments bash-light)))))))
,@(package-arguments bash-light))))))
(package-with-bootstrap-guile
(package-with-explicit-inputs (static-package bash)
`(("gcc" ,gcc)
@ -932,10 +925,9 @@ exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(package-with-bootstrap-guile
(package (inherit binutils)
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f
,@(package-arguments binutils))))
,@(package-arguments binutils)))
(inputs %boot2-inputs))))
(define-public gcc-final
@ -943,23 +935,22 @@ exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
(package (inherit gcc-boot0)
(name "gcc")
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:implicit-inputs? #f
;; Build again GMP & co. within GCC's build process, because it's hard
;; to do outside (because GCC-BOOT0 is a cross-compiler, and thus
;; doesn't honor $LIBRARY_PATH, which breaks `gnu-build-system'.)
,@(substitute-keyword-arguments ((package-arguments gcc-boot0) system)
,@(substitute-keyword-arguments (package-arguments gcc-boot0)
((#:configure-flags boot-flags)
(let loop ((args ((package-arguments gcc-4.7) system)))
(let loop ((args (package-arguments gcc-4.7)))
(match args
((#:configure-flags normal-flags _ ...)
normal-flags)
((_ rest ...)
(loop rest)))))
((#:phases phases)
`(alist-delete 'symlink-libgcc_eh ,phases))))))
`(alist-delete 'symlink-libgcc_eh ,phases)))))
(inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr))

7
gnu/packages/bootstrap.scm
View File

@ -133,7 +133,7 @@ check whether everything is alright."
(propagated-inputs (map rewritten-input
(package-propagated-inputs p)))))))
(define (glibc-dynamic-linker system)
(define* (glibc-dynamic-linker #:optional (system (%current-system)))
"Return the name of Glibc's dynamic linker for SYSTEM."
(cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
((string=? system "i686-linux") "/lib/ld-linux.so.2")
@ -301,7 +301,6 @@ $out/bin/guile --version~%"
(source #f)
(build-system trivial-build-system)
(arguments
(lambda (system)
`(#:guile ,%bootstrap-guile
#:modules ((guix build utils))
#:builder
@ -334,9 +333,9 @@ exec ~a/bin/.gcc-wrapped -B~a/lib \
-Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
bash
out libc libc libc
,(glibc-dynamic-linker system))))
,(glibc-dynamic-linker))))
(chmod "gcc" #o555)))))))
(chmod "gcc" #o555))))))
(inputs
`(("tar" ,(lambda (system)
(search-bootstrap-binary "tar" system)))

6
gnu/packages/gawk.scm
View File

@ -36,12 +36,10 @@
(base32 "0sss7rhpvizi2a88h6giv0i7w5h07s2fxkw3s6n1hqvcnhrfgbb0"))))
(build-system gnu-build-system)
(arguments
(case-lambda
((system)
`(#:parallel-tests? #f ; test suite fails in parallel
;; Work around test failure on Cygwin.
#:tests? ,(not (string=? system "i686-cygwin"))
#:tests? ,(not (string=? (%current-system) "i686-cygwin"))
#:phases (alist-cons-before
'configure 'set-shell-file-name
@ -52,8 +50,6 @@
(("/bin/sh")
(string-append bash "/bin/bash")))))
%standard-phases)))
((system cross-system)
'(#:parallel-tests? #f))))
(inputs `(("libsigsegv" ,libsigsegv)))
(home-page "http://www.gnu.org/software/gawk/")
(synopsis "GNU implementation of the Awk programming language")

12
gnu/packages/m4.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -36,10 +36,9 @@
(base32
"035r7ma272j2cwni2961jp22k6bn3n9xwn3b3qbcn2yrvlghql22"))))
(build-system gnu-build-system)
(arguments (case-lambda
((system)
(arguments
;; XXX: Disable tests on those platforms with know issues.
`(#:tests? ,(not (member system
`(#:tests? ,(not (member (%current-system)
'("x86_64-darwin"
"i686-cygwin"
"i686-sunos")))
@ -59,11 +58,6 @@
(("/bin/sh")
(format #f "~a/bin/bash" bash)))))
%standard-phases)))
((system cross-system)
`(#:patches (list (assoc-ref %build-inputs "patch/s_isdir")
(assoc-ref %build-inputs
"patch/readlink-EINVAL")
(assoc-ref %build-inputs "patch/gets"))))))
(inputs `(("patch/s_isdir" ,(search-patch "m4-s_isdir.patch"))
("patch/readlink-EINVAL"
,(search-patch "m4-readlink-EINVAL.patch"))

25
gnu/packages/make-bootstrap.scm
View File

@ -52,17 +52,15 @@
;; without nscd, and with static NSS modules.
(package (inherit glibc-final)
(arguments
(lambda (system)
(substitute-keyword-arguments ((package-arguments glibc-final) system)
(substitute-keyword-arguments (package-arguments glibc-final)
((#:patches patches)
`(cons (assoc-ref %build-inputs "patch/system")
,patches))
`(cons (assoc-ref %build-inputs "patch/system") ,patches))
((#:configure-flags flags)
;; Arrange so that getaddrinfo & co. do not contact the nscd,
;; and can use statically-linked NSS modules.
`(cons* "--disable-nscd" "--disable-build-nscd"
"--enable-static-nss"
,flags)))))
,flags))))
(inputs
`(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
,@(package-inputs glibc-final)))))
@ -119,10 +117,8 @@
%standard-phases)))))
(gawk (package (inherit gawk)
(arguments
(lambda (system)
`(#:patches (list (assoc-ref %build-inputs "patch/sh"))
,@(substitute-keyword-arguments
((package-arguments gawk) system)
,@(substitute-keyword-arguments (package-arguments gawk)
((#:phases phases)
`(alist-cons-before
'configure 'no-export-dynamic
@ -131,7 +127,7 @@
;; `-export-dynamic'.
(substitute* "configure"
(("-export-dynamic") "")))
,phases))))))
,phases)))))
(inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))))))
(finalize (lambda (p)
(static-package (package-with-explicit-inputs
@ -332,13 +328,12 @@
(package (inherit gcc-final)
(name "gcc-static")
(arguments
(lambda (system)
`(#:modules ((guix build utils)
(guix build gnu-build-system)
(srfi srfi-1)
(srfi srfi-26)
(ice-9 regex))
,@(substitute-keyword-arguments ((package-arguments gcc-final) system)
,@(substitute-keyword-arguments (package-arguments gcc-final)
((#:guile _) #f)
((#:implicit-inputs? _) #t)
((#:configure-flags flags)
@ -354,7 +349,7 @@
(remove (cut string-match "--(.*plugin|enable-languages)" <>)
,flags)))
((#:make-flags flags)
`(cons "BOOT_LDFLAGS=-static" ,flags))))))
`(cons "BOOT_LDFLAGS=-static" ,flags)))))
(inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr))
("mpc-source" ,(package-source mpc))
@ -482,7 +477,6 @@
("xz" ,xz)
("input" ,pkg)))
(arguments
(lambda (system)
(let ((name (package-name pkg))
(version (package-version pkg)))
`(#:modules ((guix build utils))
@ -499,8 +493,9 @@
(zero? (system* "tar" "cJvf"
(string-append out "/"
,name "-" ,version
"-" ,system ".tar.xz")
".")))))))))))
"-" ,(%current-system)
".tar.xz")
"."))))))))))
(define %bootstrap-binaries-tarball
;; A tarball with the statically-linked bootstrap binaries.

6
gnu/packages/ncurses.scm
View File

@ -83,8 +83,6 @@
"0fsn7xis81za62afan0vvm38bvgzg5wfmv1m86flqcj0nj7jjilh"))))
(build-system gnu-build-system)
(arguments
(case-lambda
((system)
`(#:configure-flags
`("--with-shared" "--without-debug" "--enable-widec"
@ -96,7 +94,7 @@
;; C++ bindings fail to build on
;; `i386-pc-solaris2.11' with GCC 3.4.3:
;; <http://bugs.opensolaris.org/bugdatabase/view_bug.do?bug_id=6395191>.
,,@(if (string=? system "i686-solaris")
,,@(if (string=? (%current-system) "i686-solaris")
'("--without-cxx-binding")
'()))
#:tests? #f ; no "check" target
@ -109,8 +107,6 @@
'configure
,configure-phase
%standard-phases)))))
((system cross-system)
(arguments cross-system))))
(self-native-input? #t)
(synopsis
"GNU Ncurses, a free software emulation of curses in SVR4 and more")

27
guix/build-system/gnu.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2012, 2013 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@ -66,12 +66,8 @@ when GUILE is #f."
(location (if (pair? loc) (source-properties->location loc) loc))
(arguments
(let ((args (package-arguments p)))
(if (procedure? args)
(lambda (system)
`(#:guile ,guile
#:implicit-inputs? #f ,@(args system)))
`(#:guile ,guile
#:implicit-inputs? #f ,@args))))
#:implicit-inputs? #f ,@args)))
(native-inputs (map rewritten-input
(filtered-inputs (package-native-inputs p))))
(propagated-inputs (map rewritten-input
@ -95,11 +91,7 @@ configure flags for VARIABLE, the associated value is augmented."
(package (inherit p)
(arguments
(lambda (system)
(let ((args (match (package-arguments p)
((? procedure? proc)
(proc system))
(x x))))
(let ((args (package-arguments p)))
(substitute-keyword-arguments args
((#:configure-flags flags)
(let* ((var= (string-append variable "="))
@ -111,7 +103,7 @@ configure flags for VARIABLE, the associated value is augmented."
,(string-append var= value " ")
(substring flag ,len))
flag))
,flags))))))))
,flags)))))))
(inputs (rewritten-inputs (package-inputs p)))
(propagated-inputs (rewritten-inputs (package-propagated-inputs p))))))
@ -125,21 +117,14 @@ configure flags for VARIABLE, the associated value is augmented."
(package (inherit p)
(location (source-properties->location loc))
(arguments
(let ((augment (lambda (args)
(let ((a (default-keyword-arguments args
'(#:configure-flags '()
#:strip-flags #f))))
(substitute-keyword-arguments a
((#:configure-flags flags)
`(cons* "--disable-shared"
"LDFLAGS=-static"
,flags))
`(cons* "--disable-shared" "LDFLAGS=-static" ,flags))
((#:strip-flags _)
''("--strip-all")))))))
(if (procedure? args)
(lambda x
(augment (apply args x)))
(augment args)))))))
''("--strip-all"))))))))
(define %store

10
guix/packages.scm
View File

@ -110,7 +110,7 @@ representation."
(source package-source) ; <origin> instance
(build-system package-build-system) ; build system
(arguments package-arguments ; arguments for the build method
(default '()))
(default '()) (thunked))
(inputs package-inputs ; input packages or derivations
(default '()))
@ -290,6 +290,10 @@ PACKAGE for SYSTEM."
;; because some derivations, such as the implicit inputs of the GNU build
;; system, will be queried many, many times in a row.
(cached package system
;; Bind %CURRENT-SYSTEM so that thunked field values can refer
;; to it.
(parameterize ((%current-system system))
(match package
(($ <package> name version source (= build-system-builder builder)
args inputs propagated-inputs native-inputs self-native-input?
@ -305,9 +309,7 @@ PACKAGE for SYSTEM."
(package-source-derivation store source system))
inputs
#:outputs outputs #:system system
(if (procedure? args)
(args system)
args)))))))
(args))))))))
(define* (package-cross-derivation store package)
;; TODO