From a2ffe5301b85798c0d592fec13d17df26e2ecab6 Mon Sep 17 00:00:00 2001
From: Alex Shinn <ashinn@users.noreply.github.com>
Date: Sun, 1 Jun 2014 12:53:44 +0900
Subject: [PATCH] Adding an optional count arg to regexp-replace to replace
 just the nth match.

---
 lib/chibi/regexp.scm   | 37 ++++++++++++++++++++++---------------
 lib/chibi/regexp.sld   |  3 ++-
 tests/regexp-tests.scm | 12 ++++++++++++
 3 files changed, 36 insertions(+), 16 deletions(-)

diff --git a/lib/chibi/regexp.scm b/lib/chibi/regexp.scm
index 620bcf0e..464da7ba 100644
--- a/lib/chibi/regexp.scm
+++ b/lib/chibi/regexp.scm
@@ -934,21 +934,28 @@
      end)))
 
 (define (regexp-replace rx str subst . o)
-  (let* ((start (if (pair? o) (car o) 0))
-         (end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str)))
-         (m (regexp-search rx str start end)))
-    (if m
-        (string-concatenate
-         (cons
-          (substring-cursor str
-                            (string-index->offset str start)
-                            (regexp-match-submatch-start m 0))
-          (append
-           (reverse (regexp-apply-match m str subst))
-           (list (substring-cursor str
-                                   (regexp-match-submatch-end m 0)
-                                   (string-index->offset str end))))))
-        str)))
+  (let* ((start (if (and (pair? o) (car o)) (car o) 0))
+         (o (if (pair? o) (cdr o) '()))
+         (end (if (and (pair? o) (car o)) (car o) (string-length str)))
+         (o (if (pair? o) (cdr o) '()))
+         (count (if (pair? o) (car o) 0)))
+    (let lp ((i start) (count count))
+      (let ((m (regexp-search rx str i end)))
+        (cond
+         ((not m) str)
+         ((positive? count)
+          (lp (regexp-match-submatch-end m 0) (- count 1)))
+         (else
+          (string-concatenate
+           (cons
+            (substring-cursor str
+                              (string-index->offset str start)
+                              (regexp-match-submatch-start m 0))
+            (append
+             (reverse (regexp-apply-match m str subst))
+             (list (substring-cursor str
+                                     (regexp-match-submatch-end m 0)
+                                     (string-index->offset str end))))))))))))
 
 (define (regexp-replace-all rx str subst . o)
   (regexp-fold
diff --git a/lib/chibi/regexp.sld b/lib/chibi/regexp.sld
index 259cef53..05af22b0 100644
--- a/lib/chibi/regexp.sld
+++ b/lib/chibi/regexp.sld
@@ -68,6 +68,7 @@
       (define substring-cursor substring)
       (define (string-offset->index str off) off)
       (define (string-index->offset str i) i)
+      (define (string-concatenate ls) (apply string-append ls))
       (define (string-concatenate-reverse ls)
-        (apply string-append (reverse ls))))))
+        (string-concatenate (reverse ls))))))
   (include "regexp.scm"))
diff --git a/tests/regexp-tests.scm b/tests/regexp-tests.scm
index f5e8eddc..72a034b0 100644
--- a/tests/regexp-tests.scm
+++ b/tests/regexp-tests.scm
@@ -199,6 +199,18 @@
 (test "  abc-  abc"
     (regexp-replace '(: ($ (+ alpha)) ":" (* space)) "  abc: " '(1 "-" pre 1)))
 
+(test "-abc \t\n d ef  "
+    (regexp-replace '(+ space) "  abc \t\n d ef  " "-" 0))
+(test "-abc \t\n d ef  "
+    (regexp-replace '(+ space) "  abc \t\n d ef  " "-" 0 #f 0))
+(test "  abc-d ef  "
+    (regexp-replace '(+ space) "  abc \t\n d ef  " "-" 0 #f 1))
+(test "  abc \t\n d-ef  "
+    (regexp-replace '(+ space) "  abc \t\n d ef  " "-" 0 #f 2))
+(test "  abc \t\n d ef-"
+    (regexp-replace '(+ space) "  abc \t\n d ef  " "-" 0 #f 3))
+(test "  abc \t\n d ef  "
+    (regexp-replace '(+ space) "  abc \t\n d ef  " "-" 0 #f 4))
 (test " abc d ef " (regexp-replace-all '(+ space) "  abc \t\n d ef  " " "))
 
 (define (subst-matches matches input subst)