Artifact
198ea9bf44843c480dfc8bae452762385b222176:
- File
irregex-utils.sls
— part of check-in
[c4f5a3bcd9]
at
2016-07-09 21:57:07
on branch trunk
— added gl, irregex, sdl2 - removed match.scm
(user:
ovenpasta@pizzahack.eu
size: 6692)
0000: 3b 3b 3b 20 43 68 65 7a 2d 53 63 68 65 6d 65 20 ;;; Chez-Scheme
0010: 6c 69 62 72 61 72 79 20 66 6f 72 20 41 6c 65 78 library for Alex
0020: 20 53 68 69 6e 6e 27 73 20 49 72 72 65 67 65 78 Shinn's Irregex
0030: 0a 3b 3b 3b 20 0a 3b 3b 3b 20 43 6f 70 79 72 69 .;;; .;;; Copyri
0040: 67 68 74 20 28 63 29 20 32 30 31 36 20 46 65 64 ght (c) 2016 Fed
0050: 65 72 69 63 6f 20 42 65 66 66 61 20 3c 62 65 66 erico Beffa <bef
0060: 66 61 40 66 62 65 6e 67 69 6e 65 65 72 69 6e 67 fa@fbengineering
0070: 2e 63 68 3e 0a 3b 3b 3b 20 0a 3b 3b 3b 20 50 65 .ch>.;;; .;;; Pe
0080: 72 6d 69 73 73 69 6f 6e 20 74 6f 20 75 73 65 2c rmission to use,
0090: 20 63 6f 70 79 2c 20 6d 6f 64 69 66 79 2c 20 61 copy, modify, a
00a0: 6e 64 20 64 69 73 74 72 69 62 75 74 65 20 74 68 nd distribute th
00b0: 69 73 20 73 6f 66 74 77 61 72 65 20 66 6f 72 0a is software for.
00c0: 3b 3b 3b 20 61 6e 79 20 70 75 72 70 6f 73 65 20 ;;; any purpose
00d0: 77 69 74 68 20 6f 72 20 77 69 74 68 6f 75 74 20 with or without
00e0: 66 65 65 20 69 73 20 68 65 72 65 62 79 20 67 72 fee is hereby gr
00f0: 61 6e 74 65 64 2c 20 70 72 6f 76 69 64 65 64 20 anted, provided
0100: 74 68 61 74 20 74 68 65 0a 3b 3b 3b 20 61 62 6f that the.;;; abo
0110: 76 65 20 63 6f 70 79 72 69 67 68 74 20 6e 6f 74 ve copyright not
0120: 69 63 65 20 61 6e 64 20 74 68 69 73 20 70 65 72 ice and this per
0130: 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 63 65 20 61 mission notice a
0140: 70 70 65 61 72 20 69 6e 20 61 6c 6c 0a 3b 3b 3b ppear in all.;;;
0150: 20 63 6f 70 69 65 73 2e 0a 3b 3b 3b 20 0a 3b 3b copies..;;; .;;
0160: 3b 20 54 48 45 20 53 4f 46 54 57 41 52 45 20 49 ; THE SOFTWARE I
0170: 53 20 50 52 4f 56 49 44 45 44 20 22 41 53 20 49 S PROVIDED "AS I
0180: 53 22 20 41 4e 44 20 54 48 45 20 41 55 54 48 4f S" AND THE AUTHO
0190: 52 20 44 49 53 43 4c 41 49 4d 53 20 41 4c 4c 0a R DISCLAIMS ALL.
01a0: 3b 3b 3b 20 57 41 52 52 41 4e 54 49 45 53 20 57 ;;; WARRANTIES W
01b0: 49 54 48 20 52 45 47 41 52 44 20 54 4f 20 54 48 ITH REGARD TO TH
01c0: 49 53 20 53 4f 46 54 57 41 52 45 20 49 4e 43 4c IS SOFTWARE INCL
01d0: 55 44 49 4e 47 20 41 4c 4c 20 49 4d 50 4c 49 45 UDING ALL IMPLIE
01e0: 44 0a 3b 3b 3b 20 57 41 52 52 41 4e 54 49 45 53 D.;;; WARRANTIES
01f0: 20 4f 46 20 4d 45 52 43 48 41 4e 54 41 42 49 4c OF MERCHANTABIL
0200: 49 54 59 20 41 4e 44 20 46 49 54 4e 45 53 53 2e ITY AND FITNESS.
0210: 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 53 48 41 IN NO EVENT SHA
0220: 4c 4c 20 54 48 45 0a 3b 3b 3b 20 41 55 54 48 4f LL THE.;;; AUTHO
0230: 52 20 42 45 20 4c 49 41 42 4c 45 20 46 4f 52 20 R BE LIABLE FOR
0240: 41 4e 59 20 53 50 45 43 49 41 4c 2c 20 44 49 52 ANY SPECIAL, DIR
0250: 45 43 54 2c 20 49 4e 44 49 52 45 43 54 2c 20 4f ECT, INDIRECT, O
0260: 52 20 43 4f 4e 53 45 51 55 45 4e 54 49 41 4c 0a R CONSEQUENTIAL.
0270: 3b 3b 3b 20 44 41 4d 41 47 45 53 20 4f 52 20 41 ;;; DAMAGES OR A
0280: 4e 59 20 44 41 4d 41 47 45 53 20 57 48 41 54 53 NY DAMAGES WHATS
0290: 4f 45 56 45 52 20 52 45 53 55 4c 54 49 4e 47 20 OEVER RESULTING
02a0: 46 52 4f 4d 20 4c 4f 53 53 20 4f 46 20 55 53 45 FROM LOSS OF USE
02b0: 2c 20 44 41 54 41 0a 3b 3b 3b 20 4f 52 20 50 52 , DATA.;;; OR PR
02c0: 4f 46 49 54 53 2c 20 57 48 45 54 48 45 52 20 49 OFITS, WHETHER I
02d0: 4e 20 41 4e 20 41 43 54 49 4f 4e 20 4f 46 20 43 N AN ACTION OF C
02e0: 4f 4e 54 52 41 43 54 2c 20 4e 45 47 4c 49 47 45 ONTRACT, NEGLIGE
02f0: 4e 43 45 20 4f 52 20 4f 54 48 45 52 0a 3b 3b 3b NCE OR OTHER.;;;
0300: 20 54 4f 52 54 49 4f 55 53 20 41 43 54 49 4f 4e TORTIOUS ACTION
0310: 2c 20 41 52 49 53 49 4e 47 20 4f 55 54 20 4f 46 , ARISING OUT OF
0320: 20 4f 52 20 49 4e 20 43 4f 4e 4e 45 43 54 49 4f OR IN CONNECTIO
0330: 4e 20 57 49 54 48 20 54 48 45 20 55 53 45 20 4f N WITH THE USE O
0340: 52 0a 3b 3b 3b 20 50 45 52 46 4f 52 4d 41 4e 43 R.;;; PERFORMANC
0350: 45 20 4f 46 20 54 48 49 53 20 53 4f 46 54 57 41 E OF THIS SOFTWA
0360: 52 45 2e 0a 0a 28 6c 69 62 72 61 72 79 20 28 69 RE...(library (i
0370: 72 72 65 67 65 78 2d 75 74 69 6c 73 29 0a 20 20 rregex-utils).
0380: 28 65 78 70 6f 72 74 0a 20 20 20 69 72 72 65 67 (export. irreg
0390: 65 78 2d 71 75 6f 74 65 0a 20 20 20 69 72 72 65 ex-quote. irre
03a0: 67 65 78 2d 6f 70 74 0a 20 20 20 73 72 65 2d 3e gex-opt. sre->
03b0: 73 74 72 69 6e 67 29 0a 20 20 28 69 6d 70 6f 72 string). (impor
03c0: 74 20 0a 20 20 20 20 28 65 78 63 65 70 74 20 28 t . (except (
03d0: 72 6e 72 73 29 20 65 72 72 6f 72 20 66 69 6e 64 rnrs) error find
03e0: 20 66 69 6c 74 65 72 20 72 65 6d 6f 76 65 29 0a filter remove).
03f0: 20 20 20 20 28 6f 6e 6c 79 20 28 63 68 65 7a 73 (only (chezs
0400: 63 68 65 6d 65 29 20 69 6e 63 6c 75 64 65 20 67 cheme) include g
0410: 65 74 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 et-output-string
0420: 20 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 73 74 72 open-output-str
0430: 69 6e 67 29 0a 20 20 20 20 28 69 72 72 65 67 65 ing). (irrege
0440: 78 29 0a 20 20 20 20 28 6f 6e 6c 79 20 28 73 72 x). (only (sr
0450: 66 69 20 3a 31 29 20 65 76 65 72 79 29 29 0a 0a fi :1) every))..
0460: 20 20 3b 3b 20 64 65 66 69 6e 69 74 69 6f 6e 20 ;; definition
0470: 66 72 6f 6d 20 69 72 72 65 67 65 78 0a 20 20 28 from irregex. (
0480: 64 65 66 69 6e 65 20 28 65 72 72 6f 72 20 6d 73 define (error ms
0490: 67 20 2e 20 61 72 67 73 29 0a 20 20 20 20 28 64 g . args). (d
04a0: 69 73 70 6c 61 79 20 6d 73 67 29 0a 20 20 20 20 isplay msg).
04b0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
04c0: 61 20 28 78 29 20 28 64 69 73 70 6c 61 79 20 22 a (x) (display "
04d0: 20 22 29 20 28 77 72 69 74 65 20 78 29 29 20 61 ") (write x)) a
04e0: 72 67 73 29 0a 20 20 20 20 28 6e 65 77 6c 69 6e rgs). (newlin
04f0: 65 29 0a 20 20 20 20 28 30 29 29 0a 20 20 3b 3b e). (0)). ;;
0500: 3b 3b 20 69 72 72 65 67 65 78 2d 75 74 69 6c 73 ;; irregex-utils
0510: 2e 73 63 6d 0a 3b 3b 0a 3b 3b 20 43 6f 70 79 72 .scm.;;.;; Copyr
0520: 69 67 68 74 20 28 63 29 20 32 30 31 30 20 41 6c ight (c) 2010 Al
0530: 65 78 20 53 68 69 6e 6e 2e 20 20 41 6c 6c 20 72 ex Shinn. All r
0540: 69 67 68 74 73 20 72 65 73 65 72 76 65 64 2e 0a ights reserved..
0550: 3b 3b 20 42 53 44 2d 73 74 79 6c 65 20 6c 69 63 ;; BSD-style lic
0560: 65 6e 73 65 3a 20 68 74 74 70 3a 2f 2f 73 79 6e ense: http://syn
0570: 74 68 63 6f 64 65 2e 63 6f 6d 2f 6c 69 63 65 6e thcode.com/licen
0580: 73 65 2e 74 78 74 0a 0a 28 64 65 66 69 6e 65 20 se.txt..(define
0590: 72 78 2d 73 70 65 63 69 61 6c 2d 63 68 61 72 73 rx-special-chars
05a0: 0a 20 20 22 5c 5c 7c 5b 5d 28 29 7b 7d 2e 2a 2b . "\\|[](){}.*+
05b0: 3f 5e 24 23 22 29 0a 0a 28 64 65 66 69 6e 65 20 ?^$#")..(define
05c0: 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 (string-scan-cha
05d0: 72 20 73 74 72 20 63 20 2e 20 6f 29 0a 20 20 28 r str c . o). (
05e0: 6c 65 74 20 28 28 65 6e 64 20 28 73 74 72 69 6e let ((end (strin
05f0: 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 29 0a g-length str))).
0600: 20 20 20 20 28 6c 65 74 20 73 63 61 6e 20 28 28 (let scan ((
0610: 69 20 28 69 66 20 28 70 61 69 72 3f 20 6f 29 20 i (if (pair? o)
0620: 28 63 61 72 20 6f 29 20 30 29 29 29 0a 20 20 20 (car o) 0))).
0630: 20 20 20 28 63 6f 6e 64 20 28 28 3d 20 69 20 65 (cond ((= i e
0640: 6e 64 29 20 23 66 29 0a 20 20 20 20 20 20 20 20 nd) #f).
0650: 20 20 20 20 28 28 65 71 76 3f 20 63 20 28 73 74 ((eqv? c (st
0660: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 29 ring-ref str i))
0670: 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i).
0680: 28 65 6c 73 65 20 28 73 63 61 6e 20 28 2b 20 69 (else (scan (+ i
0690: 20 31 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 1)))))))..(defi
06a0: 6e 65 20 28 69 72 72 65 67 65 78 2d 71 75 6f 74 ne (irregex-quot
06b0: 65 20 73 74 72 29 0a 20 20 28 6c 69 73 74 2d 3e e str). (list->
06c0: 73 74 72 69 6e 67 0a 20 20 20 28 6c 65 74 20 6c string. (let l
06d0: 6f 6f 70 20 28 28 6c 73 20 28 73 74 72 69 6e 67 oop ((ls (string
06e0: 2d 3e 6c 69 73 74 20 73 74 72 29 29 20 28 72 65 ->list str)) (re
06f0: 73 20 27 28 29 29 29 0a 20 20 20 20 20 28 69 66 s '())). (if
0700: 20 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 (null? ls).
0710: 20 20 20 20 20 28 72 65 76 65 72 73 65 20 72 65 (reverse re
0720: 73 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 s). (let
0730: 20 28 28 63 20 28 63 61 72 20 6c 73 29 29 29 0a ((c (car ls))).
0740: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
0750: 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 72 string-scan-char
0760: 20 72 78 2d 73 70 65 63 69 61 6c 2d 63 68 61 72 rx-special-char
0770: 73 20 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 s c).
0780: 20 20 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 6c (loop (cdr l
0790: 73 29 20 28 63 6f 6e 73 20 63 20 28 63 6f 6e 73 s) (cons c (cons
07a0: 20 23 5c 5c 20 72 65 73 29 29 29 0a 20 20 20 20 #\\ res))).
07b0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 (loop
07c0: 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 20 (cdr ls) (cons
07d0: 63 20 72 65 73 29 29 29 29 29 29 29 29 0a 0a 3b c res))))))))..;
07e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
07f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0800: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0810: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0820: 3b 3b 3b 3b 3b 3b 3b 0a 0a 28 64 65 66 69 6e 65 ;;;;;;;..(define
0830: 20 28 69 72 72 65 67 65 78 2d 6f 70 74 20 6c 73 (irregex-opt ls
0840: 29 0a 20 20 28 64 65 66 69 6e 65 20 28 6d 61 6b ). (define (mak
0850: 65 2d 61 6c 74 20 6c 73 29 0a 20 20 20 20 28 63 e-alt ls). (c
0860: 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 28 63 64 72 ond ((null? (cdr
0870: 20 6c 73 29 29 20 28 63 61 72 20 6c 73 29 29 0a ls)) (car ls)).
0880: 20 20 20 20 20 20 20 20 20 20 28 28 65 76 65 72 ((ever
0890: 79 20 63 68 61 72 3f 20 6c 73 29 20 28 6c 69 73 y char? ls) (lis
08a0: 74 20 28 6c 69 73 74 2d 3e 73 74 72 69 6e 67 20 t (list->string
08b0: 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls))).
08c0: 28 65 6c 73 65 20 28 63 6f 6e 73 20 27 6f 72 20 (else (cons 'or
08d0: 6c 73 29 29 29 29 0a 20 20 28 64 65 66 69 6e 65 ls)))). (define
08e0: 20 28 6d 61 6b 65 2d 73 65 71 20 6c 73 29 0a 20 (make-seq ls).
08f0: 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f (cond ((null?
0900: 20 28 63 64 72 20 6c 73 29 29 20 28 63 61 72 20 (cdr ls)) (car
0910: 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 ls)). (
0920: 28 65 76 65 72 79 20 28 6c 61 6d 62 64 61 20 28 (every (lambda (
0930: 78 29 20 28 6f 72 20 28 73 74 72 69 6e 67 3f 20 x) (or (string?
0940: 78 29 20 28 63 68 61 72 3f 20 78 29 29 29 20 6c x) (char? x))) l
0950: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 61 s). (a
0960: 70 70 6c 79 20 73 74 72 69 6e 67 2d 61 70 70 65 pply string-appe
0970: 6e 64 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 nd (map (lambda
0980: 28 78 29 20 28 69 66 20 28 63 68 61 72 3f 20 78 (x) (if (char? x
0990: 29 20 28 73 74 72 69 6e 67 20 78 29 20 78 29 29 ) (string x) x))
09a0: 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 ls))).
09b0: 20 28 65 6c 73 65 20 28 63 6f 6e 73 20 27 73 65 (else (cons 'se
09c0: 71 20 6c 73 29 29 29 29 0a 20 20 28 63 6f 6e 64 q ls)))). (cond
09d0: 0a 20 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 20 . ((null? ls)
09e0: 22 22 29 0a 20 20 20 28 28 6e 75 6c 6c 3f 20 28 ""). ((null? (
09f0: 63 64 72 20 6c 73 29 29 20 28 63 61 72 20 6c 73 cdr ls)) (car ls
0a00: 29 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 20 )). (else.
0a10: 28 6c 65 74 20 28 28 63 68 61 72 73 20 28 6d 61 (let ((chars (ma
0a20: 6b 65 2d 76 65 63 74 6f 72 20 32 35 36 20 27 28 ke-vector 256 '(
0a30: 29 29 29 29 0a 20 20 20 20 20 20 28 6c 65 74 20 )))). (let
0a40: 6c 70 31 20 28 28 6c 73 20 6c 73 29 20 28 65 6d lp1 ((ls ls) (em
0a50: 70 74 79 3f 20 23 66 29 29 0a 20 20 20 20 20 20 pty? #f)).
0a60: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6c 73 29 (if (null? ls)
0a70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 . (le
0a80: 74 20 6c 70 32 20 28 28 69 20 30 29 20 28 72 65 t lp2 ((i 0) (re
0a90: 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 s '())).
0aa0: 20 20 20 20 20 20 28 69 66 20 28 3d 20 69 20 32 (if (= i 2
0ab0: 35 36 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 56).
0ac0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
0ad0: 20 28 6d 61 6b 65 2d 61 6c 74 20 28 72 65 76 65 (make-alt (reve
0ae0: 72 73 65 20 72 65 73 29 29 29 29 0a 20 20 20 20 rse res)))).
0af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b00: 28 69 66 20 65 6d 70 74 79 3f 20 60 28 3f 20 2c (if empty? `(? ,
0b10: 72 65 73 29 20 72 65 73 29 29 0a 20 20 20 20 20 res) res)).
0b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
0b30: 74 20 28 28 63 20 28 69 6e 74 65 67 65 72 2d 3e t ((c (integer->
0b40: 63 68 61 72 20 69 29 29 0a 20 20 20 20 20 20 20 char i)).
0b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b60: 20 28 6f 70 74 73 20 28 76 65 63 74 6f 72 2d 72 (opts (vector-r
0b70: 65 66 20 63 68 61 72 73 20 69 29 29 29 0a 20 20 ef chars i))).
0b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0b90: 20 20 28 6c 70 32 20 28 2b 20 69 20 31 29 0a 20 (lp2 (+ i 1).
0ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bb0: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
0bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0bd0: 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 ((null?
0be0: 6f 70 74 73 29 20 72 65 73 29 0a 20 20 20 20 20 opts) res).
0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c00: 20 20 20 20 20 28 28 65 71 75 61 6c 3f 20 6f 70 ((equal? op
0c10: 74 73 20 27 28 22 22 29 29 20 60 28 2c 63 20 2c ts '("")) `(,c ,
0c20: 40 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 @res)).
0c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c40: 20 28 65 6c 73 65 20 60 28 2c 28 6d 61 6b 65 2d (else `(,(make-
0c50: 73 65 71 20 28 6c 69 73 74 20 63 20 28 69 72 72 seq (list c (irr
0c60: 65 67 65 78 2d 6f 70 74 20 6f 70 74 73 29 29 29 egex-opt opts)))
0c70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
0c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0c90: 20 20 20 2c 40 72 65 73 29 29 29 29 29 29 29 0a ,@res))))))).
0ca0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
0cb0: 2a 20 28 28 73 74 72 20 28 63 61 72 20 6c 73 29 * ((str (car ls)
0cc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0cd0: 20 20 20 20 20 28 6c 65 6e 20 28 73 74 72 69 6e (len (strin
0ce0: 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 29 0a g-length str))).
0cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
0d00: 66 20 28 7a 65 72 6f 3f 20 6c 65 6e 29 0a 20 20 f (zero? len).
0d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0d20: 28 6c 70 31 20 28 63 64 72 20 6c 73 29 20 23 74 (lp1 (cdr ls) #t
0d30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0d40: 20 20 20 20 28 6c 65 74 20 28 28 69 20 28 63 68 (let ((i (ch
0d50: 61 72 2d 3e 69 6e 74 65 67 65 72 20 28 73 74 72 ar->integer (str
0d60: 69 6e 67 2d 72 65 66 20 73 74 72 20 30 29 29 29 ing-ref str 0)))
0d70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
0d80: 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
0d90: 74 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t!.
0da0: 20 20 20 20 20 20 20 20 63 68 61 72 73 0a 20 20 chars.
0db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0dc0: 20 20 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 i.
0dd0: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 (cons
0de0: 28 73 75 62 73 74 72 69 6e 67 20 73 74 72 20 31 (substring str 1
0df0: 20 6c 65 6e 29 20 28 76 65 63 74 6f 72 2d 72 65 len) (vector-re
0e00: 66 20 63 68 61 72 73 20 69 29 29 29 0a 20 20 20 f chars i))).
0e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e20: 20 28 6c 70 31 20 28 63 64 72 20 6c 73 29 20 65 (lp1 (cdr ls) e
0e30: 6d 70 74 79 3f 29 29 29 29 29 29 29 29 29 29 0a mpty?)))))))))).
0e40: 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;;;;;;;;;;;;;;;
0e50: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0e60: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0e70: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0e80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 0a 28 64 65 66 69 ;;;;;;;;;..(defi
0e90: 6e 65 20 28 63 73 65 74 2d 3e 73 74 72 69 6e 67 ne (cset->string
0ea0: 20 6c 73 29 0a 20 20 28 6c 65 74 20 28 28 6f 75 ls). (let ((ou
0eb0: 74 20 28 6f 70 65 6e 2d 6f 75 74 70 75 74 2d 73 t (open-output-s
0ec0: 74 72 69 6e 67 29 29 29 0a 20 20 20 20 28 6c 65 tring))). (le
0ed0: 74 20 6c 70 20 28 28 6c 73 20 6c 73 29 29 0a 20 t lp ((ls ls)).
0ee0: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
0ef0: 20 20 28 28 70 61 69 72 3f 20 6c 73 29 0a 20 20 ((pair? ls).
0f00: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
0f10: 20 20 20 20 20 28 28 70 61 69 72 3f 20 28 63 61 ((pair? (ca
0f20: 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 r ls)).
0f30: 20 28 64 69 73 70 6c 61 79 20 28 69 72 72 65 67 (display (irreg
0f40: 65 78 2d 71 75 6f 74 65 20 28 73 74 72 69 6e 67 ex-quote (string
0f50: 20 28 63 61 61 72 20 6c 73 29 29 29 20 6f 75 74 (caar ls))) out
0f60: 29 0a 20 20 20 20 20 20 20 20 20 20 28 77 72 69 ). (wri
0f70: 74 65 2d 63 68 61 72 20 23 5c 2d 20 6f 75 74 29 te-char #\- out)
0f80: 0a 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 . (disp
0f90: 6c 61 79 20 28 69 72 72 65 67 65 78 2d 71 75 6f lay (irregex-quo
0fa0: 74 65 20 28 73 74 72 69 6e 67 20 28 63 64 61 72 te (string (cdar
0fb0: 20 6c 73 29 29 29 20 6f 75 74 29 29 0a 20 20 20 ls))) out)).
0fc0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 64 69 73 (else (dis
0fd0: 70 6c 61 79 20 28 69 72 72 65 67 65 78 2d 71 75 play (irregex-qu
0fe0: 6f 74 65 20 28 73 74 72 69 6e 67 20 28 63 61 72 ote (string (car
0ff0: 20 6c 73 29 29 29 20 6f 75 74 29 29 29 0a 20 20 ls))) out))).
1000: 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c (lp (cdr l
1010: 73 29 29 29 29 29 0a 20 20 20 20 28 67 65 74 2d s))))). (get-
1020: 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 20 6f 75 output-string ou
1030: 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 t)))..(define (s
1040: 72 65 2d 3e 73 74 72 69 6e 67 20 6f 62 6a 29 0a re->string obj).
1050: 20 20 28 6c 65 74 20 28 28 6f 75 74 20 28 6f 70 (let ((out (op
1060: 65 6e 2d 6f 75 74 70 75 74 2d 73 74 72 69 6e 67 en-output-string
1070: 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 70 20 ))). (let lp
1080: 28 28 78 20 6f 62 6a 29 29 0a 20 20 20 20 20 20 ((x obj)).
1090: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 70 (cond. ((p
10a0: 61 69 72 3f 20 78 29 0a 20 20 20 20 20 20 20 20 air? x).
10b0: 28 63 61 73 65 20 28 63 61 72 20 78 29 0a 20 20 (case (car x).
10c0: 20 20 20 20 20 20 20 20 28 28 3a 20 73 65 71 29 ((: seq)
10d0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e . (con
10e0: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 d. ((
10f0: 61 6e 64 20 28 70 61 69 72 3f 20 28 63 64 64 72 and (pair? (cddr
1100: 20 78 29 29 20 28 70 61 69 72 3f 20 28 63 64 64 x)) (pair? (cdd
1110: 72 20 78 29 29 20 28 6e 6f 74 20 28 65 71 3f 20 r x)) (not (eq?
1120: 78 20 6f 62 6a 29 29 29 0a 20 20 20 20 20 20 20 x obj))).
1130: 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 22 (display "
1140: 28 3f 3a 22 20 6f 75 74 29 20 28 66 6f 72 2d 65 (?:" out) (for-e
1150: 61 63 68 20 6c 70 20 28 63 64 72 20 78 29 29 20 ach lp (cdr x))
1160: 28 64 69 73 70 6c 61 79 20 22 29 22 20 6f 75 74 (display ")" out
1170: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
1180: 65 6c 73 65 20 28 66 6f 72 2d 65 61 63 68 20 6c else (for-each l
1190: 70 20 28 63 64 72 20 78 29 29 29 29 29 0a 20 20 p (cdr x))))).
11a0: 20 20 20 20 20 20 20 20 28 28 73 75 62 6d 61 74 ((submat
11b0: 63 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ch). (
11c0: 64 69 73 70 6c 61 79 20 22 28 22 20 6f 75 74 29 display "(" out)
11d0: 20 28 66 6f 72 2d 65 61 63 68 20 6c 70 20 28 63 (for-each lp (c
11e0: 64 72 20 78 29 29 20 28 64 69 73 70 6c 61 79 20 dr x)) (display
11f0: 22 29 22 20 6f 75 74 29 29 0a 20 20 20 20 20 20 ")" out)).
1200: 20 20 20 20 28 28 73 75 62 6d 61 74 63 68 2d 6e ((submatch-n
1210: 61 6d 65 64 29 0a 20 20 20 20 20 20 20 20 20 20 amed).
1220: 20 28 64 69 73 70 6c 61 79 20 22 28 3f 3c 22 20 (display "(?<"
1230: 6f 75 74 29 20 28 64 69 73 70 6c 61 79 20 28 63 out) (display (c
1240: 61 64 72 20 78 29 20 6f 75 74 29 20 28 64 69 73 adr x) out) (dis
1250: 70 6c 61 79 20 22 3e 22 20 6f 75 74 29 0a 20 20 play ">" out).
1260: 20 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 (for-ea
1270: 63 68 20 6c 70 20 28 63 64 64 72 20 78 29 29 20 ch lp (cddr x))
1280: 28 64 69 73 70 6c 61 79 20 22 29 22 20 6f 75 74 (display ")" out
1290: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 6f )). ((o
12a0: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 r). (d
12b0: 69 73 70 6c 61 79 20 22 28 3f 3a 22 20 6f 75 74 isplay "(?:" out
12c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 ). (lp
12d0: 20 28 63 61 64 72 20 78 29 29 0a 20 20 20 20 20 (cadr x)).
12e0: 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 20 (for-each
12f0: 28 6c 61 6d 62 64 61 20 28 78 29 20 28 64 69 73 (lambda (x) (dis
1300: 70 6c 61 79 20 22 7c 22 20 6f 75 74 29 20 28 6c play "|" out) (l
1310: 70 20 78 29 29 20 28 63 64 64 72 20 78 29 29 0a p x)) (cddr x)).
1320: 20 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 (disp
1330: 6c 61 79 20 22 29 22 20 6f 75 74 29 29 0a 20 20 lay ")" out)).
1340: 20 20 20 20 20 20 20 20 28 28 2a 20 2b 20 3f 20 ((* + ?
1350: 2a 3f 20 3f 3f 29 0a 20 20 20 20 20 20 20 20 20 *? ??).
1360: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
1370: 20 20 20 20 28 28 70 61 69 72 3f 20 28 63 64 64 ((pair? (cdd
1380: 72 20 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 r x)).
1390: 20 20 20 28 64 69 73 70 6c 61 79 20 22 28 3f 3a (display "(?:
13a0: 22 20 6f 75 74 29 20 28 66 6f 72 2d 65 61 63 68 " out) (for-each
13b0: 20 6c 70 20 28 63 64 72 20 78 29 29 20 28 64 69 lp (cdr x)) (di
13c0: 73 70 6c 61 79 20 22 29 22 20 6f 75 74 29 29 0a splay ")" out)).
13d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
13e0: 65 20 28 6c 70 20 28 63 61 64 72 20 78 29 29 29 e (lp (cadr x)))
13f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 69 ). (di
1400: 73 70 6c 61 79 20 28 63 61 72 20 78 29 20 6f 75 splay (car x) ou
1410: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 t)). ((
1420: 6e 6f 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 not).
1430: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
1440: 20 20 28 28 61 6e 64 20 28 70 61 69 72 3f 20 28 ((and (pair? (
1450: 63 61 64 72 20 78 29 29 20 28 65 71 3f 20 27 63 cadr x)) (eq? 'c
1460: 73 65 74 20 28 63 61 61 64 72 20 78 29 29 29 0a set (caadr x))).
1470: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
1480: 73 70 6c 61 79 20 22 5b 5e 22 20 6f 75 74 29 0a splay "[^" out).
1490: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 69 (di
14a0: 73 70 6c 61 79 20 28 63 73 65 74 2d 3e 73 74 72 splay (cset->str
14b0: 69 6e 67 20 28 63 64 61 64 72 20 78 29 29 20 6f ing (cdadr x)) o
14c0: 75 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ut).
14d0: 20 28 64 69 73 70 6c 61 79 20 22 5d 22 20 6f 75 (display "]" ou
14e0: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
14f0: 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 63 61 (else (error "ca
1500: 6e 27 74 20 72 65 70 72 65 73 65 6e 74 20 67 65 n't represent ge
1510: 6e 65 72 61 6c 20 27 6e 6f 74 27 20 69 6e 20 73 neral 'not' in s
1520: 74 72 69 6e 67 73 22 20 78 29 29 29 29 0a 20 20 trings" x)))).
1530: 20 20 20 20 20 20 20 20 28 28 63 73 65 74 29 0a ((cset).
1540: 20 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 (disp
1550: 6c 61 79 20 22 5b 22 20 6f 75 74 29 0a 20 20 20 lay "[" out).
1560: 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 (display
1570: 20 28 63 73 65 74 2d 3e 73 74 72 69 6e 67 20 28 (cset->string (
1580: 63 64 72 20 78 29 29 20 6f 75 74 29 0a 20 20 20 cdr x)) out).
1590: 20 20 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 (display
15a0: 20 22 5d 22 20 6f 75 74 29 29 0a 20 20 20 20 20 "]" out)).
15b0: 20 20 20 20 20 28 28 2d 20 26 20 2f 20 7e 29 0a ((- & / ~).
15c0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
15d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6f . ((o
15e0: 72 20 28 65 71 3f 20 23 5c 7e 20 28 63 61 72 20 r (eq? #\~ (car
15f0: 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 x)).
1600: 20 20 20 20 20 28 61 6e 64 20 28 65 71 3f 20 27 (and (eq? '
1610: 2d 20 28 63 61 72 20 78 29 29 20 28 70 61 69 72 - (car x)) (pair
1620: 3f 20 28 63 64 72 20 78 29 29 20 28 65 71 3f 20 ? (cdr x)) (eq?
1630: 27 61 6e 79 20 28 63 61 64 72 20 78 29 29 29 29 'any (cadr x))))
1640: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 . (d
1650: 69 73 70 6c 61 79 20 22 5b 5e 22 20 6f 75 74 29 isplay "[^" out)
1660: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 . (d
1670: 69 73 70 6c 61 79 20 28 63 73 65 74 2d 3e 73 74 isplay (cset->st
1680: 72 69 6e 67 20 28 69 66 20 28 65 71 3f 20 23 5c ring (if (eq? #\
1690: 7e 20 28 63 61 72 20 78 29 29 20 28 63 64 72 20 ~ (car x)) (cdr
16a0: 78 29 20 28 63 64 64 72 20 78 29 29 29 20 6f 75 x) (cddr x))) ou
16b0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
16c0: 28 64 69 73 70 6c 61 79 20 22 5d 22 20 6f 75 74 (display "]" out
16d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
16e0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
16f0: 20 20 28 6c 70 20 60 28 63 73 65 74 20 2c 40 28 (lp `(cset ,@(
1700: 73 72 65 2d 3e 63 73 65 74 20 78 29 29 29 29 29 sre->cset x)))))
1710: 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 77 2f ). ((w/
1720: 63 61 73 65 20 77 2f 6e 6f 63 61 73 65 29 0a 20 case w/nocase).
1730: 20 20 20 20 20 20 20 20 20 20 28 64 69 73 70 6c (displ
1740: 61 79 20 22 28 3f 22 20 6f 75 74 29 0a 20 20 20 ay "(?" out).
1750: 20 20 20 20 20 20 20 20 28 69 66 20 28 65 71 3f (if (eq?
1760: 20 28 63 61 72 20 78 29 20 27 77 2f 63 61 73 65 (car x) 'w/case
1770: 29 20 28 64 69 73 70 6c 61 79 20 22 2d 22 20 6f ) (display "-" o
1780: 75 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ut)).
1790: 28 64 69 73 70 6c 61 79 20 22 3a 22 20 6f 75 74 (display ":" out
17a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 66 6f ). (fo
17b0: 72 2d 65 61 63 68 20 6c 70 20 28 63 64 72 20 78 r-each lp (cdr x
17c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 64 )). (d
17d0: 69 73 70 6c 61 79 20 22 29 22 20 6f 75 74 29 29 isplay ")" out))
17e0: 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 . (else
17f0: 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 . (if
1800: 28 73 74 72 69 6e 67 3f 20 28 63 61 72 20 78 29 (string? (car x)
1810: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1820: 20 28 6c 70 20 60 28 63 73 65 74 20 2c 40 28 73 (lp `(cset ,@(s
1830: 74 72 69 6e 67 2d 3e 6c 69 73 74 20 28 63 61 72 tring->list (car
1840: 20 78 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 x)))).
1850: 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e (error "un
1860: 6b 6e 6f 77 6e 20 73 72 65 20 6f 70 65 72 61 74 known sre operat
1870: 6f 72 22 20 78 29 29 29 29 29 0a 20 20 20 20 20 or" x))))).
1880: 20 20 28 28 73 79 6d 62 6f 6c 3f 20 78 29 0a 20 ((symbol? x).
1890: 20 20 20 20 20 20 20 28 63 61 73 65 20 78 0a 20 (case x.
18a0: 20 20 20 20 20 20 20 20 20 28 28 62 6f 73 20 62 ((bos b
18b0: 6f 6c 29 20 28 64 69 73 70 6c 61 79 20 22 5e 22 ol) (display "^"
18c0: 20 6f 75 74 29 29 0a 20 20 20 20 20 20 20 20 20 out)).
18d0: 20 28 28 65 6f 73 20 65 6f 6c 29 20 28 64 69 73 ((eos eol) (dis
18e0: 70 6c 61 79 20 22 24 22 20 6f 75 74 29 29 0a 20 play "$" out)).
18f0: 20 20 20 20 20 20 20 20 20 28 28 61 6e 79 20 6e ((any n
1900: 6f 6e 6c 29 20 28 64 69 73 70 6c 61 79 20 22 2e onl) (display ".
1910: 22 20 6f 75 74 29 29 0a 20 20 20 20 20 20 20 20 " out)).
1920: 20 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 (else (error "
1930: 75 6e 6b 6e 6f 77 6e 20 73 72 65 20 73 79 6d 62 unknown sre symb
1940: 6f 6c 22 20 78 29 29 29 29 0a 20 20 20 20 20 20 ol" x)))).
1950: 20 28 28 73 74 72 69 6e 67 3f 20 78 29 0a 20 20 ((string? x).
1960: 20 20 20 20 20 20 28 64 69 73 70 6c 61 79 20 28 (display (
1970: 69 72 72 65 67 65 78 2d 71 75 6f 74 65 20 78 29 irregex-quote x)
1980: 20 6f 75 74 29 29 0a 20 20 20 20 20 20 20 28 28 out)). ((
1990: 63 68 61 72 3f 20 78 29 0a 20 20 20 20 20 20 20 char? x).
19a0: 20 28 64 69 73 70 6c 61 79 20 28 69 72 72 65 67 (display (irreg
19b0: 65 78 2d 71 75 6f 74 65 20 28 73 74 72 69 6e 67 ex-quote (string
19c0: 20 78 29 29 20 6f 75 74 29 29 0a 20 20 20 20 20 x)) out)).
19d0: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
19e0: 28 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 (error "unknown
19f0: 73 72 65 20 70 61 74 74 65 72 6e 22 20 78 29 29 sre pattern" x))
1a00: 29 29 0a 20 20 20 20 28 67 65 74 2d 6f 75 74 70 )). (get-outp
1a10: 75 74 2d 73 74 72 69 6e 67 20 6f 75 74 29 29 29 ut-string out)))
1a20: 0a 0a 29 0a ..).