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