[plt-scheme] addition to pregexp

Eli Barzilay wrote:

>On Mar 17, Matthew Flatt wrote:
>  
>
>>I like this feature.
>>
>>Instead of introducing a new name, how about generalizing
>>`[p]regexp-replace[*]' to accept either a string or a function as
>>its last argument?
>>    
>>
>
>Another point is that it's probably better if the function takes in a
>variable number of arguments -- and it will be fed the matching
>substring and then all parenthesized submatches (as with `match').
>
>  
>
Ok this version handles variable arguments depending on how many 
submatches occured. I havent tested many edge-cases, although I think 
the only problems would occur when backward referencing is used.

I sort of cheated by testing for string? and if so use the old 
pregexp-replace*.

(require (lib "list.ss"))
(require (lib "string.ss"))
(require (lib "pregexp.ss"))

(define (pregexp-match-positions* regexp str)
(let loop ((start 0)
(matches '()))
(if (>= start (string-length str))
(reverse matches)
(let ((match (pregexp-match-positions regexp str start)))
(if (not match)
(reverse matches)
(loop
(if (eq? (caar match)
(cdar match))
(add1 (cdar match))
(cdar match))
(cons match matches)))))))

(define (pregexp-replace% regexp str func)
(if (string? func)
(pregexp-replace* regexp str func)
(let ((matches (pregexp-match-positions* regexp str))
(last-position 0))
(string-append
(apply string-append
(map (lambda (current-matches)
(let ((result
(string-append
(substring str last-position
(caar current-matches))
(apply func
(map (lambda (match)
(substring str
(car match)
(cdr match)))
current-matches)))))
(set! last-position (cdar current-matches))
result))
matches))
(substring str last-position)))))

(define (string-assert str1 str2)
(unless (string=? str1 str2)
(printf "~a != ~a\n" str1 str2)))

(string-assert (pregexp-replace% "xyz" "hello" (lambda (x) x)) "hello")
(string-assert (pregexp-replace% "e" "hello" (lambda (x) x)) "hello")
(string-assert (pregexp-replace% "l*" "hello" (lambda (x)
(string-upcase x)))
"heLLo")

(string-assert (pregexp-replace%
"[A-Z]+_?" "SOME_STRING"
(lambda (x)
(string-append (substring x 0 1)
(string-downcase
(substring
(pregexp-replace "_" x "") 1)))))
"SomeString")

(string-assert (pregexp-replace%
"fo(o)" "Hello foo world"
(lambda (all o)
(string-upcase o)))
"Hello O world")

(string-assert (pregexp-replace% "color" "The wall is color" "black")
"The wall is black")