distro: Use the bootstrap Guile for the derivation of sources.

* distro/packages/base.scm (bootstrap-origin,
  package-with-bootstrap-guile): New procedures.
  (gnu-make-boot0, diffutils-boot0, findutils-boot0, binutils-boot0,
  gcc-boot0, linux-libre-headers-boot0, glibc-final, bash-final,
  guile-final): Use `package-with-bootstrap-guile'.
  (gcc-boot0-wrapped): Clear `source'.

* guix/ftp.scm (ftp-fetch): Add a #:guile keyword parameter.  Honor it.
* guix/http.scm (http-fetch): Likewise.

distro/packages/base.scm

@@ -1424,6 +1424,46 @@ $out/bin/guile --version~%"
      (home-page #f)
      (license "LGPLv3+"))))
 
+(define (bootstrap-origin source)
+  "Return a variant of SOURCE, an <origin> instance, whose method uses
+%BOOTSTRAP-GUILE to do its job."
+  (define (boot fetch)
+    (lambda* (store url hash-algo hash #:optional name)
+      (fetch store url hash-algo hash
+             #:guile %bootstrap-guile)))
+
+  (let ((orig-method (origin-method source)))
+    (origin (inherit source)
+      (method (cond ((eq? orig-method http-fetch)
+                     (boot http-fetch))
+                    ((eq? orig-method ftp-fetch)
+                     (boot ftp-fetch))
+                    (else orig-method))))))
+
+(define package-with-bootstrap-guile
+  (memoize
+   (lambda (p)
+    "Return a variant of P such that all its origins are fetched with
+%BOOTSTRAP-GUILE."
+    (define rewritten-input
+      (match-lambda
+       ((name (? origin? o))
+        `(,name ,(bootstrap-origin o)))
+       ((name (? package? p) sub-drvs ...)
+        `(,name ,(package-with-bootstrap-guile p) ,@sub-drvs))
+       (x x)))
+
+    (package (inherit p)
+      (source (match (package-source p)
+                ((? origin? o) (bootstrap-origin o))
+                (s s)))
+      (inputs (map rewritten-input
+                   (package-inputs p)))
+      (native-inputs (map rewritten-input
+                          (package-native-inputs p)))
+      (propagated-inputs (map rewritten-input
+                              (package-propagated-inputs p)))))))
+
 (define (default-keyword-arguments args defaults)
   "Return ARGS augmented with any keyword/value from DEFAULTS for
 keywords not already present in ARGS."
@@ -1456,6 +1496,7 @@ previous value of the keyword argument."
           (reverse before)))))))
 
 (define gnu-make-boot0
+  (package-with-bootstrap-guile
    (package (inherit gnu-make)
      (name "make-boot0")
      (location (source-properties->location (current-source-location)))
@@ -1474,9 +1515,10 @@ previous value of the keyword argument."
                                  (copy-file "make"
                                             (string-append bin "/make"))))
                     %standard-phases))))
