ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

discovery: Rewrite 'scheme-files' using 'scandir*'.

Browse source 
On a command like:

  guix environment --ad-hoc coreutils -- true

this reduces the number of 'stat' calls from 14.1K to 9.7K on my
setup (previously each getdents(2) call would be followed by one stat(2)
call per entry).

* guix/discovery.scm (scheme-files): Rewrite using 'scandir*'.
This commit is contained in:
Ludovic Courtès 2017-06-16 12:07:26 +02:00 committed by Ludovic Courtès
parent fa73c19373
commit d27cc3bfaa
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 21 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

50
guix/discovery.scm
View file

@ -19,6 +19,7 @@
(define-module (guix discovery)
#:use-module (guix ui)
#:use-module (guix combinators)
#:use-module (guix build syscalls)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (ice-9 vlist)
@ -38,28 +39,35 @@ (define-module (guix discovery)
(define* (scheme-files directory)
"Return the list of Scheme files found under DIRECTORY, recursively. The
returned list is sorted in alphabetical order."
(define (entry-type name properties)
(match (assoc-ref properties 'type)
('unknown
(stat:type (lstat name)))
((? symbol? type)
type)))
;; Sort entries so that 'fold-packages' works in a deterministic fashion
;; regardless of details of the underlying file system.
(sort (file-system-fold (const #t) ;enter?
(lambda (path stat result) ;leaf
(if (string-suffix? ".scm" path)
(cons path result)
result))
(lambda (path stat result) ;down
result)
(lambda (path stat result) ;up
result)
(const #f) ;skip
(lambda (path stat errno result)
(unless (= ENOENT errno)
(warning (G_ "cannot access `~a': ~a~%")
path (strerror errno)))
result)
'()
directory
stat)
string<?))
;; Use 'scandir*' so we can avoid an extra 'lstat' for each entry, as
;; opposed to Guile's 'scandir' or 'file-system-fold'.
(fold-right (lambda (entry result)
(match entry
(("." . _)
result)
((".." . _)
result)
((name . properties)
(let ((absolute (string-append directory "/" name)))
(case (entry-type absolute properties)
((directory)
(append (scheme-files absolute) result))
((regular symlink)
;; XXX: We don't recurse if we find a symlink.
(if (string-suffix? ".scm" name)
(cons absolute result)
result))
(else
result))))))
'()
(scandir* directory)))
(define file-name->module-name
(let ((not-slash (char-set-complement (char-set #\/))))