store: 'references/substitutes' caches its results.

* guix/store.scm (%reference-cache): New variable.
(references/substitutes): Use it.
This commit is contained in:
Ludovic Courtès 2016-03-14 16:53:38 +01:00
parent 3667bb6cb0
commit f09aea1b58

View File

@ -726,14 +726,23 @@ error if there is no such root."
"Return the list of references of PATH." "Return the list of references of PATH."
store-path-list)) store-path-list))
(define %reference-cache
;; Brute-force cache mapping store items to their list of references.
;; Caching matters because when building a profile in the presence of
;; grafts, we keep calling 'graft-derivation', which in turn calls
;; 'references/substitutes' many times with the same arguments. Ideally we
;; would use a cache associated with the daemon connection instead (XXX).
(make-hash-table 100))
(define (references/substitutes store items) (define (references/substitutes store items)
"Return the list of list of references of ITEMS; the result has the same "Return the list of list of references of ITEMS; the result has the same
length as ITEMS. Query substitute information for any item missing from the length as ITEMS. Query substitute information for any item missing from the
store at once. Raise a '&nix-protocol-error' exception if reference store at once. Raise a '&nix-protocol-error' exception if reference
information for one of ITEMS is missing." information for one of ITEMS is missing."
(let* ((local-refs (map (lambda (item) (let* ((local-refs (map (lambda (item)
(guard (c ((nix-protocol-error? c) #f)) (or (hash-ref %reference-cache item)
(references store item))) (guard (c ((nix-protocol-error? c) #f))
(references store item))))
items)) items))
(missing (fold-right (lambda (item local-ref result) (missing (fold-right (lambda (item local-ref result)
(if local-ref (if local-ref
@ -757,7 +766,10 @@ the list of references")
(result '())) (result '()))
(match items (match items
(() (()
(reverse result)) (let ((result (reverse result)))
(for-each (cut hash-set! %reference-cache <> <>)
items result)
result))
((item items ...) ((item items ...)
(match local-refs (match local-refs
((#f tail ...) ((#f tail ...)