regexp.stk 4.67 KB
Newer Older
eg's avatar
eg committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
;;;;
;;;; regexp.stk				-- STklos Regular Expressions
;;;; 
;;;; Copyright © 1994-2000 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; 
;;;; 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)
;;;; Last file update: 26-Nov-2000 18:59 (eg)
;;;;



#|
<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 ,(bold "n") is a digit between 1 and 9, 
 * then it is replaced in the substitution with the portion of string that
 * matched the ,(bold "n")-th parenthesized subexpression of |pattern|. If
 * ,(bold "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 ,(bold "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)
	  (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)
	  (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)))))