stk/Lib/regexp.stk

106 lines
3.4 KiB
Plaintext
Raw Normal View History

1996-09-27 06:29:02 -04:00
;;;;
;;;; r e g e x p . s t k -- Regular expressions
;;;;
;;;;
1999-09-05 07:16:41 -04:00
;;;; Copyright <20> 1993-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
1996-09-27 06:29:02 -04:00
;;;;
1999-09-05 07:16:41 -04:00
;;;; 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.
1996-09-27 06:29:02 -04:00
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 9-Nov-1994 13:24
1999-09-05 07:16:41 -04:00
;;;; Last file update: 3-Sep-1999 19:54 (eg)
1996-09-27 06:29:02 -04:00
;;;;
;;;; 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")