author | Tony Garnock-Jones <tonygarnockjones@gmail.com> |
Tue, 25 May 2010 08:09:57 +1200 | |
changeset 285 | 034958cf32d9 |
parent 11 | 089a57807585 |
permissions | -rw-r--r-- |
11
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
1 |
;Configured for Common Lisp CLISP 2.33.2 (2004-06-02) (built 3322385124) (memory 3322385911) by scmxlate, v 2004-09-08, |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
2 |
;(c) Dorai Sitaram, |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
3 |
;http://www.ccs.neu.edu/~dorai/scmxlate/scmxlate.html |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
4 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
5 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
6 |
(defparameter *pregexp-version* 20050425) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
7 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
8 |
(defparameter *pregexp-comment-char* #\;) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
9 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
10 |
(defparameter *pregexp-nul-char-int* (- (char-code #\a) 97)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
11 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
12 |
(defparameter *pregexp-return-char* (code-char (+ 13 *pregexp-nul-char-int*))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
13 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
14 |
(defparameter *pregexp-tab-char* (code-char (+ 9 *pregexp-nul-char-int*))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
15 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
16 |
(defparameter *pregexp-space-sensitive?* t) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
17 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
18 |
(defun pregexp-error (&rest whatever) (princ "Error:") |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
19 |
(mapc #'(lambda (x) (princ #\space) (prin1 x)) whatever) (terpri) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
20 |
(error "pregexp-error")) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
21 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
22 |
(defun pregexp-read-pattern (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
23 |
(if (>= i n) (list (list ':or (list ':seq)) i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
24 |
(let ((branches 'nil) (i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
25 |
(flet ((loop! (branches i) (throw 'loop! (values branches i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
26 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
27 |
(multiple-value-setq (branches i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
28 |
(let ((branches branches) (i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
29 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
30 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
31 |
(if (or (>= i n) (char= (char s i) #\))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
32 |
(list (cons ':or (nreverse branches)) i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
33 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
34 |
((vv |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
35 |
(pregexp-read-branch s (if (char= (char s i) #\|) (+ i 1) i) n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
36 |
(loop! (cons (car vv) branches) (cadr vv))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
37 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
38 |
(defun pregexp-read-branch (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
39 |
(let ((pieces 'nil) (i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
40 |
(flet ((loop! (pieces i) (throw 'loop! (values pieces i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
41 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
42 |
(multiple-value-setq (pieces i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
43 |
(let ((pieces pieces) (i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
44 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
45 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
46 |
(cond ((>= i n) (list (cons ':seq (nreverse pieces)) i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
47 |
((let ((c (char s i))) (or (char= c #\|) (char= c #\)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
48 |
(list (cons ':seq (nreverse pieces)) i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
49 |
(t |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
50 |
(let ((vv (pregexp-read-piece s i n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
51 |
(loop! (cons (car vv) pieces) (cadr vv))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
52 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
53 |
(defun pregexp-read-piece (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
54 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
55 |
(case c ((#\^) (list ':bos (+ i 1))) ((#\$) (list ':eos (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
56 |
((#\.) (pregexp-wrap-quantifier-if-any (list ':any (+ i 1)) s n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
57 |
((#\[) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
58 |
(let ((i+1 (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
59 |
(pregexp-wrap-quantifier-if-any |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
60 |
(case (and (< i+1 n) (char s i+1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
61 |
((#\^) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
62 |
(let ((vv (pregexp-read-char-list s (+ i 2) n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
63 |
(list (list ':neg-char (car vv)) (cadr vv)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
64 |
(t (pregexp-read-char-list s i+1 n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
65 |
s n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
66 |
((#\() |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
67 |
(pregexp-wrap-quantifier-if-any (pregexp-read-subpattern s (+ i 1) n) s n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
68 |
((#\\) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
69 |
(pregexp-wrap-quantifier-if-any |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
70 |
(let ((__cond_temp__ nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
71 |
(cond |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
72 |
((setq __cond_temp__ (pregexp-read-escaped-number s i n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
73 |
(funcall |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
74 |
#'(lambda (num-i) (list (list ':backref (car num-i)) (cadr num-i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
75 |
__cond_temp__)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
76 |
((setq __cond_temp__ (pregexp-read-escaped-char s i n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
77 |
(funcall #'(lambda (char-i) (list (car char-i) (cadr char-i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
78 |
__cond_temp__)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
79 |
(t (pregexp-error 'pregexp-read-piece 'backslash)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
80 |
s n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
81 |
(t |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
82 |
(if |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
83 |
(or *pregexp-space-sensitive?* |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
84 |
(and |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
85 |
(not |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
86 |
(let ((|Scheme-to-CL-3| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
87 |
(or (char= |Scheme-to-CL-3| #\space) (char= |Scheme-to-CL-3| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
88 |
(not (graphic-char-p |Scheme-to-CL-3|))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
89 |
(not (char= c *pregexp-comment-char*)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
90 |
(pregexp-wrap-quantifier-if-any (list c (+ i 1)) s n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
91 |
(let ((i i) (in-comment? nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
92 |
(flet ((loop! (i in-comment?) (throw 'loop! (values i in-comment?)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
93 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
94 |
(multiple-value-setq (i in-comment?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
95 |
(let ((i i) (in-comment? in-comment?)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
96 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
97 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
98 |
(if (>= i n) (list ':empty i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
99 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
100 |
(cond (in-comment? (loop! (+ i 1) (not (char= c #\newline)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
101 |
((let ((|Scheme-to-CL-4| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
102 |
(or (char= |Scheme-to-CL-4| #\space) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
103 |
(char= |Scheme-to-CL-4| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
104 |
(not (graphic-char-p |Scheme-to-CL-4|)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
105 |
(loop! (+ i 1) nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
106 |
((char= c *pregexp-comment-char*) (loop! (+ i 1) t)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
107 |
(t (list ':empty i))))))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
108 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
109 |
(defun pregexp-read-escaped-number (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
110 |
(and (< (+ i 1) n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
111 |
(let ((c (char s (+ i 1)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
112 |
(and (digit-char-p c) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
113 |
(let ((i (+ i 2)) (r (list c))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
114 |
(flet ((loop! (i r) (throw 'loop! (values i r)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
115 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
116 |
(multiple-value-setq (i r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
117 |
(let ((i i) (r r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
118 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
119 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
120 |
(if (>= i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
121 |
(list |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
122 |
(let ((|Scheme-to-CL-5| (concatenate 'string (nreverse r)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
123 |
(if (position #\: |Scheme-to-CL-5| :test #'char=) nil |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
124 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
125 |
((|Scheme-to-CL-6| (read-from-string |Scheme-to-CL-5| nil))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
126 |
(if (numberp |Scheme-to-CL-6|) |Scheme-to-CL-6| nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
127 |
i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
128 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
129 |
(if (digit-char-p c) (loop! (+ i 1) (cons c r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
130 |
(list |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
131 |
(let ((|Scheme-to-CL-7| (concatenate 'string (nreverse r)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
132 |
(if (position #\: |Scheme-to-CL-7| :test #'char=) nil |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
133 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
134 |
((|Scheme-to-CL-8| (read-from-string |Scheme-to-CL-7| nil))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
135 |
(if (numberp |Scheme-to-CL-8|) |Scheme-to-CL-8| nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
136 |
i))))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
137 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
138 |
(defun pregexp-read-escaped-char (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
139 |
(and (< (+ i 1) n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
140 |
(let ((c (char s (+ i 1)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
141 |
(case c ((#\b) (list ':wbdry (+ i 2))) ((#\B) (list ':not-wbdry (+ i 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
142 |
((#\d) (list ':digit (+ i 2))) ((#\D) (list '(:neg-char :digit) (+ i 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
143 |
((#\n) (list #\newline (+ i 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
144 |
((#\r) (list *pregexp-return-char* (+ i 2))) ((#\s) (list ':space (+ i 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
145 |
((#\S) (list '(:neg-char :space) (+ i 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
146 |
((#\t) (list *pregexp-tab-char* (+ i 2))) ((#\w) (list ':word (+ i 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
147 |
((#\W) (list '(:neg-char :word) (+ i 2))) (t (list c (+ i 2))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
148 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
149 |
(defun pregexp-read-posix-char-class (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
150 |
(let ((neg? nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
151 |
(let ((i i) (r (list #\:))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
152 |
(flet ((loop! (i r) (throw 'loop! (values i r)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
153 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
154 |
(multiple-value-setq (i r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
155 |
(let ((i i) (r r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
156 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
157 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
158 |
(if (>= i n) (pregexp-error 'pregexp-read-posix-char-class) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
159 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
160 |
(cond ((char= c #\^) (setq neg? t) (loop! (+ i 1) r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
161 |
((alpha-char-p c) (loop! (+ i 1) (cons c r))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
162 |
((char= c #\:) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
163 |
(if (or (>= (+ i 1) n) (not (char= (char s (+ i 1)) #\]))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
164 |
(pregexp-error 'pregexp-read-posix-char-class) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
165 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
166 |
((posix-class |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
167 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
168 |
((|Scheme-to-CL-9| |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
169 |
(map 'string |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
170 |
#'(lambda (c) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
171 |
(cond ((upper-case-p c) (char-downcase c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
172 |
((lower-case-p c) (char-upcase c)) (t c))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
173 |
(concatenate 'string (nreverse r))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
174 |
(if |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
175 |
(or (string= |Scheme-to-CL-9| "") |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
176 |
(not (char= (char |Scheme-to-CL-9| 0) #\:))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
177 |
(intern |Scheme-to-CL-9|) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
178 |
(intern (subseq |Scheme-to-CL-9| 1) :keyword))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
179 |
(list (if neg? (list ':neg-char posix-class) posix-class) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
180 |
(+ i 2))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
181 |
(t (pregexp-error 'pregexp-read-posix-char-class)))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
182 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
183 |
(defun pregexp-read-cluster-type (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
184 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
185 |
(case c |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
186 |
((#\?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
187 |
(let ((i (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
188 |
(case (char s i) ((#\:) (list 'nil (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
189 |
((#\=) (list '(:lookahead) (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
190 |
((#\!) (list '(:neg-lookahead) (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
191 |
((#\>) (list '(:no-backtrack) (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
192 |
((#\<) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
193 |
(list |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
194 |
(case (char s (+ i 1)) ((#\=) '(:lookbehind)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
195 |
((#\!) '(:neg-lookbehind)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
196 |
(t (pregexp-error 'pregexp-read-cluster-type))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
197 |
(+ i 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
198 |
(t |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
199 |
(let ((i i) (r 'nil) (inv? nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
200 |
(flet ((loop! (i r inv?) (throw 'loop! (values i r inv?)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
201 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
202 |
(multiple-value-setq (i r inv?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
203 |
(let ((i i) (r r) (inv? inv?)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
204 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
205 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
206 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
207 |
(case c ((#\-) (loop! (+ i 1) r t)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
208 |
((#\i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
209 |
(loop! (+ i 1) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
210 |
(cons (if inv? ':case-sensitive ':case-insensitive) r) nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
211 |
((#\x) (setq *pregexp-space-sensitive?* inv?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
212 |
(loop! (+ i 1) r nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
213 |
((#\:) (list r (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
214 |
(t (pregexp-error 'pregexp-read-cluster-type))))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
215 |
(t (list '(:sub) i))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
216 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
217 |
(defun pregexp-read-subpattern (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
218 |
(let ((remember-space-sensitive? *pregexp-space-sensitive?*)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
219 |
(let ((ctyp-i (pregexp-read-cluster-type s i n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
220 |
(let ((ctyp (car ctyp-i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
221 |
(let ((i (cadr ctyp-i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
222 |
(let ((vv (pregexp-read-pattern s i n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
223 |
(setq *pregexp-space-sensitive?* remember-space-sensitive?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
224 |
(let ((vv-re (car vv)) (vv-i (cadr vv))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
225 |
(if (and (< vv-i n) (char= (char s vv-i) #\))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
226 |
(list |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
227 |
(let ((ctyp ctyp) (re vv-re)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
228 |
(flet ((loop! (ctyp re) (throw 'loop! (values ctyp re)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
229 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
230 |
(multiple-value-setq (ctyp re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
231 |
(let ((ctyp ctyp) (re re)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
232 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
233 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
234 |
(if (null ctyp) re |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
235 |
(loop! (cdr ctyp) (list (car ctyp) re)))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
236 |
(+ vv-i 1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
237 |
(pregexp-error 'pregexp-read-subpattern))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
238 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
239 |
(defun pregexp-wrap-quantifier-if-any (vv s n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
240 |
(let ((re (car vv))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
241 |
(let ((i (cadr vv))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
242 |
(flet ((loop! (i) (throw 'loop! (values i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
243 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
244 |
(multiple-value-setq (i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
245 |
(let ((i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
246 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
247 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
248 |
(if (>= i n) vv |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
249 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
250 |
(if |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
251 |
(and |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
252 |
(let ((|Scheme-to-CL-10| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
253 |
(or (char= |Scheme-to-CL-10| #\space) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
254 |
(char= |Scheme-to-CL-10| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
255 |
(not (graphic-char-p |Scheme-to-CL-10|)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
256 |
(not *pregexp-space-sensitive?*)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
257 |
(loop! (+ i 1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
258 |
(case c |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
259 |
((#\* #\+ #\? #\{) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
260 |
(let ((new-re (list ':between 'minimal? 'at-least 'at-most re))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
261 |
(let ((new-vv (list new-re 'next-i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
262 |
(case c |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
263 |
((#\*) (rplaca (cddr new-re) 0) (rplaca (cdddr new-re) nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
264 |
((#\+) (rplaca (cddr new-re) 1) (rplaca (cdddr new-re) nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
265 |
((#\?) (rplaca (cddr new-re) 0) (rplaca (cdddr new-re) 1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
266 |
((#\{) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
267 |
(let ((pq (pregexp-read-nums s (+ i 1) n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
268 |
(if (not pq) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
269 |
(pregexp-error 'pregexp-wrap-quantifier-if-any |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
270 |
'left-brace-must-be-followed-by-number)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
271 |
(rplaca (cddr new-re) (car pq)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
272 |
(rplaca (cdddr new-re) (cadr pq)) (setq i (caddr pq))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
273 |
(let ((i (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
274 |
(flet ((loop! (i) (throw 'loop! (values i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
275 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
276 |
(multiple-value-setq (i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
277 |
(let ((i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
278 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
279 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
280 |
(if (>= i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
281 |
(progn (rplaca (cdr new-re) nil) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
282 |
(rplaca (cdr new-vv) i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
283 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
284 |
(cond |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
285 |
((and |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
286 |
(let ((|Scheme-to-CL-11| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
287 |
(or (char= |Scheme-to-CL-11| #\space) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
288 |
(char= |Scheme-to-CL-11| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
289 |
(not (graphic-char-p |Scheme-to-CL-11|)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
290 |
(not *pregexp-space-sensitive?*)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
291 |
(loop! (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
292 |
((char= c #\?) (rplaca (cdr new-re) t) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
293 |
(rplaca (cdr new-vv) (+ i 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
294 |
(t (rplaca (cdr new-re) nil) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
295 |
(rplaca (cdr new-vv) i)))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
296 |
new-vv))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
297 |
(t vv)))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
298 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
299 |
(defun pregexp-read-nums (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
300 |
(let ((p 'nil) (q 'nil) (k i) (reading 1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
301 |
(flet ((loop! (p q k reading) (throw 'loop! (values p q k reading)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
302 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
303 |
(multiple-value-setq (p q k reading) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
304 |
(let ((p p) (q q) (k k) (reading reading)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
305 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
306 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
307 |
(progn (if (>= k n) (pregexp-error 'pregexp-read-nums)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
308 |
(let ((c (char s k))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
309 |
(cond |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
310 |
((digit-char-p c) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
311 |
(if (= reading 1) (loop! (cons c p) q (+ k 1) 1) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
312 |
(loop! p (cons c q) (+ k 1) 2))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
313 |
((and |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
314 |
(let ((|Scheme-to-CL-12| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
315 |
(or (char= |Scheme-to-CL-12| #\space) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
316 |
(char= |Scheme-to-CL-12| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
317 |
(not (graphic-char-p |Scheme-to-CL-12|)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
318 |
(not *pregexp-space-sensitive?*)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
319 |
(loop! p q (+ k 1) reading)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
320 |
((and (char= c #\,) (= reading 1)) (loop! p q (+ k 1) 2)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
321 |
((char= c #\}) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
322 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
323 |
((p |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
324 |
(let ((|Scheme-to-CL-13| (concatenate 'string (nreverse p)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
325 |
(if (position #\: |Scheme-to-CL-13| :test #'char=) nil |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
326 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
327 |
((|Scheme-to-CL-14| |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
328 |
(read-from-string |Scheme-to-CL-13| nil))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
329 |
(if (numberp |Scheme-to-CL-14|) |Scheme-to-CL-14| nil))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
330 |
(q |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
331 |
(let ((|Scheme-to-CL-15| (concatenate 'string (nreverse q)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
332 |
(if (position #\: |Scheme-to-CL-15| :test #'char=) nil |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
333 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
334 |
((|Scheme-to-CL-16| |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
335 |
(read-from-string |Scheme-to-CL-15| nil))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
336 |
(if (numberp |Scheme-to-CL-16|) |Scheme-to-CL-16| nil)))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
337 |
(cond ((and (not p) (= reading 1)) (list 0 nil k)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
338 |
((= reading 1) (list p p k)) (t (list p q k))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
339 |
(t nil)))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
340 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
341 |
(defun pregexp-invert-char-list (vv) (rplaca (car vv) ':none-of-chars) vv) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
342 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
343 |
(defun pregexp-read-char-list (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
344 |
(let ((r 'nil) (i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
345 |
(flet ((loop! (r i) (throw 'loop! (values r i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
346 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
347 |
(multiple-value-setq (r i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
348 |
(let ((r r) (i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
349 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
350 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
351 |
(if (>= i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
352 |
(pregexp-error 'pregexp-read-char-list |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
353 |
'character-class-ended-too-soon) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
354 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
355 |
(case c |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
356 |
((#\]) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
357 |
(if (null r) (loop! (cons c r) (+ i 1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
358 |
(list (cons ':one-of-chars (nreverse r)) (+ i 1)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
359 |
((#\\) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
360 |
(let ((char-i (pregexp-read-escaped-char s i n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
361 |
(if char-i (loop! (cons (car char-i) r) (cadr char-i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
362 |
(pregexp-error 'pregexp-read-char-list 'backslash)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
363 |
((#\-) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
364 |
(if |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
365 |
(or (null r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
366 |
(let ((i+1 (+ i 1))) (and (< i+1 n) (char= (char s i+1) #\])))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
367 |
(loop! (cons c r) (+ i 1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
368 |
(let ((c-prev (car r))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
369 |
(if (characterp c-prev) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
370 |
(loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
371 |
(cons (list ':char-range c-prev (char s (+ i 1))) (cdr r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
372 |
(+ i 2)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
373 |
(loop! (cons c r) (+ i 1)))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
374 |
((#\[) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
375 |
(if (char= (char s (+ i 1)) #\:) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
376 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
377 |
((posix-char-class-i |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
378 |
(pregexp-read-posix-char-class s (+ i 2) n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
379 |
(loop! (cons (car posix-char-class-i) r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
380 |
(cadr posix-char-class-i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
381 |
(loop! (cons c r) (+ i 1)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
382 |
(t (loop! (cons c r) (+ i 1)))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
383 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
384 |
(defun pregexp-string-match (s1 s i n sk fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
385 |
(let ((n1 (length s1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
386 |
(if (> n1 n) (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
387 |
(let ((j 0) (k i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
388 |
(flet ((loop! (j k) (throw 'loop! (values j k)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
389 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
390 |
(multiple-value-setq (j k) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
391 |
(let ((j j) (k k)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
392 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
393 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
394 |
(cond ((>= j n1) (funcall sk k)) ((>= k n) (funcall fk)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
395 |
((char= (char s1 j) (char s k)) (loop! (+ j 1) (+ k 1))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
396 |
(t (funcall fk))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
397 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
398 |
(defun pregexp-char-word? (c) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
399 |
(or (alpha-char-p c) (digit-char-p c) (char= c #\_))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
400 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
401 |
(defun pregexp-at-word-boundary? (s i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
402 |
(or (= i 0) (>= i n) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
403 |
(let ((c/i (char s i)) (c/i-1 (char s (- i 1)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
404 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
405 |
((c/i/w? (pregexp-check-if-in-char-class? c/i ':word)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
406 |
(c/i-1/w? (pregexp-check-if-in-char-class? c/i-1 ':word))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
407 |
(or (and c/i/w? (not c/i-1/w?)) (and (not c/i/w?) c/i-1/w?)))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
408 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
409 |
(defun pregexp-check-if-in-char-class? (c char-class) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
410 |
(case char-class ((:any) (not (char= c #\newline))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
411 |
((:alnum) (or (alpha-char-p c) (digit-char-p c))) ((:alpha) (alpha-char-p c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
412 |
((:ascii) (< (char-code c) 128)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
413 |
((:blank) (or (char= c #\space) (char= c *pregexp-tab-char*))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
414 |
((:cntrl) (< (char-code c) 32)) ((:digit) (digit-char-p c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
415 |
((:graph) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
416 |
(and (>= (char-code c) 32) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
417 |
(not |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
418 |
(let ((|Scheme-to-CL-17| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
419 |
(or (char= |Scheme-to-CL-17| #\space) (char= |Scheme-to-CL-17| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
420 |
(not (graphic-char-p |Scheme-to-CL-17|))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
421 |
((:lower) (lower-case-p c)) ((:print) (>= (char-code c) 32)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
422 |
((:punct) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
423 |
(and (>= (char-code c) 32) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
424 |
(not |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
425 |
(let ((|Scheme-to-CL-18| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
426 |
(or (char= |Scheme-to-CL-18| #\space) (char= |Scheme-to-CL-18| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
427 |
(not (graphic-char-p |Scheme-to-CL-18|))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
428 |
(not (alpha-char-p c)) (not (digit-char-p c)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
429 |
((:space) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
430 |
(let ((|Scheme-to-CL-19| c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
431 |
(or (char= |Scheme-to-CL-19| #\space) (char= |Scheme-to-CL-19| #\tab) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
432 |
(not (graphic-char-p |Scheme-to-CL-19|))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
433 |
((:upper) (upper-case-p c)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
434 |
((:word) (or (alpha-char-p c) (digit-char-p c) (char= c #\_))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
435 |
((:xdigit) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
436 |
(or (digit-char-p c) (char-equal c #\a) (char-equal c #\b) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
437 |
(char-equal c #\c) (char-equal c #\d) (char-equal c #\e) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
438 |
(char-equal c #\f))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
439 |
(t (pregexp-error 'pregexp-check-if-in-char-class?)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
440 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
441 |
(defun pregexp-list-ref (s i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
442 |
(let ((s s) (k 0)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
443 |
(flet ((loop! (s k) (throw 'loop! (values s k)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
444 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
445 |
(multiple-value-setq (s k) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
446 |
(let ((s s) (k k)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
447 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
448 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
449 |
(cond ((null s) nil) ((= k i) (car s)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
450 |
(t (loop! (cdr s) (+ k 1)))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
451 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
452 |
(defun pregexp-make-backref-list (re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
453 |
(labels |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
454 |
((sub (re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
455 |
(if (consp re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
456 |
(let ((car-re (car re)) (sub-cdr-re (sub (cdr re)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
457 |
(if (eql car-re ':sub) (cons (cons re nil) sub-cdr-re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
458 |
(append (sub car-re) sub-cdr-re))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
459 |
'nil))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
460 |
(sub re))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
461 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
462 |
(defun pregexp-match-positions-aux (re s sn start n i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
463 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
464 |
((identity #'(lambda (x) x)) (backrefs (pregexp-make-backref-list re)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
465 |
(case-sensitive? t)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
466 |
(labels |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
467 |
((sub (re i sk fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
468 |
(cond ((eql re ':bos) (if (= i 0) (funcall sk i) (funcall fk))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
469 |
((eql re ':eos) (if (>= i sn) (funcall sk i) (funcall fk))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
470 |
((eql re ':empty) (funcall sk i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
471 |
((eql re ':wbdry) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
472 |
(if (pregexp-at-word-boundary? s i n) (funcall sk i) (funcall fk))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
473 |
((eql re ':not-wbdry) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
474 |
(if (pregexp-at-word-boundary? s i n) (funcall fk) (funcall sk i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
475 |
((and (characterp re) (< i n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
476 |
(if (funcall (if case-sensitive? #'char= #'char-equal) (char s i) re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
477 |
(funcall sk (+ i 1)) (funcall fk))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
478 |
((and (not (consp re)) (< i n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
479 |
(if (pregexp-check-if-in-char-class? (char s i) re) (funcall sk (+ i 1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
480 |
(funcall fk))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
481 |
((and (consp re) (eql (car re) ':char-range) (< i n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
482 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
483 |
(if |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
484 |
(let ((c< (if case-sensitive? #'char<= #'char-not-greaterp))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
485 |
(and (funcall c< (cadr re) c) (funcall c< c (caddr re)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
486 |
(funcall sk (+ i 1)) (funcall fk)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
487 |
((consp re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
488 |
(case (car re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
489 |
((:char-range) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
490 |
(if (>= i n) (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
491 |
(pregexp-error 'pregexp-match-positions-aux))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
492 |
((:one-of-chars) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
493 |
(if (>= i n) (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
494 |
(labels |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
495 |
((loup-one-of-chars (chars) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
496 |
(if (null chars) (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
497 |
(sub (car chars) i sk |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
498 |
#'(lambda nil (loup-one-of-chars (cdr chars))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
499 |
(loup-one-of-chars (cdr re))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
500 |
((:neg-char) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
501 |
(if (>= i n) (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
502 |
(sub (cadr re) i #'(lambda (i1) (funcall fk)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
503 |
#'(lambda nil (funcall sk (+ i 1)))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
504 |
((:seq) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
505 |
(labels |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
506 |
((loup-seq (res i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
507 |
(if (null res) (funcall sk i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
508 |
(sub (car res) i #'(lambda (i1) (loup-seq (cdr res) i1)) fk)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
509 |
(loup-seq (cdr re) i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
510 |
((:or) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
511 |
(labels |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
512 |
((loup-or (res) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
513 |
(if (null res) (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
514 |
(sub (car res) i |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
515 |
#'(lambda (i1) (or (funcall sk i1) (loup-or (cdr res)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
516 |
#'(lambda nil (loup-or (cdr res))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
517 |
(loup-or (cdr re)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
518 |
((:backref) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
519 |
(let ((c (pregexp-list-ref backrefs (cadr re)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
520 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
521 |
((backref |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
522 |
(let ((__cond_temp__ nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
523 |
(cond ((setq __cond_temp__ c) (funcall #'cdr __cond_temp__)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
524 |
(t |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
525 |
(pregexp-error 'pregexp-match-positions-aux |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
526 |
'non-existent-backref re) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
527 |
nil))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
528 |
(if backref |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
529 |
(pregexp-string-match (subseq s (car backref) (cdr backref)) s i n |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
530 |
#'(lambda (i) (funcall sk i)) fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
531 |
(funcall sk i))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
532 |
((:sub) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
533 |
(sub (cadr re) i |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
534 |
#'(lambda (i1) (rplacd (assoc re backrefs) (cons i i1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
535 |
(funcall sk i1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
536 |
fk)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
537 |
((:lookahead) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
538 |
(let ((found-it? (sub (cadr re) i identity #'(lambda nil nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
539 |
(if found-it? (funcall sk i) (funcall fk)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
540 |
((:neg-lookahead) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
541 |
(let ((found-it? (sub (cadr re) i identity #'(lambda nil nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
542 |
(if found-it? (funcall fk) (funcall sk i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
543 |
((:lookbehind) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
544 |
(let ((n-actual n) (sn-actual sn)) (setq n i) (setq sn i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
545 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
546 |
((found-it? |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
547 |
(sub (list ':seq '(:between nil 0 nil :any) (cadr re) ':eos) 0 |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
548 |
identity #'(lambda nil nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
549 |
(setq n n-actual) (setq sn sn-actual) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
550 |
(if found-it? (funcall sk i) (funcall fk))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
551 |
((:neg-lookbehind) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
552 |
(let ((n-actual n) (sn-actual sn)) (setq n i) (setq sn i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
553 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
554 |
((found-it? |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
555 |
(sub (list ':seq '(:between nil 0 nil :any) (cadr re) ':eos) 0 |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
556 |
identity #'(lambda nil nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
557 |
(setq n n-actual) (setq sn sn-actual) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
558 |
(if found-it? (funcall fk) (funcall sk i))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
559 |
((:no-backtrack) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
560 |
(let ((found-it? (sub (cadr re) i identity #'(lambda nil nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
561 |
(if found-it? (funcall sk found-it?) (funcall fk)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
562 |
((:case-sensitive :case-insensitive) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
563 |
(let ((old case-sensitive?)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
564 |
(setq case-sensitive? (eql (car re) ':case-sensitive)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
565 |
(sub (cadr re) i |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
566 |
#'(lambda (i1) (setq case-sensitive? old) (funcall sk i1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
567 |
#'(lambda nil (setq case-sensitive? old) (funcall fk))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
568 |
((:between) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
569 |
(let ((maximal? (not (cadr re)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
570 |
(let ((p (caddr re))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
571 |
(let ((q (cadddr re))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
572 |
(let ((could-loop-infinitely? (and maximal? (not q)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
573 |
(let ((re (car (cddddr re)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
574 |
(labels |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
575 |
((loup-p (k i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
576 |
(if (< k p) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
577 |
(sub re i |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
578 |
#'(lambda (i1) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
579 |
(if (and could-loop-infinitely? (= i1 i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
580 |
(pregexp-error 'pregexp-match-positions-aux |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
581 |
'greedy-quantifier-operand-could-be-empty)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
582 |
(loup-p (+ k 1) i1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
583 |
fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
584 |
(let ((q (and q (- q p)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
585 |
(labels |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
586 |
((loup-q (k i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
587 |
(let ((fk #'(lambda nil (funcall sk i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
588 |
(if (and q (>= k q)) (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
589 |
(if maximal? |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
590 |
(sub re i |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
591 |
#'(lambda (i1) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
592 |
(if (and could-loop-infinitely? (= i1 i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
593 |
(pregexp-error 'pregexp-match-positions-aux |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
594 |
'greedy-quantifier-operand-could-be-empty)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
595 |
(or (loup-q (+ k 1) i1) (funcall fk))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
596 |
fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
597 |
(or (funcall fk) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
598 |
(sub re i #'(lambda (i1) (loup-q (+ k 1) i1)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
599 |
fk))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
600 |
(loup-q 0 i)))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
601 |
(loup-p 0 i)))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
602 |
(t (pregexp-error 'pregexp-match-positions-aux)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
603 |
((>= i n) (funcall fk)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
604 |
(t (pregexp-error 'pregexp-match-positions-aux))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
605 |
(sub re i identity #'(lambda nil nil))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
606 |
(let ((backrefs (mapcar #'cdr backrefs))) (and (car backrefs) backrefs)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
607 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
608 |
(defun pregexp-replace-aux (str ins n backrefs) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
609 |
(let ((i 0) (r "")) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
610 |
(flet ((loop! (i r) (throw 'loop! (values i r)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
611 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
612 |
(multiple-value-setq (i r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
613 |
(let ((i i) (r r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
614 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
615 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
616 |
(if (>= i n) r |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
617 |
(let ((c (char ins i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
618 |
(if (char= c #\\) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
619 |
(let ((br-i (pregexp-read-escaped-number ins i n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
620 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
621 |
((br |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
622 |
(if br-i (car br-i) (if (char= (char ins (+ i 1)) #\&) 0 nil)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
623 |
(let ((i (if br-i (cadr br-i) (if br (+ i 2) (+ i 1))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
624 |
(if (not br) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
625 |
(let ((c2 (char ins i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
626 |
(loop! (+ i 1) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
627 |
(if (char= c2 #\$) r |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
628 |
(concatenate 'string r (concatenate 'string (list c2)))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
629 |
(loop! i |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
630 |
(let ((backref (pregexp-list-ref backrefs br))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
631 |
(if backref |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
632 |
(concatenate 'string r |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
633 |
(subseq str (car backref) (cdr backref))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
634 |
r))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
635 |
(loop! (+ i 1) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
636 |
(concatenate 'string r (concatenate 'string (list c))))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
637 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
638 |
(defun pregexp (s) (setq *pregexp-space-sensitive?* t) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
639 |
(list ':sub (car (pregexp-read-pattern s 0 (length s))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
640 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
641 |
(defun pregexp-match-positions (pat str &rest opt-args) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
642 |
(cond ((stringp pat) (setq pat (pregexp pat))) ((consp pat) t) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
643 |
(t |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
644 |
(pregexp-error 'pregexp-match-positions |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
645 |
'pattern-must-be-compiled-or-string-regexp pat))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
646 |
(let ((str-len (length str))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
647 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
648 |
((start |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
649 |
(if (null opt-args) 0 |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
650 |
(let ((start (car opt-args))) (setq opt-args (cdr opt-args)) start)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
651 |
(let ((end (if (null opt-args) str-len (car opt-args)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
652 |
(let ((i start)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
653 |
(flet ((loop! (i) (throw 'loop! (values i)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
654 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
655 |
(multiple-value-setq (i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
656 |
(let ((i i)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
657 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
658 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
659 |
(and (<= i end) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
660 |
(or (pregexp-match-positions-aux pat str str-len start end i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
661 |
(loop! (+ i 1))))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
662 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
663 |
(defun pregexp-match (pat str &rest opt-args) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
664 |
(let ((ix-prs (apply #'pregexp-match-positions pat str opt-args))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
665 |
(and ix-prs |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
666 |
(mapcar #'(lambda (ix-pr) (and ix-pr (subseq str (car ix-pr) (cdr ix-pr)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
667 |
ix-prs)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
668 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
669 |
(defun pregexp-split (pat str) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
670 |
(let ((n (length str))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
671 |
(let ((i 0) (r 'nil) (picked-up-one-undelimited-char? nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
672 |
(flet |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
673 |
((loop! (i r picked-up-one-undelimited-char?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
674 |
(throw 'loop! (values i r picked-up-one-undelimited-char?)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
675 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
676 |
(multiple-value-setq (i r picked-up-one-undelimited-char?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
677 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
678 |
((i i) (r r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
679 |
(picked-up-one-undelimited-char? picked-up-one-undelimited-char?)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
680 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
681 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
682 |
(let ((__cond_temp__ nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
683 |
(cond ((>= i n) (nreverse r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
684 |
((setq __cond_temp__ (pregexp-match-positions pat str i n)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
685 |
(funcall |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
686 |
#'(lambda (y) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
687 |
(let ((jk (car y))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
688 |
(let ((j (car jk)) (k (cdr jk))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
689 |
(cond |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
690 |
((= j k) (loop! (+ k 1) (cons (subseq str i (+ j 1)) r) t)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
691 |
((and (= j i) picked-up-one-undelimited-char?) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
692 |
(loop! k r nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
693 |
(t (loop! k (cons (subseq str i j) r) nil)))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
694 |
__cond_temp__)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
695 |
(t (loop! n (cons (subseq str i n) r) nil))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
696 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
697 |
(defun pregexp-replace (pat str ins) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
698 |
(let ((n (length str))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
699 |
(let ((pp (pregexp-match-positions pat str 0 n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
700 |
(if (not pp) str |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
701 |
(let ((ins-len (length ins)) (m-i (caar pp)) (m-n (cdar pp))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
702 |
(concatenate 'string (subseq str 0 m-i) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
703 |
(pregexp-replace-aux str ins ins-len pp) (subseq str m-n n))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
704 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
705 |
(defun pregexp-replace* (pat str ins) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
706 |
(let |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
707 |
((pat (if (stringp pat) (pregexp pat) pat)) (n (length str)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
708 |
(ins-len (length ins))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
709 |
(let ((i 0) (r "")) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
710 |
(flet ((loop! (i r) (throw 'loop! (values i r)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
711 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
712 |
(multiple-value-setq (i r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
713 |
(let ((i i) (r r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
714 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
715 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
716 |
(if (>= i n) r |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
717 |
(let ((pp (pregexp-match-positions pat str i n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
718 |
(if (not pp) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
719 |
(if (= i 0) str (concatenate 'string r (subseq str i n))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
720 |
(loop! (cdar pp) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
721 |
(concatenate 'string r (subseq str i (caar pp)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
722 |
(pregexp-replace-aux str ins ins-len pp))))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
723 |
|
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
724 |
(defun pregexp-quote (s) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
725 |
(let ((i (- (length s) 1)) (r 'nil)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
726 |
(flet ((loop! (i r) (throw 'loop! (values i r)))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
727 |
(loop |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
728 |
(multiple-value-setq (i r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
729 |
(let ((i i) (r r)) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
730 |
(catch 'loop! |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
731 |
(return |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
732 |
(if (< i 0) (concatenate 'string r) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
733 |
(loop! (- i 1) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
734 |
(let ((c (char s i))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
735 |
(if |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
736 |
(member c |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
737 |
'(#\\ #\. #\? #\* #\+ #\| #\^ #\$ #\[ #\] #\{ #\} #\( #\))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
738 |
(cons #\\ (cons c r)) (cons c r))))))))))))) |
089a57807585
Dorai Sitaram's Portable Regular Expression matcher
Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
parents:
diff
changeset
|
739 |