Subject: [PATCH 3/7] gnu: Memozise cross-gcc results.

From: Christopher Baines <[email-masked]>
Date: Fri, 5 Jan 2024 16:40:45 +0000

To ensure that it just returns a single package record for some given
arguments, as this helps to avoid poor performance of the store connection
object cache.

* gnu/packages/cross-base.scm (cross-gcc): Move code to
cross-gcc/implementation and call it.
(cross-gcc/implementation) New procedure.

Change-Id: Ibeafaa4d652fc1d6fd27870b82a309c177b66a05
---
 gnu/packages/cross-base.scm | 183 +++++++++++++++++++-----------------
 1 file changed, 95 insertions(+), 88 deletions(-)

diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index a04e4f9c9e..a4e361b476 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -301,6 +301,97 @@ (define (cross-gcc-search-paths target)
                              ,(string-append target "/include")))))))
              %gcc-cross-include-paths)))
 
+(define cross-gcc/implementation
+  (mlambda (target xgcc xbinutils libc)
+    (package
+      (inherit xgcc)
+      (name (string-append "gcc-cross-"
+                           (if libc "" "sans-libc-")
+                           target))
+      (source
+       (origin
+         (inherit
+          (package-source xgcc))
+         (patches
+          (append
+           (origin-patches (package-source xgcc))
+           (append (cond
+                    ((version>=? (package-version xgcc) "12.0")
+                     (search-patches "gcc-12-cross-environment-variables.patch"
+                                     "gcc-cross-gxx-include-dir.patch"))
+                    ((version>=? (package-version xgcc) "10.0")
+                     (search-patches "gcc-10-cross-environment-variables.patch"
+                                     "gcc-cross-gxx-include-dir.patch"))
+                    ((version>=? (package-version xgcc) "8.0")
+                     (search-patches "gcc-8-cross-environment-variables.patch"))
+                    ((version>=? (package-version xgcc) "6.0")
+                     (search-patches "gcc-7-cross-toolexeclibdir.patch"
+                                     "gcc-6-cross-environment-variables.patch"))
+                    (else
+                     (search-patches "gcc-cross-environment-variables.patch")))
+                   (cross-gcc-patches xgcc target))))
+         (modules '((guix build utils)))
+         (snippet
+          (cross-gcc-snippet target))))
+
+      (outputs '("out" "lib"))
+
+      (arguments
+       `(#:implicit-inputs? #f
+         #:imported-modules ((gnu build cross-toolchain)
+                             ,@%gnu-build-system-modules)
+         #:modules ((guix build gnu-build-system)
+                    (guix build utils)
+                    (gnu build cross-toolchain)
+                    (srfi srfi-1)
+                    (srfi srfi-26)
+                    (ice-9 regex))
+
+         ,@(cross-gcc-arguments target xgcc libc)))
+
+      (native-inputs
+       `(("ld-wrapper-cross" ,(make-ld-wrapper
+                               (string-append "ld-wrapper-" target)
+                               #:target (const target)
+                               #:binutils xbinutils))
+         ("binutils-cross" ,xbinutils)
+
+         ,@(let ((inputs (append (package-inputs xgcc)
+                                 (fold alist-delete (%final-inputs)
+                                       '("libc" "libc:static"))
+
+                                 ;; Call it differently so that the builder can
+                                 ;; check whether the "libc" input is #f.
+                                 `(("libc-native"
+                                    ,@(assoc-ref (%final-inputs) "libc"))
+                                   ("libc-native:static"
+                                    ,@(assoc-ref (%final-inputs)
+                                                 "libc:static"))))))
+             (cond
+              ((target-mingw? target)
+               (if libc
+                   `(,@inputs
+                     ("libc" ,libc))
+                   `(,@inputs
+                     ("mingw-source" ,(package-source mingw-w64)))))
+              ((and libc (target-avr? target))
+               `(,@inputs
+                 ("libc" ,libc)))
+              (libc
+               `(,@inputs
+                 ("libc" ,libc)
+                 ("libc:static" ,libc "static")
+                 ("xkernel-headers"       ;the target headers
+                  ,@(assoc-ref (package-propagated-inputs libc)
+                               "kernel-headers"))))
+              (else inputs)))))
+
+      (inputs '())
+
+      ;; Only search target inputs, not host inputs.
+      (search-paths (cross-gcc-search-paths target))
+      (native-search-paths '()))))
+
 (define* (cross-gcc target
                     #:key
                     (xgcc %xgcc)
@@ -310,94 +401,10 @@ (define* (cross-gcc target
 XGCC as the base compiler.  Use XBINUTILS as the associated cross-Binutils.
 If LIBC is false, then build a GCC that does not target a libc; otherwise,
 target that libc."
-  (package
-    (inherit xgcc)
-    (name (string-append "gcc-cross-"
-                         (if libc "" "sans-libc-")
-                         target))
-    (source
-     (origin
-       (inherit
-        (package-source xgcc))
-       (patches
-        (append
-         (origin-patches (package-source xgcc))
-         (append (cond
-                  ((version>=? (package-version xgcc) "12.0")
-                   (search-patches "gcc-12-cross-environment-variables.patch"
-                                   "gcc-cross-gxx-include-dir.patch"))
-                  ((version>=? (package-version xgcc) "10.0")
-                   (search-patches "gcc-10-cross-environment-variables.patch"
-                                   "gcc-cross-gxx-include-dir.patch"))
-                  ((version>=? (package-version xgcc) "8.0")
-                   (search-patches "gcc-8-cross-environment-variables.patch"))
-                  ((version>=? (package-version xgcc) "6.0")
-                   (search-patches "gcc-7-cross-toolexeclibdir.patch"
-                                   "gcc-6-cross-environment-variables.patch"))
-                  (else
-                   (search-patches "gcc-cross-environment-variables.patch")))
-                 (cross-gcc-patches xgcc target))))
-       (modules '((guix build utils)))
-       (snippet
-        (cross-gcc-snippet target))))
-
-    (outputs '("out" "lib"))
-
-    (arguments
-     `(#:implicit-inputs? #f
-       #:imported-modules ((gnu build cross-toolchain)
-                           ,@%gnu-build-system-modules)
-       #:modules ((guix build gnu-build-system)
-                  (guix build utils)
-                  (gnu build cross-toolchain)
-                  (srfi srfi-1)
-                  (srfi srfi-26)
-                  (ice-9 regex))
-
-       ,@(cross-gcc-arguments target xgcc libc)))
-
-    (native-inputs
-     `(("ld-wrapper-cross" ,(make-ld-wrapper
-                             (string-append "ld-wrapper-" target)
-                             #:target (const target)
-                             #:binutils xbinutils))
-       ("binutils-cross" ,xbinutils)
-
-       ,@(let ((inputs (append (package-inputs xgcc)
-                               (fold alist-delete (%final-inputs)
-                                     '("libc" "libc:static"))
-
-                               ;; Call it differently so that the builder can
-                               ;; check whether the "libc" input is #f.
-                               `(("libc-native"
-                                  ,@(assoc-ref (%final-inputs) "libc"))
-                                 ("libc-native:static"
-                                  ,@(assoc-ref (%final-inputs)
-                                               "libc:static"))))))
-           (cond
-            ((target-mingw? target)
-             (if libc
-                 `(,@inputs
-                   ("libc" ,libc))
-                 `(,@inputs
-                   ("mingw-source" ,(package-source mingw-w64)))))
-            ((and libc (target-avr? target))
-             `(,@inputs
-               ("libc" ,libc)))
-            (libc
-             `(,@inputs
-               ("libc" ,libc)
-               ("libc:static" ,libc "static")
-               ("xkernel-headers"       ;the target headers
-                ,@(assoc-ref (package-propagated-inputs libc)
-                             "kernel-headers"))))
-            (else inputs)))))
-
-    (inputs '())
-
-    ;; Only search target inputs, not host inputs.
-    (search-paths (cross-gcc-search-paths target))
-    (native-search-paths '())))
+  (cross-gcc/implementation target
+                            xgcc
+                            xbinutils
+                            libc))
 
 (define* (cross-kernel-headers . args)
   (if (or (= (length args) 1) (contains-keyword? args))
-- 
2.41.0