scandir: Avoid 'stat' calls on each entry.

* module/ice-9/ftw.scm (scandir): Rewrite in terms of 'readdir'.

1 files changed, 26 insertions, 32 deletions

diff --git a/module/ice-9/ftw.scm b/module/ice-9/ftw.scm
index 133e9c9b5..78636286a 100644
--- a/module/ice-9/ftw.scm
+++ b/module/ice-9/ftw.scm
@@ -1,6 +1,6 @@
 ;;;; ftw.scm --- file system tree walk
 
-;;;; 	Copyright (C) 2002, 2003, 2006, 2011, 2012, 2014 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 2002, 2003, 2006, 2011, 2012, 2014, 2016 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -535,36 +535,30 @@ when FILE-NAME is not readable."
   "Return the list of the names of files contained in directory NAME
 that match predicate SELECT? (by default, all files.)  The returned list
 of file names is sorted according to ENTRY<?, which defaults to
-`string-locale<?'.  Return #f when NAME is unreadable or is not a directory."
-  (define (enter? dir stat result)
-    (and stat (string=? dir name)))
-
-  (define (visit basename result)
-    (if (select? basename)
-        (cons basename result)
-        result))
-
-  (define (leaf name stat result)
-    (and result
-         (visit (basename name) result)))
-
-  (define (down name stat result)
-    (visit "." '()))
-
-  (define (up name stat result)
-    (visit ".." result))
-
-  (define (skip name stat result)
-    ;; All the sub-directories are skipped.
-    (visit (basename name) result))
-
-  (define (error name* stat errno result)
-    (if (string=? name name*)             ; top-level NAME is unreadable
-        result
-        (visit (basename name*) result)))
-
-  (and=> (file-system-fold enter? leaf down up skip error #f name lstat)
-         (lambda (files)
-           (sort files entry<?))))
+`string-locale<?'.  Return #f when NAME is unreadable or is not a
+directory."
+
+  ;; This procedure is implemented in terms of 'readdir' instead of
+  ;; 'file-system-fold' to avoid the extra 'stat' call that the latter
+  ;; makes for each entry.
+
+  (define (opendir* directory)
+    (catch 'system-error
+      (lambda ()
+        (opendir directory))
+      (const #f)))
+
+  (and=> (opendir* name)
+         (lambda (stream)
+           (let loop ((entry  (readdir stream))
+                      (files   '()))
+             (if (eof-object? entry)
+                 (begin
+                   (closedir stream)
+                   (sort files entry<?))
+                 (loop (readdir stream)
+                       (if (select? entry)
+                           (cons entry files)
+                           files)))))))
 
 ;;; ftw.scm ends here