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))
(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 ()
(define (subst-matches matches input subst)
(define (submatch n)

18
lib/chibi/regexp.scm
View file

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