me
/
guix
Archived
1
0
Fork 0
Code

packages: Use separate package/graft cache. 

* guix/packages.scm (%package-graft-cache): New variable.
(input-graft): Add (=> %package-graft-cache).
Ludovic Courtès 2022-05-13 09:01:16 +02:00
parent ba6ba1a5af
commit 001f4afd07
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 8 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
guix/packages.scm
View File

@ -1618,6 +1618,11 @@ and return it."
(&package-error (&package-error
(package package)))))))))))) (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) (define (input-graft system)
"Return a monadic procedure that, given a package with a graft, returns a "Return a monadic procedure that, given a package with a graft, returns a
graft, and #f otherwise." graft, and #f otherwise."
@ -1626,9 +1631,8 @@ graft, and #f otherwise."
(((? package? package) output) (((? package? package) output)
(let ((replacement (package-replacement package))) (let ((replacement (package-replacement package)))
(if replacement (if replacement
;; XXX: We should use a separate cache instead of abusing the (mcached eq? (=> %package-graft-cache)
;; object cache. (mlet %store-monad ((orig (package->derivation package system
(mcached (mlet %store-monad ((orig (package->derivation package system
#:graft? #f)) #:graft? #f))
(new (package->derivation replacement system (new (package->derivation replacement system
#:graft? #t))) #:graft? #t)))
@ -1637,7 +1641,7 @@ graft, and #f otherwise."
(origin-output output) (origin-output output)
(replacement new) (replacement new)
(replacement-output output)))) (replacement-output output))))
package 'graft output system) package output system)
(return #f)))) (return #f))))
(_ (_
(return #f))))) (return #f)))))