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.
This commit is contained in:
Ludovic Courtès 2018-01-18 16:14:06 +01:00
parent e80514bc03
commit 8102cf0b37
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 31 additions and 23 deletions

View File

@ -47,6 +47,7 @@
#:use-module (guix download) #:use-module (guix download)
#:use-module (guix build-system gnu) #:use-module (guix build-system gnu)
#:use-module (guix build-system trivial) #:use-module (guix build-system trivial)
#:use-module (guix memoization)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
@ -371,18 +372,21 @@
(current-source-location) (current-source-location)
#:guile %bootstrap-guile)))) #:guile %bootstrap-guile))))
(define (linux-libre-headers-boot0) (define linux-libre-headers-boot0
"Return Linux-Libre header files for the bootstrap environment." (mlambda ()
;; Note: this is wrapped in a thunk to nicely handle circular dependencies "Return Linux-Libre header files for the bootstrap environment."
;; between (gnu packages linux) and this module. ;; Note: this is wrapped in a thunk to nicely handle circular dependencies
(package-with-bootstrap-guile ;; between (gnu packages linux) and this module. Additionally, memoize
(package (inherit linux-libre-headers) ;; the result to play well with further memoization and code that relies
(arguments `(#:guile ,%bootstrap-guile ;; on pointer identity; see <https://bugs.gnu.org/30155>.
#:implicit-inputs? #f (package-with-bootstrap-guile
,@(package-arguments linux-libre-headers))) (package (inherit linux-libre-headers)
(native-inputs (arguments `(#:guile ,%bootstrap-guile
`(("perl" ,perl-boot0) #:implicit-inputs? #f
,@%boot0-inputs))))) ,@(package-arguments linux-libre-headers)))
(native-inputs
`(("perl" ,perl-boot0)
,@%boot0-inputs))))))
(define gnumach-headers-boot0 (define gnumach-headers-boot0
(package-with-bootstrap-guile (package-with-bootstrap-guile
@ -423,18 +427,19 @@
(current-source-location) (current-source-location)
#:guile %bootstrap-guile)))) #:guile %bootstrap-guile))))
(define (hurd-core-headers-boot0) (define hurd-core-headers-boot0
"Return the Hurd and Mach headers as well as initial Hurd libraries for (mlambda ()
"Return the Hurd and Mach headers as well as initial Hurd libraries for
the bootstrap environment." the bootstrap environment."
(package-with-bootstrap-guile (package-with-bootstrap-guile
(package (inherit hurd-core-headers) (package (inherit hurd-core-headers)
(arguments `(#:guile ,%bootstrap-guile (arguments `(#:guile ,%bootstrap-guile
,@(package-arguments hurd-core-headers))) ,@(package-arguments hurd-core-headers)))
(inputs (inputs
`(("gnumach-headers" ,gnumach-headers-boot0) `(("gnumach-headers" ,gnumach-headers-boot0)
("hurd-headers" ,hurd-headers-boot0) ("hurd-headers" ,hurd-headers-boot0)
("hurd-minimal" ,hurd-minimal-boot0) ("hurd-minimal" ,hurd-minimal-boot0)
,@%boot0-inputs))))) ,@%boot0-inputs))))))
(define* (kernel-headers-boot0 #:optional (system (%current-system))) (define* (kernel-headers-boot0 #:optional (system (%current-system)))
(match system (match system

View File

@ -620,6 +620,9 @@ itself.
This is implemented as a breadth-first traversal such that INPUTS is This is implemented as a breadth-first traversal such that INPUTS is
preserved, and only duplicate propagated inputs are removed." preserved, and only duplicate propagated inputs are removed."
(define (seen? seen item outputs) (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) (match (vhash-assq item seen)
((_ . o) (equal? o outputs)) ((_ . o) (equal? o outputs))
(_ #f))) (_ #f)))