~ chicken-core (chicken-5) 3a8da718bf4c6b71ced0fb60bee2bd84a2f2321d

commit 3a8da718bf4c6b71ced0fb60bee2bd84a2f2321d
Author:     Felix <bunny351@gmail.com>
AuthorDate: Wed Oct 14 14:59:13 2009 +0200
Commit:     Felix <bunny351@gmail.com>
CommitDate: Wed Oct 14 23:28:05 2009 +0200

    Added optional argument to grep function in regex unit [suggested by Tony Sidaway]

diff --git a/manual/Unit regex b/manual/Unit regex
index 5c21e75f..23b78e56 100644
--- a/manual/Unit regex	
+++ b/manual/Unit regex	
@@ -21,7 +21,7 @@ just use normal Scheme lists, with quasiquote if you like.
 
 === grep
 
- [procedure] (grep REGEX LIST)
+ [procedure] (grep REGEX LIST [ACCESSOR])
 
 Returns all items of {{LIST}} that match the regular expression
 {{REGEX}}.  This procedure could be defined as follows:
@@ -31,6 +31,11 @@ Returns all items of {{LIST}} that match the regular expression
   (filter (lambda (x) (string-search regex x)) lst) )
 </enscript>
 
+{{ACCESSOR}} is an optional accessor-procedure applied to each
+element before doing the match. It should take a single argument
+and return a string that will then be used in the regular expression
+matching. {{ACCESSOR}} defaults to the identity function.
+
 
 === glob->regexp
 
diff --git a/regex.scm b/regex.scm
index fab3e9d2..79c37972 100644
--- a/regex.scm
+++ b/regex.scm
@@ -295,17 +295,17 @@
 ;;; Grep-like function on list:
 
 (define grep
-  (let ([string-search string-search])
-    (lambda (rx lst)
+  (let ((string-search string-search))
+    (lambda (rx lst #!optional (acc (lambda (x) x)))
       (##sys#check-list lst 'grep)
-      (let loop ([lst lst])
-        (if (null? lst)
-            '()
-            (let ([x (car lst)]
-                  [r (cdr lst)] )
-              (if (string-search rx x)
-                  (cons x (loop r))
-                  (loop r) ) ) ) ) ) ) )
+      (let loop ((lst lst))
+	(if (null? lst)
+	    '()
+	    (let ((x (##sys#slot lst 0))
+		  (r (##sys#slot lst 1)) )
+	      (if (string-search rx (acc x))
+		  (cons x (loop r))
+		  (loop r) ) ) ) ) ) ) )
 
 
 ;;; Escape regular expression (suggested by Peter Bex):