diff --git a/collects/racket/private/string.rkt b/collects/racket/private/string.rkt index 28650bcc83..6b57b0799b 100644 --- a/collects/racket/private/string.rkt +++ b/collects/racket/private/string.rkt @@ -358,10 +358,8 @@ ;; Like splitting, but insert a replacement between matches (define -regexp-replace* (let ([regexp-replace* - (lambda (pattern string orig-replacement [ipre #""]) + (lambda (pattern string orig-replacement [start 0] [end #f] [ipre #""]) (define-values [buf sub] (get-buf+sub string pattern)) - (define start 0) - (define end #f) (define needs-string? (and (or (string? pattern) (regexp? pattern)) (string? string))) (define replacement @@ -444,26 +442,30 @@ 'regexp-replace* "cannot replace a string with a byte string: " replacement))) + (define r + (regexp-loop regexp-replace* loop start end pattern buf ipre + ;; success-choose: + (lambda (start ms acc) + (list* (if (procedure? replacement) + (check + replacement + (for/list ([m ms]) + (and m (sub buf (car m) (cdr m))))) + (replac ms replacement)) + (sub buf start (caar ms)) + acc)) + ;; failure-k: + (lambda (acc start end) + (cons (if end (sub buf start end) (sub buf start)) acc)) + ;; port functions: use string case + #f #f #f + ;; flags + #t #f)) (apply (if (bytes? buf) bytes-append string-append) - (regexp-loop regexp-replace* loop start end pattern buf ipre - ;; success-choose: - (lambda (start ms acc) - (list* (if (procedure? replacement) - (check - replacement - (for/list ([m ms]) - (and m (sub buf (car m) (cdr m))))) - (replac ms replacement)) - (sub buf start (caar ms)) - acc)) - ;; failure-k: - (lambda (acc start end) - (cons (if end (sub buf start end) (sub buf start)) acc)) - ;; port functions: use string case - #f #f #f - ;; flags - #t #f)))]) + (cond [(and (= start 0) (not end)) r] + [(not end) (cons (sub string 0 start) r)] + [else `(,(sub string 0 start) ,@r ,(sub string end))])))]) regexp-replace*)) ;; Returns all the matches for the pattern in the string, optionally diff --git a/collects/scribblings/reference/regexps.scrbl b/collects/scribblings/reference/regexps.scrbl index f25da08d15..83105323be 100644 --- a/collects/scribblings/reference/regexps.scrbl +++ b/collects/scribblings/reference/regexps.scrbl @@ -864,6 +864,8 @@ before the @litchar{\}. For example, the Racket constant [insert (or/c string? bytes? ((string?) () #:rest (listof string?) . ->* . string?) ((bytes?) () #:rest (listof bytes?) . ->* . bytes?))] + [start-pos exact-nonnegative-integer? 0] + [end-pos (or/c exact-nonnegative-integer? #f) #f] [input-prefix bytes? #""]) (or/c string? bytes?)]{ @@ -875,6 +877,10 @@ instead of just the first match. Only non-overlapping instances of recursively. Zero-length matches are treated the same as in @racket[regexp-match*]. +The optional @racket[start-pos] and @racket[end-pos] arguments select +a portion of @racket[input] for matching; the default is the entire +string or the stream up to an end-of-file. + @examples[ (regexp-replace* "([Mm])i ([a-zA-Z]*)" "mi cerveza Mi Mi Mi" "\\1y \\2") @@ -882,6 +888,7 @@ recursively. Zero-length matches are treated the same as in (lambda (all one two) (string-append (string-downcase one) "y" (string-upcase two)))) +(regexp-replace* #px"\\w" "hello world" string-upcase 0 5) (display (regexp-replace* #rx"x" "12x4x6" "\\\\")) ]} diff --git a/collects/tests/racket/basic.rktl b/collects/tests/racket/basic.rktl index fa44d17eb6..901f51574a 100644 --- a/collects/tests/racket/basic.rktl +++ b/collects/tests/racket/basic.rktl @@ -1111,6 +1111,11 @@ (test "foofoo" regexp-replace* #px"(.)?" "a" (lambda args "foo")) +(test "xxxxx world" regexp-replace* #px"\\w" "hello world" "x" 0 5) +(test "HELLO world" regexp-replace* #px"\\w" "hello world" string-upcase 0 5) +(test "hello world" regexp-replace* #px"o" "ohello world" "" 0 3) +(test "hell world" regexp-replace* #px"o" "ohello world" "" 0 6) + ;; Test weird port offsets: (define (test-weird-offset regexp-match regexp-match-positions) (test #f regexp-match "e" (open-input-string "")) @@ -1312,7 +1317,7 @@ (arity-test regexp-match-peek 2 6) (arity-test regexp-match-peek-positions 2 6) (arity-test regexp-replace 3 4) -(arity-test regexp-replace* 3 4) +(arity-test regexp-replace* 3 6) (test #t procedure? car) (test #f procedure? 'car)