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

ashinn · Dec 28, 2019 · 6f28159 · 6f28159
1 parent 3c8402d
commit 6f28159
Show file tree

Hide file tree

Showing 2 changed files with 32 additions and 23 deletions.
diff --git a/lib/chibi/regexp-test.sld b/lib/chibi/regexp-test.sld
@@ -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)

diff --git a/lib/chibi/regexp.scm b/lib/chibi/regexp.scm
@@ -1119,31 +1119,35 @@
            (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)
-  (regexp-fold
-   rx
-   (lambda (i m str acc)
-     (let ((m-start (regexp-match-submatch-start m 0)))
-       (append (regexp-apply-match m str subst)
-               (if (>= i m-start)
-                   acc
-                   (cons (substring str i m-start) acc)))))
-   '()
-   str
-   (lambda (i m str acc)
-     (let ((end (string-length str)))
-       (string-concatenate-reverse
-        (if (>= i end)
-            acc
-            (cons (substring str i end) acc)))))))
-
-(define (regexp-apply-match m str ls)
+  (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 start end)
+                 (if (>= i m-start)
+                     acc
+                     (cons (substring str i m-start) acc)))))
+     '()
+     str
+     (lambda (i m str acc)
+       (let ((end (string-length str)))
+         (string-concatenate-reverse
+          (if (>= i end)
+              acc
+              (cons (substring str i end) acc)))))
+     start end)))
+
+(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