ice-9/regex.scm

   1 ;;;;    Copyright (C) 1997 Free Software Foundation, Inc.
   2 ;;;;
   3 ;;;; This program is free software; you can redistribute it and/or modify
   4 ;;;; it under the terms of the GNU General Public License as published by
   5 ;;;; the Free Software Foundation; either version 2, or (at your option)
   6 ;;;; any later version.
   7 ;;;;
   8 ;;;; This program is distributed in the hope that it will be useful,
   9 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 ;;;; GNU General Public License for more details.
  12 ;;;;
  13 ;;;; You should have received a copy of the GNU General Public License
  14 ;;;; along with this software; see the file COPYING.  If not, write to
  15 ;;;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  16 ;;;;
  17 \f
  18 ;;;; POSIX regex support functions.
  19
  20 (define-module (ice-9 regex))
  21
  22 ;;; FIXME:
  23 ;;;   It is not clear what should happen if a `match' function
  24 ;;;   is passed a `match number' which is out of bounds for the
  25 ;;;   regexp match: return #f, or throw an error?  These routines
  26 ;;;   throw an out-of-range error.
  27
  28 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  29 ;;;; These procedures are not defined in SCSH, but I found them useful.
  30
  31 (define-public (match:count match)
  32   (- (vector-length match) 1))
  33
  34 (define-public (match:string match)
  35   (vector-ref match 0))
  36
  37 (define-public (match:prefix match)
  38   (make-shared-substring (match:string match)
  39                          0
  40                          (match:start match 0)))
  41
  42 (define-public (match:suffix match)
  43   (make-shared-substring (match:string match)
  44                          (match:end match 0)))
  45
  46 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  47 ;;;; SCSH compatibility routines.
  48
  49 (define-public (regexp-match? match)
  50   (and (vector? match)
  51        (string? (vector-ref match 0))
  52        (let loop ((i 1))
  53          (cond ((>= i (vector-length match)) #t)
  54                ((and (pair? (vector-ref match i))
  55                      (integer? (car (vector-ref match i)))
  56                      (integer? (cdr (vector-ref match i))))
  57                 (loop (+ 1 i)))
  58                (else #f)))))
  59
  60 (define-public (regexp-quote regexp)
  61   (call-with-output-string
  62    (lambda (p)
  63      (let loop ((i 0))
  64        (and (< i (string-length regexp))
  65             (begin
  66               (case (string-ref regexp i)
  67                 ((#\* #\. #\( #\) #\+ #\? #\\ #\^ #\$ #\{ #\})
  68                  (write-char #\\ p)))
  69               (write-char (string-ref regexp i) p)
  70               (loop (1+ i))))))))
  71
  72 (define-public (match:start match . args)
  73   (let* ((matchnum (if (pair? args)
  74                        (+ 1 (car args))
  75                        1))
  76          (start (car (vector-ref match matchnum))))
  77     (if (= start -1) #f start)))
  78
  79 (define-public (match:end match . args)
  80   (let* ((matchnum (if (pair? args)
  81                        (+ 1 (car args))
  82                        1))
  83          (end (cdr (vector-ref match matchnum))))
  84     (if (= end -1) #f end)))
  85
  86 (define-public (match:substring match . args)
  87   (let* ((matchnum (if (pair? args)
  88                        (car args)
  89                        0))
  90          (start (match:start match matchnum))
  91          (end   (match:end match matchnum)))
  92     (and start end (make-shared-substring (match:string match)
  93                                           start
  94                                           end))))
  95
  96 (define-public (string-match pattern str . args)
  97   (let ((rx (make-regexp pattern))
  98         (start (if (pair? args) (car args) 0)))
  99     (regexp-exec rx str start)))
 100
 101 (define-public (regexp-substitute port match . items)
 102   ;; If `port' is #f, send output to a string.
 103   (if (not port)
 104       (call-with-output-string
 105        (lambda (p)
 106          (apply regexp-substitute p match items)))
 107
 108       ;; Otherwise, process each substitution argument in `items'.
 109       (for-each (lambda (obj)
 110                   (cond ((string? obj)   (display obj port))
 111                         ((integer? obj)  (display (match:substring match obj) port))
 112                         ((eq? 'pre obj)  (display (match:prefix match) port))
 113                         ((eq? 'post obj) (display (match:suffix match) port))
 114                         (else (error 'wrong-type-arg obj))))
 115                 items)))
 116
 117 (define-public (regexp-substitute/global port regexp string . items)
 118   ;; If `port' is #f, send output to a string.
 119   (if (not port)
 120       (call-with-output-string
 121        (lambda (p)
 122          (apply regexp-substitute/global p regexp string items)))
 123
 124       ;; Otherwise, compile the regexp and match it against the
 125       ;; string, looping if 'post is encountered in `items'.
 126       (let ((rx (make-regexp regexp)))
 127         (let next-match ((str string))
 128           (let ((match (regexp-exec rx str)))
 129             (if (not match)
 130                 (display str port)
 131
 132                 ;; Process all of the items for this match.
 133                 (for-each
 134                  (lambda (obj)
 135                    (cond
 136                     ((string? obj)    (display obj port))
 137                     ((integer? obj)   (display (match:substring match obj) port))
 138                     ((procedure? obj) (display (obj match) port))
 139                     ((eq? 'pre obj)   (display (match:prefix match) port))
 140                     ((eq? 'post obj)  (next-match (match:suffix match)))
 141                     (else (error 'wrong-type-arg obj))))
 142                  items)))))))
 143