From 9ffc1c00e55eb7931846dbb3fafcf54716fff57c Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Mon, 29 Sep 2014 21:39:39 +0200
Subject: [PATCH] packages: Optimize 'find-packages-by-name' to avoid disk
accesses.
On a profile with 182 entries, "guix package --search-paths" goes from
4.5 seconds down to 0.4 second.
* gnu/packages.scm (find-packages-by-name): Make a name -> package vhash
in a promise; access it with 'vhash-fold*'.
---
gnu/packages.scm | 28 +++++++++++++---------------
1 file changed, 13 insertions(+), 15 deletions(-)
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 6d128280cca..281d0d297d9 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -179,22 +179,20 @@ (define (fold-packages proc init)
vlist-null
(all-package-modules))))
-(define* (find-packages-by-name name #:optional version)
- "Return the list of packages with the given NAME. If VERSION is not #f,
+(define find-packages-by-name
+ (let ((packages (delay
+ (fold-packages (lambda (p r)
+ (vhash-cons (package-name p) p r))
+ vlist-null))))
+ (lambda* (name #:optional version)
+ "Return the list of packages with the given NAME. If VERSION is not #f,
then only return packages whose version is equal to VERSION."
- (define right-package?
- (if version
- (lambda (p)
- (and (string=? (package-name p) name)
- (string=? (package-version p) version)))
- (lambda (p)
- (string=? (package-name p) name))))
-
- (fold-packages (lambda (package result)
- (if (right-package? package)
- (cons package result)
- result))
- '()))
+ (let ((matching (vhash-fold* cons '() name (force packages))))
+ (if version
+ (filter (lambda (package)
+ (string=? (package-version package) version))
+ matching)
+ matching)))))
(define find-newest-available-packages
(memoize
--
GitLab