From dc99e1992c66b96bc93eb4c6f2497e7c11ec23cc Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 26 Jun 2010 18:22:08 -0600
Subject: [PATCH] restore support for sub-matches in `regexp-replace*'

---
 collects/racket/private/string.rkt           | 12 ++++++------
 collects/scribblings/reference/regexps.scrbl |  4 ++--
 collects/tests/racket/basic.rktl             | 16 ++++++++++++++++
 3 files changed, 24 insertions(+), 8 deletions(-)

diff --git a/collects/racket/private/string.rkt b/collects/racket/private/string.rkt
index c5c692d190..597163ae1e 100644
--- a/collects/racket/private/string.rkt
+++ b/collects/racket/private/string.rkt
@@ -326,8 +326,8 @@
                (if (and (not needs-string?) (string? orig-replacement))
                    (string->bytes/utf-8 orig-replacement)
                    orig-replacement))
-             (define (check proc arg)
-               (let ([v (proc arg)])
+             (define (check proc args)
+               (let ([v (apply proc args)])
                  (unless (if needs-string?
                              (string? v)
                              (bytes? v))
@@ -388,9 +388,8 @@
                  (raise-type-error 'regexp-replace* "string or byte string" string))
                (unless (or (string? replacement)
                            (bytes? replacement)
-                           (and (procedure? replacement)
-                                (procedure-arity-includes? replacement 1)))
-                 (raise-type-error 'regexp-replace* "string, byte string, or procedure (arity 1)" 
+                           (procedure? replacement))
+                 (raise-type-error 'regexp-replace* "string, byte string, or procedure" 
                                    replacement))
                (when (and needs-string? (bytes? replacement))
                  (raise-mismatch-error 'regexp-replace*
@@ -404,7 +403,8 @@
                (lambda (start mstart mend ms acc) (list* (if (procedure? replacement)
                                                              (check
                                                               replacement
-                                                              (sub buf mstart mend))
+                                                              (for/list ([m ms])
+                                                                (sub buf (car m) (cdr m))))
                                                              (replac ms replacement))
                                                          (sub buf start mstart)
                                                          acc))
diff --git a/collects/scribblings/reference/regexps.scrbl b/collects/scribblings/reference/regexps.scrbl
index 3c8128b36f..b4bd0bc4b1 100644
--- a/collects/scribblings/reference/regexps.scrbl
+++ b/collects/scribblings/reference/regexps.scrbl
@@ -741,8 +741,8 @@ before the @litchar{\}. For example, the Racket constant
 @defproc[(regexp-replace* [pattern (or/c string? bytes? regexp? byte-regexp?)]
                           [input (or/c string? bytes?)]
                           [insert (or/c string? bytes? 
-                                        (string? . -> . string?)
-                                        (bytes? . -> . bytes?))]
+                                        ((string?) () #:rest (listof string?) . ->* . string?)
+                                        ((bytes?) () #:rest (listof bytes?) . ->* . bytes?))]
                           [input-prefix bytes? #""])
          (or/c string? bytes?)]{
 
diff --git a/collects/tests/racket/basic.rktl b/collects/tests/racket/basic.rktl
index d8ecb56fb0..a47a495f2e 100644
--- a/collects/tests/racket/basic.rktl
+++ b/collects/tests/racket/basic.rktl
@@ -1074,6 +1074,22 @@
 (test "x&cy&z" regexp-replace* #rx"a(.)" "xabcyawz" "\\&")
 (test "x\\cy\\z" regexp-replace* #rx"a(.)" "xabcyawz" "\\\\")
 
+;; Test sub-matches with procedure replace (second example by synx)
+(test "myCERVEZA myMI Mi"
+      regexp-replace* "([Mm])i ([a-zA-Z]*)" "mi cerveza Mi Mi Mi"
+      (lambda (all one two)
+        (string-append (string-downcase one) "y"
+                       (string-upcase two))))
+(test #"fox in socks, blue seal. trout in socks, blue fish!"
+      regexp-replace*                                     
+      #rx#"([a-z]+) ([a-z]+)"
+      #"red fox, blue seal. red trout, blue trout!"
+      (lambda (total color what)
+        (cond
+         ((equal? color #"red") (bytes-append what #" in socks"))
+         ((equal? what #"trout") (bytes-append color #" fish"))
+         (else (bytes-append color #" " what)))))
+
 ;; Test weird port offsets:
 (define (test-weird-offset regexp-match regexp-match-positions)
   (test #f regexp-match "e" (open-input-string ""))