summary refs log tree commit diff
path: root/gnu/packages.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-09-29 21:39:39 +0200
committerLudovic Courtès <ludo@gnu.org>2014-09-29 22:03:46 +0200
commit9ffc1c00e55eb7931846dbb3fafcf54716fff57c (patch)
treee4db3cb23fddd47a85febf843a147248710a1179 /gnu/packages.scm
parent34942e959744129d848ed430a595a3f5e887e1dc (diff)
downloadguix-9ffc1c00e55eb7931846dbb3fafcf54716fff57c.tar.gz
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*'.
Diffstat (limited to 'gnu/packages.scm')
-rw-r--r--gnu/packages.scm28
1 files changed, 13 insertions, 15 deletions
diff --git a/gnu/packages.scm b/gnu/packages.scm
index 6d128280cc..281d0d297d 100644
--- a/gnu/packages.scm
+++ b/gnu/packages.scm
@@ -179,22 +179,20 @@ same package twice."
           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