nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

packages: Generalize the 'cached' macro. 

* guix/packages.scm (cache): Rename to...
  (cache!): ... this.  Add 'cache' parameter, and use it.
  (cached): Add a rule to allow the cache to be specified.
This commit is contained in:
Ludovic Courtès 2014-10-18 18:19:08 +02:00
parent ef7516aa04
commit 198d84b70b
1 changed files with 20 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
guix/packages.scm
View File

@ -727,8 +727,8 @@ dependencies are known to build on SYSTEM."
;; Package to derivation-path mapping. ;; Package to derivation-path mapping.
(make-weak-key-hash-table 100)) (make-weak-key-hash-table 100))
(define (cache package system thunk) (define (cache! cache package system thunk)
"Memoize the return values of THUNK as the derivation of PACKAGE on "Memoize in CACHE the return values of THUNK as the derivation of PACKAGE on
SYSTEM." SYSTEM."
;; FIXME: This memoization should be associated with the open store, because ;; FIXME: This memoization should be associated with the open store, because
;; otherwise it breaks when switching to a different store. ;; otherwise it breaks when switching to a different store.
@ -736,26 +736,29 @@ 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 (hashq-set! cache package
`((,system ,@vals) `((,system ,@vals)
,@(or (hashq-ref %derivation-cache package) ,@(or (hashq-ref cache package) '())))
'())))
(apply values vals))) (apply values vals)))
(define-syntax-rule (cached package system body ...) (define-syntax cached
"Memoize the result of BODY for the arguments PACKAGE and SYSTEM. (syntax-rules (=>)
"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 ...)) ((_ (=> cache) package system body ...)
(key system)) (let ((thunk (lambda () body ...))
(match (hashq-ref %derivation-cache package) (key system))
((alist (... ...)) (match (hashq-ref cache package)
(match (assoc-ref alist key) ((alist (... ...))
((vals (... ...)) (match (assoc-ref alist key)
(apply values vals)) ((vals (... ...))
(apply values vals))
(#f
(cache! cache package key thunk))))
(#f (#f
(cache package key thunk)))) (cache! cache package key thunk)))))
(#f ((_ package system body ...)
(cache package key thunk))))) (cached (=> %derivation-cache) package system body ...))))
(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