discovery: Rewrite 'scheme-files' using 'scandir*'.
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:
		
							parent
							
								
									fa73c19373
								
							
						
					
					
						commit
						d27cc3bfaa
					
				
					 1 changed files with 29 additions and 21 deletions
				
			
		| 
						 | 
					@ -19,6 +19,7 @@
 | 
				
			||||||
(define-module (guix discovery)
 | 
					(define-module (guix discovery)
 | 
				
			||||||
  #:use-module (guix ui)
 | 
					  #:use-module (guix ui)
 | 
				
			||||||
  #:use-module (guix combinators)
 | 
					  #:use-module (guix combinators)
 | 
				
			||||||
 | 
					  #:use-module (guix build syscalls)
 | 
				
			||||||
  #:use-module (srfi srfi-1)
 | 
					  #:use-module (srfi srfi-1)
 | 
				
			||||||
  #:use-module (ice-9 match)
 | 
					  #:use-module (ice-9 match)
 | 
				
			||||||
  #:use-module (ice-9 vlist)
 | 
					  #:use-module (ice-9 vlist)
 | 
				
			||||||
| 
						 | 
					@ -38,28 +39,35 @@
 | 
				
			||||||
(define* (scheme-files directory)
 | 
					(define* (scheme-files directory)
 | 
				
			||||||
  "Return the list of Scheme files found under DIRECTORY, recursively.  The
 | 
					  "Return the list of Scheme files found under DIRECTORY, recursively.  The
 | 
				
			||||||
returned list is sorted in alphabetical order."
 | 
					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
 | 
					  ;; Use 'scandir*' so we can avoid an extra 'lstat' for each entry, as
 | 
				
			||||||
  ;; regardless of details of the underlying file system.
 | 
					  ;; opposed to Guile's 'scandir' or 'file-system-fold'.
 | 
				
			||||||
  (sort (file-system-fold (const #t)                 ;enter?
 | 
					  (fold-right (lambda (entry result)
 | 
				
			||||||
                          (lambda (path stat result) ;leaf
 | 
					                (match entry
 | 
				
			||||||
                            (if (string-suffix? ".scm" path)
 | 
					                  (("." . _)
 | 
				
			||||||
                                (cons path result)
 | 
					                   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))
 | 
					                            result))
 | 
				
			||||||
                          (lambda (path stat result) ;down
 | 
					                       (else
 | 
				
			||||||
                            result)
 | 
					                        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
 | 
					              (scandir* directory)))
 | 
				
			||||||
                          stat)
 | 
					 | 
				
			||||||
        string<?))
 | 
					 | 
				
			||||||
 | 
					
 | 
				
			||||||
(define file-name->module-name
 | 
					(define file-name->module-name
 | 
				
			||||||
  (let ((not-slash (char-set-complement (char-set #\/))))
 | 
					  (let ((not-slash (char-set-complement (char-set #\/))))
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Reference in a new issue