01/07: gnu: bootstrap: Memoize 'bootstrap-origin'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 7e1a74da93319a3b413854a052af1e9ccca02bdc
Author: Ludovic Courtès <address@hidden>
Date:   Sun Nov 3 17:59:28 2019 +0100

    gnu: bootstrap: Memoize 'bootstrap-origin'.
    
    * gnu/packages/bootstrap.scm (bootstrap-origin): Memoize with
    'mlambdaq'.  This improves memoization of origins in (gnu packages
    commencement).
---
 gnu/packages/bootstrap.scm | 69 +++++++++++++++++++++++-----------------------
 1 file changed, 35 insertions(+), 34 deletions(-)

diff --git a/gnu/packages/bootstrap.scm b/gnu/packages/bootstrap.scm
index c6e3c69..d6995f1 100644
--- a/gnu/packages/bootstrap.scm
+++ b/gnu/packages/bootstrap.scm
@@ -149,41 +149,42 @@ for system '~a'")
 ;;; Helper procedures.
 ;;;
 
-(define (bootstrap-origin source)
-  "Return a variant of SOURCE, an <origin> instance, whose method uses
+(define bootstrap-origin
+  (mlambdaq (source)
+    "Return a variant of SOURCE, an <origin> instance, whose method uses
 %BOOTSTRAP-GUILE to do its job."
-  (define (boot fetch)
-    (lambda* (url hash-algo hash
-              #:optional name #:key system)
-      (fetch url hash-algo hash name
-             #:guile %bootstrap-guile
-             #:system system)))
-
-  (define %bootstrap-patch-inputs
-    ;; Packages used when an <origin> has a non-empty 'patches' field.
-    `(("tar"   ,%bootstrap-coreutils&co)
-      ("xz"    ,%bootstrap-coreutils&co)
-      ("bzip2" ,%bootstrap-coreutils&co)
-      ("gzip"  ,%bootstrap-coreutils&co)
-      ("patch" ,%bootstrap-coreutils&co)))
-
-  (let ((orig-method (origin-method source)))
-    (if (or (not (null? (origin-patches source)))
-            (origin-snippet source))
-        (origin (inherit source)
-                (method (if (eq? orig-method url-fetch)
-                            (boot url-fetch)
-                            orig-method))
-                (patch-guile %bootstrap-guile)
-                (patch-inputs %bootstrap-patch-inputs)
-
-                ;; Patches can be origins as well, so process them.
-                (patches (map (match-lambda
-                                ((? origin? patch)
-                                 (bootstrap-origin patch))
-                                (patch patch))
-                              (origin-patches source))))
-        source)))
+    (define (boot fetch)
+      (lambda* (url hash-algo hash
+                    #:optional name #:key system)
+        (fetch url hash-algo hash name
+               #:guile %bootstrap-guile
+               #:system system)))
+
+    (define %bootstrap-patch-inputs
+      ;; Packages used when an <origin> has a non-empty 'patches' field.
+      `(("tar"   ,%bootstrap-coreutils&co)
+        ("xz"    ,%bootstrap-coreutils&co)
+        ("bzip2" ,%bootstrap-coreutils&co)
+        ("gzip"  ,%bootstrap-coreutils&co)
+        ("patch" ,%bootstrap-coreutils&co)))
+
+    (let ((orig-method (origin-method source)))
+      (if (or (not (null? (origin-patches source)))
+              (origin-snippet source))
+          (origin (inherit source)
+                  (method (if (eq? orig-method url-fetch)
+                              (boot url-fetch)
+                              orig-method))
+                  (patch-guile %bootstrap-guile)
+                  (patch-inputs %bootstrap-patch-inputs)
+
+                  ;; Patches can be origins as well, so process them.
+                  (patches (map (match-lambda
+                                  ((? origin? patch)
+                                   (bootstrap-origin patch))
+                                  (patch patch))
+                                (origin-patches source))))
+          source))))
 
 (define* (package-from-tarball name source program-to-test description
                                #:key snippet)