bug#60056: [PATCH RFC 3/6] build-systems: gnu: Infer cross-toolchain from native-inputs components.

[Maxim Cournoyer]

This enables a user to override the base components used to build the cross
toolchain, which allows for example to use an older version of GCC.

* guix/build-system/gnu.scm (standard-cross-packages): New GCC, BINUTILS,
LIBC and LINUX-LIBRE-HEADERS keyword arguments.  Update doc.  Rename
implementation to...
(%standard-cross-packages): ... this procedure, which is extended to support
the above new arguments.  Compute the cross toolchain components taking these
arguments into account.
(lower): Apply the GCC, BINUTILS, LIBC, and LINUX-LIBRE-HEADERS packages found
in the native inputs to standard-cross-packages, when available.
---
 guix/build-system/gnu2.scm | 111 +++++++++++++++++++++++++++----------
 1 file changed, 83 insertions(+), 28 deletions(-)

diff --git a/guix/build-system/gnu2.scm b/guix/build-system/gnu2.scm
index 95fce76714..5b0780d315 100644
--- a/guix/build-system/gnu2.scm
+++ b/guix/build-system/gnu2.scm
@@ -68,7 +68,7 @@ (define* (package-with-explicit-inputs/deprecated p inputs
 temporarily instead of memoizing across all transformations where INPUTS is
 the same.
 
-Rewrite P, which is assumed to use GNU-BUILD-SYSTEM2, to take INPUTS and
+Rewrite P, which is assumed to use GNU-BUILD-SYSTEM, to take INPUTS and
 NATIVE-INPUTS as explicit inputs instead of the implicit default, and return
 it.  INPUTS and NATIVE-INPUTS can be either input lists or thunks; in the
 latter case, they will be called in a context where the `%current-system' and
@@ -287,9 +287,21 @@ (define private-keywords
       #:implicit-inputs? #:implicit-cross-inputs?
       ,@(if target '() '(#:target))))
 
+  (define standard-cross-packages-args
+    ;; Since the packages used to customize the toolchain are intended to be
+    ;; provided manually at the package level, their actual package *name*
+    ;; must be expected, e.g. "glibc" rather than "libc".
+    (list #:gcc (and=> (assoc-ref native-inputs "gcc") car)
+          #:binutils (and=> (assoc-ref native-inputs "binutils") car)
+          #:libc (and=> (assoc-ref native-inputs "glibc") car)
+          #:linux-libre-headers
+          (and=> (assoc-ref native-inputs
+                            "linux-libre-headers") car)))
+
   (bag
     (name name)
-    (system system) (target target)
+    (system system)
+    (target target)
     (build-inputs `(,@(if source
                           `(("source" ,source))
                           '())
@@ -301,7 +313,8 @@ (define private-keywords
                     ;; <https://bugs.gnu.org/30756>.
                     ,@(if target '() inputs)
                     ,@(if (and target implicit-cross-inputs?)
-                          (standard-cross-packages2 target 'host)
+                          (apply standard-cross-packages2
+                                 target 'host standard-cross-packages-args)
                           '())
                     ,@(if implicit-inputs?
                           (standard-packages2)
@@ -314,7 +327,8 @@ (define private-keywords
     ;; 'cross-libc' (built with 'gnu-build'), whereas all the other packages
     ;; would use a target variant (built with 'gnu-cross-build'.)
     (target-inputs (if (and target implicit-cross-inputs?)
-                       (standard-cross-packages2 target 'target)
+                       (apply standard-cross-packages2
+                              target 'target standard-cross-packages-args)
                        '()))
     (outputs (if strip-binaries?
                  outputs
@@ -439,34 +453,75 @@ (define builder
 ;;; Cross-compilation.
 ;;;
 
-(define standard-cross-packages2
-  (mlambda (target kind)
-    "Return the list of name/package tuples to cross-build for TARGET.  KIND
-is one of `host' or `target'."
-    (let* ((cross     (resolve-interface '(gnu packages cross-base)))
-           (gcc       (module-ref cross 'cross-gcc))
-           (binutils  (module-ref cross 'cross-binutils))
-           (libc      (module-ref cross 'cross-libc)))
+(define* (standard-cross-packages2 target kind
+                                   #:key gcc binutils libc linux-libre-headers)
+  "Return the list of name/package tuples to cross-build for TARGET.  KIND is
+one of `host' or `target'.  GCC, BINUTILS, LIBC and LINUX-LIBRE-HEADERS are
+the packages to use to build the cross toolchain.  Unless specified, the
+defaults of the CROSS-GCC, CROSS-BINUTILS, CROSS-LIBC and CROSS-KERNEL-HEADERS
+procedures from (gnu packages cross-base) are used."
+  (%standard-cross-packages2 target kind gcc binutils libc 
linux-libre-headers))
+
+(define %standard-cross-packages2
+  (mlambda (target kind gcc binutils libc linux-libre-headers)
+    (let* ((cross-base      (resolve-interface '(gnu packages cross-base)))
+           (cross-gcc       (module-ref cross-base 'cross-gcc))
+           (cross-binutils  (module-ref cross-base 'cross-binutils))
+           (cross-libc      (module-ref cross-base 'cross-libc))
+           (cross-kernel-headers (module-ref cross-base 'cross-kernel-headers))
+           (xbinutils       (if binutils
+                                (cross-binutils target #:binutils binutils)
+                                (cross-binutils target)))
+           (cross-gcc-args/no-libc `(,target
+                                     ,@(if gcc
+                                           `(#:xgcc ,gcc)
+                                           '())
+                                     ,@(if binutils
+                                           `(#:xbinutils ,xbinutils)
+                                           '())))
+           (xgcc/no-libc    (apply cross-gcc cross-gcc-args/no-libc))
+           (cross-libc-args `(,target
+                              ,@(if libc
+                                    `(#:libc ,libc)
+                                    '())
+                              ,@(if gcc
+                                    `(#:xgcc ,xgcc/no-libc)
+                                    '())
+                              ,@(if binutils
+                                    `(#:xbinutils ,xbinutils)
+                                    '())
+                              ,@(if linux-libre-headers
+                                    `(#:xheaders
+                                      ,(apply cross-kernel-headers
+                                              `(,target
+                                                ,@(if linux-libre-headers
+                                                      `(#:linux-headers
+                                                        ,linux-libre-headers))
+                                                ,@(if gcc
+                                                      `(#:xgcc ,xgcc/no-libc)
+                                                      '())
+                                                ,@(if binutils
+                                                      `(#:xbinutils ,xbinutils)
+                                                      '()))))
+                                    '())))
+           (xlibc           (apply cross-libc cross-libc-args))
+           (xgcc            (apply cross-gcc
+                                   `(,@cross-gcc-args/no-libc #:libc ,xlibc))))
       (case kind
         ((host)
          ;; Cross-GCC appears once here, so that it's in $PATH...
-         `(("cross-gcc" ,(gcc target
-                              #:xbinutils (binutils target)
-                              #:libc (libc target)))
-           ("cross-binutils" ,(binutils target))))
+         `(("cross-gcc" ,xgcc)
+           ("cross-binutils" ,xbinutils)))
         ((target)
-         (let ((libc (libc target)))
-           ;; ... and once here, so that libstdc++ & co. are in
-           ;; CROSS_CPLUS_INCLUDE_PATH, etc.
-           `(("cross-gcc" ,(gcc target
-                                #:xbinutils (binutils target)
-                                #:libc libc))
-             ("cross-libc" ,libc)
-
-             ;; MinGW's libc doesn't have a "static" output.
-             ,@(if (member "static" (package-outputs libc))
-                   `(("cross-libc:static" ,libc "static"))
-                   '()))))))))
+         ;; ... and once here, so that libstdc++ & co. are in
+         ;; CROSS_CPLUS_INCLUDE_PATH, etc.
+         `(("cross-gcc" ,xgcc)
+           ("cross-libc" ,xlibc)
+
+           ;; MinGW's libc doesn't have a "static" output.
+           ,@(if (member "static" (package-outputs xlibc))
+                 `(("cross-libc:static" ,xlibc "static"))
+                 '())))))))
 
 (define* (gnu-cross-build name
                           #:key
-- 
2.38.1