Added regexp-substitute and regexp-substitute/global.
This commit is contained in:
parent
73844bc6ee
commit
1a2d8690ce
58
scsh/re.scm
58
scsh/re.scm
|
@ -148,6 +148,64 @@
|
||||||
0 items)
|
0 items)
|
||||||
ans))))
|
ans))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
(define (regexp-substitute/global port str re . items)
|
||||||
|
(let ((range (lambda (start item) ; Return start & end of
|
||||||
|
(cond ((integer? item) ; ITEM's range in STR.
|
||||||
|
(values (vector-ref sv item)
|
||||||
|
(vector-ref ev item)))
|
||||||
|
((eq? 'pre item) (values start (vector-ref sv 0)))
|
||||||
|
(else (error "Illegal substitution item."
|
||||||
|
item
|
||||||
|
regexp-substitute)))))
|
||||||
|
(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 (string-match re str start)))
|
||||||
|
(and match
|
||||||
|
(let* ((sv (regexp-match:start match))
|
||||||
|
(ev (regexp-match:end match)))
|
||||||
|
(for-each (lambda (item)
|
||||||
|
(cond ((string? item) (write-string item port))
|
||||||
|
((eq? 'post item)
|
||||||
|
(let ((post-start (vector-ref ev 0)))
|
||||||
|
(or (recur post-start)
|
||||||
|
(write-string item port post-start))))
|
||||||
|
(else (receive (si ei) (range start item)
|
||||||
|
(write-string str port si ei)))))
|
||||||
|
items)
|
||||||
|
#t))))
|
||||||
|
|
||||||
|
(let ((pieces (let recur ((start 0))
|
||||||
|
(let ((match (string-match re str start))
|
||||||
|
(cached-post #f))
|
||||||
|
(and match
|
||||||
|
(let* ((sv (regexp-match:start match))
|
||||||
|
(ev (regexp-match:end match)))
|
||||||
|
(reduce (lambda (pieces item)
|
||||||
|
(cond ((string? item) (cons item pieces))
|
||||||
|
((eq? 'post item)
|
||||||
|
(append (or cached-post
|
||||||
|
(begin (set! cached-post
|
||||||
|
(recur (vector-ref ev 0)))
|
||||||
|
cached-post))
|
||||||
|
pieces))
|
||||||
|
(else (receive (si ei) (range start item)
|
||||||
|
(cons (substring str si e1)
|
||||||
|
pieces)))))
|
||||||
|
0 items)))))))
|
||||||
|
(and pieces
|
||||||
|
(let ((pieces (reverse pieces)))
|
||||||
|
(if port (for-each (lambda (p) (write-string p port)) pieces)
|
||||||
|
(apply string-append pieces))))))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;;; Miscellaneous
|
;;; Miscellaneous
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
|
@ -427,6 +427,7 @@
|
||||||
regexp?
|
regexp?
|
||||||
regexp-exec
|
regexp-exec
|
||||||
regexp-substitute
|
regexp-substitute
|
||||||
|
regexp-substitute/global
|
||||||
regexp-quote))
|
regexp-quote))
|
||||||
|
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue