Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
peg	[ DIR ]	drwxr-xr-x
and-let-star.scm	2.53 KB	-rw-r--r--
arrays.scm	2.63 KB	-rw-r--r--
atomic.scm	1.55 KB	-rw-r--r--
binary-ports.scm	2.71 KB	-rw-r--r--
boot-9.scm	166.42 KB	-rw-r--r--
buffered-input.scm	4.82 KB	-rw-r--r--
calling.scm	10.54 KB	-rw-r--r--
command-line.scm	18.6 KB	-rw-r--r--
common-list.scm	8.95 KB	-rw-r--r--
control.scm	4.08 KB	-rw-r--r--
copy-tree.scm	3.05 KB	-rw-r--r--
curried-definitions.scm	1.79 KB	-rw-r--r--
deprecated.scm	1.54 KB	-rw-r--r--
documentation.scm	7.41 KB	-rw-r--r--
eval-string.scm	2.99 KB	-rw-r--r--
eval.scm	25.08 KB	-rw-r--r--
exceptions.scm	14.38 KB	-rw-r--r--
expect.scm	5.5 KB	-rw-r--r--
fdes-finalizers.scm	1.06 KB	-rw-r--r--
format.scm	65.47 KB	-rw-r--r--
ftw.scm	25.06 KB	-rw-r--r--
futures.scm	10.49 KB	-rw-r--r--
gap-buffer.scm	9.59 KB	-rw-r--r--
getopt-long.scm	16.49 KB	-rw-r--r--
hash-table.scm	1.77 KB	-rw-r--r--
hcons.scm	2.55 KB	-rw-r--r--
history.scm	2.29 KB	-rw-r--r--
i18n.scm	20.51 KB	-rw-r--r--
iconv.scm	3.19 KB	-rw-r--r--
lineio.scm	3.85 KB	-rw-r--r--
list.scm	1.29 KB	-rw-r--r--
local-eval.scm	9.84 KB	-rw-r--r--
ls.scm	3.2 KB	-rw-r--r--
match.scm	2.18 KB	-rw-r--r--
match.upstream.scm	35.93 KB	-rw-r--r--
networking.scm	3.33 KB	-rw-r--r--
null.scm	1.21 KB	-rw-r--r--
occam-channel.scm	7.26 KB	-rw-r--r--
optargs.scm	15.75 KB	-rw-r--r--
peg.scm	1.64 KB	-rw-r--r--
poe.scm	3.3 KB	-rw-r--r--
poll.scm	5.79 KB	-rw-r--r--
popen.scm	9.27 KB	-rw-r--r--
ports.scm	19.08 KB	-rw-r--r--
posix.scm	2.73 KB	-rw-r--r--
pretty-print.scm	16.88 KB	-rw-r--r--
psyntax-pp.scm	182.88 KB	-rw-r--r--
psyntax.scm	148.97 KB	-rw-r--r--
q.scm	4.2 KB	-rw-r--r--
quasisyntax.scm	5.22 KB	-rw-r--r--
r5rs.scm	1.56 KB	-rw-r--r--
r6rs-libraries.scm	10.38 KB	-rw-r--r--
r7rs-libraries.scm	4.28 KB	-rw-r--r--
rdelim.scm	7.72 KB	-rw-r--r--
read.scm	32.52 KB	-rw-r--r--
readline.scm	9.56 KB	-rw-r--r--
receive.scm	1.06 KB	-rw-r--r--
regex.scm	8.87 KB	-rw-r--r--
runq.scm	8.18 KB	-rw-r--r--
rw.scm	1.02 KB	-rw-r--r--
safe-r5rs.scm	7.5 KB	-rw-r--r--
safe.scm	1.25 KB	-rw-r--r--
sandbox.scm	34.24 KB	-rw-r--r--
save-stack.scm	2.15 KB	-rw-r--r--
scm-style-repl.scm	11.62 KB	-rw-r--r--
serialize.scm	3.78 KB	-rw-r--r--
session.scm	17.72 KB	-rw-r--r--
slib.scm	1.55 KB	-rw-r--r--
stack-catch.scm	1.94 KB	-rw-r--r--
streams.scm	5.86 KB	-rw-r--r--
string-fun.scm	9.68 KB	-rw-r--r--
suspendable-ports.scm	29.86 KB	-rw-r--r--
textual-ports.scm	2.29 KB	-rw-r--r--
threads.scm	12.54 KB	-rw-r--r--
time.scm	2.07 KB	-rw-r--r--
top-repl.scm	2.63 KB	-rw-r--r--
unicode.scm	1005 B	-rw-r--r--
vlist.scm	21.56 KB	-rw-r--r--
weak-vector.scm	1.2 KB	-rw-r--r--

