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,53 +173,78 @@
(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))
(let ((match (regexp-exec re str start))) (if (<= start str-len)
(if match (let ((match (regexp-exec re str start)))
(let* ((sv (regexp-match:start match)) (if match
(ev (regexp-match:end match))) (let* ((sv (regexp-match:start match))
(for-each (lambda (item) (ev (regexp-match:end match))
(cond ((string? item) (write-string item port)) (s (vector-ref sv 0))
((procedure? item) (write-string (item match) port)) (e (vector-ref ev 0))
((eq? 'post item) (recur (vector-ref ev 0))) (empty? (= s e)))
(else (receive (si ei) (for-each (lambda (item)
(range start sv ev item) (cond ((string? item) (write-string item port))
(write-string str port si ei)))))
items))
(write-string str port start)))) ; No match. ((procedure? item) (write-string (item match) port))
((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)
(range start sv ev item)
(write-string str port si ei)))))
items))
(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))
(let ((match (regexp-exec re str start)) (if (> start str-len) '()
(cached-post #f)) (let ((match (regexp-exec re str start))
(if match (cached-post #f))
(let* ((sv (regexp-match:start match)) (if match
(ev (regexp-match:end match))) (let* ((sv (regexp-match:start match))
(reduce (lambda (pieces item) (ev (regexp-match:end match))
(cond ((string? item) (s (vector-ref sv 0))
(cons item pieces)) (e (vector-ref ev 0))
(empty? (= s e)))
(reduce (lambda (pieces item)
(cond ((string? item)
(cons item pieces))
((procedure? item) ((procedure? item)
(cons (item match) pieces)) (cons (item match) pieces))
((eq? 'post item) ((eq? 'post0 item)
(if (not cached-post) (if (and empty? (< s str-len))
(set! cached-post (cons (string (string-ref str s))
(recur (vector-ref ev 0)))) pieces)
(append cached-post pieces)) pieces))
(else (receive (si ei) ((eq? 'post item)
(range start sv ev item) (if (not cached-post)
(cons (substring str si ei) (set! cached-post
pieces))))) (recur (if empty? (+ e 1) e))))
'() items)) (append cached-post pieces))
(else (receive (si ei)
(range start sv ev item)
(cons (substring str si ei)
pieces)))))
'() items))
;; No match. Return str[start,end].
(list (if (zero? start) str
(substring str start (string-length str)))))))))
;; No match. Return str[start,end].
(list (if (zero? start) 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))))))