stk/Lib/regexp.stk

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")