gnu/packages/commencement.scm

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