summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-01-18 16:14:06 +0100
committerLudovic Courtès <ludo@gnu.org>2018-01-18 16:14:06 +0100
commit8102cf0b37e100f760d25b500cf91ed38928615c (patch)
treea0304a1298275e7dba0dc8298f5085271737a00d
parente80514bc03b003a7ce95d7b55cf33c9f18f9e860 (diff)
downloadguix-8102cf0b37e100f760d25b500cf91ed38928615c.tar.gz
gnu: commencement: Memoize 'linux-libre-headers-boot0'.
Fixes <https://bugs.gnu.org/30155>.

The effect can be seen in the package graph produced by:

  guix graph -e '(@@ (gnu packages commencement) static-bash-for-glibc)'

This reduces the number of "duplicate" nodes in this graph, i.e.,
distinct package objects that correspond to the same derivation (objects
that are not 'eq?' but semantically equal.)

* gnu/packages/commencement.scm (linux-libre-headers-boot0): Make an
'mlambda' instead of a 'lambda'.
(hurd-core-headers-boot0): Ditto.
-rw-r--r--gnu/packages/commencement.scm51
-rw-r--r--guix/packages.scm3
2 files changed, 31 insertions, 23 deletions
diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm
index e21d58e5c9..7286e954c5 100644
--- a/gnu/packages/commencement.scm
+++ b/gnu/packages/commencement.scm
@@ -47,6 +47,7 @@
   #:use-module (guix download)
   #:use-module (guix build-system gnu)
   #:use-module (guix build-system trivial)
+  #:use-module (guix memoization)
   #:use-module (guix utils)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-26)
@@ -371,18 +372,21 @@
                                    (current-source-location)
                                    #:guile %bootstrap-guile))))
 
-(define (linux-libre-headers-boot0)
-  "Return Linux-Libre header files for the bootstrap environment."
-  ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
-  ;; between (gnu packages linux) and this module.
-  (package-with-bootstrap-guile
-   (package (inherit linux-libre-headers)
-     (arguments `(#:guile ,%bootstrap-guile
-                  #:implicit-inputs? #f
-                  ,@(package-arguments linux-libre-headers)))
-     (native-inputs
-      `(("perl" ,perl-boot0)
-        ,@%boot0-inputs)))))
+(define linux-libre-headers-boot0
+  (mlambda ()
+    "Return Linux-Libre header files for the bootstrap environment."
+    ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
+    ;; between (gnu packages linux) and this module.  Additionally, memoize
+    ;; the result to play well with further memoization and code that relies
+    ;; on pointer identity; see <https://bugs.gnu.org/30155>.
+    (package-with-bootstrap-guile
+     (package (inherit linux-libre-headers)
+              (arguments `(#:guile ,%bootstrap-guile
+                           #:implicit-inputs? #f
+                           ,@(package-arguments linux-libre-headers)))
+              (native-inputs
+               `(("perl" ,perl-boot0)
+                 ,@%boot0-inputs))))))
 
 (define gnumach-headers-boot0
   (package-with-bootstrap-guile
@@ -423,18 +427,19 @@
                                    (current-source-location)
                                    #:guile %bootstrap-guile))))
 
-(define (hurd-core-headers-boot0)
-  "Return the Hurd and Mach headers as well as initial Hurd libraries for
+(define hurd-core-headers-boot0
+  (mlambda ()
+    "Return the Hurd and Mach headers as well as initial Hurd libraries for
 the bootstrap environment."
-  (package-with-bootstrap-guile
-   (package (inherit hurd-core-headers)
-            (arguments `(#:guile ,%bootstrap-guile
-                                 ,@(package-arguments hurd-core-headers)))
-            (inputs
-             `(("gnumach-headers" ,gnumach-headers-boot0)
-               ("hurd-headers" ,hurd-headers-boot0)
-               ("hurd-minimal" ,hurd-minimal-boot0)
-               ,@%boot0-inputs)))))
+    (package-with-bootstrap-guile
+     (package (inherit hurd-core-headers)
+              (arguments `(#:guile ,%bootstrap-guile
+                           ,@(package-arguments hurd-core-headers)))
+              (inputs
+               `(("gnumach-headers" ,gnumach-headers-boot0)
+                 ("hurd-headers" ,hurd-headers-boot0)
+                 ("hurd-minimal" ,hurd-minimal-boot0)
+                 ,@%boot0-inputs))))))
 
 (define* (kernel-headers-boot0 #:optional (system (%current-system)))
   (match system
diff --git a/guix/packages.scm b/guix/packages.scm
index 9571565e17..be0a5eeedb 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -620,6 +620,9 @@ itself.
 This is implemented as a breadth-first traversal such that INPUTS is
 preserved, and only duplicate propagated inputs are removed."
   (define (seen? seen item outputs)
+    ;; FIXME: We're using pointer identity here, which is extremely sensitive
+    ;; to memoization in package-producing procedures; see
+    ;; <https://bugs.gnu.org/30155>.
     (match (vhash-assq item seen)
       ((_ . o) (equal? o outputs))
       (_       #f)))