~ chicken-core (chicken-5) 2df56df8a5a48fc4eb1a6094f7ce44f2192c963e

commit 2df56df8a5a48fc4eb1a6094f7ce44f2192c963e
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 16:32:21 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 00601671..8b3e4e5f 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)))