diff --git a/scsh/re.scm b/scsh/re.scm index e44a005..9bbc802 100644 --- a/scsh/re.scm +++ b/scsh/re.scm @@ -95,8 +95,11 @@ (let ((start (:optional maybe-start 0)) (start-vec (make-vector 10)) (end-vec (make-vector 10))) - (receive (err match?) (%string-match pattern string start - start-vec end-vec) + (receive (err match?) (if (regexp? pattern) + (%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) (and match? (make-regexp-match string start-vec end-vec)))))) @@ -158,6 +161,7 @@ (define (regexp-substitute/global port re str . items) (let ((re (->regexp re)) + (str-len (string-length str)) (range (lambda (start sv ev item) ; Return start & end of (cond ((integer? item) ; ITEM's range in STR. (values (vector-ref sv item) @@ -169,53 +173,78 @@ (num-posts (reduce (lambda (count item) (+ count (if (eq? item 'post) 1 0))) 0 items))) + (if (and port (< num-posts 2)) ;; Output port case, with zero or one POST items. (let recur ((start 0)) - (let ((match (regexp-exec re str start))) - (if match - (let* ((sv (regexp-match:start match)) - (ev (regexp-match:end match))) - (for-each (lambda (item) - (cond ((string? item) (write-string item port)) - ((procedure? item) (write-string (item match) port)) - ((eq? 'post item) (recur (vector-ref ev 0))) - (else (receive (si ei) - (range start sv ev item) - (write-string str port si ei))))) - items)) + (if (<= start str-len) + (let ((match (regexp-exec re str start))) + (if match + (let* ((sv (regexp-match:start match)) + (ev (regexp-match:end match)) + (s (vector-ref sv 0)) + (e (vector-ref ev 0)) + (empty? (= s e))) + (for-each (lambda (item) + (cond ((string? item) (write-string item port)) - (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 ((match (regexp-exec re str start)) - (cached-post #f)) - (if match - (let* ((sv (regexp-match:start match)) - (ev (regexp-match:end match))) - (reduce (lambda (pieces item) - (cond ((string? item) - (cons item pieces)) + (if (> start str-len) '() + (let ((match (regexp-exec re str start)) + (cached-post #f)) + (if match + (let* ((sv (regexp-match:start match)) + (ev (regexp-match:end match)) + (s (vector-ref sv 0)) + (e (vector-ref ev 0)) + (empty? (= s e))) + (reduce (lambda (pieces item) + (cond ((string? item) + (cons item pieces)) - ((procedure? item) - (cons (item match) pieces)) + ((procedure? item) + (cons (item match) pieces)) - ((eq? 'post item) - (if (not cached-post) - (set! cached-post - (recur (vector-ref ev 0)))) - (append cached-post pieces)) + ((eq? 'post0 item) + (if (and empty? (< s str-len)) + (cons (string (string-ref str s)) + pieces) + pieces)) - (else (receive (si ei) - (range start sv ev item) - (cons (substring str si ei) - pieces))))) - '() items)) + ((eq? 'post item) + (if (not cached-post) + (set! cached-post + (recur (if empty? (+ e 1) e)))) + (append cached-post pieces)) - ;; No match. Return str[start,end]. - (list (if (zero? start) str - (substring str start (string-length str)))))))) + (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))))))))) + (pieces (reverse pieces))) (if port (for-each (lambda (p) (write-string p port)) pieces) (apply string-append pieces))))))