1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-28 16:00:22 +02:00

scandir: Avoid 'stat' calls on each entry.

* module/ice-9/ftw.scm (scandir): Rewrite in terms of 'readdir'.
This commit is contained in:
Ludovic Courtès 2016-10-28 22:14:05 +02:00
parent 89ce9fb31b
commit 272473fee4

View file

@ -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)))
`string-locale<?'. Return #f when NAME is unreadable or is not a
directory."
(define (visit basename result)
(if (select? basename)
(cons basename result)
result))
;; 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 (leaf name stat result)
(and result
(visit (basename name) result)))
(define (opendir* directory)
(catch 'system-error
(lambda ()
(opendir directory))
(const #f)))
(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<?))))
(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