1 ;;; "MISCIO" Search for string from port.
2 ; Written 1995, 1996 by Oleg Kiselyov (oleg@ponder.csci.unt.edu)
3 ; Modified 1996, 1997, 1998 by A. Jaffer (jaffer@ai.mit.edu)
5 ; This code is in the public domain.
7 ;;; Return the index of the first occurence of a-char in str, or #f
8 (define (string-index str a-char)
11 ;; whole string has been searched, in vain
12 ((>= pos (string-length str)) #f)
13 ((char=? a-char (string-ref str pos)) pos)
14 (else (loop (+ 1 pos))))))
16 (define (string-index-ci str a-char)
19 ;; whole string has been searched, in vain
20 ((>= pos (string-length str)) #f)
21 ((char-ci=? a-char (string-ref str pos)) pos)
22 (else (loop (+ 1 pos))))))
24 (define (string-reverse-index str a-char)
25 (let loop ((pos (- (string-length str) 1)))
27 ((char=? (string-ref str pos) a-char) pos)
28 (else (loop (- pos 1))))))
30 (define (string-reverse-index-ci str a-char)
31 (let loop ((pos (- (string-length str) 1)))
33 ((char-ci=? (string-ref str pos) a-char) pos)
34 (else (loop (- pos 1))))))
36 (define (miscio:substring? pattern str char=?)
37 (let* ((pat-len (string-length pattern))
38 (search-span (- (string-length str) pat-len))
39 (c1 (if (zero? pat-len) #f (string-ref pattern 0)))
40 (c2 (if (<= pat-len 1) #f (string-ref pattern 1))))
42 ((not c1) 0) ; empty pattern, matches upfront
43 ((not c2) (string-index str c1)) ; one-char pattern
44 (else ; matching pattern of > two chars
47 ((> pos search-span) #f) ; nothing was found thru the whole str
48 ((not (char=? c1 (string-ref str pos)))
49 (outer (+ 1 pos))) ; keep looking for the right beginning
50 ((not (char=? c2 (string-ref str (+ 1 pos))))
51 (outer (+ 1 pos))) ; could've done pos+2 if c1 == c2....
52 (else ; two char matched: high probability
53 ; the rest will match too
54 (let inner ((i-pat 2) (i-str (+ 2 pos)))
55 (if (>= i-pat pat-len) pos ; the whole pattern matched
56 (if (char=? (string-ref pattern i-pat)
57 (string-ref str i-str))
58 (inner (+ 1 i-pat) (+ 1 i-str))
59 ;; mismatch after partial match
60 (outer (+ 1 pos))))))))))))
62 (define (substring? pattern str) (miscio:substring? pattern str char=?))
63 (define (substring-ci? pattern str) (miscio:substring? pattern str char-ci=?))
65 (define (find-string-from-port? str <input-port> . max-no-char)
66 (set! max-no-char (if (null? max-no-char) #f (car max-no-char)))
70 (my-peek-char ; Return a peeked char or #f
71 (lambda () (and (or (not (number? max-no-char))
72 (< no-chars-read max-no-char))
73 (let ((c (peek-char <input-port>)))
76 ((procedure? max-no-char)
78 (if (max-no-char c) #f c))
79 ((eqv? max-no-char c) #f)
81 (next-char (lambda () (set! peeked? #f) (read-char <input-port>)
82 (set! no-chars-read (+ 1 no-chars-read))))
83 (match-1st-char ; of the string str
85 (let ((c (my-peek-char)))
88 (if (char=? c (string-ref str 0))
90 (match-1st-char)))))))
91 ;; There has been a partial match, up to the point pos-to-match
92 ;; (for example, str[0] has been found in the stream)
93 ;; Now look to see if str[pos-to-match] for would be found, too
95 (lambda (pos-to-match)
96 (if (>= pos-to-match (string-length str))
97 no-chars-read ; the entire string has matched
98 (let ((c (my-peek-char)))
100 (if (not (char=? c (string-ref str pos-to-match)))
101 (backtrack 1 pos-to-match)
103 (match-other-chars (+ 1 pos-to-match)))))))))
105 ;; There had been a partial match, but then a wrong char showed up.
106 ;; Before discarding previously read (and matched) characters, we check
107 ;; to see if there was some smaller partial match. Note, characters read
108 ;; so far (which matter) are those of str[0..matched-substr-len - 1]
109 ;; In other words, we will check to see if there is such i>0 that
110 ;; substr(str,0,j) = substr(str,i,matched-substr-len)
111 ;; where j=matched-substr-len - i
113 (lambda (i matched-substr-len)
114 (let ((j (- matched-substr-len i)))
116 ;; backed off completely to the begining of str
120 (match-other-chars j) ; there was indeed a shorter match
121 (if (char=? (string-ref str k)
122 (string-ref str (+ i k)))
124 (backtrack (+ 1 i) matched-substr-len))))))))
128 (define (string-subst text old new . rest)
132 (cond ((equal? "" text) text)
133 ((substring? old text)
136 (substring text 0 idx)
139 text (+ idx (string-length old))
140 (string-length text))))))
144 (apply string-subst text rest))))