suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

restore support for sub-matches in `regexp-replace*'

Browse Source
This commit is contained in:
Matthew Flatt 2010-06-26 18:22:08 -06:00
parent 4fe07902d9
commit dc99e1992c
3 changed files with 24 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/racket/private/string.rkt
View File

@ -326,8 +326,8 @@
(if (and (not needs-string?) (string? orig-replacement)) (if (and (not needs-string?) (string? orig-replacement))
(string->bytes/utf-8 orig-replacement) (string->bytes/utf-8 orig-replacement)
orig-replacement)) orig-replacement))
(define (check proc arg) (define (check proc args)
(let ([v (proc arg)]) (let ([v (apply proc args)])
(unless (if needs-string? (unless (if needs-string?
(string? v) (string? v)
(bytes? v)) (bytes? v))
@ -388,9 +388,8 @@
(raise-type-error 'regexp-replace* "string or byte string" string)) (raise-type-error 'regexp-replace* "string or byte string" string))
(unless (or (string? replacement) (unless (or (string? replacement)
(bytes? replacement) (bytes? replacement)
(and (procedure? replacement) (procedure? replacement))
(procedure-arity-includes? replacement 1))) (raise-type-error 'regexp-replace* "string, byte string, or procedure"
(raise-type-error 'regexp-replace* "string, byte string, or procedure (arity 1)"
replacement)) replacement))
(when (and needs-string? (bytes? replacement)) (when (and needs-string? (bytes? replacement))
(raise-mismatch-error 'regexp-replace* (raise-mismatch-error 'regexp-replace*
@ -404,7 +403,8 @@
(lambda (start mstart mend ms acc) (list* (if (procedure? replacement) (lambda (start mstart mend ms acc) (list* (if (procedure? replacement)
(check (check
replacement replacement
(sub buf mstart mend)) (for/list ([m ms])
(sub buf (car m) (cdr m))))
(replac ms replacement)) (replac ms replacement))
(sub buf start mstart) (sub buf start mstart)
acc)) acc))

4
collects/scribblings/reference/regexps.scrbl
View File

@ -741,8 +741,8 @@ before the @litchar{\}. For example, the Racket constant
@defproc[(regexp-replace* [pattern (or/c string? bytes? regexp? byte-regexp?)] @defproc[(regexp-replace* [pattern (or/c string? bytes? regexp? byte-regexp?)]
[input (or/c string? bytes?)] [input (or/c string? bytes?)]
[insert (or/c string? bytes? [insert (or/c string? bytes?
(string? . -> . string?) ((string?) () #:rest (listof string?) . ->* . string?)
(bytes? . -> . bytes?))] ((bytes?) () #:rest (listof bytes?) . ->* . bytes?))]
[input-prefix bytes? #""]) [input-prefix bytes? #""])
(or/c string? bytes?)]{ (or/c string? bytes?)]{

16
collects/tests/racket/basic.rktl
View File

@ -1074,6 +1074,22 @@
(test "x&cy&z" regexp-replace* #rx"a(.)" "xabcyawz" "\\&") (test "x&cy&z" regexp-replace* #rx"a(.)" "xabcyawz" "\\&")
(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: ;; Test weird port offsets:
(define (test-weird-offset regexp-match regexp-match-positions) (define (test-weird-offset regexp-match regexp-match-positions)
(test #f regexp-match "e" (open-input-string "")) (test #f regexp-match "e" (open-input-string ""))