~ chicken-core (chicken-5) d87e1238485eb3b6a5b7a03efe71d6f6513855fd

commit d87e1238485eb3b6a5b7a03efe71d6f6513855fd
Author:     Mario Domenech Goulart <mario.goulart@gmail.com>
AuthorDate: Tue Jun 2 22:08:17 2015 -0300
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Fri Jun 12 10:41:35 2015 +1200

    posix-common: find-files: use `directory' instead of `glob'
    
    Using `directory' instead of `glob' gives a nice speed boost:
    
    With `glob':
    
    (time (find-files "."))
    2.1s CPU time, 0.164s GC time (major), 2759998/21115 mutations (total/tracked), 4/15016 GCs (major/minor)
    
    With `directory`:
    
    (time (find-files "."))
    0.58s CPU time, 0.092s GC time (major), 220194/12135 mutations (total/tracked), 3/2633 GCs (major/minor)
    
    Timings for `(find-files ".")' on a directory containing the Linux
    source code.
    
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/posix-common.scm b/posix-common.scm
index 9cf38ae0..36f94df5 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -495,37 +495,40 @@ EOF
 
 ;;; Find matching files:
 
-(define ##sys#find-files
-  (lambda (dir pred action id limit follow dot loc)
-    (##sys#check-string dir loc)
-    (let* ((depth 0)
-	   (lproc
-	    (cond ((not limit) (lambda _ #t))
-		  ((fixnum? limit) (lambda _ (fx< depth limit)))
-		  (else limit) ) )
-	   (pproc
-	    (if (procedure? pred)
-		pred
-		(let ((pred (irregex pred))) ; force compilation
-		  (lambda (x) (irregex-match pred x))) ) ) )
-      (let loop ((fs (glob (make-pathname dir (if dot "?*" "*"))))
-		 (r id) )
-	(if (null? fs)
-	    r
-	    (let ((f (##sys#slot fs 0))
-		  (rest (##sys#slot fs 1)) )
-	      (cond ((directory? f)
-		     (cond ((member (pathname-file f) '("." "..")) (loop rest r))
-			   ((and (symbolic-link? f) (not follow))
-			    (loop rest (if (pproc f) (action f r) r)))
-			   ((lproc f)
-			    (loop rest
-				  (fluid-let ((depth (fx+ depth 1)))
-				    (loop (glob (make-pathname f (if dot "?*" "*")))
-					  (if (pproc f) (action f r) r)) ) ) )
-			   (else (loop rest (if (pproc f) (action f r) r))) ) )
-		    ((pproc f) (loop rest (action f r)))
-		    (else (loop rest r)) ) ) ) ) ) ) )
+(define (##sys#find-files dir pred action id limit follow dot loc)
+  (##sys#check-string dir loc)
+  (let* ((depth 0)
+         (lproc
+          (cond ((not limit) (lambda _ #t))
+                ((fixnum? limit) (lambda _ (fx< depth limit)))
+                (else limit) ) )
+         (pproc
+          (if (procedure? pred)
+              pred
+              (let ((pred (irregex pred))) ; force compilation
+                (lambda (x) (irregex-match pred x))))))
+    (let loop ((dir dir)
+               (fs (directory dir dot))
+               (r id))
+      (if (null? fs)
+          r
+          (let* ((filename (##sys#slot fs 0))
+                 (f (make-pathname dir filename))
+                 (rest (##sys#slot fs 1)))
+            (cond ((directory? f)
+                   (cond ((member filename '("." "..")) (loop dir rest r))
+                         ((and (symbolic-link? f) (not follow))
+                          (loop dir rest (if (pproc f) (action f r) r)))
+                         ((lproc f)
+                          (loop dir
+                                rest
+                                (fluid-let ((depth (fx+ depth 1)))
+                                  (loop f
+                                        (directory f dot)
+                                        (if (pproc f) (action f r) r)))))
+                         (else (loop dir rest (if (pproc f) (action f r) r)))))
+                  ((pproc f) (loop dir rest (action f r)))
+                  (else (loop dir rest r))))))))
 
 (define (find-files dir #!key (test (lambda _ #t))
 			      (action (lambda (x y) (cons x y)))