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

packages: Turn 'cache!' into a single-value-return cache. 

* guix/packages.scm (cache!): Assume THUNK returns a single value.
(cached): Likewise.
This commit is contained in:
Ludovic Courtès 2017-06-25 16:31:33 +02:00
parent b334674fe5
commit 0b1be8fd57
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 5 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
guix/packages.scm
View File

@ -870,14 +870,14 @@ OVERRIDES."
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.
(let ((vals (call-with-values thunk list))) (let ((result (thunk)))
;; 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! cache package (hashq-set! cache package
`((,system ,@vals) `((,system . ,result)
,@(or (hashq-ref cache package) '()))) ,@(or (hashq-ref cache package) '())))
(apply values vals))) result))
(define-syntax cached (define-syntax cached
(syntax-rules (=>) (syntax-rules (=>)
@ -889,10 +889,8 @@ Return the cached result when available."
(match (hashq-ref cache package) (match (hashq-ref cache package)
((alist (... ...)) ((alist (... ...))
(match (assoc-ref alist key) (match (assoc-ref alist key)
((vals (... ...)) (#f (cache! cache package key thunk))
(apply values vals)) (value value)))
(#f
(cache! cache package key thunk))))
(#f (#f
(cache! cache package key thunk))))) (cache! cache package key thunk)))))
((_ package system body ...) ((_ package system body ...)