gnu/packages/commencement.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
   3 ;;; Copyright © 2014 Andreas Enge <andreas@enge.fr>
   4 ;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
   5 ;;; Copyright © 2014 Mark H Weaver <mhw@netris.org>
   6 ;;;
   7 ;;; This file is part of GNU Guix.
   8 ;;;
   9 ;;; GNU Guix is free software; you can redistribute it and/or modify it
  10 ;;; under the terms of the GNU General Public License as published by
  11 ;;; the Free Software Foundation; either version 3 of the License, or (at
  12 ;;; your option) any later version.
  13 ;;;
  14 ;;; GNU Guix is distributed in the hope that it will be useful, but
  15 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;;; GNU General Public License for more details.
  18 ;;;
  19 ;;; You should have received a copy of the GNU General Public License
  20 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 (define-module (gnu packages commencement)
  23   #:use-module ((guix licenses)
  24                 #:select (gpl3+ lgpl2.0+ public-domain))
  25   #:use-module (gnu packages bootstrap)
  26   #:use-module (gnu packages base)
  27   #:use-module (gnu packages bash)
  28   #:use-module (gnu packages gcc)
  29   #:use-module (gnu packages m4)
  30   #:use-module (gnu packages file)
  31   #:use-module (gnu packages gawk)
  32   #:use-module (gnu packages bison)
  33   #:use-module (gnu packages guile)
  34   #:use-module (gnu packages multiprecision)
  35   #:use-module (gnu packages compression)
  36   #:use-module (gnu packages perl)
  37   #:use-module (gnu packages linux)
  38   #:use-module (gnu packages texinfo)
  39   #:use-module (gnu packages pkg-config)
  40   #:use-module (guix packages)
  41   #:use-module (guix download)
  42   #:use-module (guix build-system gnu)
  43   #:use-module (guix build-system trivial)
  44   #:use-module (guix utils)
  45   #:use-module (srfi srfi-1)
  46   #:use-module (srfi srfi-26)
  47   #:use-module (ice-9 vlist)
  48   #:use-module (ice-9 match))
  49
  50 ;;; Commentary:
  51 ;;;
  52 ;;; This is the commencement, this is where things start.  Before the
  53 ;;; commencement, of course, there's the 'bootstrap' module, which provides us
  54 ;;; with the initial binaries.  This module uses those bootstrap binaries to
  55 ;;; actually build up the whole tool chain that make up the implicit inputs of
  56 ;;; 'gnu-build-system'.
  57 ;;;
  58 ;;; To avoid circular dependencies, this module should not be imported
  59 ;;; directly from anywhere.
  60 ;;;
  61 ;;; Code:
  62
  63 (define gnu-make-boot0
  64   (package-with-bootstrap-guile
  65    (package (inherit gnu-make)
  66      (name "make-boot0")
  67      (location (source-properties->location (current-source-location)))
  68      (arguments
  69       `(#:guile ,%bootstrap-guile
  70         #:implicit-inputs? #f
  71         #:tests? #f                  ; cannot run "make check"
  72         ,@(substitute-keyword-arguments (package-arguments gnu-make)
  73             ((#:phases phases)
  74              `(alist-replace
  75                'build (lambda _
  76                         (zero? (system* "./build.sh")))
  77                (alist-replace
  78                 'install (lambda* (#:key outputs #:allow-other-keys)
  79                            (let* ((out (assoc-ref outputs "out"))
  80                                   (bin (string-append out "/bin")))
  81                              (mkdir-p bin)
  82                              (copy-file "make"
  83                                         (string-append bin "/make"))))
  84                 ,phases))))))
  85      (native-inputs '())                          ; no need for 'pkg-config'
  86      (inputs %bootstrap-inputs))))
  87
  88 (define diffutils-boot0
  89   (package-with-bootstrap-guile
  90    (let ((p (package-with-explicit-inputs diffutils
  91                                           `(("make" ,gnu-make-boot0)
  92                                             ,@%bootstrap-inputs)
  93                                           #:guile %bootstrap-guile)))
  94      (package (inherit p)
  95        (location (source-properties->location (current-source-location)))
  96        (arguments `(#:tests? #f         ; the test suite needs diffutils
  97                     ,@(package-arguments p)))))))
  98
  99 (define findutils-boot0
 100   (package-with-bootstrap-guile
 101    (package-with-explicit-inputs findutils
 102                                  `(("make" ,gnu-make-boot0)
 103                                    ("diffutils" ,diffutils-boot0) ; for tests
 104                                    ,@%bootstrap-inputs)
 105                                  (current-source-location)
 106                                  #:guile %bootstrap-guile)))
 107
 108 (define file-boot0
 109   (package-with-bootstrap-guile
 110    (package-with-explicit-inputs file
 111                                  `(("make" ,gnu-make-boot0)
 112                                    ,@%bootstrap-inputs)
 113                                  (current-source-location)
 114                                  #:guile %bootstrap-guile)))
 115
 116
 117 (define %boot0-inputs
 118   `(("make" ,gnu-make-boot0)
 119     ("diffutils" ,diffutils-boot0)
 120     ("findutils" ,findutils-boot0)
 121     ("file" ,file-boot0)
 122     ,@%bootstrap-inputs))
 123
 124 (define* (boot-triplet #:optional (system (%current-system)))
 125   ;; Return the triplet used to create the cross toolchain needed in the
 126   ;; first bootstrapping stage.
 127   (nix-system->gnu-triplet system "guix"))
 128
 129 ;; Following Linux From Scratch, build a cross-toolchain in stage 0.  That
 130 ;; toolchain actually targets the same OS and arch, but it has the advantage
 131 ;; of being independent of the libc and tools in %BOOTSTRAP-INPUTS, since
 132 ;; GCC-BOOT0 (below) is built without any reference to the target libc.
 133
 134 (define binutils-boot0
 135   (package-with-bootstrap-guile
 136    (package (inherit binutils)
 137      (name "binutils-cross-boot0")
 138      (arguments
 139       `(#:guile ,%bootstrap-guile
 140         #:implicit-inputs? #f
 141         ,@(substitute-keyword-arguments (package-arguments binutils)
 142             ((#:configure-flags cf)
 143              `(cons ,(string-append "--target=" (boot-triplet))
 144                     ,cf)))))
 145      (inputs %boot0-inputs))))
 146
 147 (define gcc-boot0
 148   (package-with-bootstrap-guile
 149    (package (inherit gcc-4.8)
 150      (name "gcc-cross-boot0")
 151      (arguments
 152       `(#:guile ,%bootstrap-guile
 153         #:implicit-inputs? #f
 154         #:modules ((guix build gnu-build-system)
 155                    (guix build utils)
 156                    (ice-9 regex)
 157                    (srfi srfi-1)
 158                    (srfi srfi-26))
 159         ,@(substitute-keyword-arguments (package-arguments gcc-4.8)
 160             ((#:validate-runpath? _)
 161              #t)
 162             ((#:configure-flags flags)
 163              `(append (list ,(string-append "--target=" (boot-triplet))
 164
 165                             ;; No libc yet.
 166                             "--without-headers"
 167
 168                             ;; Disable features not needed at this stage.
 169                             "--disable-shared"
 170                             "--enable-languages=c,c++"
 171
 172                             ;; libstdc++ cannot be built at this stage
 173                             ;; ("Link tests are not allowed after
 174                             ;; GCC_NO_EXECUTABLES.").
 175                             "--disable-libstdc++-v3"
 176
 177                             "--disable-threads"
 178                             "--disable-libmudflap"
 179                             "--disable-libatomic"
 180                             "--disable-libsanitizer"
 181                             "--disable-libitm"
 182                             "--disable-libgomp"
 183                             "--disable-libssp"
 184                             "--disable-libquadmath"
 185                             "--disable-decimal-float")
 186                       (remove (cut string-match "--enable-languages.*" <>)
 187                               ,flags)))
 188             ((#:phases phases)
 189              `(alist-cons-after
 190                'unpack 'unpack-gmp&co
 191                (lambda* (#:key inputs #:allow-other-keys)
 192                  (let ((gmp  (assoc-ref %build-inputs "gmp-source"))
 193                        (mpfr (assoc-ref %build-inputs "mpfr-source"))
 194                        (mpc  (assoc-ref %build-inputs "mpc-source")))
 195
 196                    ;; To reduce the set of pre-built bootstrap inputs, build
 197                    ;; GMP & co. from GCC.
 198                    (for-each (lambda (source)
 199                                (or (zero? (system* "tar" "xvf" source))
 200                                    (error "failed to unpack tarball"
 201                                           source)))
 202                              (list gmp mpfr mpc))
 203
 204                    ;; Create symlinks like `gmp' -> `gmp-x.y.z'.
 205                    ,@(map (lambda (lib)
 206                             ;; Drop trailing letters, as gmp-6.0.0a unpacks
 207                             ;; into gmp-6.0.0.
 208                             `(symlink ,(string-trim-right
 209                                         (package-full-name lib)
 210                                         char-set:letter)
 211                                       ,(package-name lib)))
 212                           (list gmp mpfr mpc))))
 213                (alist-cons-after
 214                 'install 'symlink-libgcc_eh
 215                 (lambda* (#:key outputs #:allow-other-keys)
 216                   (let ((out (assoc-ref outputs "lib")))
 217                     ;; Glibc wants to link against libgcc_eh, so provide
 218                     ;; it.
 219                     (with-directory-excursion
 220                         (string-append out "/lib/gcc/"
 221                                        ,(boot-triplet)
 222                                        "/" ,(package-version gcc-4.8))
 223                       (symlink "libgcc.a" "libgcc_eh.a"))))
 224                 ,phases))))))
 225
 226      (inputs `(("gmp-source" ,(package-source gmp))
 227                ("mpfr-source" ,(package-source mpfr))
 228                ("mpc-source" ,(package-source mpc))
 229                ("binutils-cross" ,binutils-boot0)
 230
 231                ;; Call it differently so that the builder can check whether
 232                ;; the "libc" input is #f.
 233                ("libc-native" ,@(assoc-ref %boot0-inputs "libc"))
 234                ,@(alist-delete "libc" %boot0-inputs)))
 235
 236      ;; No need for Texinfo at this stage.
 237      (native-inputs (alist-delete "texinfo"
 238                                   (package-native-inputs gcc-4.8))))))
 239
 240 (define perl-boot0
 241   (package-with-bootstrap-guile
 242    (package-with-explicit-inputs perl
 243                                  %boot0-inputs
 244                                  (current-source-location)
 245                                  #:guile %bootstrap-guile)))
 246
 247 (define (linux-libre-headers-boot0)
 248   "Return Linux-Libre header files for the bootstrap environment."
 249   ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
 250   ;; between (gnu packages linux) and this module.
 251   (package-with-bootstrap-guile
 252    (package (inherit linux-libre-headers)
 253      (arguments `(#:guile ,%bootstrap-guile
 254                   #:implicit-inputs? #f
 255                   ,@(package-arguments linux-libre-headers)))
 256      (native-inputs
 257       `(("perl" ,perl-boot0)
 258         ,@%boot0-inputs)))))
 259
 260 (define texinfo-boot0
 261   ;; Texinfo used to build libc's manual.
 262   ;; We build without ncurses because it fails to build at this stage, and
 263   ;; because we don't need the stand-alone Info reader.
 264   ;; Also, use %BOOT0-INPUTS to avoid building Perl once more.
 265   (let ((texinfo (package (inherit texinfo)
 266                    (inputs (alist-delete "ncurses" (package-inputs texinfo))))))
 267     (package-with-bootstrap-guile
 268      (package-with-explicit-inputs texinfo %boot0-inputs
 269                                    (current-source-location)
 270                                    #:guile %bootstrap-guile))))
 271
 272 (define %boot1-inputs
 273   ;; 2nd stage inputs.
 274   `(("gcc" ,gcc-boot0)
 275     ("binutils-cross" ,binutils-boot0)
 276
 277     ;; Keep "binutils" here because the cross-gcc invokes `as', not the
 278     ;; cross-`as'.
 279     ,@%boot0-inputs))
 280
 281 (define glibc-final-with-bootstrap-bash
 282   ;; The final libc, "cross-built".  If everything went well, the resulting
 283   ;; store path has no dependencies.  Actually, the really-final libc is
 284   ;; built just below; the only difference is that this one uses the
 285   ;; bootstrap Bash.
 286   (package-with-bootstrap-guile
 287    (package (inherit glibc)
 288      (name "glibc-intermediate")
 289      (arguments
 290       `(#:guile ,%bootstrap-guile
 291         #:implicit-inputs? #f
 292
 293         ,@(substitute-keyword-arguments (package-arguments glibc)
 294             ((#:configure-flags flags)
 295              `(append (list ,(string-append "--host=" (boot-triplet))
 296                             ,(string-append "--build="
 297                                             (nix-system->gnu-triplet))
 298
 299                             ;; Build Sun/ONC RPC support.  In particular,
 300                             ;; install rpc/*.h.
 301                             "--enable-obsolete-rpc")
 302                       ,flags))
 303             ((#:phases phases)
 304              `(alist-cons-before
 305                'configure 'pre-configure
 306                (lambda* (#:key inputs #:allow-other-keys)
 307                  ;; Don't clobber CPATH with the bootstrap libc.
 308                  (setenv "NATIVE_CPATH" (getenv "CPATH"))
 309                  (unsetenv "CPATH")
 310
 311                  ;; 'rpcgen' needs native libc headers to be built.
 312                  (substitute* "sunrpc/Makefile"
 313                    (("sunrpc-CPPFLAGS =.*" all)
 314                     (string-append "CPATH = $(NATIVE_CPATH)\n"
 315                                    "export CPATH\n"
 316                                    all "\n"))))
 317                ,phases)))))
 318      (propagated-inputs `(("linux-headers" ,(linux-libre-headers-boot0))))
 319      (native-inputs
 320       `(("texinfo" ,texinfo-boot0)
 321         ("perl" ,perl-boot0)))
 322      (inputs
 323       `(;; The boot inputs.  That includes the bootstrap libc.  We don't want
 324         ;; it in $CPATH, hence the 'pre-configure' phase above.
 325         ,@%boot1-inputs
 326
 327         ;; A native GCC is needed to build `cross-rpcgen'.
 328         ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
 329
 330         ;; Here, we use the bootstrap Bash, which is not satisfactory
 331         ;; because we don't want to depend on bootstrap tools.
 332         ("static-bash" ,@(assoc-ref %boot0-inputs "bash")))))))
 333
 334 (define (cross-gcc-wrapper gcc binutils glibc bash)
 335   "Return a wrapper for the pseudo-cross toolchain GCC/BINUTILS/GLIBC
 336 that makes it available under the native tool names."
 337   (package (inherit gcc-4.8)
 338     (name (string-append (package-name gcc) "-wrapped"))
 339     (source #f)
 340     (build-system trivial-build-system)
 341     (outputs '("out"))
 342     (arguments
 343      `(#:guile ,%bootstrap-guile
 344        #:modules ((guix build utils))
 345        #:builder (begin
 346                    (use-modules (guix build utils))
 347
 348                    (let* ((binutils (assoc-ref %build-inputs "binutils"))
 349                           (gcc      (assoc-ref %build-inputs "gcc"))
 350                           (libc     (assoc-ref %build-inputs "libc"))
 351                           (bash     (assoc-ref %build-inputs "bash"))
 352                           (out      (assoc-ref %outputs "out"))
 353                           (bindir   (string-append out "/bin"))
 354                           (triplet  ,(boot-triplet)))
 355                      (define (wrap-program program)
 356                        ;; GCC-BOOT0 is a libc-less cross-compiler, so it
 357                        ;; needs to be told where to find the crt files and
 358                        ;; the dynamic linker.
 359                        (call-with-output-file program
 360                          (lambda (p)
 361                            (format p "#!~a/bin/bash
 362 exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%"
 363                                    bash
 364                                    gcc triplet program
 365                                    libc libc
 366                                    ,(glibc-dynamic-linker))))
 367
 368                        (chmod program #o555))
 369
 370                      (mkdir-p bindir)
 371                      (with-directory-excursion bindir
 372                        (for-each (lambda (tool)
 373                                    (symlink (string-append binutils "/bin/"
 374                                                            triplet "-" tool)
 375                                             tool))
 376                                  '("ar" "ranlib"))
 377                        (for-each wrap-program '("gcc" "g++")))))))
 378     (native-inputs
 379      `(("binutils" ,binutils)
 380        ("gcc" ,gcc)
 381        ("libc" ,glibc)
 382        ("bash" ,bash)))
 383     (inputs '())))
 384
 385 (define bison-boot1
 386   ;; XXX: This Bison is needed to rebuild Bash's parser, which is modified by
 387   ;; its CVE patches.  Remove it when it's no longer needed.
 388   (let* ((m4    (package-with-bootstrap-guile
 389                  (package-with-explicit-inputs m4 %boot0-inputs
 390                                                (current-source-location)
 391                                                #:guile %bootstrap-guile)))
 392          (bison (package (inherit bison)
 393                   (native-inputs `(("perl" ,perl-boot0)))
 394                   (propagated-inputs `(("m4" ,m4)))
 395                   (inputs '())                    ;remove Flex...
 396                   (arguments '(#:tests? #f)))))   ;... and thus disable tests
 397    (package-with-bootstrap-guile
 398     (package-with-explicit-inputs bison %boot0-inputs
 399                                   (current-source-location)
 400                                   #:guile %bootstrap-guile))))
 401
 402 (define static-bash-for-glibc
 403   ;; A statically-linked Bash to be embedded in GLIBC-FINAL, for use by
 404   ;; system(3) & co.
 405   (let* ((gcc  (cross-gcc-wrapper gcc-boot0 binutils-boot0
 406                                   glibc-final-with-bootstrap-bash
 407                                   (car (assoc-ref %boot1-inputs "bash"))))
 408          (bash (package (inherit bash-light)
 409                  (native-inputs `(("bison" ,bison-boot1)))
 410                  (arguments
 411                   `(#:guile ,%bootstrap-guile
 412                     ,@(package-arguments bash-light))))))
 413     (package-with-bootstrap-guile
 414      (package-with-explicit-inputs (static-package bash)
 415                                    `(("gcc" ,gcc)
 416                                      ("libc" ,glibc-final-with-bootstrap-bash)
 417                                      ,@(fold alist-delete %boot1-inputs
 418                                              '("gcc" "libc")))
 419                                    (current-source-location)))))
 420
 421 (define-public glibc-final
 422   ;; The final glibc, which embeds the statically-linked Bash built above.
 423   (package (inherit glibc-final-with-bootstrap-bash)
 424     (name "glibc")
 425     (inputs `(("static-bash" ,static-bash-for-glibc)
 426               ,@(alist-delete
 427                  "static-bash"
 428                  (package-inputs glibc-final-with-bootstrap-bash))))
 429
 430     ;; The final libc only refers to itself, but the 'debug' output contains
 431     ;; references to GCC-BOOT0 and to the Linux headers.  XXX: Would be great
 432     ;; if 'allowed-references' were per-output.
 433     (arguments
 434      `(#:allowed-references
 435        ,(cons* `(,gcc-boot0 "lib") (linux-libre-headers-boot0)
 436                (package-outputs glibc-final-with-bootstrap-bash))
 437
 438        ,@(package-arguments glibc-final-with-bootstrap-bash)))))
 439
 440 (define gcc-boot0-wrapped
 441   ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
 442   ;; non-cross names.
 443   (cross-gcc-wrapper gcc-boot0 binutils-boot0 glibc-final
 444                      (car (assoc-ref %boot1-inputs "bash"))))
 445
 446 (define %boot2-inputs
 447   ;; 3rd stage inputs.
 448   `(("libc" ,glibc-final)
 449     ("gcc" ,gcc-boot0-wrapped)
 450     ,@(fold alist-delete %boot1-inputs '("libc" "gcc"))))
 451
 452 (define binutils-final
 453   (package-with-bootstrap-guile
 454    (package (inherit binutils)
 455      (arguments
 456       `(#:guile ,%bootstrap-guile
 457         #:implicit-inputs? #f
 458         #:allowed-references ("out" ,glibc-final)
 459         ,@(package-arguments binutils)))
 460      (inputs %boot2-inputs))))
 461
 462 (define libstdc++
 463   ;; Intermediate libstdc++ that will allow us to build the final GCC
 464   ;; (remember that GCC-BOOT0 cannot build libstdc++.)
 465   (package-with-bootstrap-guile
 466    (package (inherit gcc-4.8)
 467      (name "libstdc++")
 468      (arguments
 469       `(#:guile ,%bootstrap-guile
 470         #:implicit-inputs? #f
 471
 472         #:out-of-source? #t
 473         #:phases (alist-cons-before
 474                   'configure 'chdir
 475                   (lambda _
 476                     (chdir "libstdc++-v3"))
 477                   %standard-phases)
 478         #:configure-flags `("--disable-shared"
 479                             "--disable-libstdcxx-threads"
 480                             "--disable-libstdcxx-pch"
 481                             ,(string-append "--with-gxx-include-dir="
 482                                             (assoc-ref %outputs "out")
 483                                             "/include"
 484                                             ;; "/include/c++/"
 485                                             ;; ,(package-version gcc-4.8)
 486                                             ))))
 487      (outputs '("out"))
 488      (inputs %boot2-inputs)
 489      (native-inputs '())
 490      (propagated-inputs '())
 491      (synopsis "GNU C++ standard library (intermediate)"))))
 492
 493 (define-public gcc-final
 494   ;; The final GCC.
 495   (package (inherit gcc-boot0)
 496     (name "gcc")
 497     (location (source-properties->location (current-source-location)))
 498     (arguments
 499      `(#:guile ,%bootstrap-guile
 500        #:implicit-inputs? #f
 501
 502        #:allowed-references ("out" "lib" ,glibc-final)
 503
 504        ;; Build again GMP & co. within GCC's build process, because it's hard
 505        ;; to do outside (because GCC-BOOT0 is a cross-compiler, and thus
 506        ;; doesn't honor $LIBRARY_PATH, which breaks `gnu-build-system'.)
 507        ,@(substitute-keyword-arguments (package-arguments gcc-boot0)
 508            ((#:configure-flags boot-flags)
 509             (let loop ((args (package-arguments gcc-4.8)))
 510               (match args
 511                 ((#:configure-flags normal-flags _ ...)
 512                  normal-flags)
 513                 ((_ rest ...)
 514                  (loop rest)))))
 515            ((#:make-flags flags)
 516             ;; Since $LIBRARY_PATH and $CPATH are not honored, add the
 517             ;; relevant flags.
 518             `(cons (string-append "CPPFLAGS=-I"
 519                                   (assoc-ref %build-inputs "libstdc++")
 520                                   "/include")
 521                    (map (lambda (flag)
 522                           (if (string-prefix? "LDFLAGS=" flag)
 523                               (string-append flag " -L"
 524                                              (assoc-ref %build-inputs "libstdc++")
 525                                              "/lib")
 526                               flag))
 527                         ,flags)))
 528            ((#:validate-runpath? _)
 529             ;; Things like libasan.so and libstdc++.so NEED ld.so and/or
 530             ;; libgcc_s.so but RUNPATH is empty.  This is a false positive, so
 531             ;; turn it off.
 532             #f)
 533            ((#:phases phases)
 534             `(alist-delete 'symlink-libgcc_eh ,phases)))))
 535
 536     ;; This time we want Texinfo, so we get the manual.
 537     (native-inputs `(("texinfo" ,texinfo-boot0)
 538                      ,@(package-native-inputs gcc-boot0)))
 539
 540     (inputs `(("gmp-source" ,(bootstrap-origin (package-source gmp)))
 541               ("mpfr-source" ,(package-source mpfr))
 542               ("mpc-source" ,(package-source mpc))
 543               ("binutils" ,binutils-final)
 544               ("libstdc++" ,libstdc++)
 545               ,@%boot2-inputs))))
 546
 547 (define ld-wrapper-boot3
 548   ;; A linker wrapper that uses the bootstrap Guile.
 549   (make-ld-wrapper "ld-wrapper-boot3"
 550                    #:binutils binutils-final
 551                    #:guile %bootstrap-guile
 552                    #:bash (car (assoc-ref %boot2-inputs "bash"))))
 553
 554 (define %boot3-inputs
 555   ;; 4th stage inputs.
 556   `(("gcc" ,gcc-final)
 557     ("ld-wrapper" ,ld-wrapper-boot3)
 558     ,@(alist-delete "gcc" %boot2-inputs)))
 559
 560 (define bash-final
 561   ;; Link with `-static-libgcc' to make sure we don't retain a reference
 562   ;; to the bootstrap GCC.
 563   (package-with-bootstrap-guile
 564    (package-with-explicit-inputs (static-libgcc-package bash)
 565                                  %boot3-inputs
 566                                  (current-source-location)
 567                                  #:guile %bootstrap-guile)))
 568
 569 (define %boot4-inputs
 570   ;; Now use the final Bash.
 571   `(("bash" ,bash-final)
 572     ,@(alist-delete "bash" %boot3-inputs)))
 573
 574 (define-public guile-final
 575   (package-with-bootstrap-guile
 576    (package-with-explicit-inputs guile-2.0/fixed
 577                                  %boot4-inputs
 578                                  (current-source-location)
 579                                  #:guile %bootstrap-guile)))
 580
 581 (define-public glibc-utf8-locales-final
 582   ;; Now that we have GUILE-FINAL, build the UTF-8 locales.  They are needed
 583   ;; by the build processes afterwards so their 'scm_to_locale_string' works
 584   ;; with the full range of Unicode codepoints (remember
 585   ;; 'scm_to_locale_string' is called every time a string is passed to a C
 586   ;; function.)
 587   (package
 588     (inherit glibc-utf8-locales)
 589     (inputs `(("glibc" ,glibc-final)
 590               ("gzip"
 591                ,(package-with-explicit-inputs gzip %boot4-inputs
 592                                               (current-source-location)
 593                                               #:guile %bootstrap-guile))))))
 594
 595 (define %boot5-inputs
 596   ;; Now with UTF-8 locale.
 597   `(("locales" ,glibc-utf8-locales-final)
 598     ,@%boot4-inputs))
 599
 600 (define gnu-make-final
 601   ;; The final GNU Make, which uses the final Guile.
 602   (package-with-bootstrap-guile
 603    (package-with-explicit-inputs gnu-make
 604                                  `(("guile" ,guile-final)
 605                                    ,@%boot5-inputs)
 606                                  (current-source-location))))
 607
 608 (define-public ld-wrapper
 609   ;; The final `ld' wrapper, which uses the final Guile.
 610   (package (inherit ld-wrapper-boot3)
 611     (name "ld-wrapper")
 612     (inputs `(("guile" ,guile-final)
 613               ("bash"  ,bash-final)
 614               ,@(fold alist-delete (package-inputs ld-wrapper-boot3)
 615                       '("guile" "bash"))))))
 616
 617 (define coreutils-final
 618   ;; The final Coreutils.  Treat them specially because some packages, such as
 619   ;; Findutils, keep a reference to the Coreutils they were built with.
 620   (package-with-bootstrap-guile
 621    (package-with-explicit-inputs coreutils
 622                                  %boot5-inputs
 623                                  (current-source-location)
 624
 625                                  ;; Use the final Guile, linked against the
 626                                  ;; final libc with working iconv, so that
 627                                  ;; 'substitute*' works well when touching
 628                                  ;; test files in Gettext.
 629                                  #:guile guile-final)))
 630
 631 (define grep-final
 632   ;; The final grep.  Gzip holds a reference to it (via zgrep), so it must be
 633   ;; built before gzip.
 634   (package-with-bootstrap-guile
 635    (package-with-explicit-inputs grep
 636                                  %boot5-inputs
 637                                  (current-source-location)
 638                                  #:guile guile-final)))
 639
 640 (define %boot6-inputs
 641   ;; Now use the final Coreutils.
 642   `(("coreutils" ,coreutils-final)
 643     ("grep" ,grep-final)
 644     ,@%boot5-inputs))
 645
 646 (define-public %final-inputs
 647   ;; Final derivations used as implicit inputs by 'gnu-build-system'.  We
 648   ;; still use 'package-with-bootstrap-guile' so that the bootstrap tools are
 649   ;; used for origins that have patches, thereby avoiding circular
 650   ;; dependencies.
 651   (let ((finalize (compose package-with-bootstrap-guile
 652                            (cut package-with-explicit-inputs <> %boot6-inputs
 653                                 (current-source-location)))))
 654     `(,@(map (match-lambda
 655               ((name package)
 656                (list name (finalize package))))
 657              `(("tar" ,tar)
 658                ("gzip" ,gzip)
 659                ("bzip2" ,bzip2)
 660                ("xz" ,xz)
 661                ("file" ,file)
 662                ("diffutils" ,diffutils)
 663                ("patch" ,patch)
 664                ("sed" ,sed)
 665                ("findutils" ,findutils)
 666                ("gawk" ,gawk)))
 667       ("grep" ,grep-final)
 668       ("coreutils" ,coreutils-final)
 669       ("make" ,gnu-make-final)
 670       ("bash" ,bash-final)
 671       ("ld-wrapper" ,ld-wrapper)
 672       ("binutils" ,binutils-final)
 673       ("gcc" ,gcc-final)
 674       ("libc" ,glibc-final)
 675       ("locales" ,glibc-utf8-locales-final))))
 676
 677 (define-public canonical-package
 678   (let ((name->package (fold (lambda (input result)
 679                                (match input
 680                                  ((_ package)
 681                                   (vhash-cons (package-full-name package)
 682                                               package result))))
 683                              vlist-null
 684                              `(("guile" ,guile-final)
 685                                ,@%final-inputs))))
 686     (lambda (package)
 687       "Return the 'canonical' variant of PACKAGE---i.e., if PACKAGE is one of
 688 the implicit inputs of 'gnu-build-system', return that one, otherwise return
 689 PACKAGE.
 690
 691 The goal is to avoid duplication in cases like GUILE-FINAL vs. GUILE-2.0,
 692 COREUTILS-FINAL vs. COREUTILS, etc."
 693       ;; XXX: This doesn't handle dependencies of the final inputs, such as
 694       ;; libunistring, GMP, etc.
 695       (match (vhash-assoc (package-full-name package) name->package)
 696         ((_ . canon)
 697          ;; In general we want CANON, except if we're cross-compiling: CANON
 698          ;; uses explicit inputs, so it is "anchored" in the bootstrapped
 699          ;; process, with dependencies on things that cannot be
 700          ;; cross-compiled.
 701          (if (%current-target-system)
 702              package
 703              canon))
 704         (_ package)))))
 705
 706 \f
 707 ;;;
 708 ;;; GCC toolchain.
 709 ;;;
 710
 711 (define (gcc-toolchain gcc)
 712   "Return a complete toolchain for GCC."
 713   (package
 714     (name "gcc-toolchain")
 715     (version (package-version gcc))
 716     (source #f)
 717     (build-system trivial-build-system)
 718     (arguments
 719      '(#:modules ((guix build union))
 720        #:builder (begin
 721                    (use-modules (ice-9 match)
 722                                 (guix build union))
 723
 724                    (match %build-inputs
 725                      (((names . directories) ...)
 726                       (union-build (assoc-ref %outputs "out")
 727                                    directories)))
 728
 729                    (union-build (assoc-ref %outputs "debug")
 730                                 (list (assoc-ref %build-inputs
 731                                                  "libc-debug"))))))
 732
 733     (native-search-paths (package-native-search-paths gcc))
 734     (search-paths (package-search-paths gcc))
 735
 736     (license (package-license gcc))
 737     (synopsis "Complete GCC tool chain for C/C++ development")
 738     (description
 739      "This package provides a complete GCC tool chain for C/C++ development to
 740 be installed in user profiles.  This includes GCC, as well as libc (headers
 741 and binaries, plus debugging symbols in the 'debug' output), and Binutils.")
 742     (home-page "http://gcc.gnu.org/")
 743     (outputs '("out" "debug"))
 744
 745     ;; The main raison d'être of this "meta-package" is (1) to conveniently
 746     ;; install everything that we need, and (2) to make sure ld-wrapper comes
 747     ;; before Binutils' ld in the user's profile.
 748     (inputs `(("gcc" ,gcc)
 749               ("ld-wrapper" ,(car (assoc-ref %final-inputs "ld-wrapper")))
 750               ("binutils" ,binutils-final)
 751               ("libc" ,glibc-final)
 752               ("libc-debug" ,glibc-final "debug")))))
 753
 754 (define-public gcc-toolchain-4.8
 755   (gcc-toolchain gcc-final))
 756
 757 (define-public gcc-toolchain-4.9
 758   (gcc-toolchain gcc-4.9))
 759
 760 ;;; commencement.scm ends here