Code Editor : regex.scm

;;;;    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
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;; 
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;;;; Lesser General Public License for more details.
;;;; 
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
;;;;

;;; Commentary:

;; These procedures are exported:
;;  (match:count match)
;;  (match:string match)
;;  (match:prefix match)
;;  (match:suffix match)
;;  (regexp-match? match)
;;  (regexp-quote string)
;;  (match:start match . submatch-num)
;;  (match:end match . submatch-num)
;;  (match:substring match . submatch-num)
;;  (string-match pattern str . start)
;;  (regexp-substitute port match . items)
;;  (fold-matches regexp string init proc . flags)
;;  (list-matches regexp string . flags)
;;  (regexp-substitute/global port regexp string . items)

;;; Code:

;;;; POSIX regex support functions.

(define-module (ice-9 regex)
  #:export (match:count match:string match:prefix match:suffix
           regexp-match? regexp-quote match:start match:end match:substring
           string-match regexp-substitute fold-matches list-matches
           regexp-substitute/global))

;; References:
;;
;; POSIX spec:
;; http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap09.html

;;; FIXME:
;;;   It is not clear what should happen if a `match' function
;;;   is passed a `match number' which is out of bounds for the
;;;   regexp match: return #f, or throw an error?  These routines
;;;   throw an out-of-range error.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; These procedures are not defined in SCSH, but I found them useful.

(define (match:count match)
  (- (vector-length match) 1))

(define (match:string match)
  (vector-ref match 0))

(define (match:prefix match)
  (substring (match:string match) 0 (match:start match 0)))

