Rehacked regexp-substitute/global; I can't remember why.

Fixed string-match to handle a regexp passed as a string.
This commit is contained in:
shivers 1998-05-02 17:33:50 +00:00
parent 21ac090065
commit 3239ff9076
1 changed files with 67 additions and 38 deletions

View File

@ -95,8 +95,11 @@
(let ((start (:optional maybe-start 0)) (let ((start (:optional maybe-start 0))
(start-vec (make-vector 10)) (start-vec (make-vector 10))
(end-vec (make-vector 10))) (end-vec (make-vector 10)))
(receive (err match?) (%string-match pattern string start (receive (err match?) (if (regexp? pattern)
start-vec end-vec) (%regexp-exec (%regexp:bytes pattern)
string start start-vec end-vec)
(%string-match pattern string start
start-vec end-vec))
(if err (error err string-match pattern string start) (if err (error err string-match pattern string start)
(and match? (make-regexp-match string start-vec end-vec)))))) (and match? (make-regexp-match string start-vec end-vec))))))
@ -158,6 +161,7 @@
(define (regexp-substitute/global port re str . items) (define (regexp-substitute/global port re str . items)
(let ((re (->regexp re)) (let ((re (->regexp re))
(str-len (string-length str))
(range (lambda (start sv ev item) ; Return start & end of (range (lambda (start sv ev item) ; Return start & end of
(cond ((integer? item) ; ITEM's range in STR. (cond ((integer? item) ; ITEM's range in STR.
(values (vector-ref sv item) (values (vector-ref sv item)
@ -169,31 +173,49 @@
(num-posts (reduce (lambda (count item) (num-posts (reduce (lambda (count item)
(+ count (if (eq? item 'post) 1 0))) (+ count (if (eq? item 'post) 1 0)))
0 items))) 0 items)))
(if (and port (< num-posts 2)) (if (and port (< num-posts 2))
;; Output port case, with zero or one POST items. ;; Output port case, with zero or one POST items.
(let recur ((start 0)) (let recur ((start 0))
(if (<= start str-len)
(let ((match (regexp-exec re str start))) (let ((match (regexp-exec re str start)))
(if match (if match
(let* ((sv (regexp-match:start match)) (let* ((sv (regexp-match:start match))
(ev (regexp-match:end match))) (ev (regexp-match:end match))
(s (vector-ref sv 0))
(e (vector-ref ev 0))
(empty? (= s e)))
(for-each (lambda (item) (for-each (lambda (item)
(cond ((string? item) (write-string item port)) (cond ((string? item) (write-string item port))
((procedure? item) (write-string (item match) port)) ((procedure? item) (write-string (item match) port))
((eq? 'post item) (recur (vector-ref ev 0)))
((eq? 'post0 item)
(if (and empty? (< s str-len))
(write-char (string-ref str s) port)))
((eq? 'post item)
(recur (if empty? (+ 1 e) e)))
(else (receive (si ei) (else (receive (si ei)
(range start sv ev item) (range start sv ev item)
(write-string str port si ei))))) (write-string str port si ei)))))
items)) items))
(write-string str port start)))) ; No match. (write-string str port start))))) ; No match.
;; Either we're making a string, or >1 POST.
(let* ((pieces (let recur ((start 0)) (let* ((pieces (let recur ((start 0))
(if (> start str-len) '()
(let ((match (regexp-exec re str start)) (let ((match (regexp-exec re str start))
(cached-post #f)) (cached-post #f))
(if match (if match
(let* ((sv (regexp-match:start match)) (let* ((sv (regexp-match:start match))
(ev (regexp-match:end match))) (ev (regexp-match:end match))
(s (vector-ref sv 0))
(e (vector-ref ev 0))
(empty? (= s e)))
(reduce (lambda (pieces item) (reduce (lambda (pieces item)
(cond ((string? item) (cond ((string? item)
(cons item pieces)) (cons item pieces))
@ -201,10 +223,16 @@
((procedure? item) ((procedure? item)
(cons (item match) pieces)) (cons (item match) pieces))
((eq? 'post0 item)
(if (and empty? (< s str-len))
(cons (string (string-ref str s))
pieces)
pieces))
((eq? 'post item) ((eq? 'post item)
(if (not cached-post) (if (not cached-post)
(set! cached-post (set! cached-post
(recur (vector-ref ev 0)))) (recur (if empty? (+ e 1) e))))
(append cached-post pieces)) (append cached-post pieces))
(else (receive (si ei) (else (receive (si ei)
@ -215,7 +243,8 @@
;; No match. Return str[start,end]. ;; No match. Return str[start,end].
(list (if (zero? start) str (list (if (zero? start) str
(substring str start (string-length str)))))))) (substring str start (string-length str)))))))))
(pieces (reverse pieces))) (pieces (reverse pieces)))
(if port (for-each (lambda (p) (write-string p port)) pieces) (if port (for-each (lambda (p) (write-string p port)) pieces)
(apply string-append pieces)))))) (apply string-append pieces))))))