From 147dc0d7fd9ab04d10b4f13cecf47a32c5b6c4b6 Mon Sep 17 00:00:00 2001
From: "Chris K. Jester-Young" <cky944@gmail.com>
Date: Mon, 17 Sep 2012 01:06:07 -0400
Subject: [PATCH 2/2] Add "limit" parameter to fold-matches and list-matches.

* doc/ref/api-regex.texi: Document new "limit" parameter.

* module/ice-9/regex.scm (fold-matches, list-matches): Optionally take
  a "limit" argument that, if specified, limits how many times the
  pattern is matched.

* test-suite/tests/regexp.test (fold-matches): Add tests for the correct
  functioning of the limit parameter.
---
 doc/ref/api-regex.texi       |   10 ++++++----
 module/ice-9/regex.scm       |   18 ++++++++++--------
 test-suite/tests/regexp.test |   16 +++++++++++++++-
 3 files changed, 31 insertions(+), 13 deletions(-)

diff --git a/doc/ref/api-regex.texi b/doc/ref/api-regex.texi
index 082fb87..2d2243f 100644
--- a/doc/ref/api-regex.texi
+++ b/doc/ref/api-regex.texi
@@ -189,11 +189,12 @@ or @code{#f} otherwise.
 @end deffn
 
 @sp 1
-@deffn {Scheme Procedure} list-matches regexp str [flags]
+@deffn {Scheme Procedure} list-matches regexp str [flags [limit]]
 Return a list of match structures which are the non-overlapping
 matches of @var{regexp} in @var{str}.  @var{regexp} can be either a
 pattern string or a compiled regexp.  The @var{flags} argument is as
-per @code{regexp-exec} above.
+per @code{regexp-exec} above.  The @var{limit} argument, if specified,
+limits how many times @var{regexp} is matched.
 
 @example
 (map match:substring (list-matches "[a-z]+" "abc 42 def 78"))
@@ -201,11 +202,12 @@ per @code{regexp-exec} above.
 @end  example
 @end deffn
 
-@deffn {Scheme Procedure} fold-matches regexp str init proc [flags]
+@deffn {Scheme Procedure} fold-matches regexp str init proc [flags [limit]]
 Apply @var{proc} to the non-overlapping matches of @var{regexp} in
 @var{str}, to build a result.  @var{regexp} can be either a pattern
 string or a compiled regexp.  The @var{flags} argument is as per
-@code{regexp-exec} above.
+@code{regexp-exec} above.  The @var{limit} argument, if specified,
+limits how many times @var{regexp} is matched.
 
 @var{proc} is called as @code{(@var{proc} match prev)} where
 @var{match} is a match structure and @var{prev} is the previous return
diff --git a/module/ice-9/regex.scm b/module/ice-9/regex.scm
index 08ae2c2..0ffe74c 100644
--- a/module/ice-9/regex.scm
+++ b/module/ice-9/regex.scm
@@ -167,26 +167,28 @@
 ;;; `b'.  Around or within `xxx', only the match covering all three
 ;;; x's counts, because the rest are not maximal.
 
-(define* (fold-matches regexp string init proc #:optional (flags 0))
+(define* (fold-matches regexp string init proc #:optional (flags 0) limit)
   (let ((regexp (if (regexp? regexp) regexp (make-regexp regexp))))
     (let loop ((start 0)
+               (count 0)
                (value init)
                (abuts #f))              ; True if start abuts a previous match.
-      (define bol (if (zero? start) 0 regexp/notbol))
-      (let ((m (if (> start (string-length string)) #f
-                   (regexp-exec regexp string start (logior flags bol)))))
+      (let* ((bol (if (zero? start) 0 regexp/notbol))
+             (m (and (or (not limit) (< count limit))
+                     (<= start (string-length string))
+                     (regexp-exec regexp string start (logior flags bol)))))
         (cond
          ((not m) value)
          ((and (= (match:start m) (match:end m)) abuts)
           ;; We matched an empty string, but that would overlap the
           ;; match immediately before.  Try again at a position
           ;; further to the right.
-          (loop (+ start 1) value #f))
+          (loop (1+ start) count value #f))
          (else
-          (loop (match:end m) (proc m value) #t)))))))
+          (loop (match:end m) (1+ count) (proc m value) #t)))))))
 
-(define* (list-matches regexp string #:optional (flags 0))
-  (reverse! (fold-matches regexp string '() cons flags)))
+(define* (list-matches regexp string #:optional (flags 0) limit)
+  (reverse! (fold-matches regexp string '() cons flags limit)))
 
 (define (regexp-substitute/global port regexp string . items)
 
diff --git a/test-suite/tests/regexp.test b/test-suite/tests/regexp.test
index d549df2..c3ba698 100644
--- a/test-suite/tests/regexp.test
+++ b/test-suite/tests/regexp.test
@@ -139,7 +139,21 @@
             (fold-matches "^foo" "foofoofoofoo" '()
                           (lambda (match result)
                             (cons (match:substring match)
-                                  result))))))
+                                  result)))))
+
+  (pass-if "without limit"
+    (equal? '("foo" "foo" "foo" "foo")
+            (fold-matches "foo" "foofoofoofoo" '()
+                          (lambda (match result)
+                            (cons (match:substring match)
+                                  result)))))
+
+  (pass-if "with limit"
+    (equal? '("foo" "foo")
+            (fold-matches "foo" "foofoofoofoo" '()
+                          (lambda (match result)
+                            (cons (match:substring match)
+                                  result)) 0 2))))
 
 
 ;;;
-- 
1.7.9.5