diff --git a/build-aux/check-final-inputs-self-contained.scm b/build-aux/check-final-inputs-self-contained.scm index bf4a74110f..ade4e98001 100644 --- a/build-aux/check-final-inputs-self-contained.scm +++ b/build-aux/check-final-inputs-self-contained.scm @@ -24,7 +24,7 @@ (guix packages) (guix derivations) (guix ui) - (gnu packages base) + (gnu packages commencement) (ice-9 match) (srfi srfi-1) (srfi srfi-26)) diff --git a/gnu-system.am b/gnu-system.am index 727a30e73f..e439f51fa7 100644 --- a/gnu-system.am +++ b/gnu-system.am @@ -54,6 +54,7 @@ GNU_SYSTEM_MODULES = \ gnu/packages/cflow.scm \ gnu/packages/check.scm \ gnu/packages/cmake.scm \ + gnu/packages/commencement.scm \ gnu/packages/compression.scm \ gnu/packages/complexity.scm \ gnu/packages/conkeror.scm \ diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index c280cff198..49a2c83dd5 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -25,10 +25,6 @@ #:use-module (gnu packages) #:use-module (gnu packages acl) #:use-module (gnu packages bash) - #:use-module (gnu packages bootstrap) - #:use-module (gnu packages compression) - #:use-module (gnu packages gcc) - #:use-module (gnu packages gawk) #:use-module (gnu packages guile) #:use-module (gnu packages multiprecision) #:use-module (gnu packages perl) @@ -37,13 +33,7 @@ #:use-module (gnu packages pkg-config) #:use-module (guix packages) #:use-module (guix download) - #:use-module (guix build-system gnu) - #:use-module (guix build-system trivial) - #:use-module (guix utils) - #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) - #:use-module (ice-9 vlist) - #:use-module (ice-9 match)) + #:use-module (guix build-system gnu)) ;;; Commentary: ;;; @@ -580,708 +570,10 @@ reflect changes made by political bodies to time zone boundaries, UTC offsets, and daylight-saving rules.") (license public-domain))) - -;;; -;;; Bootstrap packages. -;;; - -(define gnu-make-boot0 - (package-with-bootstrap-guile - (package (inherit gnu-make) - (name "make-boot0") - (location (source-properties->location (current-source-location))) - (arguments - `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - #:tests? #f ; cannot run "make check" - ,@(substitute-keyword-arguments (package-arguments gnu-make) - ((#:phases phases) - `(alist-replace - 'build (lambda _ - ;; Don't attempt to build 'guile.c' since we don't - ;; have Guile here. - (substitute* "build.sh" - (("guile\\.\\$\\{OBJEXT\\}") "")) - (zero? (system* "./build.sh"))) - (alist-replace - 'install (lambda* (#:key outputs #:allow-other-keys) - (let* ((out (assoc-ref outputs "out")) - (bin (string-append out "/bin"))) - (mkdir-p bin) - (copy-file "make" - (string-append bin "/make")))) - ,phases)))))) - (native-inputs '()) ; no need for 'pkg-config' - (inputs %bootstrap-inputs)))) - -(define diffutils-boot0 - (package-with-bootstrap-guile - (let ((p (package-with-explicit-inputs diffutils - `(("make" ,gnu-make-boot0) - ,@%bootstrap-inputs) - #:guile %bootstrap-guile))) - (package (inherit p) - (location (source-properties->location (current-source-location))) - (arguments `(#:tests? #f ; the test suite needs diffutils - ,@(package-arguments p))))))) - -(define findutils-boot0 - (package-with-bootstrap-guile - (package-with-explicit-inputs findutils - `(("make" ,gnu-make-boot0) - ("diffutils" ,diffutils-boot0) ; for tests - ,@%bootstrap-inputs) - (current-source-location) - #:guile %bootstrap-guile))) - - -(define %boot0-inputs - `(("make" ,gnu-make-boot0) - ("diffutils" ,diffutils-boot0) - ("findutils" ,findutils-boot0) - ,@%bootstrap-inputs)) - -(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 #\-)) - (arch (substring system 0 dash)) - (os (substring system (+ 1 dash)))) - (string-append arch - "-" vendor "-" - (if (string=? os "linux") - "linux-gnu" - os)))) - -(define* (boot-triplet #:optional (system (%current-system))) - ;; Return the triplet used to create the cross toolchain needed in the - ;; first bootstrapping stage. - (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 -;; of being independent of the libc and tools in %BOOTSTRAP-INPUTS, since -;; GCC-BOOT0 (below) is built without any reference to the target libc. - -(define binutils-boot0 - (package-with-bootstrap-guile - (package (inherit binutils) - (name "binutils-cross-boot0") - (arguments - `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - ,@(substitute-keyword-arguments (package-arguments binutils) - ((#:configure-flags cf) - `(cons ,(string-append "--target=" (boot-triplet)) - ,cf))))) - (inputs %boot0-inputs)))) - -(define gcc-boot0 - (package-with-bootstrap-guile - (package (inherit gcc-4.8) - (name "gcc-cross-boot0") - (arguments - `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - #:modules ((guix build gnu-build-system) - (guix build utils) - (ice-9 regex) - (srfi srfi-1) - (srfi srfi-26)) - ,@(substitute-keyword-arguments (package-arguments gcc-4.8) - ((#:configure-flags flags) - `(append (list ,(string-append "--target=" (boot-triplet)) - - ;; No libc yet. - "--without-headers" - - ;; Disable features not needed at this stage. - "--disable-shared" - "--enable-languages=c,c++" - - ;; libstdc++ cannot be built at this stage - ;; ("Link tests are not allowed after - ;; GCC_NO_EXECUTABLES."). - "--disable-libstdc++-v3" - - "--disable-threads" - "--disable-libmudflap" - "--disable-libatomic" - "--disable-libsanitizer" - "--disable-libitm" - "--disable-libgomp" - "--disable-libssp" - "--disable-libquadmath" - "--disable-decimal-float") - (remove (cut string-match "--enable-languages.*" <>) - ,flags))) - ((#:phases phases) - `(alist-cons-after - 'unpack 'unpack-gmp&co - (lambda* (#:key inputs #:allow-other-keys) - (let ((gmp (assoc-ref %build-inputs "gmp-source")) - (mpfr (assoc-ref %build-inputs "mpfr-source")) - (mpc (assoc-ref %build-inputs "mpc-source"))) - - ;; To reduce the set of pre-built bootstrap inputs, build - ;; GMP & co. from GCC. - (for-each (lambda (source) - (or (zero? (system* "tar" "xvf" source)) - (error "failed to unpack tarball" - source))) - (list gmp mpfr mpc)) - - ;; Create symlinks like `gmp' -> `gmp-x.y.z'. - ,@(map (lambda (lib) - ;; Drop trailing letters, as gmp-6.0.0a unpacks - ;; into gmp-6.0.0. - `(symlink ,(string-trim-right - (package-full-name lib) - char-set:letter) - ,(package-name lib))) - (list gmp mpfr mpc)))) - (alist-cons-after - 'install 'symlink-libgcc_eh - (lambda* (#:key outputs #:allow-other-keys) - (let ((out (assoc-ref outputs "lib"))) - ;; Glibc wants to link against libgcc_eh, so provide - ;; it. - (with-directory-excursion - (string-append out "/lib/gcc/" - ,(boot-triplet) - "/" ,(package-version gcc-4.8)) - (symlink "libgcc.a" "libgcc_eh.a")))) - ,phases)))))) - - (inputs `(("gmp-source" ,(package-source gmp)) - ("mpfr-source" ,(package-source mpfr)) - ("mpc-source" ,(package-source mpc)) - ("binutils-cross" ,binutils-boot0) - - ;; Call it differently so that the builder can check whether - ;; the "libc" input is #f. - ("libc-native" ,@(assoc-ref %boot0-inputs "libc")) - ,@(alist-delete "libc" %boot0-inputs))) - - ;; No need for Texinfo at this stage. - (native-inputs (alist-delete "texinfo" - (package-native-inputs gcc-4.8)))))) - -(define perl-boot0 - (package-with-bootstrap-guile - (package-with-explicit-inputs perl - %boot0-inputs - (current-source-location) - #:guile %bootstrap-guile))) - -(define (linux-libre-headers-boot0) - "Return Linux-Libre header files for the bootstrap environment." - ;; Note: this is wrapped in a thunk to nicely handle circular dependencies - ;; between (gnu packages linux) and this module. - (package-with-bootstrap-guile - (package (inherit linux-libre-headers) - (arguments `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - ,@(package-arguments linux-libre-headers))) - (native-inputs - `(("perl" ,perl-boot0) - ,@%boot0-inputs))))) - -(define texinfo-boot0 - ;; Texinfo used to build libc's manual. - ;; We build without ncurses because it fails to build at this stage, and - ;; because we don't need the stand-alone Info reader. - ;; Also, use %BOOT0-INPUTS to avoid building Perl once more. - (let ((texinfo (package (inherit texinfo) - (inputs (alist-delete "ncurses" (package-inputs texinfo)))))) - (package-with-bootstrap-guile - (package-with-explicit-inputs texinfo %boot0-inputs - (current-source-location) - #:guile %bootstrap-guile)))) - -(define %boot1-inputs - ;; 2nd stage inputs. - `(("gcc" ,gcc-boot0) - ("binutils-cross" ,binutils-boot0) - - ;; Keep "binutils" here because the cross-gcc invokes `as', not the - ;; cross-`as'. - ,@%boot0-inputs)) - -(define glibc-final-with-bootstrap-bash - ;; The final libc, "cross-built". If everything went well, the resulting - ;; store path has no dependencies. Actually, the really-final libc is - ;; built just below; the only difference is that this one uses the - ;; bootstrap Bash. - (package-with-bootstrap-guile - (package (inherit glibc) - (name "glibc-intermediate") - (arguments - `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - - ,@(substitute-keyword-arguments (package-arguments glibc) - ((#:configure-flags flags) - `(append (list ,(string-append "--host=" (boot-triplet)) - ,(string-append "--build=" - (nix-system->gnu-triplet)) - - ;; Build Sun/ONC RPC support. In particular, - ;; install rpc/*.h. - "--enable-obsolete-rpc") - ,flags)) - ((#:phases phases) - `(alist-cons-before - 'configure 'pre-configure - (lambda* (#:key inputs #:allow-other-keys) - ;; Don't clobber CPATH with the bootstrap libc. - (setenv "NATIVE_CPATH" (getenv "CPATH")) - (unsetenv "CPATH") - - ;; 'rpcgen' needs native libc headers to be built. - (substitute* "sunrpc/Makefile" - (("sunrpc-CPPFLAGS =.*" all) - (string-append "CPATH = $(NATIVE_CPATH)\n" - "export CPATH\n" - all "\n")))) - ,phases))))) - (propagated-inputs `(("linux-headers" ,(linux-libre-headers-boot0)))) - (native-inputs - `(("texinfo" ,texinfo-boot0) - ("perl" ,perl-boot0))) - (inputs - `(;; The boot inputs. That includes the bootstrap libc. We don't want - ;; it in $CPATH, hence the 'pre-configure' phase above. - ,@%boot1-inputs - - ;; A native GCC is needed to build `cross-rpcgen'. - ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc")) - - ;; Here, we use the bootstrap Bash, which is not satisfactory - ;; because we don't want to depend on bootstrap tools. - ("static-bash" ,@(assoc-ref %boot0-inputs "bash"))))))) - -(define (cross-gcc-wrapper gcc binutils glibc bash) - "Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC -that makes it available under the native tool names." - (package (inherit gcc-4.8) - (name (string-append (package-name gcc) "-wrapped")) - (source #f) - (build-system trivial-build-system) - (outputs '("out")) - (arguments - `(#:guile ,%bootstrap-guile - #:modules ((guix build utils)) - #:builder (begin - (use-modules (guix build utils)) - - (let* ((binutils (assoc-ref %build-inputs "binutils")) - (gcc (assoc-ref %build-inputs "gcc")) - (libc (assoc-ref %build-inputs "libc")) - (bash (assoc-ref %build-inputs "bash")) - (out (assoc-ref %outputs "out")) - (bindir (string-append out "/bin")) - (triplet ,(boot-triplet))) - (define (wrap-program program) - ;; GCC-BOOT0 is a libc-less cross-compiler, so it - ;; needs to be told where to find the crt files and - ;; the dynamic linker. - (call-with-output-file program - (lambda (p) - (format p "#!~a/bin/bash -exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" - bash - gcc triplet program - libc libc - ,(glibc-dynamic-linker)))) - - (chmod program #o555)) - - (mkdir-p bindir) - (with-directory-excursion bindir - (for-each (lambda (tool) - (symlink (string-append binutils "/bin/" - triplet "-" tool) - tool)) - '("ar" "ranlib")) - (for-each wrap-program '("gcc" "g++"))))))) - (native-inputs - `(("binutils" ,binutils) - ("gcc" ,gcc) - ("libc" ,glibc) - ("bash" ,bash))) - (inputs '()))) - -(define static-bash-for-glibc - ;; A statically-linked Bash to be embedded in GLIBC-FINAL, for use by - ;; system(3) & co. - (let* ((gcc (cross-gcc-wrapper gcc-boot0 binutils-boot0 - glibc-final-with-bootstrap-bash - (car (assoc-ref %boot1-inputs "bash")))) - (bash (package (inherit bash-light) - (arguments - `(#:guile ,%bootstrap-guile - ,@(package-arguments bash-light)))))) - (package-with-bootstrap-guile - (package-with-explicit-inputs (static-package bash) - `(("gcc" ,gcc) - ("libc" ,glibc-final-with-bootstrap-bash) - ,@(fold alist-delete %boot1-inputs - '("gcc" "libc"))) - (current-source-location))))) - -(define-public glibc-final - ;; The final glibc, which embeds the statically-linked Bash built above. - (package (inherit glibc-final-with-bootstrap-bash) - (name "glibc") - (inputs `(("static-bash" ,static-bash-for-glibc) - ,@(alist-delete - "static-bash" - (package-inputs glibc-final-with-bootstrap-bash)))) - - ;; The final libc only refers to itself, but the 'debug' output contains - ;; references to GCC-BOOT0 and to the Linux headers. XXX: Would be great - ;; if 'allowed-references' were per-output. - (arguments - `(#:allowed-references - ,(cons* `(,gcc-boot0 "lib") (linux-libre-headers-boot0) - (package-outputs glibc-final-with-bootstrap-bash)) - - ,@(package-arguments glibc-final-with-bootstrap-bash))))) - -(define gcc-boot0-wrapped - ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the - ;; non-cross names. - (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final - (car (assoc-ref %boot1-inputs "bash")))) - -(define %boot2-inputs - ;; 3rd stage inputs. - `(("libc" ,glibc-final) - ("gcc" ,gcc-boot0-wrapped) - ,@(fold alist-delete %boot1-inputs '("libc" "gcc")))) - -(define binutils-final - (package-with-bootstrap-guile - (package (inherit binutils) - (arguments - `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - #:allowed-references ("out" ,glibc-final) - ,@(package-arguments binutils))) - (inputs %boot2-inputs)))) - -(define libstdc++ - ;; Intermediate libstdc++ that will allow us to build the final GCC - ;; (remember that GCC-BOOT0 cannot build libstdc++.) - (package-with-bootstrap-guile - (package (inherit gcc-4.8) - (name "libstdc++") - (arguments - `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - - #:out-of-source? #t - #:phases (alist-cons-before - 'configure 'chdir - (lambda _ - (chdir "libstdc++-v3")) - %standard-phases) - #:configure-flags `("--disable-shared" - "--disable-libstdcxx-threads" - "--disable-libstdcxx-pch" - ,(string-append "--with-gxx-include-dir=" - (assoc-ref %outputs "out") - "/include" - ;; "/include/c++/" - ;; ,(package-version gcc-4.8) - )))) - (outputs '("out")) - (inputs %boot2-inputs) - (native-inputs '()) - (propagated-inputs '()) - (synopsis "GNU C++ standard library (intermediate)")))) - -(define-public gcc-final - ;; The final GCC. - (package (inherit gcc-boot0) - (name "gcc") - (location (source-properties->location (current-source-location))) - (arguments - `(#:guile ,%bootstrap-guile - #:implicit-inputs? #f - - #:allowed-references ("out" "lib" ,glibc-final) - - ;; 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) - ((#:configure-flags boot-flags) - (let loop ((args (package-arguments gcc-4.8))) - (match args - ((#:configure-flags normal-flags _ ...) - normal-flags) - ((_ rest ...) - (loop rest))))) - ((#:make-flags flags) - ;; Since $LIBRARY_PATH and $CPATH are not honored, add the - ;; relevant flags. - `(cons (string-append "CPPFLAGS=-I" - (assoc-ref %build-inputs "libstdc++") - "/include") - (map (lambda (flag) - (if (string-prefix? "LDFLAGS=" flag) - (string-append flag " -L" - (assoc-ref %build-inputs "libstdc++") - "/lib") - flag)) - ,flags))) - ((#:phases phases) - `(alist-delete 'symlink-libgcc_eh ,phases))))) - - ;; This time we want Texinfo, so we get the manual. - (native-inputs `(("texinfo" ,texinfo-boot0) - ,@(package-native-inputs gcc-boot0))) - - (inputs `(("gmp-source" ,(package-source gmp)) - ("mpfr-source" ,(package-source mpfr)) - ("mpc-source" ,(package-source mpc)) - ("binutils" ,binutils-final) - ("libstdc++" ,libstdc++) - ,@%boot2-inputs)))) - -(define ld-wrapper-boot3 - ;; A linker wrapper that uses the bootstrap Guile. - (package - (name "ld-wrapper-boot3") - (version "0") - (source #f) - (build-system trivial-build-system) - (inputs `(("binutils" ,binutils-final) - ("guile" ,%bootstrap-guile) - ("bash" ,@(assoc-ref %boot2-inputs "bash")) - ("wrapper" ,(search-path %load-path - "gnu/packages/ld-wrapper.scm")))) - (arguments - `(#:guile ,%bootstrap-guile - #:modules ((guix build utils)) - #:builder (begin - (use-modules (guix build utils) - (system base compile)) - - (let* ((out (assoc-ref %outputs "out")) - (bin (string-append out "/bin")) - (ld (string-append bin "/ld")) - (go (string-append bin "/ld.go"))) - - (setvbuf (current-output-port) _IOLBF) - (format #t "building ~s/bin/ld wrapper in ~s~%" - (assoc-ref %build-inputs "binutils") - out) - - (mkdir-p bin) - (copy-file (assoc-ref %build-inputs "wrapper") ld) - (substitute* ld - (("@GUILE@") - (string-append (assoc-ref %build-inputs "guile") - "/bin/guile")) - (("@BASH@") - (string-append (assoc-ref %build-inputs "bash") - "/bin/bash")) - (("@LD@") - (string-append (assoc-ref %build-inputs "binutils") - "/bin/ld"))) - (chmod ld #o555) - (compile-file ld #:output-file go))))) - (synopsis "The linker wrapper") - (description - "The linker wrapper (or `ld-wrapper') wraps the linker to add any -missing `-rpath' flags, and to detect any misuse of libraries outside of the -store.") - (home-page #f) - (license gpl3+))) - -(define %boot3-inputs - ;; 4th stage inputs. - `(("gcc" ,gcc-final) - ("ld-wrapper" ,ld-wrapper-boot3) - ,@(alist-delete "gcc" %boot2-inputs))) - -(define bash-final - ;; Link with `-static-libgcc' to make sure we don't retain a reference - ;; to the bootstrap GCC. - (package-with-bootstrap-guile - (package-with-explicit-inputs (static-libgcc-package bash) - %boot3-inputs - (current-source-location) - #:guile %bootstrap-guile))) - -(define %boot4-inputs - ;; Now use the final Bash. - `(("bash" ,bash-final) - ,@(alist-delete "bash" %boot3-inputs))) - -(define-public guile-final - (package-with-bootstrap-guile - (package-with-explicit-inputs guile-2.0/fixed - %boot4-inputs - (current-source-location) - #:guile %bootstrap-guile))) - -(define gnu-make-final - ;; The final GNU Make, which uses the final Guile. - (package-with-bootstrap-guile - (package-with-explicit-inputs gnu-make - `(("guile" ,guile-final) - ,@%boot4-inputs) - (current-source-location)))) - -(define-public ld-wrapper - ;; The final `ld' wrapper, which uses the final Guile. - (package (inherit ld-wrapper-boot3) - (name "ld-wrapper") - (inputs `(("guile" ,guile-final) - ("bash" ,bash-final) - ,@(fold alist-delete (package-inputs ld-wrapper-boot3) - '("guile" "bash")))))) - -(define coreutils-final - ;; The final Coreutils. Treat them specially because some packages, such as - ;; Findutils, keep a reference to the Coreutils they were built with. - (package-with-bootstrap-guile - (package-with-explicit-inputs coreutils - %boot4-inputs - (current-source-location) - - ;; Use the final Guile, linked against the - ;; final libc with working iconv, so that - ;; 'substitute*' works well when touching - ;; test files in Gettext. - #:guile guile-final))) - -(define grep-final - ;; The final grep. Gzip holds a reference to it (via zgrep), so it must be - ;; built before gzip. - (package-with-bootstrap-guile - (package-with-explicit-inputs grep - %boot4-inputs - (current-source-location) - #:guile guile-final))) - -(define %boot5-inputs - ;; Now use the final Coreutils. - `(("coreutils" ,coreutils-final) - ("grep" ,grep-final) - ,@%boot4-inputs)) - -(define-public %final-inputs - ;; Final derivations used as implicit inputs by 'gnu-build-system'. We - ;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are - ;; used for origins that have patches, thereby avoiding circular - ;; dependencies. - (let ((finalize (compose package-with-bootstrap-guile - (cut package-with-explicit-inputs <> %boot5-inputs - (current-source-location))))) - `(,@(map (match-lambda - ((name package) - (list name (finalize package)))) - `(("tar" ,tar) - ("gzip" ,gzip) - ("bzip2" ,bzip2) - ("xz" ,xz) - ("diffutils" ,diffutils) - ("patch" ,patch) - ("sed" ,sed) - ("findutils" ,findutils) - ("gawk" ,gawk))) - ("grep" ,grep-final) - ("coreutils" ,coreutils-final) - ("make" ,gnu-make-final) - ("bash" ,bash-final) - ("ld-wrapper" ,ld-wrapper) - ("binutils" ,binutils-final) - ("gcc" ,gcc-final) - ("libc" ,glibc-final)))) - -(define-public canonical-package - (let ((name->package (fold (lambda (input result) - (match input - ((_ package) - (vhash-cons (package-full-name package) - package result)))) - vlist-null - `(("guile" ,guile-final) - ,@%final-inputs)))) - (lambda (package) - "Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of -the implicit inputs of 'gnu-build-system', return that one, otherwise return -PACKAGE. - -The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.0, -COREUTILS-FINAL vs. COREUTILS, etc." - ;; XXX: This doesn't handle dependencies of the final inputs, such as - ;; libunistring, GMP, etc. - (match (vhash-assoc (package-full-name package) name->package) - ((_ . canon) - ;; In general we want CANON, except if we're cross-compiling: CANON - ;; uses explicit inputs, so it is "anchored" in the bootstrapped - ;; process, with dependencies on things that cannot be - ;; cross-compiled. - (if (%current-target-system) - package - canon)) - (_ package))))) - - -;;; -;;; GCC toolchain. -;;; - -(define (gcc-toolchain gcc) - "Return a complete toolchain for GCC." - (package - (name "gcc-toolchain") - (version (package-version gcc)) - (source #f) - (build-system trivial-build-system) - (arguments - '(#:modules ((guix build union)) - #:builder (begin - (use-modules (ice-9 match) - (guix build union)) - - (match %build-inputs - (((names . directories) ...) - (union-build (assoc-ref %outputs "out") - directories))) - - (union-build (assoc-ref %outputs "debug") - (list (assoc-ref %build-inputs - "libc-debug")))))) - (license (package-license gcc)) - (synopsis "Complete GCC tool chain for C/C++ development") - (description - "This package provides a complete GCC tool chain for C/C++ development to -be installed in user profiles. This includes GCC, as well as libc (headers -and binaries, plus debugging symbols in the 'debug' output), and Binutils.") - (home-page "http://gcc.gnu.org/") - (outputs '("out" "debug")) - - ;; The main raison d'être of this "meta-package" is (1) to conveniently - ;; install everything that we need, and (2) to make sure ld-wrapper comes - ;; before Binutils' ld in the user's profile. - (inputs `(("gcc" ,gcc) - ("ld-wrapper" ,(car (assoc-ref %final-inputs "ld-wrapper"))) - ("binutils" ,binutils-final) - ("libc" ,glibc-final) - ("libc-debug" ,glibc-final "debug"))))) - -(define-public gcc-toolchain-4.8 - (gcc-toolchain gcc-final)) - -(define-public gcc-toolchain-4.9 - (gcc-toolchain gcc-4.9)) +(define-public (canonical-package package) + ;; Avoid circular dependency by lazily resolving 'commencement'. + (let* ((iface (resolve-interface '(gnu packages commencement))) + (proc (module-ref iface 'canonical-package))) + (proc package))) ;;; base.scm ends here diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm new file mode 100644 index 0000000000..6c49d0a9f5 --- /dev/null +++ b/gnu/packages/commencement.scm @@ -0,0 +1,759 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès +;;; Copyright © 2014 Andreas Enge +;;; Copyright © 2012 Nikita Karetnikov +;;; Copyright © 2014 Mark H Weaver +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu packages commencement) + #:use-module ((guix licenses) + #:select (gpl3+ lgpl2.0+ public-domain)) + #:use-module (gnu packages bootstrap) + #:use-module (gnu packages base) + #:use-module (gnu packages bash) + #:use-module (gnu packages gcc) + #:use-module (gnu packages gawk) + #:use-module (gnu packages guile) + #:use-module (gnu packages multiprecision) + #:use-module (gnu packages compression) + #:use-module (gnu packages perl) + #:use-module (gnu packages linux) + #:use-module (gnu packages texinfo) + #:use-module (gnu packages pkg-config) + #:use-module (guix packages) + #:use-module (guix download) + #:use-module (guix build-system gnu) + #:use-module (guix build-system trivial) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:use-module (ice-9 vlist) + #:use-module (ice-9 match)) + +;;; Commentary: +;;; +;;; This is the commencement, this is where things start. Before the +;;; commencement, of course, there's the 'bootstrap' module, which provides us +;;; with the initial binaries. This module uses those bootstrap binaries to +;;; actually build up the whole tool chain that make up the implicit inputs of +;;; 'gnu-build-system'. +;;; +;;; To avoid circular dependencies, this module should not be imported +;;; directly from anywhere. +;;; +;;; Code: + +(define gnu-make-boot0 + (package-with-bootstrap-guile + (package (inherit gnu-make) + (name "make-boot0") + (location (source-properties->location (current-source-location))) + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + #:tests? #f ; cannot run "make check" + ,@(substitute-keyword-arguments (package-arguments gnu-make) + ((#:phases phases) + `(alist-replace + 'build (lambda _ + ;; Don't attempt to build 'guile.c' since we don't + ;; have Guile here. + (substitute* "build.sh" + (("guile\\.\\$\\{OBJEXT\\}") "")) + (zero? (system* "./build.sh"))) + (alist-replace + 'install (lambda* (#:key outputs #:allow-other-keys) + (let* ((out (assoc-ref outputs "out")) + (bin (string-append out "/bin"))) + (mkdir-p bin) + (copy-file "make" + (string-append bin "/make")))) + ,phases)))))) + (native-inputs '()) ; no need for 'pkg-config' + (inputs %bootstrap-inputs)))) + +(define diffutils-boot0 + (package-with-bootstrap-guile + (let ((p (package-with-explicit-inputs diffutils + `(("make" ,gnu-make-boot0) + ,@%bootstrap-inputs) + #:guile %bootstrap-guile))) + (package (inherit p) + (location (source-properties->location (current-source-location))) + (arguments `(#:tests? #f ; the test suite needs diffutils + ,@(package-arguments p))))))) + +(define findutils-boot0 + (package-with-bootstrap-guile + (package-with-explicit-inputs findutils + `(("make" ,gnu-make-boot0) + ("diffutils" ,diffutils-boot0) ; for tests + ,@%bootstrap-inputs) + (current-source-location) + #:guile %bootstrap-guile))) + + +(define %boot0-inputs + `(("make" ,gnu-make-boot0) + ("diffutils" ,diffutils-boot0) + ("findutils" ,findutils-boot0) + ,@%bootstrap-inputs)) + +(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 #\-)) + (arch (substring system 0 dash)) + (os (substring system (+ 1 dash)))) + (string-append arch + "-" vendor "-" + (if (string=? os "linux") + "linux-gnu" + os)))) + +(define* (boot-triplet #:optional (system (%current-system))) + ;; Return the triplet used to create the cross toolchain needed in the + ;; first bootstrapping stage. + (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 +;; of being independent of the libc and tools in %BOOTSTRAP-INPUTS, since +;; GCC-BOOT0 (below) is built without any reference to the target libc. + +(define binutils-boot0 + (package-with-bootstrap-guile + (package (inherit binutils) + (name "binutils-cross-boot0") + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + ,@(substitute-keyword-arguments (package-arguments binutils) + ((#:configure-flags cf) + `(cons ,(string-append "--target=" (boot-triplet)) + ,cf))))) + (inputs %boot0-inputs)))) + +(define gcc-boot0 + (package-with-bootstrap-guile + (package (inherit gcc-4.8) + (name "gcc-cross-boot0") + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + #:modules ((guix build gnu-build-system) + (guix build utils) + (ice-9 regex) + (srfi srfi-1) + (srfi srfi-26)) + ,@(substitute-keyword-arguments (package-arguments gcc-4.8) + ((#:configure-flags flags) + `(append (list ,(string-append "--target=" (boot-triplet)) + + ;; No libc yet. + "--without-headers" + + ;; Disable features not needed at this stage. + "--disable-shared" + "--enable-languages=c,c++" + + ;; libstdc++ cannot be built at this stage + ;; ("Link tests are not allowed after + ;; GCC_NO_EXECUTABLES."). + "--disable-libstdc++-v3" + + "--disable-threads" + "--disable-libmudflap" + "--disable-libatomic" + "--disable-libsanitizer" + "--disable-libitm" + "--disable-libgomp" + "--disable-libssp" + "--disable-libquadmath" + "--disable-decimal-float") + (remove (cut string-match "--enable-languages.*" <>) + ,flags))) + ((#:phases phases) + `(alist-cons-after + 'unpack 'unpack-gmp&co + (lambda* (#:key inputs #:allow-other-keys) + (let ((gmp (assoc-ref %build-inputs "gmp-source")) + (mpfr (assoc-ref %build-inputs "mpfr-source")) + (mpc (assoc-ref %build-inputs "mpc-source"))) + + ;; To reduce the set of pre-built bootstrap inputs, build + ;; GMP & co. from GCC. + (for-each (lambda (source) + (or (zero? (system* "tar" "xvf" source)) + (error "failed to unpack tarball" + source))) + (list gmp mpfr mpc)) + + ;; Create symlinks like `gmp' -> `gmp-x.y.z'. + ,@(map (lambda (lib) + ;; Drop trailing letters, as gmp-6.0.0a unpacks + ;; into gmp-6.0.0. + `(symlink ,(string-trim-right + (package-full-name lib) + char-set:letter) + ,(package-name lib))) + (list gmp mpfr mpc)))) + (alist-cons-after + 'install 'symlink-libgcc_eh + (lambda* (#:key outputs #:allow-other-keys) + (let ((out (assoc-ref outputs "lib"))) + ;; Glibc wants to link against libgcc_eh, so provide + ;; it. + (with-directory-excursion + (string-append out "/lib/gcc/" + ,(boot-triplet) + "/" ,(package-version gcc-4.8)) + (symlink "libgcc.a" "libgcc_eh.a")))) + ,phases)))))) + + (inputs `(("gmp-source" ,(package-source gmp)) + ("mpfr-source" ,(package-source mpfr)) + ("mpc-source" ,(package-source mpc)) + ("binutils-cross" ,binutils-boot0) + + ;; Call it differently so that the builder can check whether + ;; the "libc" input is #f. + ("libc-native" ,@(assoc-ref %boot0-inputs "libc")) + ,@(alist-delete "libc" %boot0-inputs))) + + ;; No need for Texinfo at this stage. + (native-inputs (alist-delete "texinfo" + (package-native-inputs gcc-4.8)))))) + +(define perl-boot0 + (package-with-bootstrap-guile + (package-with-explicit-inputs perl + %boot0-inputs + (current-source-location) + #:guile %bootstrap-guile))) + +(define (linux-libre-headers-boot0) + "Return Linux-Libre header files for the bootstrap environment." + ;; Note: this is wrapped in a thunk to nicely handle circular dependencies + ;; between (gnu packages linux) and this module. + (package-with-bootstrap-guile + (package (inherit linux-libre-headers) + (arguments `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + ,@(package-arguments linux-libre-headers))) + (native-inputs + `(("perl" ,perl-boot0) + ,@%boot0-inputs))))) + +(define texinfo-boot0 + ;; Texinfo used to build libc's manual. + ;; We build without ncurses because it fails to build at this stage, and + ;; because we don't need the stand-alone Info reader. + ;; Also, use %BOOT0-INPUTS to avoid building Perl once more. + (let ((texinfo (package (inherit texinfo) + (inputs (alist-delete "ncurses" (package-inputs texinfo)))))) + (package-with-bootstrap-guile + (package-with-explicit-inputs texinfo %boot0-inputs + (current-source-location) + #:guile %bootstrap-guile)))) + +(define %boot1-inputs + ;; 2nd stage inputs. + `(("gcc" ,gcc-boot0) + ("binutils-cross" ,binutils-boot0) + + ;; Keep "binutils" here because the cross-gcc invokes `as', not the + ;; cross-`as'. + ,@%boot0-inputs)) + +(define glibc-final-with-bootstrap-bash + ;; The final libc, "cross-built". If everything went well, the resulting + ;; store path has no dependencies. Actually, the really-final libc is + ;; built just below; the only difference is that this one uses the + ;; bootstrap Bash. + (package-with-bootstrap-guile + (package (inherit glibc) + (name "glibc-intermediate") + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + + ,@(substitute-keyword-arguments (package-arguments glibc) + ((#:configure-flags flags) + `(append (list ,(string-append "--host=" (boot-triplet)) + ,(string-append "--build=" + (nix-system->gnu-triplet)) + + ;; Build Sun/ONC RPC support. In particular, + ;; install rpc/*.h. + "--enable-obsolete-rpc") + ,flags)) + ((#:phases phases) + `(alist-cons-before + 'configure 'pre-configure + (lambda* (#:key inputs #:allow-other-keys) + ;; Don't clobber CPATH with the bootstrap libc. + (setenv "NATIVE_CPATH" (getenv "CPATH")) + (unsetenv "CPATH") + + ;; 'rpcgen' needs native libc headers to be built. + (substitute* "sunrpc/Makefile" + (("sunrpc-CPPFLAGS =.*" all) + (string-append "CPATH = $(NATIVE_CPATH)\n" + "export CPATH\n" + all "\n")))) + ,phases))))) + (propagated-inputs `(("linux-headers" ,(linux-libre-headers-boot0)))) + (native-inputs + `(("texinfo" ,texinfo-boot0) + ("perl" ,perl-boot0))) + (inputs + `(;; The boot inputs. That includes the bootstrap libc. We don't want + ;; it in $CPATH, hence the 'pre-configure' phase above. + ,@%boot1-inputs + + ;; A native GCC is needed to build `cross-rpcgen'. + ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc")) + + ;; Here, we use the bootstrap Bash, which is not satisfactory + ;; because we don't want to depend on bootstrap tools. + ("static-bash" ,@(assoc-ref %boot0-inputs "bash"))))))) + +(define (cross-gcc-wrapper gcc binutils glibc bash) + "Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC +that makes it available under the native tool names." + (package (inherit gcc-4.8) + (name (string-append (package-name gcc) "-wrapped")) + (source #f) + (build-system trivial-build-system) + (outputs '("out")) + (arguments + `(#:guile ,%bootstrap-guile + #:modules ((guix build utils)) + #:builder (begin + (use-modules (guix build utils)) + + (let* ((binutils (assoc-ref %build-inputs "binutils")) + (gcc (assoc-ref %build-inputs "gcc")) + (libc (assoc-ref %build-inputs "libc")) + (bash (assoc-ref %build-inputs "bash")) + (out (assoc-ref %outputs "out")) + (bindir (string-append out "/bin")) + (triplet ,(boot-triplet))) + (define (wrap-program program) + ;; GCC-BOOT0 is a libc-less cross-compiler, so it + ;; needs to be told where to find the crt files and + ;; the dynamic linker. + (call-with-output-file program + (lambda (p) + (format p "#!~a/bin/bash +exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" + bash + gcc triplet program + libc libc + ,(glibc-dynamic-linker)))) + + (chmod program #o555)) + + (mkdir-p bindir) + (with-directory-excursion bindir + (for-each (lambda (tool) + (symlink (string-append binutils "/bin/" + triplet "-" tool) + tool)) + '("ar" "ranlib")) + (for-each wrap-program '("gcc" "g++"))))))) + (native-inputs + `(("binutils" ,binutils) + ("gcc" ,gcc) + ("libc" ,glibc) + ("bash" ,bash))) + (inputs '()))) + +(define static-bash-for-glibc + ;; A statically-linked Bash to be embedded in GLIBC-FINAL, for use by + ;; system(3) & co. + (let* ((gcc (cross-gcc-wrapper gcc-boot0 binutils-boot0 + glibc-final-with-bootstrap-bash + (car (assoc-ref %boot1-inputs "bash")))) + (bash (package (inherit bash-light) + (arguments + `(#:guile ,%bootstrap-guile + ,@(package-arguments bash-light)))))) + (package-with-bootstrap-guile + (package-with-explicit-inputs (static-package bash) + `(("gcc" ,gcc) + ("libc" ,glibc-final-with-bootstrap-bash) + ,@(fold alist-delete %boot1-inputs + '("gcc" "libc"))) + (current-source-location))))) + +(define-public glibc-final + ;; The final glibc, which embeds the statically-linked Bash built above. + (package (inherit glibc-final-with-bootstrap-bash) + (name "glibc") + (inputs `(("static-bash" ,static-bash-for-glibc) + ,@(alist-delete + "static-bash" + (package-inputs glibc-final-with-bootstrap-bash)))) + + ;; The final libc only refers to itself, but the 'debug' output contains + ;; references to GCC-BOOT0 and to the Linux headers. XXX: Would be great + ;; if 'allowed-references' were per-output. + (arguments + `(#:allowed-references + ,(cons* `(,gcc-boot0 "lib") (linux-libre-headers-boot0) + (package-outputs glibc-final-with-bootstrap-bash)) + + ,@(package-arguments glibc-final-with-bootstrap-bash))))) + +(define gcc-boot0-wrapped + ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the + ;; non-cross names. + (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final + (car (assoc-ref %boot1-inputs "bash")))) + +(define %boot2-inputs + ;; 3rd stage inputs. + `(("libc" ,glibc-final) + ("gcc" ,gcc-boot0-wrapped) + ,@(fold alist-delete %boot1-inputs '("libc" "gcc")))) + +(define binutils-final + (package-with-bootstrap-guile + (package (inherit binutils) + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + #:allowed-references ("out" ,glibc-final) + ,@(package-arguments binutils))) + (inputs %boot2-inputs)))) + +(define libstdc++ + ;; Intermediate libstdc++ that will allow us to build the final GCC + ;; (remember that GCC-BOOT0 cannot build libstdc++.) + (package-with-bootstrap-guile + (package (inherit gcc-4.8) + (name "libstdc++") + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + + #:out-of-source? #t + #:phases (alist-cons-before + 'configure 'chdir + (lambda _ + (chdir "libstdc++-v3")) + %standard-phases) + #:configure-flags `("--disable-shared" + "--disable-libstdcxx-threads" + "--disable-libstdcxx-pch" + ,(string-append "--with-gxx-include-dir=" + (assoc-ref %outputs "out") + "/include" + ;; "/include/c++/" + ;; ,(package-version gcc-4.8) + )))) + (outputs '("out")) + (inputs %boot2-inputs) + (native-inputs '()) + (propagated-inputs '()) + (synopsis "GNU C++ standard library (intermediate)")))) + +(define-public gcc-final + ;; The final GCC. + (package (inherit gcc-boot0) + (name "gcc") + (location (source-properties->location (current-source-location))) + (arguments + `(#:guile ,%bootstrap-guile + #:implicit-inputs? #f + + #:allowed-references ("out" "lib" ,glibc-final) + + ;; 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) + ((#:configure-flags boot-flags) + (let loop ((args (package-arguments gcc-4.8))) + (match args + ((#:configure-flags normal-flags _ ...) + normal-flags) + ((_ rest ...) + (loop rest))))) + ((#:make-flags flags) + ;; Since $LIBRARY_PATH and $CPATH are not honored, add the + ;; relevant flags. + `(cons (string-append "CPPFLAGS=-I" + (assoc-ref %build-inputs "libstdc++") + "/include") + (map (lambda (flag) + (if (string-prefix? "LDFLAGS=" flag) + (string-append flag " -L" + (assoc-ref %build-inputs "libstdc++") + "/lib") + flag)) + ,flags))) + ((#:phases phases) + `(alist-delete 'symlink-libgcc_eh ,phases))))) + + ;; This time we want Texinfo, so we get the manual. + (native-inputs `(("texinfo" ,texinfo-boot0) + ,@(package-native-inputs gcc-boot0))) + + (inputs `(("gmp-source" ,(package-source gmp)) + ("mpfr-source" ,(package-source mpfr)) + ("mpc-source" ,(package-source mpc)) + ("binutils" ,binutils-final) + ("libstdc++" ,libstdc++) + ,@%boot2-inputs)))) + +(define ld-wrapper-boot3 + ;; A linker wrapper that uses the bootstrap Guile. + (package + (name "ld-wrapper-boot3") + (version "0") + (source #f) + (build-system trivial-build-system) + (inputs `(("binutils" ,binutils-final) + ("guile" ,%bootstrap-guile) + ("bash" ,@(assoc-ref %boot2-inputs "bash")) + ("wrapper" ,(search-path %load-path + "gnu/packages/ld-wrapper.scm")))) + (arguments + `(#:guile ,%bootstrap-guile + #:modules ((guix build utils)) + #:builder (begin + (use-modules (guix build utils) + (system base compile)) + + (let* ((out (assoc-ref %outputs "out")) + (bin (string-append out "/bin")) + (ld (string-append bin "/ld")) + (go (string-append bin "/ld.go"))) + + (setvbuf (current-output-port) _IOLBF) + (format #t "building ~s/bin/ld wrapper in ~s~%" + (assoc-ref %build-inputs "binutils") + out) + + (mkdir-p bin) + (copy-file (assoc-ref %build-inputs "wrapper") ld) + (substitute* ld + (("@GUILE@") + (string-append (assoc-ref %build-inputs "guile") + "/bin/guile")) + (("@BASH@") + (string-append (assoc-ref %build-inputs "bash") + "/bin/bash")) + (("@LD@") + (string-append (assoc-ref %build-inputs "binutils") + "/bin/ld"))) + (chmod ld #o555) + (compile-file ld #:output-file go))))) + (synopsis "The linker wrapper") + (description + "The linker wrapper (or `ld-wrapper') wraps the linker to add any +missing `-rpath' flags, and to detect any misuse of libraries outside of the +store.") + (home-page #f) + (license gpl3+))) + +(define %boot3-inputs + ;; 4th stage inputs. + `(("gcc" ,gcc-final) + ("ld-wrapper" ,ld-wrapper-boot3) + ,@(alist-delete "gcc" %boot2-inputs))) + +(define bash-final + ;; Link with `-static-libgcc' to make sure we don't retain a reference + ;; to the bootstrap GCC. + (package-with-bootstrap-guile + (package-with-explicit-inputs (static-libgcc-package bash) + %boot3-inputs + (current-source-location) + #:guile %bootstrap-guile))) + +(define %boot4-inputs + ;; Now use the final Bash. + `(("bash" ,bash-final) + ,@(alist-delete "bash" %boot3-inputs))) + +(define-public guile-final + (package-with-bootstrap-guile + (package-with-explicit-inputs guile-2.0/fixed + %boot4-inputs + (current-source-location) + #:guile %bootstrap-guile))) + +(define gnu-make-final + ;; The final GNU Make, which uses the final Guile. + (package-with-bootstrap-guile + (package-with-explicit-inputs gnu-make + `(("guile" ,guile-final) + ,@%boot4-inputs) + (current-source-location)))) + +(define-public ld-wrapper + ;; The final `ld' wrapper, which uses the final Guile. + (package (inherit ld-wrapper-boot3) + (name "ld-wrapper") + (inputs `(("guile" ,guile-final) + ("bash" ,bash-final) + ,@(fold alist-delete (package-inputs ld-wrapper-boot3) + '("guile" "bash")))))) + +(define coreutils-final + ;; The final Coreutils. Treat them specially because some packages, such as + ;; Findutils, keep a reference to the Coreutils they were built with. + (package-with-bootstrap-guile + (package-with-explicit-inputs coreutils + %boot4-inputs + (current-source-location) + + ;; Use the final Guile, linked against the + ;; final libc with working iconv, so that + ;; 'substitute*' works well when touching + ;; test files in Gettext. + #:guile guile-final))) + +(define grep-final + ;; The final grep. Gzip holds a reference to it (via zgrep), so it must be + ;; built before gzip. + (package-with-bootstrap-guile + (package-with-explicit-inputs grep + %boot4-inputs + (current-source-location) + #:guile guile-final))) + +(define %boot5-inputs + ;; Now use the final Coreutils. + `(("coreutils" ,coreutils-final) + ("grep" ,grep-final) + ,@%boot4-inputs)) + +(define-public %final-inputs + ;; Final derivations used as implicit inputs by 'gnu-build-system'. We + ;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are + ;; used for origins that have patches, thereby avoiding circular + ;; dependencies. + (let ((finalize (compose package-with-bootstrap-guile + (cut package-with-explicit-inputs <> %boot5-inputs + (current-source-location))))) + `(,@(map (match-lambda + ((name package) + (list name (finalize package)))) + `(("tar" ,tar) + ("gzip" ,gzip) + ("bzip2" ,bzip2) + ("xz" ,xz) + ("diffutils" ,diffutils) + ("patch" ,patch) + ("sed" ,sed) + ("findutils" ,findutils) + ("gawk" ,gawk))) + ("grep" ,grep-final) + ("coreutils" ,coreutils-final) + ("make" ,gnu-make-final) + ("bash" ,bash-final) + ("ld-wrapper" ,ld-wrapper) + ("binutils" ,binutils-final) + ("gcc" ,gcc-final) + ("libc" ,glibc-final)))) + +(define-public canonical-package + (let ((name->package (fold (lambda (input result) + (match input + ((_ package) + (vhash-cons (package-full-name package) + package result)))) + vlist-null + `(("guile" ,guile-final) + ,@%final-inputs)))) + (lambda (package) + "Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of +the implicit inputs of 'gnu-build-system', return that one, otherwise return +PACKAGE. + +The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.0, +COREUTILS-FINAL vs. COREUTILS, etc." + ;; XXX: This doesn't handle dependencies of the final inputs, such as + ;; libunistring, GMP, etc. + (match (vhash-assoc (package-full-name package) name->package) + ((_ . canon) + ;; In general we want CANON, except if we're cross-compiling: CANON + ;; uses explicit inputs, so it is "anchored" in the bootstrapped + ;; process, with dependencies on things that cannot be + ;; cross-compiled. + (if (%current-target-system) + package + canon)) + (_ package))))) + + +;;; +;;; GCC toolchain. +;;; + +(define (gcc-toolchain gcc) + "Return a complete toolchain for GCC." + (package + (name "gcc-toolchain") + (version (package-version gcc)) + (source #f) + (build-system trivial-build-system) + (arguments + '(#:modules ((guix build union)) + #:builder (begin + (use-modules (ice-9 match) + (guix build union)) + + (match %build-inputs + (((names . directories) ...) + (union-build (assoc-ref %outputs "out") + directories))) + + (union-build (assoc-ref %outputs "debug") + (list (assoc-ref %build-inputs + "libc-debug")))))) + (license (package-license gcc)) + (synopsis "Complete GCC tool chain for C/C++ development") + (description + "This package provides a complete GCC tool chain for C/C++ development to +be installed in user profiles. This includes GCC, as well as libc (headers +and binaries, plus debugging symbols in the 'debug' output), and Binutils.") + (home-page "http://gcc.gnu.org/") + (outputs '("out" "debug")) + + ;; The main raison d'être of this "meta-package" is (1) to conveniently + ;; install everything that we need, and (2) to make sure ld-wrapper comes + ;; before Binutils' ld in the user's profile. + (inputs `(("gcc" ,gcc) + ("ld-wrapper" ,(car (assoc-ref %final-inputs "ld-wrapper"))) + ("binutils" ,binutils-final) + ("libc" ,glibc-final) + ("libc-debug" ,glibc-final "debug"))))) + +(define-public gcc-toolchain-4.8 + (gcc-toolchain gcc-final)) + +(define-public gcc-toolchain-4.9 + (gcc-toolchain gcc-4.9)) + +;;; commencement.scm ends here diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm index bba85e3c0a..90fc606d94 100644 --- a/gnu/packages/cross-base.scm +++ b/gnu/packages/cross-base.scm @@ -21,6 +21,7 @@ #:use-module (gnu packages) #:use-module (gnu packages gcc) #:use-module (gnu packages base) + #:use-module (gnu packages commencement) #:use-module (gnu packages linux) #:use-module (guix packages) #:use-module (guix download) diff --git a/gnu/packages/make-bootstrap.scm b/gnu/packages/make-bootstrap.scm index 2808bebee3..f6ef2e326a 100644 --- a/gnu/packages/make-bootstrap.scm +++ b/gnu/packages/make-bootstrap.scm @@ -23,6 +23,7 @@ #:use-module (guix build-system trivial) #:use-module (guix build-system gnu) #:use-module ((gnu packages) #:select (search-patch)) + #:use-module ((gnu packages commencement) #:select (%final-inputs)) #:use-module (gnu packages base) #:use-module (gnu packages cross-base) #:use-module (gnu packages bash) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index e1d247e8d3..578d4cba71 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -27,7 +27,7 @@ #:use-module ((gnu packages linux) #:select (udev kbd e2fsprogs)) #:use-module ((gnu packages base) - #:select (glibc-final)) + #:select (canonical-package glibc)) #:use-module (gnu packages package-management) #:use-module ((guix build linux-initrd) #:select (mount-flags->bit-mask)) @@ -324,7 +324,7 @@ the ``message of the day''." #:allow-empty-passwords? allow-empty-passwords? #:motd motd))))))) -(define* (nscd-service #:key (glibc glibc-final)) +(define* (nscd-service #:key (glibc (canonical-package glibc))) "Return a service that runs libc's name service cache daemon (nscd)." (with-monad %store-monad (return (service diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index a34129a8ed..9f29e29a40 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -19,7 +19,8 @@ (define-module (gnu services xorg) #:use-module (gnu services) #:use-module (gnu system linux) ; 'pam-service' - #:use-module ((gnu packages base) #:select (guile-final)) + #:use-module ((gnu packages base) #:select (canonical-package)) + #:use-module (gnu packages guile) #:use-module (gnu packages xorg) #:use-module (gnu packages gl) #:use-module (gnu packages slim) @@ -40,7 +41,7 @@ ;;; Code: (define* (xorg-start-command #:key - (guile guile-final) + (guile (canonical-package guile-2.0)) (xorg-server xorg-server)) "Return a derivation that builds a GUILE script to start the X server from XORG-SERVER. Usually the X server is started by a login manager." @@ -89,7 +90,7 @@ EndSection (gexp->script "start-xorg" script))) (define* (xinitrc #:key - (guile guile-final) + (guile (canonical-package guile-2.0)) (ratpoison ratpoison) (windowmaker windowmaker)) "Return a system-wide xinitrc script that starts the specified X session." diff --git a/gnu/system.scm b/gnu/system.scm index 2894df8235..2469ade1f3 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -26,6 +26,7 @@ #:use-module (guix profiles) #:use-module (gnu packages base) #:use-module (gnu packages bash) + #:use-module (gnu packages guile) #:use-module (gnu packages which) #:use-module (gnu packages admin) #:use-module (gnu packages linux) @@ -198,7 +199,7 @@ explicitly appear in OS." ;; Default set of packages globally visible. It should include anything ;; required for basic administrator tasks. (cons* procps psmisc which less zile nano - guile-final (@ (gnu packages admin) dmd) guix + (@ (gnu packages admin) dmd) guix lsof ;for Guix's 'list-runtime-roots' util-linux inetutils isc-dhcp net-tools ; XXX: remove when Inetutils suffices @@ -212,7 +213,7 @@ explicitly appear in OS." ;; The packages below are also in %FINAL-INPUTS, so take them from ;; there to avoid duplication. (map canonical-package - (list bash coreutils findutils grep sed)))) + (list guile-2.0 bash coreutils findutils grep sed)))) (define %default-issue ;; Default contents for /etc/issue. diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index db78c56683..42fc23ee8f 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -25,9 +25,9 @@ #:use-module (guix monads) #:use-module ((guix build vm) #:select (qemu-command)) - #:use-module ((gnu packages base) - #:select (%final-inputs)) + #:use-module (gnu packages base) #:use-module (gnu packages guile) + #:use-module (gnu packages gawk) #:use-module (gnu packages bash) #:use-module (gnu packages less) #:use-module (gnu packages qemu) @@ -152,7 +152,7 @@ made available under the /xchg CIFS share." (cons #$compiled %load-compiled-path)) (primitive-load #$user-builder)))) - (coreutils -> (car (assoc-ref %final-inputs "coreutils"))) + (coreutils -> (canonical-package coreutils)) (initrd (if initrd ; use the default initrd? (return initrd) (base-initrd %linux-vm-file-systems @@ -227,8 +227,8 @@ the image." (let ((inputs '#$(append (list qemu parted grub e2fsprogs util-linux) - (map (compose car (cut assoc-ref %final-inputs <>)) - '("sed" "grep" "coreutils" "findutils" "gawk")) + (map canonical-package + (list sed grep coreutils findutils gawk)) (if register-closures? (list guix) '()))) ;; This variable is unused but allows us to add INPUTS-TO-COPY diff --git a/guix/build-system/cmake.scm b/guix/build-system/cmake.scm index 8c9a32c8ab..0fc7b62c1b 100644 --- a/guix/build-system/cmake.scm +++ b/guix/build-system/cmake.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Cyril Roelandt ;;; ;;; This file is part of GNU Guix. @@ -99,7 +99,7 @@ provides a 'CMakeLists.txt' file as its build system." ((and (? string?) (? derivation-path?)) guile) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) diff --git a/guix/build-system/gnu.scm b/guix/build-system/gnu.scm index 2c41ce0eb4..7c9b6ca398 100644 --- a/guix/build-system/gnu.scm +++ b/guix/build-system/gnu.scm @@ -209,8 +209,8 @@ listed in REFS." "Return the list of (NAME PACKAGE OUTPUT) or (NAME PACKAGE) tuples of standard packages used as implicit inputs of the GNU build system." - ;; Resolve (gnu packages base) lazily to hide circular dependency. - (let ((distro (resolve-module '(gnu packages base)))) + ;; Resolve (gnu packages commencement) lazily to hide circular dependency. + (let ((distro (resolve-module '(gnu packages commencement)))) (module-ref distro '%final-inputs))) (define* (inputs-search-paths inputs @@ -347,7 +347,7 @@ are allowed to refer to." ;; ((and (? string?) (? derivation-path?)) ;; guile) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) @@ -533,7 +533,7 @@ platform." ;; ((and (? string?) (? derivation-path?)) ;; guile) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) diff --git a/guix/build-system/perl.scm b/guix/build-system/perl.scm index e8fe2d56c8..993cd7448e 100644 --- a/guix/build-system/perl.scm +++ b/guix/build-system/perl.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -93,7 +93,7 @@ provides a `Makefile.PL' file as its build system." ((and (? string?) (? derivation-path?)) guile) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) diff --git a/guix/build-system/python.scm b/guix/build-system/python.scm index 7e26864653..dfb8b4a137 100644 --- a/guix/build-system/python.scm +++ b/guix/build-system/python.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; Copyright © 2013 Andreas Enge ;;; Copyright © 2013 Nikita Karetnikov ;;; @@ -141,7 +141,7 @@ provides a 'setup.py' file as its build system." ((and (? string?) (? derivation-path?)) guile) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) diff --git a/guix/build-system/trivial.scm b/guix/build-system/trivial.scm index 5576d596da..475e8563e5 100644 --- a/guix/build-system/trivial.scm +++ b/guix/build-system/trivial.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -32,7 +32,7 @@ ((and (? string?) (? derivation-path?)) guile) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) diff --git a/guix/download.scm b/guix/download.scm index 92d08fc2bd..c0a7e8c23a 100644 --- a/guix/download.scm +++ b/guix/download.scm @@ -205,8 +205,8 @@ must be a list of symbol/URL-list pairs." (define guile-for-build (package-derivation store (or guile - (let ((distro - (resolve-interface '(gnu packages base)))) + (let ((distro (resolve-interface + '(gnu packages commencement)))) (module-ref distro 'guile-final))) system)) diff --git a/guix/gexp.scm b/guix/gexp.scm index 6d1f328aef..e31324e101 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -429,7 +429,7 @@ package/derivation references." (define (default-guile) ;; Lazily resolve 'guile-final'. This module must not refer to (gnu …) ;; modules directly, to avoid circular dependencies, hence this hack. - (module-ref (resolve-interface '(gnu packages base)) + (module-ref (resolve-interface '(gnu packages commencement)) 'guile-final)) (define* (gexp->script name exp diff --git a/guix/git-download.scm b/guix/git-download.scm index 5691e8a870..a8b7882c9f 100644 --- a/guix/git-download.scm +++ b/guix/git-download.scm @@ -65,7 +65,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if ((? package?) (package-derivation store guile system)) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) diff --git a/guix/monads.scm b/guix/monads.scm index c714941a0c..2ab3fb94f0 100644 --- a/guix/monads.scm +++ b/guix/monads.scm @@ -444,7 +444,7 @@ connection." (define (default-guile) ;; Lazily resolve 'guile-final'. This module must not refer to (gnu …) ;; modules directly, to avoid circular dependencies, hence this hack. - (module-ref (resolve-interface '(gnu packages base)) + (module-ref (resolve-interface '(gnu packages commencement)) 'guile-final)) (parameterize ((%guile-for-build (or guile-for-build diff --git a/guix/packages.scm b/guix/packages.scm index 1939373f35..b4fc026dbb 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -291,7 +291,7 @@ corresponds to the arguments expected by `set-path-environment-variable'." (define (default-guile) "Return the default Guile package for SYSTEM." - (let ((distro (resolve-interface '(gnu packages base)))) + (let ((distro (resolve-interface '(gnu packages commencement)))) (module-ref distro 'guile-final))) (define* (patch-and-repack store source patches diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm index fb285c5e67..6ecf37e1a6 100644 --- a/guix/scripts/package.scm +++ b/guix/scripts/package.scm @@ -39,7 +39,8 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-37) #:use-module (gnu packages) - #:use-module ((gnu packages base) #:select (guile-final)) + #:use-module (gnu packages base) + #:use-module (gnu packages guile) #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) #:export (specification->package+output guix-package)) @@ -914,8 +915,9 @@ more information.~%")) (set-build-options-from-command-line (%store) opts) (parameterize ((%guile-for-build - (package-derivation (%store) - (if (assoc-ref opts 'bootstrap?) - %bootstrap-guile - guile-final)))) + (package-derivation + (%store) + (if (assoc-ref opts 'bootstrap?) + %bootstrap-guile + (canonical-package guile-2.0))))) (process-actions opts))))))) diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm index 00bea1707d..c2bf536e86 100644 --- a/guix/scripts/pull.scm +++ b/guix/scripts/pull.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013 Ludovic Courtès +;;; Copyright © 2013, 2014 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -24,6 +24,7 @@ #:use-module (guix derivations) #:use-module (guix download) #:use-module (gnu packages base) + #:use-module (gnu packages guile) #:use-module ((gnu packages bootstrap) #:select (%bootstrap-guile)) #:use-module (gnu packages compression) @@ -128,7 +129,7 @@ Download and deploy the latest version of Guix.\n")) (package-derivation store (if (assoc-ref opts 'bootstrap?) %bootstrap-guile - guile-final))) + (canonical-package guile-2.0)))) (current-build-output-port (if (assoc-ref opts 'verbose?) (current-error-port) diff --git a/guix/scripts/refresh.scm b/guix/scripts/refresh.scm index a91ea69b1f..d31e6d4897 100644 --- a/guix/scripts/refresh.scm +++ b/guix/scripts/refresh.scm @@ -27,7 +27,7 @@ #:use-module (guix gnu-maintenance) #:use-module (guix gnupg) #:use-module (gnu packages) - #:use-module ((gnu packages base) #:select (%final-inputs)) + #:use-module ((gnu packages commencement) #:select (%final-inputs)) #:use-module (ice-9 match) #:use-module (ice-9 regex) #:use-module (ice-9 vlist) diff --git a/guix/svn-download.scm b/guix/svn-download.scm index cb4d9dcc11..31dd1a90e8 100644 --- a/guix/svn-download.scm +++ b/guix/svn-download.scm @@ -61,7 +61,7 @@ type HASH-ALGO (a symbol). Use NAME as the file name, or a generic name if ((? package?) (package-derivation store guile system)) (#f ; the default - (let* ((distro (resolve-interface '(gnu packages base))) + (let* ((distro (resolve-interface '(gnu packages commencement))) (guile (module-ref distro 'guile-final))) (package-derivation store guile system))))) diff --git a/tests/builders.scm b/tests/builders.scm index 54cdeb6d7b..ce1f3852d7 100644 --- a/tests/builders.scm +++ b/tests/builders.scm @@ -46,14 +46,14 @@ (map (match-lambda ((name package) (list name (package-derivation %store package)))) - (@@ (gnu packages base) %boot0-inputs)))) + (@@ (gnu packages commencement) %boot0-inputs)))) (define %bootstrap-search-paths ;; Search path specifications that go with %BOOTSTRAP-INPUTS. (append-map (match-lambda ((name package _ ...) (package-native-search-paths package))) - (@@ (gnu packages base) %boot0-inputs))) + (@@ (gnu packages commencement) %boot0-inputs))) (define network-reachable? (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))) diff --git a/tests/guix-package.sh b/tests/guix-package.sh index ce123105bf..580aa506b3 100644 --- a/tests/guix-package.sh +++ b/tests/guix-package.sh @@ -57,7 +57,7 @@ test "`guix package --search-paths -p "$profile" | wc -l`" = 0 # Check whether we have network access. if guile -c '(getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV)' 2> /dev/null then - boot_make="(@@ (gnu packages base) gnu-make-boot0)" + boot_make="(@@ (gnu packages commencement) gnu-make-boot0)" boot_make_drv="`guix build -e "$boot_make" | grep -v -e -debug`" guix package --bootstrap -p "$profile" -i "$boot_make_drv" test -L "$profile-2-link" diff --git a/tests/packages.scm b/tests/packages.scm index 2a67f108ad..16e65619bc 100644 --- a/tests/packages.scm +++ b/tests/packages.scm @@ -339,7 +339,7 @@ (test-assert "GNU Make, bootstrap" ;; GNU Make is the first program built during bootstrap; we choose it ;; here so that the test doesn't last for too long. - (let ((gnu-make (@@ (gnu packages base) gnu-make-boot0))) + (let ((gnu-make (@@ (gnu packages commencement) gnu-make-boot0))) (and (package? gnu-make) (or (location? (package-location gnu-make)) (not (package-location gnu-make)))