mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 11:50:28 +02:00
Code Activity

define* in ice-9 regex

Browse source 
* module/ice-9/regex.scm (match:start, match:end, match:substring)
  (fold-matches, list-matches): Reimplement using define*.
This commit is contained in:
Andy Wingo 2010-07-08 17:18:21 +01:00
parent bd6fed8e23
commit ff10e93c3f
1 changed files with 11 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

32
module/ice-9/regex.scm
View file

@ -114,26 +114,17 @@
(write-char c p)))) (write-char c p))))
string)))) string))))
(define (match:start match . args) (define* (match:start match #:optional (n 0))
(let* ((matchnum (if (pair? args) (let ((start (car (vector-ref match (1+ n)))))
(+ 1 (car args))
1))
(start (car (vector-ref match matchnum))))
(if (= start -1) #f start))) (if (= start -1) #f start)))
(define (match:end match . args) (define* (match:end match #:optional (n 0))
(let* ((matchnum (if (pair? args) (let* ((end (cdr (vector-ref match (1+ n)))))
(+ 1 (car args))
1))
(end (cdr (vector-ref match matchnum))))
(if (= end -1) #f end))) (if (= end -1) #f end)))
(define (match:substring match . args) (define* (match:substring match #:optional (n 0))
(let* ((matchnum (if (pair? args) (let* ((start (match:start match n))
(car args) (end (match:end match n)))
0))
(start (match:start match matchnum))
(end (match:end match matchnum)))
(and start end (substring (match:string match) start end)))) (and start end (substring (match:string match) start end))))
(define (string-match pattern str . args) (define (string-match pattern str . args)
@ -176,9 +167,8 @@
;;; `b'. Around or within `xxx', only the match covering all three ;;; `b'. Around or within `xxx', only the match covering all three
;;; x's counts, because the rest are not maximal. ;;; x's counts, because the rest are not maximal.
(define (fold-matches regexp string init proc . flags) (define* (fold-matches regexp string init proc #:optional (flags 0))
(let ((regexp (if (regexp? regexp) regexp (make-regexp regexp))) (let ((regexp (if (regexp? regexp) regexp (make-regexp regexp))))
(flags (if (null? flags) 0 (car flags))))
(let loop ((start 0) (let loop ((start 0)
(value init) (value init)
(abuts #f)) ; True if start abuts a previous match. (abuts #f)) ; True if start abuts a previous match.
@ -194,8 +184,8 @@
(else (else
(loop (match:end m) (proc m value) #t))))))) (loop (match:end m) (proc m value) #t)))))))
(define (list-matches regexp string . flags) (define* (list-matches regexp string #:optional (flags 0))
(reverse! (apply fold-matches regexp string '() cons flags))) (reverse! (fold-matches regexp string '() cons flags)))
(define (regexp-substitute/global port regexp string . items) (define (regexp-substitute/global port regexp string . items)