02/03: discovery: Rewrite 'scheme-files' using 'scandir*'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d27cc3bfaafe6b5b0831e88afb1c46311d382a0b
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jun 16 12:07:26 2017 +0200

    discovery: Rewrite 'scheme-files' using 'scandir*'.
    
    On a command like:
    
      guix environment --ad-hoc coreutils -- true
    
    this reduces the number of 'stat' calls from 14.1K to 9.7K on my
    setup (previously each getdents(2) call would be followed by one stat(2)
    call per entry).
    
    * guix/discovery.scm (scheme-files): Rewrite using 'scandir*'.
---
 guix/discovery.scm | 50 +++++++++++++++++++++++++++++---------------------
 1 file changed, 29 insertions(+), 21 deletions(-)

diff --git a/guix/discovery.scm b/guix/discovery.scm
index 319ba7c..6cf8d6d 100644
--- a/guix/discovery.scm
+++ b/guix/discovery.scm
@@ -19,6 +19,7 @@
 (define-module (guix discovery)
   #:use-module (guix ui)
   #:use-module (guix combinators)
+  #:use-module (guix build syscalls)
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:use-module (ice-9 vlist)
@@ -38,28 +39,35 @@
 (define* (scheme-files directory)
   "Return the list of Scheme files found under DIRECTORY, recursively.  The
 returned list is sorted in alphabetical order."
+  (define (entry-type name properties)
+    (match (assoc-ref properties 'type)
+      ('unknown
+       (stat:type (lstat name)))
+      ((? symbol? type)
+       type)))
 
-  ;; Sort entries so that 'fold-packages' works in a deterministic fashion
-  ;; regardless of details of the underlying file system.
-  (sort (file-system-fold (const #t)                 ;enter?
-                          (lambda (path stat result) ;leaf
-                            (if (string-suffix? ".scm" path)
-                                (cons path result)
-                                result))
-                          (lambda (path stat result) ;down
-                            result)
-                          (lambda (path stat result) ;up
-                            result)
-                          (const #f)                 ;skip
-                          (lambda (path stat errno result)
-                            (unless (= ENOENT errno)
-                              (warning (G_ "cannot access `~a': ~a~%")
-                                       path (strerror errno)))
-                            result)
-                          '()
-                          directory
-                          stat)
-        string<?))
+  ;; Use 'scandir*' so we can avoid an extra 'lstat' for each entry, as
+  ;; opposed to Guile's 'scandir' or 'file-system-fold'.
+  (fold-right (lambda (entry result)
+                (match entry
+                  (("." . _)
+                   result)
+                  ((".." . _)
+                   result)
+                  ((name . properties)
+                   (let ((absolute (string-append directory "/" name)))
+                     (case (entry-type absolute properties)
+                       ((directory)
+                        (append (scheme-files absolute) result))
+                       ((regular symlink)
+                        ;; XXX: We don't recurse if we find a symlink.
+                        (if (string-suffix? ".scm" name)
+                            (cons absolute result)
+                            result))
+                       (else
+                        result))))))
+              '()
+              (scandir* directory)))
 
 (define file-name->module-name
   (let ((not-slash (char-set-complement (char-set #\/))))