rekahsoft
/
guix
1
1
Fork 0
Code Issues Pull Requests Releases Wiki Activity

packages: 'package->bag' keys cache by replacement. 

* guix/packages.scm (package->bag): When GRAFT? is true, use PACKAGE's
replacement as the cache key.  Remove GRAFT? from the list of
secondary cache keys.
This commit is contained in:
Ludovic Courtès 2020-03-29 16:14:14 +02:00
parent 18c8a4396b
commit 9f78552996
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 33 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
guix/packages.scm
View File

@ -1029,39 +1029,39 @@ information in exceptions."
#:key (graft? (%graft?)))
"Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
and return it."
(cached (=> %bag-cache)
package (list system target graft?)
;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked
;; field values can refer to it.
(parameterize ((%current-system system)
(%current-target-system target))
(match (if graft?
(or (package-replacement package) package)
package)
((and self
($ <package> name version source build-system
args inputs propagated-inputs native-inputs
outputs))
;; Even though we prefer to use "@" to separate the package
;; name from the package version in various user-facing parts
;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
;; prohibits the use of "@", so use "-" instead.
(or (make-bag build-system (string-append name "-" version)
#:system system
#:target target
#:source source
#:inputs (append (inputs self)
(propagated-inputs self))
#:outputs outputs
#:native-inputs (native-inputs self)
#:arguments (args self))
(raise (if target
(condition
(&package-cross-build-system-error
(package package)))
(condition
(&package-error
(package package)))))))))))
(let ((package (or (and graft? (package-replacement package))
package)))
(cached (=> %bag-cache)
package (list system target)
;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked
;; field values can refer to it.
(parameterize ((%current-system system)
(%current-target-system target))
(match package
((and self
($ <package> name version source build-system
args inputs propagated-inputs native-inputs
outputs))
;; Even though we prefer to use "@" to separate the package
;; name from the package version in various user-facing parts
;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
;; prohibits the use of "@", so use "-" instead.
(or (make-bag build-system (string-append name "-" version)
#:system system
#:target target
#:source source
#:inputs (append (inputs self)
(propagated-inputs self))
#:outputs outputs
#:native-inputs (native-inputs self)
#:arguments (args self))
(raise (if target
(condition
(&package-cross-build-system-error
(package package)))
(condition
(&package-error
(package package))))))))))))
(define %graft-cache
;; 'eq?' cache mapping package objects to a graft corresponding to their