kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

inferior: Memoize entries in 'inferior-package->manifest-entry'.

Browse Source 
Fixes a performance issue as reported by Ricardo Wurmus
in <https://bugs.gnu.org/46100>.

* guix/inferior.scm (inferior-package->manifest-entry): Remove #:parent parameter.
[cache]: New variable.
[memoized]: New macro.
[loop]: New procedure.
This commit is contained in:
Ludovic Courtès 2021-01-27 23:03:06 +01:00
parent c45a821a63
commit 0f20b3fa20
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 42 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
guix/inferior.scm
View File

@ -642,29 +642,45 @@ failing when GUIX is too old and lacks the 'guix repl' command."
(define* (inferior-package->manifest-entry package
#:optional (output "out")
#:key (parent (delay #f))
(properties '()))
#:key (properties '()))
"Return a manifest entry for the OUTPUT of package PACKAGE."
;; For each dependency, keep a promise pointing to its "parent" entry.
(letrec* ((deps (map (match-lambda
((label package)
(inferior-package->manifest-entry package
#:parent (delay entry)))
((label package output)
(inferior-package->manifest-entry package output
#:parent (delay entry))))
(inferior-package-propagated-inputs package)))
(entry (manifest-entry
(name (inferior-package-name package))
(version (inferior-package-version package))
(output output)
(item package)
(dependencies (delete-duplicates deps))
(search-paths
(inferior-package-transitive-native-search-paths package))
(parent parent)
(properties properties))))
entry))
(define cache
(make-hash-table))
(define-syntax-rule (memoized package output exp)
;; Memoize the entry returned by EXP for PACKAGE/OUTPUT. This is
;; important as the same package may be traversed many times through
;; propagated inputs, and querying the inferior is costly. Use
;; 'hash'/'equal?', which is okay since <inferior-package> is simple.
(let ((compute (lambda () exp))
(key (cons package output)))
(or (hash-ref cache key)
(let ((result (compute)))
(hash-set! cache key result)
result))))
(let loop ((package package)
(output output)
(parent (delay #f)))
(memoized package output
;; For each dependency, keep a promise pointing to its "parent" entry.
(letrec* ((deps (map (match-lambda
((label package)
(loop package "out" (delay entry)))
((label package output)
(loop package output (delay entry))))
(inferior-package-propagated-inputs package)))
(entry (manifest-entry
(name (inferior-package-name package))
(version (inferior-package-version package))
(output output)
(item package)
(dependencies (delete-duplicates deps))
(search-paths
(inferior-package-transitive-native-search-paths package))
(parent parent)
(properties properties))))
entry))))
;;;
@ -750,3 +766,7 @@ This is a convenience procedure that people may use in manifests passed to
#:cache-directory cache-directory
#:ttl ttl)))
(open-inferior cached))
;;; Local Variables:
;;; eval: (put 'memoized 'scheme-indent-function 1)
;;; End: