106 lines
3.4 KiB
Plaintext
106 lines
3.4 KiB
Plaintext
;;;;
|
|
;;;; r e g e x p . s t k -- Regular expressions
|
|
;;;;
|
|
;;;;
|
|
;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|
;;;;
|
|
;;;; Permission to use, copy, and/or distribute this software and its
|
|
;;;; documentation for any purpose and without fee is hereby granted, provided
|
|
;;;; that both the above copyright notice and this permission notice appear in
|
|
;;;; all copies and derived works. Fees for distribution or use of this
|
|
;;;; software or derived works may only be charged with express written
|
|
;;;; permission of the copyright holder.
|
|
;;;; This software is provided ``as is'' without express or implied warranty.
|
|
;;;;
|
|
;;;;
|
|
;;;; Author: Erick Gallesio [eg@unice.fr]
|
|
;;;; Creation date: 9-Nov-1994 13:24
|
|
;;;; Last file update: 21-Jul-1996 18:41
|
|
;;;;
|
|
;;;; Regexp-replace-all bug correction due to Sean Slattery
|
|
;;;; <jslttery@GS148.SP.CS.CMU.EDU>
|
|
|
|
(if (symbol-bound? '%init-regexp)
|
|
;; Regexp module is in the core interpreter
|
|
(%init-regexp)
|
|
;; Try to load regexp module dynamically
|
|
(load (string-append "sregexp." *shared-suffix*)))
|
|
|
|
(define (replace-string string ind1 ind2 new)
|
|
(string-append (substring string 0 ind1)
|
|
new
|
|
(substring string ind2 (string-length string))))
|
|
|
|
(define regexp-replace #f)
|
|
(define regexp-replace-all #f)
|
|
|
|
(let ()
|
|
|
|
;; Utility function
|
|
;; Given a string and a set of substitutions, return the substitued 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 ((string->regexp "\\\\[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
|
|
;; This function takes an iterator function to allow multiple substitution
|
|
;; (iterator function = Identity for regexp-replace)
|
|
(set! regexp-replace
|
|
(lambda (pat str subst)
|
|
(let* ((regexp (cond
|
|
((regexp? pat) pat)
|
|
((string? pat) (string->regexp pat))
|
|
(else (error "regexp-replace: Bad pattern '~1'" pat))))
|
|
(match (regexp 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 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)))))
|
|
(let ((regexp (cond
|
|
((regexp? pat) pat)
|
|
((string? pat) (string->regexp pat))
|
|
(else (error "regexp-replace: Bad pattern '~1'" pat)))))
|
|
(regexp-replace-all-r regexp str subst))))))
|
|
|
|
(provide "regexp")
|