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

regexp-replace should respect start/end also for pre/post substitutions

Browse source
This commit is contained in:
Alex Shinn 2019-12-28 22:48:44 +08:00
parent 3c8402d4fb
commit 6f28159667
2 changed files with 31 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
lib/chibi/regexp-test.sld
View file

@ -255,6 +255,13 @@
(regexp-replace '(+ space) " abc \t\n d ef " "-" 0 #f 4)) (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 " " "))
(test "bc pre: <<<bc >>> match1: <<<def>>> post: <<<gh>>>gh"
(regexp-replace
'(: ($ (+ alpha)) ":" (* space))
"abc def: ghi"
'("pre: <<<" pre ">>> match1: <<<" 1 ">>> post: <<<" post ">>>")
1 11))
(let () (let ()
(define (subst-matches matches input subst) (define (subst-matches matches input subst)
(define (submatch n) (define (submatch n)

46
lib/chibi/regexp.scm
View file

@ -1119,31 +1119,35 @@
(cons (cons
(substring str start (regexp-match-submatch-start m 0)) (substring str start (regexp-match-submatch-start m 0))
(append (append
(reverse (regexp-apply-match m str subst)) (reverse (regexp-apply-match m str subst start end))
(list (substring str (regexp-match-submatch-end m 0) end))))))))))) (list (substring str (regexp-match-submatch-end m 0) end)))))))))))
;;> Equivalent to \var{regexp-replace}, but replaces all occurrences ;;> Equivalent to \var{regexp-replace}, but replaces all occurrences
;;> of \var{re} in \var{str}. ;;> of \var{re} in \var{str}.
(define (regexp-replace-all rx str subst . o) (define (regexp-replace-all rx str subst . o)
(regexp-fold (let* ((start (if (and (pair? o) (car o)) (car o) 0))
rx (o (if (pair? o) (cdr o) '()))
(lambda (i m str acc) (end (if (and (pair? o) (car o)) (car o) (string-length str))))
(let ((m-start (regexp-match-submatch-start m 0))) (regexp-fold
(append (regexp-apply-match m str subst) rx
(if (>= i m-start) (lambda (i m str acc)
acc (let ((m-start (regexp-match-submatch-start m 0)))
(cons (substring str i m-start) acc))))) (append (regexp-apply-match m str subst start end)
'() (if (>= i m-start)
str acc
(lambda (i m str acc) (cons (substring str i m-start) acc)))))
(let ((end (string-length str))) '()
(string-concatenate-reverse str
(if (>= i end) (lambda (i m str acc)
acc (let ((end (string-length str)))
(cons (substring str i end) acc))))))) (string-concatenate-reverse
(if (>= i end)
acc
(cons (substring str i end) acc)))))
start end)))
(define (regexp-apply-match m str ls) (define (regexp-apply-match m str ls start end)
(let lp ((ls ls) (res '())) (let lp ((ls ls) (res '()))
(cond (cond
((null? ls) ((null? ls)
@ -1158,13 +1162,11 @@
(case (car ls) (case (car ls)
((pre) ((pre)
(lp (cdr ls) (lp (cdr ls)
(cons (substring str 0 (regexp-match-submatch-start m 0)) (cons (substring str start (regexp-match-submatch-start m 0))
res))) res)))
((post) ((post)
(lp (cdr ls) (lp (cdr ls)
(cons (substring str (cons (substring str (regexp-match-submatch-end m 0) end)
(regexp-match-submatch-end m 0)
(string-length str))
res))) res)))
(else (else
(cond (cond