distro: Bootstrap standard inputs from Nixpkgs.

This is a first step towards bootstrapping from a set of pre-built,
statically-linked binaries.

* guix/build-system/gnu.scm (package-with-explicit-inputs,
  standard-inputs): New procedure.
  (%store): New variable.
  (%standard-inputs): Remove.
  (gnu-build): New `implicit-inputs?' keyword parameter.  Use it to
  choose whether to use `(standard-inputs SYSTEM)' or the empty list.

* distro/base.scm (guile-2.0): Remove dependency on XZ, which is now
  implicit.
  (%bootstrap-inputs, gcc-boot0, binutils-boot0, linux-headers-boot0,
  %boot1-inputs, glibc-final, %boot2-inputs, m4-boot2, gmp-boot2,
  mpfr-boot2, mpc-boot2, %boot3-inputs, gcc-final, %boot4-inputs,
  %final-inputs): New variables.
This commit is contained in:
Ludovic Courtès 2012-09-01 19:21:06 +02:00
parent 113aef68fb
commit 60f984b262
2 changed files with 242 additions and 15 deletions

View File

@ -21,7 +21,10 @@
#:use-module (guix packages)
#:use-module (guix http)
#:use-module (guix build-system gnu)
#:use-module (guix utils))
#:use-module (guix utils)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match))
;;; Commentary:
;;;
@ -613,7 +616,7 @@ BFD (Binary File Descriptor) library, `gprof', `nm', `strip', etc.")
,(if stripped? "-g0" "-g"))))
;; Exclude libc from $LIBRARY_PATH since the compiler being used
;; should know whether its libc is, and to avoid linking build tools
;; should know where its libc is, and to avoid linking build tools
;; like `genhooks' against the wrong libc (for instance, when
;; building a gcc-for-glibc-2.16 with a gcc-for-glibc-2.13,
;; `genhooks' could end up being linked with glibc-2.16 but using
@ -1031,8 +1034,7 @@ conversions for values passed between the two languages.")
(base32
"000ng5qsq3cl1k35jvzvhwxj92wx4q87745n2fppkd4irh58vv5l"))))
(build-system gnu-build-system)
(native-inputs `(("xz" ,(nixpkgs-derivation* "xz"))
("pkgconfig" ,(nixpkgs-derivation* "pkgconfig"))))
(native-inputs `(("pkgconfig" ,(nixpkgs-derivation* "pkgconfig"))))
(inputs `(("libffi" ,libffi)
("readline" ,readline)))
@ -1169,6 +1171,171 @@ with the Linux kernel.")
(license "LGPLv2+")
(home-page "http://www.gnu.org/software/libc/")))
;;;
;;; Bootstrap packages.
;;;
(define %bootstrap-inputs
(compile-time-value
`(("libc" ,(nixpkgs-derivation "glibc"))
,@(map (lambda (name)
(list name (nixpkgs-derivation name)))
'("gnutar" "gzip" "bzip2" "xz" "diffutils" "patch"
"coreutils" "gnused" "gnugrep" "bash"
"findutils" ; used by `libtool'
"gawk" ; used by `config.status'
"gcc" "binutils" "gnumake"
"gmp" "mpfr" "mpc"))))) ; TODO: remove from here?
(define gcc-boot0
(package (inherit gcc-4.7)
(name "gcc-boot0")
(arguments
`(#:implicit-inputs? #f
,@(package-arguments gcc-4.7)))
(inputs `(,@%bootstrap-inputs))))
(define binutils-boot0
;; Since Binutils in the bootstrap inputs may be too old, build ours here.
(package (inherit binutils)
(name "binutils-boot0")
(arguments
`(#:implicit-inputs? #f
,@(package-arguments binutils)))
(inputs `(("gcc" ,gcc-boot0)
,@(alist-delete "gcc" %bootstrap-inputs)))))
(define linux-headers-boot0
(package (inherit linux-headers)
(arguments `(#:implicit-inputs? #f
,@(package-arguments linux-headers)))
(native-inputs `(("perl" ,(nixpkgs-derivation* "perl"))
,@%bootstrap-inputs))))
(define %boot1-inputs
;; 2nd stage inputs.
`(("gcc" ,gcc-boot0)
("binutils" ,binutils-boot0)
,@(fold alist-delete %bootstrap-inputs
'("gcc" "binutils"))))
(define-public glibc-final
;; The final libc.
;; FIXME: It depends on GCC-BOOT0, which depends on some of
;; %BOOTSTRAP-INPUTS.
(package (inherit glibc)
(arguments
`(#:implicit-inputs? #f
;; Leave /bin/sh as the interpreter for `ldd', `sotruss', etc. to
;; avoid keeping a reference to the bootstrap Bash.
#:patch-shebangs? #f
,@(let loop ((args (package-arguments glibc))
(before '()))
(match args
((#:configure-flags ('list cf ...) after ...)
(append (reverse before)
`(#:configure-flags (list "BASH_SHELL=/bin/sh" ,@cf))
after))
((x rest ...)
(loop rest (cons x before)))))))
(propagated-inputs `(("linux-headers" ,linux-headers-boot0)))
(inputs %boot1-inputs)))
(define %boot2-inputs
;; 3rd stage inputs.
`(("libc" ,glibc-final)
,@(alist-delete "libc" %bootstrap-inputs)))
(define m4-boot2
(package (inherit m4)
(name "m4-boot2")
(arguments (lambda (system)
`(#:implicit-inputs? #f
,@((package-arguments m4) system))))
(inputs `(,@(package-inputs m4)
,@%boot2-inputs))))
(define gmp-boot2
(package (inherit gmp)
(name "gmp-boot2")
(arguments
`(#:implicit-inputs? #f
,@(package-arguments gmp)))
(native-inputs `(("m4" ,m4-boot2)
,@%boot2-inputs))))
(define mpfr-boot2
(package (inherit mpfr)
(name "mpfr-boot2")
(arguments
`(#:implicit-inputs? #f
,@(package-arguments mpfr)))
(inputs `(("gmp" ,gmp-boot2)
,@%boot2-inputs))))
(define mpc-boot2
(package (inherit mpc)
(name "mpc-boot2")
(arguments
`(#:implicit-inputs? #f
,@(package-arguments mpc)))
(inputs `(("gmp" ,gmp-boot2)
("mpfr" ,mpfr-boot2)
,@%boot2-inputs))))
(define %boot3-inputs
;; 4th stage inputs.
`(("libc" ,glibc-final)
("gmp" ,gmp-boot2)
("mpfr" ,mpfr-boot2)
("mpc" ,mpc-boot2)
,@(fold alist-delete
%boot2-inputs
'("libc" "gmp" "mpfr" "mpc"))))
(define-public gcc-final
;; The final GCC.
(package (inherit gcc-boot0)
(name "gcc")
(inputs %boot3-inputs)))
(define %boot4-inputs
;; 5th stage inputs.
`(("gcc" ,gcc-final)
,@(fold alist-delete %boot3-inputs
'("gcc" "gmp" "mpfr" "mpc"))))
(define-public %final-inputs
;; Final derivations used as implicit inputs by `gnu-build-system'.
(let ((finalize (cut package-with-explicit-inputs <> %boot4-inputs
(source-properties->location
(current-source-location)))))
`(,@(map (match-lambda
((name package)
(list name (finalize package))))
`(("tar" ,tar)
("gzip" ,gzip)
("xz" ,xz)
("diffutils" ,diffutils)
("patch" ,patch)
("coreutils" ,coreutils)
("sed" ,sed)
("grep" ,grep)
("bash" ,bash)
("findutils" ,findutils)
("gawk" ,gawk)
("make" ,gnu-make)
("binutils" ,binutils)))
("gcc" ,gcc-final)
("glibc" ,glibc-final))))
;;;
;;; Apps & libs --- TODO: move to separate module.
;;;
(define (guile-reader guile)
"Build Guile-Reader against GUILE, a package of some version of Guile 1.8
or 2.0."
@ -1322,4 +1489,5 @@ beginning.")
;;; eval: (put 'lambda* 'scheme-indent-function 1)
;;; eval: (put 'substitute* 'scheme-indent-function 1)
;;; eval: (put 'with-directory-excursion 'scheme-indent-function 1)
;;; eval: (put 'package 'scheme-indent-function 1)
;;; End:

View File

@ -21,9 +21,13 @@
#:use-module (guix utils)
#:use-module (guix derivations)
#:use-module (guix build-system)
#:use-module (guix packages)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-39)
#:use-module (ice-9 match)
#:export (gnu-build
gnu-build-system))
gnu-build-system
package-with-explicit-inputs))
;; Commentary:
;;
@ -32,15 +36,66 @@
;;
;; Code:
(define %standard-inputs
(compile-time-value
(map (lambda (name)
(list name (nixpkgs-derivation name)))
'("gnutar" "gzip" "bzip2" "xz" "diffutils" "patch"
"coreutils" "gnused" "gnugrep" "bash"
"findutils" ; used by `libtool'
"gawk" ; used by `config.status'
"gcc" "binutils" "gnumake" "glibc"))))
(define* (package-with-explicit-inputs p boot-inputs
#:optional
(loc (source-properties->location
(current-source-location))))
"Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take BOOT-INPUTS
as explicit inputs instead of the implicit default, and return it."
(define rewritten-input
(match-lambda
((name (? package? p) sub-drv ...)
(cons* name (package-with-explicit-inputs p boot-inputs) sub-drv))
(x x)))
(define boot-input-names
(map car boot-inputs))
(define (filtered-inputs inputs)
(fold alist-delete inputs boot-input-names))
(package (inherit p)
(location loc)
(arguments
(let ((args (package-arguments p)))
(if (procedure? args)
(lambda (system)
`(#:implicit-inputs? #f ,@(args system)))
`(#:implicit-inputs? #f ,@args))))
(native-inputs (map rewritten-input
(filtered-inputs (package-native-inputs p))))
(propagated-inputs (map rewritten-input
(filtered-inputs
(package-propagated-inputs p))))
(inputs `(,@boot-inputs
,@(map rewritten-input
(filtered-inputs (package-inputs p)))))))
(define %store
;; Store passed to STANDARD-INPUTS.
(make-parameter #f))
(define standard-inputs
(memoize
(lambda (system)
"Return the list of implicit standard inputs used with the GNU Build
System: GCC, GNU Make, Bash, Coreutils, etc."
(map (match-lambda
((name pkg sub-drv ...)
(cons* name (package-derivation (%store) pkg system) sub-drv))
((name (? derivation-path? path) sub-drv ...)
(cons* name path sub-drv))
(z
(error "invalid standard input" z)))
;; Resolve (distro base) lazily to hide circular dependency.
(let* ((distro (resolve-module '(distro base)))
(inputs (module-ref distro '%final-inputs)))
(append inputs
(append-map (match-lambda
((name package _ ...)
(package-transitive-propagated-inputs package)))
inputs)))))))
(define* (gnu-build store name source inputs
#:key (outputs '("out")) (configure-flags ''())
@ -57,6 +112,7 @@
"bin" "sbin"))
(phases '%standard-phases)
(system (%current-system))
(implicit-inputs? #t) ; useful when bootstrapping
(modules '((guix build gnu-build-system)
(guix build utils))))
"Return a derivation called NAME that builds from tarball SOURCE, with
@ -88,7 +144,10 @@ input derivation INPUTS, using the usual procedure of the GNU Build System."
builder
`(("source" ,source)
,@inputs
,@%standard-inputs)
,@(if implicit-inputs?
(parameterize ((%store store))
(standard-inputs system))
'()))
#:outputs outputs
#:modules modules))