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-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
|
|
;;;;
|
|
;;;; Permission to use, copy, modify, distribute,and license this
|
|
;;;; software and its documentation for any purpose is hereby granted,
|
|
;;;; provided that existing copyright notices are retained in all
|
|
;;;; copies and that this notice is included verbatim in any
|
|
;;;; distributions. No written agreement, license, or royalty fee is
|
|
;;;; required for any of the authorized uses.
|
|
;;;; 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: 3-Sep-1999 19:54 (eg)
|
|
;;;;
|
|
;;;; 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")
|