diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2020-03-29 16:14:14 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2020-03-29 23:14:28 +0200 |
| commit | 9f7855299604c496d2d2f12041974e33baa0d63b (patch) | |
| tree | e68a0a480be43f5d2a8675227a3f0d04761e6e47 /guix/packages.scm | |
| parent | 18c8a4396bdb9e9c842ef386a2aecfac38943112 (diff) | |
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.
Diffstat (limited to 'guix/packages.scm')
| -rw-r--r-- | guix/packages.scm | 66 |
1 files changed, 33 insertions, 33 deletions
diff --git a/guix/packages.scm b/guix/packages.scm index e2578101ee..04d9b7824c 100644 --- a/guix/packages.scm +++ b/guix/packages.scm @@ -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 |