;;;;
;;;; regexp.stk                         -- STklos Regular Expressions
;;;;
;;;; Copyright © 1994-2023 Erick Gallesio <eg@stklos.net>
;;;;
;;;;
;;;; This program is free software; you can redistribute it and/or modify
;;;; it under the terms of the GNU General Public License as published by
;;;; the Free Software Foundation; either version 2 of the License, or
;;;; (at your option) any later version.
;;;;
;;;; This program is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;;; GNU General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU General Public License
;;;; along with this program; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307,
;;;; USA.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date:  9-Nov-1994 13:24 (eg)
;;;;


(export regexp-replace regexp-replace-all)



#|
<doc EXT regexp-replace regexp-replace-all
 * (regexp-replace pattern string substitution)
 * (regexp-replace-all pattern string substitution)
 *
 * |Regexp-replace| matches the regular expression |pattern| against
 * |string|. If there is a match, the portion of |string| which matches
 * |pattern| is replaced by the |substitution| string. If there is no
 * match, |regexp-replace| returns |string| unmodified. Note that the
 * given |pattern| could be here either a string or a regular expression.
 *
 * If |pattern| contains |\n| where *n* is a digit between 1 and 9,
 * then it is replaced in the substitution with the portion of string that
 * matched the *n*-th parenthesized subexpression of |pattern|. If
 * *n* is equal to 0, then it is replaced in |substitution|
 * with the portion of |string| that matched |pattern|.
 *
 * |Regexp-replace| replaces the first occurrence of |pattern| in |string|.
 * To replace _all_ the occurrences of |pattern|, use |regexp-replace-all|.
 *
 * @lisp
 * (regexp-replace "a*b" "aaabbcccc" "X")
 *                    => "Xbcccc"
 * (regexp-replace (string->regexp "a*b") "aaabbcccc" "X")
 *                    => "Xbcccc"
 * (regexp-replace "(a*)b" "aaabbcccc" "X\\1Y")
 *                    => "XaaaYbcccc"
 * (regexp-replace "f(.*)r" "foobar" "\\1 \\1")
 *                    => "ooba ooba"
 * (regexp-replace "f(.*)r" "foobar" "\\0 \\0")
 *                    => "foobar foobar"
 *
 * (regexp-replace "a*b" "aaabbcccc" "X")
 *                    => "Xbcccc"
 * (regexp-replace-all "a*b" "aaabbcccc" "X")
 *                    => "XXcccc"
 * @end lisp
doc>
|#

(define regexp-replace          #f)
(define regexp-replace-all      #f)

(let ()

  ;; Utility function
  ;; Simple replacement function
  (define (replace-string string ind1 ind2 new)
    (string-append (substring string 0 ind1)
                   new
                   (substring string ind2 (string-length string))))

  ;; Utility function
  ;; Given a string  and a set of substitutions, return the substituted string
  (define (replace-submodels string subst match)
    (if (= (length match) 1)
        ;; There is no sub-model
        subst
        ;; There are at least one sub-model to replace
        (let Loop ((subst subst))
          (let ((pos (regexp-match-positions "\\\\[0-9]" subst)))
            (if pos
                ;; At least one \x in the substitution string
                (let* ((index (+ (caar pos) 1))
                       (val   (string->number (substring subst index (+ index 1)))))
                  (if (>= val (length match))
                      (error 'regexp-replace "cannot match \\~A in model" val)
                      ;; Build a new subst with the current \x remplaced by
                      ;; its value. Iterate for further \x
                      (Loop (replace-string subst
                                            (caar pos)
                                            (cadar pos)
                                            (apply substring string
                                                   (list-ref match val))))))
                ;; No \x in substitution string
                subst)))))


  ;; If there is a match, call replace-submodels; otherwise return
  ;; string unmodified
  (set! regexp-replace
        (lambda (pat str subst)
          #:regexp-replace              ;; set procedure name
          (let ((match (regexp-match-positions pat str)))
            (if match
                ;; There was a match
                (replace-string str
                                (caar match)
                                (cadar match)
                                (replace-submodels str subst match))
                ;; No match, return the original string
                str))))


  (set! regexp-replace-all
        (lambda (pat str subst)
          #:regexp-replace-all          ;; set procedure name
          (letrec ((regexp-replace-all-r
                    (lambda (regexp str subst)
                      (let ((match (regexp-match-positions regexp str)))
                        (if match
                            (string-append (substring str 0 (caar match))
                                           (replace-submodels str subst match)
                                           (regexp-replace-all-r
                                                    regexp
                                                    (substring str
                                                               (cadar match)
                                                               (string-length str))
                                                    subst))
                            str)))))
            (regexp-replace-all-r pat str subst)))))

