packages: Improve the package-to-derivation cache.

* guix/packages.scm (cache): Preserve the former values associated with
  PACKAGE.
  (cached): Bind SYSTEM in 'let', to prevent double evaluation.
This commit is contained in:
Ludovic Courtès 2014-10-15 09:22:23 +02:00
parent 3d7d17b318
commit 8dcec91426
1 changed files with 9 additions and 5 deletions

View File

@ -573,22 +573,26 @@ SYSTEM."
;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the ;; Use `hashq-set!' instead of `hash-set!' because `hash' returns the
;; same value for all structs (as of Guile 2.0.6), and because pointer ;; same value for all structs (as of Guile 2.0.6), and because pointer
;; equality is sufficient in practice. ;; equality is sufficient in practice.
(hashq-set! %derivation-cache package `((,system ,@vals))) (hashq-set! %derivation-cache package
`((,system ,@vals)
,@(or (hashq-ref %derivation-cache package)
'())))
(apply values vals))) (apply values vals)))
(define-syntax-rule (cached package system body ...) (define-syntax-rule (cached package system body ...)
"Memoize the result of BODY for the arguments PACKAGE and SYSTEM. "Memoize the result of BODY for the arguments PACKAGE and SYSTEM.
Return the cached result when available." Return the cached result when available."
(let ((thunk (lambda () body ...))) (let ((thunk (lambda () body ...))
(key system))
(match (hashq-ref %derivation-cache package) (match (hashq-ref %derivation-cache package)
((alist (... ...)) ((alist (... ...))
(match (assoc-ref alist system) (match (assoc-ref alist key)
((vals (... ...)) ((vals (... ...))
(apply values vals)) (apply values vals))
(#f (#f
(cache package system thunk)))) (cache package key thunk))))
(#f (#f
(cache package system thunk))))) (cache package key thunk)))))
(define* (expand-input store package input system #:optional cross-system) (define* (expand-input store package input system #:optional cross-system)
"Expand INPUT, an input tuple, such that it contains only references to "Expand INPUT, an input tuple, such that it contains only references to