summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-05-13 09:01:16 +0200
committerLudovic Courtès <ludo@gnu.org>2022-05-18 23:27:03 +0200
commit001f4afd0771bafe1f17e709070b8ef56b5bdfea (patch)
tree41a17201a50681c538ea49fa10ba677f27c1b0af /guix
parentba6ba1a5af4aae36f9abc22ca5e6128f49576c9d (diff)
packages: Use separate package/graft cache.
* guix/packages.scm (%package-graft-cache): New variable. (input-graft): Add (=> %package-graft-cache).
Diffstat (limited to 'guix')
-rw-r--r--guix/packages.scm12
1 files changed, 8 insertions, 4 deletions
diff --git a/guix/packages.scm b/guix/packages.scm
index a79b36d03d..7ee65e9b6b 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1618,6 +1618,11 @@ and return it."
(&package-error
(package package))))))))))))
+(define %package-graft-cache
+ ;; Cache mapping <package> records to <graft> records, for packages that
+ ;; have a replacement.
+ (allocate-store-connection-cache 'package-graft-cache))
+
(define (input-graft system)
"Return a monadic procedure that, given a package with a graft, returns a
graft, and #f otherwise."
@@ -1626,9 +1631,8 @@ graft, and #f otherwise."
(((? package? package) output)
(let ((replacement (package-replacement package)))
(if replacement
- ;; XXX: We should use a separate cache instead of abusing the
- ;; object cache.
- (mcached (mlet %store-monad ((orig (package->derivation package system
+ (mcached eq? (=> %package-graft-cache)
+ (mlet %store-monad ((orig (package->derivation package system
#:graft? #f))
(new (package->derivation replacement system
#:graft? #t)))
@@ -1637,7 +1641,7 @@ graft, and #f otherwise."
(origin-output output)
(replacement new)
(replacement-output output))))
- package 'graft output system)
+ package output system)
(return #f))))
(_
(return #f)))))