(define (match:suffix match)
  (substring (match:string match) (match:end match 0)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;; SCSH compatibility routines.

(define (regexp-match? match)
  (and (vector? match)
       (string? (vector-ref match 0))
       (let loop ((i 1))
         (cond ((>= i (vector-length match)) #t)
               ((and (pair? (vector-ref match i))
                     (integer? (car (vector-ref match i)))
                     (integer? (cdr (vector-ref match i))))
                (loop (+ 1 i)))
               (else #f)))))

;; * . \ ^ $ and [ are special in both regexp/basic and regexp/extended and
;; can be backslash escaped.
;;
;; ( ) + ? { } and | are special in regexp/extended so must be quoted.  But
;; that can't be done with a backslash since in regexp/basic where they're
;; not special, adding a backslash makes them become special.  Character
;; class forms [(] etc are used instead.
;;
;; ) is not special when not preceded by a (, and * and ? are not special at
;; the start of a string, but we quote all of these always, so the result
;; can be concatenated or merged into some larger regexp.
;;
;; ] is not special outside a [ ] character class, so doesn't need to be
;; quoted.
;;
(define (regexp-quote string)
  (call-with-output-string
   (lambda (p)
     (string-for-each (lambda (c)
                        (case c
                          ((#\* #\. #\\ #\^ #\$ #\[)
                           (write-char #\\ p)
                           (write-char c p))
                          ((#$ #$ #\+ #\? #\{ #\} #\|)
                           (write-char #\[ p)
                           (write-char c p)
                           (write-char #\] p))
                          (else
                           (write-char c p))))
                      string))))

(define* (match:start match #:optional (n 0))
  (let ((start (car (vector-ref match (1+ n)))))
    (if (= start -1) #f start)))

(define* (match:end match #:optional (n 0))
  (let* ((end (cdr (vector-ref match (1+ n)))))
    (if (= end -1) #f end)))

(define* (match:substring match #:optional (n 0))
  (let* ((start (match:start match n))
         (end   (match:end match n)))
    (and start end (substring (match:string match) start end))))

(define (string-match pattern str . args)
  (let ((rx (make-regexp pattern))
        (start (if (pair? args) (car args) 0)))
    (regexp-exec rx str start)))

(define (regexp-substitute port match . items)
  ;; If `port' is #f, send output to a string.
  (if (not port)
      (call-with-output-string
       (lambda (p)
         (apply regexp-substitute p match items)))

;; Otherwise, process each substitution argument in `items'.
      (for-each (lambda (obj)
                  (cond ((string? obj)   (display obj port))
                        ((integer? obj)  (display (match:substring match obj) port))
                        ((eq? 'pre obj)  (display (match:prefix match) port))
                        ((eq? 'post obj) (display (match:suffix match) port))
                        (else (error 'wrong-type-arg obj))))
                items)))

;;; 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
;;; many empty strings are there in the string "a"?  Our answer:
;;;
;;;     This function applies PROC to every non-overlapping, maximal
;;;     match of REGEXP in STRING.
;;;
;;; "non-overlapping": There are two non-overlapping matches of "" in
;;; "a" --- one before the `a', and one after.  There are three
;;; non-overlapping matches of "q|x*" in "aqb": the empty strings
;;; before `a' and after `b', and `q'.  The two empty strings before
;;; and after `q' don't count, because they overlap with the match of
;;; "q".
;;;
;;; "maximal": There are three distinct maximal matches of "x*" in
;;; "axxxb": one before the `a', one covering `xxx', and one after the
;;; `b'.  Around or within `xxx', only the match covering all three
;;; x's counts, because the rest are not maximal.

(define* (fold-matches regexp string init proc #:optional (flags 0))
  (let ((regexp (if (regexp? regexp) regexp (make-regexp regexp))))
    (let loop ((start 0)
               (value init)
               (abuts #f))              ; True if start abuts a previous match.
      (define bol (if (zero? start) 0 regexp/notbol))
      (let ((m (if (> start (string-length string)) #f
                   (regexp-exec regexp string start (logior flags bol)))))
        (cond
         ((not m) value)
         ((and (= (match:start m) (match:end m)) abuts)
          ;; We matched an empty string, but that would overlap the
          ;; match immediately before.  Try again at a position
          ;; further to the right.
          (loop (+ start 1) value #f))
         (else
          (loop (match:end m) (proc m value) #t)))))))

(define* (list-matches regexp string #:optional (flags 0))
  (reverse! (fold-matches regexp string '() cons flags)))

(define (regexp-substitute/global port regexp string . items)

;; If `port' is #f, send output to a string.
  (if (not port)
      (call-with-output-string
       (lambda (p)
         (apply regexp-substitute/global p regexp string items)))

;; Walk the set of non-overlapping, maximal matches.
      (let next-match ((matches (list-matches regexp string))
                       (start 0))
        (if (null? matches)
            (display (substring string start) port)
            (let ((m (car matches)))

;; Process all of the items for this match.  Don't use
              ;; for-each, because we need to make sure 'post at the
              ;; end of the item list is a tail call.
              (let next-item ((items items))

(define (do-item item)
                  (cond
                   ((string? item)    (display item port))
                   ((integer? item)   (display (match:substring m item) port))
                   ((procedure? item) (display (item m) port))
                   ((eq? item 'pre)
                    (display
                     (substring string start (match:start m))
                     port))
                   ((eq? item 'post)
                    (next-match (cdr matches) (match:end m)))
                   (else (error 'wrong-type-arg item))))

(if (pair? items)
                    (if (null? (cdr items))
                        (do-item (car items)) ; This is a tail call.
                        (begin
                          (do-item (car items)) ; This is not.
                          (next-item (cdr items)))))))))))

${this.title}

Code Editor : regex.scm