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:
parent
89ce9fb31b
commit
272473fee4
1 changed files with 23 additions and 29 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue