>From b216b5ac548cd67d6874d6e20ea9b0865b74be6a Mon Sep 17 00:00:00 2001
From: Mario Domenech Goulart <address@hidden>
Date: Tue, 2 Jun 2015 22:08:17 -0300
Subject: [PATCH 2/2] 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.
---
 posix-common.scm | 65 +++++++++++++++++++++++++++++---------------------------
 1 file changed, 34 insertions(+), 31 deletions(-)

diff --git a/posix-common.scm b/posix-common.scm
index 69b625d..0d3638e 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)))
-- 
2.1.4