mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-09 13:30:26 +02:00
untabify (ice-9 regex)
* module/ice-9/regex.scm: Untabify.
This commit is contained in:
Andy Wingo
parent
ab6becd47f
commit
bd6fed8e23
1 changed files with 81 additions and 81 deletions
|
|
@ -1,4 +1,4 @@
|
||||||
;;;; Copyright (C) 1997, 1999, 2001, 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
|
;;;; Copyright (C) 1997, 1999, 2001, 2004, 2005, 2006, 2008, 2010 Free Software Foundation, Inc.
|
||||||
;;;;
|
;;;;
|
||||||
;;;; This library is free software; you can redistribute it and/or
|
;;;; This library is free software; you can redistribute it and/or
|
||||||
;;;; modify it under the terms of the GNU Lesser General Public
|
;;;; modify it under the terms of the GNU Lesser General Public
|
||||||
|
|
@ -38,10 +38,10 @@
|
||||||
;;;; POSIX regex support functions.
|
;;;; POSIX regex support functions.
|
||||||
|
|
||||||
(define-module (ice-9 regex)
|
(define-module (ice-9 regex)
|
||||||
:export (match:count match:string match:prefix match:suffix
|
#:export (match:count match:string match:prefix match:suffix
|
||||||
regexp-match? regexp-quote match:start match:end match:substring
|
regexp-match? regexp-quote match:start match:end match:substring
|
||||||
string-match regexp-substitute fold-matches list-matches
|
string-match regexp-substitute fold-matches list-matches
|
||||||
regexp-substitute/global))
|
regexp-substitute/global))
|
||||||
|
|
||||||
;; References:
|
;; References:
|
||||||
;;
|
;;
|
||||||
|
|
@ -76,12 +76,12 @@
|
||||||
(and (vector? match)
|
(and (vector? match)
|
||||||
(string? (vector-ref match 0))
|
(string? (vector-ref match 0))
|
||||||
(let loop ((i 1))
|
(let loop ((i 1))
|
||||||
(cond ((>= i (vector-length match)) #t)
|
(cond ((>= i (vector-length match)) #t)
|
||||||
((and (pair? (vector-ref match i))
|
((and (pair? (vector-ref match i))
|
||||||
(integer? (car (vector-ref match i)))
|
(integer? (car (vector-ref match i)))
|
||||||
(integer? (cdr (vector-ref match i))))
|
(integer? (cdr (vector-ref match i))))
|
||||||
(loop (+ 1 i)))
|
(loop (+ 1 i)))
|
||||||
(else #f)))))
|
(else #f)))))
|
||||||
|
|
||||||
;; * . \ ^ $ and [ are special in both regexp/basic and regexp/extended and
|
;; * . \ ^ $ and [ are special in both regexp/basic and regexp/extended and
|
||||||
;; can be backslash escaped.
|
;; can be backslash escaped.
|
||||||
|
|
@ -102,43 +102,43 @@
|
||||||
(call-with-output-string
|
(call-with-output-string
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(string-for-each (lambda (c)
|
(string-for-each (lambda (c)
|
||||||
(case c
|
(case c
|
||||||
((#\* #\. #\\ #\^ #\$ #\[)
|
((#\* #\. #\\ #\^ #\$ #\[)
|
||||||
(write-char #\\ p)
|
(write-char #\\ p)
|
||||||
(write-char c p))
|
(write-char c p))
|
||||||
((#\( #\) #\+ #\? #\{ #\} #\|)
|
((#\( #\) #\+ #\? #\{ #\} #\|)
|
||||||
(write-char #\[ p)
|
(write-char #\[ p)
|
||||||
(write-char c p)
|
(write-char c p)
|
||||||
(write-char #\] p))
|
(write-char #\] p))
|
||||||
(else
|
(else
|
||||||
(write-char c p))))
|
(write-char c p))))
|
||||||
string))))
|
string))))
|
||||||
|
|
||||||
(define (match:start match . args)
|
(define (match:start match . args)
|
||||||
(let* ((matchnum (if (pair? args)
|
(let* ((matchnum (if (pair? args)
|
||||||
(+ 1 (car args))
|
(+ 1 (car args))
|
||||||
1))
|
1))
|
||||||
(start (car (vector-ref match matchnum))))
|
(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 . args)
|
||||||
(let* ((matchnum (if (pair? args)
|
(let* ((matchnum (if (pair? args)
|
||||||
(+ 1 (car args))
|
(+ 1 (car args))
|
||||||
1))
|
1))
|
||||||
(end (cdr (vector-ref match matchnum))))
|
(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 . args)
|
||||||
(let* ((matchnum (if (pair? args)
|
(let* ((matchnum (if (pair? args)
|
||||||
(car args)
|
(car args)
|
||||||
0))
|
0))
|
||||||
(start (match:start match matchnum))
|
(start (match:start match matchnum))
|
||||||
(end (match:end 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)
|
||||||
(let ((rx (make-regexp pattern))
|
(let ((rx (make-regexp pattern))
|
||||||
(start (if (pair? args) (car args) 0)))
|
(start (if (pair? args) (car args) 0)))
|
||||||
(regexp-exec rx str start)))
|
(regexp-exec rx str start)))
|
||||||
|
|
||||||
(define (regexp-substitute port match . items)
|
(define (regexp-substitute port match . items)
|
||||||
|
|
@ -146,22 +146,22 @@
|
||||||
(if (not port)
|
(if (not port)
|
||||||
(call-with-output-string
|
(call-with-output-string
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(apply regexp-substitute p match items)))
|
(apply regexp-substitute p match items)))
|
||||||
|
|
||||||
;; Otherwise, process each substitution argument in `items'.
|
;; Otherwise, process each substitution argument in `items'.
|
||||||
(for-each (lambda (obj)
|
(for-each (lambda (obj)
|
||||||
(cond ((string? obj) (display obj port))
|
(cond ((string? obj) (display obj port))
|
||||||
((integer? obj) (display (match:substring match obj) port))
|
((integer? obj) (display (match:substring match obj) port))
|
||||||
((eq? 'pre obj) (display (match:prefix match) port))
|
((eq? 'pre obj) (display (match:prefix match) port))
|
||||||
((eq? 'post obj) (display (match:suffix match) port))
|
((eq? 'post obj) (display (match:suffix match) port))
|
||||||
(else (error 'wrong-type-arg obj))))
|
(else (error 'wrong-type-arg obj))))
|
||||||
items)))
|
items)))
|
||||||
|
|
||||||
;;; If we call fold-matches, below, with a regexp that can match the
|
;;; If we call fold-matches, below, with a regexp that can match the
|
||||||
;;; empty string, it's not obvious what "all the matches" means. How
|
;;; empty string, it's not obvious what "all the matches" means. How
|
||||||
;;; many empty strings are there in the string "a"? Our answer:
|
;;; many empty strings are there in the string "a"? Our answer:
|
||||||
;;;
|
;;;
|
||||||
;;; This function applies PROC to every non-overlapping, maximal
|
;;; This function applies PROC to every non-overlapping, maximal
|
||||||
;;; match of REGEXP in STRING.
|
;;; match of REGEXP in STRING.
|
||||||
;;;
|
;;;
|
||||||
;;; "non-overlapping": There are two non-overlapping matches of "" in
|
;;; "non-overlapping": There are two non-overlapping matches of "" in
|
||||||
|
|
@ -178,21 +178,21 @@
|
||||||
|
|
||||||
(define (fold-matches regexp string init proc . flags)
|
(define (fold-matches regexp string init proc . flags)
|
||||||
(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))))
|
(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.
|
||||||
(let ((m (if (> start (string-length string)) #f
|
(let ((m (if (> start (string-length string)) #f
|
||||||
(regexp-exec regexp string start flags))))
|
(regexp-exec regexp string start flags))))
|
||||||
(cond
|
(cond
|
||||||
((not m) value)
|
((not m) value)
|
||||||
((and (= (match:start m) (match:end m)) abuts)
|
((and (= (match:start m) (match:end m)) abuts)
|
||||||
;; We matched an empty string, but that would overlap the
|
;; We matched an empty string, but that would overlap the
|
||||||
;; match immediately before. Try again at a position
|
;; match immediately before. Try again at a position
|
||||||
;; further to the right.
|
;; further to the right.
|
||||||
(loop (+ start 1) value #f))
|
(loop (+ start 1) value #f))
|
||||||
(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 . flags)
|
||||||
(reverse! (apply fold-matches regexp string '() cons flags)))
|
(reverse! (apply fold-matches regexp string '() cons flags)))
|
||||||
|
|
@ -203,36 +203,36 @@
|
||||||
(if (not port)
|
(if (not port)
|
||||||
(call-with-output-string
|
(call-with-output-string
|
||||||
(lambda (p)
|
(lambda (p)
|
||||||
(apply regexp-substitute/global p regexp string items)))
|
(apply regexp-substitute/global p regexp string items)))
|
||||||
|
|
||||||
;; Walk the set of non-overlapping, maximal matches.
|
;; Walk the set of non-overlapping, maximal matches.
|
||||||
(let next-match ((matches (list-matches regexp string))
|
(let next-match ((matches (list-matches regexp string))
|
||||||
(start 0))
|
(start 0))
|
||||||
(if (null? matches)
|
(if (null? matches)
|
||||||
(display (substring string start) port)
|
(display (substring string start) port)
|
||||||
(let ((m (car matches)))
|
(let ((m (car matches)))
|
||||||
|
|
||||||
;; Process all of the items for this match. Don't use
|
;; Process all of the items for this match. Don't use
|
||||||
;; for-each, because we need to make sure 'post at the
|
;; for-each, because we need to make sure 'post at the
|
||||||
;; end of the item list is a tail call.
|
;; end of the item list is a tail call.
|
||||||
(let next-item ((items items))
|
(let next-item ((items items))
|
||||||
|
|
||||||
(define (do-item item)
|
(define (do-item item)
|
||||||
(cond
|
(cond
|
||||||
((string? item) (display item port))
|
((string? item) (display item port))
|
||||||
((integer? item) (display (match:substring m item) port))
|
((integer? item) (display (match:substring m item) port))
|
||||||
((procedure? item) (display (item m) port))
|
((procedure? item) (display (item m) port))
|
||||||
((eq? item 'pre)
|
((eq? item 'pre)
|
||||||
(display
|
(display
|
||||||
(substring string start (match:start m))
|
(substring string start (match:start m))
|
||||||
port))
|
port))
|
||||||
((eq? item 'post)
|
((eq? item 'post)
|
||||||
(next-match (cdr matches) (match:end m)))
|
(next-match (cdr matches) (match:end m)))
|
||||||
(else (error 'wrong-type-arg item))))
|
(else (error 'wrong-type-arg item))))
|
||||||
|
|
||||||
(if (pair? items)
|
(if (pair? items)
|
||||||
(if (null? (cdr items))
|
(if (null? (cdr items))
|
||||||
(do-item (car items)) ; This is a tail call.
|
(do-item (car items)) ; This is a tail call.
|
||||||
(begin
|
(begin
|
||||||
(do-item (car items)) ; This is not.
|
(do-item (car items)) ; This is not.
|
||||||
(next-item (cdr items)))))))))))
|
(next-item (cdr items)))))))))))
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue