Artifact
4eda8967bd4b4d7c6ee2163502792effee46badc:
- File
foof/irregex-utils.scm
— part of check-in
[112a40d018]
at
2016-09-01 08:27:10
on branch trunk
— various improvements, added lmdb , added license notices
(user:
ovenpasta@pizzahack.eu
size: 4479)
0000: 3b 3b 3b 3b 20 69 72 72 65 67 65 78 2d 75 74 69 ;;;; irregex-uti
0010: 6c 73 2e 73 63 6d 0a 3b 3b 0a 3b 3b 20 43 6f 70 ls.scm.;;.;; Cop
0020: 79 72 69 67 68 74 20 28 63 29 20 32 30 30 38 20 yright (c) 2008
0030: 41 6c 65 78 20 53 68 69 6e 6e 2e 20 20 41 6c 6c Alex Shinn. All
0040: 20 72 69 67 68 74 73 20 72 65 73 65 72 76 65 64 rights reserved
0050: 2e 0a 3b 3b 20 42 53 44 2d 73 74 79 6c 65 20 6c ..;; BSD-style l
0060: 69 63 65 6e 73 65 3a 20 68 74 74 70 3a 2f 2f 73 icense: http://s
0070: 79 6e 74 68 63 6f 64 65 2e 63 6f 6d 2f 6c 69 63 ynthcode.com/lic
0080: 65 6e 73 65 2e 74 78 74 0a 0a 28 64 65 66 69 6e ense.txt..(defin
0090: 65 20 72 78 2d 73 70 65 63 69 61 6c 2d 63 68 61 e rx-special-cha
00a0: 72 73 0a 20 20 22 5c 5c 7c 5b 5d 28 29 7b 7d 2e rs. "\\|[](){}.
00b0: 2a 2b 3f 5e 24 23 22 29 0a 0a 28 64 65 66 69 6e *+?^$#")..(defin
00c0: 65 20 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 e (string-scan-c
00d0: 68 61 72 20 73 74 72 20 63 20 2e 20 6f 29 0a 20 har str c . o).
00e0: 20 28 6c 65 74 20 28 28 65 6e 64 20 28 73 74 72 (let ((end (str
00f0: 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 ing-length str))
0100: 29 0a 20 20 20 20 28 6c 65 74 20 73 63 61 6e 20 ). (let scan
0110: 28 28 69 20 28 69 66 20 28 70 61 69 72 3f 20 6f ((i (if (pair? o
0120: 29 20 28 63 61 72 20 6f 29 20 30 29 29 29 0a 20 ) (car o) 0))).
0130: 20 20 20 20 20 28 63 6f 6e 64 20 28 28 3d 20 69 (cond ((= i
0140: 20 65 6e 64 29 20 23 66 29 0a 20 20 20 20 20 20 end) #f).
0150: 20 20 20 20 20 20 28 28 65 71 76 3f 20 63 20 28 ((eqv? c (
0160: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 string-ref str i
0170: 29 29 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 )) i).
0180: 20 20 28 65 6c 73 65 20 28 73 63 61 6e 20 28 2b (else (scan (+
0190: 20 69 20 31 29 29 29 29 29 29 29 0a 0a 28 64 65 i 1)))))))..(de
01a0: 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 71 75 fine (irregex-qu
01b0: 6f 74 65 20 73 74 72 29 0a 20 20 28 6c 69 73 74 ote str). (list
01c0: 2d 3e 73 74 72 69 6e 67 0a 20 20 20 28 6c 65 74 ->string. (let
01d0: 20 6c 6f 6f 70 20 28 28 6c 73 20 28 73 74 72 69 loop ((ls (stri
01e0: 6e 67 2d 3e 6c 69 73 74 20 73 74 72 29 29 20 28 ng->list str)) (
01f0: 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 20 28 res '())). (
0200: 69 66 20 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 if (null? ls).
0210: 20 20 20 20 20 28 72 65 76 65 72 73 65 20 72 65 (reverse re
0220: 73 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20 28 s). (let (
0230: 28 63 20 28 63 61 72 20 6c 73 29 29 29 0a 20 20 (c (car ls))).
0240: 20 20 20 20 20 20 20 28 69 66 20 28 73 74 72 69 (if (stri
0250: 6e 67 2d 73 63 61 6e 2d 63 68 61 72 20 72 78 2d ng-scan-char rx-
0260: 73 70 65 63 69 61 6c 2d 63 68 61 72 73 20 63 29 special-chars c)
0270: 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f . (loo
0280: 70 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 p (cdr ls) (cons
0290: 20 63 20 28 63 6f 6e 73 20 23 5c 5c 20 72 65 73 c (cons #\\ res
02a0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
02b0: 6c 6f 6f 70 20 28 63 64 72 20 6c 73 29 20 28 63 loop (cdr ls) (c
02c0: 6f 6e 73 20 63 20 72 65 73 29 29 29 29 29 29 29 ons c res)))))))
02d0: 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b )..;;;;;;;;;;;;;
02e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
02f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0300: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0310: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 0a 28 64 65 ;;;;;;;;;;;..(de
0320: 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6f 70 fine (irregex-op
0330: 74 20 6c 73 29 0a 20 20 28 63 6f 6e 64 0a 20 20 t ls). (cond.
0340: 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 20 22 22 ((null? ls) ""
0350: 29 0a 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 ). ((null? (c
0360: 64 72 20 6c 73 29 29 20 28 69 72 72 65 67 65 78 dr ls)) (irregex
0370: 2d 71 75 6f 74 65 20 28 63 61 72 20 6c 73 29 29 -quote (car ls))
0380: 29 0a 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 ). (else.
0390: 20 28 6c 65 74 20 28 28 63 68 61 72 73 20 28 6d (let ((chars (m
03a0: 61 6b 65 2d 76 65 63 74 6f 72 20 32 35 36 20 27 ake-vector 256 '
03b0: 28 29 29 29 29 0a 20 20 20 20 20 20 20 28 6c 65 ()))). (le
03c0: 74 20 6c 70 31 20 28 28 6c 73 20 6c 73 29 20 28 t lp1 ((ls ls) (
03d0: 65 6d 70 74 79 3f 20 23 66 29 29 0a 20 20 20 20 empty? #f)).
03e0: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
03f0: 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ls). (
0400: 73 74 72 69 6e 67 2d 61 70 70 65 6e 64 0a 20 20 string-append.
0410: 20 20 20 20 20 20 20 20 20 20 22 28 3f 3a 22 0a "(?:".
0420: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
0430: 69 6e 67 2d 69 6e 74 65 72 73 70 65 72 73 65 0a ing-intersperse.
0440: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
0450: 74 20 6c 70 32 20 28 28 69 20 30 29 20 28 72 65 t lp2 ((i 0) (re
0460: 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 s '())).
0470: 20 20 20 20 20 20 20 28 69 66 20 28 3d 20 69 20 (if (= i
0480: 32 35 36 29 0a 20 20 20 20 20 20 20 20 20 20 20 256).
0490: 20 20 20 20 20 20 28 72 65 76 65 72 73 65 20 72 (reverse r
04a0: 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 es).
04b0: 20 20 20 20 20 28 6c 65 74 20 28 28 63 20 28 69 (let ((c (i
04c0: 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 69 29 29 nteger->char i))
04d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
04e0: 20 20 20 20 20 20 20 20 28 6f 70 74 73 20 28 76 (opts (v
04f0: 65 63 74 6f 72 2d 72 65 66 20 63 68 61 72 73 20 ector-ref chars
0500: 69 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i))).
0510: 20 20 20 20 20 20 20 20 28 6c 70 32 20 28 2b 20 (lp2 (+
0520: 69 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 i 1).
0530: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
0540: 20 28 6e 75 6c 6c 3f 20 6f 70 74 73 29 0a 20 20 (null? opts).
0550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0560: 20 20 20 20 20 20 20 20 72 65 73 0a 20 20 20 20 res.
0570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0580: 20 20 20 20 20 20 28 63 6f 6e 73 20 28 73 74 72 (cons (str
0590: 69 6e 67 2d 61 70 70 65 6e 64 0a 20 20 20 20 20 ing-append.
05a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 72 72 (irr
05c0: 65 67 65 78 2d 71 75 6f 74 65 20 28 73 74 72 69 egex-quote (stri
05d0: 6e 67 20 63 29 29 0a 20 20 20 20 20 20 20 20 20 ng c)).
05e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
05f0: 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 (irregex
0600: 2d 6f 70 74 20 6f 70 74 73 29 29 0a 20 20 20 20 -opt opts)).
0610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0620: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 29 res)
0630: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
0640: 20 20 20 22 7c 22 29 0a 20 20 20 20 20 20 20 20 "|").
0650: 20 20 20 20 28 69 66 20 65 6d 70 74 79 3f 20 22 (if empty? "
0660: 7c 22 20 22 22 29 20 3b 20 6f 72 20 75 73 65 20 |" "") ; or use
0670: 74 72 61 69 6c 69 6e 67 20 27 3f 27 20 3f 0a 20 trailing '?' ?.
0680: 20 20 20 20 20 20 20 20 20 20 20 22 29 22 29 0a ")").
0690: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
06a0: 20 28 28 73 74 72 20 28 63 61 72 20 6c 73 29 29 ((str (car ls))
06b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
06c0: 20 20 20 28 6c 65 6e 20 28 73 74 72 69 6e 67 2d (len (string-
06d0: 6c 65 6e 67 74 68 20 73 74 72 29 29 29 0a 20 20 length str))).
06e0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
06f0: 7a 65 72 6f 3f 20 6c 65 6e 29 0a 20 20 20 20 20 zero? len).
0700: 20 20 20 20 20 20 20 20 20 20 28 6c 70 31 20 28 (lp1 (
0710: 63 64 72 20 6c 73 29 20 23 74 29 0a 20 20 20 20 cdr ls) #t).
0720: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
0730: 28 28 69 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 ((i (char->integ
0740: 65 72 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 er (string-ref s
0750: 74 72 20 30 29 29 29 29 0a 20 20 20 20 20 20 20 tr 0)))).
0760: 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
0770: 72 2d 73 65 74 21 0a 20 20 20 20 20 20 20 20 20 r-set!.
0780: 20 20 20 20 20 20 20 20 20 63 68 61 72 73 0a 20 chars.
0790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07a0: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
07b0: 20 20 20 20 20 28 63 6f 6e 73 20 28 73 75 62 73 (cons (subs
07c0: 74 72 69 6e 67 20 73 74 72 20 31 20 28 73 74 72 tring str 1 (str
07d0: 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 ing-length str))
07e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
07f0: 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 (vector
0800: 2d 72 65 66 20 63 68 61 72 73 20 69 29 29 29 0a -ref chars i))).
0810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0820: 20 28 6c 70 31 20 28 63 64 72 20 6c 73 29 20 65 (lp1 (cdr ls) e
0830: 6d 70 74 79 3f 29 29 29 29 29 29 29 29 29 29 0a mpty?)))))))))).
0840: 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;;;;;;;;;;;;;;;
0850: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0860: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0870: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0880: 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 0a 28 64 65 66 69 ;;;;;;;;;..(defi
0890: 6e 65 20 28 63 73 65 74 2d 3e 73 74 72 69 6e 67 ne (cset->string
08a0: 20 6c 73 29 0a 20 20 28 77 69 74 68 2d 6f 75 74 ls). (with-out
08b0: 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a 20 20 put-to-string.
08c0: 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 (lambda ().
08d0: 20 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 20 (let lp ((ls
08e0: 6c 73 29 29 0a 20 20 20 20 20 20 20 20 28 75 6e ls)). (un
08f0: 6c 65 73 73 20 28 6e 75 6c 6c 3f 20 6c 73 29 0a less (null? ls).
0900: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
0910: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 61 ((pa
0920: 69 72 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 ir? (car ls)).
0930: 20 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 (disp
0940: 6c 61 79 20 28 69 72 72 65 67 65 78 2d 71 75 6f lay (irregex-quo
0950: 74 65 20 28 73 74 72 69 6e 67 20 28 63 61 61 72 te (string (caar
0960: 20 6c 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 ls)))).
0970: 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 2d (display "-
0980: 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ").
0990: 28 64 69 73 70 6c 61 79 20 28 69 72 72 65 67 65 (display (irrege
09a0: 78 2d 71 75 6f 74 65 20 28 73 74 72 69 6e 67 20 x-quote (string
09b0: 28 63 64 61 72 20 6c 73 29 29 29 29 29 0a 20 20 (cdar ls))))).
09c0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
09d0: 28 64 69 73 70 6c 61 79 20 28 69 72 72 65 67 65 (display (irrege
09e0: 78 2d 71 75 6f 74 65 20 28 73 74 72 69 6e 67 20 x-quote (string
09f0: 28 63 61 72 20 6c 73 29 29 29 29 29 29 0a 20 20 (car ls)))))).
0a00: 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 (lp (cdr
0a10: 20 6c 73 29 29 29 29 29 29 29 0a 0a 28 64 65 66 ls)))))))..(def
0a20: 69 6e 65 20 28 73 72 65 2d 3e 73 74 72 69 6e 67 ine (sre->string
0a30: 20 6f 62 6a 29 0a 20 20 28 77 69 74 68 2d 6f 75 obj). (with-ou
0a40: 74 70 75 74 2d 74 6f 2d 73 74 72 69 6e 67 0a 20 tput-to-string.
0a50: 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 (lambda ().
0a60: 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 78 20 (let lp ((x
0a70: 6f 62 6a 29 29 0a 20 20 20 20 20 20 20 20 28 63 obj)). (c
0a80: 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 28 28 ond. ((
0a90: 70 61 69 72 3f 20 78 29 0a 20 20 20 20 20 20 20 pair? x).
0aa0: 20 20 20 20 28 63 61 73 65 20 28 63 61 72 20 78 (case (car x
0ab0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
0ac0: 28 7c 3a 7c 20 73 65 71 29 0a 20 20 20 20 20 20 (|:| seq).
0ad0: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
0ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
0af0: 61 6e 64 20 28 70 61 69 72 3f 20 28 63 64 64 72 and (pair? (cddr
0b00: 20 78 29 29 20 28 70 61 69 72 3f 20 28 63 64 64 x)) (pair? (cdd
0b10: 72 20 78 29 29 20 28 6e 6f 74 20 28 65 71 3f 20 r x)) (not (eq?
0b20: 78 20 6f 62 6a 29 29 29 0a 20 20 20 20 20 20 20 x obj))).
0b30: 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c (displ
0b40: 61 79 20 22 28 3f 3a 22 29 20 28 66 6f 72 2d 65 ay "(?:") (for-e
0b50: 61 63 68 20 6c 70 20 28 63 64 72 20 78 29 29 20 ach lp (cdr x))
0b60: 28 64 69 73 70 6c 61 79 20 22 29 22 29 29 0a 20 (display ")")).
0b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0b80: 65 6c 73 65 20 28 66 6f 72 2d 65 61 63 68 20 6c else (for-each l
0b90: 70 20 28 63 64 72 20 78 29 29 29 29 29 0a 20 20 p (cdr x))))).
0ba0: 20 20 20 20 20 20 20 20 20 20 20 28 28 73 75 62 ((sub
0bb0: 6d 61 74 63 68 29 20 28 64 69 73 70 6c 61 79 20 match) (display
0bc0: 22 28 22 29 20 28 66 6f 72 2d 65 61 63 68 20 6c "(") (for-each l
0bd0: 70 20 28 63 64 72 20 78 29 29 20 28 64 69 73 70 p (cdr x)) (disp
0be0: 6c 61 79 20 22 29 22 29 29 0a 20 20 20 20 20 20 lay ")")).
0bf0: 20 20 20 20 20 20 20 28 28 7c 5c 7c 7c 20 6f 72 ((|\|| or
0c00: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0c10: 28 64 69 73 70 6c 61 79 20 22 28 3f 3a 22 29 0a (display "(?:").
0c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
0c30: 70 20 28 63 61 64 72 20 78 29 29 0a 20 20 20 20 p (cadr x)).
0c40: 20 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 (for-e
0c50: 61 63 68 20 28 6c 61 6d 62 64 61 20 28 78 29 20 ach (lambda (x)
0c60: 28 64 69 73 70 6c 61 79 20 22 7c 22 29 20 28 6c (display "|") (l
0c70: 70 20 78 29 29 20 28 63 64 64 72 20 78 29 29 0a p x)) (cddr x)).
0c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 (d
0c90: 69 73 70 6c 61 79 20 22 29 22 29 29 0a 20 20 20 isplay ")")).
0ca0: 20 20 20 20 20 20 20 20 20 20 28 28 2a 20 2b 20 ((* +
0cb0: 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?).
0cc0: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond.
0cd0: 20 20 20 20 20 20 20 28 28 70 61 69 72 3f 20 28 ((pair? (
0ce0: 63 64 64 72 20 78 29 29 0a 20 20 20 20 20 20 20 cddr x)).
0cf0: 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c (displ
0d00: 61 79 20 22 28 3f 3a 22 29 20 28 66 6f 72 2d 65 ay "(?:") (for-e
0d10: 61 63 68 20 6c 70 20 28 63 64 72 20 78 29 29 20 ach lp (cdr x))
0d20: 28 64 69 73 70 6c 61 79 20 22 29 22 29 29 0a 20 (display ")")).
0d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
0d40: 65 6c 73 65 20 28 6c 70 20 28 63 61 64 72 20 78 else (lp (cadr x
0d50: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
0d60: 20 20 20 28 64 69 73 70 6c 61 79 20 28 63 61 72 (display (car
0d70: 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 x))).
0d80: 20 20 20 28 28 6e 6f 74 29 0a 20 20 20 20 20 20 ((not).
0d90: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
0da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
0db0: 61 6e 64 20 28 70 61 69 72 3f 20 28 63 61 64 72 and (pair? (cadr
0dc0: 20 78 29 29 20 28 65 71 3f 20 27 63 73 65 74 20 x)) (eq? 'cset
0dd0: 28 63 61 61 64 72 20 78 29 29 29 0a 20 20 20 20 (caadr x))).
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
0df0: 73 70 6c 61 79 20 22 5b 5e 22 29 0a 20 20 20 20 splay "[^").
0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
0e10: 73 70 6c 61 79 20 28 63 73 65 74 2d 3e 73 74 72 splay (cset->str
0e20: 69 6e 67 20 28 63 64 61 64 72 20 78 29 29 29 0a ing (cdadr x))).
0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e40: 20 28 64 69 73 70 6c 61 79 20 22 5d 22 29 29 0a (display "]")).
0e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e60: 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 63 61 (else (error "ca
0e70: 6e 27 74 20 72 65 70 72 65 73 65 6e 74 20 67 65 n't represent ge
0e80: 6e 65 72 61 6c 20 27 6e 6f 74 27 20 69 6e 20 73 neral 'not' in s
0e90: 74 72 69 6e 67 73 22 20 78 29 29 29 29 0a 20 20 trings" x)))).
0ea0: 20 20 20 20 20 20 20 20 20 20 20 28 28 63 73 65 ((cse
0eb0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
0ec0: 20 28 64 69 73 70 6c 61 79 20 22 5b 22 29 0a 20 (display "[").
0ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
0ee0: 73 70 6c 61 79 20 28 63 73 65 74 2d 3e 73 74 72 splay (cset->str
0ef0: 69 6e 67 20 28 63 64 72 20 78 29 29 29 0a 20 20 ing (cdr x))).
0f00: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 73 (dis
0f10: 70 6c 61 79 20 22 5d 22 29 29 0a 20 20 20 20 20 play "]")).
0f20: 20 20 20 20 20 20 20 20 28 28 77 2f 63 61 73 65 ((w/case
0f30: 20 77 2f 6e 6f 63 61 73 65 29 0a 20 20 20 20 20 w/nocase).
0f40: 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 (displa
0f50: 79 20 22 28 3f 22 29 0a 20 20 20 20 20 20 20 20 y "(?").
0f60: 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 28 (if (eq? (
0f70: 63 61 72 20 78 29 20 27 77 2f 63 61 73 65 29 20 car x) 'w/case)
0f80: 28 64 69 73 70 6c 61 79 20 22 2d 22 29 29 0a 20 (display "-")).
0f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
0fa0: 73 70 6c 61 79 20 22 3a 22 29 0a 20 20 20 20 20 splay ":").
0fb0: 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 (for-ea
0fc0: 63 68 20 6c 70 20 28 63 64 72 20 78 29 29 0a 20 ch lp (cdr x)).
0fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
0fe0: 73 70 6c 61 79 20 22 29 22 29 29 0a 20 20 20 20 splay ")")).
0ff0: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
1000: 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 6d error "unknown m
1010: 61 74 63 68 20 6f 70 65 72 61 74 6f 72 22 20 78 atch operator" x
1020: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 )))). (
1030: 28 73 79 6d 62 6f 6c 3f 20 78 29 0a 20 20 20 20 (symbol? x).
1040: 20 20 20 20 20 20 20 28 63 61 73 65 20 78 0a 20 (case x.
1050: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 62 6f ((bo
1060: 73 20 62 6f 6c 29 20 28 64 69 73 70 6c 61 79 20 s bol) (display
1070: 22 5e 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 "^")).
1080: 20 20 20 28 28 65 6f 73 20 65 6f 6c 29 20 28 64 ((eos eol) (d
1090: 69 73 70 6c 61 79 20 22 24 22 29 29 0a 20 20 20 isplay "$")).
10a0: 20 20 20 20 20 20 20 20 20 20 28 28 61 6e 79 20 ((any
10b0: 6e 6f 6e 6c 29 20 28 64 69 73 70 6c 61 79 20 22 nonl) (display "
10c0: 2e 22 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 .")).
10d0: 20 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 (else (error "
10e0: 75 6e 6b 6e 6f 77 6e 20 6d 61 74 63 68 20 73 79 unknown match sy
10f0: 6d 62 6f 6c 22 20 78 29 29 29 29 0a 20 20 20 20 mbol" x)))).
1100: 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3f 20 ((string?
1110: 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 x). (d
1120: 69 73 70 6c 61 79 20 28 69 72 72 65 67 65 78 2d isplay (irregex-
1130: 71 75 6f 74 65 20 28 2d 3e 73 74 72 69 6e 67 20 quote (->string
1140: 78 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 x)))).
1150: 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 75 6e (else (error "un
1160: 6b 6e 6f 77 6e 20 6d 61 74 63 68 20 70 61 74 74 known match patt
1170: 65 72 6e 22 20 78 29 29 29 29 29 29 29 0a 0a ern" x)))))))..