Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Adding an optional count arg to regexp-replace to replace just the nth match.

Browse source
This commit is contained in:
Alex Shinn 2014-06-01 12:53:44 +09:00
parent 152e66fbd6
commit a2ffe5301b
3 changed files with 36 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

37
lib/chibi/regexp.scm
View file

@ -934,21 +934,28 @@
end))) end)))
(define (regexp-replace rx str subst . o) (define (regexp-replace rx str subst . o)
(let* ((start (if (pair? o) (car o) 0)) (let* ((start (if (and (pair? o) (car o)) (car o) 0))
(end (if (and (pair? o) (pair? (cdr o))) (cadr o) (string-length str))) (o (if (pair? o) (cdr o) '()))
(m (regexp-search rx str start end))) (end (if (and (pair? o) (car o)) (car o) (string-length str)))
(if m (o (if (pair? o) (cdr o) '()))
(string-concatenate (count (if (pair? o) (car o) 0)))
(cons (let lp ((i start) (count count))
(substring-cursor str (let ((m (regexp-search rx str i end)))
(string-index->offset str start) (cond
(regexp-match-submatch-start m 0)) ((not m) str)
(append ((positive? count)
(reverse (regexp-apply-match m str subst)) (lp (regexp-match-submatch-end m 0) (- count 1)))
(list (substring-cursor str (else
(regexp-match-submatch-end m 0) (string-concatenate
(string-index->offset str end)))))) (cons
str))) (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) (define (regexp-replace-all rx str subst . o)
(regexp-fold (regexp-fold

3
lib/chibi/regexp.sld
View file

@ -68,6 +68,7 @@
(define substring-cursor substring) (define substring-cursor substring)
(define (string-offset->index str off) off) (define (string-offset->index str off) off)
(define (string-index->offset str i) i) (define (string-index->offset str i) i)
(define (string-concatenate ls) (apply string-append ls))
(define (string-concatenate-reverse ls) (define (string-concatenate-reverse ls)
(apply string-append (reverse ls)))))) (string-concatenate (reverse ls))))))
(include "regexp.scm")) (include "regexp.scm"))

12
tests/regexp-tests.scm
View file

@ -199,6 +199,18 @@
(test " abc- abc" (test " abc- abc"
(regexp-replace '(: ($ (+ alpha)) ":" (* space)) " abc: " '(1 "-" pre 1))) (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 " " ")) (test " abc d ef " (regexp-replace-all '(+ space) " abc \t\n d ef " " "))
(define (subst-matches matches input subst) (define (subst-matches matches input subst)