Commit 13aadfc0 authored by Ludovic Courtès's avatar Ludovic Courtès
Browse files

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.
parent 69bd3db1
......@@ -580,8 +580,8 @@ (define %derivation-cache
;; Package to derivation-path mapping.
(make-weak-key-hash-table 100))
(define (cache package system thunk)
"Memoize the return values of THUNK as the derivation of PACKAGE on
(define (cache! cache package system thunk)
"Memoize in CACHE the return values of THUNK as the derivation of PACKAGE on
SYSTEM."
;; FIXME: This memoization should be associated with the open store, because
;; otherwise it breaks when switching to a different store.
......@@ -589,26 +589,29 @@ (define (cache package system thunk)
;; 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
;; equality is sufficient in practice.
(hashq-set! %derivation-cache package
(hashq-set! cache package
`((,system ,@vals)
,@(or (hashq-ref %derivation-cache package)
'())))
,@(or (hashq-ref cache package) '())))
(apply values vals)))
(define-syntax-rule (cached package system body ...)
"Memoize the result of BODY for the arguments PACKAGE and SYSTEM.
(define-syntax cached
(syntax-rules (=>)
"Memoize the result of BODY for the arguments PACKAGE and SYSTEM.
Return the cached result when available."
(let ((thunk (lambda () body ...))
(key system))
(match (hashq-ref %derivation-cache package)
((alist (... ...))
(match (assoc-ref alist key)
((vals (... ...))
(apply values vals))
((_ (=> cache) package system body ...)
(let ((thunk (lambda () body ...))
(key system))
(match (hashq-ref cache package)
((alist (... ...))
(match (assoc-ref alist key)
((vals (... ...))
(apply values vals))
(#f
(cache! cache package key thunk))))
(#f
(cache package key thunk))))
(#f
(cache package key thunk)))))
(cache! cache package key thunk)))))
((_ package system body ...)
(cached (=> %derivation-cache) package system body ...))))
(define* (expand-input store package input system #:optional cross-system)
"Expand INPUT, an input tuple, such that it contains only references to
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment