me
/
guix
Archived
1
0
Fork 0
Code

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.
master
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

453
gnu/packages/base.scm
View File

@ -162,10 +162,10 @@ files (as archives).")
(build-system gnu-build-system) (build-system gnu-build-system)
(native-inputs '()) ; FIXME: needs `ed' for the tests (native-inputs '()) ; FIXME: needs `ed' for the tests
(arguments (arguments
(case-lambda '(#:tests? #f)
((system) '(#:tests? #f)) ;; TODO: When cross-compiling, add this:
((system cross-system) ;; '(#:configure-flags '("ac_cv_func_strnlen_working=yes"))
'(#:configure-flags '("ac_cv_func_strnlen_working=yes"))))) )
(synopsis "GNU Patch, a program to apply differences to files") (synopsis "GNU Patch, a program to apply differences to files")
(description (description
"GNU Patch takes a patch file containing a difference listing produced by "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" `(("patch/absolute-paths"
,(search-patch "findutils-absolute-paths.patch")))) ,(search-patch "findutils-absolute-paths.patch"))))
(arguments (arguments
(case-lambda `(#:patches (list (assoc-ref %build-inputs "patch/absolute-paths")))
((system)
`(#:patches (list (assoc-ref %build-inputs "patch/absolute-paths")))) ;; TODO: Work around cross-compilation failure.
((system cross-system) ;; See <http://savannah.gnu.org/bugs/?27299#comment1>.
;; Work around cross-compilation failure. ;; `(#:configure-flags '("gl_cv_func_wcwidth_works=yes")
;; See <http://savannah.gnu.org/bugs/?27299#comment1>. ;; ,@(arguments cross-system))
`(#:configure-flags '("gl_cv_func_wcwidth_works=yes") )
,@(arguments cross-system)))))
(synopsis "Basic directory searching utilities of the GNU operating (synopsis "Basic directory searching utilities of the GNU operating
system") system")
(description (description
@ -396,90 +395,89 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
("mpfr" ,mpfr) ("mpfr" ,mpfr)
("mpc" ,mpc))) ; TODO: libelf, ppl, cloog, zlib, etc. ("mpc" ,mpc))) ; TODO: libelf, ppl, cloog, zlib, etc.
(arguments (arguments
(lambda (system) `(#:out-of-source? #t
`(#:out-of-source? #t #:strip-binaries? ,stripped?
#:strip-binaries? ,stripped? #:configure-flags
#:configure-flags `("--enable-plugin"
`("--enable-plugin" "--enable-languages=c,c++"
"--enable-languages=c,c++" "--disable-multilib"
"--disable-multilib"
"--with-local-prefix=/no-gcc-local-prefix" "--with-local-prefix=/no-gcc-local-prefix"
,(let ((libc (assoc-ref %build-inputs "libc"))) ,(let ((libc (assoc-ref %build-inputs "libc")))
(if libc (if libc
(string-append "--with-native-system-header-dir=" libc (string-append "--with-native-system-header-dir=" libc
"/include") "/include")
"--without-headers"))) "--without-headers")))
#:make-flags #:make-flags
(let ((libc (assoc-ref %build-inputs "libc"))) (let ((libc (assoc-ref %build-inputs "libc")))
`(,@(if libc `(,@(if libc
(list (string-append "LDFLAGS_FOR_BUILD=" (list (string-append "LDFLAGS_FOR_BUILD="
"-L" libc "/lib " "-L" libc "/lib "
"-Wl,-dynamic-linker " "-Wl,-dynamic-linker "
"-Wl," libc "-Wl," libc
,(glibc-dynamic-linker system))) ,(glibc-dynamic-linker)))
'()) '())
,(string-append "BOOT_CFLAGS=-O2 " ,(string-append "BOOT_CFLAGS=-O2 "
,(if stripped? "-g0" "-g")))) ,(if stripped? "-g0" "-g"))))
#:tests? #f #:tests? #f
#:phases #:phases
(alist-cons-before (alist-cons-before
'configure 'pre-configure 'configure 'pre-configure
(lambda* (#:key inputs outputs #:allow-other-keys) (lambda* (#:key inputs outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")) (let ((out (assoc-ref outputs "out"))
(libc (assoc-ref inputs "libc"))) (libc (assoc-ref inputs "libc")))
(when libc (when libc
;; The following is not performed for `--without-headers' ;; The following is not performed for `--without-headers'
;; cross-compiler builds. ;; cross-compiler builds.
;; Fix the dynamic linker's file name. ;; Fix the dynamic linker's file name.
(substitute* (find-files "gcc/config" (substitute* (find-files "gcc/config"
"^linux(64|-elf)?\\.h$") "^linux(64|-elf)?\\.h$")
(("#define GLIBC_DYNAMIC_LINKER([^ ]*).*$" _ suffix) (("#define GLIBC_DYNAMIC_LINKER([^ ]*).*$" _ suffix)
(format #f "#define GLIBC_DYNAMIC_LINKER~a \"~a\"~%" (format #f "#define GLIBC_DYNAMIC_LINKER~a \"~a\"~%"
suffix suffix
(string-append libc ,(glibc-dynamic-linker system))))) (string-append libc ,(glibc-dynamic-linker)))))
;; Tell where to find libstdc++, libc, and `?crt*.o', except ;; Tell where to find libstdc++, libc, and `?crt*.o', except
;; `crt{begin,end}.o', which come with GCC. ;; `crt{begin,end}.o', which come with GCC.
(substitute* (find-files "gcc/config" (substitute* (find-files "gcc/config"
"^(gnu-user(64)?|linux-elf)\\.h$") "^(gnu-user(64)?|linux-elf)\\.h$")
(("#define LIB_SPEC (.*)$" _ suffix) (("#define LIB_SPEC (.*)$" _ suffix)
;; Note that with this "lib" spec, we may still add a ;; Note that with this "lib" spec, we may still add a
;; RUNPATH to GCC even when `libgcc_s' is not NEEDED. ;; RUNPATH to GCC even when `libgcc_s' is not NEEDED.
;; There's not much that can be done to avoid it, though. ;; There's not much that can be done to avoid it, though.
(format #f "#define LIB_SPEC \"-L~a/lib %{!static:-rpath=~a/lib \ (format #f "#define LIB_SPEC \"-L~a/lib %{!static:-rpath=~a/lib \
%{!static-libgcc:-rpath=~a/lib64 -rpath=~a/lib}} \" ~a~%" %{!static-libgcc:-rpath=~a/lib64 -rpath=~a/lib}} \" ~a~%"
libc libc out out suffix)) libc libc out out suffix))
(("#define STARTFILE_SPEC.*$" line) (("#define STARTFILE_SPEC.*$" line)
(format #f "#define STANDARD_STARTFILE_PREFIX_1 \"~a/lib\" (format #f "#define STANDARD_STARTFILE_PREFIX_1 \"~a/lib\"
#define STANDARD_STARTFILE_PREFIX_2 \"\" #define STANDARD_STARTFILE_PREFIX_2 \"\"
~a~%" ~a~%"
libc line)))) libc line))))
;; Don't retain a dependency on the build-time sed. ;; Don't retain a dependency on the build-time sed.
(substitute* "fixincludes/fixincl.x" (substitute* "fixincludes/fixincl.x"
(("static char const sed_cmd_z\\[\\] =.*;") (("static char const sed_cmd_z\\[\\] =.*;")
"static char const sed_cmd_z[] = \"sed\";")))) "static char const sed_cmd_z[] = \"sed\";"))))
(alist-cons-after (alist-cons-after
'configure 'post-configure 'configure 'post-configure
(lambda _ (lambda _
;; Don't store configure flags, to avoid retaining references to ;; Don't store configure flags, to avoid retaining references to
;; build-time dependencies---e.g., `--with-ppl=/nix/store/xxx'. ;; build-time dependencies---e.g., `--with-ppl=/nix/store/xxx'.
(substitute* "Makefile" (substitute* "Makefile"
(("^TOPLEVEL_CONFIGURE_ARGUMENTS=(.*)$" _ rest) (("^TOPLEVEL_CONFIGURE_ARGUMENTS=(.*)$" _ rest)
"TOPLEVEL_CONFIGURE_ARGUMENTS=\n"))) "TOPLEVEL_CONFIGURE_ARGUMENTS=\n")))
(alist-replace 'install (alist-replace 'install
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(zero? (zero?
(system* "make" (system* "make"
,(if stripped? ,(if stripped?
"install-strip" "install-strip"
"install")))) "install"))))
%standard-phases)))))) %standard-phases)))))
(properties `((gcc-libc . ,(assoc-ref inputs "libc")))) (properties `((gcc-libc . ,(assoc-ref inputs "libc"))))
(synopsis "The GNU Compiler Collection") (synopsis "The GNU Compiler Collection")
@ -653,7 +651,8 @@ with the Linux kernel.")
("findutils" ,findutils-boot0) ("findutils" ,findutils-boot0)
,@%bootstrap-inputs)) ,@%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 "Return an a guess of the GNU triplet corresponding to Nix system
identifier SYSTEM." identifier SYSTEM."
(let* ((dash (string-index system #\-)) (let* ((dash (string-index system #\-))
@ -665,10 +664,10 @@ identifier SYSTEM."
"linux-gnu" "linux-gnu"
os)))) os))))
(define boot-triplet (define* (boot-triplet #:optional (system (%current-system)))
;; Return the triplet used to create the cross toolchain needed in the ;; Return the triplet used to create the cross toolchain needed in the
;; first bootstrapping stage. ;; 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 ;; 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 ;; toolchain actually targets the same OS and arch, but it has the advantage
@ -680,12 +679,11 @@ identifier SYSTEM."
(package (inherit binutils) (package (inherit binutils)
(name "binutils-cross-boot0") (name "binutils-cross-boot0")
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile #:implicit-inputs? #f
#:implicit-inputs? #f ,@(substitute-keyword-arguments (package-arguments binutils)
,@(substitute-keyword-arguments (package-arguments binutils) ((#:configure-flags cf)
((#:configure-flags cf) `(list ,(string-append "--target=" (boot-triplet)))))))
`(list ,(string-append "--target=" (boot-triplet system))))))))
(inputs %boot0-inputs)))) (inputs %boot0-inputs))))
(define gcc-boot0 (define gcc-boot0
@ -693,82 +691,80 @@ identifier SYSTEM."
(package (inherit gcc-4.7) (package (inherit gcc-4.7)
(name "gcc-cross-boot0") (name "gcc-cross-boot0")
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile #:implicit-inputs? #f
#:implicit-inputs? #f #:modules ((guix build gnu-build-system)
#:modules ((guix build gnu-build-system) (guix build utils)
(guix build utils) (ice-9 regex)
(ice-9 regex) (srfi srfi-1)
(srfi srfi-1) (srfi srfi-26))
(srfi srfi-26)) ,@(substitute-keyword-arguments (package-arguments gcc-4.7)
,@(substitute-keyword-arguments ((package-arguments gcc-4.7) system) ((#:configure-flags flags)
((#:configure-flags flags) `(append (list ,(string-append "--target=" (boot-triplet))
`(append (list ,(string-append "--target="
(boot-triplet system))
;; No libc yet. ;; No libc yet.
"--without-headers" "--without-headers"
;; Disable features not needed at this stage. ;; Disable features not needed at this stage.
"--disable-shared" "--disable-shared"
"--enable-languages=c" "--enable-languages=c"
"--disable-libmudflap" "--disable-libmudflap"
"--disable-libgomp" "--disable-libgomp"
"--disable-libssp" "--disable-libssp"
"--disable-libquadmath" "--disable-libquadmath"
"--disable-decimal-float") "--disable-decimal-float")
(remove (cut string-match "--enable-languages.*" <>) (remove (cut string-match "--enable-languages.*" <>)
,flags))) ,flags)))
((#:phases phases) ((#:phases phases)
`(alist-cons-after `(alist-cons-after
'unpack 'unpack-gmp&co 'unpack 'unpack-gmp&co
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
(let ((gmp (assoc-ref %build-inputs "gmp-source")) (let ((gmp (assoc-ref %build-inputs "gmp-source"))
(mpfr (assoc-ref %build-inputs "mpfr-source")) (mpfr (assoc-ref %build-inputs "mpfr-source"))
(mpc (assoc-ref %build-inputs "mpc-source"))) (mpc (assoc-ref %build-inputs "mpc-source")))
;; To reduce the set of pre-built bootstrap inputs, build ;; To reduce the set of pre-built bootstrap inputs, build
;; GMP & co. from GCC. ;; GMP & co. from GCC.
(for-each (lambda (source) (for-each (lambda (source)
(or (zero? (system* "tar" "xvf" source)) (or (zero? (system* "tar" "xvf" source))
(error "failed to unpack tarball" (error "failed to unpack tarball"
source))) source)))
(list gmp mpfr mpc)) (list gmp mpfr mpc))
;; Create symlinks like `gmp' -> `gmp-5.0.5'. ;; Create symlinks like `gmp' -> `gmp-5.0.5'.
,@(map (lambda (lib) ,@(map (lambda (lib)
`(symlink ,(package-full-name lib) `(symlink ,(package-full-name lib)
,(package-name lib))) ,(package-name lib)))
(list gmp mpfr mpc)) (list gmp mpfr mpc))
;; MPFR headers/lib are found under $(MPFR)/src, but ;; MPFR headers/lib are found under $(MPFR)/src, but
;; `configure' wrongfully tells MPC too look under ;; `configure' wrongfully tells MPC too look under
;; $(MPFR), so fix that. ;; $(MPFR), so fix that.
(substitute* "configure" (substitute* "configure"
(("extra_mpc_mpfr_configure_flags(.+)--with-mpfr-include=([^/]+)/mpfr(.*)--with-mpfr-lib=([^ ]+)/mpfr" (("extra_mpc_mpfr_configure_flags(.+)--with-mpfr-include=([^/]+)/mpfr(.*)--with-mpfr-lib=([^ ]+)/mpfr"
_ equals include middle lib) _ equals include middle lib)
(string-append "extra_mpc_mpfr_configure_flags" equals (string-append "extra_mpc_mpfr_configure_flags" equals
"--with-mpfr-include=" include "--with-mpfr-include=" include
"/mpfr/src" middle "/mpfr/src" middle
"--with-mpfr-lib=" lib "--with-mpfr-lib=" lib
"/mpfr/src")) "/mpfr/src"))
(("gmpinc='-I([^ ]+)/mpfr -I([^ ]+)/mpfr" _ a b) (("gmpinc='-I([^ ]+)/mpfr -I([^ ]+)/mpfr" _ a b)
(string-append "gmpinc='-I" a "/mpfr/src " (string-append "gmpinc='-I" a "/mpfr/src "
"-I" b "/mpfr/src")) "-I" b "/mpfr/src"))
(("gmplibs='-L([^ ]+)/mpfr" _ a) (("gmplibs='-L([^ ]+)/mpfr" _ a)
(string-append "gmplibs='-L" a "/mpfr/src"))))) (string-append "gmplibs='-L" a "/mpfr/src")))))
(alist-cons-after (alist-cons-after
'install 'symlink-libgcc_eh 'install 'symlink-libgcc_eh
(lambda* (#:key outputs #:allow-other-keys) (lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out"))) (let ((out (assoc-ref outputs "out")))
;; Glibc wants to link against libgcc_eh, so provide ;; Glibc wants to link against libgcc_eh, so provide
;; it. ;; it.
(with-directory-excursion (with-directory-excursion
(string-append out "/lib/gcc/" (string-append out "/lib/gcc/"
,(boot-triplet system) ,(boot-triplet)
"/" ,(package-version gcc-4.7)) "/" ,(package-version gcc-4.7))
(symlink "libgcc.a" "libgcc_eh.a")))) (symlink "libgcc.a" "libgcc_eh.a"))))
,phases))))))) ,phases))))))
(inputs `(("gmp-source" ,(package-source gmp)) (inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr)) ("mpfr-source" ,(package-source mpfr))
@ -812,20 +808,19 @@ identifier SYSTEM."
(package (inherit glibc) (package (inherit glibc)
(name "glibc-intermediate") (name "glibc-intermediate")
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile #:implicit-inputs? #f
#:implicit-inputs? #f
,@(substitute-keyword-arguments (package-arguments glibc) ,@(substitute-keyword-arguments (package-arguments glibc)
((#:configure-flags flags) ((#:configure-flags flags)
`(append (list ,(string-append "--host=" (boot-triplet system)) `(append (list ,(string-append "--host=" (boot-triplet))
,(string-append "--build=" ,(string-append "--build="
(nix-system->gnu-triplet system)) (nix-system->gnu-triplet))
;; Build Sun/ONC RPC support. In particular, ;; Build Sun/ONC RPC support. In particular,
;; install rpc/*.h. ;; install rpc/*.h.
"--enable-obsolete-rpc") "--enable-obsolete-rpc")
,flags)))))) ,flags)))))
(propagated-inputs `(("linux-headers" ,linux-libre-headers-boot0))) (propagated-inputs `(("linux-headers" ,linux-libre-headers-boot0)))
(inputs (inputs
`( ;; A native GCC is needed to build `cross-rpcgen'. `( ;; A native GCC is needed to build `cross-rpcgen'.
@ -847,40 +842,39 @@ that makes it available under the native tool names."
(source #f) (source #f)
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile #:modules ((guix build utils))
#:modules ((guix build utils)) #:builder (begin
#:builder (begin (use-modules (guix build utils))
(use-modules (guix build utils))
(let* ((binutils (assoc-ref %build-inputs "binutils")) (let* ((binutils (assoc-ref %build-inputs "binutils"))
(gcc (assoc-ref %build-inputs "gcc")) (gcc (assoc-ref %build-inputs "gcc"))
(libc (assoc-ref %build-inputs "libc")) (libc (assoc-ref %build-inputs "libc"))
(bash (assoc-ref %build-inputs "bash")) (bash (assoc-ref %build-inputs "bash"))
(out (assoc-ref %outputs "out")) (out (assoc-ref %outputs "out"))
(bindir (string-append out "/bin")) (bindir (string-append out "/bin"))
(triplet ,(boot-triplet system))) (triplet ,(boot-triplet)))
(mkdir-p bindir) (mkdir-p bindir)
(with-directory-excursion bindir (with-directory-excursion bindir
(for-each (lambda (tool) (for-each (lambda (tool)
(symlink (string-append binutils "/bin/" (symlink (string-append binutils "/bin/"
triplet "-" tool) triplet "-" tool)
tool)) tool))
'("ar" "ranlib")) '("ar" "ranlib"))
;; GCC-BOOT0 is a libc-less cross-compiler, so it ;; GCC-BOOT0 is a libc-less cross-compiler, so it
;; needs to be told where to find the crt files and ;; needs to be told where to find the crt files and
;; the dynamic linker. ;; the dynamic linker.
(call-with-output-file "gcc" (call-with-output-file "gcc"
(lambda (p) (lambda (p)
(format p "#!~a/bin/bash (format p "#!~a/bin/bash
exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" exec ~a/bin/~a-gcc -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
bash bash
gcc triplet gcc triplet
libc libc libc libc
,(glibc-dynamic-linker system)))) ,(glibc-dynamic-linker))))
(chmod "gcc" #o555))))))) (chmod "gcc" #o555))))))
(native-inputs (native-inputs
`(("binutils" ,binutils) `(("binutils" ,binutils)
("gcc" ,gcc) ("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")))) (car (assoc-ref %boot1-inputs "bash"))))
(bash (package (inherit bash-light) (bash (package (inherit bash-light)
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile ,@(package-arguments bash-light))))))
,@(package-arguments bash-light)))))))
(package-with-bootstrap-guile (package-with-bootstrap-guile
(package-with-explicit-inputs (static-package bash) (package-with-explicit-inputs (static-package bash)
`(("gcc" ,gcc) `(("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-with-bootstrap-guile
(package (inherit binutils) (package (inherit binutils)
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile #:implicit-inputs? #f
#:implicit-inputs? #f ,@(package-arguments binutils)))
,@(package-arguments binutils))))
(inputs %boot2-inputs)))) (inputs %boot2-inputs))))
(define-public gcc-final (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) (package (inherit gcc-boot0)
(name "gcc") (name "gcc")
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile #:implicit-inputs? #f
#:implicit-inputs? #f
;; Build again GMP & co. within GCC's build process, because it's hard ;; 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 ;; to do outside (because GCC-BOOT0 is a cross-compiler, and thus
;; doesn't honor $LIBRARY_PATH, which breaks `gnu-build-system'.) ;; 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) ((#:configure-flags boot-flags)
(let loop ((args ((package-arguments gcc-4.7) system))) (let loop ((args (package-arguments gcc-4.7)))
(match args (match args
((#:configure-flags normal-flags _ ...) ((#:configure-flags normal-flags _ ...)
normal-flags) normal-flags)
((_ rest ...) ((_ rest ...)
(loop rest))))) (loop rest)))))
((#:phases phases) ((#:phases phases)
`(alist-delete 'symlink-libgcc_eh ,phases)))))) `(alist-delete 'symlink-libgcc_eh ,phases)))))
(inputs `(("gmp-source" ,(package-source gmp)) (inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr)) ("mpfr-source" ,(package-source mpfr))

61
gnu/packages/bootstrap.scm
View File

@ -133,7 +133,7 @@ check whether everything is alright."
(propagated-inputs (map rewritten-input (propagated-inputs (map rewritten-input
(package-propagated-inputs p))))))) (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." "Return the name of Glibc's dynamic linker for SYSTEM."
(cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2") (cond ((string=? system "x86_64-linux") "/lib/ld-linux-x86-64.so.2")
((string=? system "i686-linux") "/lib/ld-linux.so.2") ((string=? system "i686-linux") "/lib/ld-linux.so.2")
@ -301,42 +301,41 @@ $out/bin/guile --version~%"
(source #f) (source #f)
(build-system trivial-build-system) (build-system trivial-build-system)
(arguments (arguments
(lambda (system) `(#:guile ,%bootstrap-guile
`(#:guile ,%bootstrap-guile #:modules ((guix build utils))
#:modules ((guix build utils)) #:builder
#:builder (let ((out (assoc-ref %outputs "out"))
(let ((out (assoc-ref %outputs "out")) (tar (assoc-ref %build-inputs "tar"))
(tar (assoc-ref %build-inputs "tar")) (xz (assoc-ref %build-inputs "xz"))
(xz (assoc-ref %build-inputs "xz")) (bash (assoc-ref %build-inputs "bash"))
(bash (assoc-ref %build-inputs "bash")) (libc (assoc-ref %build-inputs "libc"))
(libc (assoc-ref %build-inputs "libc")) (tarball (assoc-ref %build-inputs "tarball")))
(tarball (assoc-ref %build-inputs "tarball"))) (use-modules (guix build utils)
(use-modules (guix build utils) (ice-9 popen))
(ice-9 popen))
(mkdir out) (mkdir out)
(copy-file tarball "binaries.tar.xz") (copy-file tarball "binaries.tar.xz")
(system* xz "-d" "binaries.tar.xz") (system* xz "-d" "binaries.tar.xz")
(let ((builddir (getcwd)) (let ((builddir (getcwd))
(bindir (string-append out "/bin"))) (bindir (string-append out "/bin")))
(with-directory-excursion out (with-directory-excursion out
(system* tar "xvf" (system* tar "xvf"
(string-append builddir "/binaries.tar"))) (string-append builddir "/binaries.tar")))
(with-directory-excursion bindir (with-directory-excursion bindir
(chmod "." #o755) (chmod "." #o755)
(rename-file "gcc" ".gcc-wrapped") (rename-file "gcc" ".gcc-wrapped")
(call-with-output-file "gcc" (call-with-output-file "gcc"
(lambda (p) (lambda (p)
(format p "#!~a (format p "#!~a
exec ~a/bin/.gcc-wrapped -B~a/lib \ exec ~a/bin/.gcc-wrapped -B~a/lib \
-Wl,-rpath -Wl,~a/lib \ -Wl,-rpath -Wl,~a/lib \
-Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
bash bash
out libc libc libc out libc libc libc
,(glibc-dynamic-linker system)))) ,(glibc-dynamic-linker))))
(chmod "gcc" #o555))))))) (chmod "gcc" #o555))))))
(inputs (inputs
`(("tar" ,(lambda (system) `(("tar" ,(lambda (system)
(search-bootstrap-binary "tar" system))) (search-bootstrap-binary "tar" system)))

28
gnu/packages/gawk.scm
View File

@ -36,24 +36,20 @@
(base32 "0sss7rhpvizi2a88h6giv0i7w5h07s2fxkw3s6n1hqvcnhrfgbb0")))) (base32 "0sss7rhpvizi2a88h6giv0i7w5h07s2fxkw3s6n1hqvcnhrfgbb0"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(case-lambda `(#:parallel-tests? #f ; test suite fails in parallel
((system)
`(#:parallel-tests? #f ; test suite fails in parallel
;; Work around test failure on Cygwin. ;; Work around test failure on Cygwin.
#:tests? ,(not (string=? system "i686-cygwin")) #:tests? ,(not (string=? (%current-system) "i686-cygwin"))
#:phases (alist-cons-before #:phases (alist-cons-before
'configure 'set-shell-file-name 'configure 'set-shell-file-name
(lambda* (#:key inputs #:allow-other-keys) (lambda* (#:key inputs #:allow-other-keys)
;; Refer to the right shell. ;; Refer to the right shell.
(let ((bash (assoc-ref inputs "bash"))) (let ((bash (assoc-ref inputs "bash")))
(substitute* "io.c" (substitute* "io.c"
(("/bin/sh") (("/bin/sh")
(string-append bash "/bin/bash"))))) (string-append bash "/bin/bash")))))
%standard-phases))) %standard-phases)))
((system cross-system)
'(#:parallel-tests? #f))))
(inputs `(("libsigsegv" ,libsigsegv))) (inputs `(("libsigsegv" ,libsigsegv)))
(home-page "http://www.gnu.org/software/gawk/") (home-page "http://www.gnu.org/software/gawk/")
(synopsis "GNU implementation of the Awk programming language") (synopsis "GNU implementation of the Awk programming language")

52
gnu/packages/m4.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -36,34 +36,28 @@
(base32 (base32
"035r7ma272j2cwni2961jp22k6bn3n9xwn3b3qbcn2yrvlghql22")))) "035r7ma272j2cwni2961jp22k6bn3n9xwn3b3qbcn2yrvlghql22"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (case-lambda (arguments
((system) ;; XXX: Disable tests on those platforms with know issues.
;; XXX: Disable tests on those platforms with know issues. `(#:tests? ,(not (member (%current-system)
`(#:tests? ,(not (member system '("x86_64-darwin"
'("x86_64-darwin" "i686-cygwin"
"i686-cygwin" "i686-sunos")))
"i686-sunos"))) #:patches (list (assoc-ref %build-inputs "patch/s_isdir")
#:patches (list (assoc-ref %build-inputs "patch/s_isdir") (assoc-ref %build-inputs
(assoc-ref %build-inputs "patch/readlink-EINVAL")
"patch/readlink-EINVAL") (assoc-ref %build-inputs "patch/gets"))
(assoc-ref %build-inputs "patch/gets")) #:phases (alist-cons-before
#:phases (alist-cons-before 'check 'pre-check
'check 'pre-check (lambda* (#:key inputs #:allow-other-keys)
(lambda* (#:key inputs #:allow-other-keys) ;; Fix references to /bin/sh.
;; Fix references to /bin/sh. (let ((bash (assoc-ref inputs "bash")))
(let ((bash (assoc-ref inputs "bash"))) (for-each patch-shebang
(for-each patch-shebang (find-files "tests" "\\.sh$"))
(find-files "tests" "\\.sh$")) (substitute* (find-files "tests"
(substitute* (find-files "tests" "posix_spawn")
"posix_spawn") (("/bin/sh")
(("/bin/sh") (format #f "~a/bin/bash" bash)))))
(format #f "~a/bin/bash" bash))))) %standard-phases)))
%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")) (inputs `(("patch/s_isdir" ,(search-patch "m4-s_isdir.patch"))
("patch/readlink-EINVAL" ("patch/readlink-EINVAL"
,(search-patch "m4-readlink-EINVAL.patch")) ,(search-patch "m4-readlink-EINVAL.patch"))

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

@ -52,17 +52,15 @@
;; without nscd, and with static NSS modules. ;; without nscd, and with static NSS modules.
(package (inherit glibc-final) (package (inherit glibc-final)
(arguments (arguments
(lambda (system) (substitute-keyword-arguments (package-arguments glibc-final)
(substitute-keyword-arguments ((package-arguments glibc-final) system) ((#:patches patches)
((#:patches patches) `(cons (assoc-ref %build-inputs "patch/system") ,patches))
`(cons (assoc-ref %build-inputs "patch/system") ((#:configure-flags flags)
,patches)) ;; Arrange so that getaddrinfo & co. do not contact the nscd,
((#:configure-flags flags) ;; and can use statically-linked NSS modules.
;; Arrange so that getaddrinfo & co. do not contact the nscd, `(cons* "--disable-nscd" "--disable-build-nscd"
;; and can use statically-linked NSS modules. "--enable-static-nss"
`(cons* "--disable-nscd" "--disable-build-nscd" ,flags))))
"--enable-static-nss"
,flags)))))
(inputs (inputs
`(("patch/system" ,(search-patch "glibc-bootstrap-system.patch")) `(("patch/system" ,(search-patch "glibc-bootstrap-system.patch"))
,@(package-inputs glibc-final))))) ,@(package-inputs glibc-final)))))
@ -119,19 +117,17 @@
%standard-phases))))) %standard-phases)))))
(gawk (package (inherit gawk) (gawk (package (inherit gawk)
(arguments (arguments
(lambda (system) `(#:patches (list (assoc-ref %build-inputs "patch/sh"))
`(#:patches (list (assoc-ref %build-inputs "patch/sh")) ,@(substitute-keyword-arguments (package-arguments gawk)
,@(substitute-keyword-arguments ((#:phases phases)
((package-arguments gawk) system) `(alist-cons-before
((#:phases phases) 'configure 'no-export-dynamic
`(alist-cons-before (lambda _
'configure 'no-export-dynamic ;; Since we use `-static', remove
(lambda _ ;; `-export-dynamic'.
;; Since we use `-static', remove (substitute* "configure"
;; `-export-dynamic'. (("-export-dynamic") "")))
(substitute* "configure" ,phases)))))
(("-export-dynamic") "")))
,phases))))))
(inputs `(("patch/sh" ,(search-patch "gawk-shell.patch")))))) (inputs `(("patch/sh" ,(search-patch "gawk-shell.patch"))))))
(finalize (lambda (p) (finalize (lambda (p)
(static-package (package-with-explicit-inputs (static-package (package-with-explicit-inputs
@ -332,29 +328,28 @@
(package (inherit gcc-final) (package (inherit gcc-final)
(name "gcc-static") (name "gcc-static")
(arguments (arguments
(lambda (system) `(#:modules ((guix build utils)
`(#:modules ((guix build utils) (guix build gnu-build-system)
(guix build gnu-build-system) (srfi srfi-1)
(srfi srfi-1) (srfi srfi-26)
(srfi srfi-26) (ice-9 regex))
(ice-9 regex)) ,@(substitute-keyword-arguments (package-arguments gcc-final)
,@(substitute-keyword-arguments ((package-arguments gcc-final) system) ((#:guile _) #f)
((#:guile _) #f) ((#:implicit-inputs? _) #t)
((#:implicit-inputs? _) #t) ((#:configure-flags flags)
((#:configure-flags flags) `(append (list
`(append (list "--disable-shared"
"--disable-shared" "--disable-plugin"
"--disable-plugin" "--enable-languages=c"
"--enable-languages=c" "--disable-libmudflap"
"--disable-libmudflap" "--disable-libgomp"
"--disable-libgomp" "--disable-libssp"
"--disable-libssp" "--disable-libquadmath"
"--disable-libquadmath" "--disable-decimal-float")
"--disable-decimal-float") (remove (cut string-match "--(.*plugin|enable-languages)" <>)
(remove (cut string-match "--(.*plugin|enable-languages)" <>) ,flags)))
,flags))) ((#:make-flags flags)
((#:make-flags flags) `(cons "BOOT_LDFLAGS=-static" ,flags)))))
`(cons "BOOT_LDFLAGS=-static" ,flags))))))
(inputs `(("gmp-source" ,(package-source gmp)) (inputs `(("gmp-source" ,(package-source gmp))
("mpfr-source" ,(package-source mpfr)) ("mpfr-source" ,(package-source mpfr))
("mpc-source" ,(package-source mpc)) ("mpc-source" ,(package-source mpc))
@ -482,25 +477,25 @@
("xz" ,xz) ("xz" ,xz)
("input" ,pkg))) ("input" ,pkg)))
(arguments (arguments
(lambda (system) (let ((name (package-name pkg))
(let ((name (package-name pkg)) (version (package-version pkg)))
(version (package-version pkg))) `(#:modules ((guix build utils))
`(#:modules ((guix build utils)) #:builder
#:builder (begin
(begin (use-modules (guix build utils))
(use-modules (guix build utils)) (let ((out (assoc-ref %outputs "out"))
(let ((out (assoc-ref %outputs "out")) (input (assoc-ref %build-inputs "input"))
(input (assoc-ref %build-inputs "input")) (tar (assoc-ref %build-inputs "tar"))
(tar (assoc-ref %build-inputs "tar")) (xz (assoc-ref %build-inputs "xz")))
(xz (assoc-ref %build-inputs "xz"))) (mkdir out)
(mkdir out) (set-path-environment-variable "PATH" '("bin") (list tar xz))
(set-path-environment-variable "PATH" '("bin") (list tar xz)) (with-directory-excursion input
(with-directory-excursion input (zero? (system* "tar" "cJvf"
(zero? (system* "tar" "cJvf" (string-append out "/"
(string-append out "/" ,name "-" ,version
,name "-" ,version "-" ,(%current-system)
"-" ,system ".tar.xz") ".tar.xz")
"."))))))))))) "."))))))))))
(define %bootstrap-binaries-tarball (define %bootstrap-binaries-tarball
;; A tarball with the statically-linked bootstrap binaries. ;; A tarball with the statically-linked bootstrap binaries.

48
gnu/packages/ncurses.scm
View File

@ -83,34 +83,30 @@
"0fsn7xis81za62afan0vvm38bvgzg5wfmv1m86flqcj0nj7jjilh")))) "0fsn7xis81za62afan0vvm38bvgzg5wfmv1m86flqcj0nj7jjilh"))))
(build-system gnu-build-system) (build-system gnu-build-system)
(arguments (arguments
(case-lambda `(#:configure-flags
((system) `("--with-shared" "--without-debug" "--enable-widec"
`(#:configure-flags
`("--with-shared" "--without-debug" "--enable-widec"
;; By default headers land in an `ncursesw' subdir, which is not ;; By default headers land in an `ncursesw' subdir, which is not
;; what users expect. ;; what users expect.
,(string-append "--includedir=" (assoc-ref %outputs "out") ,(string-append "--includedir=" (assoc-ref %outputs "out")
"/include") "/include")
;; C++ bindings fail to build on ;; C++ bindings fail to build on
;; `i386-pc-solaris2.11' with GCC 3.4.3: ;; `i386-pc-solaris2.11' with GCC 3.4.3:
;; <http://bugs.opensolaris.org/bugdatabase/view_bug.do?bug_id=6395191>. ;; <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") '("--without-cxx-binding")
'())) '()))
#:tests? #f ; no "check" target #:tests? #f ; no "check" target
#:phases (alist-cons-after #:phases (alist-cons-after
'install 'post-install ,post-install-phase 'install 'post-install ,post-install-phase
(alist-cons-before (alist-cons-before
'configure 'patch-makefile-SHELL 'configure 'patch-makefile-SHELL
,patch-makefile-phase ,patch-makefile-phase
(alist-replace (alist-replace
'configure 'configure
,configure-phase ,configure-phase
%standard-phases))))) %standard-phases)))))
((system cross-system)
(arguments cross-system))))
(self-native-input? #t) (self-native-input? #t)
(synopsis (synopsis
"GNU Ncurses, a free software emulation of curses in SVR4 and more") "GNU Ncurses, a free software emulation of curses in SVR4 and more")

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

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -66,12 +66,8 @@ when GUILE is #f."
(location (if (pair? loc) (source-properties->location loc) loc)) (location (if (pair? loc) (source-properties->location loc) loc))
(arguments (arguments
(let ((args (package-arguments p))) (let ((args (package-arguments p)))
(if (procedure? args) `(#:guile ,guile
(lambda (system) #:implicit-inputs? #f ,@args)))
`(#:guile ,guile
#:implicit-inputs? #f ,@(args system)))
`(#:guile ,guile
#:implicit-inputs? #f ,@args))))
(native-inputs (map rewritten-input (native-inputs (map rewritten-input
(filtered-inputs (package-native-inputs p)))) (filtered-inputs (package-native-inputs p))))
(propagated-inputs (map rewritten-input (propagated-inputs (map rewritten-input
@ -95,23 +91,19 @@ configure flags for VARIABLE, the associated value is augmented."
(package (inherit p) (package (inherit p)
(arguments (arguments
(lambda (system) (let ((args (package-arguments p)))
(let ((args (match (package-arguments p) (substitute-keyword-arguments args
((? procedure? proc) ((#:configure-flags flags)
(proc system)) (let* ((var= (string-append variable "="))
(x x)))) (len (string-length var=)))
(substitute-keyword-arguments args `(cons ,(string-append var= value)
((#:configure-flags flags) (map (lambda (flag)
(let* ((var= (string-append variable "=")) (if (string-prefix? ,var= flag)
(len (string-length var=))) (string-append
`(cons ,(string-append var= value) ,(string-append var= value " ")
(map (lambda (flag) (substring flag ,len))
(if (string-prefix? ,var= flag) flag))
(string-append ,flags)))))))
,(string-append var= value " ")
(substring flag ,len))
flag))
,flags))))))))
(inputs (rewritten-inputs (package-inputs p))) (inputs (rewritten-inputs (package-inputs p)))
(propagated-inputs (rewritten-inputs (package-propagated-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) (package (inherit p)
(location (source-properties->location loc)) (location (source-properties->location loc))
(arguments (arguments
(let ((augment (lambda (args) (let ((a (default-keyword-arguments args
(let ((a (default-keyword-arguments args '(#:configure-flags '()
'(#:configure-flags '() #:strip-flags #f))))
#:strip-flags #f)))) (substitute-keyword-arguments a
(substitute-keyword-arguments a ((#:configure-flags flags)
((#:configure-flags flags) `(cons* "--disable-shared" "LDFLAGS=-static" ,flags))
`(cons* "--disable-shared" ((#:strip-flags _)
"LDFLAGS=-static" ''("--strip-all"))))))))
,flags))
((#:strip-flags _)
''("--strip-all")))))))
(if (procedure? args)
(lambda x
(augment (apply args x)))
(augment args)))))))
(define %store (define %store

38
guix/packages.scm
View File

@ -110,7 +110,7 @@ representation."
(source package-source) ; <origin> instance (source package-source) ; <origin> instance
(build-system package-build-system) ; build system (build-system package-build-system) ; build system
(arguments package-arguments ; arguments for the build method (arguments package-arguments ; arguments for the build method
(default '())) (default '()) (thunked))
(inputs package-inputs ; input packages or derivations (inputs package-inputs ; input packages or derivations
(default '())) (default '()))
@ -290,24 +290,26 @@ PACKAGE for SYSTEM."
;; because some derivations, such as the implicit inputs of the GNU build ;; because some derivations, such as the implicit inputs of the GNU build
;; system, will be queried many, many times in a row. ;; system, will be queried many, many times in a row.
(cached package system (cached package system
(match package
(($ <package> name version source (= build-system-builder builder)
args inputs propagated-inputs native-inputs self-native-input?
outputs)
;; TODO: For `search-paths', add a builder prologue that calls
;; `set-path-environment-variable'.
(let ((inputs (map expand-input
(package-transitive-inputs package))))
(apply builder ;; Bind %CURRENT-SYSTEM so that thunked field values can refer
store (package-full-name package) ;; to it.
(and source (parameterize ((%current-system system))
(package-source-derivation store source system)) (match package
inputs (($ <package> name version source (= build-system-builder builder)
#:outputs outputs #:system system args inputs propagated-inputs native-inputs self-native-input?
(if (procedure? args) outputs)
(args system) ;; TODO: For `search-paths', add a builder prologue that calls
args))))))) ;; `set-path-environment-variable'.
(let ((inputs (map expand-input
(package-transitive-inputs package))))
(apply builder
store (package-full-name package)
(and source
(package-source-derivation store source system))
inputs
#:outputs outputs #:system system
(args))))))))
(define* (package-cross-derivation store package) (define* (package-cross-derivation store package)
;; TODO ;; TODO