diff mbox series

[bug#68266,5/7] gnu: Memozise cross-mig results.

Message ID e1640e9c30677bb61093dd3b8e409dc0033ebe3a.1704472849.git.mail@cbaines.net
State New
Headers show
Series Memoize packages associated with cross building. | expand

Commit Message

Christopher Baines Jan. 5, 2024, 4:40 p.m. UTC 
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-mig): Move code to
cross-mig/implementation and call it.
(cross-mig/implementation) New procedure.

Change-Id: Iaf2a69c48664d2f0766b9d2f6e981653e0e3c44c
---
 gnu/packages/cross-base.scm | 56 +++++++++++++++++++------------------
 1 file changed, 29 insertions(+), 27 deletions(-)
diff mbox series

Patch

diff --git a/gnu/packages/cross-base.scm b/gnu/packages/cross-base.scm
index f966e2f5ac..6c6c6e7636 100644
--- a/gnu/packages/cross-base.scm
+++ b/gnu/packages/cross-base.scm
@@ -467,37 +467,39 @@  (define* (cross-mig target
                     (xbinutils (cross-binutils target)))
   "Return a cross-mig for TARGET, where TARGET is a GNU triplet.  Use XGCC as
 the base compiler.  Use XBINUTILS as the associated cross-Binutils."
-  (define xgnumach-headers
-    (cross-gnumach-headers target
-                           #:xgcc xgcc
-                           #:xbinutils xbinutils))
-  (package
-    (inherit mig)
-    (name (string-append "mig-cross"))
-    (arguments
-     (substitute-keyword-arguments (package-arguments mig)
-       ((#:configure-flags flags #~'())
-        #~(list #$(string-append "--target=" target)))
-       ((#:tests? _ #f)
-        #f)
-       ((#:phases phases #~%standard-phases)
-        #~(modify-phases #$phases
-            (add-before 'configure 'set-cross-headers-path
-              (lambda* (#:key inputs #:allow-other-keys)
-                (let* ((mach #+xgnumach-headers)
-                       (cpath (string-append mach "/include")))
-                  (for-each (lambda (variable)
-                              (setenv variable cpath))
-                            '#$%gcc-cross-include-paths))))))))
-    (propagated-inputs
-     (list xgnumach-headers))
-    (native-inputs
-     (modify-inputs (package-native-inputs mig)
-       (prepend xgcc xbinutils)))))
+  (cross-mig/implementation target xgcc xbinutils))
 
+(define cross-mig/implementation
+  (mlambda (target xgcc xbinutils)
+    "Return a cross-mig for TARGET, where TARGET is a GNU triplet.  Use XGCC as
+the base compiler.  Use XBINUTILS as the associated cross-Binutils."
+    (define xgnumach-headers
+      (cross-gnumach-headers target
+                             #:xgcc xgcc
+                             #:xbinutils xbinutils))
     (package
+      (inherit mig)
+      (name (string-append "mig-cross"))
       (arguments
+       (substitute-keyword-arguments (package-arguments mig)
+         ((#:configure-flags flags #~'())
+          #~(list #$(string-append "--target=" target)))
+         ((#:tests? _ #f)
+          #f)
+         ((#:phases phases #~%standard-phases)
           #~(modify-phases #$phases
+              (add-before 'configure 'set-cross-headers-path
+                (lambda* (#:key inputs #:allow-other-keys)
+                  (let* ((mach #+xgnumach-headers)
+                         (cpath (string-append mach "/include")))
+                    (for-each (lambda (variable)
+                                (setenv variable cpath))
+                              '#$%gcc-cross-include-paths))))))))
+      (propagated-inputs
+       (list xgnumach-headers))
+      (native-inputs
+       (modify-inputs (package-native-inputs mig)
+         (prepend xgcc xbinutils))))))
 
 (define cross-kernel-headers/implementation
   (mlambda (target linux-headers xgcc xbinutils)