civodul pushed a commit to branch stable-2.0 in repository guile. commit 272473fee489ebb7f64b7c893ec262d29aaa981f Author: Ludovic Courtès <l...@gnu.org> 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