guile-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Guile-commits] 01/01: scandir: Avoid 'stat' calls on each entry.


From: Ludovic Courtès
Subject: [Guile-commits] 01/01: scandir: Avoid 'stat' calls on each entry.
Date: Fri, 28 Oct 2016 20:17:32 +0000 (UTC)

civodul pushed a commit to branch stable-2.0
in repository guile.

commit 272473fee489ebb7f64b7c893ec262d29aaa981f
Author: Ludovic Courtès <address@hidden>
Date:   Fri Oct 28 22:14:05 2016 +0200

    scandir: Avoid 'stat' calls on each entry.
    
    * module/ice-9/ftw.scm (scandir): Rewrite in terms of 'readdir'.
---
 module/ice-9/ftw.scm |   58 ++++++++++++++++++++++----------------------------
 1 file changed, 26 insertions(+), 32 deletions(-)

diff --git a/module/ice-9/ftw.scm b/module/ice-9/ftw.scm
index 133e9c9..7863628 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



reply via email to

[Prev in Thread] Current Thread [Next in Thread]