-    (inputs %bootstrap-inputs)))
+     (inputs %bootstrap-inputs))))
 
 (define diffutils-boot0
+  (package-with-bootstrap-guile
    (let ((p (package-with-explicit-inputs diffutils
                                           `(("make" ,gnu-make-boot0)
                                             ,@%bootstrap-inputs)
@@ -1484,15 +1526,16 @@ previous value of the keyword argument."
      (package (inherit p)
        (location (source-properties->location (current-source-location)))
        (arguments `(#:tests? #f         ; the test suite needs diffutils
-                   ,@(package-arguments p))))))
+                    ,@(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))
+                                 #:guile %bootstrap-guile)))
 
 
 (define %boot0-inputs
@@ -1524,6 +1567,7 @@ identifier SYSTEM."
 ;; 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
@@ -1533,9 +1577,10 @@ identifier SYSTEM."
           ,@(substitute-keyword-arguments (package-arguments binutils)
               ((#:configure-flags cf)
                `(list ,(string-append "--target=" (boot-triplet system))))))))
-    (inputs %boot0-inputs)))
+     (inputs %boot0-inputs))))
 
 (define gcc-boot0
+  (package-with-bootstrap-guile
    (package (inherit gcc-4.7)
      (name "gcc-cross-boot0")
      (arguments
@@ -1624,9 +1669,10 @@ identifier SYSTEM."
                ;; 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)))))
+               ,@(alist-delete "libc" %boot0-inputs))))))
 
 (define linux-libre-headers-boot0
+  (package-with-bootstrap-guile
    (package (inherit linux-libre-headers)
      (arguments `(#:guile ,%bootstrap-guile
                   #:implicit-inputs? #f
@@ -1637,7 +1683,7 @@ identifier SYSTEM."
                                                 (current-source-location)
                                                 #:guile %bootstrap-guile)))
         `(("perl" ,perl)
-         ,@%boot0-inputs)))))
+          ,@%boot0-inputs))))))
 
 (define %boot1-inputs
   ;; 2nd stage inputs.
@@ -1651,6 +1697,7 @@ identifier SYSTEM."
 (define-public glibc-final
   ;; The final libc, "cross-built".  If everything went well, the resulting
   ;; store path has no dependencies.
+  (package-with-bootstrap-guile
    (package (inherit glibc)
      (arguments
       (lambda (system)
@@ -1676,13 +1723,14 @@ identifier SYSTEM."
      (propagated-inputs `(("linux-headers" ,linux-libre-headers-boot0)))
      (inputs `( ;; A native GCC is needed to build `cross-rpcgen'.
                ("native-gcc" ,@(assoc-ref %boot0-inputs "gcc"))
-              ,@%boot1-inputs))))
+               ,@%boot1-inputs)))))
 
 (define gcc-boot0-wrapped
   ;; Make the cross-tools GCC-BOOT0 and BINUTILS-BOOT0 available under the
   ;; non-cross names.
   (package (inherit gcc-4.7)
     (name (string-append (package-name gcc-boot0) "-wrapped"))
+    (source #f)
     (build-system trivial-build-system)
     (arguments
      (lambda (system)
@@ -1821,16 +1869,18 @@ store.")
     ,@(alist-delete "gcc" %boot2-inputs)))
 
 (define-public bash-final
+  (package-with-bootstrap-guile
    (package-with-explicit-inputs bash %boot3-inputs
                                  (current-source-location)
-                                #:guile %bootstrap-guile))
+                                 #:guile %bootstrap-guile)))
 
 (define-public guile-final
+  (package-with-bootstrap-guile
    (package-with-explicit-inputs guile-2.0
                                  `(("bash" ,bash-final)
                                    ,@(alist-delete "bash" %boot3-inputs))
                                  (current-source-location)
-                                #:guile %bootstrap-guile))
+                                 #:guile %bootstrap-guile)))
 
 (define-public ld-wrapper
   ;; The final `ld' wrapper, which uses the final Guile.

guix/ftp.scm

@@ -17,7 +17,10 @@
 ;;; along with Guix.  If not, see <ftp://www.gnu.org/licenses/>.
 
 (define-module (guix ftp)
+  #:use-module (ice-9 match)
   #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module ((guix store) #:select (derivation-path?))
   #:use-module (guix utils)
   #:export (ftp-fetch))
 
@@ -29,7 +32,7 @@
 
 (define* (ftp-fetch store url hash-algo hash
                     #:optional name
-                    #:key (system (%current-system)))
+                    #:key (system (%current-system)) guile)
   "Return the path of a fixed-output derivation in STORE that fetches URL,
 which is expected to have hash HASH of type HASH-ALGO (a symbol).  By
 default, the file name is the base name of URL; optionally, NAME can specify
@@ -39,11 +42,24 @@ a different file name."
        (use-modules (guix build ftp))
        (ftp-fetch ,url %output)))
 
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system))
+      ((and (? string?) (? derivation-path?))
+       guile)
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(distro packages base)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system)))))
+
   (build-expression->derivation store (or name (basename url)) system
                                 builder '()
                                 #:hash-algo hash-algo
                                 #:hash hash
                                 #:modules '((guix ftp-client)
                                             (guix build ftp)
-                                            (guix build utils))))
+                                            (guix build utils))
+                                #:guile-for-build guile-for-build))
+
 ;;; ftp.scm ends here

guix/http.scm

@@ -17,7 +17,10 @@
 ;;; along with Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix http)
+  #:use-module (ice-9 match)
   #:use-module (guix derivations)
+  #:use-module (guix packages)
+  #:use-module ((guix store) #:select (derivation-path?))
   #:use-module (guix utils)
   #:export (http-fetch))
 
@@ -29,7 +32,7 @@
 
 (define* (http-fetch store url hash-algo hash
                      #:optional name
-                     #:key (system (%current-system)))
+                     #:key (system (%current-system)) guile)
   "Return the path of a fixed-output derivation in STORE that fetches URL,
 which is expected to have hash HASH of type HASH-ALGO (a symbol).  By
 default, the file name is the base name of URL; optionally, NAME can specify
@@ -39,8 +42,22 @@ a different file name."
        (use-modules (guix build http))
        (http-fetch ,url %output)))
 
+  (define guile-for-build
+    (match guile
+      ((? package?)
+       (package-derivation store guile system))
+      ((and (? string?) (? derivation-path?))
+       guile)
+      (#f                                         ; the default
+       (let* ((distro (resolve-interface '(distro packages base)))
+              (guile  (module-ref distro 'guile-final)))
+         (package-derivation store guile system)))))
+
   (build-expression->derivation store (or name (basename url)) system
                                 builder '()
                                 #:hash-algo hash-algo
                                 #:hash hash
-                                #:modules '((guix build http))))
+                                #:modules '((guix build http))
+                                #:guile-for-build guile-for-build))
+
+;;; http.scm ends here