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 29 0a 20 20 28 65 78 70 6f 72 rregex). (expor
0380: 74 20 0a 20 20 20 20 69 72 72 65 67 65 78 0a 20 t . irregex.
0390: 20 20 20 73 74 72 69 6e 67 2d 3e 69 72 72 65 67 string->irreg
03a0: 65 78 0a 20 20 20 20 73 72 65 2d 3e 69 72 72 65 ex. sre->irre
03b0: 67 65 78 0a 20 20 20 20 73 74 72 69 6e 67 2d 3e gex. string->
03c0: 73 72 65 0a 20 20 20 20 6d 61 79 62 65 2d 73 74 sre. maybe-st
03d0: 72 69 6e 67 2d 3e 73 72 65 0a 20 20 20 20 69 72 ring->sre. ir
03e0: 72 65 67 65 78 3f 0a 20 20 20 20 69 72 72 65 67 regex?. irreg
03f0: 65 78 2d 6d 61 74 63 68 2d 64 61 74 61 3f 0a 20 ex-match-data?.
0400: 20 20 20 69 72 72 65 67 65 78 2d 6e 65 77 2d 6d irregex-new-m
0410: 61 74 63 68 65 73 0a 20 20 20 20 69 72 72 65 67 atches. irreg
0420: 65 78 2d 72 65 73 65 74 2d 6d 61 74 63 68 65 73 ex-reset-matches
0430: 21 0a 20 20 20 20 69 72 72 65 67 65 78 2d 73 65 !. irregex-se
0440: 61 72 63 68 0a 20 20 20 20 69 72 72 65 67 65 78 arch. irregex
0450: 2d 73 65 61 72 63 68 2f 6d 61 74 63 68 65 73 0a -search/matches.
0460: 20 20 20 20 69 72 72 65 67 65 78 2d 6d 61 74 63 irregex-matc
0470: 68 0a 20 20 20 20 69 72 72 65 67 65 78 2d 73 65 h. irregex-se
0480: 61 72 63 68 2f 63 68 75 6e 6b 65 64 0a 20 20 20 arch/chunked.
0490: 20 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2f 63 irregex-match/c
04a0: 68 75 6e 6b 65 64 0a 20 20 20 20 69 72 72 65 67 hunked. irreg
04b0: 65 78 2d 66 6f 6c 64 2f 63 68 75 6e 6b 65 64 0a ex-fold/chunked.
04c0: 20 20 20 20 6d 61 6b 65 2d 69 72 72 65 67 65 78 make-irregex
04d0: 2d 63 68 75 6e 6b 65 72 0a 20 20 20 20 69 72 72 -chunker. irr
04e0: 65 67 65 78 2d 6d 61 74 63 68 2d 73 75 62 73 74 egex-match-subst
04f0: 72 69 6e 67 0a 20 20 20 20 69 72 72 65 67 65 78 ring. irregex
0500: 2d 6d 61 74 63 68 2d 73 75 62 63 68 75 6e 6b 0a -match-subchunk.
0510: 20 20 20 20 69 72 72 65 67 65 78 2d 6d 61 74 63 irregex-matc
0520: 68 2d 73 74 61 72 74 2d 63 68 75 6e 6b 0a 20 20 h-start-chunk.
0530: 20 20 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d irregex-match-
0540: 65 6e 64 2d 63 68 75 6e 6b 0a 20 20 20 20 69 72 end-chunk. ir
0550: 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 regex-match-star
0560: 74 2d 69 6e 64 65 78 0a 20 20 20 20 69 72 72 65 t-index. irre
0570: 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e gex-match-end-in
0580: 64 65 78 0a 20 20 20 20 69 72 72 65 67 65 78 2d dex. irregex-
0590: 6d 61 74 63 68 2d 6e 75 6d 2d 73 75 62 6d 61 74 match-num-submat
05a0: 63 68 65 73 0a 20 20 20 20 69 72 72 65 67 65 78 ches. irregex
05b0: 2d 6d 61 74 63 68 2d 6e 61 6d 65 73 0a 20 20 20 -match-names.
05c0: 20 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 76 irregex-match-v
05d0: 61 6c 69 64 2d 69 6e 64 65 78 3f 0a 20 20 20 20 alid-index?.
05e0: 69 72 72 65 67 65 78 2d 66 6f 6c 64 0a 20 20 20 irregex-fold.
05f0: 20 69 72 72 65 67 65 78 2d 72 65 70 6c 61 63 65 irregex-replace
0600: 0a 20 20 20 20 69 72 72 65 67 65 78 2d 72 65 70 . irregex-rep
0610: 6c 61 63 65 2f 61 6c 6c 0a 20 20 20 20 69 72 72 lace/all. irr
0620: 65 67 65 78 2d 64 66 61 0a 20 20 20 20 69 72 72 egex-dfa. irr
0630: 65 67 65 78 2d 64 66 61 2f 73 65 61 72 63 68 0a egex-dfa/search.
0640: 20 20 20 20 69 72 72 65 67 65 78 2d 6e 66 61 0a irregex-nfa.
0650: 20 20 20 20 69 72 72 65 67 65 78 2d 66 6c 61 67 irregex-flag
0660: 73 0a 20 20 20 20 69 72 72 65 67 65 78 2d 6c 65 s. irregex-le
0670: 6e 67 74 68 73 0a 20 20 20 20 69 72 72 65 67 65 ngths. irrege
0680: 78 2d 6e 61 6d 65 73 0a 20 20 20 20 69 72 72 65 x-names. irre
0690: 67 65 78 2d 6e 75 6d 2d 73 75 62 6d 61 74 63 68 gex-num-submatch
06a0: 65 73 0a 20 20 20 20 69 72 72 65 67 65 78 2d 65 es. irregex-e
06b0: 78 74 72 61 63 74 0a 20 20 20 20 69 72 72 65 67 xtract. irreg
06c0: 65 78 2d 73 70 6c 69 74 0a 20 20 20 20 73 72 65 ex-split. sre
06d0: 2d 3e 63 73 65 74 29 0a 20 20 28 69 6d 70 6f 72 ->cset). (impor
06e0: 74 20 0a 20 20 20 20 28 73 72 66 69 20 73 30 20 t . (srfi s0
06f0: 63 6f 6e 64 2d 65 78 70 61 6e 64 29 0a 20 20 20 cond-expand).
0700: 20 28 65 78 63 65 70 74 20 28 72 6e 72 73 29 20 (except (rnrs)
0710: 65 72 72 6f 72 20 66 69 6e 64 20 66 69 6c 74 65 error find filte
0720: 72 20 72 65 6d 6f 76 65 29 0a 20 20 20 20 28 72 r remove). (r
0730: 6e 72 73 20 72 35 72 73 29 0a 20 20 20 20 28 72 nrs r5rs). (r
0740: 6e 72 73 20 6d 75 74 61 62 6c 65 2d 70 61 69 72 nrs mutable-pair
0750: 73 29 0a 20 20 20 20 28 72 6e 72 73 20 6d 75 74 s). (rnrs mut
0760: 61 62 6c 65 2d 73 74 72 69 6e 67 73 29 0a 20 20 able-strings).
0770: 20 20 28 6f 6e 6c 79 20 28 63 68 65 7a 73 63 68 (only (chezsch
0780: 65 6d 65 29 20 69 6e 63 6c 75 64 65 29 29 0a 0a eme) include))..
0790: 20 20 3b 3b 20 64 65 66 69 6e 69 74 69 6f 6e 20 ;; definition
07a0: 66 72 6f 6d 20 69 72 72 65 67 65 78 0a 20 20 28 from irregex. (
07b0: 64 65 66 69 6e 65 20 28 65 72 72 6f 72 20 6d 73 define (error ms
07c0: 67 20 2e 20 61 72 67 73 29 0a 20 20 20 20 28 64 g . args). (d
07d0: 69 73 70 6c 61 79 20 6d 73 67 29 0a 20 20 20 20 isplay msg).
07e0: 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d 62 64 (for-each (lambd
07f0: 61 20 28 78 29 20 28 64 69 73 70 6c 61 79 20 22 a (x) (display "
0800: 20 22 29 20 28 77 72 69 74 65 20 78 29 29 20 61 ") (write x)) a
0810: 72 67 73 29 0a 20 20 20 20 28 6e 65 77 6c 69 6e rgs). (newlin
0820: 65 29 0a 20 20 20 20 28 30 29 29 0a 3b 3b 3b 3b e). (0)).;;;;
0830: 20 69 72 72 65 67 65 78 2e 73 63 6d 20 2d 2d 20 irregex.scm --
0840: 49 72 52 65 67 75 6c 61 72 20 45 78 70 72 65 73 IrRegular Expres
0850: 73 69 6f 6e 73 0a 3b 3b 0a 3b 3b 20 43 6f 70 79 sions.;;.;; Copy
0860: 72 69 67 68 74 20 28 63 29 20 32 30 30 35 2d 32 right (c) 2005-2
0870: 30 32 34 20 41 6c 65 78 20 53 68 69 6e 6e 2e 20 024 Alex Shinn.
0880: 20 41 6c 6c 20 72 69 67 68 74 73 20 72 65 73 65 All rights rese
0890: 72 76 65 64 2e 0a 3b 3b 20 42 53 44 2d 73 74 79 rved..;; BSD-sty
08a0: 6c 65 20 6c 69 63 65 6e 73 65 3a 20 68 74 74 70 le license: http
08b0: 3a 2f 2f 73 79 6e 74 68 63 6f 64 65 2e 63 6f 6d ://synthcode.com
08c0: 2f 6c 69 63 65 6e 73 65 2e 74 78 74 0a 0a 3b 3b /license.txt..;;
08d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
08e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
08f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0900: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0910: 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 41 74 20 74 68 69 ;;;;;;.;; At thi
0920: 73 20 6d 6f 6d 65 6e 74 20 74 68 65 72 65 20 77 s moment there w
0930: 61 73 20 61 20 6c 6f 75 64 20 72 69 6e 67 20 61 as a loud ring a
0940: 74 20 74 68 65 20 62 65 6c 6c 2c 20 61 6e 64 20 t the bell, and
0950: 49 20 63 6f 75 6c 64 0a 3b 3b 20 68 65 61 72 20 I could.;; hear
0960: 4d 72 73 2e 20 48 75 64 73 6f 6e 2c 20 6f 75 72 Mrs. Hudson, our
0970: 20 6c 61 6e 64 6c 61 64 79 2c 20 72 61 69 73 69 landlady, raisi
0980: 6e 67 20 68 65 72 20 76 6f 69 63 65 20 69 6e 20 ng her voice in
0990: 61 20 77 61 69 6c 20 6f 66 0a 3b 3b 20 65 78 70 a wail of.;; exp
09a0: 6f 73 74 75 6c 61 74 69 6f 6e 20 61 6e 64 20 64 ostulation and d
09b0: 69 73 6d 61 79 2e 0a 3b 3b 0a 3b 3b 20 22 42 79 ismay..;;.;; "By
09c0: 20 68 65 61 76 65 6e 2c 20 48 6f 6c 6d 65 73 2c heaven, Holmes,
09d0: 22 20 49 20 73 61 69 64 2c 20 68 61 6c 66 20 72 " I said, half r
09e0: 69 73 69 6e 67 2c 20 22 49 20 62 65 6c 69 65 76 ising, "I believ
09f0: 65 20 74 68 61 74 0a 3b 3b 20 74 68 65 79 20 61 e that.;; they a
0a00: 72 65 20 72 65 61 6c 6c 79 20 61 66 74 65 72 20 re really after
0a10: 75 73 2e 22 0a 3b 3b 0a 3b 3b 20 22 4e 6f 2c 20 us.".;;.;; "No,
0a20: 69 74 27 73 20 6e 6f 74 20 71 75 69 74 65 20 73 it's not quite s
0a30: 6f 20 62 61 64 20 61 73 20 74 68 61 74 2e 20 20 o bad as that.
0a40: 49 74 20 69 73 20 74 68 65 20 75 6e 6f 66 66 69 It is the unoffi
0a50: 63 69 61 6c 0a 3b 3b 20 66 6f 72 63 65 2c 20 2d cial.;; force, -
0a60: 2d 20 74 68 65 20 42 61 6b 65 72 20 53 74 72 65 - the Baker Stre
0a70: 65 74 20 69 72 72 65 67 75 6c 61 72 73 2e 22 0a et irregulars.".
0a80: 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;;;;;;;;;;;;;;;
0a90: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0aa0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0ab0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0ac0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 4e ;;;;;;;;;.;;;; N
0ad0: 6f 74 65 73 0a 3b 3b 0a 3b 3b 20 54 68 69 73 20 otes.;;.;; This
0ae0: 63 6f 64 65 20 73 68 6f 75 6c 64 20 6e 6f 74 20 code should not
0af0: 72 65 71 75 69 72 65 20 61 6e 79 20 70 6f 72 74 require any port
0b00: 69 6e 67 20 2d 20 69 74 20 73 68 6f 75 6c 64 20 ing - it should
0b10: 77 6f 72 6b 20 6f 75 74 20 6f 66 0a 3b 3b 20 74 work out of.;; t
0b20: 68 65 20 62 6f 78 20 69 6e 20 61 6e 79 20 52 5b he box in any R[
0b30: 34 35 37 5d 52 53 20 53 63 68 65 6d 65 20 69 6d 457]RS Scheme im
0b40: 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 2e 20 20 53 plementation. S
0b50: 6c 69 67 68 74 20 6d 6f 64 69 66 69 63 61 74 69 light modificati
0b60: 6f 6e 73 0a 3b 3b 20 61 72 65 20 6e 65 65 64 65 ons.;; are neede
0b70: 64 20 66 6f 72 20 52 36 52 53 20 28 61 20 73 65 d for R6RS (a se
0b80: 70 61 72 61 74 65 20 52 36 52 53 2d 63 6f 6d 70 parate R6RS-comp
0b90: 61 74 69 62 6c 65 20 76 65 72 73 69 6f 6e 20 69 atible version i
0ba0: 73 20 69 6e 63 6c 75 64 65 64 0a 3b 3b 20 69 6e s included.;; in
0bb0: 20 74 68 65 20 64 69 73 74 72 69 62 75 74 69 6f the distributio
0bc0: 6e 20 61 73 20 69 72 72 65 67 65 78 2d 72 36 72 n as irregex-r6r
0bd0: 73 2e 73 63 6d 29 2e 0a 3b 3b 0a 3b 3b 20 54 68 s.scm)..;;.;; Th
0be0: 65 20 67 6f 61 6c 20 6f 66 20 70 6f 72 74 61 62 e goal of portab
0bf0: 69 6c 69 74 79 20 6d 61 6b 65 73 20 74 68 69 73 ility makes this
0c00: 20 63 6f 64 65 20 61 20 6c 69 74 74 6c 65 20 63 code a little c
0c10: 6c 75 6d 73 79 20 61 6e 64 0a 3b 3b 20 69 6e 65 lumsy and.;; ine
0c20: 66 66 69 63 69 65 6e 74 2e 20 20 46 75 74 75 72 fficient. Futur
0c30: 65 20 76 65 72 73 69 6f 6e 73 20 77 69 6c 6c 20 e versions will
0c40: 69 6e 63 6c 75 64 65 20 62 6f 74 68 20 63 6c 65 include both cle
0c50: 61 6e 75 70 20 61 6e 64 0a 3b 3b 20 70 65 72 66 anup and.;; perf
0c60: 6f 72 6d 61 6e 63 65 20 74 75 6e 69 6e 67 2c 20 ormance tuning,
0c70: 62 75 74 20 79 6f 75 20 63 61 6e 20 6f 6e 6c 79 but you can only
0c80: 20 67 6f 20 73 6f 20 66 61 72 20 77 68 69 6c 65 go so far while
0c90: 20 73 74 61 79 69 6e 67 0a 3b 3b 20 70 6f 72 74 staying.;; port
0ca0: 61 62 6c 65 2e 20 20 41 4e 44 2d 4c 45 54 2a 2c able. AND-LET*,
0cb0: 20 53 52 46 49 2d 39 20 72 65 63 6f 72 64 73 20 SRFI-9 records
0cc0: 61 6e 64 20 63 75 73 74 6f 6d 20 6d 61 63 72 6f and custom macro
0cd0: 73 20 77 6f 75 6c 64 27 76 65 20 62 65 65 6e 0a s would've been.
0ce0: 3b 3b 20 6e 69 63 65 2e 0a 0a 3b 3b 3b 3b 3b 3b ;; nice...;;;;;;
0cf0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0d00: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0d10: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0d20: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0d30: 3b 3b 0a 3b 3b 3b 3b 20 48 69 73 74 6f 72 79 0a ;;.;;;; History.
0d40: 3b 3b 20 30 2e 39 2e 31 31 3a 20 32 30 32 34 2f ;; 0.9.11: 2024/
0d50: 30 32 2f 32 33 20 2d 20 47 75 69 6c 65 20 74 65 02/23 - Guile te
0d60: 73 74 20 61 6e 64 20 70 61 63 6b 61 67 69 6e 67 st and packaging
0d70: 20 73 75 70 70 6f 72 74 20 66 72 6f 6d 20 54 6f support from To
0d80: 6d 61 73 20 56 6f 6c 66 2e 0a 3b 3b 20 30 2e 39 mas Volf..;; 0.9
0d90: 2e 31 30 3a 20 32 30 32 31 2f 30 37 2f 30 36 20 .10: 2021/07/06
0da0: 2d 20 66 69 78 65 73 20 66 6f 72 20 73 75 62 6d - fixes for subm
0db0: 61 74 63 68 65 73 20 75 6e 64 65 72 20 6b 6c 65 atches under kle
0dc0: 65 6e 65 20 73 74 61 72 2c 20 65 6d 70 74 79 20 ene star, empty
0dd0: 73 65 71 73 0a 3b 3b 20 20 20 20 20 20 20 20 20 seqs.;;
0de0: 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 20 61 in a
0df0: 6c 74 65 72 6e 61 74 69 6f 6e 73 2c 20 61 6e 64 lternations, and
0e00: 20 62 6f 6c 20 69 6e 20 66 6f 6c 64 73 20 66 6f bol in folds fo
0e10: 72 20 62 61 63 6b 74 72 61 63 6b 69 6e 67 0a 3b r backtracking.;
0e20: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
0e30: 20 20 20 20 20 20 6d 61 74 63 68 65 72 20 28 74 matcher (t
0e40: 68 61 6e 6b 73 20 4a 6f 68 6e 20 43 6c 65 6d 65 hanks John Cleme
0e50: 6e 74 73 20 61 6e 64 20 73 6e 61 6e 20 66 6f 72 nts and snan for
0e60: 20 72 65 70 6f 72 74 69 6e 67 0a 3b 3b 20 20 20 reporting.;;
0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0e80: 20 20 61 6e 64 20 50 65 74 65 72 20 42 65 78 20 and Peter Bex
0e90: 66 6f 72 20 66 69 78 69 6e 67 29 0a 3b 3b 20 30 for fixing).;; 0
0ea0: 2e 39 2e 39 3a 20 32 30 32 31 2f 30 35 2f 31 34 .9.9: 2021/05/14
0eb0: 20 2d 20 6d 6f 72 65 20 63 6f 6d 70 72 65 68 65 - more comprehe
0ec0: 6e 73 69 76 65 20 66 69 78 20 66 6f 72 20 72 65 nsive fix for re
0ed0: 70 65 61 74 65 64 20 65 6d 70 74 79 20 6d 61 74 peated empty mat
0ee0: 63 68 65 73 0a 3b 3b 20 30 2e 39 2e 38 3a 20 32 ches.;; 0.9.8: 2
0ef0: 30 32 30 2f 30 37 2f 31 33 20 2d 20 66 69 78 20 020/07/13 - fix
0f00: 69 72 72 65 67 65 78 2d 72 65 70 6c 61 63 65 2f irregex-replace/
0f10: 61 6c 6c 20 77 69 74 68 20 6c 6f 6f 6b 2d 62 65 all with look-be
0f20: 68 69 6e 64 20 70 61 74 74 65 72 6e 73 0a 3b 3b hind patterns.;;
0f30: 20 30 2e 39 2e 37 3a 20 32 30 31 39 2f 31 32 2f 0.9.7: 2019/12/
0f40: 33 31 20 2d 20 6d 6f 72 65 20 69 6e 74 75 69 74 31 - more intuit
0f50: 69 76 65 20 68 61 6e 64 6c 69 6e 67 20 6f 66 20 ive handling of
0f60: 65 6d 70 74 79 20 6d 61 74 63 68 65 73 20 69 6e empty matches in
0f70: 20 2d 66 6f 6c 64 2c 0a 3b 3b 20 20 20 20 20 20 -fold,.;;
0f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
0f90: 72 65 70 6c 61 63 65 20 61 6e 64 20 2d 73 70 6c replace and -spl
0fa0: 69 74 0a 3b 3b 20 30 2e 39 2e 36 3a 20 32 30 31 it.;; 0.9.6: 201
0fb0: 36 2f 31 32 2f 30 35 20 2d 20 66 69 78 65 64 20 6/12/05 - fixed
0fc0: 65 78 70 6f 6e 65 6e 74 69 61 6c 20 6d 65 6d 6f exponential memo
0fd0: 72 79 20 75 73 65 20 6f 66 20 2b 20 69 6e 20 63 ry use of + in c
0fe0: 6f 6d 70 69 6c 61 74 69 6f 6e 0a 3b 3b 20 20 20 ompilation.;;
0ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1000: 20 20 6f 66 20 62 61 63 6b 74 72 61 63 6b 69 6e of backtrackin
1010: 67 20 6d 61 74 63 68 65 72 20 28 43 56 45 2d 32 g matcher (CVE-2
1020: 30 31 36 2d 39 39 35 34 29 2e 0a 3b 3b 20 30 2e 016-9954)..;; 0.
1030: 39 2e 35 3a 20 32 30 31 36 2f 30 39 2f 31 30 20 9.5: 2016/09/10
1040: 2d 20 66 69 78 65 64 20 61 20 62 75 67 20 69 6e - fixed a bug in
1050: 20 69 72 72 65 67 65 78 2d 66 6f 6c 64 20 68 61 irregex-fold ha
1060: 6e 64 6c 69 6e 67 20 6f 66 20 62 6f 77 0a 3b 3b ndling of bow.;;
1070: 20 30 2e 39 2e 34 3a 20 32 30 31 35 2f 31 32 2f 0.9.4: 2015/12/
1080: 31 34 20 2d 20 70 65 72 66 6f 72 6d 61 6e 63 65 14 - performance
1090: 20 69 6d 70 72 6f 76 65 6d 65 6e 74 20 66 6f 72 improvement for
10a0: 20 7b 6e 2c 6d 7d 20 6d 61 74 63 68 65 73 0a 3b {n,m} matches.;
10b0: 3b 20 30 2e 39 2e 33 3a 20 32 30 31 34 2f 30 37 ; 0.9.3: 2014/07
10c0: 2f 30 31 20 2d 20 52 37 52 53 20 6c 69 62 72 61 /01 - R7RS libra
10d0: 72 79 0a 3b 3b 20 30 2e 39 2e 32 3a 20 32 30 31 ry.;; 0.9.2: 201
10e0: 32 2f 31 31 2f 32 39 20 2d 20 66 69 78 65 64 20 2/11/29 - fixed
10f0: 61 20 62 75 67 20 69 6e 20 2d 66 6f 6c 64 20 6f a bug in -fold o
1100: 6e 20 63 6f 6e 64 69 74 69 6f 6e 61 6c 20 62 6f n conditional bo
1110: 73 20 70 61 74 74 65 72 6e 73 0a 3b 3b 20 30 2e s patterns.;; 0.
1120: 39 2e 31 3a 20 32 30 31 32 2f 31 31 2f 32 37 20 9.1: 2012/11/27
1130: 2d 20 76 61 72 69 6f 75 73 20 61 63 63 75 6d 75 - various accumu
1140: 6c 61 74 65 64 20 62 75 67 66 69 78 65 73 0a 3b lated bugfixes.;
1150: 3b 20 30 2e 39 2e 30 3a 20 32 30 31 32 2f 30 36 ; 0.9.0: 2012/06
1160: 2f 30 33 20 2d 20 55 73 69 6e 67 20 74 61 67 73 /03 - Using tags
1170: 20 66 6f 72 20 6d 61 74 63 68 20 65 78 74 72 61 for match extra
1180: 63 74 69 6f 6e 20 66 72 6f 6d 20 50 65 74 65 72 ction from Peter
1190: 20 42 65 78 2e 0a 3b 3b 20 30 2e 38 2e 33 3a 20 Bex..;; 0.8.3:
11a0: 32 30 31 31 2f 31 32 2f 31 38 20 2d 20 76 61 72 2011/12/18 - var
11b0: 69 6f 75 73 20 61 63 63 75 6d 75 6c 61 74 65 64 ious accumulated
11c0: 20 62 75 67 66 69 78 65 73 0a 3b 3b 20 30 2e 38 bugfixes.;; 0.8
11d0: 2e 32 3a 20 32 30 31 30 2f 30 38 2f 32 38 20 2d .2: 2010/08/28 -
11e0: 20 28 2e 2e 2e 29 3f 20 73 75 62 6d 61 74 63 68 (...)? submatch
11f0: 20 65 78 74 72 61 63 74 69 6f 6e 20 66 69 78 20 extraction fix
1200: 61 6e 64 20 61 6c 74 65 72 6e 61 74 65 0a 3b 3b and alternate.;;
1210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1220: 20 20 20 20 20 6e 61 6d 65 64 20 73 75 62 6d 61 named subma
1230: 74 63 68 65 73 20 66 72 6f 6d 20 50 65 74 65 72 tches from Peter
1240: 20 42 65 78 0a 3b 3b 20 20 20 20 20 20 20 20 20 Bex.;;
1250: 20 20 20 20 20 20 20 20 20 20 20 20 41 64 64 65 Adde
1260: 64 20 69 72 72 65 67 65 78 2d 73 70 6c 69 74 2c d irregex-split,
1270: 20 69 72 72 65 67 65 78 2d 65 78 74 72 61 63 74 irregex-extract
1280: 2c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ,.;;
1290: 20 20 20 20 20 20 20 20 20 69 72 72 65 67 65 78 irregex
12a0: 2d 6d 61 74 63 68 2d 6e 61 6d 65 73 20 61 6e 64 -match-names and
12b0: 20 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 76 irregex-match-v
12c0: 61 6c 69 64 2d 69 6e 64 65 78 3f 0a 3b 3b 20 20 alid-index?.;;
12d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e0: 20 20 20 74 6f 20 43 68 69 63 6b 65 6e 20 61 6e to Chicken an
12f0: 64 20 47 75 69 6c 65 20 6d 6f 64 75 6c 65 20 65 d Guile module e
1300: 78 70 6f 72 74 20 6c 69 73 74 73 20 61 6e 64 20 xport lists and
1310: 6d 61 64 65 0a 3b 3b 20 20 20 20 20 20 20 20 20 made.;;
1320: 20 20 20 20 20 20 20 20 20 20 20 20 74 68 65 20 the
1330: 6c 61 74 74 65 72 20 61 63 63 65 70 74 20 6e 61 latter accept na
1340: 6d 65 64 20 73 75 62 6d 61 74 63 68 65 73 2e 20 med submatches.
1350: 20 54 68 65 20 70 72 6f 63 65 64 75 72 65 73 0a The procedures.
1360: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
1370: 20 20 20 20 20 20 20 69 72 72 65 67 65 78 2d 6d irregex-m
1380: 61 74 63 68 2d 7b 73 74 61 72 74 2c 65 6e 64 7d atch-{start,end}
1390: 2d 7b 69 6e 64 65 78 2c 63 68 75 6e 6b 7d 20 6e -{index,chunk} n
13a0: 6f 77 20 61 6c 73 6f 0a 3b 3b 20 20 20 20 20 20 ow also.;;
13b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 61 a
13c0: 63 63 65 70 74 20 6e 61 6d 65 64 20 73 75 62 6d ccept named subm
13d0: 61 74 63 68 65 73 2c 20 77 69 74 68 20 74 68 65 atches, with the
13e0: 20 69 6e 64 65 78 20 61 72 67 75 6d 65 6e 74 0a index argument.
13f0: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
1400: 20 20 20 20 20 20 20 6d 61 64 65 20 6f 70 74 69 made opti
1410: 6f 6e 61 6c 2e 20 20 49 6d 70 72 6f 76 65 64 20 onal. Improved
1420: 61 72 67 75 6d 65 6e 74 20 74 79 70 65 20 63 68 argument type ch
1430: 65 63 6b 73 2e 0a 3b 3b 20 20 20 20 20 20 20 20 ecks..;;
1440: 20 20 20 20 20 20 20 20 20 20 20 20 20 44 69 73 Dis
1450: 61 6c 6c 6f 77 20 6e 65 67 61 74 69 76 65 20 73 allow negative s
1460: 75 62 6d 61 74 63 68 20 69 6e 64 65 78 2e 0a 3b ubmatch index..;
1470: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
1480: 20 20 20 20 20 20 49 6d 70 72 6f 76 65 20 70 65 Improve pe
1490: 72 66 6f 72 6d 61 6e 63 65 20 6f 66 20 62 61 63 rformance of bac
14a0: 6b 74 72 61 63 6b 69 6e 67 20 6d 61 74 63 68 65 ktracking matche
14b0: 72 2e 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 r..;;
14c0: 20 20 20 20 20 20 20 20 20 20 52 65 66 61 63 74 Refact
14d0: 6f 72 20 63 68 61 72 73 65 74 20 68 61 6e 64 6c or charset handl
14e0: 69 6e 67 20 69 6e 74 6f 20 61 20 63 6f 6e 73 69 ing into a consi
14f0: 73 74 65 6e 74 20 41 50 49 0a 3b 3b 20 30 2e 38 stent API.;; 0.8
1500: 2e 31 3a 20 32 30 31 30 2f 30 33 2f 30 39 20 2d .1: 2010/03/09 -
1510: 20 62 61 63 6b 74 72 61 63 6b 69 6e 67 20 69 72 backtracking ir
1520: 72 65 67 65 78 2d 6d 61 74 63 68 20 66 69 78 20 regex-match fix
1530: 61 6e 64 20 6f 74 68 65 72 20 73 6d 61 6c 6c 20 and other small
1540: 66 69 78 65 73 0a 3b 3b 20 30 2e 38 2e 30 3a 20 fixes.;; 0.8.0:
1550: 32 30 31 30 2f 30 31 2f 32 30 20 2d 20 6f 70 74 2010/01/20 - opt
1560: 69 6d 69 7a 69 6e 67 20 44 46 41 20 63 6f 6d 70 imizing DFA comp
1570: 69 6c 61 74 69 6f 6e 2c 20 61 64 64 69 6e 67 20 ilation, adding
1580: 53 52 45 20 65 73 63 61 70 65 73 0a 3b 3b 20 20 SRE escapes.;;
1590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15a0: 20 20 20 69 6e 73 69 64 65 20 50 43 52 45 73 2c inside PCREs,
15b0: 20 61 64 64 69 6e 67 20 75 74 69 6c 69 74 79 20 adding utility
15c0: 53 52 45 73 0a 3b 3b 20 30 2e 37 2e 35 3a 20 32 SREs.;; 0.7.5: 2
15d0: 30 30 39 2f 30 38 2f 33 31 20 2d 20 61 64 64 69 009/08/31 - addi
15e0: 6e 67 20 69 72 72 65 67 65 78 2d 65 78 74 72 61 ng irregex-extra
15f0: 63 74 20 61 6e 64 20 69 72 72 65 67 65 78 2d 73 ct and irregex-s
1600: 70 6c 69 74 0a 3b 3b 20 20 20 20 20 20 20 20 20 plit.;;
1610: 20 20 20 20 20 20 20 20 20 20 20 20 2a 2d 66 6f *-fo
1620: 6c 64 20 63 6f 70 69 65 73 20 6d 61 74 63 68 20 ld copies match
1630: 64 61 74 61 20 28 75 73 65 20 2a 2d 66 6f 6c 64 data (use *-fold
1640: 2f 66 61 73 74 20 66 6f 72 20 73 70 65 65 64 29 /fast for speed)
1650: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
1660: 20 20 20 20 20 20 20 20 69 72 72 65 67 65 78 2d irregex-
1670: 6f 70 74 20 6e 6f 77 20 72 65 74 75 72 6e 73 20 opt now returns
1680: 61 6e 20 53 52 45 0a 3b 3b 20 30 2e 37 2e 34 3a an SRE.;; 0.7.4:
1690: 20 32 30 30 39 2f 30 35 2f 31 34 20 2d 20 65 6d 2009/05/14 - em
16a0: 70 74 79 20 61 6c 74 65 72 6e 61 74 65 73 20 28 pty alternates (
16b0: 6f 72 29 20 61 6e 64 20 65 6d 70 74 79 20 63 73 or) and empty cs
16c0: 65 74 73 20 61 6c 77 61 79 73 20 66 61 69 6c 2c ets always fail,
16d0: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
16e0: 20 20 20 20 20 20 20 20 62 75 67 66 69 78 20 69 bugfix i
16f0: 6e 20 64 65 66 61 75 6c 74 20 66 69 6e 61 6c 69 n default finali
1700: 7a 65 72 20 66 6f 72 20 69 72 72 65 67 65 78 2d zer for irregex-
1710: 66 6f 6c 64 2f 63 68 75 6e 6b 65 64 0a 3b 3b 20 fold/chunked.;;
1720: 30 2e 37 2e 33 3a 20 32 30 30 39 2f 30 34 2f 31 0.7.3: 2009/04/1
1730: 34 20 2d 20 61 64 64 69 6e 67 20 69 72 72 65 67 4 - adding irreg
1740: 65 78 2d 66 6f 6c 64 2f 63 68 75 6e 6b 65 64 2c ex-fold/chunked,
1750: 20 6d 69 6e 6f 72 20 64 6f 63 20 66 69 78 65 73 minor doc fixes
1760: 0a 3b 3b 20 30 2e 37 2e 32 3a 20 32 30 30 39 2f .;; 0.7.2: 2009/
1770: 30 32 2f 31 31 20 2d 20 73 6f 6d 65 20 62 75 67 02/11 - some bug
1780: 66 69 78 65 73 2c 20 6d 75 63 68 20 69 6d 70 72 fixes, much impr
1790: 6f 76 65 64 20 64 6f 63 75 6d 65 6e 74 61 74 69 oved documentati
17a0: 6f 6e 0a 3b 3b 20 30 2e 37 2e 31 3a 20 32 30 30 on.;; 0.7.1: 200
17b0: 38 2f 31 30 2f 33 30 20 2d 20 73 65 76 65 72 61 8/10/30 - severa
17c0: 6c 20 62 75 67 66 69 78 65 73 20 28 74 68 61 6e l bugfixes (than
17d0: 6b 73 20 74 6f 20 44 65 72 69 63 6b 20 45 64 64 ks to Derick Edd
17e0: 69 6e 67 74 6f 6e 29 0a 3b 3b 20 30 2e 37 2e 30 ington).;; 0.7.0
17f0: 3a 20 32 30 30 38 2f 31 30 2f 32 30 20 2d 20 73 : 2008/10/20 - s
1800: 75 70 70 6f 72 74 20 61 62 73 74 72 61 63 74 20 upport abstract
1810: 63 68 75 6e 6b 65 64 20 73 74 72 69 6e 67 73 0a chunked strings.
1820: 3b 3b 20 30 2e 36 2e 32 3a 20 32 30 30 38 2f 30 ;; 0.6.2: 2008/0
1830: 37 2f 32 36 20 2d 20 6d 69 6e 6f 72 20 62 75 67 7/26 - minor bug
1840: 66 69 78 65 73 2c 20 61 6c 6c 6f 77 20 67 6c 6f fixes, allow glo
1850: 62 61 6c 20 64 69 73 61 62 6c 69 6e 67 20 6f 66 bal disabling of
1860: 20 75 74 66 38 20 6d 6f 64 65 2c 0a 3b 3b 20 20 utf8 mode,.;;
1870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1880: 20 20 20 66 72 69 65 6e 64 6c 69 65 72 20 65 72 friendlier er
1890: 72 6f 72 20 6d 65 73 73 61 67 65 73 20 69 6e 20 ror messages in
18a0: 70 61 72 73 69 6e 67 2c 20 5c 51 2e 2e 5c 45 20 parsing, \Q..\E
18b0: 73 75 70 70 6f 72 74 0a 3b 3b 20 30 2e 36 2e 31 support.;; 0.6.1
18c0: 3a 20 32 30 30 38 2f 30 37 2f 32 31 20 2d 20 61 : 2008/07/21 - a
18d0: 64 64 65 64 20 75 74 66 38 20 6d 6f 64 65 2c 20 dded utf8 mode,
18e0: 6d 6f 72 65 20 75 74 69 6c 73 2c 20 62 75 67 66 more utils, bugf
18f0: 69 78 65 73 0a 3b 3b 20 20 20 30 2e 36 3a 20 32 ixes.;; 0.6: 2
1900: 30 30 38 2f 30 35 2f 30 31 20 2d 20 6d 6f 73 74 008/05/01 - most
1910: 20 6f 66 20 50 43 52 45 20 73 75 70 70 6f 72 74 of PCRE support
1920: 65 64 0a 3b 3b 20 20 20 30 2e 35 3a 20 32 30 30 ed.;; 0.5: 200
1930: 38 2f 30 34 2f 32 34 20 2d 20 66 75 6c 6c 79 20 8/04/24 - fully
1940: 70 6f 72 74 61 62 6c 65 20 52 34 52 53 2c 20 6d portable R4RS, m
1950: 61 6e 79 20 50 43 52 45 20 66 65 61 74 75 72 65 any PCRE feature
1960: 73 20 69 6d 70 6c 65 6d 65 6e 74 65 64 0a 3b 3b s implemented.;;
1970: 20 20 20 30 2e 34 3a 20 32 30 30 38 2f 30 34 2f 0.4: 2008/04/
1980: 31 37 20 2d 20 72 65 77 72 69 74 69 6e 67 20 4e 17 - rewriting N
1990: 46 41 20 74 6f 20 75 73 65 20 65 66 66 69 63 69 FA to use effici
19a0: 65 6e 74 20 63 6c 6f 73 75 72 65 20 63 6f 6d 70 ent closure comp
19b0: 69 6c 61 74 69 6f 6e 2c 0a 3b 3b 20 20 20 20 20 ilation,.;;
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d0: 6e 6f 72 6d 61 6c 20 73 74 72 69 6e 67 73 20 6f normal strings o
19e0: 6e 6c 79 2c 20 62 75 74 20 61 6c 6c 20 6f 66 20 nly, but all of
19f0: 74 68 65 20 73 70 65 6e 63 65 72 20 74 65 73 74 the spencer test
1a00: 73 20 70 61 73 73 0a 3b 3b 20 20 20 30 2e 33 3a s pass.;; 0.3:
1a10: 20 32 30 30 38 2f 30 33 2f 31 30 20 2d 20 61 64 2008/03/10 - ad
1a20: 64 69 6e 67 20 44 46 41 20 63 6f 6e 76 65 72 74 ding DFA convert
1a30: 65 72 20 28 6e 6f 72 6d 61 6c 20 73 74 72 69 6e er (normal strin
1a40: 67 73 20 6f 6e 6c 79 29 0a 3b 3b 20 20 20 30 2e gs only).;; 0.
1a50: 32 3a 20 32 30 30 35 2f 30 39 2f 32 37 20 2d 20 2: 2005/09/27 -
1a60: 61 64 64 69 6e 67 20 69 72 72 65 67 65 78 2d 6f adding irregex-o
1a70: 70 74 20 28 6c 69 6b 65 20 65 6c 69 73 70 27 73 pt (like elisp's
1a80: 20 72 65 67 65 78 70 2d 6f 70 74 29 20 75 74 69 regexp-opt) uti
1a90: 6c 69 74 79 0a 3b 3b 20 20 20 30 2e 31 3a 20 32 lity.;; 0.1: 2
1aa0: 30 30 35 2f 30 38 2f 31 38 20 2d 20 73 69 6d 70 005/08/18 - simp
1ab0: 6c 65 20 4e 46 41 20 69 6e 74 65 72 70 72 65 74 le NFA interpret
1ac0: 65 72 20 6f 76 65 72 20 61 62 73 74 72 61 63 74 er over abstract
1ad0: 20 63 68 75 6e 6b 65 64 20 73 74 72 69 6e 67 73 chunked strings
1ae0: 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
1af0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1b00: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1b10: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1b20: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 ;;;;;;;;;;.;;;;
1b30: 44 61 74 61 20 53 74 72 75 63 74 75 72 65 73 0a Data Structures.
1b40: 0a 28 64 65 66 69 6e 65 20 69 72 72 65 67 65 78 .(define irregex
1b50: 2d 74 61 67 20 27 2a 69 72 72 65 67 65 78 2d 74 -tag '*irregex-t
1b60: 61 67 2a 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d ag*)..(define (m
1b70: 61 6b 65 2d 69 72 72 65 67 65 78 20 64 66 61 20 ake-irregex dfa
1b80: 64 66 61 2f 73 65 61 72 63 68 20 6e 66 61 20 66 dfa/search nfa f
1b90: 6c 61 67 73 20 73 75 62 6d 61 74 63 68 65 73 20 lags submatches
1ba0: 6c 65 6e 67 74 68 73 20 6e 61 6d 65 73 29 0a 20 lengths names).
1bb0: 20 28 76 65 63 74 6f 72 20 69 72 72 65 67 65 78 (vector irregex
1bc0: 2d 74 61 67 20 64 66 61 20 64 66 61 2f 73 65 61 -tag dfa dfa/sea
1bd0: 72 63 68 20 6e 66 61 20 66 6c 61 67 73 20 73 75 rch nfa flags su
1be0: 62 6d 61 74 63 68 65 73 20 6c 65 6e 67 74 68 73 bmatches lengths
1bf0: 20 6e 61 6d 65 73 29 29 0a 0a 28 64 65 66 69 6e names))..(defin
1c00: 65 20 28 69 72 72 65 67 65 78 3f 20 6f 62 6a 29 e (irregex? obj)
1c10: 0a 20 20 28 61 6e 64 20 28 76 65 63 74 6f 72 3f . (and (vector?
1c20: 20 6f 62 6a 29 0a 20 20 20 20 20 20 20 28 3d 20 obj). (=
1c30: 38 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 8 (vector-length
1c40: 20 6f 62 6a 29 29 0a 20 20 20 20 20 20 20 28 65 obj)). (e
1c50: 71 3f 20 69 72 72 65 67 65 78 2d 74 61 67 20 28 q? irregex-tag (
1c60: 76 65 63 74 6f 72 2d 72 65 66 20 6f 62 6a 20 30 vector-ref obj 0
1c70: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 ))))..(define (i
1c80: 72 72 65 67 65 78 2d 64 66 61 20 78 29 20 28 76 rregex-dfa x) (v
1c90: 65 63 74 6f 72 2d 72 65 66 20 78 20 31 29 29 0a ector-ref x 1)).
1ca0: 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 (define (irregex
1cb0: 2d 64 66 61 2f 73 65 61 72 63 68 20 78 29 20 28 -dfa/search x) (
1cc0: 76 65 63 74 6f 72 2d 72 65 66 20 78 20 32 29 29 vector-ref x 2))
1cd0: 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 .(define (irrege
1ce0: 78 2d 6e 66 61 20 78 29 20 28 76 65 63 74 6f 72 x-nfa x) (vector
1cf0: 2d 72 65 66 20 78 20 33 29 29 0a 28 64 65 66 69 -ref x 3)).(defi
1d00: 6e 65 20 28 69 72 72 65 67 65 78 2d 66 6c 61 67 ne (irregex-flag
1d10: 73 20 78 29 20 28 76 65 63 74 6f 72 2d 72 65 66 s x) (vector-ref
1d20: 20 78 20 34 29 29 0a 28 64 65 66 69 6e 65 20 28 x 4)).(define (
1d30: 69 72 72 65 67 65 78 2d 6e 75 6d 2d 73 75 62 6d irregex-num-subm
1d40: 61 74 63 68 65 73 20 78 29 20 28 76 65 63 74 6f atches x) (vecto
1d50: 72 2d 72 65 66 20 78 20 35 29 29 0a 28 64 65 66 r-ref x 5)).(def
1d60: 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6c 65 6e ine (irregex-len
1d70: 67 74 68 73 20 78 29 20 28 76 65 63 74 6f 72 2d gths x) (vector-
1d80: 72 65 66 20 78 20 36 29 29 0a 28 64 65 66 69 6e ref x 6)).(defin
1d90: 65 20 28 69 72 72 65 67 65 78 2d 6e 61 6d 65 73 e (irregex-names
1da0: 20 78 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 x) (vector-ref
1db0: 78 20 37 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 x 7))..(define (
1dc0: 76 65 63 74 6f 72 2d 63 6f 70 79 20 76 29 0a 20 vector-copy v).
1dd0: 20 28 6c 65 74 20 28 28 72 20 28 6d 61 6b 65 2d (let ((r (make-
1de0: 76 65 63 74 6f 72 20 28 76 65 63 74 6f 72 2d 6c vector (vector-l
1df0: 65 6e 67 74 68 20 76 29 29 29 29 0a 20 20 20 20 ength v)))).
1e00: 28 64 6f 20 28 28 69 20 28 2d 20 28 76 65 63 74 (do ((i (- (vect
1e10: 6f 72 2d 6c 65 6e 67 74 68 20 76 29 20 31 29 20 or-length v) 1)
1e20: 28 2d 20 69 20 31 29 29 29 0a 20 20 20 20 20 20 (- i 1))).
1e30: 20 20 28 28 3c 20 69 20 30 29 20 72 29 0a 20 20 ((< i 0) r).
1e40: 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
1e50: 20 72 20 69 20 28 76 65 63 74 6f 72 2d 72 65 66 r i (vector-ref
1e60: 20 76 20 69 29 29 29 29 29 0a 0a 28 64 65 66 69 v i)))))..(defi
1e70: 6e 65 20 28 69 72 72 65 67 65 78 2d 6e 65 77 2d ne (irregex-new-
1e80: 6d 61 74 63 68 65 73 20 69 72 78 29 0a 20 20 28 matches irx). (
1e90: 6d 61 6b 65 2d 69 72 72 65 67 65 78 2d 6d 61 74 make-irregex-mat
1ea0: 63 68 20 28 69 72 72 65 67 65 78 2d 6e 75 6d 2d ch (irregex-num-
1eb0: 73 75 62 6d 61 74 63 68 65 73 20 69 72 78 29 20 submatches irx)
1ec0: 28 69 72 72 65 67 65 78 2d 6e 61 6d 65 73 20 69 (irregex-names i
1ed0: 72 78 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 rx)))..(define (
1ee0: 69 72 72 65 67 65 78 2d 72 65 73 65 74 2d 6d 61 irregex-reset-ma
1ef0: 74 63 68 65 73 21 20 6d 29 0a 20 20 28 64 6f 20 tches! m). (do
1f00: 28 28 69 20 28 2d 20 28 76 65 63 74 6f 72 2d 6c ((i (- (vector-l
1f10: 65 6e 67 74 68 20 6d 29 20 31 29 20 28 2d 20 69 ength m) 1) (- i
1f20: 20 31 29 29 29 0a 20 20 20 20 20 20 28 28 3c 3d 1))). ((<=
1f30: 20 69 20 33 29 20 6d 29 0a 20 20 20 20 28 76 65 i 3) m). (ve
1f40: 63 74 6f 72 2d 73 65 74 21 20 6d 20 69 20 23 66 ctor-set! m i #f
1f50: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 )))..(define (ir
1f60: 72 65 67 65 78 2d 63 6f 70 79 2d 6d 61 74 63 68 regex-copy-match
1f70: 65 73 20 6d 29 0a 20 20 28 61 6e 64 20 28 76 65 es m). (and (ve
1f80: 63 74 6f 72 3f 20 6d 29 20 28 76 65 63 74 6f 72 ctor? m) (vector
1f90: 2d 63 6f 70 79 20 6d 29 29 29 0a 0a 28 64 65 66 -copy m)))..(def
1fa0: 69 6e 65 20 69 72 72 65 67 65 78 2d 6d 61 74 63 ine irregex-matc
1fb0: 68 2d 74 61 67 20 27 2a 69 72 72 65 67 65 78 2d h-tag '*irregex-
1fc0: 6d 61 74 63 68 2d 74 61 67 2a 29 0a 0a 28 64 65 match-tag*)..(de
1fd0: 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 fine (irregex-ma
1fe0: 74 63 68 2d 64 61 74 61 3f 20 6f 62 6a 29 0a 20 tch-data? obj).
1ff0: 20 28 61 6e 64 20 28 76 65 63 74 6f 72 3f 20 6f (and (vector? o
2000: 62 6a 29 0a 20 20 20 20 20 20 20 28 3e 3d 20 28 bj). (>= (
2010: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6f 62 vector-length ob
2020: 6a 29 20 31 31 29 0a 20 20 20 20 20 20 20 28 65 j) 11). (e
2030: 71 3f 20 69 72 72 65 67 65 78 2d 6d 61 74 63 68 q? irregex-match
2040: 2d 74 61 67 20 28 76 65 63 74 6f 72 2d 72 65 66 -tag (vector-ref
2050: 20 6f 62 6a 20 30 29 29 29 29 0a 0a 28 64 65 66 obj 0))))..(def
2060: 69 6e 65 20 28 6d 61 6b 65 2d 69 72 72 65 67 65 ine (make-irrege
2070: 78 2d 6d 61 74 63 68 20 63 6f 75 6e 74 20 6e 61 x-match count na
2080: 6d 65 73 29 0a 20 20 28 6c 65 74 20 28 28 72 65 mes). (let ((re
2090: 73 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 s (make-vector (
20a0: 2b 20 28 2a 20 34 20 28 2b 20 32 20 63 6f 75 6e + (* 4 (+ 2 coun
20b0: 74 29 29 20 33 29 20 23 66 29 29 29 0a 20 20 20 t)) 3) #f))).
20c0: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 72 65 (vector-set! re
20d0: 73 20 30 20 69 72 72 65 67 65 78 2d 6d 61 74 63 s 0 irregex-matc
20e0: 68 2d 74 61 67 29 0a 20 20 20 20 28 76 65 63 74 h-tag). (vect
20f0: 6f 72 2d 73 65 74 21 20 72 65 73 20 32 20 6e 61 or-set! res 2 na
2100: 6d 65 73 29 0a 20 20 20 20 72 65 73 29 29 0a 0a mes). res))..
2110: 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 (define (irregex
2120: 2d 6d 61 74 63 68 2d 6e 75 6d 2d 73 75 62 6d 61 -match-num-subma
2130: 74 63 68 65 73 20 6d 29 0a 20 20 28 2d 20 28 71 tches m). (- (q
2140: 75 6f 74 69 65 6e 74 20 28 2d 20 28 76 65 63 74 uotient (- (vect
2150: 6f 72 2d 6c 65 6e 67 74 68 20 6d 29 20 33 29 20 or-length m) 3)
2160: 34 29 20 32 29 29 0a 0a 28 64 65 66 69 6e 65 20 4) 2))..(define
2170: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 63 (irregex-match-c
2180: 68 75 6e 6b 65 72 20 6d 29 0a 20 20 28 76 65 63 hunker m). (vec
2190: 74 6f 72 2d 72 65 66 20 6d 20 31 29 29 0a 28 64 tor-ref m 1)).(d
21a0: 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6d efine (irregex-m
21b0: 61 74 63 68 2d 6e 61 6d 65 73 20 6d 29 0a 20 20 atch-names m).
21c0: 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 20 32 29 (vector-ref m 2)
21d0: 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 ).(define (irreg
21e0: 65 78 2d 6d 61 74 63 68 2d 63 68 75 6e 6b 65 72 ex-match-chunker
21f0: 2d 73 65 74 21 20 6d 20 73 74 72 29 0a 20 20 28 -set! m str). (
2200: 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 20 31 20 vector-set! m 1
2210: 73 74 72 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 str))..(define (
2220: 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 %irregex-match-s
2230: 74 61 72 74 2d 63 68 75 6e 6b 20 6d 20 6e 29 20 tart-chunk m n)
2240: 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 20 28 2b (vector-ref m (+
2250: 20 33 20 28 2a 20 6e 20 34 29 29 29 29 0a 28 64 3 (* n 4)))).(d
2260: 65 66 69 6e 65 20 28 25 69 72 72 65 67 65 78 2d efine (%irregex-
2270: 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 match-start-inde
2280: 78 20 6d 20 6e 29 20 28 76 65 63 74 6f 72 2d 72 x m n) (vector-r
2290: 65 66 20 6d 20 28 2b 20 34 20 28 2a 20 6e 20 34 ef m (+ 4 (* n 4
22a0: 29 29 29 29 0a 28 64 65 66 69 6e 65 20 28 25 69 )))).(define (%i
22b0: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
22c0: 2d 63 68 75 6e 6b 20 6d 20 6e 29 20 20 20 28 76 -chunk m n) (v
22d0: 65 63 74 6f 72 2d 72 65 66 20 6d 20 28 2b 20 35 ector-ref m (+ 5
22e0: 20 28 2a 20 6e 20 34 29 29 29 29 0a 28 64 65 66 (* n 4)))).(def
22f0: 69 6e 65 20 28 25 69 72 72 65 67 65 78 2d 6d 61 ine (%irregex-ma
2300: 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 6d 20 tch-end-index m
2310: 6e 29 20 20 20 28 76 65 63 74 6f 72 2d 72 65 66 n) (vector-ref
2320: 20 6d 20 28 2b 20 36 20 28 2a 20 6e 20 34 29 29 m (+ 6 (* n 4))
2330: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 25 69 72 ))..(define (%ir
2340: 72 65 67 65 78 2d 6d 61 74 63 68 2d 66 61 69 6c regex-match-fail
2350: 20 6d 29 0a 20 20 28 76 65 63 74 6f 72 2d 72 65 m). (vector-re
2360: 66 20 6d 20 28 2d 20 28 76 65 63 74 6f 72 2d 6c f m (- (vector-l
2370: 65 6e 67 74 68 20 6d 29 20 31 29 29 29 0a 28 64 ength m) 1))).(d
2380: 65 66 69 6e 65 20 28 25 69 72 72 65 67 65 78 2d efine (%irregex-
2390: 6d 61 74 63 68 2d 66 61 69 6c 2d 73 65 74 21 20 match-fail-set!
23a0: 6d 20 78 29 0a 20 20 28 76 65 63 74 6f 72 2d 73 m x). (vector-s
23b0: 65 74 21 20 6d 20 28 2d 20 28 76 65 63 74 6f 72 et! m (- (vector
23c0: 2d 6c 65 6e 67 74 68 20 6d 29 20 31 29 20 78 29 -length m) 1) x)
23d0: 29 0a 0a 3b 3b 20 70 75 62 6c 69 63 20 69 6e 74 )..;; public int
23e0: 65 72 66 61 63 65 20 77 69 74 68 20 65 72 72 6f erface with erro
23f0: 72 20 63 68 65 63 6b 69 6e 67 0a 28 64 65 66 69 r checking.(defi
2400: 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 ne (irregex-matc
2410: 68 2d 73 74 61 72 74 2d 63 68 75 6e 6b 20 6d 20 h-start-chunk m
2420: 2e 20 6f 70 74 29 0a 20 20 28 6c 65 74 20 28 28 . opt). (let ((
2430: 6e 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 n (irregex-match
2440: 2d 6e 75 6d 65 72 69 63 2d 69 6e 64 65 78 20 22 -numeric-index "
2450: 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 irregex-match-st
2460: 61 72 74 2d 63 68 75 6e 6b 22 20 6d 20 6f 70 74 art-chunk" m opt
2470: 29 29 29 0a 20 20 20 20 28 61 6e 64 20 6e 20 28 ))). (and n (
2480: 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 %irregex-match-s
2490: 74 61 72 74 2d 63 68 75 6e 6b 20 6d 20 6e 29 29 tart-chunk m n))
24a0: 29 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 )).(define (irre
24b0: 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d gex-match-start-
24c0: 69 6e 64 65 78 20 6d 20 2e 20 6f 70 74 29 0a 20 index m . opt).
24d0: 20 28 6c 65 74 20 28 28 6e 20 28 69 72 72 65 67 (let ((n (irreg
24e0: 65 78 2d 6d 61 74 63 68 2d 6e 75 6d 65 72 69 63 ex-match-numeric
24f0: 2d 69 6e 64 65 78 20 22 69 72 72 65 67 65 78 2d -index "irregex-
2500: 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 match-start-inde
2510: 78 22 20 6d 20 6f 70 74 29 29 29 0a 20 20 20 20 x" m opt))).
2520: 28 61 6e 64 20 6e 20 28 25 69 72 72 65 67 65 78 (and n (%irregex
2530: 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 -match-start-ind
2540: 65 78 20 6d 20 6e 29 29 29 29 0a 28 64 65 66 69 ex m n)))).(defi
2550: 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 ne (irregex-matc
2560: 68 2d 65 6e 64 2d 63 68 75 6e 6b 20 6d 20 2e 20 h-end-chunk m .
2570: 6f 70 74 29 0a 20 20 28 6c 65 74 20 28 28 6e 20 opt). (let ((n
2580: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 6e (irregex-match-n
2590: 75 6d 65 72 69 63 2d 69 6e 64 65 78 20 22 69 72 umeric-index "ir
25a0: 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d regex-match-end-
25b0: 63 68 75 6e 6b 22 20 6d 20 6f 70 74 29 29 29 0a chunk" m opt))).
25c0: 20 20 20 20 28 61 6e 64 20 6e 20 28 25 69 72 72 (and n (%irr
25d0: 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 63 egex-match-end-c
25e0: 68 75 6e 6b 20 6d 20 6e 29 29 29 29 0a 28 64 65 hunk m n)))).(de
25f0: 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 fine (irregex-ma
2600: 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 6d 20 tch-end-index m
2610: 2e 20 6f 70 74 29 0a 20 20 28 6c 65 74 20 28 28 . opt). (let ((
2620: 6e 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 n (irregex-match
2630: 2d 6e 75 6d 65 72 69 63 2d 69 6e 64 65 78 20 22 -numeric-index "
2640: 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e irregex-match-en
2650: 64 2d 69 6e 64 65 78 22 20 6d 20 6f 70 74 29 29 d-index" m opt))
2660: 29 0a 20 20 20 20 28 61 6e 64 20 6e 20 28 25 69 ). (and n (%i
2670: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
2680: 2d 69 6e 64 65 78 20 6d 20 6e 29 29 29 29 0a 0a -index m n))))..
2690: 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 (define (irregex
26a0: 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 63 68 75 -match-start-chu
26b0: 6e 6b 2d 73 65 74 21 20 6d 20 6e 20 73 74 61 72 nk-set! m n star
26c0: 74 29 0a 20 20 28 76 65 63 74 6f 72 2d 73 65 74 t). (vector-set
26d0: 21 20 6d 20 28 2b 20 33 20 28 2a 20 6e 20 34 29 ! m (+ 3 (* n 4)
26e0: 29 20 73 74 61 72 74 29 29 0a 28 64 65 66 69 6e ) start)).(defin
26f0: 65 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 e (irregex-match
2700: 2d 73 74 61 72 74 2d 69 6e 64 65 78 2d 73 65 74 -start-index-set
2710: 21 20 6d 20 6e 20 73 74 61 72 74 29 0a 20 20 28 ! m n start). (
2720: 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 20 28 2b vector-set! m (+
2730: 20 34 20 28 2a 20 6e 20 34 29 29 20 73 74 61 72 4 (* n 4)) star
2740: 74 29 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 t)).(define (irr
2750: 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 63 egex-match-end-c
2760: 68 75 6e 6b 2d 73 65 74 21 20 6d 20 6e 20 65 6e hunk-set! m n en
2770: 64 29 0a 20 20 28 76 65 63 74 6f 72 2d 73 65 74 d). (vector-set
2780: 21 20 6d 20 28 2b 20 35 20 28 2a 20 6e 20 34 29 ! m (+ 5 (* n 4)
2790: 29 20 65 6e 64 29 29 0a 28 64 65 66 69 6e 65 20 ) end)).(define
27a0: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 (irregex-match-e
27b0: 6e 64 2d 69 6e 64 65 78 2d 73 65 74 21 20 6d 20 nd-index-set! m
27c0: 6e 20 65 6e 64 29 0a 20 20 28 76 65 63 74 6f 72 n end). (vector
27d0: 2d 73 65 74 21 20 6d 20 28 2b 20 36 20 28 2a 20 -set! m (+ 6 (*
27e0: 6e 20 34 29 29 20 65 6e 64 29 29 0a 0a 3b 3b 20 n 4)) end))..;;
27f0: 54 61 67 73 20 75 73 65 20 69 6e 64 69 63 65 73 Tags use indices
2800: 20 74 68 61 74 20 61 72 65 20 61 6c 69 67 6e 65 that are aligne
2810: 64 20 74 6f 20 73 74 61 72 74 2f 65 6e 64 20 70 d to start/end p
2820: 6f 73 69 74 69 6f 6e 73 20 6a 75 73 74 20 6c 69 ositions just li
2830: 6b 65 20 74 68 65 0a 3b 3b 20 6d 61 74 63 68 20 ke the.;; match
2840: 76 65 63 74 6f 72 73 2e 20 20 69 65 2c 20 61 20 vectors. ie, a
2850: 74 61 67 20 30 20 69 73 20 61 20 73 74 61 72 74 tag 0 is a start
2860: 20 74 61 67 2c 20 31 20 69 73 20 69 74 73 20 63 tag, 1 is its c
2870: 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 65 6e 64 orresponding end
2880: 20 74 61 67 2e 0a 3b 3b 20 54 68 65 79 20 73 74 tag..;; They st
2890: 61 72 74 20 61 74 20 30 2c 20 77 68 69 63 68 20 art at 0, which
28a0: 72 65 71 75 69 72 65 73 20 75 73 20 74 6f 20 6d requires us to m
28b0: 61 70 20 74 68 65 6d 20 74 6f 20 73 75 62 6d 61 ap them to subma
28c0: 74 63 68 20 69 6e 64 65 78 20 31 2e 0a 3b 3b 20 tch index 1..;;
28d0: 53 6f 72 72 79 20 66 6f 72 20 74 68 65 20 68 6f Sorry for the ho
28e0: 72 72 69 62 6c 65 20 6e 61 6d 65 20 3b 29 0a 28 rrible name ;).(
28f0: 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d define (irregex-
2900: 6d 61 74 63 68 2d 63 68 75 6e 6b 26 69 6e 64 65 match-chunk&inde
2910: 78 2d 66 72 6f 6d 2d 74 61 67 2d 73 65 74 21 20 x-from-tag-set!
2920: 6d 20 74 20 63 68 75 6e 6b 20 69 6e 64 65 78 29 m t chunk index)
2930: 0a 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
2940: 6d 20 28 2b 20 37 20 28 2a 20 74 20 32 29 29 20 m (+ 7 (* t 2))
2950: 63 68 75 6e 6b 29 0a 20 20 28 76 65 63 74 6f 72 chunk). (vector
2960: 2d 73 65 74 21 20 6d 20 28 2b 20 38 20 28 2a 20 -set! m (+ 8 (*
2970: 74 20 32 29 29 20 69 6e 64 65 78 29 29 0a 0a 3b t 2)) index))..;
2980: 3b 20 48 65 6c 70 65 72 20 70 72 6f 63 65 64 75 ; Helper procedu
2990: 72 65 20 74 6f 20 63 6f 6e 76 65 72 74 20 61 6e re to convert an
29a0: 79 20 74 79 70 65 20 6f 66 20 69 6e 64 65 78 20 y type of index
29b0: 66 72 6f 6d 20 61 20 72 65 73 74 20 61 72 67 73 from a rest args
29c0: 20 6c 69 73 74 0a 3b 3b 20 74 6f 20 61 20 6e 75 list.;; to a nu
29d0: 6d 65 72 69 63 20 69 6e 64 65 78 2e 20 20 4e 61 meric index. Na
29e0: 6d 65 64 20 73 75 62 6d 61 74 63 68 65 73 20 61 med submatches a
29f0: 72 65 20 63 6f 6e 76 65 72 74 65 64 20 74 6f 20 re converted to
2a00: 74 68 65 69 72 20 63 6f 72 72 65 73 70 6f 6e 64 their correspond
2a10: 69 6e 67 0a 3b 3b 20 6e 75 6d 65 72 69 63 20 69 ing.;; numeric i
2a20: 6e 64 65 78 2c 20 61 6e 64 20 6e 75 6d 65 72 69 ndex, and numeri
2a30: 63 20 73 75 62 6d 61 74 63 68 65 73 20 61 72 65 c submatches are
2a40: 20 63 68 65 63 6b 65 64 20 66 6f 72 20 76 61 6c checked for val
2a50: 69 64 69 74 79 2e 0a 3b 3b 20 41 6e 20 65 72 72 idity..;; An err
2a60: 6f 72 20 69 73 20 72 61 69 73 65 64 20 66 6f 72 or is raised for
2a70: 20 69 6e 76 61 6c 69 64 20 6e 75 6d 65 72 69 63 invalid numeric
2a80: 20 6f 72 20 6e 61 6d 65 64 20 69 6e 64 69 63 65 or named indice
2a90: 73 2c 20 23 66 20 69 73 20 72 65 74 75 72 6e 65 s, #f is returne
2aa0: 64 0a 3b 3b 20 66 6f 72 20 64 65 66 69 6e 65 64 d.;; for defined
2ab0: 20 62 75 74 20 6e 6f 6e 6d 61 74 63 68 69 6e 67 but nonmatching
2ac0: 20 69 6e 64 69 63 65 73 2e 0a 28 64 65 66 69 6e indices..(defin
2ad0: 65 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 e (irregex-match
2ae0: 2d 6e 75 6d 65 72 69 63 2d 69 6e 64 65 78 20 6c -numeric-index l
2af0: 6f 63 61 74 69 6f 6e 20 6d 20 6f 70 74 29 0a 20 ocation m opt).
2b00: 20 28 63 6f 6e 64 0a 20 20 20 28 28 6e 6f 74 20 (cond. ((not
2b10: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 64 (irregex-match-d
2b20: 61 74 61 3f 20 6d 29 29 0a 20 20 20 20 28 65 72 ata? m)). (er
2b30: 72 6f 72 20 28 73 74 72 69 6e 67 2d 61 70 70 65 ror (string-appe
2b40: 6e 64 20 6c 6f 63 61 74 69 6f 6e 20 22 3a 20 6e nd location ": n
2b50: 6f 74 20 6d 61 74 63 68 20 64 61 74 61 22 29 20 ot match data")
2b60: 6d 29 29 0a 20 20 20 28 28 6e 6f 74 20 28 70 61 m)). ((not (pa
2b70: 69 72 3f 20 6f 70 74 29 29 20 30 29 0a 20 20 20 ir? opt)) 0).
2b80: 28 28 70 61 69 72 3f 20 28 63 64 72 20 6f 70 74 ((pair? (cdr opt
2b90: 29 29 0a 20 20 20 20 28 61 70 70 6c 79 20 65 72 )). (apply er
2ba0: 72 6f 72 20 28 73 74 72 69 6e 67 2d 61 70 70 65 ror (string-appe
2bb0: 6e 64 20 6c 6f 63 61 74 69 6f 6e 20 22 3a 20 74 nd location ": t
2bc0: 6f 6f 20 6d 61 6e 79 20 61 72 67 75 6d 65 6e 74 oo many argument
2bd0: 73 22 29 20 6d 20 6f 70 74 29 29 0a 20 20 20 28 s") m opt)). (
2be0: 65 6c 73 65 0a 20 20 20 20 28 6c 65 74 20 28 28 else. (let ((
2bf0: 6e 20 28 63 61 72 20 6f 70 74 29 29 29 0a 20 20 n (car opt))).
2c00: 20 20 20 20 28 69 66 20 28 6e 75 6d 62 65 72 3f (if (number?
2c10: 20 6e 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 n). (i
2c20: 66 20 28 61 6e 64 20 28 69 6e 74 65 67 65 72 3f f (and (integer?
2c30: 20 6e 29 20 28 65 78 61 63 74 3f 20 6e 29 29 0a n) (exact? n)).
2c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
2c50: 66 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 f (irregex-match
2c60: 2d 76 61 6c 69 64 2d 6e 75 6d 65 72 69 63 2d 69 -valid-numeric-i
2c70: 6e 64 65 78 3f 20 6d 20 6e 29 0a 20 20 20 20 20 ndex? m n).
2c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
2c90: 64 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 d (irregex-match
2ca0: 2d 6d 61 74 63 68 65 64 2d 6e 75 6d 65 72 69 63 -matched-numeric
2cb0: 2d 69 6e 64 65 78 3f 20 6d 20 6e 29 20 6e 29 0a -index? m n) n).
2cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2cd0: 20 20 28 65 72 72 6f 72 20 28 73 74 72 69 6e 67 (error (string
2ce0: 2d 61 70 70 65 6e 64 20 6c 6f 63 61 74 69 6f 6e -append location
2cf0: 20 22 3a 20 6e 6f 74 20 61 20 76 61 6c 69 64 20 ": not a valid
2d00: 69 6e 64 65 78 22 29 0a 20 20 20 20 20 20 20 20 index").
2d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d20: 20 6d 20 6e 29 29 0a 20 20 20 20 20 20 20 20 20 m n)).
2d30: 20 20 20 20 20 28 65 72 72 6f 72 20 28 73 74 72 (error (str
2d40: 69 6e 67 2d 61 70 70 65 6e 64 20 6c 6f 63 61 74 ing-append locat
2d50: 69 6f 6e 20 22 3a 20 6e 6f 74 20 61 6e 20 65 78 ion ": not an ex
2d60: 61 63 74 20 69 6e 74 65 67 65 72 22 29 20 6e 29 act integer") n)
2d70: 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 ). (let
2d80: 20 6c 70 20 28 28 6c 73 20 28 69 72 72 65 67 65 lp ((ls (irrege
2d90: 78 2d 6d 61 74 63 68 2d 6e 61 6d 65 73 20 6d 29 x-match-names m)
2da0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2db0: 20 20 20 20 20 28 75 6e 6b 6e 6f 77 6e 3f 20 23 (unknown? #
2dc0: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
2dd0: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
2de0: 20 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 ((null? ls).
2df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
2e00: 64 20 75 6e 6b 6e 6f 77 6e 3f 0a 20 20 20 20 20 d unknown?.
2e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
2e20: 72 72 6f 72 20 28 73 74 72 69 6e 67 2d 61 70 70 rror (string-app
2e30: 65 6e 64 20 6c 6f 63 61 74 69 6f 6e 20 22 3a 20 end location ":
2e40: 75 6e 6b 6e 6f 77 6e 20 6d 61 74 63 68 20 6e 61 unknown match na
2e50: 6d 65 22 29 20 6e 29 29 29 0a 20 20 20 20 20 20 me") n))).
2e60: 20 20 20 20 20 20 20 28 28 65 71 3f 20 6e 20 28 ((eq? n (
2e70: 63 61 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 caar ls)).
2e80: 20 20 20 20 20 20 20 20 28 69 66 20 28 25 69 72 (if (%ir
2e90: 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 regex-match-star
2ea0: 74 2d 63 68 75 6e 6b 20 6d 20 28 63 64 61 72 20 t-chunk m (cdar
2eb0: 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls)).
2ec0: 20 20 20 20 20 20 20 28 63 64 61 72 20 6c 73 29 (cdar ls)
2ed0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2ee0: 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 (lp (cdr ls)
2ef0: 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 #f))).
2f00: 20 20 20 28 65 6c 73 65 20 28 6c 70 20 28 63 64 (else (lp (cd
2f10: 72 20 6c 73 29 20 75 6e 6b 6e 6f 77 6e 3f 29 29 r ls) unknown?))
2f20: 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
2f30: 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
2f40: 76 61 6c 69 64 2d 6e 75 6d 65 72 69 63 2d 69 6e valid-numeric-in
2f50: 64 65 78 3f 20 6d 20 6e 29 0a 20 20 28 61 6e 64 dex? m n). (and
2f60: 20 28 3e 3d 20 6e 20 30 29 20 28 3c 20 28 2b 20 (>= n 0) (< (+
2f70: 33 20 28 2a 20 6e 20 34 29 29 20 28 2d 20 28 76 3 (* n 4)) (- (v
2f80: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6d 29 20 ector-length m)
2f90: 34 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 4))))..(define (
2fa0: 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 6d 61 irregex-match-ma
2fb0: 74 63 68 65 64 2d 6e 75 6d 65 72 69 63 2d 69 6e tched-numeric-in
2fc0: 64 65 78 3f 20 6d 20 6e 29 0a 20 20 28 61 6e 64 dex? m n). (and
2fd0: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 20 28 (vector-ref m (
2fe0: 2b 20 34 20 28 2a 20 6e 20 34 29 29 29 0a 20 20 + 4 (* n 4))).
2ff0: 20 20 20 20 20 23 74 29 29 0a 0a 28 64 65 66 69 #t))..(defi
3000: 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 ne (irregex-matc
3010: 68 2d 76 61 6c 69 64 2d 6e 61 6d 65 64 2d 69 6e h-valid-named-in
3020: 64 65 78 3f 20 6d 20 6e 29 0a 20 20 28 61 6e 64 dex? m n). (and
3030: 20 28 61 73 73 71 20 6e 20 28 69 72 72 65 67 65 (assq n (irrege
3040: 78 2d 6d 61 74 63 68 2d 6e 61 6d 65 73 20 6d 29 x-match-names m)
3050: 29 0a 20 20 20 20 20 20 20 23 74 29 29 0a 0a 28 ). #t))..(
3060: 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d define (irregex-
3070: 6d 61 74 63 68 2d 76 61 6c 69 64 2d 69 6e 64 65 match-valid-inde
3080: 78 3f 20 6d 20 6e 29 0a 20 20 28 69 66 20 28 6e x? m n). (if (n
3090: 6f 74 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 ot (irregex-matc
30a0: 68 2d 64 61 74 61 3f 20 6d 29 29 0a 20 20 20 20 h-data? m)).
30b0: 20 20 28 65 72 72 6f 72 20 22 69 72 72 65 67 65 (error "irrege
30c0: 78 2d 6d 61 74 63 68 2d 76 61 6c 69 64 2d 69 6e x-match-valid-in
30d0: 64 65 78 3f 3a 20 6e 6f 74 20 6d 61 74 63 68 20 dex?: not match
30e0: 64 61 74 61 22 20 6d 29 29 0a 20 20 28 69 66 20 data" m)). (if
30f0: 28 69 6e 74 65 67 65 72 3f 20 6e 29 0a 20 20 20 (integer? n).
3100: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 65 78 61 (if (not (exa
3110: 63 74 3f 20 6e 29 29 0a 20 20 20 20 20 20 20 20 ct? n)).
3120: 20 20 28 65 72 72 6f 72 20 22 69 72 72 65 67 65 (error "irrege
3130: 78 2d 6d 61 74 63 68 2d 76 61 6c 69 64 2d 69 6e x-match-valid-in
3140: 64 65 78 3f 3a 20 6e 6f 74 20 61 6e 20 65 78 61 dex?: not an exa
3150: 63 74 20 69 6e 74 65 67 65 72 22 20 6e 29 0a 20 ct integer" n).
3160: 20 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 (irrege
3170: 78 2d 6d 61 74 63 68 2d 76 61 6c 69 64 2d 6e 75 x-match-valid-nu
3180: 6d 65 72 69 63 2d 69 6e 64 65 78 3f 20 6d 20 6e meric-index? m n
3190: 29 29 0a 20 20 20 20 20 20 28 69 72 72 65 67 65 )). (irrege
31a0: 78 2d 6d 61 74 63 68 2d 76 61 6c 69 64 2d 6e 61 x-match-valid-na
31b0: 6d 65 64 2d 69 6e 64 65 78 3f 20 6d 20 6e 29 29 med-index? m n))
31c0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 )..(define (irre
31d0: 67 65 78 2d 6d 61 74 63 68 2d 73 75 62 73 74 72 gex-match-substr
31e0: 69 6e 67 20 6d 20 2e 20 6f 70 74 29 0a 20 20 28 ing m . opt). (
31f0: 6c 65 74 2a 20 28 28 6e 20 28 69 72 72 65 67 65 let* ((n (irrege
3200: 78 2d 6d 61 74 63 68 2d 6e 75 6d 65 72 69 63 2d x-match-numeric-
3210: 69 6e 64 65 78 20 22 69 72 72 65 67 65 78 2d 6d index "irregex-m
3220: 61 74 63 68 2d 73 75 62 73 74 72 69 6e 67 22 20 atch-substring"
3230: 6d 20 6f 70 74 29 29 0a 20 20 20 20 20 20 20 20 m opt)).
3240: 20 28 63 6e 6b 20 28 69 72 72 65 67 65 78 2d 6d (cnk (irregex-m
3250: 61 74 63 68 2d 63 68 75 6e 6b 65 72 20 6d 29 29 atch-chunker m))
3260: 29 0a 20 20 20 20 28 61 6e 64 20 6e 0a 20 20 20 ). (and n.
3270: 20 20 20 20 20 20 28 28 63 68 75 6e 6b 65 72 2d ((chunker-
3280: 67 65 74 2d 73 75 62 73 74 72 69 6e 67 20 63 6e get-substring cn
3290: 6b 29 0a 20 20 20 20 20 20 20 20 20 20 28 25 69 k). (%i
32a0: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 rregex-match-sta
32b0: 72 74 2d 63 68 75 6e 6b 20 6d 20 6e 29 0a 20 20 rt-chunk m n).
32c0: 20 20 20 20 20 20 20 20 28 25 69 72 72 65 67 65 (%irrege
32d0: 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e x-match-start-in
32e0: 64 65 78 20 6d 20 6e 29 0a 20 20 20 20 20 20 20 dex m n).
32f0: 20 20 20 28 25 69 72 72 65 67 65 78 2d 6d 61 74 (%irregex-mat
3300: 63 68 2d 65 6e 64 2d 63 68 75 6e 6b 20 6d 20 6e ch-end-chunk m n
3310: 29 0a 20 20 20 20 20 20 20 20 20 20 28 25 69 72 ). (%ir
3320: 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d regex-match-end-
3330: 69 6e 64 65 78 20 6d 20 6e 29 29 29 29 29 0a 0a index m n)))))..
3340: 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 (define (irregex
3350: 2d 6d 61 74 63 68 2d 73 75 62 63 68 75 6e 6b 20 -match-subchunk
3360: 6d 20 2e 20 6f 70 74 29 0a 20 20 28 6c 65 74 2a m . opt). (let*
3370: 20 28 28 6e 20 28 69 72 72 65 67 65 78 2d 6d 61 ((n (irregex-ma
3380: 74 63 68 2d 6e 75 6d 65 72 69 63 2d 69 6e 64 65 tch-numeric-inde
3390: 78 20 22 69 72 72 65 67 65 78 2d 6d 61 74 63 68 x "irregex-match
33a0: 2d 73 75 62 63 68 75 6e 6b 22 20 6d 20 6f 70 74 -subchunk" m opt
33b0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 63 6e 6b )). (cnk
33c0: 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
33d0: 63 68 75 6e 6b 65 72 20 6d 29 29 0a 20 20 20 20 chunker m)).
33e0: 20 20 20 20 20 28 67 65 74 2d 73 75 62 63 68 75 (get-subchu
33f0: 6e 6b 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d nk (chunker-get-
3400: 73 75 62 63 68 75 6e 6b 20 63 6e 6b 29 29 29 0a subchunk cnk))).
3410: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 67 65 74 (if (not get
3420: 2d 73 75 62 63 68 75 6e 6b 29 0a 20 20 20 20 20 -subchunk).
3430: 20 20 20 28 65 72 72 6f 72 20 22 74 68 69 73 20 (error "this
3440: 63 68 75 6e 6b 20 74 79 70 65 20 64 6f 65 73 20 chunk type does
3450: 6e 6f 74 20 73 75 70 70 6f 72 74 20 6d 61 74 63 not support matc
3460: 68 20 73 75 62 63 68 75 6e 6b 73 22 29 0a 20 20 h subchunks").
3470: 20 20 20 20 20 20 28 61 6e 64 20 6e 20 28 67 65 (and n (ge
3480: 74 2d 73 75 62 63 68 75 6e 6b 0a 20 20 20 20 20 t-subchunk.
3490: 20 20 20 20 20 20 20 20 20 20 20 28 25 69 72 72 (%irr
34a0: 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 egex-match-start
34b0: 2d 63 68 75 6e 6b 20 6d 20 6e 29 0a 20 20 20 20 -chunk m n).
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 25 69 72 (%ir
34d0: 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 regex-match-star
34e0: 74 2d 69 6e 64 65 78 20 6d 20 6e 29 0a 20 20 20 t-index m n).
34f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 25 69 (%i
3500: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
3510: 2d 63 68 75 6e 6b 20 6d 20 6e 29 0a 20 20 20 20 -chunk m n).
3520: 20 20 20 20 20 20 20 20 20 20 20 20 28 25 69 72 (%ir
3530: 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d regex-match-end-
3540: 69 6e 64 65 78 20 6d 20 6e 29 29 29 29 29 29 0a index m n)))))).
3550: 0a 3b 3b 20 63 68 75 6e 6b 65 72 73 20 74 65 6c .;; chunkers tel
3560: 6c 20 75 73 20 68 6f 77 20 74 6f 20 6e 61 76 69 l us how to navi
3570: 67 61 74 65 20 74 68 72 6f 75 67 68 20 63 68 61 gate through cha
3580: 69 6e 65 64 20 63 68 75 6e 6b 73 20 6f 66 20 73 ined chunks of s
3590: 74 72 69 6e 67 73 0a 0a 28 64 65 66 69 6e 65 20 trings..(define
35a0: 28 6d 61 6b 65 2d 69 72 72 65 67 65 78 2d 63 68 (make-irregex-ch
35b0: 75 6e 6b 65 72 20 67 65 74 2d 6e 65 78 74 20 67 unker get-next g
35c0: 65 74 2d 73 74 72 20 2e 20 6f 29 0a 20 20 28 6c et-str . o). (l
35d0: 65 74 2a 20 28 28 67 65 74 2d 73 74 61 72 74 20 et* ((get-start
35e0: 28 6f 72 20 28 61 6e 64 20 28 70 61 69 72 3f 20 (or (and (pair?
35f0: 6f 29 20 28 63 61 72 20 6f 29 29 20 28 6c 61 6d o) (car o)) (lam
3600: 62 64 61 20 28 63 6e 6b 29 20 30 29 29 29 0a 20 bda (cnk) 0))).
3610: 20 20 20 20 20 20 20 20 28 6f 20 28 69 66 20 28 (o (if (
3620: 70 61 69 72 3f 20 6f 29 20 28 63 64 72 20 6f 29 pair? o) (cdr o)
3630: 20 6f 29 29 0a 20 20 20 20 20 20 20 20 20 28 67 o)). (g
3640: 65 74 2d 65 6e 64 20 28 6f 72 20 28 61 6e 64 20 et-end (or (and
3650: 28 70 61 69 72 3f 20 6f 29 20 28 63 61 72 20 6f (pair? o) (car o
3660: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
3670: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
3680: 20 28 63 6e 6b 29 20 28 73 74 72 69 6e 67 2d 6c (cnk) (string-l
3690: 65 6e 67 74 68 20 28 67 65 74 2d 73 74 72 20 63 ength (get-str c
36a0: 6e 6b 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 nk))))).
36b0: 20 28 6f 20 28 69 66 20 28 70 61 69 72 3f 20 6f (o (if (pair? o
36c0: 29 20 28 63 64 72 20 6f 29 20 6f 29 29 0a 20 20 ) (cdr o) o)).
36d0: 20 20 20 20 20 20 20 28 67 65 74 2d 73 75 62 73 (get-subs
36e0: 74 72 0a 20 20 20 20 20 20 20 20 20 20 28 6f 72 tr. (or
36f0: 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 (and (pair? o)
3700: 28 63 61 72 20 6f 29 29 0a 20 20 20 20 20 20 20 (car o)).
3710: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
3720: 63 6e 6b 31 20 73 74 61 72 74 20 63 6e 6b 32 20 cnk1 start cnk2
3730: 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 end).
3740: 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 63 6e (if (eq? cn
3750: 6b 31 20 63 6e 6b 32 29 0a 20 20 20 20 20 20 20 k1 cnk2).
3760: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 (su
3770: 62 73 74 72 69 6e 67 20 28 67 65 74 2d 73 74 72 bstring (get-str
3780: 20 63 6e 6b 31 29 20 73 74 61 72 74 20 65 6e 64 cnk1) start end
3790: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
37a0: 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 20 (let loop
37b0: 28 28 63 6e 6b 20 28 67 65 74 2d 6e 65 78 74 20 ((cnk (get-next
37c0: 63 6e 6b 31 29 29 0a 20 20 20 20 20 20 20 20 20 cnk1)).
37d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
37e0: 20 20 20 20 20 20 28 72 65 73 20 28 6c 69 73 74 (res (list
37f0: 20 28 73 75 62 73 74 72 69 6e 67 20 28 67 65 74 (substring (get
3800: 2d 73 74 72 20 63 6e 6b 31 29 0a 20 20 20 20 20 -str cnk1).
3810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3840: 73 74 61 72 74 0a 20 20 20 20 20 20 20 20 20 20 start.
3850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3870: 20 20 20 20 20 20 20 20 20 20 20 28 67 65 74 2d (get-
3880: 65 6e 64 20 63 6e 6b 31 29 29 29 29 29 0a 20 20 end cnk1))))).
3890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38a0: 20 20 20 20 28 69 66 20 28 65 71 3f 20 63 6e 6b (if (eq? cnk
38b0: 20 63 6e 6b 32 29 0a 20 20 20 20 20 20 20 20 20 cnk2).
38c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
38d0: 20 28 73 74 72 69 6e 67 2d 63 61 74 2d 72 65 76 (string-cat-rev
38e0: 65 72 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 erse.
38f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3900: 28 63 6f 6e 73 20 28 73 75 62 73 74 72 69 6e 67 (cons (substring
3910: 20 28 67 65 74 2d 73 74 72 20 63 6e 6b 29 0a 20 (get-str cnk).
3920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3940: 20 20 20 20 20 20 20 20 20 20 20 28 67 65 74 2d (get-
3950: 73 74 61 72 74 20 63 6e 6b 29 0a 20 20 20 20 20 start cnk).
3960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3980: 20 20 20 20 20 20 20 65 6e 64 29 0a 20 20 20 20 end).
3990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
39a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 res
39b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
39c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 6f (lo
39d0: 6f 70 20 28 67 65 74 2d 6e 65 78 74 20 63 6e 6b op (get-next cnk
39e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
39f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a00: 20 20 28 63 6f 6e 73 20 28 73 75 62 73 74 72 69 (cons (substri
3a10: 6e 67 20 28 67 65 74 2d 73 74 72 20 63 6e 6b 29 ng (get-str cnk)
3a20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a50: 20 20 28 67 65 74 2d 73 74 61 72 74 20 63 6e 6b (get-start cnk
3a60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3a90: 20 20 20 28 67 65 74 2d 65 6e 64 20 63 6e 6b 29 (get-end cnk)
3aa0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ac0: 20 20 20 20 20 20 20 20 72 65 73 29 29 29 29 29 res)))))
3ad0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 6f 20 ))). (o
3ae0: 28 69 66 20 28 70 61 69 72 3f 20 6f 29 20 28 63 (if (pair? o) (c
3af0: 64 72 20 6f 29 20 6f 29 29 0a 20 20 20 20 20 20 dr o) o)).
3b00: 20 20 20 28 67 65 74 2d 73 75 62 63 68 75 6e 6b (get-subchunk
3b10: 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 (and (pair? o)
3b20: 28 63 61 72 20 6f 29 29 29 29 0a 20 20 20 20 28 (car o)))). (
3b30: 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 28 70 72 if (not (and (pr
3b40: 6f 63 65 64 75 72 65 3f 20 67 65 74 2d 6e 65 78 ocedure? get-nex
3b50: 74 29 20 28 70 72 6f 63 65 64 75 72 65 3f 20 67 t) (procedure? g
3b60: 65 74 2d 73 74 72 29 0a 20 20 20 20 20 20 20 20 et-str).
3b70: 20 20 20 20 20 20 20 20 20 20 28 70 72 6f 63 65 (proce
3b80: 64 75 72 65 3f 20 67 65 74 2d 73 74 61 72 74 29 dure? get-start)
3b90: 20 28 70 72 6f 63 65 64 75 72 65 3f 20 67 65 74 (procedure? get
3ba0: 2d 73 75 62 73 74 72 29 29 29 0a 20 20 20 20 20 -substr))).
3bb0: 20 20 20 28 65 72 72 6f 72 20 22 6d 61 6b 65 2d (error "make-
3bc0: 69 72 72 65 67 65 78 2d 63 68 75 6e 6b 65 72 3a irregex-chunker:
3bd0: 20 65 78 70 65 63 74 65 64 20 61 20 70 72 6f 63 expected a proc
3be0: 64 75 72 65 22 29 29 0a 20 20 20 20 28 76 65 63 dure")). (vec
3bf0: 74 6f 72 20 67 65 74 2d 6e 65 78 74 20 67 65 74 tor get-next get
3c00: 2d 73 74 72 20 67 65 74 2d 73 74 61 72 74 20 67 -str get-start g
3c10: 65 74 2d 65 6e 64 20 67 65 74 2d 73 75 62 73 74 et-end get-subst
3c20: 72 20 67 65 74 2d 73 75 62 63 68 75 6e 6b 29 29 r get-subchunk))
3c30: 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 75 6e )..(define (chun
3c40: 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b ker-get-next cnk
3c50: 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6e ) (vector-ref cn
3c60: 6b 20 30 29 29 0a 28 64 65 66 69 6e 65 20 28 63 k 0)).(define (c
3c70: 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 20 63 hunker-get-str c
3c80: 6e 6b 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 nk) (vector-ref
3c90: 63 6e 6b 20 31 29 29 0a 28 64 65 66 69 6e 65 20 cnk 1)).(define
3ca0: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 (chunker-get-sta
3cb0: 72 74 20 63 6e 6b 29 20 28 76 65 63 74 6f 72 2d rt cnk) (vector-
3cc0: 72 65 66 20 63 6e 6b 20 32 29 29 0a 28 64 65 66 ref cnk 2)).(def
3cd0: 69 6e 65 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 ine (chunker-get
3ce0: 2d 65 6e 64 20 63 6e 6b 29 20 28 76 65 63 74 6f -end cnk) (vecto
3cf0: 72 2d 72 65 66 20 63 6e 6b 20 33 29 29 0a 28 64 r-ref cnk 3)).(d
3d00: 65 66 69 6e 65 20 28 63 68 75 6e 6b 65 72 2d 67 efine (chunker-g
3d10: 65 74 2d 73 75 62 73 74 72 69 6e 67 20 63 6e 6b et-substring cnk
3d20: 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6e ) (vector-ref cn
3d30: 6b 20 34 29 29 0a 28 64 65 66 69 6e 65 20 28 63 k 4)).(define (c
3d40: 68 75 6e 6b 65 72 2d 67 65 74 2d 73 75 62 63 68 hunker-get-subch
3d50: 75 6e 6b 20 63 6e 6b 29 20 28 76 65 63 74 6f 72 unk cnk) (vector
3d60: 2d 72 65 66 20 63 6e 6b 20 35 29 29 0a 0a 28 64 -ref cnk 5))..(d
3d70: 65 66 69 6e 65 20 28 63 68 75 6e 6b 65 72 2d 70 efine (chunker-p
3d80: 72 65 76 2d 63 68 75 6e 6b 20 63 6e 6b 20 73 74 rev-chunk cnk st
3d90: 61 72 74 20 65 6e 64 29 0a 20 20 28 69 66 20 28 art end). (if (
3da0: 65 71 3f 20 73 74 61 72 74 20 65 6e 64 29 0a 20 eq? start end).
3db0: 20 20 20 20 20 23 66 0a 20 20 20 20 20 20 28 6c #f. (l
3dc0: 65 74 20 28 28 67 65 74 2d 6e 65 78 74 20 28 63 et ((get-next (c
3dd0: 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 hunker-get-next
3de0: 63 6e 6b 29 29 29 0a 20 20 20 20 20 20 20 20 28 cnk))). (
3df0: 6c 65 74 20 6c 70 20 28 28 73 74 61 72 74 20 73 let lp ((start s
3e00: 74 61 72 74 29 29 0a 20 20 20 20 20 20 20 20 20 tart)).
3e10: 20 28 6c 65 74 20 28 28 6e 65 78 74 20 28 67 65 (let ((next (ge
3e20: 74 2d 6e 65 78 74 20 73 74 61 72 74 29 29 29 0a t-next start))).
3e30: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
3e40: 28 65 71 3f 20 6e 65 78 74 20 65 6e 64 29 0a 20 (eq? next end).
3e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
3e60: 74 61 72 74 0a 20 20 20 20 20 20 20 20 20 20 20 tart.
3e70: 20 20 20 20 20 28 61 6e 64 20 6e 65 78 74 20 28 (and next (
3e80: 6c 70 20 6e 65 78 74 29 29 29 29 29 29 29 29 0a lp next)))))))).
3e90: 0a 28 64 65 66 69 6e 65 20 28 63 68 75 6e 6b 65 .(define (chunke
3ea0: 72 2d 70 72 65 76 2d 63 68 61 72 20 63 6e 6b 20 r-prev-char cnk
3eb0: 73 74 61 72 74 20 65 6e 64 29 0a 20 20 28 6c 65 start end). (le
3ec0: 74 20 28 28 70 72 65 76 20 28 63 68 75 6e 6b 65 t ((prev (chunke
3ed0: 72 2d 70 72 65 76 2d 63 68 75 6e 6b 20 63 6e 6b r-prev-chunk cnk
3ee0: 20 73 74 61 72 74 20 65 6e 64 29 29 29 0a 20 20 start end))).
3ef0: 20 20 28 61 6e 64 20 70 72 65 76 0a 20 20 20 20 (and prev.
3f00: 20 20 20 20 20 28 73 74 72 69 6e 67 2d 72 65 66 (string-ref
3f10: 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 ((chunker-get-s
3f20: 74 72 20 63 6e 6b 29 20 70 72 65 76 29 0a 20 20 tr cnk) prev).
3f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f40: 20 20 20 28 2d 20 28 28 63 68 75 6e 6b 65 72 2d (- ((chunker-
3f50: 67 65 74 2d 65 6e 64 20 63 6e 6b 29 20 70 72 65 get-end cnk) pre
3f60: 76 29 20 31 29 29 29 29 29 0a 0a 28 64 65 66 69 v) 1)))))..(defi
3f70: 6e 65 20 28 63 68 75 6e 6b 65 72 2d 6e 65 78 74 ne (chunker-next
3f80: 2d 63 68 61 72 20 63 6e 6b 20 73 72 63 29 0a 20 -char cnk src).
3f90: 20 28 6c 65 74 20 28 28 6e 65 78 74 20 28 28 63 (let ((next ((c
3fa0: 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 hunker-get-next
3fb0: 63 6e 6b 29 20 73 72 63 29 29 29 0a 20 20 20 20 cnk) src))).
3fc0: 28 61 6e 64 20 6e 65 78 74 0a 20 20 20 20 20 20 (and next.
3fd0: 20 20 20 28 73 74 72 69 6e 67 2d 72 65 66 20 28 (string-ref (
3fe0: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 (chunker-get-str
3ff0: 20 63 6e 6b 29 20 6e 65 78 74 29 0a 20 20 20 20 cnk) next).
4000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4010: 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 ((chunker-get-s
4020: 74 61 72 74 20 63 6e 6b 29 20 6e 65 78 74 29 29 tart cnk) next))
4030: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 )))..(define (ch
4040: 75 6e 6b 2d 62 65 66 6f 72 65 3f 20 63 6e 6b 20 unk-before? cnk
4050: 61 20 62 29 0a 20 20 28 61 6e 64 20 28 6e 6f 74 a b). (and (not
4060: 20 28 65 71 3f 20 61 20 62 29 29 0a 20 20 20 20 (eq? a b)).
4070: 20 20 20 28 6c 65 74 20 28 28 6e 65 78 74 20 28 (let ((next (
4080: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 (chunker-get-nex
4090: 74 20 63 6e 6b 29 20 61 29 29 29 0a 20 20 20 20 t cnk) a))).
40a0: 20 20 20 20 20 28 61 6e 64 20 6e 65 78 74 0a 20 (and next.
40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
40c0: 20 28 65 71 3f 20 6e 65 78 74 20 62 29 0a 20 20 (eq? next b).
40d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
40e0: 23 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 #t.
40f0: 20 20 20 20 20 28 63 68 75 6e 6b 2d 62 65 66 6f (chunk-befo
4100: 72 65 3f 20 63 6e 6b 20 6e 65 78 74 20 62 29 29 re? cnk next b))
4110: 29 29 29 29 0a 0a 3b 3b 20 46 6f 72 20 6c 6f 6f ))))..;; For loo
4120: 6b 2d 62 65 68 69 6e 64 20 73 65 61 72 63 68 65 k-behind searche
4130: 73 2c 20 77 72 61 70 20 61 6e 20 65 78 69 73 74 s, wrap an exist
4140: 69 6e 67 20 63 68 75 6e 6b 65 72 20 73 75 63 68 ing chunker such
4150: 20 74 68 61 74 20 69 74 0a 3b 3b 20 72 65 74 75 that it.;; retu
4160: 72 6e 73 20 74 68 65 20 73 61 6d 65 20 72 65 73 rns the same res
4170: 75 6c 74 73 20 62 75 74 20 65 6e 64 73 20 61 74 ults but ends at
4180: 20 61 20 67 69 76 65 6e 20 70 6f 69 6e 74 2e 0a a given point..
4190: 28 64 65 66 69 6e 65 20 28 77 72 61 70 2d 65 6e (define (wrap-en
41a0: 64 2d 63 68 75 6e 6b 65 72 20 63 6e 6b 20 73 72 d-chunker cnk sr
41b0: 63 20 69 29 0a 20 20 28 6d 61 6b 65 2d 69 72 72 c i). (make-irr
41c0: 65 67 65 78 2d 63 68 75 6e 6b 65 72 0a 20 20 20 egex-chunker.
41d0: 28 6c 61 6d 62 64 61 20 28 78 29 20 28 61 6e 64 (lambda (x) (and
41e0: 20 28 6e 6f 74 20 28 65 71 3f 20 78 20 73 72 63 (not (eq? x src
41f0: 29 29 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 )) ((chunker-get
4200: 2d 6e 65 78 74 20 63 6e 6b 29 20 78 29 29 29 0a -next cnk) x))).
4210: 20 20 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d (chunker-get-
4220: 73 74 72 20 63 6e 6b 29 0a 20 20 20 28 63 68 75 str cnk). (chu
4230: 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 nker-get-start c
4240: 6e 6b 29 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 nk). (lambda (
4250: 78 29 0a 20 20 20 20 20 3b 3b 20 54 4f 44 4f 3a x). ;; TODO:
4260: 20 74 68 69 73 20 69 73 20 61 20 68 61 63 6b 20 this is a hack
4270: 77 6f 72 6b 61 72 6f 75 6e 64 20 66 6f 72 20 74 workaround for t
4280: 68 65 20 66 61 63 74 20 74 68 61 74 20 77 65 20 he fact that we
4290: 64 6f 6e 27 74 0a 20 20 20 20 20 3b 3b 20 68 61 don't. ;; ha
42a0: 76 65 20 65 69 74 68 65 72 20 61 20 6e 6f 74 69 ve either a noti
42b0: 6f 6e 20 6f 66 20 63 68 75 6e 6b 20 65 71 75 69 on of chunk equi
42c0: 76 61 6c 65 6e 63 65 20 6f 72 20 63 68 75 6e 6b valence or chunk
42d0: 20 74 72 75 6e 63 61 74 69 6f 6e 2c 0a 20 20 20 truncation,.
42e0: 20 20 3b 3b 20 75 6e 74 69 6c 20 77 68 69 63 68 ;; until which
42f0: 20 74 69 6d 65 20 28 6e 65 67 2d 29 6c 6f 6f 6b time (neg-)look
4300: 2d 62 65 68 69 6e 64 20 69 6e 20 61 20 66 6f 6c -behind in a fol
4310: 64 20 77 6f 6e 27 74 20 77 6f 72 6b 20 6f 6e 0a d won't work on.
4320: 20 20 20 20 20 3b 3b 20 6e 6f 6e 2d 62 61 73 69 ;; non-basi
4330: 63 20 63 68 75 6e 6b 73 2e 0a 20 20 20 20 20 28 c chunks.. (
4340: 69 66 20 28 6f 72 20 28 65 71 3f 20 78 20 73 72 if (or (eq? x sr
4350: 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c).
4360: 28 61 6e 64 20 28 6e 6f 74 20 28 28 63 68 75 6e (and (not ((chun
4370: 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b ker-get-next cnk
4380: 29 20 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) x)).
4390: 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 28 63 (not ((c
43a0: 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 hunker-get-next
43b0: 63 6e 6b 29 20 73 72 63 29 29 29 29 0a 20 20 20 cnk) src)))).
43c0: 20 20 20 20 20 20 69 0a 20 20 20 20 20 20 20 20 i.
43d0: 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 ((chunker-get-e
43e0: 6e 64 20 63 6e 6b 29 20 78 29 29 29 0a 20 20 20 nd cnk) x))).
43f0: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 75 62 (chunker-get-sub
4400: 73 74 72 69 6e 67 20 63 6e 6b 29 0a 20 20 20 28 string cnk). (
4410: 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 75 62 63 chunker-get-subc
4420: 68 75 6e 6b 20 63 6e 6b 29 29 29 0a 0a 3b 3b 3b hunk cnk)))..;;;
4430: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4440: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4450: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4460: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4470: 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 53 74 72 69 6e ;;;;;.;;;; Strin
4480: 67 20 55 74 69 6c 69 74 69 65 73 0a 0a 3b 3b 20 g Utilities..;;
4490: 55 6e 69 63 6f 64 65 20 76 65 72 73 69 6f 6e 20 Unicode version
44a0: 28 73 6b 69 70 20 73 75 72 72 6f 67 61 74 65 73 (skip surrogates
44b0: 29 0a 28 64 65 66 69 6e 65 20 2a 61 6c 6c 2d 63 ).(define *all-c
44c0: 68 61 72 73 2a 0a 20 20 60 28 2f 20 2c 28 69 6e hars*. `(/ ,(in
44d0: 74 65 67 65 72 2d 3e 63 68 61 72 20 30 29 20 2c teger->char 0) ,
44e0: 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 23 (integer->char #
44f0: 78 44 37 46 46 29 0a 20 20 20 20 20 20 2c 28 69 xD7FF). ,(i
4500: 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 23 78 45 nteger->char #xE
4510: 30 30 30 29 20 2c 28 69 6e 74 65 67 65 72 2d 3e 000) ,(integer->
4520: 63 68 61 72 20 23 78 31 30 46 46 46 46 29 29 29 char #x10FFFF)))
4530: 0a 0a 3b 3b 20 41 53 43 49 49 20 76 65 72 73 69 ..;; ASCII versi
4540: 6f 6e 2c 20 6f 66 66 73 65 74 20 74 6f 20 6e 6f on, offset to no
4550: 74 20 61 73 73 75 6d 65 20 30 2d 32 35 35 0a 3b t assume 0-255.;
4560: 3b 20 28 64 65 66 69 6e 65 20 2a 61 6c 6c 2d 63 ; (define *all-c
4570: 68 61 72 73 2a 20 60 28 2f 20 2c 28 69 6e 74 65 hars* `(/ ,(inte
4580: 67 65 72 2d 3e 63 68 61 72 20 28 2d 20 28 63 68 ger->char (- (ch
4590: 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 ar->integer #\sp
45a0: 61 63 65 29 20 33 32 29 29 20 2c 28 69 6e 74 65 ace) 32)) ,(inte
45b0: 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 ger->char (+ (ch
45c0: 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 ar->integer #\sp
45d0: 61 63 65 29 20 32 32 33 29 29 29 29 0a 0a 3b 3b ace) 223))))..;;
45e0: 20 73 65 74 20 74 6f 20 23 66 20 74 6f 20 69 67 set to #f to ig
45f0: 6e 6f 72 65 20 65 76 65 6e 20 61 6e 20 65 78 70 nore even an exp
4600: 6c 69 63 69 74 20 72 65 71 75 65 73 74 20 66 6f licit request fo
4610: 72 20 75 74 66 38 20 68 61 6e 64 6c 69 6e 67 0a r utf8 handling.
4620: 3b 3b 20 54 68 65 20 75 74 66 38 2d 6d 6f 64 65 ;; The utf8-mode
4630: 20 69 73 20 75 6e 64 65 73 69 72 65 64 20 6f 6e is undesired on
4640: 20 61 6e 79 20 69 6d 70 6c 65 6d 65 6e 74 61 74 any implementat
4650: 69 6f 6e 20 77 69 74 68 20 6e 61 74 69 76 65 20 ion with native
4660: 75 6e 69 63 6f 64 65 20 73 75 70 70 6f 72 74 2e unicode support.
4670: 0a 3b 3b 20 49 74 20 69 73 20 61 20 77 6f 72 6b .;; It is a work
4680: 61 72 6f 75 6e 64 20 66 6f 72 20 74 68 6f 73 65 around for those
4690: 20 74 68 61 74 20 74 72 65 61 74 20 73 74 72 69 that treat stri
46a0: 6e 67 73 20 61 73 20 61 20 72 61 77 20 62 79 74 ngs as a raw byt
46b0: 65 20 73 65 71 75 65 6e 63 65 73 2c 20 61 6e 64 e sequences, and
46c0: 0a 3b 3b 20 64 6f 65 73 20 6e 6f 74 20 77 6f 72 .;; does not wor
46d0: 6b 20 77 65 6c 6c 20 6f 74 68 65 72 77 69 73 65 k well otherwise
46e0: 2e 20 20 53 6f 20 64 69 73 61 62 6c 65 20 69 74 . So disable it
46f0: 20 6f 6e 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 on implementati
4700: 6f 6e 73 20 6b 6e 6f 77 6e 20 74 6f 0a 3b 3b 20 ons known to.;;
4710: 68 61 6e 64 6c 65 20 75 6e 69 63 6f 64 65 20 6e handle unicode n
4720: 61 74 69 76 65 6c 79 2e 0a 28 64 65 66 69 6e 65 atively..(define
4730: 20 2a 61 6c 6c 6f 77 2d 75 74 66 38 2d 6d 6f 64 *allow-utf8-mod
4740: 65 3f 2a 20 28 63 6f 6e 64 2d 65 78 70 61 6e 64 e?* (cond-expand
4750: 20 28 28 61 6e 64 20 63 68 69 63 6b 65 6e 20 28 ((and chicken (
4760: 6e 6f 74 20 66 75 6c 6c 2d 75 6e 69 63 6f 64 65 not full-unicode
4770: 29 29 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 )) #t).
4780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
47a0: 65 6c 73 65 20 23 66 29 29 29 0a 0a 3b 3b 20 28 else #f)))..;; (
47b0: 64 65 66 69 6e 65 20 2a 6e 61 6d 65 64 2d 63 68 define *named-ch
47c0: 61 72 2d 70 72 6f 70 65 72 74 69 65 73 2a 20 27 ar-properties* '
47d0: 28 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 74 ())..(define (st
47e0: 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 72 20 73 ring-scan-char s
47f0: 74 72 20 63 20 2e 20 6f 29 0a 20 20 28 6c 65 74 tr c . o). (let
4800: 20 28 28 65 6e 64 20 28 73 74 72 69 6e 67 2d 6c ((end (string-l
4810: 65 6e 67 74 68 20 73 74 72 29 29 29 0a 20 20 20 ength str))).
4820: 20 28 6c 65 74 20 73 63 61 6e 20 28 28 69 20 28 (let scan ((i (
4830: 69 66 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 if (pair? o) (ca
4840: 72 20 6f 29 20 30 29 29 29 0a 20 20 20 20 20 20 r o) 0))).
4850: 28 63 6f 6e 64 20 28 28 3d 20 69 20 65 6e 64 29 (cond ((= i end)
4860: 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 #f).
4870: 20 28 28 65 71 76 3f 20 63 20 28 73 74 72 69 6e ((eqv? c (strin
4880: 67 2d 72 65 66 20 73 74 72 20 69 29 29 20 69 29 g-ref str i)) i)
4890: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c . (el
48a0: 73 65 20 28 73 63 61 6e 20 28 2b 20 69 20 31 29 se (scan (+ i 1)
48b0: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
48c0: 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 (string-scan-cha
48d0: 72 2d 65 73 63 61 70 65 20 73 74 72 20 63 20 2e r-escape str c .
48e0: 20 6f 29 0a 20 20 28 6c 65 74 20 28 28 65 6e 64 o). (let ((end
48f0: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
4900: 73 74 72 29 29 29 0a 20 20 20 20 28 6c 65 74 20 str))). (let
4910: 73 63 61 6e 20 28 28 69 20 28 69 66 20 28 70 61 scan ((i (if (pa
4920: 69 72 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 30 ir? o) (car o) 0
4930: 29 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 ))). (cond
4940: 28 28 3d 20 69 20 65 6e 64 29 20 23 66 29 0a 20 ((= i end) #f).
4950: 20 20 20 20 20 20 20 20 20 20 20 28 28 65 71 76 ((eqv
4960: 3f 20 63 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ? c (string-ref
4970: 73 74 72 20 69 29 29 20 69 29 0a 20 20 20 20 20 str i)) i).
4980: 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 63 20 ((eqv? c
4990: 23 5c 5c 29 20 28 73 63 61 6e 20 28 2b 20 69 20 #\\) (scan (+ i
49a0: 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 2))).
49b0: 20 28 65 6c 73 65 20 28 73 63 61 6e 20 28 2b 20 (else (scan (+
49c0: 69 20 31 29 29 29 29 29 29 29 0a 0a 28 64 65 66 i 1)))))))..(def
49d0: 69 6e 65 20 28 73 74 72 69 6e 67 2d 73 63 61 6e ine (string-scan
49e0: 2d 70 72 65 64 20 73 74 72 20 70 72 65 64 20 2e -pred str pred .
49f0: 20 6f 29 0a 20 20 28 6c 65 74 20 28 28 65 6e 64 o). (let ((end
4a00: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
4a10: 73 74 72 29 29 29 0a 20 20 20 20 28 6c 65 74 20 str))). (let
4a20: 73 63 61 6e 20 28 28 69 20 28 69 66 20 28 70 61 scan ((i (if (pa
4a30: 69 72 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 30 ir? o) (car o) 0
4a40: 29 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 ))). (cond
4a50: 28 28 3d 20 69 20 65 6e 64 29 20 23 66 29 0a 20 ((= i end) #f).
4a60: 20 20 20 20 20 20 20 20 20 20 20 28 28 70 72 65 ((pre
4a70: 64 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 d (string-ref st
4a80: 72 20 69 29 29 20 69 29 0a 20 20 20 20 20 20 20 r i)) i).
4a90: 20 20 20 20 20 28 65 6c 73 65 20 28 73 63 61 6e (else (scan
4aa0: 20 28 2b 20 69 20 31 29 29 29 29 29 29 29 0a 0a (+ i 1)))))))..
4ab0: 28 64 65 66 69 6e 65 20 28 73 74 72 69 6e 67 2d (define (string-
4ac0: 73 70 6c 69 74 2d 63 68 61 72 20 73 74 72 20 63 split-char str c
4ad0: 29 0a 20 20 28 6c 65 74 20 28 28 65 6e 64 20 28 ). (let ((end (
4ae0: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 string-length st
4af0: 72 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 70 r))). (let lp
4b00: 20 28 28 69 20 30 29 20 28 66 72 6f 6d 20 30 29 ((i 0) (from 0)
4b10: 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 (res '())).
4b20: 20 20 28 64 65 66 69 6e 65 20 28 63 6f 6c 6c 65 (define (colle
4b30: 63 74 29 20 28 63 6f 6e 73 20 28 73 75 62 73 74 ct) (cons (subst
4b40: 72 69 6e 67 20 73 74 72 20 66 72 6f 6d 20 69 29 ring str from i)
4b50: 20 72 65 73 29 29 0a 20 20 20 20 20 20 28 63 6f res)). (co
4b60: 6e 64 20 28 28 3e 3d 20 69 20 65 6e 64 29 20 28 nd ((>= i end) (
4b70: 72 65 76 65 72 73 65 20 28 63 6f 6c 6c 65 63 74 reverse (collect
4b80: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
4b90: 28 28 65 71 76 3f 20 63 20 28 73 74 72 69 6e 67 ((eqv? c (string
4ba0: 2d 72 65 66 20 73 74 72 20 69 29 29 20 28 6c 70 -ref str i)) (lp
4bb0: 20 28 2b 20 69 20 31 29 20 28 2b 20 69 20 31 29 (+ i 1) (+ i 1)
4bc0: 20 28 63 6f 6c 6c 65 63 74 29 29 29 0a 20 20 20 (collect))).
4bd0: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
4be0: 6c 70 20 28 2b 20 69 20 31 29 20 66 72 6f 6d 20 lp (+ i 1) from
4bf0: 72 65 73 29 29 29 29 29 29 0a 0a 28 64 65 66 69 res))))))..(defi
4c00: 6e 65 20 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 ne (char-alphanu
4c10: 6d 65 72 69 63 3f 20 63 29 0a 20 20 28 6f 72 20 meric? c). (or
4c20: 28 63 68 61 72 2d 61 6c 70 68 61 62 65 74 69 63 (char-alphabetic
4c30: 3f 20 63 29 20 28 63 68 61 72 2d 6e 75 6d 65 72 ? c) (char-numer
4c40: 69 63 3f 20 63 29 29 29 0a 0a 28 64 65 66 69 6e ic? c)))..(defin
4c50: 65 20 28 25 73 75 62 73 74 72 69 6e 67 3d 3f 20 e (%substring=?
4c60: 61 20 62 20 73 74 61 72 74 31 20 73 74 61 72 74 a b start1 start
4c70: 32 20 6c 65 6e 29 0a 20 20 28 6c 65 74 20 6c 70 2 len). (let lp
4c80: 20 28 28 69 20 30 29 29 0a 20 20 20 20 28 63 6f ((i 0)). (co
4c90: 6e 64 20 28 28 3e 3d 20 69 20 6c 65 6e 29 0a 20 nd ((>= i len).
4ca0: 20 20 20 20 20 20 20 20 20 20 23 74 29 0a 20 20 #t).
4cb0: 20 20 20 20 20 20 20 20 28 28 63 68 61 72 3d 3f ((char=?
4cc0: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 61 20 28 (string-ref a (
4cd0: 2b 20 73 74 61 72 74 31 20 69 29 29 20 28 73 74 + start1 i)) (st
4ce0: 72 69 6e 67 2d 72 65 66 20 62 20 28 2b 20 73 74 ring-ref b (+ st
4cf0: 61 72 74 32 20 69 29 29 29 0a 20 20 20 20 20 20 art2 i))).
4d00: 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 31 29 (lp (+ i 1)
4d10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c )). (el
4d20: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 23 66 se. #f
4d30: 29 29 29 29 0a 0a 3b 3b 20 53 52 46 49 2d 31 33 ))))..;; SRFI-13
4d40: 20 65 78 74 72 61 63 74 73 0a 0a 28 64 65 66 69 extracts..(defi
4d50: 6e 65 20 28 25 25 73 74 72 69 6e 67 2d 63 6f 70 ne (%%string-cop
4d60: 79 21 20 74 6f 20 74 73 74 61 72 74 20 66 72 6f y! to tstart fro
4d70: 6d 20 66 73 74 61 72 74 20 66 65 6e 64 29 0a 20 m fstart fend).
4d80: 20 28 64 6f 20 28 28 69 20 66 73 74 61 72 74 20 (do ((i fstart
4d90: 28 2b 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 (+ i 1)).
4da0: 28 6a 20 74 73 74 61 72 74 20 28 2b 20 6a 20 31 (j tstart (+ j 1
4db0: 29 29 29 0a 20 20 20 20 20 20 28 28 3e 3d 20 69 ))). ((>= i
4dc0: 20 66 65 6e 64 29 29 0a 20 20 20 20 28 73 74 72 fend)). (str
4dd0: 69 6e 67 2d 73 65 74 21 20 74 6f 20 6a 20 28 73 ing-set! to j (s
4de0: 74 72 69 6e 67 2d 72 65 66 20 66 72 6f 6d 20 69 tring-ref from i
4df0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 ))))..(define (s
4e00: 74 72 69 6e 67 2d 63 61 74 2d 72 65 76 65 72 73 tring-cat-revers
4e10: 65 20 73 74 72 69 6e 67 2d 6c 69 73 74 29 0a 20 e string-list).
4e20: 20 28 73 74 72 69 6e 67 2d 63 61 74 2d 72 65 76 (string-cat-rev
4e30: 65 72 73 65 2f 61 75 78 0a 20 20 20 28 66 6f 6c erse/aux. (fol
4e40: 64 20 28 6c 61 6d 62 64 61 20 28 73 20 61 29 20 d (lambda (s a)
4e50: 28 2b 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 (+ (string-lengt
4e60: 68 20 73 29 20 61 29 29 20 30 20 73 74 72 69 6e h s) a)) 0 strin
4e70: 67 2d 6c 69 73 74 29 0a 20 20 20 73 74 72 69 6e g-list). strin
4e80: 67 2d 6c 69 73 74 29 29 0a 0a 28 64 65 66 69 6e g-list))..(defin
4e90: 65 20 28 73 74 72 69 6e 67 2d 63 61 74 2d 72 65 e (string-cat-re
4ea0: 76 65 72 73 65 2f 61 75 78 20 6c 65 6e 20 73 74 verse/aux len st
4eb0: 72 69 6e 67 2d 6c 69 73 74 29 0a 20 20 28 6c 65 ring-list). (le
4ec0: 74 20 28 28 72 65 73 20 28 6d 61 6b 65 2d 73 74 t ((res (make-st
4ed0: 72 69 6e 67 20 6c 65 6e 29 29 29 0a 20 20 20 20 ring len))).
4ee0: 28 6c 65 74 20 6c 70 20 28 28 69 20 6c 65 6e 29 (let lp ((i len)
4ef0: 20 28 6c 73 20 73 74 72 69 6e 67 2d 6c 69 73 74 (ls string-list
4f00: 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 70 61 )). (if (pa
4f10: 69 72 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 ir? ls).
4f20: 20 20 28 6c 65 74 2a 20 28 28 73 20 28 63 61 72 (let* ((s (car
4f30: 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls)).
4f40: 20 20 20 20 20 20 20 28 73 6c 65 6e 20 28 73 74 (slen (st
4f50: 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 29 29 0a ring-length s)).
4f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f70: 20 28 69 20 28 2d 20 69 20 73 6c 65 6e 29 29 29 (i (- i slen)))
4f80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 25 25 . (%%
4f90: 73 74 72 69 6e 67 2d 63 6f 70 79 21 20 72 65 73 string-copy! res
4fa0: 20 69 20 73 20 30 20 73 6c 65 6e 29 0a 20 20 20 i s 0 slen).
4fb0: 20 20 20 20 20 20 20 20 20 28 6c 70 20 69 20 28 (lp i (
4fc0: 63 64 72 20 6c 73 29 29 29 29 29 0a 20 20 20 20 cdr ls))))).
4fd0: 72 65 73 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b res))..;;;;;;;;;
4fe0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
4ff0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5000: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5010: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a ;;;;;;;;;;;;;;;.
5020: 3b 3b 3b 3b 20 4c 69 73 74 20 55 74 69 6c 69 74 ;;;; List Utilit
5030: 69 65 73 0a 0a 3b 3b 20 6c 69 6b 65 20 74 68 65 ies..;; like the
5040: 20 6f 6e 65 2d 61 72 67 20 49 4f 54 41 20 63 61 one-arg IOTA ca
5050: 73 65 0a 28 64 65 66 69 6e 65 20 28 7a 65 72 6f se.(define (zero
5060: 2d 74 6f 20 6e 29 0a 20 20 28 69 66 20 28 3c 3d -to n). (if (<=
5070: 20 6e 20 30 29 0a 20 20 20 20 20 20 27 28 29 0a n 0). '().
5080: 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 (let lp ((
5090: 69 20 28 2d 20 6e 20 31 29 29 20 28 72 65 73 20 i (- n 1)) (res
50a0: 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 '())). (i
50b0: 66 20 28 7a 65 72 6f 3f 20 69 29 20 28 63 6f 6e f (zero? i) (con
50c0: 73 20 30 20 72 65 73 29 20 28 6c 70 20 28 2d 20 s 0 res) (lp (-
50d0: 69 20 31 29 20 28 63 6f 6e 73 20 69 20 72 65 73 i 1) (cons i res
50e0: 29 29 29 29 29 29 0a 0a 3b 3b 20 53 52 46 49 2d ))))))..;; SRFI-
50f0: 31 20 65 78 74 72 61 63 74 73 20 28 73 69 6d 70 1 extracts (simp
5100: 6c 69 66 69 65 64 20 31 2d 61 72 79 20 76 65 72 lified 1-ary ver
5110: 73 69 6f 6e 73 29 0a 0a 28 64 65 66 69 6e 65 20 sions)..(define
5120: 28 66 69 6e 64 20 70 72 65 64 20 6c 73 29 0a 20 (find pred ls).
5130: 20 28 63 6f 6e 64 20 28 28 66 69 6e 64 2d 74 61 (cond ((find-ta
5140: 69 6c 20 70 72 65 64 20 6c 73 29 20 3d 3e 20 63 il pred ls) => c
5150: 61 72 29 0a 20 20 20 20 20 20 20 20 28 65 6c 73 ar). (els
5160: 65 20 23 66 29 29 29 0a 0a 28 64 65 66 69 6e 65 e #f)))..(define
5170: 20 28 66 69 6e 64 2d 74 61 69 6c 20 70 72 65 64 (find-tail pred
5180: 20 6c 73 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 ls). (let lp (
5190: 28 6c 73 20 6c 73 29 29 0a 20 20 20 20 28 63 6f (ls ls)). (co
51a0: 6e 64 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 20 23 nd ((null? ls) #
51b0: 66 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 70 f). ((p
51c0: 72 65 64 20 28 63 61 72 20 6c 73 29 29 20 6c 73 red (car ls)) ls
51d0: 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 ). (els
51e0: 65 20 28 6c 70 20 28 63 64 72 20 6c 73 29 29 29 e (lp (cdr ls)))
51f0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 )))..(define (la
5200: 73 74 20 6c 73 29 0a 20 20 28 69 66 20 28 6e 6f st ls). (if (no
5210: 74 20 28 70 61 69 72 3f 20 6c 73 29 29 0a 20 20 t (pair? ls)).
5220: 20 20 20 20 28 65 72 72 6f 72 20 22 63 61 6e 27 (error "can'
5230: 74 20 74 61 6b 65 20 6c 61 73 74 20 6f 66 20 65 t take last of e
5240: 6d 70 74 79 20 6c 69 73 74 22 20 6c 73 29 0a 20 mpty list" ls).
5250: 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 6c (let lp ((l
5260: 73 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 28 s ls)). (
5270: 69 66 20 28 70 61 69 72 3f 20 28 63 64 72 20 6c if (pair? (cdr l
5280: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
5290: 28 6c 70 20 28 63 64 72 20 6c 73 29 29 0a 20 20 (lp (cdr ls)).
52a0: 20 20 20 20 20 20 20 20 20 20 28 63 61 72 20 6c (car l
52b0: 73 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 s)))))..(define
52c0: 28 61 6e 79 20 70 72 65 64 20 6c 73 29 0a 20 20 (any pred ls).
52d0: 28 61 6e 64 20 28 70 61 69 72 3f 20 6c 73 29 0a (and (pair? ls).
52e0: 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 (let lp (
52f0: 28 68 65 61 64 20 28 63 61 72 20 6c 73 29 29 20 (head (car ls))
5300: 28 74 61 69 6c 20 28 63 64 72 20 6c 73 29 29 29 (tail (cdr ls)))
5310: 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e . (if (n
5320: 75 6c 6c 3f 20 74 61 69 6c 29 0a 20 20 20 20 20 ull? tail).
5330: 20 20 20 20 20 20 20 20 28 70 72 65 64 20 68 65 (pred he
5340: 61 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ad).
5350: 20 28 6f 72 20 28 70 72 65 64 20 68 65 61 64 29 (or (pred head)
5360: 20 28 6c 70 20 28 63 61 72 20 74 61 69 6c 29 20 (lp (car tail)
5370: 28 63 64 72 20 74 61 69 6c 29 29 29 29 29 29 29 (cdr tail)))))))
5380: 0a 0a 28 64 65 66 69 6e 65 20 28 65 76 65 72 79 ..(define (every
5390: 20 70 72 65 64 20 6c 73 29 0a 20 20 28 6f 72 20 pred ls). (or
53a0: 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 (null? ls).
53b0: 20 28 6c 65 74 20 6c 70 20 28 28 68 65 61 64 20 (let lp ((head
53c0: 28 63 61 72 20 6c 73 29 29 20 20 28 74 61 69 6c (car ls)) (tail
53d0: 20 28 63 64 72 20 6c 73 29 29 29 0a 20 20 20 20 (cdr ls))).
53e0: 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
53f0: 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
5400: 20 28 70 72 65 64 20 68 65 61 64 29 0a 20 20 20 (pred head).
5410: 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 70 (and (p
5420: 72 65 64 20 68 65 61 64 29 20 28 6c 70 20 28 63 red head) (lp (c
5430: 61 72 20 74 61 69 6c 29 20 28 63 64 72 20 74 61 ar tail) (cdr ta
5440: 69 6c 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 il)))))))..(defi
5450: 6e 65 20 28 66 6f 6c 64 20 6b 6f 6e 73 20 6b 6e ne (fold kons kn
5460: 69 6c 20 6c 73 29 0a 20 20 28 6c 65 74 20 6c 70 il ls). (let lp
5470: 20 28 28 6c 73 20 6c 73 29 20 28 72 65 73 20 6b ((ls ls) (res k
5480: 6e 69 6c 29 29 0a 20 20 20 20 28 69 66 20 28 6e nil)). (if (n
5490: 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 ull? ls).
54a0: 20 72 65 73 0a 20 20 20 20 20 20 20 20 28 6c 70 res. (lp
54b0: 20 28 63 64 72 20 6c 73 29 20 28 6b 6f 6e 73 20 (cdr ls) (kons
54c0: 28 63 61 72 20 6c 73 29 20 72 65 73 29 29 29 29 (car ls) res))))
54d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 66 69 6c 74 )..(define (filt
54e0: 65 72 20 70 72 65 64 20 6c 73 29 0a 20 20 28 6c er pred ls). (l
54f0: 65 74 20 6c 70 20 28 28 6c 73 20 6c 73 29 20 28 et lp ((ls ls) (
5500: 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 69 res '())). (i
5510: 66 20 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 f (null? ls).
5520: 20 20 20 20 20 28 72 65 76 65 72 73 65 20 72 65 (reverse re
5530: 73 29 0a 20 20 20 20 20 20 20 20 28 6c 70 20 28 s). (lp (
5540: 63 64 72 20 6c 73 29 20 28 69 66 20 28 70 72 65 cdr ls) (if (pre
5550: 64 20 28 63 61 72 20 6c 73 29 29 20 28 63 6f 6e d (car ls)) (con
5560: 73 20 28 63 61 72 20 6c 73 29 20 72 65 73 29 20 s (car ls) res)
5570: 72 65 73 29 29 29 29 29 0a 0a 28 64 65 66 69 6e res)))))..(defin
5580: 65 20 28 72 65 6d 6f 76 65 20 70 72 65 64 20 6c e (remove pred l
5590: 73 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 6c s). (let lp ((l
55a0: 73 20 6c 73 29 20 28 72 65 73 20 27 28 29 29 29 s ls) (res '()))
55b0: 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 . (if (null?
55c0: 6c 73 29 0a 20 20 20 20 20 20 20 20 28 72 65 76 ls). (rev
55d0: 65 72 73 65 20 72 65 73 29 0a 20 20 20 20 20 20 erse res).
55e0: 20 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 28 (lp (cdr ls) (
55f0: 69 66 20 28 70 72 65 64 20 28 63 61 72 20 6c 73 if (pred (car ls
5600: 29 29 20 72 65 73 20 28 63 6f 6e 73 20 28 63 61 )) res (cons (ca
5610: 72 20 6c 73 29 20 72 65 73 29 29 29 29 29 29 0a r ls) res)))))).
5620: 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;;;;;;;;;;;;;;;
5630: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5640: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5650: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5660: 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 46 ;;;;;;;;;.;;;; F
5670: 6c 61 67 73 0a 0a 28 64 65 66 69 6e 65 20 28 62 lags..(define (b
5680: 69 74 2d 73 68 72 20 6e 20 69 29 0a 20 20 28 71 it-shr n i). (q
5690: 75 6f 74 69 65 6e 74 20 6e 20 28 65 78 70 74 20 uotient n (expt
56a0: 32 20 69 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 2 i)))..(define
56b0: 28 62 69 74 2d 73 68 6c 20 6e 20 69 29 0a 20 20 (bit-shl n i).
56c0: 28 2a 20 6e 20 28 65 78 70 74 20 32 20 69 29 29 (* n (expt 2 i))
56d0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 62 69 74 2d )..(define (bit-
56e0: 6e 6f 74 20 6e 29 20 28 2d 20 23 78 46 46 46 46 not n) (- #xFFFF
56f0: 20 6e 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 62 n))..(define (b
5700: 69 74 2d 69 6f 72 20 61 20 62 29 0a 20 20 28 63 it-ior a b). (c
5710: 6f 6e 64 0a 20 20 20 28 28 7a 65 72 6f 3f 20 61 ond. ((zero? a
5720: 29 20 62 29 0a 20 20 20 28 28 7a 65 72 6f 3f 20 ) b). ((zero?
5730: 62 29 20 61 29 0a 20 20 20 28 65 6c 73 65 0a 20 b) a). (else.
5740: 20 20 20 28 2b 20 28 69 66 20 28 6f 72 20 28 6f (+ (if (or (o
5750: 64 64 3f 20 61 29 20 28 6f 64 64 3f 20 62 29 29 dd? a) (odd? b))
5760: 20 31 20 30 29 0a 20 20 20 20 20 20 20 28 2a 20 1 0). (*
5770: 32 20 28 62 69 74 2d 69 6f 72 20 28 71 75 6f 74 2 (bit-ior (quot
5780: 69 65 6e 74 20 61 20 32 29 20 28 71 75 6f 74 69 ient a 2) (quoti
5790: 65 6e 74 20 62 20 32 29 29 29 29 29 29 29 0a 0a ent b 2)))))))..
57a0: 28 64 65 66 69 6e 65 20 28 62 69 74 2d 61 6e 64 (define (bit-and
57b0: 20 61 20 62 29 0a 20 20 28 63 6f 6e 64 0a 20 20 a b). (cond.
57c0: 20 28 28 7a 65 72 6f 3f 20 61 29 20 30 29 0a 20 ((zero? a) 0).
57d0: 20 20 28 28 7a 65 72 6f 3f 20 62 29 20 30 29 0a ((zero? b) 0).
57e0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 28 2b 20 (else. (+
57f0: 28 69 66 20 28 61 6e 64 20 28 6f 64 64 3f 20 61 (if (and (odd? a
5800: 29 20 28 6f 64 64 3f 20 62 29 29 20 31 20 30 29 ) (odd? b)) 1 0)
5810: 0a 20 20 20 20 20 20 20 28 2a 20 32 20 28 62 69 . (* 2 (bi
5820: 74 2d 61 6e 64 20 28 71 75 6f 74 69 65 6e 74 20 t-and (quotient
5830: 61 20 32 29 20 28 71 75 6f 74 69 65 6e 74 20 62 a 2) (quotient b
5840: 20 32 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 2)))))))..(defi
5850: 6e 65 20 28 69 6e 74 65 67 65 72 2d 6c 6f 67 20 ne (integer-log
5860: 6e 29 0a 20 20 28 64 65 66 69 6e 65 20 28 62 38 n). (define (b8
5870: 20 6e 20 72 29 0a 20 20 20 20 28 69 66 20 28 3e n r). (if (>
5880: 3d 20 6e 20 28 62 69 74 2d 73 68 6c 20 31 20 38 = n (bit-shl 1 8
5890: 29 29 20 28 62 34 20 28 62 69 74 2d 73 68 72 20 )) (b4 (bit-shr
58a0: 6e 20 38 29 20 28 2b 20 72 20 38 29 29 20 28 62 n 8) (+ r 8)) (b
58b0: 34 20 6e 20 72 29 29 29 0a 20 20 28 64 65 66 69 4 n r))). (defi
58c0: 6e 65 20 28 62 34 20 6e 20 72 29 0a 20 20 20 20 ne (b4 n r).
58d0: 28 69 66 20 28 3e 3d 20 6e 20 28 62 69 74 2d 73 (if (>= n (bit-s
58e0: 68 6c 20 31 20 34 29 29 20 28 62 32 20 28 62 69 hl 1 4)) (b2 (bi
58f0: 74 2d 73 68 72 20 6e 20 34 29 20 28 2b 20 72 20 t-shr n 4) (+ r
5900: 34 29 29 20 28 62 32 20 6e 20 72 29 29 29 0a 20 4)) (b2 n r))).
5910: 20 28 64 65 66 69 6e 65 20 28 62 32 20 6e 20 72 (define (b2 n r
5920: 29 0a 20 20 20 20 28 69 66 20 28 3e 3d 20 6e 20 ). (if (>= n
5930: 28 62 69 74 2d 73 68 6c 20 31 20 32 29 29 20 28 (bit-shl 1 2)) (
5940: 62 31 20 28 62 69 74 2d 73 68 72 20 6e 20 32 29 b1 (bit-shr n 2)
5950: 20 28 2b 20 72 20 32 29 29 20 28 62 31 20 6e 20 (+ r 2)) (b1 n
5960: 72 29 29 29 0a 20 20 28 64 65 66 69 6e 65 20 28 r))). (define (
5970: 62 31 20 6e 20 72 29 20 28 69 66 20 28 3e 3d 20 b1 n r) (if (>=
5980: 6e 20 28 62 69 74 2d 73 68 6c 20 31 20 31 29 29 n (bit-shl 1 1))
5990: 20 28 2b 20 72 20 31 29 20 72 29 29 0a 20 20 28 (+ r 1) r)). (
59a0: 69 66 20 28 3e 3d 20 6e 20 28 62 69 74 2d 73 68 if (>= n (bit-sh
59b0: 6c 20 31 20 31 36 29 29 20 28 62 38 20 28 62 69 l 1 16)) (b8 (bi
59c0: 74 2d 73 68 72 20 6e 20 31 36 29 20 31 36 29 20 t-shr n 16) 16)
59d0: 28 62 38 20 6e 20 30 29 29 29 0a 0a 28 64 65 66 (b8 n 0)))..(def
59e0: 69 6e 65 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 ine (flag-set? f
59f0: 6c 61 67 73 20 69 29 0a 20 20 28 3d 20 69 20 28 lags i). (= i (
5a00: 62 69 74 2d 61 6e 64 20 66 6c 61 67 73 20 69 29 bit-and flags i)
5a10: 29 29 0a 28 64 65 66 69 6e 65 20 28 66 6c 61 67 )).(define (flag
5a20: 2d 6a 6f 69 6e 20 61 20 62 29 0a 20 20 28 69 66 -join a b). (if
5a30: 20 62 20 28 62 69 74 2d 69 6f 72 20 61 20 62 29 b (bit-ior a b)
5a40: 20 61 29 29 0a 28 64 65 66 69 6e 65 20 28 66 6c a)).(define (fl
5a50: 61 67 2d 63 6c 65 61 72 20 61 20 62 29 0a 20 20 ag-clear a b).
5a60: 28 62 69 74 2d 61 6e 64 20 61 20 28 62 69 74 2d (bit-and a (bit-
5a70: 6e 6f 74 20 62 29 29 29 0a 0a 28 64 65 66 69 6e not b)))..(defin
5a80: 65 20 7e 6e 6f 6e 65 20 30 29 0a 28 64 65 66 69 e ~none 0).(defi
5a90: 6e 65 20 7e 73 65 61 72 63 68 65 72 3f 20 31 29 ne ~searcher? 1)
5aa0: 0a 28 64 65 66 69 6e 65 20 7e 63 6f 6e 73 75 6d .(define ~consum
5ab0: 65 72 3f 20 32 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b er? 2)..;;;;;;;;
5ac0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5ad0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5ae0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5af0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
5b00: 0a 3b 3b 3b 3b 20 50 61 72 73 69 6e 67 20 45 6d .;;;; Parsing Em
5b10: 62 65 64 64 65 64 20 53 52 45 73 20 69 6e 20 50 bedded SREs in P
5b20: 43 52 45 20 53 74 72 69 6e 67 73 0a 0a 3b 3b 20 CRE Strings..;;
5b30: 28 64 65 66 69 6e 65 20 28 77 69 74 68 2d 72 65 (define (with-re
5b40: 61 64 2d 66 72 6f 6d 2d 73 74 72 69 6e 67 20 73 ad-from-string s
5b50: 74 72 20 69 20 70 72 6f 63 29 0a 3b 3b 20 20 20 tr i proc).;;
5b60: 28 64 65 66 69 6e 65 20 28 70 6f 72 74 2d 73 69 (define (port-si
5b70: 7a 65 20 69 6e 29 0a 3b 3b 20 20 20 20 20 28 6c ze in).;; (l
5b80: 65 74 20 6c 70 20 28 28 69 20 30 29 29 20 28 69 et lp ((i 0)) (i
5b90: 66 20 28 65 6f 66 2d 6f 62 6a 65 63 74 3f 20 28 f (eof-object? (
5ba0: 72 65 61 64 2d 63 68 61 72 20 69 6e 29 29 20 69 read-char in)) i
5bb0: 20 28 6c 70 20 28 2b 20 69 20 31 29 29 29 29 29 (lp (+ i 1)))))
5bc0: 0a 3b 3b 20 20 20 28 6c 65 74 2a 20 28 28 6c 65 .;; (let* ((le
5bd0: 6e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 n (string-length
5be0: 20 73 74 72 29 29 0a 3b 3b 20 20 20 20 20 20 20 str)).;;
5bf0: 20 20 20 28 74 61 69 6c 2d 6c 65 6e 20 28 2d 20 (tail-len (-
5c00: 6c 65 6e 20 69 29 29 0a 3b 3b 20 20 20 20 20 20 len i)).;;
5c10: 20 20 20 20 28 69 6e 20 28 6f 70 65 6e 2d 69 6e (in (open-in
5c20: 70 75 74 2d 73 74 72 69 6e 67 20 28 73 75 62 73 put-string (subs
5c30: 74 72 69 6e 67 20 73 74 72 20 69 20 6c 65 6e 29 tring str i len)
5c40: 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 28 )).;; (
5c50: 73 72 65 20 28 72 65 61 64 20 69 6e 29 29 0a 3b sre (read in)).;
5c60: 3b 20 20 20 20 20 20 20 20 20 20 28 75 6e 75 73 ; (unus
5c70: 65 64 2d 6c 65 6e 20 28 70 6f 72 74 2d 73 69 7a ed-len (port-siz
5c80: 65 20 69 6e 29 29 29 0a 3b 3b 20 20 20 20 20 28 e in))).;; (
5c90: 63 6c 6f 73 65 2d 69 6e 70 75 74 2d 70 6f 72 74 close-input-port
5ca0: 20 69 6e 29 0a 3b 3b 20 20 20 20 20 28 70 72 6f in).;; (pro
5cb0: 63 20 73 72 65 20 28 2d 20 74 61 69 6c 2d 6c 65 c sre (- tail-le
5cc0: 6e 20 75 6e 75 73 65 64 2d 6c 65 6e 29 29 29 29 n unused-len))))
5cd0: 0a 0a 28 64 65 66 69 6e 65 20 63 6c 6f 73 65 2d ..(define close-
5ce0: 74 6f 6b 65 6e 20 28 6c 69 73 74 20 27 63 6c 6f token (list 'clo
5cf0: 73 65 29 29 0a 28 64 65 66 69 6e 65 20 64 6f 74 se)).(define dot
5d00: 2d 74 6f 6b 65 6e 20 28 73 74 72 69 6e 67 2d 3e -token (string->
5d10: 73 79 6d 62 6f 6c 20 22 2e 22 29 29 0a 0a 28 64 symbol "."))..(d
5d20: 65 66 69 6e 65 20 28 77 69 74 68 2d 72 65 61 64 efine (with-read
5d30: 2d 66 72 6f 6d 2d 73 74 72 69 6e 67 20 73 74 72 -from-string str
5d40: 20 69 20 70 72 6f 63 29 0a 20 20 28 64 65 66 69 i proc). (defi
5d50: 6e 65 20 65 6e 64 20 28 73 74 72 69 6e 67 2d 6c ne end (string-l
5d60: 65 6e 67 74 68 20 73 74 72 29 29 0a 20 20 28 64 ength str)). (d
5d70: 65 66 69 6e 65 20 28 72 65 61 64 20 69 20 6b 29 efine (read i k)
5d80: 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 . (cond.
5d90: 28 28 3e 3d 20 69 20 65 6e 64 29 20 28 65 72 72 ((>= i end) (err
5da0: 6f 72 20 22 75 6e 74 65 72 6d 69 6e 61 74 65 64 or "unterminated
5db0: 20 65 6d 62 65 64 64 65 64 20 53 52 45 22 20 73 embedded SRE" s
5dc0: 74 72 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a tr)). (else.
5dd0: 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 (case (str
5de0: 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 0a 20 ing-ref str i).
5df0: 20 20 20 20 20 20 20 28 28 23 5c 28 29 0a 20 20 ((#\().
5e00: 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 (let lp (
5e10: 28 69 20 28 2b 20 69 20 31 29 29 20 28 6c 73 20 (i (+ i 1)) (ls
5e20: 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 '())).
5e30: 20 28 72 65 61 64 0a 20 20 20 20 20 20 20 20 20 (read.
5e40: 20 20 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 i.
5e50: 20 28 6c 61 6d 62 64 61 20 28 78 20 6a 29 0a 20 (lambda (x j).
5e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
5e70: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
5e80: 20 20 28 28 65 71 3f 20 78 20 63 6c 6f 73 65 2d ((eq? x close-
5e90: 74 6f 6b 65 6e 29 0a 20 20 20 20 20 20 20 20 20 token).
5ea0: 20 20 20 20 20 20 20 28 6b 20 28 72 65 76 65 72 (k (rever
5eb0: 73 65 20 6c 73 29 20 6a 29 29 0a 20 20 20 20 20 se ls) j)).
5ec0: 20 20 20 20 20 20 20 20 20 20 28 28 65 71 3f 20 ((eq?
5ed0: 78 20 64 6f 74 2d 74 6f 6b 65 6e 29 0a 20 20 20 x dot-token).
5ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
5ef0: 20 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 (null? ls).
5f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f10: 28 65 72 72 6f 72 20 22 62 61 64 20 64 6f 74 74 (error "bad dott
5f20: 65 64 20 66 6f 72 6d 22 20 73 74 72 29 0a 20 20 ed form" str).
5f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f40: 20 20 28 72 65 61 64 20 6a 20 28 6c 61 6d 62 64 (read j (lambd
5f50: 61 20 28 79 20 6a 32 29 0a 20 20 20 20 20 20 20 a (y j2).
5f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f70: 20 20 20 20 20 20 20 28 72 65 61 64 20 6a 32 20 (read j2
5f80: 28 6c 61 6d 62 64 61 20 28 7a 20 6a 33 29 0a 20 (lambda (z j3).
5f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fb0: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not
5fc0: 20 28 65 71 3f 20 7a 20 63 6c 6f 73 65 2d 74 6f (eq? z close-to
5fd0: 6b 65 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 ken)).
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6000: 20 20 20 28 65 72 72 6f 72 20 22 62 61 64 20 64 (error "bad d
6010: 6f 74 74 65 64 20 66 6f 72 6d 22 20 73 74 72 29 otted form" str)
6020: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6b (k
6050: 20 28 61 70 70 65 6e 64 20 28 72 65 76 65 72 73 (append (revers
6060: 65 20 28 63 64 72 20 6c 73 29 29 0a 20 20 20 20 e (cdr ls)).
6070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60a0: 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 6c (cons (car l
60b0: 73 29 20 79 29 29 0a 20 20 20 20 20 20 20 20 20 s) y)).
60c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60e0: 20 20 20 20 20 20 20 6a 33 29 29 29 29 29 29 29 j3)))))))
60f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6100: 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
6110: 20 20 20 20 20 20 20 28 6c 70 20 6a 20 28 63 6f (lp j (co
6120: 6e 73 20 78 20 6c 73 29 29 29 29 29 29 29 29 0a ns x ls)))))))).
6130: 20 20 20 20 20 20 20 20 28 28 23 5c 29 29 0a 20 ((#\)).
6140: 20 20 20 20 20 20 20 20 28 6b 20 63 6c 6f 73 65 (k close
6150: 2d 74 6f 6b 65 6e 20 28 2b 20 69 20 31 29 29 29 -token (+ i 1)))
6160: 0a 20 20 20 20 20 20 20 20 28 28 23 5c 3b 29 0a . ((#\;).
6170: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 73 6b (let sk
6180: 69 70 20 28 28 69 20 28 2b 20 69 20 31 29 29 29 ip ((i (+ i 1)))
6190: 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 . (if
61a0: 28 6f 72 20 28 3e 3d 20 69 20 65 6e 64 29 20 28 (or (>= i end) (
61b0: 65 71 76 3f 20 23 5c 6e 65 77 6c 69 6e 65 20 28 eqv? #\newline (
61c0: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 string-ref str i
61d0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
61e0: 20 20 20 28 72 65 61 64 20 28 2b 20 69 20 31 29 (read (+ i 1)
61f0: 20 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 k).
6200: 20 20 20 28 73 6b 69 70 20 28 2b 20 69 20 31 29 (skip (+ i 1)
6210: 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 23 )))). ((#
6220: 5c 27 20 23 5c 60 29 0a 20 20 20 20 20 20 20 20 \' #\`).
6230: 20 28 72 65 61 64 20 28 2b 20 69 20 31 29 0a 20 (read (+ i 1).
6240: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
6250: 61 20 28 73 65 78 70 20 6a 29 0a 20 20 20 20 20 a (sexp j).
6260: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 71 (let ((q
6270: 20 28 69 66 20 28 65 71 76 3f 20 23 5c 27 20 28 (if (eqv? #\' (
6280: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 string-ref str i
6290: 29 29 20 27 71 75 6f 74 65 20 27 71 75 61 73 69 )) 'quote 'quasi
62a0: 71 75 6f 74 65 29 29 29 0a 20 20 20 20 20 20 20 quote))).
62b0: 20 20 20 20 20 20 20 20 28 6b 20 28 6c 69 73 74 (k (list
62c0: 20 71 20 73 65 78 70 29 20 6a 29 29 29 29 29 0a q sexp) j))))).
62d0: 20 20 20 20 20 20 20 20 28 28 23 5c 2c 29 0a 20 ((#\,).
62e0: 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
62f0: 61 74 3f 20 28 61 6e 64 20 28 3c 20 28 2b 20 69 at? (and (< (+ i
6300: 20 31 29 20 65 6e 64 29 20 28 65 71 76 3f 20 23 1) end) (eqv? #
6310: 5c 40 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 \@ (string-ref s
6320: 74 72 20 28 2b 20 69 20 31 29 29 29 29 29 0a 20 tr (+ i 1))))).
6330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6340: 75 20 28 69 66 20 61 74 3f 20 27 75 71 75 6f 74 u (if at? 'uquot
6350: 65 2d 73 70 6c 69 63 69 6e 67 20 27 75 6e 71 75 e-splicing 'unqu
6360: 6f 74 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 ote)).
6370: 20 20 20 20 20 20 28 6a 20 28 69 66 20 61 74 3f (j (if at?
6380: 20 28 2b 20 69 20 32 29 20 28 2b 20 69 20 31 29 (+ i 2) (+ i 1)
6390: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
63a0: 72 65 61 64 20 6a 20 28 6c 61 6d 62 64 61 20 28 read j (lambda (
63b0: 73 65 78 70 20 6a 29 20 28 6b 20 28 6c 69 73 74 sexp j) (k (list
63c0: 20 75 20 73 65 78 70 29 20 6a 29 29 29 29 29 0a u sexp) j))))).
63d0: 20 20 20 20 20 20 20 20 28 28 23 5c 22 29 0a 20 ((#\").
63e0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 73 63 61 (let sca
63f0: 6e 20 28 28 66 72 6f 6d 20 28 2b 20 69 20 31 29 n ((from (+ i 1)
6400: 29 20 28 69 20 28 2b 20 69 20 31 29 29 20 28 72 ) (i (+ i 1)) (r
6410: 65 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 es '())).
6420: 20 20 20 20 28 64 65 66 69 6e 65 20 28 63 6f 6c (define (col
6430: 6c 65 63 74 29 0a 20 20 20 20 20 20 20 20 20 20 lect).
6440: 20 20 20 28 69 66 20 28 3d 20 66 72 6f 6d 20 69 (if (= from i
6450: 29 20 72 65 73 20 28 63 6f 6e 73 20 28 73 75 62 ) res (cons (sub
6460: 73 74 72 69 6e 67 20 73 74 72 20 66 72 6f 6d 20 string str from
6470: 69 29 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 i) res))).
6480: 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 20 65 (if (>= i e
6490: 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
64a0: 20 20 20 28 65 72 72 6f 72 20 22 75 6e 74 65 72 (error "unter
64b0: 6d 69 6e 61 74 65 64 20 73 74 72 69 6e 67 20 69 minated string i
64c0: 6e 20 65 6d 62 65 64 64 65 64 20 53 52 45 22 20 n embedded SRE"
64d0: 73 74 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 str).
64e0: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
64f0: 67 2d 72 65 66 20 73 74 72 20 69 29 0a 20 20 20 g-ref str i).
6500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
6510: 23 5c 22 29 20 28 6b 20 28 73 74 72 69 6e 67 2d #\") (k (string-
6520: 63 61 74 2d 72 65 76 65 72 73 65 20 28 63 6f 6c cat-reverse (col
6530: 6c 65 63 74 29 29 20 28 2b 20 69 20 31 29 29 29 lect)) (+ i 1)))
6540: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6550: 20 20 28 28 23 5c 5c 29 20 28 73 63 61 6e 20 28 ((#\\) (scan (
6560: 2b 20 69 20 31 29 20 28 2b 20 69 20 32 29 20 28 + i 1) (+ i 2) (
6570: 63 6f 6c 6c 65 63 74 29 29 29 0a 20 20 20 20 20 collect))).
6580: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
6590: 65 20 28 73 63 61 6e 20 66 72 6f 6d 20 28 2b 20 e (scan from (+
65a0: 69 20 31 29 20 72 65 73 29 29 29 29 29 29 0a 20 i 1) res)))))).
65b0: 20 20 20 20 20 20 20 28 28 23 5c 23 29 0a 20 20 ((#\#).
65c0: 20 20 20 20 20 20 20 28 63 61 73 65 20 28 73 74 (case (st
65d0: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 ring-ref str (+
65e0: 69 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 i 1)).
65f0: 20 28 28 23 5c 3b 29 0a 20 20 20 20 20 20 20 20 ((#\;).
6600: 20 20 20 20 28 72 65 61 64 20 28 2b 20 69 20 32 (read (+ i 2
6610: 29 20 28 6c 61 6d 62 64 61 20 28 73 65 78 70 20 ) (lambda (sexp
6620: 6a 29 20 28 72 65 61 64 20 6a 20 6b 29 29 29 29 j) (read j k))))
6630: 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c . ((#\
6640: 5c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 \). (
6650: 72 65 61 64 20 28 2b 20 69 20 32 29 0a 20 20 20 read (+ i 2).
6660: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
6670: 64 61 20 28 73 65 78 70 20 6a 29 0a 20 20 20 20 da (sexp j).
6680: 20 20 20 20 20 20 20 20 20 20 20 20 28 6b 20 28 (k (
6690: 63 61 73 65 20 73 65 78 70 0a 20 20 20 20 20 20 case sexp.
66a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
66b0: 28 73 70 61 63 65 29 20 23 5c 73 70 61 63 65 29 (space) #\space)
66c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
66d0: 20 20 20 20 20 20 28 28 6e 65 77 6c 69 6e 65 29 ((newline)
66e0: 20 23 5c 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 #\newline).
66f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6700: 20 28 65 6c 73 65 20 28 6c 65 74 20 28 28 73 20 (else (let ((s
6710: 28 69 66 20 28 6e 75 6d 62 65 72 3f 20 73 65 78 (if (number? sex
6720: 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 p).
6730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6740: 20 20 20 20 20 20 20 20 20 20 20 28 6e 75 6d 62 (numb
6750: 65 72 2d 3e 73 74 72 69 6e 67 20 73 65 78 70 29 er->string sexp)
6760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6780: 20 20 20 20 20 20 20 20 20 28 73 79 6d 62 6f 6c (symbol
6790: 2d 3e 73 74 72 69 6e 67 20 73 65 78 70 29 29 29 ->string sexp)))
67a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
67b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
67c0: 73 74 72 69 6e 67 2d 72 65 66 20 73 20 30 29 29 string-ref s 0))
67d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
67e0: 20 20 20 20 20 20 6a 29 29 29 29 0a 20 20 20 20 j)))).
67f0: 20 20 20 20 20 20 20 28 28 23 5c 74 20 23 5c 66 ((#\t #\f
6800: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6b ). (k
6810: 20 28 65 71 76 3f 20 23 5c 74 20 28 73 74 72 69 (eqv? #\t (stri
6820: 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 69 20 ng-ref str (+ i
6830: 31 29 29 29 20 28 2b 20 69 20 32 29 29 29 0a 20 1))) (+ i 2))).
6840: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
6850: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err
6860: 6f 72 20 22 62 61 64 20 23 20 73 79 6e 74 61 78 or "bad # syntax
6870: 20 69 6e 20 73 69 6d 70 6c 69 66 69 65 64 20 53 in simplified S
6880: 52 45 22 20 69 29 29 29 29 0a 20 20 20 20 20 20 RE" i)))).
6890: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
68a0: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond.
68b0: 20 28 28 63 68 61 72 2d 77 68 69 74 65 73 70 61 ((char-whitespa
68c0: 63 65 3f 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ce? (string-ref
68d0: 73 74 72 20 69 29 29 0a 20 20 20 20 20 20 20 20 str i)).
68e0: 20 20 20 28 72 65 61 64 20 28 2b 20 69 20 31 29 (read (+ i 1)
68f0: 20 6b 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 k)). (
6900: 65 6c 73 65 20 3b 3b 20 73 79 6d 62 6f 6c 2f 6e else ;; symbol/n
6910: 75 6d 62 65 72 0a 20 20 20 20 20 20 20 20 20 20 umber.
6920: 20 28 6c 65 74 20 73 63 61 6e 20 28 28 6a 20 28 (let scan ((j (
6930: 2b 20 69 20 31 29 29 29 0a 20 20 20 20 20 20 20 + i 1))).
6940: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
6950: 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 28 ((or (
6960: 3e 3d 20 6a 20 65 6e 64 29 0a 20 20 20 20 20 20 >= j end).
6970: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
6980: 74 20 28 28 63 20 28 73 74 72 69 6e 67 2d 72 65 t ((c (string-re
6990: 66 20 73 74 72 20 6a 29 29 29 0a 20 20 20 20 20 f str j))).
69a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69b0: 28 6f 72 20 28 63 68 61 72 2d 77 68 69 74 65 73 (or (char-whites
69c0: 70 61 63 65 3f 20 63 29 0a 20 20 20 20 20 20 20 pace? c).
69d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69e0: 20 20 28 6d 65 6d 76 20 63 20 27 28 23 5c 3b 20 (memv c '(#\;
69f0: 23 5c 28 20 23 5c 29 20 23 5c 22 20 23 5c 23 20 #\( #\) #\" #\#
6a00: 23 5c 5c 29 29 29 29 29 0a 20 20 20 20 20 20 20 #\\))))).
6a10: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 (let ((s
6a20: 74 72 32 20 28 73 75 62 73 74 72 69 6e 67 20 73 tr2 (substring s
6a30: 74 72 20 69 20 6a 29 29 29 0a 20 20 20 20 20 20 tr i j))).
6a40: 20 20 20 20 20 20 20 20 20 20 20 28 6b 20 28 6f (k (o
6a50: 72 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 r (string->numbe
6a60: 72 20 73 74 72 32 29 20 28 73 74 72 69 6e 67 2d r str2) (string-
6a70: 3e 73 79 6d 62 6f 6c 20 73 74 72 32 29 29 20 6a >symbol str2)) j
6a80: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
6a90: 20 20 28 65 6c 73 65 20 28 73 63 61 6e 20 28 2b (else (scan (+
6aa0: 20 6a 20 31 29 29 29 29 29 29 29 29 29 29 29 29 j 1))))))))))))
6ab0: 0a 20 20 28 72 65 61 64 20 69 20 28 6c 61 6d 62 . (read i (lamb
6ac0: 64 61 20 28 72 65 73 20 6a 29 0a 20 20 20 20 20 da (res j).
6ad0: 20 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 (if (eq?
6ae0: 72 65 73 20 27 63 6c 6f 73 65 2d 74 6f 6b 65 6e res 'close-token
6af0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6b00: 20 20 28 65 72 72 6f 72 20 22 75 6e 65 78 70 65 (error "unexpe
6b10: 63 74 65 64 20 27 29 27 20 69 6e 20 53 52 45 22 cted ')' in SRE"
6b20: 20 73 74 72 20 6a 29 0a 20 20 20 20 20 20 20 20 str j).
6b30: 20 20 20 20 20 20 20 20 28 70 72 6f 63 20 72 65 (proc re
6b40: 73 20 6a 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b s j)))))..;;;;;;
6b50: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
6b60: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
6b70: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
6b80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
6b90: 3b 3b 0a 3b 3b 3b 3b 20 50 61 72 73 69 6e 67 20 ;;.;;;; Parsing
6ba0: 50 43 52 45 20 53 74 72 69 6e 67 73 0a 0a 28 64 PCRE Strings..(d
6bb0: 65 66 69 6e 65 20 7e 73 61 76 65 3f 20 31 29 0a efine ~save? 1).
6bc0: 28 64 65 66 69 6e 65 20 7e 63 61 73 65 2d 69 6e (define ~case-in
6bd0: 73 65 6e 73 69 74 69 76 65 3f 20 32 29 0a 28 64 sensitive? 2).(d
6be0: 65 66 69 6e 65 20 7e 6d 75 6c 74 69 2d 6c 69 6e efine ~multi-lin
6bf0: 65 3f 20 34 29 0a 28 64 65 66 69 6e 65 20 7e 73 e? 4).(define ~s
6c00: 69 6e 67 6c 65 2d 6c 69 6e 65 3f 20 38 29 0a 28 ingle-line? 8).(
6c10: 64 65 66 69 6e 65 20 7e 69 67 6e 6f 72 65 2d 73 define ~ignore-s
6c20: 70 61 63 65 3f 20 31 36 29 0a 28 64 65 66 69 6e pace? 16).(defin
6c30: 65 20 7e 75 74 66 38 3f 20 33 32 29 0a 0a 28 64 e ~utf8? 32)..(d
6c40: 65 66 69 6e 65 20 28 73 79 6d 62 6f 6c 2d 6c 69 efine (symbol-li
6c50: 73 74 2d 3e 66 6c 61 67 73 20 6c 73 29 0a 20 20 st->flags ls).
6c60: 28 6c 65 74 20 6c 70 20 28 28 6c 73 20 6c 73 29 (let lp ((ls ls)
6c70: 20 28 72 65 73 20 7e 6e 6f 6e 65 29 29 0a 20 20 (res ~none)).
6c80: 20 20 28 69 66 20 28 6e 6f 74 20 28 70 61 69 72 (if (not (pair
6c90: 3f 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 72 ? ls)). r
6ca0: 65 73 0a 20 20 20 20 20 20 20 20 28 6c 70 20 28 es. (lp (
6cb0: 63 64 72 20 6c 73 29 0a 20 20 20 20 20 20 20 20 cdr ls).
6cc0: 20 20 20 20 28 66 6c 61 67 2d 6a 6f 69 6e 0a 20 (flag-join.
6cd0: 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 0a res.
6ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 (ca
6cf0: 73 65 20 28 63 61 72 20 6c 73 29 0a 20 20 20 20 se (car ls).
6d00: 20 20 20 20 20 20 20 20 20 20 20 28 28 69 20 63 ((i c
6d10: 69 20 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 i case-insensiti
6d20: 76 65 29 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 ve) ~case-insens
6d30: 69 74 69 76 65 3f 29 0a 20 20 20 20 20 20 20 20 itive?).
6d40: 20 20 20 20 20 20 20 28 28 6d 20 6d 75 6c 74 69 ((m multi
6d50: 2d 6c 69 6e 65 29 20 7e 6d 75 6c 74 69 2d 6c 69 -line) ~multi-li
6d60: 6e 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 ne?).
6d70: 20 20 20 20 28 28 73 20 73 69 6e 67 6c 65 2d 6c ((s single-l
6d80: 69 6e 65 29 20 7e 73 69 6e 67 6c 65 2d 6c 69 6e ine) ~single-lin
6d90: 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e?).
6da0: 20 20 20 28 28 78 20 69 67 6e 6f 72 65 2d 73 70 ((x ignore-sp
6db0: 61 63 65 29 20 7e 69 67 6e 6f 72 65 2d 73 70 61 ace) ~ignore-spa
6dc0: 63 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 ce?).
6dd0: 20 20 20 20 28 28 75 20 75 74 66 38 29 20 28 69 ((u utf8) (i
6de0: 66 20 2a 61 6c 6c 6f 77 2d 75 74 66 38 2d 6d 6f f *allow-utf8-mo
6df0: 64 65 3f 2a 20 7e 75 74 66 38 3f 20 7e 6e 6f 6e de?* ~utf8? ~non
6e00: 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
6e10: 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 29 29 (else #f)))))
6e20: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 79 ))..(define (may
6e30: 62 65 2d 73 74 72 69 6e 67 2d 3e 73 72 65 20 6f be-string->sre o
6e40: 62 6a 29 0a 20 20 28 69 66 20 28 73 74 72 69 6e bj). (if (strin
6e50: 67 3f 20 6f 62 6a 29 20 28 73 74 72 69 6e 67 2d g? obj) (string-
6e60: 3e 73 72 65 20 6f 62 6a 29 20 6f 62 6a 29 29 0a >sre obj) obj)).
6e70: 0a 28 64 65 66 69 6e 65 20 28 73 74 72 69 6e 67 .(define (string
6e80: 2d 3e 73 72 65 20 73 74 72 20 2e 20 6f 29 0a 20 ->sre str . o).
6e90: 20 28 69 66 20 28 6e 6f 74 20 28 73 74 72 69 6e (if (not (strin
6ea0: 67 3f 20 73 74 72 29 29 20 28 65 72 72 6f 72 20 g? str)) (error
6eb0: 22 73 74 72 69 6e 67 2d 3e 73 72 65 3a 20 65 78 "string->sre: ex
6ec0: 70 65 63 74 65 64 20 61 20 73 74 72 69 6e 67 22 pected a string"
6ed0: 20 73 74 72 29 29 0a 20 20 28 6c 65 74 20 28 28 str)). (let ((
6ee0: 65 6e 64 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 end (string-leng
6ef0: 74 68 20 73 74 72 29 29 0a 20 20 20 20 20 20 20 th str)).
6f00: 20 28 66 6c 61 67 73 20 28 73 79 6d 62 6f 6c 2d (flags (symbol-
6f10: 6c 69 73 74 2d 3e 66 6c 61 67 73 20 6f 29 29 29 list->flags o)))
6f20: 0a 0a 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 .. (let lp ((
6f30: 69 20 30 29 20 28 66 72 6f 6d 20 30 29 20 28 66 i 0) (from 0) (f
6f40: 6c 61 67 73 20 66 6c 61 67 73 29 20 28 72 65 73 lags flags) (res
6f50: 20 27 28 29 29 20 28 73 74 20 27 28 29 29 29 0a '()) (st '())).
6f60: 0a 20 20 20 20 20 20 3b 3b 20 68 61 6e 64 6c 65 . ;; handle
6f70: 20 63 61 73 65 20 73 65 6e 73 69 74 69 76 69 74 case sensitivit
6f80: 79 20 61 74 20 74 68 65 20 6c 69 74 65 72 61 6c y at the literal
6f90: 20 63 68 61 72 2f 73 74 72 69 6e 67 20 6c 65 76 char/string lev
6fa0: 65 6c 0a 20 20 20 20 20 20 28 64 65 66 69 6e 65 el. (define
6fb0: 20 28 63 61 73 65 64 2d 63 68 61 72 20 63 68 29 (cased-char ch)
6fc0: 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e . (if (an
6fd0: 64 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 d (flag-set? fla
6fe0: 67 73 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 gs ~case-insensi
6ff0: 74 69 76 65 3f 29 0a 20 20 20 20 20 20 20 20 20 tive?).
7000: 20 20 20 20 20 20 20 20 28 63 68 61 72 2d 61 6c (char-al
7010: 70 68 61 62 65 74 69 63 3f 20 63 68 29 29 0a 20 phabetic? ch)).
7020: 20 20 20 20 20 20 20 20 20 20 20 60 28 6f 72 20 `(or
7030: 2c 63 68 20 2c 28 63 68 61 72 2d 61 6c 74 63 61 ,ch ,(char-altca
7040: 73 65 20 63 68 29 29 0a 20 20 20 20 20 20 20 20 se ch)).
7050: 20 20 20 20 63 68 29 29 0a 20 20 20 20 20 20 28 ch)). (
7060: 64 65 66 69 6e 65 20 28 63 61 73 65 64 2d 73 74 define (cased-st
7070: 72 69 6e 67 20 73 74 72 29 0a 20 20 20 20 20 20 ring str).
7080: 20 20 28 69 66 20 28 66 6c 61 67 2d 73 65 74 3f (if (flag-set?
7090: 20 66 6c 61 67 73 20 7e 63 61 73 65 2d 69 6e 73 flags ~case-ins
70a0: 65 6e 73 69 74 69 76 65 3f 29 0a 20 20 20 20 20 ensitive?).
70b0: 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 71 75 (sre-sequ
70c0: 65 6e 63 65 20 28 6d 61 70 20 63 61 73 65 64 2d ence (map cased-
70d0: 63 68 61 72 20 28 73 74 72 69 6e 67 2d 3e 6c 69 char (string->li
70e0: 73 74 20 73 74 72 29 29 29 0a 20 20 20 20 20 20 st str))).
70f0: 20 20 20 20 20 20 73 74 72 29 29 0a 20 20 20 20 str)).
7100: 20 20 3b 3b 20 61 63 63 75 6d 75 6c 61 74 65 20 ;; accumulate
7110: 74 68 65 20 73 75 62 73 74 72 69 6e 67 20 66 72 the substring fr
7120: 6f 6d 2e 2e 69 20 61 73 20 6c 69 74 65 72 61 6c om..i as literal
7130: 20 74 65 78 74 0a 20 20 20 20 20 20 28 64 65 66 text. (def
7140: 69 6e 65 20 28 63 6f 6c 6c 65 63 74 29 0a 20 20 ine (collect).
7150: 20 20 20 20 20 20 28 69 66 20 28 3d 20 69 20 66 (if (= i f
7160: 72 6f 6d 29 20 72 65 73 20 28 63 6f 6e 73 20 28 rom) res (cons (
7170: 63 61 73 65 64 2d 73 74 72 69 6e 67 20 28 73 75 cased-string (su
7180: 62 73 74 72 69 6e 67 20 73 74 72 20 66 72 6f 6d bstring str from
7190: 20 69 29 29 20 72 65 73 29 29 29 0a 20 20 20 20 i)) res))).
71a0: 20 20 3b 3b 20 6c 69 6b 65 20 63 6f 6c 6c 65 63 ;; like collec
71b0: 74 20 62 75 74 20 62 72 65 61 6b 73 20 6f 66 66 t but breaks off
71c0: 20 74 68 65 20 6c 61 73 74 20 73 69 6e 67 6c 65 the last single
71d0: 20 63 68 61 72 61 63 74 65 72 20 77 68 65 6e 0a character when.
71e0: 20 20 20 20 20 20 3b 3b 20 63 6f 6c 6c 65 63 74 ;; collect
71f0: 69 6e 67 20 6c 69 74 65 72 61 6c 20 64 61 74 61 ing literal data
7200: 2c 20 61 73 20 74 68 65 20 61 72 67 75 6d 65 6e , as the argumen
7210: 74 20 74 6f 20 3f 2f 2a 2f 2b 20 65 74 63 2e 0a t to ?/*/+ etc..
7220: 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 63 (define (c
7230: 6f 6c 6c 65 63 74 2f 73 69 6e 67 6c 65 29 0a 20 ollect/single).
7240: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 75 (let* ((u
7250: 74 66 38 3f 20 28 66 6c 61 67 2d 73 65 74 3f 20 tf8? (flag-set?
7260: 66 6c 61 67 73 20 7e 75 74 66 38 3f 29 29 0a 20 flags ~utf8?)).
7270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6a (j
7280: 20 28 69 66 20 28 61 6e 64 20 75 74 66 38 3f 20 (if (and utf8?
7290: 28 3e 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 (> i 1)).
72a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
72b0: 75 74 66 38 2d 62 61 63 6b 75 70 2d 74 6f 2d 69 utf8-backup-to-i
72c0: 6e 69 74 69 61 6c 2d 63 68 61 72 20 73 74 72 20 nitial-char str
72d0: 28 2d 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 (- i 1)).
72e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
72f0: 2d 20 69 20 31 29 29 29 29 0a 20 20 20 20 20 20 - i 1)))).
7300: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
7310: 20 20 20 20 20 28 28 3c 20 6a 20 66 72 6f 6d 29 ((< j from)
7320: 0a 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 . res
7330: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 6c ). (el
7340: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 se. (
7350: 6c 65 74 20 28 28 63 20 28 63 61 73 65 64 2d 63 let ((c (cased-c
7360: 68 61 72 20 28 69 66 20 75 74 66 38 3f 0a 20 20 har (if utf8?.
7370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7390: 20 20 20 28 75 74 66 38 2d 73 74 72 69 6e 67 2d (utf8-string-
73a0: 72 65 66 20 73 74 72 20 6a 20 28 2d 20 69 20 6a ref str j (- i j
73b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
73c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73d0: 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
73e0: 72 65 66 20 73 74 72 20 6a 29 29 29 29 29 0a 20 ref str j))))).
73f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
7400: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
7410: 20 20 28 28 3d 20 6a 20 66 72 6f 6d 29 0a 20 20 ((= j from).
7420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
7430: 6f 6e 73 20 63 20 72 65 73 29 29 0a 20 20 20 20 ons c res)).
7440: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
7450: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7460: 20 28 63 6f 6e 73 20 63 0a 20 20 20 20 20 20 20 (cons c.
7470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7480: 63 6f 6e 73 20 28 63 61 73 65 64 2d 73 74 72 69 cons (cased-stri
7490: 6e 67 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 ng (substring st
74a0: 72 20 66 72 6f 6d 20 6a 29 29 0a 20 20 20 20 20 r from j)).
74b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
74c0: 20 20 20 20 20 20 20 72 65 73 29 29 29 29 29 29 res))))))
74d0: 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 63 6f 6c ))). ;; col
74e0: 6c 65 63 74 73 20 66 6f 72 20 75 73 65 20 61 73 lects for use as
74f0: 20 61 20 72 65 73 75 6c 74 2c 20 72 65 76 65 72 a result, rever
7500: 73 69 6e 67 20 61 6e 64 20 67 72 6f 75 70 69 6e sing and groupin
7510: 67 20 4f 52 0a 20 20 20 20 20 20 3b 3b 20 74 65 g OR. ;; te
7520: 72 6d 73 2c 20 61 6e 64 20 73 6f 6d 65 20 75 67 rms, and some ug
7530: 6c 79 20 74 77 65 61 6b 69 6e 67 20 6f 66 20 60 ly tweaking of `
7540: 66 75 6e 63 74 69 6f 6e 2d 6c 69 6b 65 27 20 67 function-like' g
7550: 72 6f 75 70 73 20 61 6e 64 0a 20 20 20 20 20 20 roups and.
7560: 3b 3b 20 63 6f 6e 64 69 74 69 6f 6e 61 6c 73 0a ;; conditionals.
7570: 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 63 (define (c
7580: 6f 6c 6c 65 63 74 2f 74 65 72 6d 73 29 0a 20 20 ollect/terms).
7590: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6c 73 (let* ((ls
75a0: 20 28 63 6f 6c 6c 65 63 74 29 29 0a 20 20 20 20 (collect)).
75b0: 20 20 20 20 20 20 20 20 20 20 20 28 66 75 6e 63 (func
75c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
75d0: 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6c 73 29 (and (pair? ls)
75e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
75f0: 20 20 20 20 20 20 28 6d 65 6d 71 20 28 6c 61 73 (memq (las
7600: 74 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 t ls).
7610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7620: 20 27 28 61 74 6f 6d 69 63 20 69 66 20 6c 6f 6f '(atomic if loo
7630: 6b 2d 61 68 65 61 64 20 6e 65 67 2d 6c 6f 6f 6b k-ahead neg-look
7640: 2d 61 68 65 61 64 0a 20 20 20 20 20 20 20 20 20 -ahead.
7650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7660: 20 20 20 20 20 20 20 20 20 20 20 6c 6f 6f 6b 2d look-
7670: 62 65 68 69 6e 64 20 6e 65 67 2d 6c 6f 6f 6b 2d behind neg-look-
7680: 62 65 68 69 6e 64 0a 20 20 20 20 20 20 20 20 20 behind.
7690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76a0: 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20 73 75 => su
76b0: 62 6d 61 74 63 68 2d 6e 61 6d 65 64 0a 20 20 20 bmatch-named.
76c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76e0: 20 77 2f 75 74 66 38 20 77 2f 6e 6f 75 74 66 38 w/utf8 w/noutf8
76f0: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
7700: 20 20 20 20 28 70 72 65 66 69 78 20 28 69 66 20 (prefix (if
7710: 28 61 6e 64 20 66 75 6e 63 20 28 6d 65 6d 71 20 (and func (memq
7720: 28 63 61 72 20 66 75 6e 63 29 20 27 28 3d 3e 20 (car func) '(=>
7730: 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 29 submatch-named))
7740: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7750: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li
7760: 73 74 20 27 73 75 62 6d 61 74 63 68 2d 6e 61 6d st 'submatch-nam
7770: 65 64 20 28 63 61 64 72 20 28 72 65 76 65 72 73 ed (cadr (revers
7780: 65 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 e ls))).
7790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77a0: 20 20 20 28 61 6e 64 20 66 75 6e 63 20 28 6c 69 (and func (li
77b0: 73 74 20 28 63 61 72 20 66 75 6e 63 29 29 29 29 st (car func))))
77c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
77d0: 20 28 6c 73 20 28 69 66 20 66 75 6e 63 0a 20 20 (ls (if func.
77e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77f0: 20 20 20 20 20 28 69 66 20 28 6d 65 6d 71 20 28 (if (memq (
7800: 63 61 72 20 66 75 6e 63 29 20 27 28 3d 3e 20 73 car func) '(=> s
7810: 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 29 0a ubmatch-named)).
7820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7830: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 76 65 (reve
7840: 72 73 65 20 28 63 64 64 72 20 28 72 65 76 65 72 rse (cddr (rever
7850: 73 65 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 se ls))).
7860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7870: 20 20 20 20 28 72 65 76 65 72 73 65 20 28 63 64 (reverse (cd
7880: 72 20 28 72 65 76 65 72 73 65 20 6c 73 29 29 29 r (reverse ls)))
7890: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
78a0: 20 20 20 20 20 20 20 20 20 6c 73 29 29 29 0a 20 ls))).
78b0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 (let lp
78c0: 20 28 28 6c 73 20 6c 73 29 20 28 74 65 72 6d 20 ((ls ls) (term
78d0: 27 28 29 29 20 28 72 65 73 20 27 28 29 29 29 0a '()) (res '())).
78e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 64 65 66 (def
78f0: 69 6e 65 20 28 73 68 69 66 74 29 0a 20 20 20 20 ine (shift).
7900: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 (cons
7910: 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 74 65 (sre-sequence te
7920: 72 6d 29 20 72 65 73 29 29 0a 20 20 20 20 20 20 rm) res)).
7930: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
7940: 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f ((null?
7950: 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls).
7960: 20 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 28 (let* ((res (
7970: 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 28 73 sre-alternate (s
7980: 68 69 66 74 29 29 29 0a 20 20 20 20 20 20 20 20 hift))).
7990: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
79a0: 73 20 28 69 66 20 28 66 6c 61 67 2d 73 65 74 3f s (if (flag-set?
79b0: 20 66 6c 61 67 73 20 7e 73 61 76 65 3f 29 0a 20 flags ~save?).
79c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
79d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li
79e0: 73 74 20 27 73 75 62 6d 61 74 63 68 20 72 65 73 st 'submatch res
79f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a10: 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 res))).
7a20: 20 20 20 20 20 20 20 28 69 66 20 70 72 65 66 69 (if prefi
7a30: 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
7a40: 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 27 (if (eq? '
7a50: 69 66 20 28 63 61 72 20 70 72 65 66 69 78 29 29 if (car prefix))
7a60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7a70: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
7a80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a90: 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 70 ((not (p
7aa0: 61 69 72 3f 20 72 65 73 29 29 0a 20 20 20 20 20 air? res)).
7ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ac0: 20 20 20 20 20 27 65 70 73 69 6c 6f 6e 29 0a 20 'epsilon).
7ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ae0: 20 20 20 20 20 20 20 20 28 28 6d 65 6d 71 20 28 ((memq (
7af0: 63 61 72 20 72 65 73 29 0a 20 20 20 20 20 20 20 car res).
7b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b10: 20 20 20 20 20 20 20 20 20 27 28 6c 6f 6f 6b 2d '(look-
7b20: 61 68 65 61 64 20 6e 65 67 2d 6c 6f 6f 6b 2d 61 ahead neg-look-a
7b30: 68 65 61 64 0a 20 20 20 20 20 20 20 20 20 20 20 head.
7b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b60: 20 20 6c 6f 6f 6b 2d 62 65 68 69 6e 64 20 6e 65 look-behind ne
7b70: 67 2d 6c 6f 6f 6b 2d 62 65 68 69 6e 64 29 29 0a g-look-behind)).
7b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b90: 20 20 20 20 20 20 20 20 20 20 72 65 73 29 0a 20 res).
7ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7bb0: 20 20 20 20 20 20 20 20 28 28 65 71 3f 20 27 73 ((eq? 's
7bc0: 65 71 20 28 63 61 72 20 72 65 73 29 29 0a 20 20 eq (car res)).
7bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7be0: 20 20 20 20 20 20 20 20 60 28 69 66 20 2c 28 63 `(if ,(c
7bf0: 61 64 72 20 72 65 73 29 0a 20 20 20 20 20 20 20 adr res).
7c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c10: 20 20 20 20 20 20 20 20 2c 28 73 72 65 2d 73 65 ,(sre-se
7c20: 71 75 65 6e 63 65 20 28 63 64 64 72 20 72 65 73 quence (cddr res
7c30: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
7c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
7c50: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
7c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 `(
7c70: 69 66 20 2c 28 63 61 64 61 64 72 20 72 65 73 29 if ,(cadadr res)
7c80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ca0: 2c 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 ,(sre-sequence (
7cb0: 63 64 64 61 64 72 20 72 65 73 29 29 0a 20 20 20 cddadr res)).
7cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cd0: 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 73 72 ,(sr
7ce0: 65 2d 61 6c 74 65 72 6e 61 74 65 20 28 63 64 64 e-alternate (cdd
7cf0: 72 20 72 65 73 29 29 29 29 29 0a 20 20 20 20 20 r res))))).
7d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d10: 20 20 20 60 28 2c 40 70 72 65 66 69 78 20 2c 72 `(,@prefix ,r
7d20: 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
7d30: 20 20 20 20 20 20 20 20 20 72 65 73 29 29 29 0a res))).
7d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 65 ((e
7d50: 71 3f 20 27 6f 72 20 28 63 61 72 20 6c 73 29 29 q? 'or (car ls))
7d60: 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 27 28 (lp (cdr ls) '(
7d70: 29 20 28 73 68 69 66 74 29 29 29 0a 20 20 20 20 ) (shift))).
7d80: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
7d90: 6c 70 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e lp (cdr ls) (con
7da0: 73 20 28 63 61 72 20 6c 73 29 20 74 65 72 6d 29 s (car ls) term)
7db0: 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 20 res)))))).
7dc0: 20 28 64 65 66 69 6e 65 20 28 73 61 76 65 29 0a (define (save).
7dd0: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 (cons (c
7de0: 6f 6e 73 20 66 6c 61 67 73 20 28 63 6f 6c 6c 65 ons flags (colle
7df0: 63 74 29 29 20 73 74 29 29 0a 0a 20 20 20 20 20 ct)) st))..
7e00: 20 3b 3b 20 6d 61 69 6e 20 70 61 72 73 69 6e 67 ;; main parsing
7e10: 0a 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 . (if (>= i
7e20: 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
7e30: 28 69 66 20 28 70 61 69 72 3f 20 73 74 29 0a 20 (if (pair? st).
7e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
7e50: 72 6f 72 20 22 75 6e 74 65 72 6d 69 6e 61 74 65 ror "unterminate
7e60: 64 20 70 61 72 65 6e 74 68 65 73 69 73 20 69 6e d parenthesis in
7e70: 20 72 65 67 65 78 70 22 20 73 74 72 29 0a 20 20 regexp" str).
7e80: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6c (col
7e90: 6c 65 63 74 2f 74 65 72 6d 73 29 29 0a 20 20 20 lect/terms)).
7ea0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 20 (let ((c
7eb0: 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
7ec0: 69 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i))).
7ed0: 20 28 63 61 73 65 20 63 0a 20 20 20 20 20 20 20 (case c.
7ee0: 20 20 20 20 20 20 20 28 28 23 5c 2e 29 0a 20 20 ((#\.).
7ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
7f00: 20 28 2b 20 69 20 31 29 20 28 2b 20 69 20 31 29 (+ i 1) (+ i 1)
7f10: 20 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 flags.
7f20: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 (cons
7f30: 28 69 66 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 (if (flag-set? f
7f40: 6c 61 67 73 20 7e 73 69 6e 67 6c 65 2d 6c 69 6e lags ~single-lin
7f50: 65 3f 29 20 27 61 6e 79 20 27 6e 6f 6e 6c 29 0a e?) 'any 'nonl).
7f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f70: 20 20 20 20 20 20 20 20 20 28 63 6f 6c 6c 65 63 (collec
7f80: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
7f90: 20 20 20 20 20 20 20 73 74 29 29 0a 20 20 20 20 st)).
7fa0: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 3f 29 ((#\?)
7fb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7fc0: 28 6c 65 74 20 28 28 72 65 73 20 28 63 6f 6c 6c (let ((res (coll
7fd0: 65 63 74 2f 73 69 6e 67 6c 65 29 29 29 0a 20 20 ect/single))).
7fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7ff0: 69 66 20 28 6e 75 6c 6c 3f 20 72 65 73 29 0a 20 if (null? res).
8000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8010: 20 20 20 20 28 65 72 72 6f 72 20 22 3f 20 63 61 (error "? ca
8020: 6e 27 74 20 66 6f 6c 6c 6f 77 20 65 6d 70 74 79 n't follow empty
8030: 20 70 61 74 74 65 72 6e 22 20 73 74 72 20 72 65 pattern" str re
8040: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
8050: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 78 (let ((x
8060: 20 28 63 61 72 20 72 65 73 29 29 29 0a 20 20 20 (car res))).
8070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8080: 20 20 20 20 28 6c 70 20 28 2b 20 69 20 31 29 0a (lp (+ i 1).
8090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
80a0: 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 69 20 (+ i
80b0: 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1).
80c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6c fl
80d0: 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ags.
80e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
80f0: 63 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 20 20 cons.
8100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8110: 20 28 69 66 20 28 70 61 69 72 3f 20 78 29 0a 20 (if (pair? x).
8120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8140: 63 61 73 65 20 28 63 61 72 20 78 29 0a 20 20 20 case (car x).
8150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8170: 28 2a 29 20 20 60 28 2a 3f 20 2c 40 28 63 64 72 (*) `(*? ,@(cdr
8180: 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 x))).
8190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
81a0: 20 20 20 20 20 20 20 20 28 28 2b 29 20 20 60 28 ((+) `(
81b0: 2a 2a 3f 20 31 20 23 66 20 2c 40 28 63 64 72 20 **? 1 #f ,@(cdr
81c0: 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 x))).
81d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
81e0: 20 20 20 20 20 20 20 28 28 3f 29 20 20 60 28 3f ((?) `(?
81f0: 3f 20 2c 40 28 63 64 72 20 78 29 29 29 0a 20 20 ? ,@(cdr x))).
8200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8220: 28 28 2a 2a 29 20 60 28 2a 2a 3f 20 2c 40 28 63 ((**) `(**? ,@(c
8230: 64 72 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 dr x))).
8240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8250: 20 20 20 20 20 20 20 20 20 20 28 28 3d 29 20 20 ((=)
8260: 60 28 2a 2a 3f 20 2c 28 63 61 64 72 20 78 29 20 `(**? ,(cadr x)
8270: 2c 40 28 63 64 72 20 78 29 29 29 0a 20 20 20 20 ,@(cdr x))).
8280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
82a0: 3e 3d 29 20 20 60 28 2a 2a 3f 20 2c 28 63 61 64 >=) `(**? ,(cad
82b0: 72 20 78 29 20 23 66 20 2c 40 28 63 64 64 72 20 r x) #f ,@(cddr
82c0: 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 x))).
82d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
82e0: 20 20 20 20 20 20 20 28 65 6c 73 65 20 60 28 3f (else `(?
82f0: 20 2c 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 ,x))).
8300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8310: 20 20 20 20 20 20 20 60 28 3f 20 2c 78 29 29 0a `(? ,x)).
8320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8330: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 (cdr
8340: 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 res)).
8350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8360: 20 20 73 74 29 29 29 29 29 0a 20 20 20 20 20 20 st))))).
8370: 20 20 20 20 20 20 20 20 28 28 23 5c 2b 20 23 5c ((#\+ #\
8380: 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 *).
8390: 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 28 63 (let* ((res (c
83a0: 6f 6c 6c 65 63 74 2f 73 69 6e 67 6c 65 29 29 0a ollect/single)).
83b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
83c0: 20 20 20 20 20 20 28 78 20 28 69 66 20 28 70 61 (x (if (pa
83d0: 69 72 3f 20 72 65 73 29 20 28 63 61 72 20 72 65 ir? res) (car re
83e0: 73 29 20 27 65 70 73 69 6c 6f 6e 29 29 0a 20 20 s) 'epsilon)).
83f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8400: 20 20 20 20 28 6f 70 20 28 73 74 72 69 6e 67 2d (op (string-
8410: 3e 73 79 6d 62 6f 6c 20 28 73 74 72 69 6e 67 20 >symbol (string
8420: 63 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 c)))).
8430: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
8440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8450: 28 73 72 65 2d 72 65 70 65 61 74 65 72 3f 20 78 (sre-repeater? x
8460: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8470: 20 20 20 20 20 28 65 72 72 6f 72 20 22 64 75 70 (error "dup
8480: 6c 69 63 61 74 65 20 72 65 70 65 74 69 74 69 6f licate repetitio
8490: 6e 20 28 65 2e 67 2e 20 2a 2a 29 20 69 6e 20 70 n (e.g. **) in p
84a0: 61 74 74 65 72 6e 22 20 73 74 72 20 72 65 73 29 attern" str res)
84b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
84c0: 20 20 20 20 28 28 73 72 65 2d 65 6d 70 74 79 3f ((sre-empty?
84d0: 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 x).
84e0: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 63 (error "c
84f0: 61 6e 27 74 20 72 65 70 65 61 74 20 65 6d 70 74 an't repeat empt
8500: 79 20 70 61 74 74 65 72 6e 20 28 65 2e 67 2e 20 y pattern (e.g.
8510: 28 29 2a 29 22 20 73 74 72 20 72 65 73 29 29 0a ()*)" str res)).
8520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8530: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
8540: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
8550: 2b 20 69 20 31 29 20 28 2b 20 69 20 31 29 20 66 + i 1) (+ i 1) f
8560: 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
8570: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
8580: 73 20 28 6c 69 73 74 20 6f 70 20 78 29 20 28 63 s (list op x) (c
8590: 64 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 dr res)).
85a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
85b0: 73 74 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 st))))).
85c0: 20 20 20 20 20 20 28 28 23 5c 28 29 0a 20 20 20 ((#\().
85d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
85e0: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
85f0: 20 20 28 28 3e 3d 20 28 2b 20 69 20 31 29 20 65 ((>= (+ i 1) e
8600: 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
8610: 20 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e 74 (error "unt
8620: 65 72 6d 69 6e 61 74 65 64 20 70 61 72 65 6e 74 erminated parent
8630: 68 65 73 69 73 20 69 6e 20 72 65 67 65 78 70 22 hesis in regexp"
8640: 20 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 str)).
8650: 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 6d 65 ((not (me
8660: 6d 76 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 mv (string-ref s
8670: 74 72 20 28 2b 20 69 20 31 29 29 20 27 28 23 5c tr (+ i 1)) '(#\
8680: 3f 20 23 5c 2a 29 29 29 20 3b 20 6e 6f 72 6d 61 ? #\*))) ; norma
8690: 6c 20 63 61 73 65 0a 20 20 20 20 20 20 20 20 20 l case.
86a0: 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 (lp (+ i
86b0: 20 31 29 20 28 2b 20 69 20 31 29 20 28 66 6c 61 1) (+ i 1) (fla
86c0: 67 2d 6a 6f 69 6e 20 66 6c 61 67 73 20 7e 73 61 g-join flags ~sa
86d0: 76 65 3f 29 20 27 28 29 20 28 73 61 76 65 29 29 ve?) '() (save))
86e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
86f0: 20 20 28 28 3e 3d 20 28 2b 20 69 20 32 29 20 65 ((>= (+ i 2) e
8700: 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
8710: 20 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e 74 (error "unt
8720: 65 72 6d 69 6e 61 74 65 64 20 70 61 72 65 6e 74 erminated parent
8730: 68 65 73 69 73 20 69 6e 20 72 65 67 65 78 70 22 hesis in regexp"
8740: 20 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 str)).
8750: 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 28 73 ((eqv? (s
8760: 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b tring-ref str (+
8770: 20 69 20 31 29 29 20 23 5c 2a 29 0a 20 20 20 20 i 1)) #\*).
8780: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
8790: 20 28 65 71 76 3f 20 23 5c 27 20 28 73 74 72 69 (eqv? #\' (stri
87a0: 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 69 20 ng-ref str (+ i
87b0: 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 2))).
87c0: 20 20 20 20 20 20 20 20 20 20 28 77 69 74 68 2d (with-
87d0: 72 65 61 64 2d 66 72 6f 6d 2d 73 74 72 69 6e 67 read-from-string
87e0: 20 73 74 72 20 28 2b 20 69 20 33 29 0a 20 20 20 str (+ i 3).
87f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8800: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 73 72 65 (lambda (sre
8810: 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 j).
8820: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
8830: 20 28 6f 72 20 28 3e 3d 20 6a 20 65 6e 64 29 20 (or (>= j end)
8840: 28 6e 6f 74 20 28 65 71 76 3f 20 23 5c 29 20 28 (not (eqv? #\) (
8850: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 6a string-ref str j
8860: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
8870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8880: 20 20 28 65 72 72 6f 72 20 22 75 6e 74 65 72 6d (error "unterm
8890: 69 6e 61 74 65 64 20 28 2a 27 2e 2e 2e 29 20 53 inated (*'...) S
88a0: 52 45 20 65 73 63 61 70 65 22 20 73 74 72 29 0a RE escape" str).
88b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
88c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
88d0: 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 (+ j 1) (+ j 1)
88e0: 20 66 6c 61 67 73 20 28 63 6f 6e 73 20 73 72 65 flags (cons sre
88f0: 20 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 (collect)) st))
8900: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8910: 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 (error "
8920: 62 61 64 20 72 65 67 65 78 70 20 73 79 6e 74 61 bad regexp synta
8930: 78 3a 20 28 2a 46 4f 4f 29 20 6e 6f 74 20 73 75 x: (*FOO) not su
8940: 70 70 6f 72 74 65 64 22 20 73 74 72 29 29 29 0a pported" str))).
8950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8960: 28 65 6c 73 65 20 20 20 20 20 20 20 20 20 20 20 (else
8970: 20 20 20 20 20 20 20 20 3b 3b 20 28 3f 2e 2e 2e ;; (?...
8980: 29 20 63 61 73 65 0a 20 20 20 20 20 20 20 20 20 ) case.
8990: 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 73 (case (s
89a0: 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b tring-ref str (+
89b0: 20 69 20 32 29 29 0a 20 20 20 20 20 20 20 20 20 i 2)).
89c0: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 23 29 ((#\#)
89d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
89e0: 20 20 20 20 20 28 6c 65 74 20 28 28 6a 20 28 73 (let ((j (s
89f0: 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 72 20 tring-scan-char
8a00: 73 74 72 20 23 5c 29 20 28 2b 20 69 20 33 29 29 str #\) (+ i 3))
8a10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
8a20: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f (if (no
8a30: 74 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 t j).
8a40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8a50: 65 72 72 6f 72 20 22 6d 69 73 73 69 6e 67 20 29 error "missing )
8a60: 20 61 66 74 65 72 20 23 22 20 73 74 72 29 0a 20 after #" str).
8a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8a80: 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 (lp (+
8a90: 6a 20 69 29 20 28 2b 20 6a 20 31 29 20 66 6c 61 j i) (+ j 1) fla
8aa0: 67 73 20 28 63 6f 6c 6c 65 63 74 29 20 73 74 29 gs (collect) st)
8ab0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
8ac0: 20 20 20 20 20 20 20 28 28 23 5c 3a 29 0a 20 20 ((#\:).
8ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ae0: 20 20 28 6c 70 20 28 2b 20 69 20 33 29 20 28 2b (lp (+ i 3) (+
8af0: 20 69 20 33 29 20 28 66 6c 61 67 2d 63 6c 65 61 i 3) (flag-clea
8b00: 72 20 66 6c 61 67 73 20 7e 73 61 76 65 3f 29 20 r flags ~save?)
8b10: 27 28 29 20 28 73 61 76 65 29 29 29 0a 20 20 20 '() (save))).
8b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b30: 28 28 23 5c 3d 29 0a 20 20 20 20 20 20 20 20 20 ((#\=).
8b40: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
8b50: 2b 20 69 20 33 29 20 28 2b 20 69 20 33 29 20 28 + i 3) (+ i 3) (
8b60: 66 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 73 flag-clear flags
8b70: 20 7e 73 61 76 65 3f 29 0a 20 20 20 20 20 20 20 ~save?).
8b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8b90: 20 27 28 6c 6f 6f 6b 2d 61 68 65 61 64 29 20 28 '(look-ahead) (
8ba0: 73 61 76 65 29 29 29 0a 20 20 20 20 20 20 20 20 save))).
8bb0: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 21 ((#\!
8bc0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8bd0: 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 33 (lp (+ i 3
8be0: 29 20 28 2b 20 69 20 33 29 20 28 66 6c 61 67 2d ) (+ i 3) (flag-
8bf0: 63 6c 65 61 72 20 66 6c 61 67 73 20 7e 73 61 76 clear flags ~sav
8c00: 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e?).
8c10: 20 20 20 20 20 20 20 20 20 20 20 20 27 28 6e 65 '(ne
8c20: 67 2d 6c 6f 6f 6b 2d 61 68 65 61 64 29 20 28 73 g-look-ahead) (s
8c30: 61 76 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 ave))).
8c40: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 3c 29 ((#\<)
8c50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8c60: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
8c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c80: 28 28 3e 3d 20 28 2b 20 69 20 33 29 20 65 6e 64 ((>= (+ i 3) end
8c90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8ca0: 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 (error "
8cb0: 75 6e 74 65 72 6d 69 6e 61 74 65 64 20 70 61 72 unterminated par
8cc0: 65 6e 74 68 65 73 69 73 20 69 6e 20 72 65 67 65 enthesis in rege
8cd0: 78 70 22 20 73 74 72 29 29 0a 20 20 20 20 20 20 xp" str)).
8ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
8cf0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
8d00: 20 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 (case
8d10: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
8d20: 20 28 2b 20 69 20 33 29 29 0a 20 20 20 20 20 20 (+ i 3)).
8d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d40: 20 20 28 28 23 5c 3d 29 0a 20 20 20 20 20 20 20 ((#\=).
8d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d60: 20 20 28 6c 70 20 28 2b 20 69 20 34 29 20 28 2b (lp (+ i 4) (+
8d70: 20 69 20 34 29 20 28 66 6c 61 67 2d 63 6c 65 61 i 4) (flag-clea
8d80: 72 20 66 6c 61 67 73 20 7e 73 61 76 65 3f 29 0a r flags ~save?).
8d90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 6c '(l
8db0: 6f 6f 6b 2d 62 65 68 69 6e 64 29 20 28 73 61 76 ook-behind) (sav
8dc0: 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 e))).
8dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 ((#
8de0: 5c 21 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 \!).
8df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
8e00: 20 28 2b 20 69 20 34 29 20 28 2b 20 69 20 34 29 (+ i 4) (+ i 4)
8e10: 20 28 66 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 (flag-clear fla
8e20: 67 73 20 7e 73 61 76 65 3f 29 0a 20 20 20 20 20 gs ~save?).
8e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e40: 20 20 20 20 20 20 20 20 27 28 6e 65 67 2d 6c 6f '(neg-lo
8e50: 6f 6b 2d 62 65 68 69 6e 64 29 20 28 73 61 76 65 ok-behind) (save
8e60: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
8e70: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
8e80: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
8e90: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
8ea0: 28 28 6a 20 28 61 6e 64 20 28 63 68 61 72 2d 61 ((j (and (char-a
8eb0: 6c 70 68 61 62 65 74 69 63 3f 0a 20 20 20 20 20 lphabetic?.
8ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ee0: 20 20 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 (string-ref s
8ef0: 74 72 20 28 2b 20 69 20 33 29 29 29 0a 20 20 20 tr (+ i 3))).
8f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f20: 20 20 20 20 28 73 74 72 69 6e 67 2d 73 63 61 6e (string-scan
8f30: 2d 63 68 61 72 20 73 74 72 20 23 5c 3e 20 28 2b -char str #\> (+
8f40: 20 69 20 34 29 29 29 29 29 0a 20 20 20 20 20 20 i 4))))).
8f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f60: 20 20 20 20 20 28 69 66 20 6a 0a 20 20 20 20 20 (if j.
8f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f80: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
8f90: 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 20 28 66 j 1) (+ j 1) (f
8fa0: 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 73 20 lag-clear flags
8fb0: 7e 73 61 76 65 3f 29 0a 20 20 20 20 20 20 20 20 ~save?).
8fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fd0: 20 20 20 20 20 20 20 20 20 20 20 60 28 2c 28 73 `(,(s
8fe0: 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 28 73 tring->symbol (s
8ff0: 75 62 73 74 72 69 6e 67 20 73 74 72 20 28 2b 20 ubstring str (+
9000: 69 20 33 29 20 6a 29 29 0a 20 20 20 20 20 20 20 i 3) j)).
9010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 75 su
9030: 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a 20 20 bmatch-named).
9040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9060: 20 28 73 61 76 65 29 29 0a 20 20 20 20 20 20 20 (save)).
9070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9080: 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 (error "
9090: 69 6e 76 61 6c 69 64 20 28 3f 3c 20 73 65 71 75 invalid (?< sequ
90a0: 65 6e 63 65 22 20 73 74 72 29 29 29 29 29 29 29 ence" str)))))))
90b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
90c0: 20 20 20 20 20 28 28 23 5c 3e 29 0a 20 20 20 20 ((#\>).
90d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90e0: 28 6c 70 20 28 2b 20 69 20 33 29 20 28 2b 20 69 (lp (+ i 3) (+ i
90f0: 20 33 29 20 28 66 6c 61 67 2d 63 6c 65 61 72 20 3) (flag-clear
9100: 66 6c 61 67 73 20 7e 73 61 76 65 3f 29 0a 20 20 flags ~save?).
9110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9120: 20 20 20 20 20 20 27 28 61 74 6f 6d 69 63 29 20 '(atomic)
9130: 28 73 61 76 65 29 29 29 0a 20 20 20 20 20 20 20 (save))).
9140: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 28 ;;((
9150: 23 5c 27 20 23 5c 50 29 20 3b 20 6e 61 6d 65 64 #\' #\P) ; named
9160: 20 73 75 62 70 61 74 74 65 72 6e 73 0a 20 20 20 subpatterns.
9170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9180: 3b 3b 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 ;; ).
9190: 20 20 20 20 20 20 20 20 3b 3b 28 28 23 5c 52 29 ;;((#\R)
91a0: 20 3b 20 72 65 63 75 72 73 69 6f 6e 0a 20 20 20 ; recursion.
91b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91c0: 3b 3b 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 ;; ).
91d0: 20 20 20 20 20 20 20 20 28 28 23 5c 28 29 0a 20 ((#\().
91e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
91f0: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
9200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
9210: 3e 3d 20 28 2b 20 69 20 33 29 20 65 6e 64 29 0a >= (+ i 3) end).
9220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9230: 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e (error "un
9240: 74 65 72 6d 69 6e 61 74 65 64 20 70 61 72 65 6e terminated paren
9250: 74 68 65 73 69 73 20 69 6e 20 72 65 67 65 78 70 thesis in regexp
9260: 22 20 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 " str)).
9270: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 ((c
9280: 68 61 72 2d 6e 75 6d 65 72 69 63 3f 20 28 73 74 har-numeric? (st
9290: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 ring-ref str (+
92a0: 69 20 33 29 29 29 0a 20 20 20 20 20 20 20 20 20 i 3))).
92b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
92c0: 74 20 28 28 6a 20 28 73 74 72 69 6e 67 2d 73 63 t ((j (string-sc
92d0: 61 6e 2d 63 68 61 72 20 73 74 72 20 23 5c 29 20 an-char str #\)
92e0: 28 2b 20 69 20 33 29 29 29 29 0a 20 20 20 20 20 (+ i 3)))).
92f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9300: 20 20 20 28 69 66 20 28 6e 6f 74 20 6a 29 0a 20 (if (not j).
9310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9320: 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro
9330: 72 20 22 6d 69 73 73 69 6e 67 20 63 6c 6f 73 69 r "missing closi
9340: 6e 67 20 70 61 72 65 6e 74 68 65 73 69 73 22 20 ng parenthesis"
9350: 73 74 72 20 69 29 0a 20 20 20 20 20 20 20 20 20 str i).
9360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9370: 20 20 20 28 6c 65 74 20 28 28 6e 20 28 73 74 72 (let ((n (str
9380: 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 73 75 62 ing->number (sub
9390: 73 74 72 69 6e 67 20 73 74 72 20 28 2b 20 69 20 string str (+ i
93a0: 33 29 20 6a 29 29 29 29 0a 20 20 20 20 20 20 20 3) j)))).
93b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93c0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
93d0: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
93e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93f0: 20 20 20 20 20 28 65 72 72 6f 72 20 22 69 6e 76 (error "inv
9400: 61 6c 69 64 20 63 6f 6e 64 69 74 69 6f 6e 61 6c alid conditional
9410: 20 72 65 66 65 72 65 6e 63 65 22 20 73 74 72 29 reference" str)
9420: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9440: 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 29 20 28 (lp (+ j 1) (
9450: 2b 20 6a 20 31 29 20 28 66 6c 61 67 2d 63 6c 65 + j 1) (flag-cle
9460: 61 72 20 66 6c 61 67 73 20 7e 73 61 76 65 3f 29 ar flags ~save?)
9470: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9490: 20 20 20 20 20 20 20 60 28 2c 6e 20 69 66 29 20 `(,n if)
94a0: 28 73 61 76 65 29 29 29 29 29 29 29 0a 20 20 20 (save))))))).
94b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94c0: 20 20 28 28 63 68 61 72 2d 61 6c 70 68 61 62 65 ((char-alphabe
94d0: 74 69 63 3f 20 28 73 74 72 69 6e 67 2d 72 65 66 tic? (string-ref
94e0: 20 73 74 72 20 28 2b 20 69 20 33 29 29 29 0a 20 str (+ i 3))).
94f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9500: 20 20 20 20 20 28 6c 65 74 20 28 28 6a 20 28 73 (let ((j (s
9510: 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 72 20 tring-scan-char
9520: 73 74 72 20 23 5c 29 20 28 2b 20 69 20 33 29 29 str #\) (+ i 3))
9530: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
9540: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
9550: 6e 6f 74 20 6a 29 0a 20 20 20 20 20 20 20 20 20 not j).
9560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9570: 20 20 20 28 65 72 72 6f 72 20 22 6d 69 73 73 69 (error "missi
9580: 6e 67 20 63 6c 6f 73 69 6e 67 20 70 61 72 65 6e ng closing paren
9590: 74 68 65 73 69 73 22 20 73 74 72 20 69 29 0a 20 thesis" str i).
95a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
95b0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
95c0: 28 28 73 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d ((s (string->sym
95d0: 62 6f 6c 20 28 73 75 62 73 74 72 69 6e 67 20 73 bol (substring s
95e0: 74 72 20 28 2b 20 69 20 33 29 20 6a 29 29 29 29 tr (+ i 3) j))))
95f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
9610: 6c 70 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 lp (+ j 1) (+ j
9620: 31 29 20 28 66 6c 61 67 2d 63 6c 65 61 72 20 66 1) (flag-clear f
9630: 6c 61 67 73 20 7e 73 61 76 65 3f 29 0a 20 20 20 lags ~save?).
9640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
9660: 28 2c 73 20 69 66 29 20 28 73 61 76 65 29 29 29 (,s if) (save)))
9670: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
9680: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
9690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
96a0: 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 (lp (+ i 2)
96b0: 20 28 2b 20 69 20 32 29 20 28 66 6c 61 67 2d 63 (+ i 2) (flag-c
96c0: 6c 65 61 72 20 66 6c 61 67 73 20 7e 73 61 76 65 lear flags ~save
96d0: 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?).
96e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 69 '(i
96f0: 66 29 20 28 73 61 76 65 29 29 29 29 29 0a 20 20 f) (save))))).
9700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9710: 20 28 28 23 5c 7b 29 0a 20 20 20 20 20 20 20 20 ((#\{).
9720: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err
9730: 6f 72 20 22 75 6e 73 75 70 70 6f 72 74 65 64 20 or "unsupported
9740: 50 65 72 6c 2d 73 74 79 6c 65 20 63 6c 75 73 74 Perl-style clust
9750: 65 72 22 20 73 74 72 29 29 0a 20 20 20 20 20 20 er" str)).
9760: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
9770: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
9780: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6f 6c (let ((ol
9790: 64 2d 66 6c 61 67 73 20 66 6c 61 67 73 29 29 0a d-flags flags)).
97a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
97b0: 20 20 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 (let lp2 (
97c0: 28 6a 20 28 2b 20 69 20 32 29 29 20 28 66 6c 61 (j (+ i 2)) (fla
97d0: 67 73 20 66 6c 61 67 73 29 20 28 69 6e 76 65 72 gs flags) (inver
97e0: 74 3f 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 t? #f)).
97f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9800: 28 64 65 66 69 6e 65 20 28 6a 6f 69 6e 20 78 29 (define (join x)
9810: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9820: 20 20 20 20 20 20 20 20 20 20 20 28 28 69 66 20 ((if
9830: 69 6e 76 65 72 74 3f 20 66 6c 61 67 2d 63 6c 65 invert? flag-cle
9840: 61 72 20 66 6c 61 67 2d 6a 6f 69 6e 29 20 66 6c ar flag-join) fl
9850: 61 67 73 20 78 29 29 0a 20 20 20 20 20 20 20 20 ags x)).
9860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9870: 28 64 65 66 69 6e 65 20 28 6e 65 77 2d 72 65 73 (define (new-res
9880: 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 res).
9890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
98a0: 28 6c 65 74 20 28 28 62 65 66 6f 72 65 20 28 66 (let ((before (f
98b0: 6c 61 67 2d 73 65 74 3f 20 6f 6c 64 2d 66 6c 61 lag-set? old-fla
98c0: 67 73 20 7e 75 74 66 38 3f 29 29 0a 20 20 20 20 gs ~utf8?)).
98d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
98e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 66 74 (aft
98f0: 65 72 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c er (flag-set? fl
9900: 61 67 73 20 7e 75 74 66 38 3f 29 29 29 0a 20 20 ags ~utf8?))).
9910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9920: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 (if (e
9930: 71 3f 20 62 65 66 6f 72 65 20 61 66 74 65 72 29 q? before after)
9940: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9960: 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 res.
9970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9980: 20 20 20 20 20 28 63 6f 6e 73 20 28 69 66 20 61 (cons (if a
9990: 66 74 65 72 20 27 77 2f 75 74 66 38 20 27 77 2f fter 'w/utf8 'w/
99a0: 6e 6f 75 74 66 38 29 20 72 65 73 29 29 29 29 0a noutf8) res)))).
99b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
99c0: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
99d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
99e0: 20 20 20 20 20 20 20 28 28 3e 3d 20 6a 20 65 6e ((>= j en
99f0: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
9a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
9a10: 72 6f 72 20 22 69 6e 63 6f 6d 70 6c 65 74 65 20 ror "incomplete
9a20: 63 6c 75 73 74 65 72 22 20 73 74 72 20 69 29 29 cluster" str i))
9a30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9a40: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
9a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9a60: 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 20 (case
9a70: 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
9a80: 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j).
9a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
9aa0: 28 23 5c 69 29 0a 20 20 20 20 20 20 20 20 20 20 (#\i).
9ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ac0: 20 20 20 28 6c 70 32 20 28 2b 20 6a 20 31 29 20 (lp2 (+ j 1)
9ad0: 28 6a 6f 69 6e 20 7e 63 61 73 65 2d 69 6e 73 65 (join ~case-inse
9ae0: 6e 73 69 74 69 76 65 3f 29 20 69 6e 76 65 72 74 nsitive?) invert
9af0: 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ?)).
9b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b10: 28 28 23 5c 6d 29 0a 20 20 20 20 20 20 20 20 20 ((#\m).
9b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b30: 20 20 20 20 28 6c 70 32 20 28 2b 20 6a 20 31 29 (lp2 (+ j 1)
9b40: 20 28 6a 6f 69 6e 20 7e 6d 75 6c 74 69 2d 6c 69 (join ~multi-li
9b50: 6e 65 3f 29 20 69 6e 76 65 72 74 3f 29 29 0a 20 ne?) invert?)).
9b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b70: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 78 ((#\x
9b80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
9ba0: 6c 70 32 20 28 2b 20 6a 20 31 29 20 28 6a 6f 69 lp2 (+ j 1) (joi
9bb0: 6e 20 7e 69 67 6e 6f 72 65 2d 73 70 61 63 65 3f n ~ignore-space?
9bc0: 29 20 69 6e 76 65 72 74 3f 29 29 0a 20 20 20 20 ) invert?)).
9bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9be0: 20 20 20 20 20 20 20 20 28 28 23 5c 75 29 0a 20 ((#\u).
9bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9c00: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
9c10: 2a 61 6c 6c 6f 77 2d 75 74 66 38 2d 6d 6f 64 65 *allow-utf8-mode
9c20: 3f 2a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?*.
9c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9c40: 20 20 20 20 28 6c 70 32 20 28 2b 20 6a 20 31 29 (lp2 (+ j 1)
9c50: 20 28 6a 6f 69 6e 20 7e 75 74 66 38 3f 29 20 69 (join ~utf8?) i
9c60: 6e 76 65 72 74 3f 29 0a 20 20 20 20 20 20 20 20 nvert?).
9c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9c80: 20 20 20 20 20 20 20 20 20 28 6c 70 32 20 28 2b (lp2 (+
9c90: 20 6a 20 31 29 20 66 6c 61 67 73 20 69 6e 76 65 j 1) flags inve
9ca0: 72 74 3f 29 29 29 0a 20 20 20 20 20 20 20 20 20 rt?))).
9cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9cc0: 20 20 20 28 28 23 5c 2d 29 0a 20 20 20 20 20 20 ((#\-).
9cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ce0: 20 20 20 20 20 20 20 28 6c 70 32 20 28 2b 20 6a (lp2 (+ j
9cf0: 20 31 29 20 66 6c 61 67 73 20 28 6e 6f 74 20 69 1) flags (not i
9d00: 6e 76 65 72 74 3f 29 29 29 0a 20 20 20 20 20 20 nvert?))).
9d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9d20: 20 20 20 20 20 20 28 28 23 5c 29 29 0a 20 20 20 ((#\)).
9d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9d40: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
9d50: 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 20 66 6c j 1) (+ j 1) fl
9d60: 61 67 73 20 28 6e 65 77 2d 72 65 73 20 28 63 6f ags (new-res (co
9d70: 6c 6c 65 63 74 29 29 0a 20 20 20 20 20 20 20 20 llect)).
9d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9d90: 20 20 20 20 20 20 20 20 20 73 74 29 29 0a 20 20 st)).
9da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9db0: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 3a 29 ((#\:)
9dc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
9de0: 70 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 p (+ j 1) (+ j 1
9df0: 29 20 66 6c 61 67 73 20 28 6e 65 77 2d 72 65 73 ) flags (new-res
9e00: 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 '()).
9e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e20: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 6f (cons (co
9e30: 6e 73 20 6f 6c 64 2d 66 6c 61 67 73 20 28 63 6f ns old-flags (co
9e40: 6c 6c 65 63 74 29 29 20 73 74 29 29 29 0a 20 20 llect)) st))).
9e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e60: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
9e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
9e90: 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 72 65 67 ror "unknown reg
9ea0: 65 78 20 63 6c 75 73 74 65 72 20 6d 6f 64 69 66 ex cluster modif
9eb0: 69 65 72 22 20 73 74 72 29 0a 20 20 20 20 20 20 ier" str).
9ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ed0: 20 20 20 20 20 20 20 29 29 29 29 29 29 29 29 29 )))))))))
9ee0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
9ef0: 20 28 28 23 5c 29 29 0a 20 20 20 20 20 20 20 20 ((#\)).
9f00: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
9f10: 3f 20 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 ? st).
9f20: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 (error
9f30: 22 74 6f 6f 20 6d 61 6e 79 20 29 27 73 20 69 6e "too many )'s in
9f40: 20 72 65 67 65 78 70 22 20 73 74 72 29 0a 20 20 regexp" str).
9f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f60: 20 28 6c 70 20 28 2b 20 69 20 31 29 0a 20 20 20 (lp (+ i 1).
9f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9f80: 20 20 20 20 28 2b 20 69 20 31 29 0a 20 20 20 20 (+ i 1).
9f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9fa0: 20 20 20 28 63 61 61 72 20 73 74 29 0a 20 20 20 (caar st).
9fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9fc0: 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6c 6c 65 (cons (colle
9fd0: 63 74 2f 74 65 72 6d 73 29 20 28 63 64 61 72 20 ct/terms) (cdar
9fe0: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
9ff0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 (cdr
a000: 20 73 74 29 29 29 29 0a 20 20 20 20 20 20 20 20 st)))).
a010: 20 20 20 20 20 20 28 28 23 5c 5b 29 0a 20 20 20 ((#\[).
a020: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
a030: 6c 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ly.
a040: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 72 65 20 (lambda (sre
a050: 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j).
a060: 20 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 29 (lp (+ j 1)
a070: 20 28 2b 20 6a 20 31 29 20 66 6c 61 67 73 20 28 (+ j 1) flags (
a080: 63 6f 6e 73 20 73 72 65 20 28 63 6f 6c 6c 65 63 cons sre (collec
a090: 74 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 t)) st)).
a0a0: 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
a0b0: 2d 70 61 72 73 65 2d 63 73 65 74 20 73 74 72 20 -parse-cset str
a0c0: 28 2b 20 69 20 31 29 20 66 6c 61 67 73 29 29 29 (+ i 1) flags)))
a0d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
a0e0: 28 23 5c 7b 29 0a 20 20 20 20 20 20 20 20 20 20 (#\{).
a0f0: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
a100: 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 ((or
a110: 28 3e 3d 20 28 2b 20 69 20 31 29 20 65 6e 64 29 (>= (+ i 1) end)
a120: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a130: 20 20 20 20 20 20 28 6e 6f 74 20 28 6f 72 20 28 (not (or (
a140: 63 68 61 72 2d 6e 75 6d 65 72 69 63 3f 20 28 73 char-numeric? (s
a150: 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b tring-ref str (+
a160: 20 69 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 i 1))).
a170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a180: 20 20 20 20 20 20 28 65 71 76 3f 20 23 5c 2c 20 (eqv? #\,
a190: 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
a1a0: 28 2b 20 69 20 31 29 29 29 29 29 29 0a 20 20 20 (+ i 1)))))).
a1b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
a1c0: 70 20 28 2b 20 69 20 31 29 20 66 72 6f 6d 20 66 p (+ i 1) from f
a1d0: 6c 61 67 73 20 72 65 73 20 73 74 29 29 0a 20 20 lags res st)).
a1e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
a1f0: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
a200: 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 (let ((res
a210: 28 63 6f 6c 6c 65 63 74 2f 73 69 6e 67 6c 65 29 (collect/single)
a220: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
a230: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
a240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a250: 28 28 6e 75 6c 6c 3f 20 72 65 73 29 0a 20 20 20 ((null? res).
a260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a270: 20 20 28 65 72 72 6f 72 20 22 7b 20 63 61 6e 27 (error "{ can'
a280: 74 20 66 6f 6c 6c 6f 77 20 65 6d 70 74 79 20 70 t follow empty p
a290: 61 74 74 65 72 6e 22 29 29 0a 20 20 20 20 20 20 attern")).
a2a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
a2b0: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
a2c0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
a2d0: 28 78 20 28 63 61 72 20 72 65 73 29 29 0a 20 20 (x (car res)).
a2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a2f0: 20 20 20 20 20 20 20 20 20 20 28 74 61 69 6c 20 (tail
a300: 28 63 64 72 20 72 65 73 29 29 0a 20 20 20 20 20 (cdr res)).
a310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a320: 20 20 20 20 20 20 20 28 6a 20 28 6f 72 20 28 73 (j (or (s
a330: 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 72 20 tring-scan-char
a340: 73 74 72 20 23 5c 7d 20 28 2b 20 69 20 31 29 29 str #\} (+ i 1))
a350: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a360: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a370: 20 20 20 20 28 65 72 72 6f 72 20 22 6d 69 73 73 (error "miss
a380: 69 6e 67 20 63 6c 6f 73 69 6e 67 20 7d 22 20 73 ing closing }" s
a390: 74 72 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 tr i))).
a3a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a3b0: 20 20 20 20 28 73 32 20 28 73 74 72 69 6e 67 2d (s2 (string-
a3c0: 73 70 6c 69 74 2d 63 68 61 72 20 28 73 75 62 73 split-char (subs
a3d0: 74 72 69 6e 67 20 73 74 72 20 28 2b 20 69 20 31 tring str (+ i 1
a3e0: 29 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) j).
a3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a410: 20 20 20 20 20 20 20 20 23 5c 2c 29 29 0a 20 20 #\,)).
a420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a430: 20 20 20 20 20 20 20 20 20 20 28 6e 20 28 73 74 (n (st
a440: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 28 63 61 ring->number (ca
a450: 72 20 73 32 29 29 29 0a 20 20 20 20 20 20 20 20 r s2))).
a460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a470: 20 20 20 20 28 6d 20 28 61 6e 64 20 28 70 61 69 (m (and (pai
a480: 72 3f 20 28 63 64 72 20 73 32 29 29 0a 20 20 20 r? (cdr s2)).
a490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a4b0: 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 (string->number
a4c0: 20 28 63 61 64 72 20 73 32 29 29 29 29 29 0a 20 (cadr s2))))).
a4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a4e0: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
a4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a500: 20 20 20 20 28 28 6f 72 20 28 6e 6f 74 20 6e 29 ((or (not n)
a510: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
a520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
a530: 6e 64 20 28 70 61 69 72 3f 20 28 63 64 72 20 73 nd (pair? (cdr s
a540: 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
a550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a560: 20 20 20 20 20 20 28 6e 6f 74 20 28 65 71 75 61 (not (equa
a570: 6c 3f 20 22 22 20 28 63 61 64 72 20 73 32 29 29 l? "" (cadr s2))
a580: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5a0: 20 20 20 20 28 6e 6f 74 20 6d 29 29 29 0a 20 20 (not m))).
a5b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a5c0: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 69 (error "i
a5d0: 6e 76 61 6c 69 64 20 7b 6e 7d 20 72 65 70 65 74 nvalid {n} repet
a5e0: 69 74 69 6f 6e 20 73 79 6e 74 61 78 22 20 73 32 ition syntax" s2
a5f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
a600: 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c ((nul
a610: 6c 3f 20 28 63 64 72 20 73 32 29 29 0a 20 20 20 l? (cdr s2)).
a620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a630: 20 20 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 (lp (+ j 1
a640: 29 20 28 2b 20 6a 20 31 29 20 66 6c 61 67 73 20 ) (+ j 1) flags
a650: 60 28 28 3d 20 2c 6e 20 2c 78 29 20 2c 40 74 61 `((= ,n ,x) ,@ta
a660: 69 6c 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 il) st)).
a670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a680: 20 28 6d 0a 20 20 20 20 20 20 20 20 20 20 20 20 (m.
a690: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
a6a0: 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 (+ j 1) (+ j 1)
a6b0: 20 66 6c 61 67 73 20 60 28 28 2a 2a 20 2c 6e 20 flags `((** ,n
a6c0: 2c 6d 20 2c 78 29 20 2c 40 74 61 69 6c 29 20 73 ,m ,x) ,@tail) s
a6d0: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
a6e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
a6f0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
a700: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
a710: 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 20 66 + j 1) (+ j 1) f
a720: 6c 61 67 73 20 60 28 28 3e 3d 20 2c 6e 20 2c 78 lags `((>= ,n ,x
a730: 29 20 2c 40 74 61 69 6c 29 20 73 74 29 0a 20 20 ) ,@tail) st).
a740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a750: 20 20 20 20 20 20 20 29 29 29 29 29 29 29 29 29 )))))))))
a760: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
a770: 28 23 5c 5c 29 0a 20 20 20 20 20 20 20 20 20 20 (#\\).
a780: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
a790: 20 20 20 20 20 20 20 20 20 20 20 28 28 3e 3d 20 ((>=
a7a0: 28 2b 20 69 20 31 29 20 65 6e 64 29 0a 20 20 20 (+ i 1) end).
a7b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
a7c0: 72 72 6f 72 20 22 69 6e 63 6f 6d 70 6c 65 74 65 rror "incomplete
a7d0: 20 65 73 63 61 70 65 20 73 65 71 75 65 6e 63 65 escape sequence
a7e0: 22 20 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 " str)).
a7f0: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
a800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
a810: 6c 65 74 20 28 28 63 20 28 73 74 72 69 6e 67 2d let ((c (string-
a820: 72 65 66 20 73 74 72 20 28 2b 20 69 20 31 29 29 ref str (+ i 1))
a830: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
a840: 20 20 20 20 20 20 28 63 61 73 65 20 63 0a 20 20 (case c.
a850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a860: 20 20 20 28 28 23 5c 64 29 0a 20 20 20 20 20 20 ((#\d).
a870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a880: 28 6c 70 20 28 2b 20 69 20 32 29 20 28 2b 20 69 (lp (+ i 2) (+ i
a890: 20 32 29 20 66 6c 61 67 73 20 60 28 6e 75 6d 65 2) flags `(nume
a8a0: 72 69 63 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 ric ,@(collect))
a8b0: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 st)).
a8c0: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 44 ((#\D
a8d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a8e0: 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 (lp (+ i
a8f0: 20 32 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 2) (+ i 2) flag
a900: 73 20 60 28 28 7e 20 6e 75 6d 65 72 69 63 29 20 s `((~ numeric)
a910: 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 ,@(collect)) st)
a920: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
a930: 20 20 20 20 20 20 20 28 28 23 5c 73 29 0a 20 20 ((#\s).
a940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
a950: 20 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 (lp (+ i 2)
a960: 28 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 (+ i 2) flags `(
a970: 73 70 61 63 65 20 2c 40 28 63 6f 6c 6c 65 63 74 space ,@(collect
a980: 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 )) st)).
a990: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 ((#
a9a0: 5c 53 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 \S).
a9b0: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
a9c0: 20 69 20 32 29 20 28 2b 20 69 20 32 29 20 66 6c i 2) (+ i 2) fl
a9d0: 61 67 73 20 60 28 28 7e 20 73 70 61 63 65 29 20 ags `((~ space)
a9e0: 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 ,@(collect)) st)
a9f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
aa00: 20 20 20 20 20 20 20 28 28 23 5c 77 29 0a 20 20 ((#\w).
aa10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa20: 20 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 (lp (+ i 2)
aa30: 28 2b 20 69 20 32 29 20 66 6c 61 67 73 0a 20 20 (+ i 2) flags.
aa40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aa50: 20 20 20 20 20 20 20 20 60 28 28 6f 72 20 61 6c `((or al
aa60: 70 68 61 6e 75 6d 65 72 69 63 20 28 22 5f 22 29 phanumeric ("_")
aa70: 29 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 ) ,@(collect)) s
aa80: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
aa90: 20 20 20 20 20 20 20 20 20 28 28 23 5c 57 29 0a ((#\W).
aaa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aab0: 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 32 (lp (+ i 2
aac0: 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 73 0a ) (+ i 2) flags.
aad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aae0: 20 20 20 20 20 20 20 20 20 20 60 28 28 7e 20 28 `((~ (
aaf0: 6f 72 20 61 6c 70 68 61 6e 75 6d 65 72 69 63 20 or alphanumeric
ab00: 28 22 5f 22 29 29 29 20 2c 40 28 63 6f 6c 6c 65 ("_"))) ,@(colle
ab10: 63 74 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 ct)) st)).
ab20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
ab30: 28 23 5c 62 29 0a 20 20 20 20 20 20 20 20 20 20 (#\b).
ab40: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
ab50: 28 2b 20 69 20 32 29 20 28 2b 20 69 20 32 29 20 (+ i 2) (+ i 2)
ab60: 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 flags.
ab70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ab80: 60 28 28 6f 72 20 62 6f 77 20 65 6f 77 29 20 2c `((or bow eow) ,
ab90: 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 @(collect)) st))
aba0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
abb0: 20 20 20 20 20 20 28 28 23 5c 42 29 0a 20 20 20 ((#\B).
abc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
abd0: 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 (lp (+ i 2) (
abe0: 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 6e + i 2) flags `(n
abf0: 77 62 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 wb ,@(collect))
ac00: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
ac10: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 41 29 ((#\A)
ac20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ac30: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
ac40: 32 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 73 2) (+ i 2) flags
ac50: 20 60 28 62 6f 73 20 2c 40 28 63 6f 6c 6c 65 63 `(bos ,@(collec
ac60: 74 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 t)) st)).
ac70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
ac80: 23 5c 5a 29 0a 20 20 20 20 20 20 20 20 20 20 20 #\Z).
ac90: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
aca0: 2b 20 69 20 32 29 20 28 2b 20 69 20 32 29 20 66 + i 2) (+ i 2) f
acb0: 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
acc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
acd0: 28 28 3f 20 23 5c 6e 65 77 6c 69 6e 65 29 20 65 ((? #\newline) e
ace0: 6f 73 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 os ,@(collect))
acf0: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
ad00: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 7a 29 ((#\z)
ad10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ad20: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
ad30: 32 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 73 2) (+ i 2) flags
ad40: 20 60 28 65 6f 73 20 2c 40 28 63 6f 6c 6c 65 63 `(eos ,@(collec
ad50: 74 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 t)) st)).
ad60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
ad70: 23 5c 52 29 0a 20 20 20 20 20 20 20 20 20 20 20 #\R).
ad80: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
ad90: 2b 20 69 20 32 29 20 28 2b 20 69 20 32 29 20 66 + i 2) (+ i 2) f
ada0: 6c 61 67 73 20 60 28 6e 65 77 6c 69 6e 65 20 2c lags `(newline ,
adb0: 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 @(collect)) st))
adc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
add0: 20 20 20 20 20 20 28 28 23 5c 4b 29 0a 20 20 20 ((#\K).
ade0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
adf0: 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 (lp (+ i 2) (
ae00: 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 72 + i 2) flags `(r
ae10: 65 73 65 74 20 2c 40 28 63 6f 6c 6c 65 63 74 29 eset ,@(collect)
ae20: 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 ) st)).
ae30: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 74 ;; t
ae40: 68 65 73 65 20 74 77 6f 20 61 72 65 20 66 72 6f hese two are fro
ae50: 6d 20 45 6d 61 63 73 20 61 6e 64 20 54 52 45 2c m Emacs and TRE,
ae60: 20 62 75 74 20 6e 6f 74 20 69 6e 20 50 43 52 45 but not in PCRE
ae70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ae80: 20 20 20 20 20 20 28 28 23 5c 3c 29 0a 20 20 20 ((#\<).
ae90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aea0: 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 (lp (+ i 2) (
aeb0: 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 62 + i 2) flags `(b
aec0: 6f 77 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 ow ,@(collect))
aed0: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
aee0: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 3e 29 ((#\>)
aef0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
af00: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
af10: 32 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 73 2) (+ i 2) flags
af20: 20 60 28 65 6f 77 20 2c 40 28 63 6f 6c 6c 65 63 `(eow ,@(collec
af30: 74 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 t)) st)).
af40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
af50: 23 5c 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 #\x).
af60: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
af70: 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y.
af80: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
af90: 20 28 63 68 20 6a 29 0a 20 20 20 20 20 20 20 20 (ch j).
afa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
afb0: 20 28 6c 70 20 28 2b 20 6a 20 31 29 20 28 2b 20 (lp (+ j 1) (+
afc0: 6a 20 31 29 20 66 6c 61 67 73 20 60 28 2c 63 68 j 1) flags `(,ch
afd0: 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 ,@(collect)) st
afe0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
aff0: 20 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e (strin
b000: 67 2d 70 61 72 73 65 2d 68 65 78 2d 65 73 63 61 g-parse-hex-esca
b010: 70 65 20 73 74 72 20 28 2b 20 69 20 32 29 20 65 pe str (+ i 2) e
b020: 6e 64 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 nd))).
b030: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 6b ((#\k
b040: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b050: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 (let ((c
b060: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
b070: 20 28 2b 20 69 20 32 29 29 29 29 0a 20 20 20 20 (+ i 2)))).
b080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b090: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 6d 65 (if (not (me
b0a0: 6d 76 20 63 20 27 28 23 5c 3c 20 23 5c 7b 20 23 mv c '(#\< #\{ #
b0b0: 5c 27 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 \'))).
b0c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b0d0: 20 20 28 65 72 72 6f 72 20 22 62 61 64 20 5c 5c (error "bad \\
b0e0: 6b 20 75 73 61 67 65 2c 20 65 78 70 65 63 74 65 k usage, expecte
b0f0: 64 20 5c 5c 6b 3c 2e 2e 2e 3e 22 20 73 74 72 29 d \\k<...>" str)
b100: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b110: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
b120: 74 2a 20 28 28 74 65 72 6d 69 6e 61 6c 20 28 63 t* ((terminal (c
b130: 68 61 72 2d 6d 69 72 72 6f 72 20 63 29 29 0a 20 har-mirror c)).
b140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b160: 20 20 28 6a 20 28 73 74 72 69 6e 67 2d 73 63 61 (j (string-sca
b170: 6e 2d 63 68 61 72 20 73 74 72 20 74 65 72 6d 69 n-char str termi
b180: 6e 61 6c 20 28 2b 20 69 20 32 29 29 29 0a 20 20 nal (+ i 2))).
b190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1b0: 20 28 73 20 28 61 6e 64 20 6a 20 28 73 75 62 73 (s (and j (subs
b1c0: 74 72 69 6e 67 20 73 74 72 20 28 2b 20 69 20 33 tring str (+ i 3
b1d0: 29 20 6a 29 29 29 0a 20 20 20 20 20 20 20 20 20 ) j))).
b1e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b1f0: 20 20 20 20 20 20 20 20 20 20 28 62 61 63 6b 72 (backr
b200: 65 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ef.
b210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b220: 20 20 20 20 20 20 20 28 69 66 20 28 66 6c 61 67 (if (flag
b230: 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e 63 61 73 -set? flags ~cas
b240: 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 0a e-insensitive?).
b250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b270: 20 20 20 20 20 20 20 20 27 62 61 63 6b 72 65 66 'backref
b280: 2d 63 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 -ci.
b290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2a0: 20 20 20 20 20 20 20 20 20 20 20 20 27 62 61 63 'bac
b2b0: 6b 72 65 66 29 29 29 0a 20 20 20 20 20 20 20 20 kref))).
b2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b2d0: 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6a (if (not j
b2e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b2f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b300: 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e 74 65 (error "unte
b310: 72 6d 69 6e 61 74 65 64 20 6e 61 6d 65 64 20 62 rminated named b
b320: 61 63 6b 72 65 66 22 20 73 74 72 29 0a 20 20 20 ackref" str).
b330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
b350: 6c 70 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 lp (+ j 1) (+ j
b360: 31 29 20 66 6c 61 67 73 0a 20 20 20 20 20 20 20 1) flags.
b370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 60 `
b390: 28 28 2c 62 61 63 6b 72 65 66 20 2c 28 73 74 72 ((,backref ,(str
b3a0: 69 6e 67 2d 3e 73 79 6d 62 6f 6c 20 73 29 29 0a ing->symbol s)).
b3b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b3d0: 20 20 20 20 20 20 20 20 2c 40 28 63 6f 6c 6c 65 ,@(colle
b3e0: 63 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ct)).
b3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b400: 20 20 20 20 20 20 20 20 20 20 20 73 74 29 29 29 st)))
b410: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
b420: 20 20 20 20 20 20 20 20 20 28 28 23 5c 51 29 20 ((#\Q)
b430: 20 3b 3b 20 5c 51 2e 2e 5c 45 20 65 73 63 61 70 ;; \Q..\E escap
b440: 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 es.
b450: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
b460: 72 65 73 20 28 63 6f 6c 6c 65 63 74 29 29 29 0a res (collect))).
b470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b480: 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 32 (let lp2
b490: 20 28 28 6a 20 28 2b 20 69 20 32 29 29 29 0a 20 ((j (+ i 2))).
b4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4b0: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
b4c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4d0: 20 20 20 20 20 20 20 20 20 20 28 28 3e 3d 20 6a ((>= j
b4e0: 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
b4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b500: 20 20 28 6c 70 20 6a 20 28 2b 20 69 20 32 29 20 (lp j (+ i 2)
b510: 66 6c 61 67 73 20 72 65 73 20 73 74 29 29 0a 20 flags res st)).
b520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b530: 20 20 20 20 20 20 20 20 20 20 28 28 65 71 76 3f ((eqv?
b540: 20 23 5c 5c 20 28 73 74 72 69 6e 67 2d 72 65 66 #\\ (string-ref
b550: 20 73 74 72 20 6a 29 29 0a 20 20 20 20 20 20 20 str j)).
b560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b570: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
b580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b590: 20 20 20 20 20 20 20 20 28 28 3e 3d 20 28 2b 20 ((>= (+
b5a0: 6a 20 31 29 20 65 6e 64 29 0a 20 20 20 20 20 20 j 1) end).
b5b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b5c0: 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 6a (lp (+ j
b5d0: 20 31 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 1) (+ i 2) flag
b5e0: 73 20 72 65 73 20 73 74 29 29 0a 20 20 20 20 20 s res st)).
b5f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b600: 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 23 ((eqv? #
b610: 5c 45 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 \E (string-ref s
b620: 74 72 20 28 2b 20 6a 20 31 29 29 29 0a 20 20 20 tr (+ j 1))).
b630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b640: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
b650: 2b 20 6a 20 32 29 20 28 2b 20 6a 20 32 29 20 66 + j 2) (+ j 2) f
b660: 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
b670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b680: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 73 75 (cons (su
b690: 62 73 74 72 69 6e 67 20 73 74 72 20 28 2b 20 69 bstring str (+ i
b6a0: 20 32 29 20 6a 29 20 72 65 73 29 20 73 74 29 29 2) j) res) st))
b6b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b6c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
b6d0: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
b6e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b6f0: 20 20 28 6c 70 32 20 28 2b 20 6a 20 32 29 29 29 (lp2 (+ j 2)))
b700: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
b710: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
b720: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
b730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b740: 28 6c 70 32 20 28 2b 20 6a 20 31 29 29 29 29 29 (lp2 (+ j 1)))))
b750: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
b760: 20 20 20 20 20 20 20 20 28 28 23 5c 27 29 0a 20 ((#\').
b770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b780: 20 20 20 20 20 28 77 69 74 68 2d 72 65 61 64 2d (with-read-
b790: 66 72 6f 6d 2d 73 74 72 69 6e 67 20 73 74 72 20 from-string str
b7a0: 28 2b 20 69 20 32 29 0a 20 20 20 20 20 20 20 20 (+ i 2).
b7b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
b7c0: 6c 61 6d 62 64 61 20 28 73 72 65 20 6a 29 0a 20 lambda (sre j).
b7d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b7e0: 20 20 20 20 20 20 20 20 28 6c 70 20 6a 20 6a 20 (lp j j
b7f0: 66 6c 61 67 73 20 28 63 6f 6e 73 20 73 72 65 20 flags (cons sre
b800: 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 29 (collect)) st)))
b810: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b820: 20 20 20 20 20 20 20 3b 3b 28 28 23 5c 70 29 20 ;;((#\p)
b830: 20 3b 20 58 58 58 58 20 75 6e 69 63 6f 64 65 20 ; XXXX unicode
b840: 70 72 6f 70 65 72 74 69 65 73 0a 20 20 20 20 20 properties.
b850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b860: 3b 3b 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 ;; ).
b870: 20 20 20 20 20 20 20 20 20 20 3b 3b 28 28 23 5c ;;((#\
b880: 50 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 P).
b890: 20 20 20 20 20 20 20 20 3b 3b 20 29 0a 20 20 20 ;; ).
b8a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8b0: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
b8c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
b8d0: 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ond.
b8e0: 20 20 20 20 20 20 20 20 20 20 20 28 28 63 68 61 ((cha
b8f0: 72 2d 6e 75 6d 65 72 69 63 3f 20 63 29 0a 20 20 r-numeric? c).
b900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b910: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6a 20 (let* ((j
b920: 28 6f 72 20 28 73 74 72 69 6e 67 2d 73 63 61 6e (or (string-scan
b930: 2d 70 72 65 64 0a 20 20 20 20 20 20 20 20 20 20 -pred.
b940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b950: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 72 str
b960: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b980: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
b990: 28 63 29 20 28 6e 6f 74 20 28 63 68 61 72 2d 6e (c) (not (char-n
b9a0: 75 6d 65 72 69 63 3f 20 63 29 29 29 0a 20 20 20 umeric? c))).
b9b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9d0: 20 20 20 20 28 2b 20 69 20 32 29 29 0a 20 20 20 (+ i 2)).
b9e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba00: 20 20 20 65 6e 64 29 29 0a 20 20 20 20 20 20 20 end)).
ba10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba20: 20 20 20 20 20 20 20 20 28 62 61 63 6b 72 65 66 (backref
ba30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ba40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba50: 20 28 69 66 20 28 66 6c 61 67 2d 73 65 74 3f 20 (if (flag-set?
ba60: 66 6c 61 67 73 20 7e 63 61 73 65 2d 69 6e 73 65 flags ~case-inse
ba70: 6e 73 69 74 69 76 65 3f 29 0a 20 20 20 20 20 20 nsitive?).
ba80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ba90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 62 'b
baa0: 61 63 6b 72 65 66 2d 63 69 0a 20 20 20 20 20 20 ackref-ci.
bab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 62 'b
bad0: 61 63 6b 72 65 66 29 29 0a 20 20 20 20 20 20 20 ackref)).
bae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
baf0: 20 20 20 20 20 20 20 20 28 72 65 73 20 60 28 28 (res `((
bb00: 2c 62 61 63 6b 72 65 66 20 2c 28 73 74 72 69 6e ,backref ,(strin
bb10: 67 2d 3e 6e 75 6d 62 65 72 0a 20 20 20 20 20 20 g->number.
bb20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb40: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 62 (sub
bb50: 73 74 72 69 6e 67 20 73 74 72 20 28 2b 20 69 20 string str (+ i
bb60: 31 29 20 6a 29 29 29 0a 20 20 20 20 20 20 20 20 1) j))).
bb70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 40 ,@
bb90: 28 63 6f 6c 6c 65 63 74 29 29 29 29 0a 20 20 20 (collect)))).
bba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbb0: 20 20 20 20 20 20 20 28 6c 70 20 6a 20 6a 20 66 (lp j j f
bbc0: 6c 61 67 73 20 72 65 73 20 73 74 29 29 29 0a 20 lags res st))).
bbd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bbe0: 20 20 20 20 20 20 28 28 63 68 61 72 2d 61 6c 70 ((char-alp
bbf0: 68 61 62 65 74 69 63 3f 20 63 29 0a 20 20 20 20 habetic? c).
bc00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc10: 20 20 20 20 28 6c 65 74 20 28 28 63 65 6c 6c 20 (let ((cell
bc20: 28 61 73 73 76 20 63 20 70 6f 73 69 78 2d 65 73 (assv c posix-es
bc30: 63 61 70 65 2d 73 65 71 75 65 6e 63 65 73 29 29 cape-sequences))
bc40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
bc50: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
bc60: 63 65 6c 6c 0a 20 20 20 20 20 20 20 20 20 20 20 cell.
bc70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc80: 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 (lp (+ i 2) (
bc90: 2b 20 69 20 32 29 20 66 6c 61 67 73 0a 20 20 20 + i 2) flags.
bca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
bcc0: 63 6f 6e 73 20 28 63 64 72 20 63 65 6c 6c 29 20 cons (cdr cell)
bcd0: 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 0a 20 (collect)) st).
bce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
bd00: 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 65 73 63 ror "unknown esc
bd10: 61 70 65 20 73 65 71 75 65 6e 63 65 22 20 73 74 ape sequence" st
bd20: 72 20 63 29 29 29 29 0a 20 20 20 20 20 20 20 20 r c)))).
bd30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
bd40: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
bd50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
bd60: 20 28 2b 20 69 20 32 29 20 28 2b 20 69 20 31 29 (+ i 2) (+ i 1)
bd70: 20 66 6c 61 67 73 20 28 63 6f 6c 6c 65 63 74 29 flags (collect)
bd80: 20 73 74 29 29 29 29 29 29 29 29 29 0a 20 20 20 st))))))))).
bd90: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 7c ((#\|
bda0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
bdb0: 20 28 6c 70 20 28 2b 20 69 20 31 29 20 28 2b 20 (lp (+ i 1) (+
bdc0: 69 20 31 29 20 66 6c 61 67 73 20 28 63 6f 6e 73 i 1) flags (cons
bdd0: 20 27 6f 72 20 28 63 6f 6c 6c 65 63 74 29 29 20 'or (collect))
bde0: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
bdf0: 20 20 20 28 28 23 5c 5e 29 0a 20 20 20 20 20 20 ((#\^).
be00: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
be10: 73 79 6d 20 28 69 66 20 28 66 6c 61 67 2d 73 65 sym (if (flag-se
be20: 74 3f 20 66 6c 61 67 73 20 7e 6d 75 6c 74 69 2d t? flags ~multi-
be30: 6c 69 6e 65 3f 29 20 27 62 6f 6c 20 27 62 6f 73 line?) 'bol 'bos
be40: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
be50: 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 31 29 (lp (+ i 1)
be60: 20 28 2b 20 69 20 31 29 20 66 6c 61 67 73 20 28 (+ i 1) flags (
be70: 63 6f 6e 73 20 73 79 6d 20 28 63 6f 6c 6c 65 63 cons sym (collec
be80: 74 29 29 20 73 74 29 29 29 0a 20 20 20 20 20 20 t)) st))).
be90: 20 20 20 20 20 20 20 20 28 28 23 5c 24 29 0a 20 ((#\$).
bea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
beb0: 65 74 20 28 28 73 79 6d 20 28 69 66 20 28 66 6c et ((sym (if (fl
bec0: 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e 6d ag-set? flags ~m
bed0: 75 6c 74 69 2d 6c 69 6e 65 3f 29 20 27 65 6f 6c ulti-line?) 'eol
bee0: 20 27 65 6f 73 29 29 29 0a 20 20 20 20 20 20 20 'eos))).
bef0: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
bf00: 20 69 20 31 29 20 28 2b 20 69 20 31 29 20 66 6c i 1) (+ i 1) fl
bf10: 61 67 73 20 28 63 6f 6e 73 20 73 79 6d 20 28 63 ags (cons sym (c
bf20: 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 29 0a 20 ollect)) st))).
bf30: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 ((#
bf40: 5c 73 70 61 63 65 29 0a 20 20 20 20 20 20 20 20 \space).
bf50: 20 20 20 20 20 20 20 28 69 66 20 28 66 6c 61 67 (if (flag
bf60: 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e 69 67 6e -set? flags ~ign
bf70: 6f 72 65 2d 73 70 61 63 65 3f 29 0a 20 20 20 20 ore-space?).
bf80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
bf90: 6c 70 20 28 2b 20 69 20 31 29 20 28 2b 20 69 20 lp (+ i 1) (+ i
bfa0: 31 29 20 66 6c 61 67 73 20 28 63 6f 6c 6c 65 63 1) flags (collec
bfb0: 74 29 20 73 74 29 0a 20 20 20 20 20 20 20 20 20 t) st).
bfc0: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
bfd0: 20 69 20 31 29 20 66 72 6f 6d 20 66 6c 61 67 73 i 1) from flags
bfe0: 20 72 65 73 20 73 74 29 29 29 0a 20 20 20 20 20 res st))).
bff0: 20 20 20 20 20 20 20 20 20 28 28 23 5c 23 29 0a ((#\#).
c000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c010: 69 66 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c if (flag-set? fl
c020: 61 67 73 20 7e 69 67 6e 6f 72 65 2d 73 70 61 63 ags ~ignore-spac
c030: 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e?).
c040: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6a 20 (let ((j
c050: 28 6f 72 20 28 73 74 72 69 6e 67 2d 73 63 61 6e (or (string-scan
c060: 2d 63 68 61 72 20 73 74 72 20 23 5c 6e 65 77 6c -char str #\newl
c070: 69 6e 65 20 28 2b 20 69 20 31 29 29 0a 20 20 20 ine (+ i 1)).
c080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c090: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 (-
c0a0: 65 6e 64 20 31 29 29 29 29 0a 20 20 20 20 20 20 end 1)))).
c0b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c0c0: 6c 70 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 lp (+ j 1) (+ j
c0d0: 31 29 20 66 6c 61 67 73 20 28 63 6f 6c 6c 65 63 1) flags (collec
c0e0: 74 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 t) st)).
c0f0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
c100: 2b 20 69 20 31 29 20 66 72 6f 6d 20 66 6c 61 67 + i 1) from flag
c110: 73 20 72 65 73 20 73 74 29 29 29 0a 20 20 20 20 s res st))).
c120: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
c130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c140: 6c 70 20 28 2b 20 69 20 31 29 20 66 72 6f 6d 20 lp (+ i 1) from
c150: 66 6c 61 67 73 20 72 65 73 20 73 74 29 29 29 29 flags res st))))
c160: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 70 6f ))))..(define po
c170: 73 69 78 2d 65 73 63 61 70 65 2d 73 65 71 75 65 six-escape-seque
c180: 6e 63 65 73 0a 20 20 60 28 28 23 5c 6e 20 2e 20 nces. `((#\n .
c190: 23 5c 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 28 #\newline). (
c1a0: 23 5c 72 20 2e 20 2c 28 69 6e 74 65 67 65 72 2d #\r . ,(integer-
c1b0: 3e 63 68 61 72 20 28 2b 20 28 63 68 61 72 2d 3e >char (+ (char->
c1c0: 69 6e 74 65 67 65 72 20 23 5c 6e 65 77 6c 69 6e integer #\newlin
c1d0: 65 29 20 33 29 29 29 0a 20 20 20 20 28 23 5c 74 e) 3))). (#\t
c1e0: 20 2e 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 . ,(integer->ch
c1f0: 61 72 20 28 2d 20 28 63 68 61 72 2d 3e 69 6e 74 ar (- (char->int
c200: 65 67 65 72 20 23 5c 6e 65 77 6c 69 6e 65 29 20 eger #\newline)
c210: 31 29 29 29 0a 20 20 20 20 28 23 5c 61 20 2e 20 1))). (#\a .
c220: 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
c230: 28 2d 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 (- (char->intege
c240: 72 20 23 5c 6e 65 77 6c 69 6e 65 29 20 33 29 29 r #\newline) 3))
c250: 29 0a 20 20 20 20 28 23 5c 65 20 2e 20 2c 28 69 ). (#\e . ,(i
c260: 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 nteger->char (+
c270: 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 (char->integer #
c280: 5c 6e 65 77 6c 69 6e 65 29 20 23 78 31 31 29 29 \newline) #x11))
c290: 29 0a 20 20 20 20 28 23 5c 66 20 2e 20 2c 28 69 ). (#\f . ,(i
c2a0: 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 nteger->char (+
c2b0: 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 (char->integer #
c2c0: 5c 6e 65 77 6c 69 6e 65 29 20 32 29 29 29 0a 20 \newline) 2))).
c2d0: 20 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 ))..(define (
c2e0: 63 68 61 72 2d 61 6c 74 63 61 73 65 20 63 29 0a char-altcase c).
c2f0: 20 20 28 69 66 20 28 63 68 61 72 2d 75 70 70 65 (if (char-uppe
c300: 72 2d 63 61 73 65 3f 20 63 29 20 28 63 68 61 72 r-case? c) (char
c310: 2d 64 6f 77 6e 63 61 73 65 20 63 29 20 28 63 68 -downcase c) (ch
c320: 61 72 2d 75 70 63 61 73 65 20 63 29 29 29 0a 0a ar-upcase c)))..
c330: 28 64 65 66 69 6e 65 20 28 63 68 61 72 2d 6d 69 (define (char-mi
c340: 72 72 6f 72 20 63 29 0a 20 20 28 63 61 73 65 20 rror c). (case
c350: 63 20 28 28 23 5c 3c 29 20 23 5c 3e 29 20 28 28 c ((#\<) #\>) ((
c360: 23 5c 7b 29 20 23 5c 7d 29 20 28 28 23 5c 28 29 #\{) #\}) ((#\()
c370: 20 23 5c 29 29 20 28 28 23 5c 5b 29 20 23 5c 5d #\)) ((#\[) #\]
c380: 29 20 28 65 6c 73 65 20 63 29 29 29 0a 0a 28 64 ) (else c)))..(d
c390: 65 66 69 6e 65 20 28 73 74 72 69 6e 67 2d 70 61 efine (string-pa
c3a0: 72 73 65 2d 68 65 78 2d 65 73 63 61 70 65 20 73 rse-hex-escape s
c3b0: 74 72 20 69 20 65 6e 64 29 0a 20 20 28 63 6f 6e tr i end). (con
c3c0: 64 0a 20 20 20 28 28 3e 3d 20 69 20 65 6e 64 29 d. ((>= i end)
c3d0: 0a 20 20 20 20 28 65 72 72 6f 72 20 22 69 6e 63 . (error "inc
c3e0: 6f 6d 70 6c 65 74 65 20 68 65 78 20 65 73 63 61 omplete hex esca
c3f0: 70 65 22 20 73 74 72 20 69 29 29 0a 20 20 20 28 pe" str i)). (
c400: 28 65 71 76 3f 20 23 5c 7b 20 28 73 74 72 69 6e (eqv? #\{ (strin
c410: 67 2d 72 65 66 20 73 74 72 20 69 29 29 0a 20 20 g-ref str i)).
c420: 20 20 28 6c 65 74 20 28 28 6a 20 28 73 74 72 69 (let ((j (stri
c430: 6e 67 2d 73 63 61 6e 2d 63 68 61 72 2d 65 73 63 ng-scan-char-esc
c440: 61 70 65 20 73 74 72 20 23 5c 7d 20 28 2b 20 69 ape str #\} (+ i
c450: 20 31 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 1)))). (if
c460: 20 28 6e 6f 74 20 6a 29 0a 20 20 20 20 20 20 20 (not j).
c470: 20 20 20 28 65 72 72 6f 72 20 22 69 6e 63 6f 6d (error "incom
c480: 70 6c 65 74 65 20 68 65 78 20 62 72 61 63 65 20 plete hex brace
c490: 65 73 63 61 70 65 22 20 73 74 72 20 69 29 0a 20 escape" str i).
c4a0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
c4b0: 28 73 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 (s (substring st
c4c0: 72 20 28 2b 20 69 20 31 29 20 6a 29 29 0a 20 20 r (+ i 1) j)).
c4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c4e0: 6e 20 28 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 n (string->numbe
c4f0: 72 20 73 20 31 36 29 29 29 0a 20 20 20 20 20 20 r s 16))).
c500: 20 20 20 20 20 20 28 69 66 20 6e 0a 20 20 20 20 (if n.
c510: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
c520: 74 20 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 t (integer->char
c530: 20 6e 29 20 6a 29 0a 20 20 20 20 20 20 20 20 20 n) j).
c540: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 62 (error "b
c550: 61 64 20 68 65 78 20 62 72 61 63 65 20 65 73 63 ad hex brace esc
c560: 61 70 65 22 20 73 29 29 29 29 29 29 0a 20 20 20 ape" s)))))).
c570: 28 28 3e 3d 20 28 2b 20 69 20 31 29 20 65 6e 64 ((>= (+ i 1) end
c580: 29 0a 20 20 20 20 28 65 72 72 6f 72 20 22 69 6e ). (error "in
c590: 63 6f 6d 70 6c 65 74 65 20 68 65 78 20 65 73 63 complete hex esc
c5a0: 61 70 65 22 20 73 74 72 20 69 29 29 0a 20 20 20 ape" str i)).
c5b0: 28 65 6c 73 65 0a 20 20 20 20 28 6c 65 74 2a 20 (else. (let*
c5c0: 28 28 73 20 28 73 75 62 73 74 72 69 6e 67 20 73 ((s (substring s
c5d0: 74 72 20 69 20 28 2b 20 69 20 32 29 29 29 0a 20 tr i (+ i 2))).
c5e0: 20 20 20 20 20 20 20 20 20 20 28 6e 20 28 73 74 (n (st
c5f0: 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 20 31 ring->number s 1
c600: 36 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 6e 6))). (if n
c610: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 . (list
c620: 20 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 (integer->char
c630: 6e 29 20 28 2b 20 69 20 32 29 29 0a 20 20 20 20 n) (+ i 2)).
c640: 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 62 61 (error "ba
c650: 64 20 68 65 78 20 65 73 63 61 70 65 22 20 73 29 d hex escape" s)
c660: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
c670: 73 74 72 69 6e 67 2d 70 61 72 73 65 2d 63 73 65 string-parse-cse
c680: 74 20 73 74 72 20 73 74 61 72 74 20 66 6c 61 67 t str start flag
c690: 73 29 0a 20 20 28 6c 65 74 2a 20 28 28 65 6e 64 s). (let* ((end
c6a0: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
c6b0: 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 28 str)). (
c6c0: 69 6e 76 65 72 74 3f 20 28 61 6e 64 20 28 3c 20 invert? (and (<
c6d0: 73 74 61 72 74 20 65 6e 64 29 20 28 65 71 76 3f start end) (eqv?
c6e0: 20 23 5c 5e 20 28 73 74 72 69 6e 67 2d 72 65 66 #\^ (string-ref
c6f0: 20 73 74 72 20 73 74 61 72 74 29 29 29 29 0a 20 str start)))).
c700: 20 20 20 20 20 20 20 20 28 75 74 66 38 3f 20 28 (utf8? (
c710: 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 flag-set? flags
c720: 7e 75 74 66 38 3f 29 29 29 0a 20 20 20 20 28 64 ~utf8?))). (d
c730: 65 66 69 6e 65 20 28 67 6f 20 69 20 70 72 65 76 efine (go i prev
c740: 2d 63 68 61 72 20 63 73 65 74 29 0a 20 20 20 20 -char cset).
c750: 20 20 28 69 66 20 28 3e 3d 20 69 20 65 6e 64 29 (if (>= i end)
c760: 0a 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f . (erro
c770: 72 20 22 69 6e 63 6f 6d 70 6c 65 74 65 20 63 68 r "incomplete ch
c780: 61 72 20 73 65 74 22 20 73 74 72 20 69 20 65 6e ar set" str i en
c790: 64 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 d). (le
c7a0: 74 20 28 28 63 20 28 73 74 72 69 6e 67 2d 72 65 t ((c (string-re
c7b0: 66 20 73 74 72 20 69 29 29 29 0a 20 20 20 20 20 f str i))).
c7c0: 20 20 20 20 20 20 20 28 63 61 73 65 20 63 0a 20 (case c.
c7d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 ((#
c7e0: 5c 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 \]).
c7f0: 20 20 20 28 69 66 20 28 63 73 65 74 2d 65 6d 70 (if (cset-emp
c800: 74 79 3f 20 63 73 65 74 29 0a 20 20 20 20 20 20 ty? cset).
c810: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 6f (go
c820: 20 28 2b 20 69 20 31 29 20 23 5c 5d 20 28 63 73 (+ i 1) #\] (cs
c830: 65 74 2d 61 64 6a 6f 69 6e 20 63 73 65 74 20 23 et-adjoin cset #
c840: 5c 5d 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 \])).
c850: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 (let ((c
c860: 69 3f 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c i? (flag-set? fl
c870: 61 67 73 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 ags ~case-insens
c880: 69 74 69 76 65 3f 29 29 29 0a 20 20 20 20 20 20 itive?))).
c890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c8a0: 6c 69 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 list.
c8b0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
c8c0: 28 28 72 65 73 20 28 69 66 20 63 69 3f 20 28 63 ((res (if ci? (c
c8d0: 73 65 74 2d 63 61 73 65 2d 69 6e 73 65 6e 73 69 set-case-insensi
c8e0: 74 69 76 65 20 63 73 65 74 29 20 63 73 65 74 29 tive cset) cset)
c8f0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
c900: 20 20 20 20 20 20 20 20 20 20 20 28 63 73 65 74 (cset
c910: 2d 3e 73 72 65 20 28 69 66 20 69 6e 76 65 72 74 ->sre (if invert
c920: 3f 20 28 63 73 65 74 2d 63 6f 6d 70 6c 65 6d 65 ? (cset-compleme
c930: 6e 74 20 72 65 73 29 20 72 65 73 29 29 29 0a 20 nt res) res))).
c940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c950: 20 20 20 20 20 69 29 29 29 29 0a 20 20 20 20 20 i)))).
c960: 20 20 20 20 20 20 20 20 20 28 28 23 5c 2d 29 0a ((#\-).
c970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c980: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
c990: 20 20 20 20 20 28 28 6f 72 20 28 3d 20 69 20 73 ((or (= i s
c9a0: 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 20 20 tart).
c9b0: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
c9c0: 28 3d 20 69 20 28 2b 20 73 74 61 72 74 20 31 29 (= i (+ start 1)
c9d0: 29 20 28 65 71 76 3f 20 23 5c 5e 20 28 73 74 72 ) (eqv? #\^ (str
c9e0: 69 6e 67 2d 72 65 66 20 73 74 72 20 73 74 61 72 ing-ref str star
c9f0: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
ca00: 20 20 20 20 20 20 20 20 20 20 28 65 71 76 3f 20 (eqv?
ca10: 23 5c 5d 20 28 73 74 72 69 6e 67 2d 72 65 66 20 #\] (string-ref
ca20: 73 74 72 20 28 2b 20 69 20 31 29 29 29 29 0a 20 str (+ i 1)))).
ca30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ca40: 28 67 6f 20 28 2b 20 69 20 31 29 20 63 20 28 63 (go (+ i 1) c (c
ca50: 73 65 74 2d 61 64 6a 6f 69 6e 20 63 73 65 74 20 set-adjoin cset
ca60: 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 c))).
ca70: 20 20 20 20 20 28 28 6e 6f 74 20 70 72 65 76 2d ((not prev-
ca80: 63 68 61 72 29 0a 20 20 20 20 20 20 20 20 20 20 char).
ca90: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 62 (error "b
caa0: 61 64 20 63 68 61 72 2d 73 65 74 22 29 29 0a 20 ad char-set")).
cab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
cac0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
cad0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 68 61 (let ((cha
cae0: 72 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 r (string-ref st
caf0: 72 20 28 2b 20 69 20 31 29 29 29 29 0a 20 20 20 r (+ i 1)))).
cb00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cb10: 28 61 70 70 6c 79 0a 20 20 20 20 20 20 20 20 20 (apply.
cb20: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
cb30: 64 61 20 28 63 20 6a 29 0a 20 20 20 20 20 20 20 da (c j).
cb40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
cb50: 69 66 20 28 63 68 61 72 3c 3f 20 63 20 70 72 65 if (char<? c pre
cb60: 76 2d 63 68 61 72 29 0a 20 20 20 20 20 20 20 20 v-char).
cb70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cb80: 20 20 28 65 72 72 6f 72 20 22 69 6e 76 65 72 74 (error "invert
cb90: 65 64 20 72 61 6e 67 65 20 69 6e 20 63 68 61 72 ed range in char
cba0: 2d 73 65 74 22 20 70 72 65 76 2d 63 68 61 72 20 -set" prev-char
cbb0: 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c).
cbc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 6f (go
cbd0: 20 6a 20 23 66 20 28 63 73 65 74 2d 75 6e 69 6f j #f (cset-unio
cbe0: 6e 20 63 73 65 74 20 28 72 61 6e 67 65 2d 3e 63 n cset (range->c
cbf0: 73 65 74 20 70 72 65 76 2d 63 68 61 72 20 63 29 set prev-char c)
cc00: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
cc10: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
cc20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cc30: 20 20 20 20 28 28 61 6e 64 20 28 65 71 76 3f 20 ((and (eqv?
cc40: 23 5c 5c 20 63 68 61 72 29 20 28 61 73 73 76 20 #\\ char) (assv
cc50: 63 68 61 72 20 70 6f 73 69 78 2d 65 73 63 61 70 char posix-escap
cc60: 65 2d 73 65 71 75 65 6e 63 65 73 29 29 0a 20 20 e-sequences)).
cc70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cc80: 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 28 => (lambda (
cc90: 78 29 20 28 6c 69 73 74 20 28 63 64 72 20 78 29 x) (list (cdr x)
cca0: 20 28 2b 20 69 20 33 29 29 29 29 0a 20 20 20 20 (+ i 3)))).
ccb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ccc0: 20 28 28 61 6e 64 20 28 65 71 76 3f 20 23 5c 5c ((and (eqv? #\\
ccd0: 20 63 68 61 72 29 0a 20 20 20 20 20 20 20 20 20 char).
cce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ccf0: 20 20 28 65 71 76 3f 20 28 73 74 72 69 6e 67 2d (eqv? (string-
cd00: 72 65 66 20 73 74 72 20 28 2b 20 69 20 32 29 29 ref str (+ i 2))
cd10: 20 23 5c 78 29 29 0a 20 20 20 20 20 20 20 20 20 #\x)).
cd20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
cd30: 72 69 6e 67 2d 70 61 72 73 65 2d 68 65 78 2d 65 ring-parse-hex-e
cd40: 73 63 61 70 65 20 73 74 72 20 28 2b 20 69 20 33 scape str (+ i 3
cd50: 29 20 65 6e 64 29 29 0a 20 20 20 20 20 20 20 20 ) end)).
cd60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 ((a
cd70: 6e 64 20 75 74 66 38 3f 20 28 3c 3d 20 23 78 38 nd utf8? (<= #x8
cd80: 30 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 0 (char->integer
cd90: 20 63 68 61 72 29 20 23 78 46 46 29 29 0a 20 20 char) #xFF)).
cda0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cdb0: 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e 20 28 (let ((len (
cdc0: 75 74 66 38 2d 73 74 61 72 74 2d 63 68 61 72 2d utf8-start-char-
cdd0: 3e 6c 65 6e 67 74 68 20 63 68 61 72 29 29 29 0a >length char))).
cde0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cdf0: 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 75 (list (u
ce00: 74 66 38 2d 73 74 72 69 6e 67 2d 72 65 66 20 73 tf8-string-ref s
ce10: 74 72 20 28 2b 20 69 20 31 29 20 6c 65 6e 29 20 tr (+ i 1) len)
ce20: 28 2b 20 69 20 31 20 6c 65 6e 29 29 29 29 0a 20 (+ i 1 len)))).
ce30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ce40: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
ce50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ce60: 28 6c 69 73 74 20 63 68 61 72 20 28 2b 20 69 20 (list char (+ i
ce70: 32 29 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 2))))))))).
ce80: 20 20 20 20 20 20 20 20 20 28 28 23 5c 5b 29 0a ((#\[).
ce90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
cea0: 6c 65 74 2a 20 28 28 69 6e 76 3f 20 28 65 71 76 let* ((inv? (eqv
ceb0: 3f 20 23 5c 5e 20 28 73 74 72 69 6e 67 2d 72 65 ? #\^ (string-re
cec0: 66 20 73 74 72 20 28 2b 20 69 20 31 29 29 29 29 f str (+ i 1))))
ced0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
cee0: 20 20 20 20 20 20 20 28 69 32 20 28 69 66 20 69 (i2 (if i
cef0: 6e 76 3f 20 28 2b 20 69 20 32 29 20 28 2b 20 69 nv? (+ i 2) (+ i
cf00: 20 31 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 1)))).
cf10: 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 73 (case (s
cf20: 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 32 tring-ref str i2
cf30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
cf40: 20 20 20 20 20 28 28 23 5c 3a 29 0a 20 20 20 20 ((#\:).
cf50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cf60: 28 6c 65 74 20 28 28 6a 20 28 73 74 72 69 6e 67 (let ((j (string
cf70: 2d 73 63 61 6e 2d 63 68 61 72 20 73 74 72 20 23 -scan-char str #
cf80: 5c 3a 20 28 2b 20 69 32 20 31 29 29 29 29 0a 20 \: (+ i2 1)))).
cf90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cfa0: 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 6e 6f (if (or (no
cfb0: 74 20 6a 29 20 28 6e 6f 74 20 28 65 71 76 3f 20 t j) (not (eqv?
cfc0: 23 5c 5d 20 28 73 74 72 69 6e 67 2d 72 65 66 20 #\] (string-ref
cfd0: 73 74 72 20 28 2b 20 6a 20 31 29 29 29 29 29 0a str (+ j 1))))).
cfe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cff0: 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
d000: 20 22 69 6e 63 6f 6d 70 6c 65 74 65 20 63 68 61 "incomplete cha
d010: 72 61 63 74 65 72 20 63 6c 61 73 73 22 20 73 74 racter class" st
d020: 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
d030: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
d040: 74 2a 20 28 28 63 6c 61 73 73 20 28 73 72 65 2d t* ((class (sre-
d050: 3e 63 73 65 74 0a 20 20 20 20 20 20 20 20 20 20 >cset.
d060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
d080: 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f 6c 0a 20 string->symbol.
d090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d0a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d0b0: 20 20 20 20 20 20 20 20 20 28 73 75 62 73 74 72 (substr
d0c0: 69 6e 67 20 73 74 72 20 28 2b 20 69 32 20 31 29 ing str (+ i2 1)
d0d0: 20 6a 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 j)))).
d0e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d0f0: 20 20 20 20 20 20 20 20 28 63 6c 61 73 73 20 28 (class (
d100: 69 66 20 69 6e 76 3f 20 28 63 73 65 74 2d 63 6f if inv? (cset-co
d110: 6d 70 6c 65 6d 65 6e 74 20 63 6c 61 73 73 29 20 mplement class)
d120: 63 6c 61 73 73 29 29 29 0a 20 20 20 20 20 20 20 class))).
d130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d140: 20 20 20 20 20 28 67 6f 20 28 2b 20 6a 20 32 29 (go (+ j 2)
d150: 20 23 66 20 28 63 73 65 74 2d 75 6e 69 6f 6e 20 #f (cset-union
d160: 63 73 65 74 20 63 6c 61 73 73 29 29 29 29 29 29 cset class))))))
d170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d180: 20 20 20 20 28 28 23 5c 3d 20 23 5c 2e 29 0a 20 ((#\= #\.).
d190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d1a0: 20 20 20 28 65 72 72 6f 72 20 22 63 6f 6c 6c 61 (error "colla
d1b0: 74 69 6e 67 20 73 65 71 75 65 6e 63 65 73 20 6e ting sequences n
d1c0: 6f 74 20 73 75 70 70 6f 72 74 65 64 22 20 73 74 ot supported" st
d1d0: 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r)).
d1e0: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
d1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d200: 20 28 67 6f 20 28 2b 20 69 20 31 29 20 23 5c 5b (go (+ i 1) #\[
d210: 20 28 63 73 65 74 2d 61 64 6a 6f 69 6e 20 63 73 (cset-adjoin cs
d220: 65 74 20 23 5c 5b 29 29 29 29 29 29 0a 20 20 20 et #\[)))))).
d230: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 5c ((#\\
d240: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
d250: 20 28 6c 65 74 20 28 28 63 20 28 73 74 72 69 6e (let ((c (strin
d260: 67 2d 72 65 66 20 73 74 72 20 28 2b 20 69 20 31 g-ref str (+ i 1
d270: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
d280: 20 20 20 20 20 20 28 63 61 73 65 20 63 0a 20 20 (case c.
d290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2a0: 20 28 28 23 5c 64 20 23 5c 44 20 23 5c 73 20 23 ((#\d #\D #\s #
d2b0: 5c 53 20 23 5c 77 20 23 5c 57 29 0a 20 20 20 20 \S #\w #\W).
d2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2d0: 28 67 6f 20 28 2b 20 69 20 32 29 20 23 66 0a 20 (go (+ i 2) #f.
d2e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d2f0: 20 20 20 20 20 20 20 28 63 73 65 74 2d 75 6e 69 (cset-uni
d300: 6f 6e 20 63 73 65 74 0a 20 20 20 20 20 20 20 20 on cset.
d310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d320: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 65 (sre
d330: 2d 3e 63 73 65 74 20 28 73 74 72 69 6e 67 2d 3e ->cset (string->
d340: 73 72 65 20 28 73 74 72 69 6e 67 20 23 5c 5c 20 sre (string #\\
d350: 63 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 c)))))).
d360: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 78 ((#\x
d370: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
d380: 20 20 20 20 20 20 28 61 70 70 6c 79 0a 20 20 20 (apply.
d390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d3a0: 20 20 28 6c 61 6d 62 64 61 20 28 63 68 20 6a 29 (lambda (ch j)
d3b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d3c0: 20 20 20 20 20 20 20 20 28 67 6f 20 6a 20 63 68 (go j ch
d3d0: 20 28 63 73 65 74 2d 61 64 6a 6f 69 6e 20 63 73 (cset-adjoin cs
d3e0: 65 74 20 63 68 29 29 29 0a 20 20 20 20 20 20 20 et ch))).
d3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
d400: 74 72 69 6e 67 2d 70 61 72 73 65 2d 68 65 78 2d tring-parse-hex-
d410: 65 73 63 61 70 65 20 73 74 72 20 28 2b 20 69 20 escape str (+ i
d420: 32 29 20 65 6e 64 29 29 29 0a 20 20 20 20 20 20 2) end))).
d430: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
d440: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
d450: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 20 (let ((c
d460: 28 63 6f 6e 64 20 28 28 61 73 73 76 20 63 20 70 (cond ((assv c p
d470: 6f 73 69 78 2d 65 73 63 61 70 65 2d 73 65 71 75 osix-escape-sequ
d480: 65 6e 63 65 73 29 20 3d 3e 20 63 64 72 29 0a 20 ences) => cdr).
d490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d4a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d4b0: 20 20 28 65 6c 73 65 20 63 29 29 29 29 0a 20 20 (else c)))).
d4c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d4d0: 20 20 20 20 28 67 6f 20 28 2b 20 69 20 32 29 20 (go (+ i 2)
d4e0: 63 20 28 63 73 65 74 2d 61 64 6a 6f 69 6e 20 63 c (cset-adjoin c
d4f0: 73 65 74 20 63 29 29 29 29 29 29 29 0a 20 20 20 set c))))))).
d500: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
d510: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d520: 28 69 66 20 28 61 6e 64 20 75 74 66 38 3f 20 28 (if (and utf8? (
d530: 3c 3d 20 23 78 38 30 20 28 63 68 61 72 2d 3e 69 <= #x80 (char->i
d540: 6e 74 65 67 65 72 20 63 29 20 23 78 46 46 29 29 nteger c) #xFF))
d550: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d560: 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e 20 28 (let ((len (
d570: 75 74 66 38 2d 73 74 61 72 74 2d 63 68 61 72 2d utf8-start-char-
d580: 3e 6c 65 6e 67 74 68 20 63 29 29 29 0a 20 20 20 >length c))).
d590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d5a0: 20 20 28 67 6f 20 28 2b 20 69 20 6c 65 6e 29 0a (go (+ i len).
d5b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d5c0: 20 20 20 20 20 20 20 20 20 28 75 74 66 38 2d 73 (utf8-s
d5d0: 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 20 tring-ref str i
d5e0: 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 len).
d5f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
d600: 73 65 74 2d 61 64 6a 6f 69 6e 20 63 73 65 74 20 set-adjoin cset
d610: 28 75 74 66 38 2d 73 74 72 69 6e 67 2d 72 65 66 (utf8-string-ref
d620: 20 73 74 72 20 69 20 6c 65 6e 29 29 29 29 0a 20 str i len)))).
d630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d640: 20 20 28 67 6f 20 28 2b 20 69 20 31 29 20 63 20 (go (+ i 1) c
d650: 28 63 73 65 74 2d 61 64 6a 6f 69 6e 20 63 73 65 (cset-adjoin cse
d660: 74 20 63 29 29 29 29 29 29 29 29 0a 20 20 20 20 t c)))))))).
d670: 28 69 66 20 69 6e 76 65 72 74 3f 0a 20 20 20 20 (if invert?.
d680: 20 20 20 20 28 67 6f 20 28 2b 20 73 74 61 72 74 (go (+ start
d690: 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 1).
d6a0: 23 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 #f. (
d6b0: 69 66 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c if (flag-set? fl
d6c0: 61 67 73 20 7e 6d 75 6c 74 69 2d 6c 69 6e 65 3f ags ~multi-line?
d6d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
d6e0: 20 20 28 63 68 61 72 2d 3e 63 73 65 74 20 23 5c (char->cset #\
d6f0: 6e 65 77 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 newline).
d700: 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d 63 (make-c
d710: 73 65 74 29 29 29 0a 20 20 20 20 20 20 20 20 28 set))). (
d720: 67 6f 20 73 74 61 72 74 20 23 66 20 28 6d 61 6b go start #f (mak
d730: 65 2d 63 73 65 74 29 29 29 29 29 0a 0a 3b 3b 3b e-cset)))))..;;;
d740: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d750: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d760: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d770: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d780: 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 55 54 46 2d 38 ;;;;;.;;;; UTF-8
d790: 20 55 74 69 6c 69 74 69 65 73 0a 0a 3b 3b 20 48 Utilities..;; H
d7a0: 65 72 65 20 61 72 65 20 73 6f 6d 65 20 68 61 69 ere are some hai
d7b0: 72 79 20 6f 70 74 69 6d 69 7a 61 74 69 6f 6e 73 ry optimizations
d7c0: 20 74 68 61 74 20 6e 65 65 64 20 74 6f 20 62 65 that need to be
d7d0: 20 64 6f 63 75 6d 65 6e 74 65 64 0a 3b 3b 20 62 documented.;; b
d7e0: 65 74 74 65 72 2e 20 20 54 68 61 6e 6b 73 20 74 etter. Thanks t
d7f0: 6f 20 74 68 65 73 65 2c 20 77 65 20 6e 65 76 65 o these, we neve
d800: 72 20 64 6f 20 61 6e 79 20 75 74 66 38 20 70 72 r do any utf8 pr
d810: 6f 63 65 73 73 69 6e 67 20 6f 6e 63 65 20 74 68 ocessing once th
d820: 65 0a 3b 3b 20 72 65 67 65 78 70 20 69 73 20 63 e.;; regexp is c
d830: 6f 6d 70 69 6c 65 64 2e 0a 0a 3b 3b 20 74 77 6f ompiled...;; two
d840: 20 63 68 61 72 73 3a 20 61 62 2e 2e 65 66 0a 3b chars: ab..ef.;
d850: 3b 20 20 20 20 20 20 20 20 20 20 20 20 61 5b 62 ; a[b
d860: 2e 2e 78 46 46 5d 7c 5b 62 2d 64 5d 5b 78 38 30 ..xFF]|[b-d][x80
d870: 2e 2e 78 46 46 5d 7c 65 5b 78 38 30 2e 2e 78 46 ..xFF]|e[x80..xF
d880: 46 5d 0a 0a 3b 3b 20 74 68 72 65 65 20 63 68 61 F]..;; three cha
d890: 72 73 3a 20 61 62 63 2e 2e 67 68 69 0a 3b 3b 20 rs: abc..ghi.;;
d8a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 62 5b ab[
d8b0: 63 2e 2e 78 46 46 5d 7c 61 5b 64 2e 2e 78 46 46 c..xFF]|a[d..xFF
d8c0: 5d 5b 78 38 30 2e 2e 78 46 46 5d 7c 0a 3b 3b 20 ][x80..xFF]|.;;
d8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 62 2e [b.
d8e0: 2e 66 5d 5b 78 38 30 2e 2e 78 46 46 5d 5b 78 38 .f][x80..xFF][x8
d8f0: 30 2e 2e 78 46 46 5d 7c 0a 3b 3b 20 20 20 20 20 0..xFF]|.;;
d900: 20 20 20 20 20 20 20 20 20 67 5b 78 38 30 2e 2e g[x80..
d910: 67 5d 5b 78 38 30 2e 2e 78 46 46 5d 7c 67 68 5b g][x80..xFF]|gh[
d920: 78 38 30 2e 2e 69 5d 0a 0a 3b 3b 20 66 6f 75 72 x80..i]..;; four
d930: 20 63 68 61 72 73 3a 20 61 62 63 64 2e 2e 67 68 chars: abcd..gh
d940: 69 6a 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ij.;;
d950: 20 20 61 62 63 5b 64 2e 2e 78 46 46 5d 7c 61 62 abc[d..xFF]|ab
d960: 5b 64 2e 2e 78 46 46 5d 5b 78 38 30 2e 2e 78 46 [d..xFF][x80..xF
d970: 46 5d 7c 61 5b 63 2e 2e 78 46 46 5d 5b 78 38 30 F]|a[c..xFF][x80
d980: 2e 2e 78 46 46 5d 5b 78 38 30 2e 2e 78 46 46 5d ..xFF][x80..xFF]
d990: 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 |.;;
d9a0: 20 5b 62 2e 2e 66 5d 5b 78 38 30 2e 2e 78 46 46 [b..f][x80..xFF
d9b0: 5d 5b 78 38 30 2e 2e 78 46 46 5d 5b 78 38 30 2e ][x80..xFF][x80.
d9c0: 2e 78 46 46 5d 7c 0a 3b 3b 20 20 20 20 20 20 20 .xFF]|.;;
d9d0: 20 20 20 20 20 20 67 5b 78 38 30 2e 2e 67 5d 5b g[x80..g][
d9e0: 78 38 30 2e 2e 78 46 46 5d 5b 78 38 30 2e 2e 78 x80..xFF][x80..x
d9f0: 46 46 5d 7c 67 68 5b 78 38 30 2e 2e 68 5d 5b 78 FF]|gh[x80..h][x
da00: 38 30 2e 2e 78 46 46 5d 7c 67 68 69 5b 78 38 30 80..xFF]|ghi[x80
da10: 2e 2e 6a 5d 0a 0a 28 64 65 66 69 6e 65 20 28 68 ..j]..(define (h
da20: 69 67 68 2d 63 68 61 72 3f 20 63 29 20 28 3c 3d igh-char? c) (<=
da30: 20 23 78 38 30 20 28 63 68 61 72 2d 3e 69 6e 74 #x80 (char->int
da40: 65 67 65 72 20 63 29 29 29 0a 0a 3b 3b 20 6e 75 eger c)))..;; nu
da50: 6d 62 65 72 20 6f 66 20 74 6f 74 61 6c 20 62 79 mber of total by
da60: 74 65 73 20 69 6e 20 61 20 75 74 66 38 20 63 68 tes in a utf8 ch
da70: 61 72 20 67 69 76 65 6e 20 74 68 65 20 31 73 74 ar given the 1st
da80: 20 62 79 74 65 0a 0a 28 64 65 66 69 6e 65 20 75 byte..(define u
da90: 74 66 38 2d 73 74 61 72 74 2d 63 68 61 72 2d 3e tf8-start-char->
daa0: 6c 65 6e 67 74 68 0a 20 20 28 6c 65 74 20 28 28 length. (let ((
dab0: 74 61 62 6c 65 20 27 23 28 0a 31 20 31 20 31 20 table '#(.1 1 1
dac0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
dad0: 31 20 31 20 31 20 31 20 31 20 3b 20 30 78 0a 31 1 1 1 1 1 ; 0x.1
dae0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
daf0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 3b 1 1 1 1 1 1 1 ;
db00: 20 31 78 0a 31 20 31 20 31 20 31 20 31 20 31 20 1x.1 1 1 1 1 1
db10: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
db20: 31 20 31 20 3b 20 32 78 0a 31 20 31 20 31 20 31 1 1 ; 2x.1 1 1 1
db30: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
db40: 20 31 20 31 20 31 20 31 20 3b 20 33 78 0a 31 20 1 1 1 1 ; 3x.1
db50: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
db60: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 3b 20 1 1 1 1 1 1 1 ;
db70: 34 78 0a 31 20 31 20 31 20 31 20 31 20 31 20 31 4x.1 1 1 1 1 1 1
db80: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
db90: 20 31 20 3b 20 35 78 0a 31 20 31 20 31 20 31 20 1 ; 5x.1 1 1 1
dba0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
dbb0: 31 20 31 20 31 20 31 20 3b 20 36 78 0a 31 20 31 1 1 1 1 ; 6x.1 1
dbc0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
dbd0: 20 31 20 31 20 31 20 31 20 31 20 31 20 3b 20 37 1 1 1 1 1 1 ; 7
dbe0: 78 0a 31 20 31 20 31 20 31 20 31 20 31 20 31 20 x.1 1 1 1 1 1 1
dbf0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
dc00: 31 20 3b 20 38 78 0a 31 20 31 20 31 20 31 20 31 1 ; 8x.1 1 1 1 1
dc10: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
dc20: 20 31 20 31 20 31 20 3b 20 39 78 0a 31 20 31 20 1 1 1 ; 9x.1 1
dc30: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
dc40: 31 20 31 20 31 20 31 20 31 20 31 20 3b 20 61 78 1 1 1 1 1 1 ; ax
dc50: 0a 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 .1 1 1 1 1 1 1 1
dc60: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
dc70: 20 3b 20 62 78 0a 32 20 32 20 32 20 32 20 32 20 ; bx.2 2 2 2 2
dc80: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
dc90: 32 20 32 20 32 20 3b 20 63 78 0a 32 20 32 20 32 2 2 2 ; cx.2 2 2
dca0: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
dcb0: 20 32 20 32 20 32 20 32 20 32 20 3b 20 64 78 0a 2 2 2 2 2 ; dx.
dcc0: 33 20 33 20 33 20 33 20 33 20 33 20 33 20 33 20 3 3 3 3 3 3 3 3
dcd0: 33 20 33 20 33 20 33 20 33 20 33 20 33 20 33 20 3 3 3 3 3 3 3 3
dce0: 3b 20 65 78 0a 34 20 34 20 34 20 34 20 34 20 34 ; ex.4 4 4 4 4 4
dcf0: 20 34 20 34 20 35 20 35 20 35 20 35 20 36 20 36 4 4 5 5 5 5 6 6
dd00: 20 30 20 30 20 3b 20 66 78 0a 29 29 29 0a 20 20 0 0 ; fx.))).
dd10: 20 20 28 6c 61 6d 62 64 61 20 28 63 29 20 28 76 (lambda (c) (v
dd20: 65 63 74 6f 72 2d 72 65 66 20 74 61 62 6c 65 20 ector-ref table
dd30: 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 63 (char->integer c
dd40: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
dd50: 75 74 66 38 2d 73 74 72 69 6e 67 2d 72 65 66 20 utf8-string-ref
dd60: 73 74 72 20 69 20 6c 65 6e 29 0a 20 20 28 64 65 str i len). (de
dd70: 66 69 6e 65 20 28 62 79 74 65 20 6e 29 20 28 63 fine (byte n) (c
dd80: 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 28 73 74 har->integer (st
dd90: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 6e 29 29 ring-ref str n))
dda0: 29 0a 20 20 28 63 61 73 65 20 6c 65 6e 0a 20 20 ). (case len.
ddb0: 20 20 28 28 31 29 20 3b 20 73 68 6f 75 6c 64 6e ((1) ; shouldn
ddc0: 27 74 20 68 61 70 70 65 6e 20 69 6e 20 74 68 69 't happen in thi
ddd0: 73 20 6d 6f 64 75 6c 65 0a 20 20 20 20 20 28 73 s module. (s
dde0: 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 tring-ref str i)
ddf0: 29 0a 20 20 20 20 28 28 32 29 0a 20 20 20 20 20 ). ((2).
de00: 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 0a 20 (integer->char.
de10: 20 20 20 20 20 28 2b 20 28 62 69 74 2d 73 68 6c (+ (bit-shl
de20: 20 28 62 69 74 2d 61 6e 64 20 28 62 79 74 65 20 (bit-and (byte
de30: 69 29 20 23 62 30 30 30 31 31 31 31 31 29 20 36 i) #b00011111) 6
de40: 29 0a 20 20 20 20 20 20 20 20 20 28 62 69 74 2d ). (bit-
de50: 61 6e 64 20 28 62 79 74 65 20 28 2b 20 69 20 31 and (byte (+ i 1
de60: 29 29 20 23 62 30 30 31 31 31 31 31 31 29 29 29 )) #b00111111)))
de70: 29 0a 20 20 20 20 28 28 33 29 0a 20 20 20 20 20 ). ((3).
de80: 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 0a 20 (integer->char.
de90: 20 20 20 20 20 28 2b 20 28 62 69 74 2d 73 68 6c (+ (bit-shl
dea0: 20 28 62 69 74 2d 61 6e 64 20 28 62 79 74 65 20 (bit-and (byte
deb0: 69 29 20 23 62 30 30 30 30 31 31 31 31 29 20 31 i) #b00001111) 1
dec0: 32 29 0a 20 20 20 20 20 20 20 20 20 28 62 69 74 2). (bit
ded0: 2d 73 68 6c 20 28 62 69 74 2d 61 6e 64 20 28 62 -shl (bit-and (b
dee0: 79 74 65 20 28 2b 20 69 20 31 29 29 20 23 62 30 yte (+ i 1)) #b0
def0: 30 31 31 31 31 31 31 29 20 36 29 0a 20 20 20 20 0111111) 6).
df00: 20 20 20 20 20 28 62 69 74 2d 61 6e 64 20 28 62 (bit-and (b
df10: 79 74 65 20 28 2b 20 69 20 32 29 29 20 23 62 30 yte (+ i 2)) #b0
df20: 30 31 31 31 31 31 31 29 29 29 29 0a 20 20 20 20 0111111)))).
df30: 28 28 34 29 0a 20 20 20 20 20 28 69 6e 74 65 67 ((4). (integ
df40: 65 72 2d 3e 63 68 61 72 0a 20 20 20 20 20 20 28 er->char. (
df50: 2b 20 28 62 69 74 2d 73 68 6c 20 28 62 69 74 2d + (bit-shl (bit-
df60: 61 6e 64 20 28 62 79 74 65 20 69 29 20 23 62 30 and (byte i) #b0
df70: 30 30 30 30 31 31 31 29 20 31 38 29 0a 20 20 20 0000111) 18).
df80: 20 20 20 20 20 20 28 62 69 74 2d 73 68 6c 20 28 (bit-shl (
df90: 62 69 74 2d 61 6e 64 20 28 62 79 74 65 20 28 2b bit-and (byte (+
dfa0: 20 69 20 31 29 29 20 23 62 30 30 31 31 31 31 31 i 1)) #b0011111
dfb0: 31 29 20 31 32 29 0a 20 20 20 20 20 20 20 20 20 1) 12).
dfc0: 28 62 69 74 2d 73 68 6c 20 28 62 69 74 2d 61 6e (bit-shl (bit-an
dfd0: 64 20 28 62 79 74 65 20 28 2b 20 69 20 32 29 29 d (byte (+ i 2))
dfe0: 20 23 62 30 30 31 31 31 31 31 31 29 20 36 29 0a #b00111111) 6).
dff0: 20 20 20 20 20 20 20 20 20 28 62 69 74 2d 61 6e (bit-an
e000: 64 20 28 62 79 74 65 20 28 2b 20 69 20 33 29 29 d (byte (+ i 3))
e010: 20 23 62 30 30 31 31 31 31 31 31 29 29 29 29 0a #b00111111)))).
e020: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 28 (else. (
e030: 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 64 20 75 error "invalid u
e040: 74 66 38 20 6c 65 6e 67 74 68 22 20 73 74 72 20 tf8 length" str
e050: 6c 65 6e 20 69 29 29 29 29 0a 0a 28 64 65 66 69 len i))))..(defi
e060: 6e 65 20 28 75 74 66 38 2d 62 61 63 6b 75 70 2d ne (utf8-backup-
e070: 74 6f 2d 69 6e 69 74 69 61 6c 2d 63 68 61 72 20 to-initial-char
e080: 73 74 72 20 69 29 0a 20 20 28 6c 65 74 20 6c 70 str i). (let lp
e090: 20 28 28 69 20 69 29 29 0a 20 20 20 20 28 69 66 ((i i)). (if
e0a0: 20 28 3d 20 69 20 30 29 0a 20 20 20 20 20 20 20 (= i 0).
e0b0: 20 30 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 0. (let
e0c0: 28 28 63 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 ((c (char->integ
e0d0: 65 72 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 er (string-ref s
e0e0: 74 72 20 69 29 29 29 29 0a 20 20 20 20 20 20 20 tr i)))).
e0f0: 20 20 20 28 69 66 20 28 6f 72 20 28 3c 20 63 20 (if (or (< c
e100: 23 78 38 30 29 20 28 3e 3d 20 63 20 23 78 43 30 #x80) (>= c #xC0
e110: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
e120: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
e130: 20 28 6c 70 20 28 2d 20 69 20 31 29 29 29 29 29 (lp (- i 1)))))
e140: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 74 66 ))..(define (utf
e150: 38 2d 6c 6f 77 65 73 74 2d 64 69 67 69 74 2d 6f 8-lowest-digit-o
e160: 66 2d 6c 65 6e 67 74 68 20 6c 65 6e 29 0a 20 20 f-length len).
e170: 28 63 61 73 65 20 6c 65 6e 0a 20 20 20 20 28 28 (case len. ((
e180: 31 29 20 30 29 20 28 28 32 29 20 23 78 43 30 29 1) 0) ((2) #xC0)
e190: 20 28 28 33 29 20 23 78 45 30 29 20 28 28 34 29 ((3) #xE0) ((4)
e1a0: 20 23 78 46 30 29 0a 20 20 20 20 28 65 6c 73 65 #xF0). (else
e1b0: 20 28 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 64 (error "invalid
e1c0: 20 75 74 66 38 20 6c 65 6e 67 74 68 22 20 6c 65 utf8 length" le
e1d0: 6e 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 n))))..(define (
e1e0: 75 74 66 38 2d 68 69 67 68 65 73 74 2d 64 69 67 utf8-highest-dig
e1f0: 69 74 2d 6f 66 2d 6c 65 6e 67 74 68 20 6c 65 6e it-of-length len
e200: 29 0a 20 20 28 63 61 73 65 20 6c 65 6e 0a 20 20 ). (case len.
e210: 20 20 28 28 31 29 20 23 78 37 46 29 20 28 28 32 ((1) #x7F) ((2
e220: 29 20 23 78 44 46 29 20 28 28 33 29 20 23 78 45 ) #xDF) ((3) #xE
e230: 46 29 20 28 28 34 29 20 23 78 46 37 29 0a 20 20 F) ((4) #xF7).
e240: 20 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 (else (error "
e250: 69 6e 76 61 6c 69 64 20 75 74 66 38 20 6c 65 6e invalid utf8 len
e260: 67 74 68 22 20 6c 65 6e 29 29 29 29 0a 0a 28 64 gth" len))))..(d
e270: 65 66 69 6e 65 20 28 63 68 61 72 2d 3e 75 74 66 efine (char->utf
e280: 38 2d 6c 69 73 74 20 63 29 0a 20 20 28 6c 65 74 8-list c). (let
e290: 20 28 28 69 20 28 63 68 61 72 2d 3e 69 6e 74 65 ((i (char->inte
e2a0: 67 65 72 20 63 29 29 29 0a 20 20 20 20 28 63 6f ger c))). (co
e2b0: 6e 64 0a 20 20 20 20 20 28 28 3c 3d 20 69 20 23 nd. ((<= i #
e2c0: 78 37 46 29 20 28 6c 69 73 74 20 69 29 29 0a 20 x7F) (list i)).
e2d0: 20 20 20 20 28 28 3c 3d 20 69 20 23 78 37 46 46 ((<= i #x7FF
e2e0: 29 0a 20 20 20 20 20 20 28 6c 69 73 74 20 28 62 ). (list (b
e2f0: 69 74 2d 69 6f 72 20 23 62 31 31 30 30 30 30 30 it-ior #b1100000
e300: 30 20 28 62 69 74 2d 73 68 72 20 69 20 36 29 29 0 (bit-shr i 6))
e310: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 62 69 . (bi
e320: 74 2d 69 6f 72 20 23 62 31 30 30 30 30 30 30 30 t-ior #b10000000
e330: 20 28 62 69 74 2d 61 6e 64 20 69 20 23 62 31 31 (bit-and i #b11
e340: 31 31 31 31 29 29 29 29 0a 20 20 20 20 20 28 28 1111)))). ((
e350: 3c 3d 20 69 20 23 78 46 46 46 46 29 0a 20 20 20 <= i #xFFFF).
e360: 20 20 20 28 6c 69 73 74 20 28 62 69 74 2d 69 6f (list (bit-io
e370: 72 20 23 62 31 31 31 30 30 30 30 30 20 28 62 69 r #b11100000 (bi
e380: 74 2d 73 68 72 20 69 20 31 32 29 29 0a 20 20 20 t-shr i 12)).
e390: 20 20 20 20 20 20 20 20 20 28 62 69 74 2d 69 6f (bit-io
e3a0: 72 20 23 62 31 30 30 30 30 30 30 30 20 28 62 69 r #b10000000 (bi
e3b0: 74 2d 61 6e 64 20 28 62 69 74 2d 73 68 72 20 69 t-and (bit-shr i
e3c0: 20 36 29 20 23 62 31 31 31 31 31 31 29 29 0a 20 6) #b111111)).
e3d0: 20 20 20 20 20 20 20 20 20 20 20 28 62 69 74 2d (bit-
e3e0: 69 6f 72 20 23 62 31 30 30 30 30 30 30 30 20 28 ior #b10000000 (
e3f0: 62 69 74 2d 61 6e 64 20 69 20 23 62 31 31 31 31 bit-and i #b1111
e400: 31 31 29 29 29 29 0a 20 20 20 20 20 28 28 3c 3d 11)))). ((<=
e410: 20 69 20 23 78 31 46 46 46 46 46 29 0a 20 20 20 i #x1FFFFF).
e420: 20 20 20 28 6c 69 73 74 20 28 62 69 74 2d 69 6f (list (bit-io
e430: 72 20 23 62 31 31 31 31 30 30 30 30 20 28 62 69 r #b11110000 (bi
e440: 74 2d 73 68 72 20 69 20 31 38 29 29 0a 20 20 20 t-shr i 18)).
e450: 20 20 20 20 20 20 20 20 20 28 62 69 74 2d 69 6f (bit-io
e460: 72 20 23 62 31 30 30 30 30 30 30 30 20 28 62 69 r #b10000000 (bi
e470: 74 2d 61 6e 64 20 28 62 69 74 2d 73 68 72 20 69 t-and (bit-shr i
e480: 20 31 32 29 20 23 62 31 31 31 31 31 31 29 29 0a 12) #b111111)).
e490: 20 20 20 20 20 20 20 20 20 20 20 20 28 62 69 74 (bit
e4a0: 2d 69 6f 72 20 23 62 31 30 30 30 30 30 30 30 20 -ior #b10000000
e4b0: 28 62 69 74 2d 61 6e 64 20 28 62 69 74 2d 73 68 (bit-and (bit-sh
e4c0: 72 20 69 20 36 29 20 23 62 31 31 31 31 31 31 29 r i 6) #b111111)
e4d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 62 ). (b
e4e0: 69 74 2d 69 6f 72 20 23 62 31 30 30 30 30 30 30 it-ior #b1000000
e4f0: 30 20 28 62 69 74 2d 61 6e 64 20 69 20 23 62 31 0 (bit-and i #b1
e500: 31 31 31 31 31 29 29 29 29 0a 20 20 20 20 20 28 11111)))). (
e510: 65 6c 73 65 20 28 65 72 72 6f 72 20 22 75 6e 69 else (error "uni
e520: 63 6f 64 65 20 63 6f 64 65 70 6f 69 6e 74 20 6f code codepoint o
e530: 75 74 20 6f 66 20 72 61 6e 67 65 3a 22 20 69 29 ut of range:" i)
e540: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 75 ))))..(define (u
e550: 6e 69 63 6f 64 65 2d 72 61 6e 67 65 2d 3e 75 74 nicode-range->ut
e560: 66 38 2d 70 61 74 74 65 72 6e 20 6c 6f 20 68 69 f8-pattern lo hi
e570: 29 0a 20 20 28 6c 65 74 20 28 28 6c 6f 2d 6c 73 ). (let ((lo-ls
e580: 20 28 63 68 61 72 2d 3e 75 74 66 38 2d 6c 69 73 (char->utf8-lis
e590: 74 20 6c 6f 29 29 0a 20 20 20 20 20 20 20 20 28 t lo)). (
e5a0: 68 69 2d 6c 73 20 28 63 68 61 72 2d 3e 75 74 66 hi-ls (char->utf
e5b0: 38 2d 6c 69 73 74 20 68 69 29 29 29 0a 20 20 20 8-list hi))).
e5c0: 20 28 69 66 20 28 6e 6f 74 20 28 3d 20 28 6c 65 (if (not (= (le
e5d0: 6e 67 74 68 20 6c 6f 2d 6c 73 29 20 28 6c 65 6e ngth lo-ls) (len
e5e0: 67 74 68 20 68 69 2d 6c 73 29 29 29 0a 20 20 20 gth hi-ls))).
e5f0: 20 20 20 20 20 28 73 72 65 2d 61 6c 74 65 72 6e (sre-altern
e600: 61 74 65 20 28 6c 69 73 74 20 28 75 6e 69 63 6f ate (list (unico
e610: 64 65 2d 72 61 6e 67 65 2d 63 6c 69 6d 62 2d 64 de-range-climb-d
e620: 69 67 69 74 73 20 6c 6f 2d 6c 73 20 68 69 2d 6c igits lo-ls hi-l
e630: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
e640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e650: 28 75 6e 69 63 6f 64 65 2d 72 61 6e 67 65 2d 75 (unicode-range-u
e660: 70 2d 74 6f 20 68 69 2d 6c 73 29 29 29 0a 20 20 p-to hi-ls))).
e670: 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 (let lp ((
e680: 6c 6f 2d 6c 73 20 6c 6f 2d 6c 73 29 20 28 68 69 lo-ls lo-ls) (hi
e690: 2d 6c 73 20 68 69 2d 6c 73 29 29 0a 20 20 20 20 -ls hi-ls)).
e6a0: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
e6b0: 20 20 20 20 20 20 20 28 28 3d 20 28 63 61 72 20 ((= (car
e6c0: 6c 6f 2d 6c 73 29 20 28 63 61 72 20 68 69 2d 6c lo-ls) (car hi-l
e6d0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
e6e0: 28 73 72 65 2d 73 65 71 75 65 6e 63 65 0a 20 20 (sre-sequence.
e6f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
e700: 73 20 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 s (integer->char
e710: 20 28 63 61 72 20 6c 6f 2d 6c 73 29 29 0a 20 20 (car lo-ls)).
e720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
e730: 66 20 28 6e 75 6c 6c 3f 20 28 63 64 72 20 6c 6f f (null? (cdr lo
e740: 2d 6c 73 29 29 20 27 28 29 0a 20 20 20 20 20 20 -ls)) '().
e750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
e760: 6f 6e 73 20 28 6c 70 20 28 63 64 72 20 6c 6f 2d ons (lp (cdr lo-
e770: 6c 73 29 20 28 63 64 72 20 68 69 2d 6c 73 29 29 ls) (cdr hi-ls))
e780: 20 27 28 29 29 29 29 29 29 0a 20 20 20 20 20 20 '()))))).
e790: 20 20 20 20 20 28 28 3d 20 28 2b 20 28 63 61 72 ((= (+ (car
e7a0: 20 6c 6f 2d 6c 73 29 20 31 29 20 28 63 61 72 20 lo-ls) 1) (car
e7b0: 68 69 2d 6c 73 29 29 0a 20 20 20 20 20 20 20 20 hi-ls)).
e7c0: 20 20 20 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 (sre-alterna
e7d0: 74 65 20 28 6c 69 73 74 20 28 75 6e 69 63 6f 64 te (list (unicod
e7e0: 65 2d 72 61 6e 67 65 2d 75 70 2d 66 72 6f 6d 20 e-range-up-from
e7f0: 6c 6f 2d 6c 73 29 0a 20 20 20 20 20 20 20 20 20 lo-ls).
e800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e810: 20 20 20 20 20 20 20 20 28 75 6e 69 63 6f 64 65 (unicode
e820: 2d 72 61 6e 67 65 2d 75 70 2d 74 6f 20 68 69 2d -range-up-to hi-
e830: 6c 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 ls)))).
e840: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
e850: 20 20 20 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 (sre-alterna
e860: 74 65 20 28 6c 69 73 74 20 28 75 6e 69 63 6f 64 te (list (unicod
e870: 65 2d 72 61 6e 67 65 2d 75 70 2d 66 72 6f 6d 20 e-range-up-from
e880: 6c 6f 2d 6c 73 29 0a 20 20 20 20 20 20 20 20 20 lo-ls).
e890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e8a0: 20 20 20 20 20 20 20 20 28 75 6e 69 63 6f 64 65 (unicode
e8b0: 2d 72 61 6e 67 65 2d 6d 69 64 64 6c 65 20 6c 6f -range-middle lo
e8c0: 2d 6c 73 20 68 69 2d 6c 73 29 0a 20 20 20 20 20 -ls hi-ls).
e8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e8e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 75 6e 69 (uni
e8f0: 63 6f 64 65 2d 72 61 6e 67 65 2d 75 70 2d 74 6f code-range-up-to
e900: 20 68 69 2d 6c 73 29 29 29 29 29 29 29 29 29 0a hi-ls))))))))).
e910: 0a 28 64 65 66 69 6e 65 20 28 75 6e 69 63 6f 64 .(define (unicod
e920: 65 2d 72 61 6e 67 65 2d 68 65 6c 70 65 72 20 6f e-range-helper o
e930: 6e 65 20 6c 73 20 70 72 65 66 69 78 20 72 65 73 ne ls prefix res
e940: 29 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6c ). (if (null? l
e950: 73 29 0a 20 20 20 20 20 20 72 65 73 0a 20 20 20 s). res.
e960: 20 20 20 28 75 6e 69 63 6f 64 65 2d 72 61 6e 67 (unicode-rang
e970: 65 2d 68 65 6c 70 65 72 0a 20 20 20 20 20 20 20 e-helper.
e980: 6f 6e 65 0a 20 20 20 20 20 20 20 28 63 64 72 20 one. (cdr
e990: 6c 73 29 0a 20 20 20 20 20 20 20 28 63 6f 6e 73 ls). (cons
e9a0: 20 28 63 61 72 20 6c 73 29 20 70 72 65 66 69 78 (car ls) prefix
e9b0: 29 0a 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 ). (cons (
e9c0: 73 72 65 2d 73 65 71 75 65 6e 63 65 0a 20 20 20 sre-sequence.
e9d0: 20 20 20 20 20 20 20 20 20 20 20 60 28 2c 40 28 `(,@(
e9e0: 6d 61 70 20 69 6e 74 65 67 65 72 2d 3e 63 68 61 map integer->cha
e9f0: 72 20 70 72 65 66 69 78 29 0a 20 20 20 20 20 20 r prefix).
ea00: 20 20 20 20 20 20 20 20 20 20 2c 28 6f 6e 65 20 ,(one
ea10: 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 (car ls)).
ea20: 20 20 20 20 20 20 20 20 20 20 2c 40 28 6d 61 70 ,@(map
ea30: 20 28 6c 61 6d 62 64 61 20 28 5f 29 0a 20 20 20 (lambda (_).
ea40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea50: 20 20 20 20 20 20 60 28 2f 20 2c 28 69 6e 74 65 `(/ ,(inte
ea60: 67 65 72 2d 3e 63 68 61 72 20 23 78 38 30 29 0a ger->char #x80).
ea70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea80: 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 69 ,(i
ea90: 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 23 78 46 nteger->char #xF
eaa0: 46 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 F))).
eab0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 (cdr
eac0: 20 6c 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 ls)))).
ead0: 20 20 20 20 20 72 65 73 29 29 29 29 0a 0a 28 64 res))))..(d
eae0: 65 66 69 6e 65 20 28 75 6e 69 63 6f 64 65 2d 72 efine (unicode-r
eaf0: 61 6e 67 65 2d 75 70 2d 66 72 6f 6d 20 6c 6f 2d ange-up-from lo-
eb00: 6c 73 29 0a 20 20 28 73 72 65 2d 73 65 71 75 65 ls). (sre-seque
eb10: 6e 63 65 0a 20 20 20 28 6c 69 73 74 20 28 69 6e nce. (list (in
eb20: 74 65 67 65 72 2d 3e 63 68 61 72 20 28 63 61 72 teger->char (car
eb30: 20 6c 6f 2d 6c 73 29 29 0a 20 20 20 20 20 20 20 lo-ls)).
eb40: 20 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 (sre-alternate
eb50: 0a 20 20 20 20 20 20 20 20 20 20 28 75 6e 69 63 . (unic
eb60: 6f 64 65 2d 72 61 6e 67 65 2d 68 65 6c 70 65 72 ode-range-helper
eb70: 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d . (lam
eb80: 62 64 61 20 28 63 29 0a 20 20 20 20 20 20 20 20 bda (c).
eb90: 20 20 20 20 20 60 28 2f 20 2c 28 69 6e 74 65 67 `(/ ,(integ
eba0: 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 61 72 er->char (+ (car
ebb0: 20 6c 6f 2d 6c 73 29 20 31 29 29 20 2c 28 69 6e lo-ls) 1)) ,(in
ebc0: 74 65 67 65 72 2d 3e 63 68 61 72 20 23 78 46 46 teger->char #xFF
ebd0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
ebe0: 63 64 72 20 28 72 65 76 65 72 73 65 20 28 63 64 cdr (reverse (cd
ebf0: 72 20 6c 6f 2d 6c 73 29 29 29 0a 20 20 20 20 20 r lo-ls))).
ec00: 20 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 20 '().
ec10: 20 20 20 20 20 28 6c 69 73 74 0a 20 20 20 20 20 (list.
ec20: 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 71 75 (sre-sequ
ec30: 65 6e 63 65 0a 20 20 20 20 20 20 20 20 20 20 20 ence.
ec40: 20 20 28 61 70 70 65 6e 64 0a 20 20 20 20 20 20 (append.
ec50: 20 20 20 20 20 20 20 20 28 6d 61 70 20 69 6e 74 (map int
ec60: 65 67 65 72 2d 3e 63 68 61 72 20 28 72 65 76 65 eger->char (reve
ec70: 72 73 65 20 28 63 64 72 20 28 72 65 76 65 72 73 rse (cdr (revers
ec80: 65 20 28 63 64 72 20 6c 6f 2d 6c 73 29 29 29 29 e (cdr lo-ls))))
ec90: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
eca0: 60 28 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d 3e `((/ ,(integer->
ecb0: 63 68 61 72 20 28 6c 61 73 74 20 6c 6f 2d 6c 73 char (last lo-ls
ecc0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
ecd0: 20 20 20 20 20 20 2c 28 69 6e 74 65 67 65 72 2d ,(integer-
ece0: 3e 63 68 61 72 20 23 78 46 46 29 29 29 29 29 29 >char #xFF))))))
ecf0: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
ed00: 75 6e 69 63 6f 64 65 2d 72 61 6e 67 65 2d 75 70 unicode-range-up
ed10: 2d 74 6f 20 68 69 2d 6c 73 29 0a 20 20 28 73 72 -to hi-ls). (sr
ed20: 65 2d 73 65 71 75 65 6e 63 65 0a 20 20 20 28 6c e-sequence. (l
ed30: 69 73 74 20 28 69 6e 74 65 67 65 72 2d 3e 63 68 ist (integer->ch
ed40: 61 72 20 28 63 61 72 20 68 69 2d 6c 73 29 29 0a ar (car hi-ls)).
ed50: 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 61 6c (sre-al
ed60: 74 65 72 6e 61 74 65 0a 20 20 20 20 20 20 20 20 ternate.
ed70: 20 20 28 75 6e 69 63 6f 64 65 2d 72 61 6e 67 65 (unicode-range
ed80: 2d 68 65 6c 70 65 72 0a 20 20 20 20 20 20 20 20 -helper.
ed90: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 29 0a 20 (lambda (c).
eda0: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 2f 20 `(/
edb0: 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
edc0: 23 78 38 30 29 20 2c 28 69 6e 74 65 67 65 72 2d #x80) ,(integer-
edd0: 3e 63 68 61 72 20 28 2d 20 28 63 61 72 20 68 69 >char (- (car hi
ede0: 2d 6c 73 29 20 31 29 29 29 29 0a 20 20 20 20 20 -ls) 1)))).
edf0: 20 20 20 20 20 20 28 63 64 72 20 28 72 65 76 65 (cdr (reve
ee00: 72 73 65 20 28 63 64 72 20 68 69 2d 6c 73 29 29 rse (cdr hi-ls))
ee10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 27 28 29 ). '()
ee20: 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 . (lis
ee30: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 73 t. (s
ee40: 72 65 2d 73 65 71 75 65 6e 63 65 0a 20 20 20 20 re-sequence.
ee50: 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 (append
ee60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
ee70: 6d 61 70 20 69 6e 74 65 67 65 72 2d 3e 63 68 61 map integer->cha
ee80: 72 20 28 72 65 76 65 72 73 65 20 28 63 64 72 20 r (reverse (cdr
ee90: 28 72 65 76 65 72 73 65 20 28 63 64 72 20 68 69 (reverse (cdr hi
eea0: 2d 6c 73 29 29 29 29 29 0a 20 20 20 20 20 20 20 -ls))))).
eeb0: 20 20 20 20 20 20 20 60 28 28 2f 20 2c 28 69 6e `((/ ,(in
eec0: 74 65 67 65 72 2d 3e 63 68 61 72 20 23 78 38 30 teger->char #x80
eed0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
eee0: 20 20 20 20 20 2c 28 69 6e 74 65 67 65 72 2d 3e ,(integer->
eef0: 63 68 61 72 20 28 6c 61 73 74 20 68 69 2d 6c 73 char (last hi-ls
ef00: 29 29 29 29 29 29 29 29 29 29 29 29 0a 0a 28 64 ))))))))))))..(d
ef10: 65 66 69 6e 65 20 28 75 6e 69 63 6f 64 65 2d 72 efine (unicode-r
ef20: 61 6e 67 65 2d 63 6c 69 6d 62 2d 64 69 67 69 74 ange-climb-digit
ef30: 73 20 6c 6f 2d 6c 73 20 68 69 2d 6c 73 29 0a 20 s lo-ls hi-ls).
ef40: 20 28 6c 65 74 20 28 28 6c 6f 2d 6c 65 6e 20 28 (let ((lo-len (
ef50: 6c 65 6e 67 74 68 20 6c 6f 2d 6c 73 29 29 29 0a length lo-ls))).
ef60: 20 20 20 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 (sre-alterna
ef70: 74 65 0a 20 20 20 20 20 28 61 70 70 65 6e 64 0a te. (append.
ef80: 20 20 20 20 20 20 28 6c 69 73 74 0a 20 20 20 20 (list.
ef90: 20 20 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 (sre-sequence
efa0: 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 60 . (cons `
efb0: 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 (/ ,(integer->ch
efc0: 61 72 20 28 63 61 72 20 6c 6f 2d 6c 73 29 29 0a ar (car lo-ls)).
efd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
efe0: 20 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 ,(integer->cha
eff0: 72 20 28 69 66 20 28 3c 3d 20 28 63 61 72 20 6c r (if (<= (car l
f000: 6f 2d 6c 73 29 20 23 78 37 46 29 20 23 78 37 46 o-ls) #x7F) #x7F
f010: 20 23 78 46 46 29 29 29 0a 20 20 20 20 20 20 20 #xFF))).
f020: 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d (map (lam
f030: 62 64 61 20 28 5f 29 0a 20 20 20 20 20 20 20 20 bda (_).
f040: 20 20 20 20 20 20 20 20 20 20 20 20 20 60 28 2f `(/
f050: 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 ,(integer->char
f060: 20 23 78 38 30 29 20 2c 28 69 6e 74 65 67 65 72 #x80) ,(integer
f070: 2d 3e 63 68 61 72 20 23 78 46 46 29 29 29 0a 20 ->char #xFF))).
f080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f090: 20 20 28 63 64 72 20 6c 6f 2d 6c 73 29 29 29 29 (cdr lo-ls))))
f0a0: 29 0a 20 20 20 20 20 20 28 6d 61 70 0a 20 20 20 ). (map.
f0b0: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 69 29 0a (lambda (i).
f0c0: 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 (sre-se
f0d0: 71 75 65 6e 63 65 0a 20 20 20 20 20 20 20 20 20 quence.
f0e0: 20 28 63 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 (cons.
f0f0: 20 20 60 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d `(/ ,(integer-
f100: 3e 63 68 61 72 20 28 75 74 66 38 2d 6c 6f 77 65 >char (utf8-lowe
f110: 73 74 2d 64 69 67 69 74 2d 6f 66 2d 6c 65 6e 67 st-digit-of-leng
f120: 74 68 20 28 2b 20 69 20 6c 6f 2d 6c 65 6e 20 31 th (+ i lo-len 1
f130: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
f140: 20 20 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 ,(integer->ch
f150: 61 72 20 28 75 74 66 38 2d 68 69 67 68 65 73 74 ar (utf8-highest
f160: 2d 64 69 67 69 74 2d 6f 66 2d 6c 65 6e 67 74 68 -digit-of-length
f170: 20 28 2b 20 69 20 6c 6f 2d 6c 65 6e 20 31 29 29 (+ i lo-len 1))
f180: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6d )). (m
f190: 61 70 20 28 6c 61 6d 62 64 61 20 28 5f 29 0a 20 ap (lambda (_).
f1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f1b0: 20 60 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d 3e `(/ ,(integer->
f1c0: 63 68 61 72 20 23 78 38 30 29 20 2c 28 69 6e 74 char #x80) ,(int
f1d0: 65 67 65 72 2d 3e 63 68 61 72 20 23 78 46 46 29 eger->char #xFF)
f1e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
f1f0: 20 20 20 28 7a 65 72 6f 2d 74 6f 20 28 2b 20 69 (zero-to (+ i
f200: 20 6c 6f 2d 6c 65 6e 29 29 29 29 29 29 0a 20 20 lo-len)))))).
f210: 20 20 20 20 20 28 7a 65 72 6f 2d 74 6f 20 28 2d (zero-to (-
f220: 20 28 6c 65 6e 67 74 68 20 68 69 2d 6c 73 29 20 (length hi-ls)
f230: 28 2b 20 6c 6f 2d 6c 65 6e 20 31 29 29 29 29 0a (+ lo-len 1)))).
f240: 20 20 20 20 20 20 28 6c 69 73 74 0a 20 20 20 20 (list.
f250: 20 20 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 (sre-sequence
f260: 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 60 . (cons `
f270: 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 (/ ,(integer->ch
f280: 61 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ar.
f290: 20 20 20 20 20 20 20 28 75 74 66 38 2d 6c 6f 77 (utf8-low
f2a0: 65 73 74 2d 64 69 67 69 74 2d 6f 66 2d 6c 65 6e est-digit-of-len
f2b0: 67 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 gth.
f2c0: 20 20 20 20 20 20 20 20 20 28 75 74 66 38 2d 73 (utf8-s
f2d0: 74 61 72 74 2d 63 68 61 72 2d 3e 6c 65 6e 67 74 tart-char->lengt
f2e0: 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 h.
f2f0: 20 20 20 20 20 20 20 20 28 69 6e 74 65 67 65 72 (integer
f300: 2d 3e 63 68 61 72 20 28 2d 20 28 63 61 72 20 68 ->char (- (car h
f310: 69 2d 6c 73 29 20 31 29 29 29 29 29 0a 20 20 20 i-ls) 1))))).
f320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2c ,
f330: 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 (integer->char (
f340: 2d 20 28 63 61 72 20 68 69 2d 6c 73 29 20 31 29 - (car hi-ls) 1)
f350: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
f360: 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 5f (map (lambda (_
f370: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
f380: 20 20 20 20 20 20 20 60 28 2f 20 2c 28 69 6e 74 `(/ ,(int
f390: 65 67 65 72 2d 3e 63 68 61 72 20 23 78 38 30 29 eger->char #x80)
f3a0: 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 ,(integer->char
f3b0: 20 23 78 46 46 29 29 29 0a 20 20 20 20 20 20 20 #xFF))).
f3c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 (cdr
f3d0: 20 68 69 2d 6c 73 29 29 29 29 29 29 29 29 29 0a hi-ls))))))))).
f3e0: 0a 28 64 65 66 69 6e 65 20 28 75 6e 69 63 6f 64 .(define (unicod
f3f0: 65 2d 72 61 6e 67 65 2d 6d 69 64 64 6c 65 20 6c e-range-middle l
f400: 6f 2d 6c 73 20 68 69 2d 6c 73 29 0a 20 20 28 6c o-ls hi-ls). (l
f410: 65 74 20 28 28 6c 6f 20 28 69 6e 74 65 67 65 72 et ((lo (integer
f420: 2d 3e 63 68 61 72 20 28 2b 20 28 63 61 72 20 6c ->char (+ (car l
f430: 6f 2d 6c 73 29 20 31 29 29 29 0a 20 20 20 20 20 o-ls) 1))).
f440: 20 20 20 28 68 69 20 28 69 6e 74 65 67 65 72 2d (hi (integer-
f450: 3e 63 68 61 72 20 28 2d 20 28 63 61 72 20 68 69 >char (- (car hi
f460: 2d 6c 73 29 20 31 29 29 29 29 0a 20 20 20 20 28 -ls) 1)))). (
f470: 73 72 65 2d 73 65 71 75 65 6e 63 65 0a 20 20 20 sre-sequence.
f480: 20 20 28 63 6f 6e 73 20 28 69 66 20 28 63 68 61 (cons (if (cha
f490: 72 3d 3f 20 6c 6f 20 68 69 29 20 6c 6f 20 60 28 r=? lo hi) lo `(
f4a0: 2f 20 2c 6c 6f 20 2c 68 69 29 29 0a 20 20 20 20 / ,lo ,hi)).
f4b0: 20 20 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d (map (lam
f4c0: 62 64 61 20 28 5f 29 20 60 28 2f 20 2c 28 69 6e bda (_) `(/ ,(in
f4d0: 74 65 67 65 72 2d 3e 63 68 61 72 20 23 78 38 30 teger->char #x80
f4e0: 29 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 ) ,(integer->cha
f4f0: 72 20 23 78 46 46 29 29 29 0a 20 20 20 20 20 20 r #xFF))).
f500: 20 20 20 20 20 20 20 20 20 20 28 63 64 72 20 6c (cdr l
f510: 6f 2d 6c 73 29 29 29 29 29 29 0a 0a 3b 3b 20 4d o-ls))))))..;; M
f520: 61 79 62 65 20 74 68 69 73 20 73 68 6f 75 6c 64 aybe this should
f530: 20 6a 75 73 74 20 6d 6f 64 69 66 79 20 74 68 65 just modify the
f540: 20 69 6e 70 75 74 3f 0a 28 64 65 66 69 6e 65 20 input?.(define
f550: 28 63 73 65 74 2d 3e 75 74 66 38 2d 70 61 74 74 (cset->utf8-patt
f560: 65 72 6e 20 63 73 65 74 29 0a 20 20 28 6c 65 74 ern cset). (let
f570: 20 6c 70 20 28 28 6c 73 20 28 63 73 65 74 2d 3e lp ((ls (cset->
f580: 70 6c 69 73 74 20 63 73 65 74 29 29 20 28 61 6c plist cset)) (al
f590: 74 73 20 27 28 29 29 20 28 6c 6f 2d 63 73 65 74 ts '()) (lo-cset
f5a0: 20 27 28 29 29 29 0a 20 20 20 20 28 69 66 20 28 '())). (if (
f5b0: 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 null? ls).
f5c0: 20 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 (sre-alternate
f5d0: 20 28 61 70 70 65 6e 64 20 28 72 65 76 65 72 73 (append (revers
f5e0: 65 20 61 6c 74 73 29 0a 20 20 20 20 20 20 20 20 e alts).
f5f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f600: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
f610: 3f 20 6c 6f 2d 63 73 65 74 29 0a 20 20 20 20 20 ? lo-cset).
f620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 '(
f640: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
f650: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f660: 20 20 20 20 20 28 6c 69 73 74 20 28 63 6f 6e 73 (list (cons
f670: 20 27 2f 20 28 72 65 76 65 72 73 65 20 6c 6f 2d '/ (reverse lo-
f680: 63 73 65 74 29 29 29 29 29 29 0a 20 20 20 20 20 cset)))))).
f690: 20 20 20 28 69 66 20 28 6f 72 20 28 68 69 67 68 (if (or (high
f6a0: 2d 63 68 61 72 3f 20 28 63 61 72 20 6c 73 29 29 -char? (car ls))
f6b0: 20 20 28 68 69 67 68 2d 63 68 61 72 3f 20 28 63 (high-char? (c
f6c0: 61 64 72 20 6c 73 29 29 29 0a 20 20 20 20 20 20 adr ls))).
f6d0: 20 20 20 20 20 20 28 6c 70 20 28 63 64 64 72 20 (lp (cddr
f6e0: 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
f6f0: 20 20 20 20 28 63 6f 6e 73 20 28 75 6e 69 63 6f (cons (unico
f700: 64 65 2d 72 61 6e 67 65 2d 3e 75 74 66 38 2d 70 de-range->utf8-p
f710: 61 74 74 65 72 6e 20 28 63 61 72 20 6c 73 29 20 attern (car ls)
f720: 28 63 61 64 72 20 6c 73 29 29 20 61 6c 74 73 29 (cadr ls)) alts)
f730: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
f740: 20 6c 6f 2d 63 73 65 74 29 0a 20 20 20 20 20 20 lo-cset).
f750: 20 20 20 20 20 20 28 6c 70 20 28 63 64 64 72 20 (lp (cddr
f760: 6c 73 29 20 61 6c 74 73 20 28 63 6f 6e 73 20 28 ls) alts (cons (
f770: 63 61 64 72 20 6c 73 29 20 28 63 6f 6e 73 20 28 cadr ls) (cons (
f780: 63 61 72 20 6c 73 29 20 6c 6f 2d 63 73 65 74 29 car ls) lo-cset)
f790: 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
f7a0: 28 73 72 65 2d 61 64 6a 75 73 74 2d 75 74 66 38 (sre-adjust-utf8
f7b0: 20 73 72 65 20 66 6c 61 67 73 29 0a 20 20 28 6c sre flags). (l
f7c0: 65 74 20 61 64 6a 75 73 74 20 28 28 73 72 65 20 et adjust ((sre
f7d0: 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 sre).
f7e0: 20 20 20 20 28 75 74 66 38 3f 20 28 66 6c 61 67 (utf8? (flag
f7f0: 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e 75 74 66 -set? flags ~utf
f800: 38 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 8?)).
f810: 20 20 20 20 28 63 69 3f 20 28 66 6c 61 67 2d 73 (ci? (flag-s
f820: 65 74 3f 20 66 6c 61 67 73 20 7e 63 61 73 65 2d et? flags ~case-
f830: 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 29 29 0a insensitive?))).
f840: 20 20 20 20 28 64 65 66 69 6e 65 20 28 72 65 63 (define (rec
f850: 20 73 72 65 29 20 28 61 64 6a 75 73 74 20 73 72 sre) (adjust sr
f860: 65 20 75 74 66 38 3f 20 63 69 3f 29 29 0a 20 20 e utf8? ci?)).
f870: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 70 (cond. ((p
f880: 61 69 72 3f 20 73 72 65 29 0a 20 20 20 20 20 20 air? sre).
f890: 28 63 61 73 65 20 28 63 61 72 20 73 72 65 29 0a (case (car sre).
f8a0: 20 20 20 20 20 20 20 20 28 28 77 2f 75 74 66 38 ((w/utf8
f8b0: 29 20 28 61 64 6a 75 73 74 20 28 73 72 65 2d 73 ) (adjust (sre-s
f8c0: 65 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 equence (cdr sre
f8d0: 29 29 20 23 74 20 63 69 3f 29 29 0a 20 20 20 20 )) #t ci?)).
f8e0: 20 20 20 20 28 28 77 2f 6e 6f 75 74 66 38 29 20 ((w/noutf8)
f8f0: 28 61 64 6a 75 73 74 20 28 73 72 65 2d 73 65 71 (adjust (sre-seq
f900: 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 29 uence (cdr sre))
f910: 20 23 66 20 63 69 3f 29 29 0a 20 20 20 20 20 20 #f ci?)).
f920: 20 20 28 28 77 2f 63 61 73 65 29 0a 20 20 20 20 ((w/case).
f930: 20 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 (cons (car
f940: 73 72 65 29 20 28 6d 61 70 20 28 6c 61 6d 62 64 sre) (map (lambd
f950: 61 20 28 73 29 20 28 61 64 6a 75 73 74 20 73 20 a (s) (adjust s
f960: 75 74 66 38 3f 20 23 66 29 29 20 28 63 64 72 20 utf8? #f)) (cdr
f970: 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
f980: 28 28 77 2f 6e 6f 63 61 73 65 29 0a 20 20 20 20 ((w/nocase).
f990: 20 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 (cons (car
f9a0: 73 72 65 29 20 28 6d 61 70 20 28 6c 61 6d 62 64 sre) (map (lambd
f9b0: 61 20 28 73 29 20 28 61 64 6a 75 73 74 20 73 20 a (s) (adjust s
f9c0: 75 74 66 38 3f 20 23 74 29 29 20 28 63 64 72 20 utf8? #t)) (cdr
f9d0: 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
f9e0: 28 28 2f 20 7e 20 26 20 2d 29 0a 20 20 20 20 20 ((/ ~ & -).
f9f0: 20 20 20 20 28 69 66 20 28 6e 6f 74 20 75 74 66 (if (not utf
fa00: 38 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 8?).
fa10: 20 73 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 sre.
fa20: 20 20 28 6c 65 74 20 28 28 63 73 65 74 20 28 73 (let ((cset (s
fa30: 72 65 2d 3e 63 73 65 74 20 73 72 65 20 63 69 3f re->cset sre ci?
fa40: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
fa50: 20 20 20 28 69 66 20 28 61 6e 79 20 68 69 67 68 (if (any high
fa60: 2d 63 68 61 72 3f 20 28 63 73 65 74 2d 3e 70 6c -char? (cset->pl
fa70: 69 73 74 20 63 73 65 74 29 29 0a 20 20 20 20 20 ist cset)).
fa80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
fa90: 66 20 63 69 3f 0a 20 20 20 20 20 20 20 20 20 20 f ci?.
faa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 (li
fab0: 73 74 20 27 77 2f 63 61 73 65 20 28 63 73 65 74 st 'w/case (cset
fac0: 2d 3e 75 74 66 38 2d 70 61 74 74 65 72 6e 20 63 ->utf8-pattern c
fad0: 73 65 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 set)).
fae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 73 (cs
faf0: 65 74 2d 3e 75 74 66 38 2d 70 61 74 74 65 72 6e et->utf8-pattern
fb00: 20 63 73 65 74 29 29 0a 20 20 20 20 20 20 20 20 cset)).
fb10: 20 20 20 20 20 20 20 20 20 20 20 73 72 65 29 29 sre))
fb20: 29 29 0a 20 20 20 20 20 20 20 20 28 28 2a 29 0a )). ((*).
fb30: 20 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 (case (
fb40: 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
fb50: 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
fb60: 20 20 20 3b 3b 20 73 70 65 63 69 61 6c 20 63 61 ;; special ca
fb70: 73 65 20 6f 70 74 69 6d 69 7a 61 74 69 6f 6e 3a se optimization:
fb80: 20 2e 2a 20 77 2f 75 74 66 38 20 3d 3d 20 2e 2a .* w/utf8 == .*
fb90: 20 77 2f 6e 6f 75 74 66 38 0a 20 20 20 20 20 20 w/noutf8.
fba0: 20 20 20 20 20 28 28 61 6e 79 29 20 27 28 2a 20 ((any) '(*
fbb0: 61 6e 79 29 29 0a 20 20 20 20 20 20 20 20 20 20 any)).
fbc0: 20 28 28 6e 6f 6e 6c 29 20 27 28 2a 20 6e 6f 6e ((nonl) '(* non
fbd0: 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 l)). (
fbe0: 65 6c 73 65 20 28 63 6f 6e 73 20 27 2a 20 28 6d else (cons '* (m
fbf0: 61 70 20 72 65 63 20 28 63 64 72 20 73 72 65 29 ap rec (cdr sre)
fc00: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 65 ))))). (e
fc10: 6c 73 65 0a 20 20 20 20 20 20 20 20 20 28 63 6f lse. (co
fc20: 6e 73 20 28 63 61 72 20 73 72 65 29 20 28 6d 61 ns (car sre) (ma
fc30: 70 20 72 65 63 20 28 63 64 72 20 73 72 65 29 29 p rec (cdr sre))
fc40: 29 29 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a )))). (else.
fc50: 20 20 20 20 20 20 28 63 61 73 65 20 73 72 65 0a (case sre.
fc60: 20 20 20 20 20 20 20 20 28 28 61 6e 79 29 20 28 ((any) (
fc70: 69 66 20 75 74 66 38 3f 20 27 75 74 66 38 2d 61 if utf8? 'utf8-a
fc80: 6e 79 20 27 61 6e 79 29 29 0a 20 20 20 20 20 20 ny 'any)).
fc90: 20 20 28 28 6e 6f 6e 6c 29 20 28 69 66 20 75 74 ((nonl) (if ut
fca0: 66 38 3f 20 27 75 74 66 38 2d 6e 6f 6e 6c 20 27 f8? 'utf8-nonl '
fcb0: 6e 6f 6e 6c 29 29 0a 20 20 20 20 20 20 20 20 28 nonl)). (
fcc0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 28 69 else. (i
fcd0: 66 20 28 61 6e 64 20 75 74 66 38 3f 20 28 63 68 f (and utf8? (ch
fce0: 61 72 3f 20 73 72 65 29 20 28 68 69 67 68 2d 63 ar? sre) (high-c
fcf0: 68 61 72 3f 20 73 72 65 29 29 0a 20 20 20 20 20 har? sre)).
fd00: 20 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 71 (sre-seq
fd10: 75 65 6e 63 65 20 28 6d 61 70 20 69 6e 74 65 67 uence (map integ
fd20: 65 72 2d 3e 63 68 61 72 20 28 63 68 61 72 2d 3e er->char (char->
fd30: 75 74 66 38 2d 6c 69 73 74 20 73 72 65 29 29 29 utf8-list sre)))
fd40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 73 72 . sr
fd50: 65 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b e)))))))..;;;;;;
fd60: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fd70: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fd80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fd90: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fda0: 3b 3b 0a 3b 3b 3b 3b 20 43 6f 6d 70 69 6c 61 74 ;;.;;;; Compilat
fdb0: 69 6f 6e 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 ion..(define (ir
fdc0: 72 65 67 65 78 20 78 20 2e 20 6f 29 0a 20 20 28 regex x . o). (
fdd0: 63 6f 6e 64 0a 20 20 20 28 28 69 72 72 65 67 65 cond. ((irrege
fde0: 78 3f 20 78 29 20 78 29 0a 20 20 20 28 28 73 74 x? x) x). ((st
fdf0: 72 69 6e 67 3f 20 78 29 20 28 61 70 70 6c 79 20 ring? x) (apply
fe00: 73 74 72 69 6e 67 2d 3e 69 72 72 65 67 65 78 20 string->irregex
fe10: 78 20 6f 29 29 0a 20 20 20 28 65 6c 73 65 20 28 x o)). (else (
fe20: 61 70 70 6c 79 20 73 72 65 2d 3e 69 72 72 65 67 apply sre->irreg
fe30: 65 78 20 78 20 6f 29 29 29 29 0a 0a 28 64 65 66 ex x o))))..(def
fe40: 69 6e 65 20 28 73 74 72 69 6e 67 2d 3e 69 72 72 ine (string->irr
fe50: 65 67 65 78 20 73 74 72 20 2e 20 6f 29 0a 20 20 egex str . o).
fe60: 28 61 70 70 6c 79 20 73 72 65 2d 3e 69 72 72 65 (apply sre->irre
fe70: 67 65 78 20 28 61 70 70 6c 79 20 73 74 72 69 6e gex (apply strin
fe80: 67 2d 3e 73 72 65 20 73 74 72 20 6f 29 20 6f 29 g->sre str o) o)
fe90: 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d )..(define (sre-
fea0: 3e 69 72 72 65 67 65 78 20 73 72 65 20 2e 20 6f >irregex sre . o
feb0: 29 0a 20 20 28 6c 65 74 2a 20 28 28 70 61 74 2d ). (let* ((pat-
fec0: 66 6c 61 67 73 20 28 73 79 6d 62 6f 6c 2d 6c 69 flags (symbol-li
fed0: 73 74 2d 3e 66 6c 61 67 73 20 6f 29 29 0a 20 20 st->flags o)).
fee0: 20 20 20 20 20 20 20 28 73 72 65 20 28 69 66 20 (sre (if
fef0: 2a 61 6c 6c 6f 77 2d 75 74 66 38 2d 6d 6f 64 65 *allow-utf8-mode
ff00: 3f 2a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?*.
ff10: 20 20 20 20 20 28 73 72 65 2d 61 64 6a 75 73 74 (sre-adjust
ff20: 2d 75 74 66 38 20 73 72 65 20 70 61 74 2d 66 6c -utf8 sre pat-fl
ff30: 61 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ags).
ff40: 20 20 20 20 20 20 20 73 72 65 29 29 0a 20 20 20 sre)).
ff50: 20 20 20 20 20 20 28 73 65 61 72 63 68 65 72 3f (searcher?
ff60: 20 28 73 72 65 2d 73 65 61 72 63 68 65 72 3f 20 (sre-searcher?
ff70: 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 28 sre)). (
ff80: 73 72 65 2d 64 66 61 20 28 69 66 20 73 65 61 72 sre-dfa (if sear
ff90: 63 68 65 72 3f 20 28 73 72 65 2d 72 65 6d 6f 76 cher? (sre-remov
ffa0: 65 2d 69 6e 69 74 69 61 6c 2d 62 6f 73 20 73 72 e-initial-bos sr
ffb0: 65 29 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 e) sre)).
ffc0: 20 20 28 64 66 61 2d 6c 69 6d 69 74 20 28 63 6f (dfa-limit (co
ffd0: 6e 64 20 28 28 6d 65 6d 71 20 27 73 6d 61 6c 6c nd ((memq 'small
ffe0: 20 6f 29 20 31 29 20 28 28 6d 65 6d 71 20 27 66 o) 1) ((memq 'f
fff0: 61 73 74 20 6f 29 20 35 30 29 20 28 65 6c 73 65 ast o) 50) (else
10000 20 31 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 10))).
10010 3b 3b 20 54 4f 44 4f 3a 20 4d 61 79 62 65 20 6d ;; TODO: Maybe m
10020 61 6b 65 20 74 68 65 73 65 20 74 77 6f 20 70 72 ake these two pr
10030 6f 6d 69 73 65 73 3b 20 69 66 20 77 65 20 6f 6e omises; if we on
10040 6c 79 20 77 61 6e 74 20 74 6f 20 73 65 61 72 63 ly want to searc
10050 68 2c 0a 20 20 20 20 20 20 20 20 20 3b 3b 20 69 h,. ;; i
10060 74 27 73 20 77 61 73 74 65 66 75 6c 20 74 6f 20 t's wasteful to
10070 63 6f 6d 70 69 6c 65 20 74 68 65 20 6d 61 74 63 compile the matc
10080 68 65 72 2c 20 61 6e 64 20 76 69 63 65 20 76 65 her, and vice ve
10090 72 73 61 0a 20 20 20 20 20 20 20 20 20 3b 3b 20 rsa. ;;
100a0 4d 61 79 62 65 20 70 72 6f 76 69 64 65 20 61 20 Maybe provide a
100b0 66 6c 61 67 20 74 6f 20 63 6f 6d 70 69 6c 65 20 flag to compile
100c0 65 61 67 65 72 6c 79 2c 20 74 6f 20 68 65 6c 70 eagerly, to help
100d0 20 62 65 6e 63 68 6d 61 72 6b 69 6e 67 20 65 74 benchmarking et
100e0 63 2e 0a 20 20 20 20 20 20 20 20 20 28 64 66 61 c.. (dfa
100f0 2f 73 65 61 72 63 68 0a 20 20 20 20 20 20 20 20 /search.
10100 20 20 28 63 6f 6e 64 20 28 28 6d 65 6d 71 20 27 (cond ((memq '
10110 62 61 63 6b 74 72 61 63 6b 20 6f 29 20 23 66 29 backtrack o) #f)
10120 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
10130 20 28 73 65 61 72 63 68 65 72 3f 20 23 74 29 0a (searcher? #t).
10140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10150 28 28 73 72 65 2d 3e 6e 66 61 20 60 28 73 65 71 ((sre->nfa `(seq
10160 20 28 2a 20 61 6e 79 29 20 2c 73 72 65 2d 64 66 (* any) ,sre-df
10170 61 29 20 70 61 74 2d 66 6c 61 67 73 29 0a 20 20 a) pat-flags).
10180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d =
10190 3e 20 28 6c 61 6d 62 64 61 20 28 6e 66 61 29 0a > (lambda (nfa).
101a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
101b0 20 20 20 20 20 20 28 6e 66 61 2d 3e 64 66 61 20 (nfa->dfa
101c0 6e 66 61 20 28 2a 20 64 66 61 2d 6c 69 6d 69 74 nfa (* dfa-limit
101d0 20 28 6e 66 61 2d 6e 75 6d 2d 73 74 61 74 65 73 (nfa-num-states
101e0 20 6e 66 61 29 29 29 29 29 0a 20 20 20 20 20 20 nfa))))).
101f0 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
10200 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 #f))). (
10210 64 66 61 20 28 63 6f 6e 64 20 28 28 61 6e 64 20 dfa (cond ((and
10220 64 66 61 2f 73 65 61 72 63 68 20 28 73 72 65 2d dfa/search (sre-
10230 3e 6e 66 61 20 73 72 65 2d 64 66 61 20 70 61 74 >nfa sre-dfa pat
10240 2d 66 6c 61 67 73 29 29 0a 20 20 20 20 20 20 20 -flags)).
10250 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e =>
10260 20 28 6c 61 6d 62 64 61 20 28 6e 66 61 29 0a 20 (lambda (nfa).
10270 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10280 20 20 20 20 20 20 20 20 20 28 6e 66 61 2d 3e 64 (nfa->d
10290 66 61 20 6e 66 61 20 28 2a 20 64 66 61 2d 6c 69 fa nfa (* dfa-li
102a0 6d 69 74 20 28 6e 66 61 2d 6e 75 6d 2d 73 74 61 mit (nfa-num-sta
102b0 74 65 73 20 6e 66 61 29 29 29 29 29 0a 20 20 20 tes nfa))))).
102c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
102d0 20 28 65 6c 73 65 20 23 66 29 29 29 0a 20 20 20 (else #f))).
102e0 20 20 20 20 20 20 28 73 75 62 6d 61 74 63 68 65 (submatche
102f0 73 20 28 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 s (sre-count-sub
10300 6d 61 74 63 68 65 73 20 73 72 65 2d 64 66 61 29 matches sre-dfa)
10310 29 0a 20 20 20 20 20 20 20 20 20 28 6e 61 6d 65 ). (name
10320 73 20 28 73 72 65 2d 6e 61 6d 65 73 20 73 72 65 s (sre-names sre
10330 2d 64 66 61 20 31 20 27 28 29 29 29 0a 20 20 20 -dfa 1 '())).
10340 20 20 20 20 20 20 28 6c 65 6e 73 20 28 73 72 65 (lens (sre
10350 2d 6c 65 6e 67 74 68 2d 72 61 6e 67 65 73 20 73 -length-ranges s
10360 72 65 2d 64 66 61 20 6e 61 6d 65 73 29 29 0a 20 re-dfa names)).
10370 20 20 20 20 20 20 20 20 28 66 6c 61 67 73 20 28 (flags (
10380 66 6c 61 67 2d 6a 6f 69 6e 0a 20 20 20 20 20 20 flag-join.
10390 20 20 20 20 20 20 20 20 20 20 20 28 66 6c 61 67 (flag
103a0 2d 6a 6f 69 6e 20 7e 6e 6f 6e 65 20 28 61 6e 64 -join ~none (and
103b0 20 73 65 61 72 63 68 65 72 3f 20 7e 73 65 61 72 searcher? ~sear
103c0 63 68 65 72 3f 29 29 0a 20 20 20 20 20 20 20 20 cher?)).
103d0 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 73 (and (s
103e0 72 65 2d 63 6f 6e 73 75 6d 65 72 3f 20 73 72 65 re-consumer? sre
103f0 29 20 7e 63 6f 6e 73 75 6d 65 72 3f 29 29 29 29 ) ~consumer?))))
10400 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 . (cond.
10410 28 64 66 61 0a 20 20 20 20 20 20 28 6d 61 6b 65 (dfa. (make
10420 2d 69 72 72 65 67 65 78 20 64 66 61 20 64 66 61 -irregex dfa dfa
10430 2f 73 65 61 72 63 68 20 23 66 20 66 6c 61 67 73 /search #f flags
10440 20 73 75 62 6d 61 74 63 68 65 73 20 6c 65 6e 73 submatches lens
10450 20 6e 61 6d 65 73 29 29 0a 20 20 20 20 20 28 65 names)). (e
10460 6c 73 65 0a 20 20 20 20 20 20 28 6c 65 74 20 28 lse. (let (
10470 28 66 20 28 73 72 65 2d 3e 70 72 6f 63 65 64 75 (f (sre->procedu
10480 72 65 20 73 72 65 20 70 61 74 2d 66 6c 61 67 73 re sre pat-flags
10490 20 6e 61 6d 65 73 29 29 29 0a 20 20 20 20 20 20 names))).
104a0 20 20 28 6d 61 6b 65 2d 69 72 72 65 67 65 78 20 (make-irregex
104b0 23 66 20 23 66 20 66 20 66 6c 61 67 73 20 73 75 #f #f f flags su
104c0 62 6d 61 74 63 68 65 73 20 6c 65 6e 73 20 6e 61 bmatches lens na
104d0 6d 65 73 29 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b mes))))))..;;;;;
104e0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
104f0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
10500 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
10510 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
10520 3b 3b 3b 0a 3b 3b 3b 3b 20 53 52 45 20 41 6e 61 ;;;.;;;; SRE Ana
10530 6c 79 73 69 73 0a 0a 3b 3b 20 72 65 74 75 72 6e lysis..;; return
10540 73 20 23 74 20 69 66 20 74 68 65 20 73 72 65 20 s #t if the sre
10550 63 61 6e 20 65 76 65 72 20 62 65 20 65 6d 70 74 can ever be empt
10560 79 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d 65 y.(define (sre-e
10570 6d 70 74 79 3f 20 73 72 65 29 0a 20 20 28 69 66 mpty? sre). (if
10580 20 28 70 61 69 72 3f 20 73 72 65 29 0a 20 20 20 (pair? sre).
10590 20 20 20 28 63 61 73 65 20 28 63 61 72 20 73 72 (case (car sr
105a0 65 29 0a 20 20 20 20 20 20 20 20 28 28 2a 20 3f e). ((* ?
105b0 20 6c 6f 6f 6b 2d 61 68 65 61 64 20 6c 6f 6f 6b look-ahead look
105c0 2d 62 65 68 69 6e 64 20 6e 65 67 2d 6c 6f 6f 6b -behind neg-look
105d0 2d 61 68 65 61 64 20 6e 65 67 2d 6c 6f 6f 6b 2d -ahead neg-look-
105e0 62 65 68 69 6e 64 29 20 23 74 29 0a 20 20 20 20 behind) #t).
105f0 20 20 20 20 28 28 2a 2a 29 20 28 6f 72 20 28 6e ((**) (or (n
10600 6f 74 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 ot (number? (cad
10610 72 20 73 72 65 29 29 29 20 28 7a 65 72 6f 3f 20 r sre))) (zero?
10620 28 63 61 64 72 20 73 72 65 29 29 29 29 0a 20 20 (cadr sre)))).
10630 20 20 20 20 20 20 28 28 6f 72 29 20 28 61 6e 79 ((or) (any
10640 20 73 72 65 2d 65 6d 70 74 79 3f 20 28 63 64 72 sre-empty? (cdr
10650 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 sre))).
10660 28 28 3a 20 73 65 71 20 24 20 73 75 62 6d 61 74 ((: seq $ submat
10670 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e ch => submatch-n
10680 61 6d 65 64 20 2b 20 61 74 6f 6d 69 63 29 0a 20 amed + atomic).
10690 20 20 20 20 20 20 20 20 28 65 76 65 72 79 20 73 (every s
106a0 72 65 2d 65 6d 70 74 79 3f 20 28 63 64 72 20 73 re-empty? (cdr s
106b0 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 65 re))). (e
106c0 6c 73 65 20 23 66 29 29 0a 20 20 20 20 20 20 28 lse #f)). (
106d0 6d 65 6d 71 20 73 72 65 20 27 28 65 70 73 69 6c memq sre '(epsil
106e0 6f 6e 20 62 6f 73 20 65 6f 73 20 62 6f 6c 20 65 on bos eos bol e
106f0 6f 6c 20 62 6f 77 20 65 6f 77 20 63 6f 6d 6d 69 ol bow eow commi
10700 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 t))))..(define (
10710 73 72 65 2d 61 6e 79 3f 20 73 72 65 29 0a 20 20 sre-any? sre).
10720 28 6f 72 20 28 65 71 3f 20 73 72 65 20 27 61 6e (or (eq? sre 'an
10730 79 29 0a 20 20 20 20 20 20 28 61 6e 64 20 28 70 y). (and (p
10740 61 69 72 3f 20 73 72 65 29 0a 20 20 20 20 20 20 air? sre).
10750 20 20 20 20 20 28 63 61 73 65 20 28 63 61 72 20 (case (car
10760 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 sre).
10770 20 20 28 28 73 65 71 20 3a 20 24 20 73 75 62 6d ((seq : $ subm
10780 61 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 atch => submatch
10790 2d 6e 61 6d 65 64 29 0a 20 20 20 20 20 20 20 20 -named).
107a0 20 20 20 20 20 20 28 61 6e 64 20 28 70 61 69 72 (and (pair
107b0 3f 20 28 63 64 72 20 73 72 65 29 29 20 28 6e 75 ? (cdr sre)) (nu
107c0 6c 6c 3f 20 28 63 64 64 72 20 73 72 65 29 29 20 ll? (cddr sre))
107d0 28 73 72 65 2d 61 6e 79 3f 20 28 63 61 64 72 20 (sre-any? (cadr
107e0 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
107f0 20 20 20 20 20 28 28 6f 72 29 20 28 65 76 65 72 ((or) (ever
10800 79 20 73 72 65 2d 61 6e 79 3f 20 28 63 64 72 20 y sre-any? (cdr
10810 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 sre))).
10820 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 29 (else #f))))
10830 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d )..(define (sre-
10840 72 65 70 65 61 74 65 72 3f 20 73 72 65 29 0a 20 repeater? sre).
10850 20 28 61 6e 64 20 28 70 61 69 72 3f 20 73 72 65 (and (pair? sre
10860 29 0a 20 20 20 20 20 20 20 28 6f 72 20 28 6d 65 ). (or (me
10870 6d 71 20 28 63 61 72 20 73 72 65 29 20 27 28 2a mq (car sre) '(*
10880 20 2b 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 +)).
10890 28 61 6e 64 20 28 6d 65 6d 71 20 28 63 61 72 20 (and (memq (car
108a0 73 72 65 29 20 27 28 24 20 73 75 62 6d 61 74 63 sre) '($ submatc
108b0 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e 61 h => submatch-na
108c0 6d 65 64 20 73 65 71 20 3a 29 29 0a 20 20 20 20 med seq :)).
108d0 20 20 20 20 20 20 20 20 20 20 20 20 28 70 61 69 (pai
108e0 72 3f 20 28 63 64 72 20 73 72 65 29 29 0a 20 20 r? (cdr sre)).
108f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e (n
10900 75 6c 6c 3f 20 28 63 64 64 72 20 73 72 65 29 29 ull? (cddr sre))
10910 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
10920 20 28 73 72 65 2d 72 65 70 65 61 74 65 72 3f 20 (sre-repeater?
10930 28 63 61 64 72 20 73 72 65 29 29 29 29 29 29 0a (cadr sre)))))).
10940 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d 62 6f .(define (sre-bo
10950 73 3f 20 73 72 65 29 0a 20 20 28 69 66 20 28 70 s? sre). (if (p
10960 61 69 72 3f 20 73 72 65 29 0a 20 20 20 20 20 20 air? sre).
10970 28 63 61 73 65 20 28 63 61 72 20 73 72 65 29 0a (case (car sre).
10980 20 20 20 20 20 20 20 20 28 28 73 65 71 20 3a 20 ((seq :
10990 24 20 73 75 62 6d 61 74 63 68 20 3d 3e 20 73 75 $ submatch => su
109a0 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a 20 20 bmatch-named).
109b0 20 20 20 20 20 20 20 28 61 6e 64 20 28 70 61 69 (and (pai
109c0 72 3f 20 28 63 64 72 20 73 72 65 29 29 20 28 73 r? (cdr sre)) (s
109d0 72 65 2d 62 6f 73 3f 20 28 63 61 64 72 20 73 72 re-bos? (cadr sr
109e0 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 e)))). ((
109f0 6f 72 29 20 28 65 76 65 72 79 20 73 72 65 2d 62 or) (every sre-b
10a00 6f 73 3f 20 28 63 64 72 20 73 72 65 29 29 29 0a os? (cdr sre))).
10a10 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 (else #f
10a20 29 29 0a 20 20 20 20 20 20 28 65 71 3f 20 27 62 )). (eq? 'b
10a30 6f 73 20 73 72 65 29 29 29 0a 0a 3b 3b 20 61 20 os sre)))..;; a
10a40 73 65 61 72 63 68 65 72 20 64 6f 65 73 6e 27 74 searcher doesn't
10a50 20 6e 65 65 64 20 65 78 70 6c 69 63 69 74 20 69 need explicit i
10a60 74 65 72 61 74 69 6f 6e 20 74 6f 20 66 69 6e 64 teration to find
10a70 20 74 68 65 20 66 69 72 73 74 20 6d 61 74 63 68 the first match
10a80 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d 73 65 .(define (sre-se
10a90 61 72 63 68 65 72 3f 20 73 72 65 29 0a 20 20 28 archer? sre). (
10aa0 6f 72 20 28 73 72 65 2d 62 6f 73 3f 20 73 72 65 or (sre-bos? sre
10ab0 29 0a 20 20 20 20 20 20 28 61 6e 64 20 28 70 61 ). (and (pa
10ac0 69 72 3f 20 73 72 65 29 0a 20 20 20 20 20 20 20 ir? sre).
10ad0 20 20 20 20 28 63 61 73 65 20 28 63 61 72 20 73 (case (car s
10ae0 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 re).
10af0 20 28 28 2a 20 2b 29 20 28 73 72 65 2d 61 6e 79 ((* +) (sre-any
10b00 3f 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 ? (sre-sequence
10b10 28 63 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 (cdr sre)))).
10b20 20 20 20 20 20 20 20 20 20 20 28 28 73 65 71 20 ((seq
10b30 3a 20 24 20 73 75 62 6d 61 74 63 68 20 3d 3e 20 : $ submatch =>
10b40 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a submatch-named).
10b50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
10b60 6e 64 20 28 70 61 69 72 3f 20 28 63 64 72 20 73 nd (pair? (cdr s
10b70 72 65 29 29 20 28 73 72 65 2d 73 65 61 72 63 68 re)) (sre-search
10b80 65 72 3f 20 28 63 61 64 72 20 73 72 65 29 29 29 er? (cadr sre)))
10b90 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
10ba0 28 6f 72 29 20 28 65 76 65 72 79 20 73 72 65 2d (or) (every sre-
10bb0 73 65 61 72 63 68 65 72 3f 20 28 63 64 72 20 73 searcher? (cdr s
10bc0 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 re))).
10bd0 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 29 29 (else #f)))))
10be0 0a 0a 3b 3b 20 61 20 63 6f 6e 73 75 6d 65 72 20 ..;; a consumer
10bf0 64 6f 65 73 6e 27 74 20 6e 65 65 64 20 74 6f 20 doesn't need to
10c00 6d 61 74 63 68 20 6d 6f 72 65 20 74 68 61 6e 20 match more than
10c10 6f 6e 63 65 0a 28 64 65 66 69 6e 65 20 28 73 72 once.(define (sr
10c20 65 2d 63 6f 6e 73 75 6d 65 72 3f 20 73 72 65 29 e-consumer? sre)
10c30 0a 20 20 28 6f 72 20 28 73 72 65 2d 62 6f 73 3f . (or (sre-bos?
10c40 20 73 72 65 29 0a 20 20 20 20 20 20 28 61 6e 64 sre). (and
10c50 20 28 70 61 69 72 3f 20 73 72 65 29 0a 20 20 20 (pair? sre).
10c60 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 63 (case (c
10c70 61 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 ar sre).
10c80 20 20 20 20 20 28 28 2a 20 2b 29 20 28 73 72 65 ((* +) (sre
10c90 2d 61 6e 79 3f 20 28 73 72 65 2d 73 65 71 75 65 -any? (sre-seque
10ca0 6e 63 65 20 28 63 64 72 20 73 72 65 29 29 29 29 nce (cdr sre))))
10cb0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 . ((
10cc0 73 65 71 20 3a 20 24 20 73 75 62 6d 61 74 63 68 seq : $ submatch
10cd0 20 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e 61 6d => submatch-nam
10ce0 65 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ed).
10cf0 20 20 28 61 6e 64 20 28 70 61 69 72 3f 20 28 63 (and (pair? (c
10d00 64 72 20 73 72 65 29 29 20 28 73 72 65 2d 63 6f dr sre)) (sre-co
10d10 6e 73 75 6d 65 72 3f 20 28 6c 61 73 74 20 73 72 nsumer? (last sr
10d20 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 e)))).
10d30 20 20 20 28 28 6f 72 29 20 28 65 76 65 72 79 20 ((or) (every
10d40 73 72 65 2d 63 6f 6e 73 75 6d 65 72 3f 20 28 63 sre-consumer? (c
10d50 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 dr sre))).
10d60 20 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 (else #f)
10d70 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 ))))..(define (s
10d80 72 65 2d 68 61 73 2d 73 75 62 6d 61 74 63 68 65 re-has-submatche
10d90 73 3f 20 73 72 65 29 0a 20 20 28 61 6e 64 20 28 s? sre). (and (
10da0 70 61 69 72 3f 20 73 72 65 29 0a 20 20 20 20 20 pair? sre).
10db0 20 20 28 6f 72 20 28 6d 65 6d 71 20 28 63 61 72 (or (memq (car
10dc0 20 73 72 65 29 20 27 28 24 20 73 75 62 6d 61 74 sre) '($ submat
10dd0 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e ch => submatch-n
10de0 61 6d 65 64 29 29 0a 20 20 20 20 20 20 20 20 20 amed)).
10df0 20 20 28 69 66 20 28 65 71 3f 20 27 70 6f 73 69 (if (eq? 'posi
10e00 78 2d 73 74 72 69 6e 67 20 28 63 61 72 20 73 72 x-string (car sr
10e10 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
10e20 20 20 20 28 73 72 65 2d 68 61 73 2d 73 75 62 6d (sre-has-subm
10e30 61 74 63 68 65 73 3f 20 28 73 74 72 69 6e 67 2d atches? (string-
10e40 3e 73 72 65 20 28 63 61 64 72 20 73 72 65 29 29 >sre (cadr sre))
10e50 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
10e60 20 28 61 6e 79 20 73 72 65 2d 68 61 73 2d 73 75 (any sre-has-su
10e70 62 6d 61 74 63 68 65 73 3f 20 28 63 64 72 20 73 bmatches? (cdr s
10e80 72 65 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e re))))))..(defin
10e90 65 20 28 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 e (sre-count-sub
10ea0 6d 61 74 63 68 65 73 20 73 72 65 29 0a 20 20 28 matches sre). (
10eb0 6c 65 74 20 63 6f 75 6e 74 20 28 28 73 72 65 20 let count ((sre
10ec0 73 72 65 29 20 28 73 75 6d 20 30 29 29 0a 20 20 sre) (sum 0)).
10ed0 20 20 28 69 66 20 28 70 61 69 72 3f 20 73 72 65 (if (pair? sre
10ee0 29 0a 20 20 20 20 20 20 20 20 28 66 6f 6c 64 20 ). (fold
10ef0 63 6f 75 6e 74 0a 20 20 20 20 20 20 20 20 20 20 count.
10f00 20 20 20 20 28 2b 20 73 75 6d 20 28 63 61 73 65 (+ sum (case
10f10 20 28 63 61 72 20 73 72 65 29 0a 20 20 20 20 20 (car sre).
10f20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10f30 20 20 28 28 24 20 73 75 62 6d 61 74 63 68 20 3d (($ submatch =
10f40 3e 20 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 > submatch-named
10f50 29 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) 1).
10f60 20 20 20 20 20 20 20 20 20 20 20 20 28 28 64 73 ((ds
10f70 6d 29 20 28 2b 20 28 63 61 64 72 20 73 72 65 29 m) (+ (cadr sre)
10f80 20 28 63 61 64 64 72 20 73 72 65 29 29 29 0a 20 (caddr sre))).
10f90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10fa0 20 20 20 20 20 20 28 28 70 6f 73 69 78 2d 73 74 ((posix-st
10fb0 72 69 6e 67 29 0a 20 20 20 20 20 20 20 20 20 20 ring).
10fc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
10fd0 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 re-count-submatc
10fe0 68 65 73 20 28 73 74 72 69 6e 67 2d 3e 73 72 65 hes (string->sre
10ff0 20 28 63 61 64 72 20 73 72 65 29 29 29 29 0a 20 (cadr sre)))).
11000 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11010 20 20 20 20 20 20 28 65 6c 73 65 20 30 29 29 29 (else 0)))
11020 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
11030 63 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 cdr sre)).
11040 20 20 73 75 6d 29 29 29 0a 0a 28 64 65 66 69 6e sum)))..(defin
11050 65 20 28 73 72 65 2d 6c 65 6e 67 74 68 2d 72 61 e (sre-length-ra
11060 6e 67 65 73 20 73 72 65 20 2e 20 6f 29 0a 20 20 nges sre . o).
11070 28 6c 65 74 20 28 28 6e 61 6d 65 73 20 28 69 66 (let ((names (if
11080 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 72 20 (pair? o) (car
11090 6f 29 20 28 73 72 65 2d 6e 61 6d 65 73 20 73 72 o) (sre-names sr
110a0 65 20 31 20 27 28 29 29 29 29 0a 20 20 20 20 20 e 1 '()))).
110b0 20 20 20 28 73 75 62 6c 65 6e 73 20 28 6d 61 6b (sublens (mak
110c0 65 2d 76 65 63 74 6f 72 20 28 2b 20 31 20 28 73 e-vector (+ 1 (s
110d0 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 re-count-submatc
110e0 68 65 73 20 73 72 65 29 29 20 23 66 29 29 29 0a hes sre)) #f))).
110f0 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
11100 0a 20 20 20 20 20 73 75 62 6c 65 6e 73 0a 20 20 . sublens.
11110 20 20 20 30 0a 20 20 20 20 20 28 6c 65 74 20 6c 0. (let l
11120 70 20 28 28 73 72 65 20 73 72 65 29 20 28 6e 20 p ((sre sre) (n
11130 31 29 20 28 6c 6f 20 30 29 20 28 68 69 20 30 29 1) (lo 0) (hi 0)
11140 20 28 72 65 74 75 72 6e 20 63 6f 6e 73 29 29 0a (return cons)).
11150 20 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 (define (
11160 67 72 6f 77 20 69 29 20 28 72 65 74 75 72 6e 20 grow i) (return
11170 28 2b 20 6c 6f 20 69 29 20 28 61 6e 64 20 68 69 (+ lo i) (and hi
11180 20 28 2b 20 68 69 20 69 29 29 29 29 0a 20 20 20 (+ hi i)))).
11190 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
111a0 20 20 28 28 70 61 69 72 3f 20 73 72 65 29 0a 20 ((pair? sre).
111b0 20 20 20 20 20 20 20 20 28 69 66 20 28 73 74 72 (if (str
111c0 69 6e 67 3f 20 28 63 61 72 20 73 72 65 29 29 0a ing? (car sre)).
111d0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 72 (gr
111e0 6f 77 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 ow 1).
111f0 20 20 20 28 63 61 73 65 20 28 63 61 72 20 73 72 (case (car sr
11200 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
11210 20 20 28 28 2f 20 7e 20 26 20 2d 29 0a 20 20 20 ((/ ~ & -).
11220 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 72 (gr
11230 6f 77 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 ow 1)).
11240 20 20 20 20 20 20 28 28 70 6f 73 69 78 2d 73 74 ((posix-st
11250 72 69 6e 67 29 0a 20 20 20 20 20 20 20 20 20 20 ring).
11260 20 20 20 20 20 20 28 6c 70 20 28 73 74 72 69 6e (lp (strin
11270 67 2d 3e 73 72 65 20 28 63 61 64 72 20 73 72 65 g->sre (cadr sre
11280 29 29 20 6e 20 6c 6f 20 68 69 20 72 65 74 75 72 )) n lo hi retur
11290 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 n)).
112a0 20 20 20 28 28 73 65 71 20 3a 20 77 2f 63 61 73 ((seq : w/cas
112b0 65 20 77 2f 6e 6f 63 61 73 65 20 61 74 6f 6d 69 e w/nocase atomi
112c0 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c).
112d0 20 20 20 28 6c 65 74 20 6c 70 32 20 28 28 6c 73 (let lp2 ((ls
112e0 20 28 63 64 72 20 73 72 65 29 29 20 28 6e 20 6e (cdr sre)) (n n
112f0 29 20 28 6c 6f 32 20 30 29 20 28 68 69 32 20 30 ) (lo2 0) (hi2 0
11300 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
11310 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
11320 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
11330 20 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 (retur
11340 6e 20 28 2b 20 6c 6f 20 6c 6f 32 29 20 28 61 6e n (+ lo lo2) (an
11350 64 20 68 69 20 68 69 32 20 28 2b 20 68 69 20 68 d hi hi2 (+ hi h
11360 69 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 i2))).
11370 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
11380 28 63 61 72 20 6c 73 29 20 6e 20 30 20 30 0a 20 (car ls) n 0 0.
11390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
113a0 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
113b0 20 28 6c 6f 33 20 68 69 33 29 0a 20 20 20 20 20 (lo3 hi3).
113c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
113d0 20 20 20 20 20 20 20 28 6c 70 32 20 28 63 64 72 (lp2 (cdr
113e0 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls).
113f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11400 20 20 20 20 20 20 28 2b 20 6e 20 28 73 72 65 2d (+ n (sre-
11410 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 68 65 73 count-submatches
11420 20 28 63 61 72 20 6c 73 29 29 29 0a 20 20 20 20 (car ls))).
11430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11440 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 (+
11450 6c 6f 32 20 6c 6f 33 29 0a 20 20 20 20 20 20 20 lo2 lo3).
11460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11470 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 68 (and h
11480 69 32 20 68 69 33 20 28 2b 20 68 69 32 20 68 69 i2 hi3 (+ hi2 hi
11490 33 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 3)))))))).
114a0 20 20 20 20 20 20 20 20 20 28 28 6f 72 29 0a 20 ((or).
114b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
114c0 6c 65 74 20 6c 70 32 20 28 28 6c 73 20 28 63 64 let lp2 ((ls (cd
114d0 72 20 73 72 65 29 29 20 28 6e 20 6e 29 20 28 6c r sre)) (n n) (l
114e0 6f 32 20 23 66 29 20 28 68 69 32 20 30 29 29 0a o2 #f) (hi2 0)).
114f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11500 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6c 73 29 (if (null? ls)
11510 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11520 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 28 (return (
11530 2b 20 6c 6f 20 28 6f 72 20 6c 6f 32 20 31 29 29 + lo (or lo2 1))
11540 20 28 61 6e 64 20 68 69 20 68 69 32 20 28 2b 20 (and hi hi2 (+
11550 68 69 20 68 69 32 29 29 29 0a 20 20 20 20 20 20 hi hi2))).
11560 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11570 28 6c 70 20 28 63 61 72 20 6c 73 29 20 6e 20 30 (lp (car ls) n 0
11580 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
11590 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
115a0 6d 62 64 61 20 28 6c 6f 33 20 68 69 33 29 0a 20 mbda (lo3 hi3).
115b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
115c0 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 32 20 (lp2
115d0 28 63 64 72 20 6c 73 29 0a 20 20 20 20 20 20 20 (cdr ls).
115e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
115f0 20 20 20 20 20 20 20 20 20 20 28 2b 20 6e 20 28 (+ n (
11600 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 sre-count-submat
11610 63 68 65 73 20 28 63 61 72 20 6c 73 29 29 29 0a ches (car ls))).
11620 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11630 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11640 20 28 69 66 20 6c 6f 32 20 28 6d 69 6e 20 6c 6f (if lo2 (min lo
11650 32 20 6c 6f 33 29 20 6c 6f 33 29 0a 20 20 20 20 2 lo3) lo3).
11660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11670 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
11680 64 20 68 69 32 20 68 69 33 20 28 6d 61 78 20 68 d hi2 hi3 (max h
11690 69 32 20 68 69 33 29 29 29 29 29 29 29 29 0a 20 i2 hi3)))))))).
116a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
116b0 69 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 if).
116c0 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
116d0 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 ((or
116e0 28 6e 75 6c 6c 3f 20 28 63 64 72 20 73 72 65 29 (null? (cdr sre)
116f0 29 20 28 6e 75 6c 6c 3f 20 28 63 64 64 72 20 73 ) (null? (cddr s
11700 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 re))).
11710 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 (return
11720 6c 6f 20 68 69 29 29 0a 20 20 20 20 20 20 20 20 lo hi)).
11730 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
11740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11750 20 28 6c 65 74 20 28 28 6e 31 20 28 73 72 65 2d (let ((n1 (sre-
11760 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 68 65 73 count-submatches
11770 20 28 63 61 72 20 73 72 65 29 29 29 0a 20 20 20 (car sre))).
11780 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11790 20 20 20 20 20 28 6e 32 20 28 73 72 65 2d 63 6f (n2 (sre-co
117a0 75 6e 74 2d 73 75 62 6d 61 74 63 68 65 73 20 28 unt-submatches (
117b0 63 61 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 cadr sre)))).
117c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
117d0 20 28 6c 70 20 28 69 66 20 28 6f 72 20 28 6e 75 (lp (if (or (nu
117e0 6d 62 65 72 3f 20 28 63 61 64 72 20 73 72 65 29 mber? (cadr sre)
117f0 29 20 28 73 79 6d 62 6f 6c 3f 20 28 63 61 64 72 ) (symbol? (cadr
11800 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 sre))).
11810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11820 20 20 20 20 27 65 70 73 69 6c 6f 6e 0a 20 20 20 'epsilon.
11830 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11840 20 20 20 20 20 20 20 20 20 28 63 61 64 72 20 73 (cadr s
11850 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 re)).
11860 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 20 6c n l
11870 6f 20 68 69 0a 20 20 20 20 20 20 20 20 20 20 20 o hi.
11880 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
11890 6d 62 64 61 20 28 6c 6f 32 20 68 69 32 29 0a 20 mbda (lo2 hi2).
118a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
118b0 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 61 (lp (ca
118c0 64 64 72 20 73 72 65 29 20 28 2b 20 6e 20 6e 31 ddr sre) (+ n n1
118d0 29 20 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 ) 0 0.
118e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
118f0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 6f 33 (lambda (lo3
11900 20 68 69 33 29 0a 20 20 20 20 20 20 20 20 20 20 hi3).
11910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11920 20 20 20 20 20 20 28 6c 70 20 28 69 66 20 28 70 (lp (if (p
11930 61 69 72 3f 20 28 63 64 64 64 72 20 73 72 65 29 air? (cdddr sre)
11940 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
11950 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11960 20 20 20 20 20 20 20 20 20 20 28 63 61 64 64 64 (caddd
11970 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 r sre).
11980 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
119a0 65 70 73 69 6c 6f 6e 29 0a 20 20 20 20 20 20 20 epsilon).
119b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119c0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 (+
119d0 6e 20 6e 31 20 6e 32 29 20 30 20 30 0a 20 20 20 n n1 n2) 0 0.
119e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
119f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a00 20 28 6c 61 6d 62 64 61 20 28 6c 6f 34 20 68 69 (lambda (lo4 hi
11a10 34 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 4).
11a20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a30 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e (return
11a40 20 28 2b 20 6c 6f 32 20 28 6d 69 6e 20 6c 6f 33 (+ lo2 (min lo3
11a50 20 6c 6f 34 29 29 0a 20 20 20 20 20 20 20 20 20 lo4)).
11a60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11a80 20 20 20 20 20 28 61 6e 64 20 68 69 32 20 68 69 (and hi2 hi
11a90 33 20 68 69 34 0a 20 20 20 20 20 20 20 20 20 20 3 hi4.
11aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ab0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ac0 20 20 20 20 20 20 20 20 20 28 2b 20 68 69 32 20 (+ hi2
11ad0 28 6d 61 78 20 68 69 33 20 68 69 34 29 29 0a 20 (max hi3 hi4)).
11ae0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11af0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11b10 20 20 29 29 29 29 29 29 29 29 29 29 29 29 0a 20 )))))))))))).
11b20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
11b30 64 73 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 dsm).
11b40 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d 73 65 (lp (sre-se
11b50 71 75 65 6e 63 65 20 28 63 64 64 64 72 20 73 72 quence (cdddr sr
11b60 65 29 29 20 28 2b 20 6e 20 28 63 61 64 72 20 73 e)) (+ n (cadr s
11b70 72 65 29 29 20 6c 6f 20 68 69 20 72 65 74 75 72 re)) lo hi retur
11b80 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 n)).
11b90 20 20 20 28 28 24 20 73 75 62 6d 61 74 63 68 20 (($ submatch
11ba0 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 => submatch-name
11bb0 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
11bc0 20 20 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 (lp (sre-sequ
11bd0 65 6e 63 65 0a 20 20 20 20 20 20 20 20 20 20 20 ence.
11be0 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 (if (e
11bf0 71 3f 20 27 73 75 62 6d 61 74 63 68 20 28 63 61 q? 'submatch (ca
11c00 72 20 73 72 65 29 29 20 28 63 64 72 20 73 72 65 r sre)) (cdr sre
11c10 29 20 28 63 64 64 72 20 73 72 65 29 29 29 0a 20 ) (cddr sre))).
11c20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c30 20 20 20 28 2b 20 6e 20 31 29 20 6c 6f 20 68 69 (+ n 1) lo hi
11c40 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11c50 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 6f (lambda (lo
11c60 32 20 68 69 32 29 0a 20 20 20 20 20 20 20 20 20 2 hi2).
11c70 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
11c80 63 74 6f 72 2d 73 65 74 21 20 73 75 62 6c 65 6e ctor-set! sublen
11c90 73 20 6e 20 28 63 6f 6e 73 20 6c 6f 32 20 68 69 s n (cons lo2 hi
11ca0 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
11cb0 20 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 (retur
11cc0 6e 20 6c 6f 32 20 68 69 32 29 29 29 29 0a 20 20 n lo2 hi2)))).
11cd0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 62 ((b
11ce0 61 63 6b 72 65 66 20 62 61 63 6b 72 65 66 2d 63 ackref backref-c
11cf0 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
11d00 20 20 20 28 6c 65 74 20 28 28 6e 20 28 63 6f 6e (let ((n (con
11d10 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
11d20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 ((nu
11d30 6d 62 65 72 3f 20 28 63 61 64 72 20 73 72 65 29 mber? (cadr sre)
11d40 29 20 28 63 61 64 72 20 73 72 65 29 29 0a 20 20 ) (cadr sre)).
11d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11d60 20 20 20 20 20 20 20 20 28 28 61 73 73 71 20 28 ((assq (
11d70 63 61 64 72 20 73 72 65 29 20 6e 61 6d 65 73 29 cadr sre) names)
11d80 20 3d 3e 20 63 64 72 29 0a 20 20 20 20 20 20 20 => cdr).
11d90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11da0 20 20 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 (else (error
11db0 22 75 6e 6b 6e 6f 77 6e 20 62 61 63 6b 72 65 66 "unknown backref
11dc0 65 72 65 6e 63 65 22 20 28 63 61 64 72 20 73 72 erence" (cadr sr
11dd0 65 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 e)))))).
11de0 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
11df0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11e00 20 20 20 28 28 6f 72 20 28 6e 6f 74 20 28 69 6e ((or (not (in
11e10 74 65 67 65 72 3f 20 6e 29 29 0a 20 20 20 20 20 teger? n)).
11e20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11e30 20 20 20 28 6e 6f 74 20 28 3c 20 30 20 6e 20 28 (not (< 0 n (
11e40 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 73 75 vector-length su
11e50 62 6c 65 6e 73 29 29 29 29 0a 20 20 20 20 20 20 blens)))).
11e60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
11e70 72 72 6f 72 20 22 73 72 65 2d 6c 65 6e 67 74 68 rror "sre-length
11e80 3a 20 69 6e 76 61 6c 69 64 20 62 61 63 6b 72 65 : invalid backre
11e90 66 65 72 65 6e 63 65 22 20 73 72 65 29 29 0a 20 ference" sre)).
11ea0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11eb0 20 20 28 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d ((not (vector-
11ec0 72 65 66 20 73 75 62 6c 65 6e 73 20 6e 29 29 0a ref sublens n)).
11ed0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ee0 20 20 20 20 28 65 72 72 6f 72 20 22 73 72 65 2d (error "sre-
11ef0 6c 65 6e 67 74 68 3a 20 69 6e 76 61 6c 69 64 20 length: invalid
11f00 66 6f 72 77 61 72 64 20 62 61 63 6b 72 65 66 65 forward backrefe
11f10 72 65 6e 63 65 22 20 73 72 65 29 29 0a 20 20 20 rence" sre)).
11f20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f30 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
11f40 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
11f50 28 6c 6f 32 20 28 63 61 72 20 28 76 65 63 74 6f (lo2 (car (vecto
11f60 72 2d 72 65 66 20 73 75 62 6c 65 6e 73 20 6e 29 r-ref sublens n)
11f70 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
11f80 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 69 (hi
11f90 32 20 28 63 64 72 20 28 76 65 63 74 6f 72 2d 72 2 (cdr (vector-r
11fa0 65 66 20 73 75 62 6c 65 6e 73 20 6e 29 29 29 29 ef sublens n))))
11fb0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11fc0 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 28 (return (
11fd0 2b 20 6c 6f 20 6c 6f 32 29 20 28 61 6e 64 20 68 + lo lo2) (and h
11fe0 69 20 68 69 32 20 28 2b 20 68 69 20 68 69 32 29 i hi2 (+ hi hi2)
11ff0 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
12000 20 20 20 20 20 20 20 28 28 2a 20 2a 3f 29 0a 20 ((* *?).
12010 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12020 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 lp (sre-sequence
12030 20 28 63 64 72 20 73 72 65 29 29 20 6e 20 6c 6f (cdr sre)) n lo
12040 20 68 69 20 28 6c 61 6d 62 64 61 20 28 6c 6f 20 hi (lambda (lo
12050 68 69 29 20 23 66 29 29 0a 20 20 20 20 20 20 20 hi) #f)).
12060 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e (return
12070 20 6c 6f 20 23 66 29 29 0a 20 20 20 20 20 20 20 lo #f)).
12080 20 20 20 20 20 20 20 20 28 28 2a 2a 20 2a 2a 3f ((** **?
12090 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
120a0 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
120b0 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 28 61 ((or (a
120c0 6e 64 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 nd (number? (cad
120d0 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
120e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
120f0 20 20 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 (number? (cad
12100 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 dr sre)).
12110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12120 20 20 20 20 28 3e 20 28 63 61 64 72 20 73 72 65 (> (cadr sre
12130 29 20 28 63 61 64 64 72 20 73 72 65 29 29 29 0a ) (caddr sre))).
12140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12150 20 20 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 (and (not
12160 28 63 61 64 72 20 73 72 65 29 29 20 28 63 61 64 (cadr sre)) (cad
12170 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 dr sre))).
12180 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 74 (ret
12190 75 72 6e 20 6c 6f 20 68 69 29 29 0a 20 20 20 20 urn lo hi)).
121a0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
121b0 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
121c0 20 20 20 20 20 28 69 66 20 28 63 61 64 64 72 20 (if (caddr
121d0 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 sre).
121e0 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
121f0 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
12200 64 64 72 20 73 72 65 29 29 20 6e 20 30 20 30 0a ddr sre)) n 0 0.
12210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12220 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
12230 61 20 28 6c 6f 32 20 68 69 32 29 0a 20 20 20 20 a (lo2 hi2).
12240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12250 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 (return
12260 28 2b 20 6c 6f 20 28 2a 20 28 63 61 64 72 20 73 (+ lo (* (cadr s
12270 72 65 29 20 6c 6f 32 29 29 0a 20 20 20 20 20 20 re) lo2)).
12280 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12290 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
122a0 6e 64 20 68 69 20 68 69 32 20 28 2b 20 68 69 20 nd hi hi2 (+ hi
122b0 28 2a 20 28 63 61 64 64 72 20 73 72 65 29 20 68 (* (caddr sre) h
122c0 69 32 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 i2)))))).
122d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
122e0 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 lp (sre-sequence
122f0 20 28 63 64 64 64 72 20 73 72 65 29 29 20 6e 20 (cdddr sre)) n
12300 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 0 0.
12310 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
12320 61 6d 62 64 61 20 28 6c 6f 32 20 68 69 32 29 0a ambda (lo2 hi2).
12330 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12340 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 74 (ret
12350 75 72 6e 20 28 2b 20 6c 6f 20 28 2a 20 28 63 61 urn (+ lo (* (ca
12360 64 72 20 73 72 65 29 20 6c 6f 32 29 29 20 23 66 dr sre) lo2)) #f
12370 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
12380 20 20 20 20 20 20 20 28 28 2b 29 0a 20 20 20 20 ((+).
12390 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
123a0 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 (sre-sequence (c
123b0 64 72 20 73 72 65 29 29 20 6e 20 6c 6f 20 68 69 dr sre)) n lo hi
123c0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
123d0 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 6f (lambda (lo
123e0 32 20 68 69 32 29 0a 20 20 20 20 20 20 20 20 20 2 hi2).
123f0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
12400 74 75 72 6e 20 28 2b 20 6c 6f 20 6c 6f 32 29 20 turn (+ lo lo2)
12410 23 66 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 #f)))).
12420 20 20 20 20 20 20 28 28 3f 20 3f 3f 29 0a 20 20 ((? ??).
12430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
12440 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 p (sre-sequence
12450 28 63 64 72 20 73 72 65 29 29 20 6e 20 6c 6f 20 (cdr sre)) n lo
12460 68 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 hi.
12470 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
12480 6c 6f 32 20 68 69 32 29 0a 20 20 20 20 20 20 20 lo2 hi2).
12490 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
124a0 72 65 74 75 72 6e 20 6c 6f 20 28 61 6e 64 20 68 return lo (and h
124b0 69 20 68 69 32 20 28 2b 20 68 69 20 68 69 32 29 i hi2 (+ hi hi2)
124c0 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
124d0 20 20 20 20 20 28 28 3d 20 3d 3f 20 3e 3d 20 3e ((= =? >= >
124e0 3d 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 =?).
124f0 20 20 20 20 28 6c 70 20 60 28 2a 2a 20 2c 28 63 (lp `(** ,(c
12500 61 64 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 adr sre).
12510 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12520 20 20 2c 28 69 66 20 28 6d 65 6d 71 20 28 63 61 ,(if (memq (ca
12530 72 20 73 72 65 29 20 27 28 3e 3d 20 3e 3d 3f 29 r sre) '(>= >=?)
12540 29 20 23 66 20 28 63 61 64 72 20 73 72 65 29 29 ) #f (cadr sre))
12550 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12560 20 20 20 20 20 20 20 20 20 20 2c 40 28 63 64 64 ,@(cdd
12570 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
12580 20 20 20 20 20 20 20 20 20 20 20 20 6e 20 6c 6f n lo
12590 20 68 69 20 72 65 74 75 72 6e 29 29 0a 20 20 20 hi return)).
125a0 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6c 6f ((lo
125b0 6f 6b 2d 61 68 65 61 64 20 6e 65 67 2d 6c 6f 6f ok-ahead neg-loo
125c0 6b 2d 61 68 65 61 64 20 6c 6f 6f 6b 2d 62 65 68 k-ahead look-beh
125d0 69 6e 64 20 6e 65 67 2d 6c 6f 6f 6b 2d 62 65 68 ind neg-look-beh
125e0 69 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 ind).
125f0 20 20 20 20 20 28 72 65 74 75 72 6e 20 6c 6f 20 (return lo
12600 68 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 hi)).
12610 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
12620 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
12630 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12640 20 28 28 61 73 73 71 20 28 63 61 72 20 73 72 65 ((assq (car sre
12650 29 20 73 72 65 2d 6e 61 6d 65 64 2d 64 65 66 69 ) sre-named-defi
12660 6e 69 74 69 6f 6e 73 29 0a 20 20 20 20 20 20 20 nitions).
12670 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c => (l
12680 61 6d 62 64 61 20 28 63 65 6c 6c 29 0a 20 20 20 ambda (cell).
12690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
126a0 20 20 20 20 28 6c 70 20 28 61 70 70 6c 79 20 28 (lp (apply (
126b0 63 64 72 20 63 65 6c 6c 29 20 28 63 64 72 20 73 cdr cell) (cdr s
126c0 72 65 29 29 20 6e 20 6c 6f 20 68 69 20 72 65 74 re)) n lo hi ret
126d0 75 72 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 urn))).
126e0 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
126f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12700 28 65 72 72 6f 72 20 22 73 72 65 2d 6c 65 6e 67 (error "sre-leng
12710 74 68 2d 72 61 6e 67 65 73 3a 20 75 6e 6b 6e 6f th-ranges: unkno
12720 77 6e 20 73 72 65 20 6f 70 65 72 61 74 6f 72 22 wn sre operator"
12730 20 73 72 65 29 29 29 29 29 29 29 0a 20 20 20 20 sre))))))).
12740 20 20 20 20 28 28 63 68 61 72 3f 20 73 72 65 29 ((char? sre)
12750 0a 20 20 20 20 20 20 20 20 20 28 67 72 6f 77 20 . (grow
12760 31 29 29 0a 20 20 20 20 20 20 20 20 28 28 73 74 1)). ((st
12770 72 69 6e 67 3f 20 73 72 65 29 0a 20 20 20 20 20 ring? sre).
12780 20 20 20 20 28 67 72 6f 77 20 28 73 74 72 69 6e (grow (strin
12790 67 2d 6c 65 6e 67 74 68 20 73 72 65 29 29 29 0a g-length sre))).
127a0 20 20 20 20 20 20 20 20 28 28 6d 65 6d 71 20 73 ((memq s
127b0 72 65 20 27 28 61 6e 79 20 6e 6f 6e 6c 29 29 0a re '(any nonl)).
127c0 20 20 20 20 20 20 20 20 20 28 67 72 6f 77 20 31 (grow 1
127d0 29 29 0a 20 20 20 20 20 20 20 20 28 28 6d 65 6d )). ((mem
127e0 71 20 73 72 65 20 27 28 65 70 73 69 6c 6f 6e 20 q sre '(epsilon
127f0 62 6f 73 20 65 6f 73 20 62 6f 6c 20 65 6f 6c 20 bos eos bol eol
12800 62 6f 77 20 65 6f 77 20 6e 77 62 20 63 6f 6d 6d bow eow nwb comm
12810 69 74 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 it)). (r
12820 65 74 75 72 6e 20 6c 6f 20 68 69 29 29 0a 20 20 eturn lo hi)).
12830 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
12840 20 20 20 20 20 28 6c 65 74 20 28 28 63 65 6c 6c (let ((cell
12850 20 28 61 73 73 71 20 73 72 65 20 73 72 65 2d 6e (assq sre sre-n
12860 61 6d 65 64 2d 64 65 66 69 6e 69 74 69 6f 6e 73 amed-definitions
12870 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
12880 69 66 20 63 65 6c 6c 0a 20 20 20 20 20 20 20 20 if cell.
12890 20 20 20 20 20 20 20 28 6c 70 20 28 69 66 20 28 (lp (if (
128a0 70 72 6f 63 65 64 75 72 65 3f 20 28 63 64 72 20 procedure? (cdr
128b0 63 65 6c 6c 29 29 20 28 28 63 64 72 20 63 65 6c cell)) ((cdr cel
128c0 6c 29 29 20 28 63 64 72 20 63 65 6c 6c 29 29 0a l)) (cdr cell)).
128d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
128e0 20 20 20 6e 20 6c 6f 20 68 69 20 72 65 74 75 72 n lo hi retur
128f0 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
12900 20 20 28 65 72 72 6f 72 20 22 73 72 65 2d 6c 65 (error "sre-le
12910 6e 67 74 68 2d 72 61 6e 67 65 73 3a 20 75 6e 6b ngth-ranges: unk
12920 6e 6f 77 6e 20 73 72 65 22 20 73 72 65 29 29 29 nown sre" sre)))
12930 29 29 29 29 0a 20 20 20 20 73 75 62 6c 65 6e 73 )))). sublens
12940 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ))..;;;;;;;;;;;;
12950 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
12960 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
12970 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
12980 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b ;;;;;;;;;;;;.;;;
12990 3b 20 53 52 45 20 4d 61 6e 69 70 75 6c 61 74 69 ; SRE Manipulati
129a0 6f 6e 0a 0a 3b 3b 20 62 75 69 6c 64 20 61 20 28 on..;; build a (
129b0 73 65 71 20 6c 73 20 2e 2e 2e 29 20 73 72 65 20 seq ls ...) sre
129c0 66 72 6f 6d 20 61 20 6c 69 73 74 0a 28 64 65 66 from a list.(def
129d0 69 6e 65 20 28 73 72 65 2d 73 65 71 75 65 6e 63 ine (sre-sequenc
129e0 65 20 6c 73 29 0a 20 20 28 63 6f 6e 64 0a 20 20 e ls). (cond.
129f0 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 20 27 65 70 ((null? ls) 'ep
12a00 73 69 6c 6f 6e 29 0a 20 20 20 28 28 6e 75 6c 6c silon). ((null
12a10 3f 20 28 63 64 72 20 6c 73 29 29 20 28 63 61 72 ? (cdr ls)) (car
12a20 20 6c 73 29 29 0a 20 20 20 28 65 6c 73 65 20 28 ls)). (else (
12a30 63 6f 6e 73 20 27 73 65 71 20 6c 73 29 29 29 29 cons 'seq ls))))
12a40 0a 0a 3b 3b 20 62 75 69 6c 64 20 61 20 28 6f 72 ..;; build a (or
12a50 20 6c 73 20 2e 2e 2e 29 20 73 72 65 20 66 72 6f ls ...) sre fro
12a60 6d 20 61 20 6c 69 73 74 0a 28 64 65 66 69 6e 65 m a list.(define
12a70 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 (sre-alternate
12a80 6c 73 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 ls). (cond. (
12a90 28 6e 75 6c 6c 3f 20 6c 73 29 20 27 28 6f 72 29 (null? ls) '(or)
12aa0 29 0a 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 64 ). ((null? (cd
12ab0 72 20 6c 73 29 29 20 28 63 61 72 20 6c 73 29 29 r ls)) (car ls))
12ac0 0a 20 20 20 28 65 6c 73 65 20 28 63 6f 6e 73 20 . (else (cons
12ad0 27 6f 72 20 6c 73 29 29 29 29 0a 0a 3b 3b 20 72 'or ls))))..;; r
12ae0 65 74 75 72 6e 73 20 61 6e 20 65 71 75 69 76 61 eturns an equiva
12af0 6c 65 6e 74 20 53 52 45 20 77 69 74 68 6f 75 74 lent SRE without
12b00 20 61 6e 79 20 6d 61 74 63 68 20 69 6e 66 6f 72 any match infor
12b10 6d 61 74 69 6f 6e 0a 28 64 65 66 69 6e 65 20 28 mation.(define (
12b20 73 72 65 2d 73 74 72 69 70 2d 73 75 62 6d 61 74 sre-strip-submat
12b30 63 68 65 73 20 73 72 65 29 0a 20 20 28 69 66 20 ches sre). (if
12b40 28 6e 6f 74 20 28 70 61 69 72 3f 20 73 72 65 29 (not (pair? sre)
12b50 29 0a 20 20 20 20 20 20 73 72 65 0a 20 20 20 20 ). sre.
12b60 20 20 28 63 61 73 65 20 28 63 61 72 20 73 72 65 (case (car sre
12b70 29 0a 20 20 20 20 20 20 20 20 28 28 24 20 73 75 ). (($ su
12b80 62 6d 61 74 63 68 29 20 28 73 72 65 2d 73 74 72 bmatch) (sre-str
12b90 69 70 2d 73 75 62 6d 61 74 63 68 65 73 20 28 73 ip-submatches (s
12ba0 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 72 re-sequence (cdr
12bb0 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 sre)))).
12bc0 20 28 28 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e ((=> submatch-n
12bd0 61 6d 65 64 29 20 28 73 72 65 2d 73 74 72 69 70 amed) (sre-strip
12be0 2d 73 75 62 6d 61 74 63 68 65 73 20 28 73 72 65 -submatches (sre
12bf0 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 72 20 -sequence (cddr
12c00 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
12c10 28 28 64 73 6d 29 20 28 73 72 65 2d 73 74 72 69 ((dsm) (sre-stri
12c20 70 2d 73 75 62 6d 61 74 63 68 65 73 20 28 73 72 p-submatches (sr
12c30 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 64 e-sequence (cddd
12c40 72 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 r sre)))).
12c50 20 20 28 65 6c 73 65 20 28 6d 61 70 20 73 72 65 (else (map sre
12c60 2d 73 74 72 69 70 2d 73 75 62 6d 61 74 63 68 65 -strip-submatche
12c70 73 20 73 72 65 29 29 29 29 29 0a 0a 3b 3b 20 67 s sre)))))..;; g
12c80 69 76 65 6e 20 61 20 63 68 61 72 2d 73 65 74 20 iven a char-set
12c90 6c 69 73 74 20 6f 66 20 63 68 61 72 73 20 61 6e list of chars an
12ca0 64 20 73 74 72 69 6e 67 73 2c 20 66 6c 61 74 74 d strings, flatt
12cb0 65 6e 73 20 74 68 65 6d 20 69 6e 74 6f 0a 3b 3b ens them into.;;
12cc0 20 63 68 61 72 73 20 6f 6e 6c 79 0a 28 64 65 66 chars only.(def
12cd0 69 6e 65 20 28 73 72 65 2d 66 6c 61 74 74 65 6e ine (sre-flatten
12ce0 2d 72 61 6e 67 65 73 20 6c 73 29 0a 20 20 28 6c -ranges ls). (l
12cf0 65 74 20 6c 70 20 28 28 6c 73 20 6c 73 29 20 28 et lp ((ls ls) (
12d00 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 63 res '())). (c
12d10 6f 6e 64 0a 20 20 20 20 20 28 28 6e 75 6c 6c 3f ond. ((null?
12d20 20 6c 73 29 0a 20 20 20 20 20 20 28 72 65 76 65 ls). (reve
12d30 72 73 65 20 72 65 73 29 29 0a 20 20 20 20 20 28 rse res)). (
12d40 28 73 74 72 69 6e 67 3f 20 28 63 61 72 20 6c 73 (string? (car ls
12d50 29 29 0a 20 20 20 20 20 20 28 6c 70 20 28 61 70 )). (lp (ap
12d60 70 65 6e 64 20 28 73 74 72 69 6e 67 2d 3e 6c 69 pend (string->li
12d70 73 74 20 28 63 61 72 20 6c 73 29 29 20 28 63 64 st (car ls)) (cd
12d80 72 20 6c 73 29 29 20 72 65 73 29 29 0a 20 20 20 r ls)) res)).
12d90 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 6c (else. (l
12da0 70 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 p (cdr ls) (cons
12db0 20 28 63 61 72 20 6c 73 29 20 72 65 73 29 29 29 (car ls) res)))
12dc0 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 72 )))..(define (sr
12dd0 65 2d 6e 61 6d 65 73 20 73 72 65 20 6e 20 6e 61 e-names sre n na
12de0 6d 65 73 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 mes). (if (not
12df0 28 70 61 69 72 3f 20 73 72 65 29 29 0a 20 20 20 (pair? sre)).
12e00 20 20 20 6e 61 6d 65 73 0a 20 20 20 20 20 20 28 names. (
12e10 63 61 73 65 20 28 63 61 72 20 73 72 65 29 0a 20 case (car sre).
12e20 20 20 20 20 20 20 20 28 28 24 20 73 75 62 6d 61 (($ subma
12e30 74 63 68 29 0a 20 20 20 20 20 20 20 20 20 28 73 tch). (s
12e40 72 65 2d 6e 61 6d 65 73 20 28 73 72 65 2d 73 65 re-names (sre-se
12e50 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 quence (cdr sre)
12e60 29 20 28 2b 20 6e 20 31 29 20 6e 61 6d 65 73 29 ) (+ n 1) names)
12e70 29 0a 20 20 20 20 20 20 20 20 28 28 3d 3e 20 73 ). ((=> s
12e80 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a 20 ubmatch-named).
12e90 20 20 20 20 20 20 20 20 28 73 72 65 2d 6e 61 6d (sre-nam
12ea0 65 73 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 es (sre-sequence
12eb0 20 28 63 64 64 72 20 73 72 65 29 29 0a 20 20 20 (cddr sre)).
12ec0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12ed0 20 28 2b 20 6e 20 31 29 0a 20 20 20 20 20 20 20 (+ n 1).
12ee0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
12ef0 6e 73 20 28 63 6f 6e 73 20 28 63 61 64 72 20 73 ns (cons (cadr s
12f00 72 65 29 20 6e 29 20 6e 61 6d 65 73 29 29 29 0a re) n) names))).
12f10 20 20 20 20 20 20 20 20 28 28 64 73 6d 29 0a 20 ((dsm).
12f20 20 20 20 20 20 20 20 20 28 73 72 65 2d 6e 61 6d (sre-nam
12f30 65 73 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 es (sre-sequence
12f40 20 28 63 64 64 64 72 20 73 72 65 29 29 20 28 2b (cdddr sre)) (+
12f50 20 6e 20 28 63 61 64 72 20 73 72 65 29 29 20 6e n (cadr sre)) n
12f60 61 6d 65 73 29 29 0a 20 20 20 20 20 20 20 20 28 ames)). (
12f70 28 73 65 71 20 3a 20 6f 72 20 2a 20 2b 20 3f 20 (seq : or * + ?
12f80 2a 3f 20 3f 3f 20 77 2f 63 61 73 65 20 77 2f 6e *? ?? w/case w/n
12f90 6f 63 61 73 65 20 61 74 6f 6d 69 63 0a 20 20 20 ocase atomic.
12fa0 20 20 20 20 20 20 20 6c 6f 6f 6b 2d 61 68 65 61 look-ahea
12fb0 64 20 6c 6f 6f 6b 2d 62 65 68 69 6e 64 20 6e 65 d look-behind ne
12fc0 67 2d 6c 6f 6f 6b 2d 61 68 65 61 64 20 6e 65 67 g-look-ahead neg
12fd0 2d 6c 6f 6f 6b 2d 62 65 68 69 6e 64 29 0a 20 20 -look-behind).
12fe0 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 71 75 (sre-sequ
12ff0 65 6e 63 65 2d 6e 61 6d 65 73 20 28 63 64 72 20 ence-names (cdr
13000 73 72 65 29 20 6e 20 6e 61 6d 65 73 29 29 0a 20 sre) n names)).
13010 20 20 20 20 20 20 20 28 28 3d 20 3e 3d 29 0a 20 ((= >=).
13020 20 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 71 (sre-seq
13030 75 65 6e 63 65 2d 6e 61 6d 65 73 20 28 63 64 64 uence-names (cdd
13040 72 20 73 72 65 29 20 6e 20 6e 61 6d 65 73 29 29 r sre) n names))
13050 0a 20 20 20 20 20 20 20 20 28 28 2a 2a 20 2a 2a . ((** **
13060 3f 29 0a 20 20 20 20 20 20 20 20 20 28 73 72 65 ?). (sre
13070 2d 73 65 71 75 65 6e 63 65 2d 6e 61 6d 65 73 20 -sequence-names
13080 28 63 64 64 64 72 20 73 72 65 29 20 6e 20 6e 61 (cdddr sre) n na
13090 6d 65 73 29 29 0a 20 20 20 20 20 20 20 20 28 65 mes)). (e
130a0 6c 73 65 0a 20 20 20 20 20 20 20 20 20 6e 61 6d lse. nam
130b0 65 73 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 es))))..(define
130c0 28 73 72 65 2d 73 65 71 75 65 6e 63 65 2d 6e 61 (sre-sequence-na
130d0 6d 65 73 20 6c 73 20 6e 20 6e 61 6d 65 73 29 0a mes ls n names).
130e0 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6c 73 29 (if (null? ls)
130f0 0a 20 20 20 20 20 20 6e 61 6d 65 73 0a 20 20 20 . names.
13100 20 20 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 (sre-sequence
13110 2d 6e 61 6d 65 73 20 28 63 64 72 20 6c 73 29 0a -names (cdr ls).
13120 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13130 20 20 20 20 20 20 20 20 20 20 28 2b 20 6e 20 28 (+ n (
13140 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 sre-count-submat
13150 63 68 65 73 20 28 63 61 72 20 6c 73 29 29 29 0a ches (car ls))).
13160 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13170 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 6e (sre-n
13180 61 6d 65 73 20 28 63 61 72 20 6c 73 29 20 6e 20 ames (car ls) n
13190 6e 61 6d 65 73 29 29 29 29 0a 0a 28 64 65 66 69 names))))..(defi
131a0 6e 65 20 28 73 72 65 2d 72 65 6d 6f 76 65 2d 69 ne (sre-remove-i
131b0 6e 69 74 69 61 6c 2d 62 6f 73 20 73 72 65 29 0a nitial-bos sre).
131c0 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 70 61 69 (cond. ((pai
131d0 72 3f 20 73 72 65 29 0a 20 20 20 20 28 63 61 73 r? sre). (cas
131e0 65 20 28 63 61 72 20 73 72 65 29 0a 20 20 20 20 e (car sre).
131f0 20 20 28 28 73 65 71 20 3a 20 24 20 73 75 62 6d ((seq : $ subm
13200 61 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 atch => submatch
13210 2d 6e 61 6d 65 64 20 2a 20 2b 29 0a 20 20 20 20 -named * +).
13220 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
13230 20 28 28 6e 6f 74 20 28 70 61 69 72 3f 20 28 63 ((not (pair? (c
13240 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 dr sre))).
13250 20 20 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 sre).
13260 28 28 65 71 3f 20 27 62 6f 73 20 28 63 61 64 72 ((eq? 'bos (cadr
13270 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
13280 28 63 6f 6e 73 20 28 63 61 72 20 73 72 65 29 20 (cons (car sre)
13290 28 63 64 64 72 20 73 72 65 29 29 29 0a 20 20 20 (cddr sre))).
132a0 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
132b0 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 73 (cons (car s
132c0 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 re).
132d0 20 20 20 28 63 6f 6e 73 20 28 73 72 65 2d 72 65 (cons (sre-re
132e0 6d 6f 76 65 2d 69 6e 69 74 69 61 6c 2d 62 6f 73 move-initial-bos
132f0 20 28 63 61 64 72 20 73 72 65 29 29 20 28 63 64 (cadr sre)) (cd
13300 64 72 20 73 72 65 29 29 29 29 29 29 0a 20 20 20 dr sre)))))).
13310 20 20 20 28 28 6f 72 29 0a 20 20 20 20 20 20 20 ((or).
13320 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 28 (sre-alternate (
13330 6d 61 70 20 73 72 65 2d 72 65 6d 6f 76 65 2d 69 map sre-remove-i
13340 6e 69 74 69 61 6c 2d 62 6f 73 20 28 63 64 72 20 nitial-bos (cdr
13350 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 28 65 sre)))). (e
13360 6c 73 65 0a 20 20 20 20 20 20 20 73 72 65 29 29 lse. sre))
13370 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 20 73 ). (else. s
13380 72 65 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b re)))..;;;;;;;;;
13390 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
133a0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
133b0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
133c0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a ;;;;;;;;;;;;;;;.
133d0 3b 3b 3b 3b 20 42 61 73 69 63 20 4d 61 74 63 68 ;;;; Basic Match
133e0 69 6e 67 0a 0a 28 64 65 66 69 6e 65 20 69 72 72 ing..(define irr
133f0 65 67 65 78 2d 62 61 73 69 63 2d 73 74 72 69 6e egex-basic-strin
13400 67 2d 63 68 75 6e 6b 65 72 0a 20 20 28 6d 61 6b g-chunker. (mak
13410 65 2d 69 72 72 65 67 65 78 2d 63 68 75 6e 6b 65 e-irregex-chunke
13420 72 20 28 6c 61 6d 62 64 61 20 28 78 29 20 23 66 r (lambda (x) #f
13430 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
13440 20 20 20 20 20 20 20 20 20 20 63 61 72 0a 20 20 car.
13450 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13460 20 20 20 20 20 20 63 61 64 72 0a 20 20 20 20 20 cadr.
13470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13480 20 20 20 63 61 64 64 72 0a 20 20 20 20 20 20 20 caddr.
13490 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
134a0 20 28 6c 61 6d 62 64 61 20 28 73 72 63 31 20 69 (lambda (src1 i
134b0 20 73 72 63 32 20 6a 29 0a 20 20 20 20 20 20 20 src2 j).
134c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
134d0 20 20 20 28 73 75 62 73 74 72 69 6e 67 20 28 63 (substring (c
134e0 61 72 20 73 72 63 31 29 20 69 20 6a 29 29 29 29 ar src1) i j))))
134f0 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 ..(define (irreg
13500 65 78 2d 73 65 61 72 63 68 20 78 20 73 74 72 20 ex-search x str
13510 2e 20 6f 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 . o). (if (not
13520 28 73 74 72 69 6e 67 3f 20 73 74 72 29 29 20 28 (string? str)) (
13530 65 72 72 6f 72 20 22 69 72 72 65 67 65 78 2d 73 error "irregex-s
13540 65 61 72 63 68 3a 20 6e 6f 74 20 61 20 73 74 72 earch: not a str
13550 69 6e 67 22 20 73 74 72 29 29 0a 20 20 28 6c 65 ing" str)). (le
13560 74 20 28 28 73 74 61 72 74 20 28 6f 72 20 28 61 t ((start (or (a
13570 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 nd (pair? o) (ca
13580 72 20 6f 29 29 20 30 29 29 0a 20 20 20 20 20 20 r o)) 0)).
13590 20 20 28 65 6e 64 20 28 6f 72 20 28 61 6e 64 20 (end (or (and
135a0 28 70 61 69 72 3f 20 6f 29 20 28 70 61 69 72 3f (pair? o) (pair?
135b0 20 28 63 64 72 20 6f 29 29 20 28 63 61 64 72 20 (cdr o)) (cadr
135c0 6f 29 29 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 o)) (string-leng
135d0 74 68 20 73 74 72 29 29 29 29 0a 20 20 20 20 28 th str)))). (
135e0 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 28 69 6e if (not (and (in
135f0 74 65 67 65 72 3f 20 73 74 61 72 74 29 20 28 65 teger? start) (e
13600 78 61 63 74 3f 20 73 74 61 72 74 29 29 29 0a 20 xact? start))).
13610 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 69 (error "i
13620 72 72 65 67 65 78 2d 73 65 61 72 63 68 3a 20 6e rregex-search: n
13630 6f 74 20 61 6e 20 65 78 61 63 74 20 69 6e 74 65 ot an exact inte
13640 67 65 72 22 20 73 74 61 72 74 29 29 0a 20 20 20 ger" start)).
13650 20 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 28 (if (not (and (
13660 69 6e 74 65 67 65 72 3f 20 65 6e 64 29 20 28 65 integer? end) (e
13670 78 61 63 74 3f 20 65 6e 64 29 29 29 0a 20 20 20 xact? end))).
13680 20 20 20 20 20 28 65 72 72 6f 72 20 22 69 72 72 (error "irr
13690 65 67 65 78 2d 73 65 61 72 63 68 3a 20 6e 6f 74 egex-search: not
136a0 20 61 6e 20 65 78 61 63 74 20 69 6e 74 65 67 65 an exact intege
136b0 72 22 20 65 6e 64 29 29 0a 20 20 20 20 28 69 72 r" end)). (ir
136c0 72 65 67 65 78 2d 73 65 61 72 63 68 2f 63 68 75 regex-search/chu
136d0 6e 6b 65 64 20 78 0a 20 20 20 20 20 20 20 20 20 nked x.
136e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
136f0 20 20 20 69 72 72 65 67 65 78 2d 62 61 73 69 63 irregex-basic
13700 2d 73 74 72 69 6e 67 2d 63 68 75 6e 6b 65 72 0a -string-chunker.
13710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13720 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 (lis
13730 74 20 73 74 72 20 73 74 61 72 74 20 65 6e 64 29 t str start end)
13740 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
13750 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 sta
13760 72 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 rt)))..(define (
13770 69 72 72 65 67 65 78 2d 73 65 61 72 63 68 2f 63 irregex-search/c
13780 68 75 6e 6b 65 64 20 78 20 63 6e 6b 20 73 72 63 hunked x cnk src
13790 20 2e 20 6f 29 0a 20 20 28 6c 65 74 2a 20 28 28 . o). (let* ((
137a0 69 72 78 20 28 69 72 72 65 67 65 78 20 78 29 29 irx (irregex x))
137b0 0a 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 . (match
137c0 65 73 20 28 69 72 72 65 67 65 78 2d 6e 65 77 2d es (irregex-new-
137d0 6d 61 74 63 68 65 73 20 69 72 78 29 29 0a 20 20 matches irx)).
137e0 20 20 20 20 20 20 20 28 69 20 28 69 66 20 28 70 (i (if (p
137f0 61 69 72 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 air? o) (car o)
13800 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 ((chunker-get-st
13810 61 72 74 20 63 6e 6b 29 20 73 72 63 29 29 29 29 art cnk) src))))
13820 0a 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 . (irregex-ma
13830 74 63 68 2d 63 68 75 6e 6b 65 72 2d 73 65 74 21 tch-chunker-set!
13840 20 6d 61 74 63 68 65 73 20 63 6e 6b 29 0a 20 20 matches cnk).
13850 20 20 28 69 72 72 65 67 65 78 2d 73 65 61 72 63 (irregex-searc
13860 68 2f 6d 61 74 63 68 65 73 20 69 72 78 20 63 6e h/matches irx cn
13870 6b 20 28 63 6f 6e 73 20 73 72 63 20 69 29 20 73 k (cons src i) s
13880 72 63 20 69 20 6d 61 74 63 68 65 73 29 29 29 0a rc i matches))).
13890 0a 3b 3b 20 69 6e 74 65 72 6e 61 6c 20 72 6f 75 .;; internal rou
138a0 74 69 6e 65 2c 20 63 61 6e 20 62 65 20 75 73 65 tine, can be use
138b0 64 20 69 6e 20 6c 6f 6f 70 73 20 74 6f 20 61 76 d in loops to av
138c0 6f 69 64 20 72 65 61 6c 6c 6f 63 61 74 69 6e 67 oid reallocating
138d0 20 74 68 65 0a 3b 3b 20 6d 61 74 63 68 20 76 65 the.;; match ve
138e0 63 74 6f 72 0a 28 64 65 66 69 6e 65 20 28 69 72 ctor.(define (ir
138f0 72 65 67 65 78 2d 73 65 61 72 63 68 2f 6d 61 74 regex-search/mat
13900 63 68 65 73 20 69 72 78 20 63 6e 6b 20 69 6e 69 ches irx cnk ini
13910 74 20 73 72 63 20 69 20 6d 61 74 63 68 65 73 29 t src i matches)
13920 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 69 72 . (cond. ((ir
13930 72 65 67 65 78 2d 64 66 61 20 69 72 78 29 0a 20 regex-dfa irx).
13940 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 (cond. ((
13950 66 6c 61 67 2d 73 65 74 3f 20 28 69 72 72 65 67 flag-set? (irreg
13960 65 78 2d 66 6c 61 67 73 20 69 72 78 29 20 7e 73 ex-flags irx) ~s
13970 65 61 72 63 68 65 72 3f 29 0a 20 20 20 20 20 20 earcher?).
13980 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 28 28 64 (cond. ((d
13990 66 61 2d 6d 61 74 63 68 2f 6c 6f 6e 67 65 73 74 fa-match/longest
139a0 20 28 69 72 72 65 67 65 78 2d 64 66 61 20 69 72 (irregex-dfa ir
139b0 78 29 20 63 6e 6b 20 73 72 63 20 69 20 23 66 20 x) cnk src i #f
139c0 23 66 20 6d 61 74 63 68 65 73 20 30 29 0a 20 20 #f matches 0).
139d0 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d (irregex-m
139e0 61 74 63 68 2d 73 74 61 72 74 2d 63 68 75 6e 6b atch-start-chunk
139f0 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 30 20 -set! matches 0
13a00 73 72 63 29 0a 20 20 20 20 20 20 20 20 28 69 72 src). (ir
13a10 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 regex-match-star
13a20 74 2d 69 6e 64 65 78 2d 73 65 74 21 20 6d 61 74 t-index-set! mat
13a30 63 68 65 73 20 30 20 69 29 0a 20 20 20 20 20 20 ches 0 i).
13a40 20 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 matches).
13a50 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
13a60 23 66 29 29 29 0a 20 20 20 20 20 28 28 64 66 61 #f))). ((dfa
13a70 2d 6d 61 74 63 68 2f 73 68 6f 72 74 65 73 74 0a -match/shortest.
13a80 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
13a90 64 66 61 2f 73 65 61 72 63 68 20 69 72 78 29 20 dfa/search irx)
13aa0 63 6e 6b 20 73 72 63 20 69 20 6d 61 74 63 68 65 cnk src i matche
13ab0 73 20 30 29 0a 20 20 20 20 20 20 28 6c 65 74 20 s 0). (let
13ac0 28 28 64 66 61 20 28 69 72 72 65 67 65 78 2d 64 ((dfa (irregex-d
13ad0 66 61 20 69 72 78 29 29 0a 20 20 20 20 20 20 20 fa irx)).
13ae0 20 20 20 20 20 28 67 65 74 2d 73 74 61 72 74 20 (get-start
13af0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 (chunker-get-sta
13b00 72 74 20 63 6e 6b 29 29 0a 20 20 20 20 20 20 20 rt cnk)).
13b10 20 20 20 20 20 28 67 65 74 2d 65 6e 64 20 28 63 (get-end (c
13b20 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 hunker-get-end c
13b30 6e 6b 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 nk)).
13b40 20 28 67 65 74 2d 6e 65 78 74 20 28 63 68 75 6e (get-next (chun
13b50 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b ker-get-next cnk
13b60 29 29 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 ))). (let
13b70 20 6c 70 31 20 28 28 73 72 63 20 73 72 63 29 20 lp1 ((src src)
13b80 28 69 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 (i i)).
13b90 20 28 6c 65 74 20 28 28 65 6e 64 20 28 67 65 74 (let ((end (get
13ba0 2d 65 6e 64 20 73 72 63 29 29 29 0a 20 20 20 20 -end src))).
13bb0 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 32 (let lp2
13bc0 20 28 28 69 20 69 29 29 0a 20 20 20 20 20 20 20 ((i i)).
13bd0 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
13be0 20 20 20 20 20 20 20 20 20 20 20 20 28 28 64 66 ((df
13bf0 61 2d 6d 61 74 63 68 2f 6c 6f 6e 67 65 73 74 20 a-match/longest
13c00 64 66 61 20 63 6e 6b 20 73 72 63 20 69 20 23 66 dfa cnk src i #f
13c10 20 23 66 20 6d 61 74 63 68 65 73 20 30 29 0a 20 #f matches 0).
13c20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
13c30 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 irregex-match-st
13c40 61 72 74 2d 63 68 75 6e 6b 2d 73 65 74 21 20 6d art-chunk-set! m
13c50 61 74 63 68 65 73 20 30 20 73 72 63 29 0a 20 20 atches 0 src).
13c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
13c70 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 rregex-match-sta
13c80 72 74 2d 69 6e 64 65 78 2d 73 65 74 21 20 6d 61 rt-index-set! ma
13c90 74 63 68 65 73 20 30 20 69 29 0a 20 20 20 20 20 tches 0 i).
13ca0 20 20 20 20 20 20 20 20 20 20 20 6d 61 74 63 68 match
13cb0 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 es).
13cc0 20 20 20 28 28 3e 3d 20 69 20 65 6e 64 29 0a 20 ((>= i end).
13cd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
13ce0 6c 65 74 20 28 28 6e 65 78 74 20 28 67 65 74 2d let ((next (get-
13cf0 6e 65 78 74 20 73 72 63 29 29 29 0a 20 20 20 20 next src))).
13d00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
13d10 6e 64 20 6e 65 78 74 20 28 6c 70 31 20 6e 65 78 nd next (lp1 nex
13d20 74 20 28 67 65 74 2d 73 74 61 72 74 20 6e 65 78 t (get-start nex
13d30 74 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 t))))).
13d40 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
13d50 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 32 (lp2
13d60 20 28 2b 20 69 20 31 29 29 29 29 29 29 29 29 29 (+ i 1)))))))))
13d70 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 . (else.
13d80 20 20 23 66 29 29 29 0a 20 20 20 28 65 6c 73 65 #f))). (else
13d90 0a 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 . (let ((res
13da0 28 69 72 72 65 67 65 78 2d 73 65 61 72 63 68 2f (irregex-search/
13db0 62 61 63 6b 74 72 61 63 6b 20 69 72 78 20 63 6e backtrack irx cn
13dc0 6b 20 69 6e 69 74 20 73 72 63 20 69 20 6d 61 74 k init src i mat
13dd0 63 68 65 73 29 29 29 0a 20 20 20 20 20 20 28 69 ches))). (i
13de0 66 20 72 65 73 20 28 25 69 72 72 65 67 65 78 2d f res (%irregex-
13df0 6d 61 74 63 68 2d 66 61 69 6c 2d 73 65 74 21 20 match-fail-set!
13e00 72 65 73 20 23 66 29 29 0a 20 20 20 20 20 20 72 res #f)). r
13e10 65 73 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 es))))..(define
13e20 28 69 72 72 65 67 65 78 2d 73 65 61 72 63 68 2f (irregex-search/
13e30 62 61 63 6b 74 72 61 63 6b 20 69 72 78 20 63 6e backtrack irx cn
13e40 6b 20 69 6e 69 74 20 73 72 63 20 69 20 6d 61 74 k init src i mat
13e50 63 68 65 73 29 0a 20 20 28 6c 65 74 20 28 28 6d ches). (let ((m
13e60 61 74 63 68 65 72 20 28 69 72 72 65 67 65 78 2d atcher (irregex-
13e70 6e 66 61 20 69 72 78 29 29 0a 20 20 20 20 20 20 nfa irx)).
13e80 20 20 28 73 74 72 20 28 28 63 68 75 6e 6b 65 72 (str ((chunker
13e90 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 73 72 -get-str cnk) sr
13ea0 63 29 29 0a 20 20 20 20 20 20 20 20 28 65 6e 64 c)). (end
13eb0 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 ((chunker-get-e
13ec0 6e 64 20 63 6e 6b 29 20 73 72 63 29 29 0a 20 20 nd cnk) src)).
13ed0 20 20 20 20 20 20 28 67 65 74 2d 6e 65 78 74 20 (get-next
13ee0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 (chunker-get-nex
13ef0 74 20 63 6e 6b 29 29 29 0a 20 20 20 20 28 69 66 t cnk))). (if
13f00 20 28 66 6c 61 67 2d 73 65 74 3f 20 28 69 72 72 (flag-set? (irr
13f10 65 67 65 78 2d 66 6c 61 67 73 20 69 72 78 29 20 egex-flags irx)
13f20 7e 73 65 61 72 63 68 65 72 3f 29 0a 20 20 20 20 ~searcher?).
13f30 20 20 20 20 28 6d 61 74 63 68 65 72 20 63 6e 6b (matcher cnk
13f40 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
13f50 65 6e 64 20 6d 61 74 63 68 65 73 20 28 6c 61 6d end matches (lam
13f60 62 64 61 20 28 29 20 23 66 29 29 0a 20 20 20 20 bda () #f)).
13f70 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 73 72 (let lp ((sr
13f80 63 32 20 73 72 63 29 0a 20 20 20 20 20 20 20 20 c2 src).
13f90 20 20 20 20 20 20 20 20 20 28 73 74 72 20 73 74 (str st
13fa0 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r).
13fb0 20 20 20 20 28 69 20 69 29 0a 20 20 20 20 20 20 (i i).
13fc0 20 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 (end
13fd0 65 6e 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 end)).
13fe0 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
13ff0 20 28 28 6d 61 74 63 68 65 72 20 63 6e 6b 20 69 ((matcher cnk i
14000 6e 69 74 20 73 72 63 32 20 73 74 72 20 69 20 65 nit src2 str i e
14010 6e 64 20 6d 61 74 63 68 65 73 20 28 6c 61 6d 62 nd matches (lamb
14020 64 61 20 28 29 20 23 66 29 29 0a 20 20 20 20 20 da () #f)).
14030 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
14040 6d 61 74 63 68 2d 73 74 61 72 74 2d 63 68 75 6e match-start-chun
14050 6b 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 30 k-set! matches 0
14060 20 73 72 63 32 29 0a 20 20 20 20 20 20 20 20 20 src2).
14070 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
14080 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 2d 73 65 h-start-index-se
14090 74 21 20 6d 61 74 63 68 65 73 20 30 20 69 29 0a t! matches 0 i).
140a0 20 20 20 20 20 20 20 20 20 20 20 20 6d 61 74 63 matc
140b0 68 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 hes).
140c0 28 28 3c 20 69 20 65 6e 64 29 0a 20 20 20 20 20 ((< i end).
140d0 20 20 20 20 20 20 20 28 6c 70 20 73 72 63 32 20 (lp src2
140e0 73 74 72 20 28 2b 20 69 20 31 29 20 65 6e 64 29 str (+ i 1) end)
140f0 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 6c ). (el
14100 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 se. (
14110 6c 65 74 20 28 28 73 72 63 32 20 28 67 65 74 2d let ((src2 (get-
14120 6e 65 78 74 20 73 72 63 32 29 29 29 0a 20 20 20 next src2))).
14130 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 73 (if s
14140 72 63 32 0a 20 20 20 20 20 20 20 20 20 20 20 20 rc2.
14150 20 20 20 20 20 20 28 6c 70 20 73 72 63 32 0a 20 (lp src2.
14160 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14170 20 20 20 20 20 28 28 63 68 75 6e 6b 65 72 2d 67 ((chunker-g
14180 65 74 2d 73 74 72 20 63 6e 6b 29 20 73 72 63 32 et-str cnk) src2
14190 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
141a0 20 20 20 20 20 20 20 20 28 28 63 68 75 6e 6b 65 ((chunke
141b0 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 r-get-start cnk)
141c0 20 73 72 63 32 29 0a 20 20 20 20 20 20 20 20 20 src2).
141d0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 ((c
141e0 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 hunker-get-end c
141f0 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 nk) src2)).
14200 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 #f)
14210 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
14220 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 20 (irregex-match
14230 69 72 78 20 73 74 72 20 2e 20 6f 29 0a 20 20 28 irx str . o). (
14240 69 66 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3f if (not (string?
14250 20 73 74 72 29 29 20 28 65 72 72 6f 72 20 22 69 str)) (error "i
14260 72 72 65 67 65 78 2d 6d 61 74 63 68 3a 20 6e 6f rregex-match: no
14270 74 20 61 20 73 74 72 69 6e 67 22 20 73 74 72 29 t a string" str)
14280 29 0a 20 20 28 6c 65 74 20 28 28 73 74 61 72 74 ). (let ((start
14290 20 28 6f 72 20 28 61 6e 64 20 28 70 61 69 72 3f (or (and (pair?
142a0 20 6f 29 20 28 63 61 72 20 6f 29 29 20 30 29 29 o) (car o)) 0))
142b0 0a 20 20 20 20 20 20 20 20 28 65 6e 64 20 28 6f . (end (o
142c0 72 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 r (and (pair? o)
142d0 20 28 70 61 69 72 3f 20 28 63 64 72 20 6f 29 29 (pair? (cdr o))
142e0 20 28 63 61 64 72 20 6f 29 29 20 28 73 74 72 69 (cadr o)) (stri
142f0 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 29 ng-length str)))
14300 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
14310 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 73 74 and (integer? st
14320 61 72 74 29 20 28 65 78 61 63 74 3f 20 73 74 61 art) (exact? sta
14330 72 74 29 29 29 0a 20 20 20 20 20 20 20 20 28 65 rt))). (e
14340 72 72 6f 72 20 22 69 72 72 65 67 65 78 2d 6d 61 rror "irregex-ma
14350 74 63 68 3a 20 6e 6f 74 20 61 6e 20 65 78 61 63 tch: not an exac
14360 74 20 69 6e 74 65 67 65 72 22 20 73 74 61 72 74 t integer" start
14370 29 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 )). (if (not
14380 28 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 65 (and (integer? e
14390 6e 64 29 20 28 65 78 61 63 74 3f 20 65 6e 64 29 nd) (exact? end)
143a0 29 29 0a 20 20 20 20 20 20 20 20 28 65 72 72 6f )). (erro
143b0 72 20 22 69 72 72 65 67 65 78 2d 6d 61 74 63 68 r "irregex-match
143c0 3a 20 6e 6f 74 20 61 6e 20 65 78 61 63 74 20 69 : not an exact i
143d0 6e 74 65 67 65 72 22 20 65 6e 64 29 29 0a 20 20 nteger" end)).
143e0 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (irregex-match
143f0 2f 63 68 75 6e 6b 65 64 20 69 72 78 0a 20 20 20 /chunked irx.
14400 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14410 20 20 20 20 20 20 20 20 69 72 72 65 67 65 78 2d irregex-
14420 62 61 73 69 63 2d 73 74 72 69 6e 67 2d 63 68 75 basic-string-chu
14430 6e 6b 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 nker.
14440 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14450 28 6c 69 73 74 20 73 74 72 20 73 74 61 72 74 20 (list str start
14460 65 6e 64 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 end))))..(define
14470 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2f (irregex-match/
14480 63 68 75 6e 6b 65 64 20 69 72 78 20 63 6e 6b 20 chunked irx cnk
14490 73 72 63 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 src). (let* ((i
144a0 72 78 20 28 69 72 72 65 67 65 78 20 69 72 78 29 rx (irregex irx)
144b0 29 0a 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 ). (matc
144c0 68 65 73 20 28 69 72 72 65 67 65 78 2d 6e 65 77 hes (irregex-new
144d0 2d 6d 61 74 63 68 65 73 20 69 72 78 29 29 29 0a -matches irx))).
144e0 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 (irregex-mat
144f0 63 68 2d 63 68 75 6e 6b 65 72 2d 73 65 74 21 20 ch-chunker-set!
14500 6d 61 74 63 68 65 73 20 63 6e 6b 29 0a 20 20 20 matches cnk).
14510 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 69 72 (cond. ((ir
14520 72 65 67 65 78 2d 64 66 61 20 69 72 78 29 0a 20 regex-dfa irx).
14530 20 20 20 20 20 28 61 6e 64 0a 20 20 20 20 20 20 (and.
14540 20 28 64 66 61 2d 6d 61 74 63 68 2f 6c 6f 6e 67 (dfa-match/long
14550 65 73 74 0a 20 20 20 20 20 20 20 20 28 69 72 72 est. (irr
14560 65 67 65 78 2d 64 66 61 20 69 72 78 29 20 63 6e egex-dfa irx) cn
14570 6b 20 73 72 63 20 28 28 63 68 75 6e 6b 65 72 2d k src ((chunker-
14580 67 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 get-start cnk) s
14590 72 63 29 20 23 66 20 23 66 20 6d 61 74 63 68 65 rc) #f #f matche
145a0 73 20 30 29 0a 20 20 20 20 20 20 20 28 3d 20 28 s 0). (= (
145b0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 (chunker-get-end
145c0 20 63 6e 6b 29 20 28 25 69 72 72 65 67 65 78 2d cnk) (%irregex-
145d0 6d 61 74 63 68 2d 65 6e 64 2d 63 68 75 6e 6b 20 match-end-chunk
145e0 6d 61 74 63 68 65 73 20 30 29 29 0a 20 20 20 20 matches 0)).
145f0 20 20 20 20 20 20 28 25 69 72 72 65 67 65 78 2d (%irregex-
14600 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 match-end-index
14610 6d 61 74 63 68 65 73 20 30 29 29 0a 20 20 20 20 matches 0)).
14620 20 20 20 28 62 65 67 69 6e 0a 20 20 20 20 20 20 (begin.
14630 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
14640 68 2d 73 74 61 72 74 2d 63 68 75 6e 6b 2d 73 65 h-start-chunk-se
14650 74 21 20 6d 61 74 63 68 65 73 20 30 20 73 72 63 t! matches 0 src
14660 29 0a 20 20 20 20 20 20 20 20 20 28 69 72 72 65 ). (irre
14670 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d gex-match-start-
14680 69 6e 64 65 78 2d 73 65 74 21 20 6d 61 74 63 68 index-set! match
14690 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 es.
146a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146b0 20 20 20 20 20 20 20 20 20 20 20 20 30 0a 20 20 0.
146c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146e0 20 20 20 20 20 20 20 28 28 63 68 75 6e 6b 65 72 ((chunker
146f0 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 -get-start cnk)
14700 73 72 63 29 29 0a 20 20 20 20 20 20 20 20 20 6d src)). m
14710 61 74 63 68 65 73 29 29 29 0a 20 20 20 20 20 28 atches))). (
14720 65 6c 73 65 0a 20 20 20 20 20 20 28 6c 65 74 2a else. (let*
14730 20 28 28 6d 61 74 63 68 65 72 20 28 69 72 72 65 ((matcher (irre
14740 67 65 78 2d 6e 66 61 20 69 72 78 29 29 0a 20 20 gex-nfa irx)).
14750 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 20 (str
14760 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 ((chunker-get-st
14770 72 20 63 6e 6b 29 20 73 72 63 29 29 0a 20 20 20 r cnk) src)).
14780 20 20 20 20 20 20 20 20 20 20 28 69 20 28 28 63 (i ((c
14790 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 hunker-get-start
147a0 20 63 6e 6b 29 20 73 72 63 29 29 0a 20 20 20 20 cnk) src)).
147b0 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 28 28 (end ((
147c0 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 chunker-get-end
147d0 63 6e 6b 29 20 73 72 63 29 29 0a 20 20 20 20 20 cnk) src)).
147e0 20 20 20 20 20 20 20 20 28 69 6e 69 74 20 28 63 (init (c
147f0 6f 6e 73 20 73 72 63 20 69 29 29 29 0a 20 20 20 ons src i))).
14800 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 6d (let lp ((m
14810 20 28 6d 61 74 63 68 65 72 20 63 6e 6b 20 69 6e (matcher cnk in
14820 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
14830 20 6d 61 74 63 68 65 73 20 28 6c 61 6d 62 64 61 matches (lambda
14840 20 28 29 20 23 66 29 29 29 29 0a 20 20 20 20 20 () #f)))).
14850 20 20 20 20 20 28 61 6e 64 20 6d 0a 20 20 20 20 (and m.
14860 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
14870 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
14880 20 28 28 61 6e 64 20 28 6e 6f 74 20 28 28 63 68 ((and (not ((ch
14890 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 unker-get-next c
148a0 6e 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nk).
148b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
148c0 28 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (%irregex-match-
148d0 65 6e 64 2d 63 68 75 6e 6b 20 6d 20 30 29 29 29 end-chunk m 0)))
148e0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
148f0 20 20 20 20 20 20 20 28 3d 20 28 28 63 68 75 6e (= ((chun
14900 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 6e 6b 29 ker-get-end cnk)
14910 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
14920 20 20 20 20 20 20 20 20 20 20 20 28 25 69 72 72 (%irr
14930 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 63 egex-match-end-c
14940 68 75 6e 6b 20 6d 20 30 29 29 0a 20 20 20 20 20 hunk m 0)).
14950 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14960 20 20 20 20 28 25 69 72 72 65 67 65 78 2d 6d 61 (%irregex-ma
14970 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 6d 20 tch-end-index m
14980 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 0))).
14990 20 20 20 20 20 20 28 25 69 72 72 65 67 65 78 2d (%irregex-
149a0 6d 61 74 63 68 2d 66 61 69 6c 2d 73 65 74 21 20 match-fail-set!
149b0 6d 20 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 m #f).
149c0 20 20 20 20 20 20 20 6d 29 0a 20 20 20 20 20 20 m).
149d0 20 20 20 20 20 20 20 20 20 20 28 28 25 69 72 72 ((%irr
149e0 65 67 65 78 2d 6d 61 74 63 68 2d 66 61 69 6c 20 egex-match-fail
149f0 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 m).
14a00 20 20 20 20 28 6c 70 20 28 28 25 69 72 72 65 67 (lp ((%irreg
14a10 65 78 2d 6d 61 74 63 68 2d 66 61 69 6c 20 6d 29 ex-match-fail m)
14a20 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
14a30 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
14a40 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 29 #f)))
14a50 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
14a60 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 3f 20 (irregex-match?
14a70 2e 20 61 72 67 73 29 0a 20 20 28 61 6e 64 20 28 . args). (and (
14a80 61 70 70 6c 79 20 69 72 72 65 67 65 78 2d 6d 61 apply irregex-ma
14a90 74 63 68 20 61 72 67 73 29 20 23 74 29 29 0a 0a tch args) #t))..
14aa0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14ab0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14ac0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14ad0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14ae0 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 44 46 ;;;;;;;;.;;;; DF
14af0 41 20 4d 61 74 63 68 69 6e 67 0a 0a 3b 3b 20 69 A Matching..;; i
14b00 6e 6c 69 6e 65 20 74 68 65 73 65 0a 28 64 65 66 nline these.(def
14b10 69 6e 65 20 28 64 66 61 2d 69 6e 69 74 2d 73 74 ine (dfa-init-st
14b20 61 74 65 20 64 66 61 29 0a 20 20 28 76 65 63 74 ate dfa). (vect
14b30 6f 72 2d 72 65 66 20 64 66 61 20 30 29 29 0a 28 or-ref dfa 0)).(
14b40 64 65 66 69 6e 65 20 28 64 66 61 2d 6e 65 78 74 define (dfa-next
14b50 2d 73 74 61 74 65 20 64 66 61 20 6e 6f 64 65 29 -state dfa node)
14b60 0a 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 . (vector-ref d
14b70 66 61 20 28 63 61 64 72 20 6e 6f 64 65 29 29 29 fa (cadr node)))
14b80 0a 28 64 65 66 69 6e 65 20 28 64 66 61 2d 63 65 .(define (dfa-ce
14b90 6c 6c 2d 63 6f 6d 6d 61 6e 64 73 20 64 66 61 20 ll-commands dfa
14ba0 6e 6f 64 65 29 0a 20 20 28 63 64 64 72 20 6e 6f node). (cddr no
14bb0 64 65 29 29 0a 28 64 65 66 69 6e 65 20 28 64 66 de)).(define (df
14bc0 61 2d 66 69 6e 61 6c 69 7a 65 72 20 64 66 61 20 a-finalizer dfa
14bd0 73 74 61 74 65 29 0a 20 20 28 63 61 72 20 73 74 state). (car st
14be0 61 74 65 29 29 0a 0a 3b 3b 20 74 68 69 73 20 73 ate))..;; this s
14bf0 65 61 72 63 68 65 73 20 66 6f 72 20 74 68 65 20 earches for the
14c00 66 69 72 73 74 20 65 6e 64 20 69 6e 64 65 78 20 first end index
14c10 66 6f 72 20 77 68 69 63 68 20 61 20 6d 61 74 63 for which a matc
14c20 68 20 69 73 20 70 6f 73 73 69 62 6c 65 0a 28 64 h is possible.(d
14c30 65 66 69 6e 65 20 28 64 66 61 2d 6d 61 74 63 68 efine (dfa-match
14c40 2f 73 68 6f 72 74 65 73 74 20 64 66 61 20 63 6e /shortest dfa cn
14c50 6b 20 73 72 63 20 73 74 61 72 74 20 6d 61 74 63 k src start matc
14c60 68 65 73 20 69 6e 64 65 78 29 0a 20 20 28 6c 65 hes index). (le
14c70 74 20 28 28 67 65 74 2d 73 74 72 20 28 63 68 75 t ((get-str (chu
14c80 6e 6b 65 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b nker-get-str cnk
14c90 29 29 0a 20 20 20 20 20 20 20 20 28 67 65 74 2d )). (get-
14ca0 73 74 61 72 74 20 28 63 68 75 6e 6b 65 72 2d 67 start (chunker-g
14cb0 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 29 0a 20 et-start cnk)).
14cc0 20 20 20 20 20 20 20 28 67 65 74 2d 65 6e 64 20 (get-end
14cd0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 (chunker-get-end
14ce0 20 63 6e 6b 29 29 0a 20 20 20 20 20 20 20 20 28 cnk)). (
14cf0 67 65 74 2d 6e 65 78 74 20 28 63 68 75 6e 6b 65 get-next (chunke
14d00 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 29 r-get-next cnk))
14d10 0a 20 20 20 20 20 20 20 20 3b 3b 20 53 6b 69 70 . ;; Skip
14d20 20 74 68 65 20 22 73 65 74 2d 75 70 22 20 73 74 the "set-up" st
14d30 61 74 65 2c 20 77 65 20 64 6f 6e 27 74 20 6e 65 ate, we don't ne
14d40 65 64 20 74 6f 20 73 65 74 20 74 61 67 73 2e 0a ed to set tags..
14d50 20 20 20 20 20 20 20 20 28 73 74 61 72 74 2d 73 (start-s
14d60 74 61 74 65 20 28 64 66 61 2d 6e 65 78 74 2d 73 tate (dfa-next-s
14d70 74 61 74 65 20 64 66 61 20 28 63 61 64 72 20 28 tate dfa (cadr (
14d80 64 66 61 2d 69 6e 69 74 2d 73 74 61 74 65 20 64 dfa-init-state d
14d90 66 61 29 29 29 29 29 0a 20 20 20 20 28 6c 65 74 fa))))). (let
14da0 20 6c 70 31 20 28 28 73 72 63 20 73 72 63 29 20 lp1 ((src src)
14db0 28 73 74 61 72 74 20 73 74 61 72 74 29 20 28 73 (start start) (s
14dc0 74 61 74 65 20 73 74 61 72 74 2d 73 74 61 74 65 tate start-state
14dd0 29 29 0a 20 20 20 20 20 20 28 61 6e 64 0a 20 20 )). (and.
14de0 20 20 20 20 20 73 72 63 0a 20 20 20 20 20 20 20 src.
14df0 28 6c 65 74 20 28 28 73 74 72 20 28 67 65 74 2d (let ((str (get-
14e00 73 74 72 20 73 72 63 29 29 0a 20 20 20 20 20 20 str src)).
14e10 20 20 20 20 20 20 20 28 65 6e 64 20 28 67 65 74 (end (get
14e20 2d 65 6e 64 20 73 72 63 29 29 29 0a 20 20 20 20 -end src))).
14e30 20 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 28 (let lp2 ((
14e40 69 20 73 74 61 72 74 29 20 28 73 74 61 74 65 20 i start) (state
14e50 73 74 61 74 65 29 29 0a 20 20 20 20 20 20 20 20 state)).
14e60 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
14e70 20 20 20 20 20 28 28 64 66 61 2d 66 69 6e 61 6c ((dfa-final
14e80 69 7a 65 72 20 64 66 61 20 73 74 61 74 65 29 0a izer dfa state).
14e90 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
14ea0 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
14eb0 20 28 69 6e 64 65 78 0a 20 20 20 20 20 20 20 20 (index.
14ec0 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
14ed0 6d 61 74 63 68 2d 65 6e 64 2d 63 68 75 6e 6b 2d match-end-chunk-
14ee0 73 65 74 21 20 6d 61 74 63 68 65 73 20 69 6e 64 set! matches ind
14ef0 65 78 20 73 72 63 29 0a 20 20 20 20 20 20 20 20 ex src).
14f00 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
14f10 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 2d match-end-index-
14f20 73 65 74 21 20 6d 61 74 63 68 65 73 20 69 6e 64 set! matches ind
14f30 65 78 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 ex i))).
14f40 20 20 20 20 20 23 74 29 0a 20 20 20 20 20 20 20 #t).
14f50 20 20 20 20 20 28 28 3c 20 69 20 65 6e 64 29 0a ((< i end).
14f60 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
14f70 74 2a 20 28 28 63 68 20 28 73 74 72 69 6e 67 2d t* ((ch (string-
14f80 72 65 66 20 73 74 72 20 69 29 29 0a 20 20 20 20 ref str i)).
14f90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14fa0 28 6e 65 78 74 20 28 66 69 6e 64 20 28 6c 61 6d (next (find (lam
14fb0 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 bda (x).
14fc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14fd0 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 65 (or (e
14fe0 71 76 3f 20 63 68 20 28 63 61 72 20 78 29 29 0a qv? ch (car x)).
14ff0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15000 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15010 20 20 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 (and (not
15020 28 63 68 61 72 3f 20 28 63 61 72 20 78 29 29 29 (char? (car x)))
15030 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15040 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15050 20 20 20 20 20 20 20 20 20 20 20 20 28 63 73 65 (cse
15060 74 2d 63 6f 6e 74 61 69 6e 73 3f 20 28 63 61 72 t-contains? (car
15070 20 78 29 20 63 68 29 29 29 29 0a 20 20 20 20 20 x) ch)))).
15080 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15090 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 20 (cdr
150a0 73 74 61 74 65 29 29 29 29 0a 20 20 20 20 20 20 state)))).
150b0 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 6e 65 (and ne
150c0 78 74 20 28 6c 70 32 20 28 2b 20 69 20 31 29 20 xt (lp2 (+ i 1)
150d0 28 64 66 61 2d 6e 65 78 74 2d 73 74 61 74 65 20 (dfa-next-state
150e0 64 66 61 20 6e 65 78 74 29 29 29 29 29 0a 20 20 dfa next))))).
150f0 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
15100 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
15110 74 20 28 28 6e 65 78 74 20 28 67 65 74 2d 6e 65 t ((next (get-ne
15120 78 74 20 73 72 63 29 29 29 0a 20 20 20 20 20 20 xt src))).
15130 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 6e 65 (and ne
15140 78 74 20 28 6c 70 31 20 6e 65 78 74 20 28 67 65 xt (lp1 next (ge
15150 74 2d 73 74 61 72 74 20 6e 65 78 74 29 20 73 74 t-start next) st
15160 61 74 65 29 29 29 29 29 29 29 29 29 29 29 0a 0a ate)))))))))))..
15170 28 64 65 66 69 6e 65 20 28 66 69 6e 61 6c 69 7a (define (finaliz
15180 65 21 20 66 69 6e 61 6c 69 7a 65 72 20 6d 65 6d e! finalizer mem
15190 6f 72 79 20 6d 61 74 63 68 65 73 29 0a 20 20 28 ory matches). (
151a0 66 6f 72 2d 65 61 63 68 0a 20 20 20 28 6c 61 6d for-each. (lam
151b0 62 64 61 20 28 74 61 67 26 73 6c 6f 74 29 0a 20 bda (tag&slot).
151c0 20 20 20 20 28 6c 65 74 2a 20 28 28 74 61 67 20 (let* ((tag
151d0 28 63 61 72 20 74 61 67 26 73 6c 6f 74 29 29 0a (car tag&slot)).
151e0 20 20 20 20 20 20 20 20 20 20 20 20 28 73 6c 6f (slo
151f0 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 65 t (vector-ref me
15200 6d 6f 72 79 20 28 63 64 72 20 74 61 67 26 73 6c mory (cdr tag&sl
15210 6f 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ot))).
15220 20 20 28 63 68 75 6e 6b 26 70 6f 73 20 28 76 65 (chunk&pos (ve
15230 63 74 6f 72 2d 72 65 66 20 73 6c 6f 74 20 74 61 ctor-ref slot ta
15240 67 29 29 29 0a 20 20 20 20 20 20 20 28 69 72 72 g))). (irr
15250 65 67 65 78 2d 6d 61 74 63 68 2d 63 68 75 6e 6b egex-match-chunk
15260 26 69 6e 64 65 78 2d 66 72 6f 6d 2d 74 61 67 2d &index-from-tag-
15270 73 65 74 21 0a 20 20 20 20 20 20 20 20 6d 61 74 set!. mat
15280 63 68 65 73 20 74 61 67 0a 20 20 20 20 20 20 20 ches tag.
15290 20 28 61 6e 64 20 63 68 75 6e 6b 26 70 6f 73 20 (and chunk&pos
152a0 28 63 61 72 20 63 68 75 6e 6b 26 70 6f 73 29 29 (car chunk&pos))
152b0 0a 20 20 20 20 20 20 20 20 28 61 6e 64 20 63 68 . (and ch
152c0 75 6e 6b 26 70 6f 73 20 28 63 64 72 20 63 68 75 unk&pos (cdr chu
152d0 6e 6b 26 70 6f 73 29 29 29 29 29 0a 20 20 20 66 nk&pos))))). f
152e0 69 6e 61 6c 69 7a 65 72 29 29 0a 28 64 65 66 69 inalizer)).(defi
152f0 6e 65 20 28 6d 61 6b 65 2d 69 6e 69 74 69 61 6c ne (make-initial
15300 2d 6d 65 6d 6f 72 79 20 73 6c 6f 74 73 20 6d 61 -memory slots ma
15310 74 63 68 65 73 29 0a 20 20 28 6c 65 74 20 28 28 tches). (let ((
15320 73 69 7a 65 20 28 2a 20 28 69 72 72 65 67 65 78 size (* (irregex
15330 2d 6d 61 74 63 68 2d 6e 75 6d 2d 73 75 62 6d 61 -match-num-subma
15340 74 63 68 65 73 20 6d 61 74 63 68 65 73 29 20 32 tches matches) 2
15350 29 29 0a 20 20 20 20 20 20 20 20 28 6d 65 6d 6f )). (memo
15360 72 79 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ry (make-vector
15370 73 6c 6f 74 73 29 29 29 0a 20 20 20 20 28 64 6f slots))). (do
15380 20 28 28 69 20 30 20 28 2b 20 69 20 31 29 29 29 ((i 0 (+ i 1)))
15390 0a 20 20 20 20 20 20 20 20 28 28 3d 20 69 20 73 . ((= i s
153a0 6c 6f 74 73 29 20 6d 65 6d 6f 72 79 29 0a 20 20 lots) memory).
153b0 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
153c0 20 6d 65 6d 6f 72 79 20 69 20 28 6d 61 6b 65 2d memory i (make-
153d0 76 65 63 74 6f 72 20 73 69 7a 65 20 23 66 29 29 vector size #f))
153e0 29 29 29 0a 0a 3b 3b 20 74 68 69 73 20 66 69 6e )))..;; this fin
153f0 64 73 20 74 68 65 20 6c 6f 6e 67 65 73 74 20 6d ds the longest m
15400 61 74 63 68 20 73 74 61 72 74 69 6e 67 20 61 74 atch starting at
15410 20 61 20 67 69 76 65 6e 20 69 6e 64 65 78 0a 28 a given index.(
15420 64 65 66 69 6e 65 20 28 64 66 61 2d 6d 61 74 63 define (dfa-matc
15430 68 2f 6c 6f 6e 67 65 73 74 20 64 66 61 20 63 6e h/longest dfa cn
15440 6b 20 73 72 63 20 73 74 61 72 74 20 65 6e 64 2d k src start end-
15450 73 72 63 20 65 6e 64 20 6d 61 74 63 68 65 73 20 src end matches
15460 69 6e 64 65 78 29 0a 20 20 28 6c 65 74 2a 20 28 index). (let* (
15470 28 67 65 74 2d 73 74 72 20 28 63 68 75 6e 6b 65 (get-str (chunke
15480 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 29 0a r-get-str cnk)).
15490 20 20 20 20 20 20 20 20 20 28 67 65 74 2d 73 74 (get-st
154a0 61 72 74 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 art (chunker-get
154b0 2d 73 74 61 72 74 20 63 6e 6b 29 29 0a 20 20 20 -start cnk)).
154c0 20 20 20 20 20 20 28 67 65 74 2d 65 6e 64 20 28 (get-end (
154d0 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 chunker-get-end
154e0 63 6e 6b 29 29 0a 20 20 20 20 20 20 20 20 20 28 cnk)). (
154f0 67 65 74 2d 6e 65 78 74 20 28 63 68 75 6e 6b 65 get-next (chunke
15500 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 29 r-get-next cnk))
15510 0a 20 20 20 20 20 20 20 20 20 28 69 6e 69 74 69 . (initi
15520 61 6c 2d 73 74 61 74 65 20 28 64 66 61 2d 69 6e al-state (dfa-in
15530 69 74 2d 73 74 61 74 65 20 64 66 61 29 29 0a 20 it-state dfa)).
15540 20 20 20 20 20 20 20 20 28 6d 65 6d 6f 72 79 2d (memory-
15550 73 69 7a 65 20 28 63 61 72 20 69 6e 69 74 69 61 size (car initia
15560 6c 2d 73 74 61 74 65 29 29 0a 20 20 20 20 20 20 l-state)).
15570 20 20 20 28 73 75 62 6d 61 74 63 68 65 73 3f 20 (submatches?
15580 28 6e 6f 74 20 28 7a 65 72 6f 3f 20 6d 65 6d 6f (not (zero? memo
15590 72 79 2d 73 69 7a 65 29 29 29 0a 20 20 20 20 20 ry-size))).
155a0 20 20 20 20 3b 3b 20 41 20 76 65 63 74 6f 72 20 ;; A vector
155b0 6f 66 20 76 65 63 74 6f 72 73 2c 20 65 61 63 68 of vectors, each
155c0 20 6f 66 20 73 69 7a 65 20 3c 6e 75 6d 62 65 72 of size <number
155d0 20 6f 66 20 73 74 61 72 74 2f 65 6e 64 20 73 75 of start/end su
155e0 62 6d 61 74 63 68 65 73 3e 0a 20 20 20 20 20 20 bmatches>.
155f0 20 20 20 28 6d 65 6d 6f 72 79 20 28 6d 61 6b 65 (memory (make
15600 2d 69 6e 69 74 69 61 6c 2d 6d 65 6d 6f 72 79 20 -initial-memory
15610 6d 65 6d 6f 72 79 2d 73 69 7a 65 20 6d 61 74 63 memory-size matc
15620 68 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 hes)). (
15630 69 6e 69 74 2d 63 65 6c 6c 20 28 63 61 64 72 20 init-cell (cadr
15640 69 6e 69 74 69 61 6c 2d 73 74 61 74 65 29 29 0a initial-state)).
15650 20 20 20 20 20 20 20 20 20 28 73 74 61 72 74 2d (start-
15660 73 74 61 74 65 20 28 64 66 61 2d 6e 65 78 74 2d state (dfa-next-
15670 73 74 61 74 65 20 64 66 61 20 69 6e 69 74 2d 63 state dfa init-c
15680 65 6c 6c 29 29 0a 20 20 20 20 20 20 20 20 20 28 ell)). (
15690 73 74 61 72 74 2d 66 69 6e 61 6c 69 7a 65 72 20 start-finalizer
156a0 28 64 66 61 2d 66 69 6e 61 6c 69 7a 65 72 20 64 (dfa-finalizer d
156b0 66 61 20 73 74 61 72 74 2d 73 74 61 74 65 29 29 fa start-state))
156c0 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 ). (cond.
156d0 20 28 69 6e 64 65 78 0a 20 20 20 20 20 20 28 69 (index. (i
156e0 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
156f0 2d 63 68 75 6e 6b 2d 73 65 74 21 20 6d 61 74 63 -chunk-set! matc
15700 68 65 73 20 69 6e 64 65 78 20 23 66 29 0a 20 20 hes index #f).
15710 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 (irregex-mat
15720 63 68 2d 65 6e 64 2d 69 6e 64 65 78 2d 73 65 74 ch-end-index-set
15730 21 20 6d 61 74 63 68 65 73 20 69 6e 64 65 78 20 ! matches index
15740 23 66 29 29 29 0a 20 20 20 20 28 63 6f 6e 64 20 #f))). (cond
15750 28 73 75 62 6d 61 74 63 68 65 73 3f 0a 20 20 20 (submatches?.
15760 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 (for-eac
15770 68 20 28 6c 61 6d 62 64 61 20 28 73 29 0a 20 20 h (lambda (s).
15780 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15790 20 20 20 20 20 28 6c 65 74 20 28 28 73 6c 6f 74 (let ((slot
157a0 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 65 6d (vector-ref mem
157b0 6f 72 79 20 28 63 64 72 20 73 29 29 29 29 0a 20 ory (cdr s)))).
157c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
157d0 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
157e0 73 65 74 21 20 73 6c 6f 74 20 28 63 61 72 20 73 set! slot (car s
157f0 29 20 28 63 6f 6e 73 20 73 72 63 20 73 74 61 72 ) (cons src star
15800 74 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 t)))).
15810 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 20 (cdr
15820 28 64 66 61 2d 63 65 6c 6c 2d 63 6f 6d 6d 61 6e (dfa-cell-comman
15830 64 73 20 64 66 61 20 69 6e 69 74 2d 63 65 6c 6c ds dfa init-cell
15840 29 29 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c ))))). (let l
15850 70 31 20 28 28 73 72 63 20 73 72 63 29 0a 20 20 p1 ((src src).
15860 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 (sta
15870 72 74 20 73 74 61 72 74 29 0a 20 20 20 20 20 20 rt start).
15880 20 20 20 20 20 20 20 20 28 73 74 61 74 65 20 73 (state s
15890 74 61 72 74 2d 73 74 61 74 65 29 0a 20 20 20 20 tart-state).
158a0 20 20 20 20 20 20 20 20 20 20 28 72 65 73 2d 73 (res-s
158b0 72 63 20 28 61 6e 64 20 73 74 61 72 74 2d 66 69 rc (and start-fi
158c0 6e 61 6c 69 7a 65 72 20 73 72 63 29 29 0a 20 20 nalizer src)).
158d0 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 73 (res
158e0 2d 69 6e 64 65 78 20 28 61 6e 64 20 73 74 61 72 -index (and star
158f0 74 2d 66 69 6e 61 6c 69 7a 65 72 20 73 74 61 72 t-finalizer star
15900 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
15910 20 20 28 66 69 6e 61 6c 69 7a 65 72 20 73 74 61 (finalizer sta
15920 72 74 2d 66 69 6e 61 6c 69 7a 65 72 29 29 0a 20 rt-finalizer)).
15930 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 72 20 (let ((str
15940 28 67 65 74 2d 73 74 72 20 73 72 63 29 29 0a 20 (get-str src)).
15950 20 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 (end
15960 28 69 66 20 28 65 71 3f 20 73 72 63 20 65 6e 64 (if (eq? src end
15970 2d 73 72 63 29 20 65 6e 64 20 28 67 65 74 2d 65 -src) end (get-e
15980 6e 64 20 73 72 63 29 29 29 29 0a 20 20 20 20 20 nd src)))).
15990 20 20 20 28 6c 65 74 20 6c 70 32 20 28 28 69 20 (let lp2 ((i
159a0 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 20 start).
159b0 20 20 20 20 20 20 20 20 20 28 73 74 61 74 65 20 (state
159c0 73 74 61 74 65 29 0a 20 20 20 20 20 20 20 20 20 state).
159d0 20 20 20 20 20 20 20 20 20 28 72 65 73 2d 73 72 (res-sr
159e0 63 20 72 65 73 2d 73 72 63 29 0a 20 20 20 20 20 c res-src).
159f0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
15a00 73 2d 69 6e 64 65 78 20 72 65 73 2d 69 6e 64 65 s-index res-inde
15a10 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x).
15a20 20 20 20 20 20 28 66 69 6e 61 6c 69 7a 65 72 20 (finalizer
15a30 66 69 6e 61 6c 69 7a 65 72 29 29 0a 20 20 20 20 finalizer)).
15a40 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
15a50 20 20 20 20 20 20 20 28 28 3e 3d 20 69 20 65 6e ((>= i en
15a60 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 d). (
15a70 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
15a80 20 20 28 28 61 6e 64 20 69 6e 64 65 78 20 72 65 ((and index re
15a90 73 2d 73 72 63 29 0a 20 20 20 20 20 20 20 20 20 s-src).
15aa0 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 (irregex-ma
15ab0 74 63 68 2d 65 6e 64 2d 63 68 75 6e 6b 2d 73 65 tch-end-chunk-se
15ac0 74 21 20 6d 61 74 63 68 65 73 20 69 6e 64 65 78 t! matches index
15ad0 20 72 65 73 2d 73 72 63 29 0a 20 20 20 20 20 20 res-src).
15ae0 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 (irregex
15af0 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 -match-end-index
15b00 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 69 6e -set! matches in
15b10 64 65 78 20 72 65 73 2d 69 6e 64 65 78 29 29 29 dex res-index)))
15b20 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 . (le
15b30 74 20 28 28 6e 65 78 74 20 28 61 6e 64 20 28 6e t ((next (and (n
15b40 6f 74 20 28 65 71 3f 20 73 72 63 20 65 6e 64 2d ot (eq? src end-
15b50 73 72 63 29 29 20 28 67 65 74 2d 6e 65 78 74 20 src)) (get-next
15b60 73 72 63 29 29 29 29 0a 20 20 20 20 20 20 20 20 src)))).
15b70 20 20 20 20 20 20 28 69 66 20 6e 65 78 74 0a 20 (if next.
15b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15b90 20 28 6c 70 31 20 6e 65 78 74 20 28 67 65 74 2d (lp1 next (get-
15ba0 73 74 61 72 74 20 6e 65 78 74 29 20 73 74 61 74 start next) stat
15bb0 65 20 72 65 73 2d 73 72 63 20 72 65 73 2d 69 6e e res-src res-in
15bc0 64 65 78 20 66 69 6e 61 6c 69 7a 65 72 29 0a 20 dex finalizer).
15bd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15be0 20 28 61 6e 64 20 69 6e 64 65 78 0a 20 20 20 20 (and index.
15bf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c00 20 20 20 28 25 69 72 72 65 67 65 78 2d 6d 61 74 (%irregex-mat
15c10 63 68 2d 65 6e 64 2d 63 68 75 6e 6b 20 6d 61 74 ch-end-chunk mat
15c20 63 68 65 73 20 69 6e 64 65 78 29 0a 20 20 20 20 ches index).
15c30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c40 20 20 20 28 6f 72 20 28 6e 6f 74 20 66 69 6e 61 (or (not fina
15c50 6c 69 7a 65 72 29 20 28 66 69 6e 61 6c 69 7a 65 lizer) (finalize
15c60 21 20 66 69 6e 61 6c 69 7a 65 72 20 6d 65 6d 6f ! finalizer memo
15c70 72 79 20 6d 61 74 63 68 65 73 29 29 0a 20 20 20 ry matches)).
15c80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c90 20 20 20 20 23 74 29 29 29 29 0a 20 20 20 20 20 #t)))).
15ca0 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
15cb0 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
15cc0 63 68 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 ch (string-ref s
15cd0 74 72 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 tr i)).
15ce0 20 20 20 20 20 20 20 20 20 20 28 63 65 6c 6c 20 (cell
15cf0 28 66 69 6e 64 20 28 6c 61 6d 62 64 61 20 28 78 (find (lambda (x
15d00 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15d10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d20 20 20 20 28 6f 72 20 28 65 71 76 3f 20 63 68 20 (or (eqv? ch
15d30 28 63 61 72 20 78 29 29 0a 20 20 20 20 20 20 20 (car x)).
15d40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
15d60 6e 64 20 28 6e 6f 74 20 28 63 68 61 72 3f 20 28 nd (not (char? (
15d70 63 61 72 20 78 29 29 29 0a 20 20 20 20 20 20 20 car x))).
15d80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15da0 20 20 20 28 63 73 65 74 2d 63 6f 6e 74 61 69 6e (cset-contain
15db0 73 3f 20 28 63 61 72 20 78 29 20 63 68 29 29 29 s? (car x) ch)))
15dc0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15dd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15de0 20 28 63 64 72 20 73 74 61 74 65 29 29 29 29 0a (cdr state)))).
15df0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
15e00 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ond.
15e10 20 20 20 28 63 65 6c 6c 0a 20 20 20 20 20 20 20 (cell.
15e20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
15e30 28 6e 65 78 74 20 28 64 66 61 2d 6e 65 78 74 2d (next (dfa-next-
15e40 73 74 61 74 65 20 64 66 61 20 63 65 6c 6c 29 29 state dfa cell))
15e50 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15e60 20 20 20 20 20 20 20 20 28 6e 65 77 2d 66 69 6e (new-fin
15e70 61 6c 69 7a 65 72 20 28 64 66 61 2d 66 69 6e 61 alizer (dfa-fina
15e80 6c 69 7a 65 72 20 64 66 61 20 6e 65 78 74 29 29 lizer dfa next))
15e90 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15ea0 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
15eb0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 (su
15ec0 62 6d 61 74 63 68 65 73 3f 0a 20 20 20 20 20 20 bmatches?.
15ed0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
15ee0 65 74 20 28 28 63 6d 64 73 20 28 64 66 61 2d 63 et ((cmds (dfa-c
15ef0 65 6c 6c 2d 63 6f 6d 6d 61 6e 64 73 20 64 66 61 ell-commands dfa
15f00 20 63 65 6c 6c 29 29 29 0a 20 20 20 20 20 20 20 cell))).
15f10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
15f20 3b 20 53 61 76 65 20 6d 61 74 63 68 20 77 68 65 ; Save match whe
15f30 6e 20 77 65 27 72 65 20 6d 6f 76 69 6e 67 20 66 n we're moving f
15f40 72 6f 6d 20 61 63 63 65 70 74 69 6e 67 20 73 74 rom accepting st
15f50 61 74 65 20 74 6f 0a 20 20 20 20 20 20 20 20 20 ate to.
15f60 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
15f70 72 65 6a 65 63 74 69 6e 67 20 73 74 61 74 65 3b rejecting state;
15f80 20 74 68 69 73 20 63 6f 75 6c 64 20 62 65 20 74 this could be t
15f90 68 65 20 6c 61 73 74 20 61 63 63 65 70 74 69 6e he last acceptin
15fa0 67 20 6f 6e 65 2e 0a 20 20 20 20 20 20 20 20 20 g one..
15fb0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
15fc0 6e 64 20 28 28 61 6e 64 20 66 69 6e 61 6c 69 7a nd ((and finaliz
15fd0 65 72 20 28 6e 6f 74 20 6e 65 77 2d 66 69 6e 61 er (not new-fina
15fe0 6c 69 7a 65 72 29 29 0a 20 20 20 20 20 20 20 20 lizer)).
15ff0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16000 20 20 20 20 20 28 66 69 6e 61 6c 69 7a 65 21 20 (finalize!
16010 66 69 6e 61 6c 69 7a 65 72 20 6d 65 6d 6f 72 79 finalizer memory
16020 20 6d 61 74 63 68 65 73 29 29 29 0a 20 20 20 20 matches))).
16030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16040 20 20 28 66 6f 72 2d 65 61 63 68 20 28 6c 61 6d (for-each (lam
16050 62 64 61 20 28 73 29 0a 20 20 20 20 20 20 20 20 bda (s).
16060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16070 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
16080 28 73 6c 6f 74 20 28 76 65 63 74 6f 72 2d 72 65 (slot (vector-re
16090 66 20 6d 65 6d 6f 72 79 20 28 63 64 72 20 73 29 f memory (cdr s)
160a0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
160b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
160c0 20 20 20 20 20 20 20 20 20 20 20 28 63 68 75 6e (chun
160d0 6b 26 70 6f 73 69 74 69 6f 6e 20 28 63 6f 6e 73 k&position (cons
160e0 20 73 72 63 20 28 2b 20 69 20 31 29 29 29 29 0a src (+ i 1)))).
160f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16100 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16110 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
16120 20 73 6c 6f 74 20 28 63 61 72 20 73 29 20 63 68 slot (car s) ch
16130 75 6e 6b 26 70 6f 73 69 74 69 6f 6e 29 29 29 0a unk&position))).
16140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16150 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16160 28 63 64 72 20 63 6d 64 73 29 29 0a 20 20 20 20 (cdr cmds)).
16170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16180 20 20 3b 3b 20 52 65 61 73 73 69 67 6e 69 6e 67 ;; Reassigning
16190 20 63 6f 6d 6d 61 6e 64 73 20 6d 61 79 20 62 65 commands may be
161a0 20 69 6e 20 61 6e 20 6f 72 64 65 72 20 77 68 69 in an order whi
161b0 63 68 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ch.
161c0 20 20 20 20 20 20 20 20 20 3b 3b 20 63 61 75 73 ;; caus
161d0 65 73 20 6d 65 6d 6f 72 79 20 63 65 6c 6c 73 20 es memory cells
161e0 74 6f 20 62 65 20 63 6c 6f 62 62 65 72 65 64 20 to be clobbered
161f0 62 65 66 6f 72 65 0a 20 20 20 20 20 20 20 20 20 before.
16200 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
16210 74 68 65 79 27 72 65 20 72 65 61 64 20 6f 75 74 they're read out
16220 2e 20 20 4d 61 6b 65 20 32 20 70 61 73 73 65 73 . Make 2 passes
16230 20 74 6f 20 6d 61 69 6e 74 61 69 6e 0a 20 20 20 to maintain.
16240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16250 20 20 20 3b 3b 20 6f 6c 64 20 76 61 6c 75 65 73 ;; old values
16260 20 62 79 20 63 6f 70 79 69 6e 67 20 74 68 65 6d by copying them
16270 20 69 6e 74 6f 20 61 20 63 6c 6f 73 75 72 65 2e into a closure.
16280 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16290 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 68 (for-each
162a0 20 28 6c 61 6d 62 64 61 20 28 65 78 65 63 75 74 (lambda (execut
162b0 65 21 29 20 28 65 78 65 63 75 74 65 21 29 29 0a e!) (execute!)).
162c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
162d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
162e0 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 63 29 (map (lambda (c)
162f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16300 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16310 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
16320 74 61 67 20 28 76 65 63 74 6f 72 2d 72 65 66 20 tag (vector-ref
16330 63 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 c 0)).
16340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16360 20 20 20 20 28 73 73 20 28 76 65 63 74 6f 72 2d (ss (vector-
16370 72 65 66 20 6d 65 6d 6f 72 79 20 28 76 65 63 74 ref memory (vect
16380 6f 72 2d 72 65 66 20 63 20 31 29 29 29 0a 20 20 or-ref c 1))).
16390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
163a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
163b0 20 20 20 20 20 20 20 20 20 20 20 20 28 64 73 20 (ds
163c0 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 65 6d 6f (vector-ref memo
163d0 72 79 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 ry (vector-ref c
163e0 20 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 2))).
163f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16400 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16410 20 20 20 20 28 76 61 6c 75 65 2d 66 72 6f 6d 20 (value-from
16420 28 76 65 63 74 6f 72 2d 72 65 66 20 73 73 20 74 (vector-ref ss t
16430 61 67 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ag))).
16440 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16450 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
16460 6c 61 6d 62 64 61 20 28 29 20 28 76 65 63 74 6f lambda () (vecto
16470 72 2d 73 65 74 21 20 64 73 20 74 61 67 20 76 61 r-set! ds tag va
16480 6c 75 65 2d 66 72 6f 6d 29 29 29 29 0a 20 20 20 lue-from)))).
16490 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
164a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
164b0 20 20 28 63 61 72 20 63 6d 64 73 29 29 29 29 29 (car cmds)))))
164c0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
164d0 20 20 20 20 28 69 66 20 6e 65 77 2d 66 69 6e 61 (if new-fina
164e0 6c 69 7a 65 72 0a 20 20 20 20 20 20 20 20 20 20 lizer.
164f0 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 32 (lp2
16500 20 28 2b 20 69 20 31 29 20 6e 65 78 74 20 73 72 (+ i 1) next sr
16510 63 20 28 2b 20 69 20 31 29 20 6e 65 77 2d 66 69 c (+ i 1) new-fi
16520 6e 61 6c 69 7a 65 72 29 0a 20 20 20 20 20 20 20 nalizer).
16530 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
16540 6c 70 32 20 28 2b 20 69 20 31 29 20 6e 65 78 74 lp2 (+ i 1) next
16550 20 72 65 73 2d 73 72 63 20 72 65 73 2d 69 6e 64 res-src res-ind
16560 65 78 20 23 66 29 29 29 29 0a 20 20 20 20 20 20 ex #f)))).
16570 20 20 20 20 20 20 20 20 20 28 72 65 73 2d 73 72 (res-sr
16580 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 c.
16590 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
165a0 20 20 20 20 20 20 20 20 20 28 69 6e 64 65 78 0a (index.
165b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
165c0 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (irregex-match
165d0 2d 65 6e 64 2d 63 68 75 6e 6b 2d 73 65 74 21 20 -end-chunk-set!
165e0 6d 61 74 63 68 65 73 20 69 6e 64 65 78 20 72 65 matches index re
165f0 73 2d 73 72 63 29 0a 20 20 20 20 20 20 20 20 20 s-src).
16600 20 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 (irrege
16610 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 x-match-end-inde
16620 78 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 69 x-set! matches i
16630 6e 64 65 78 20 72 65 73 2d 69 6e 64 65 78 29 29 ndex res-index))
16640 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
16650 20 20 28 63 6f 6e 64 20 28 66 69 6e 61 6c 69 7a (cond (finaliz
16660 65 72 20 28 66 69 6e 61 6c 69 7a 65 21 20 66 69 er (finalize! fi
16670 6e 61 6c 69 7a 65 72 20 6d 65 6d 6f 72 79 20 6d nalizer memory m
16680 61 74 63 68 65 73 29 29 29 0a 20 20 20 20 20 20 atches))).
16690 20 20 20 20 20 20 20 20 20 20 23 74 29 0a 20 20 #t).
166a0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 ((a
166b0 6e 64 20 69 6e 64 65 78 20 28 25 69 72 72 65 67 nd index (%irreg
166c0 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 63 68 75 ex-match-end-chu
166d0 6e 6b 20 6d 61 74 63 68 65 73 20 69 6e 64 65 78 nk matches index
166e0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
166f0 20 20 20 28 63 6f 6e 64 20 28 66 69 6e 61 6c 69 (cond (finali
16700 7a 65 72 20 28 66 69 6e 61 6c 69 7a 65 21 20 66 zer (finalize! f
16710 69 6e 61 6c 69 7a 65 72 20 6d 65 6d 6f 72 79 20 inalizer memory
16720 6d 61 74 63 68 65 73 29 29 29 0a 20 20 20 20 20 matches))).
16730 20 20 20 20 20 20 20 20 20 20 20 23 74 29 0a 20 #t).
16740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
16750 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
16760 20 20 20 20 23 66 29 29 29 29 29 29 29 29 29 29 #f))))))))))
16770 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
16780 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
16790 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
167a0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
167b0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 ;;;;;;;;;;.;;;;
167c0 4e 61 6d 65 64 20 44 65 66 69 6e 69 74 69 6f 6e Named Definition
167d0 73 0a 0a 28 64 65 66 69 6e 65 20 73 72 65 2d 6e s..(define sre-n
167e0 61 6d 65 64 2d 64 65 66 69 6e 69 74 69 6f 6e 73 amed-definitions
167f0 0a 20 20 60 28 28 61 6e 79 20 2e 20 2c 2a 61 6c . `((any . ,*al
16800 6c 2d 63 68 61 72 73 2a 29 0a 20 20 20 20 28 6e l-chars*). (n
16810 6f 6e 6c 20 2e 20 28 2d 20 2c 2a 61 6c 6c 2d 63 onl . (- ,*all-c
16820 68 61 72 73 2a 20 28 2c 28 73 74 72 69 6e 67 20 hars* (,(string
16830 23 5c 6e 65 77 6c 69 6e 65 29 29 29 29 0a 20 20 #\newline)))).
16840 20 20 28 61 6c 70 68 61 62 65 74 69 63 20 2e 20 (alphabetic .
16850 28 2f 20 23 5c 61 20 23 5c 7a 20 23 5c 41 20 23 (/ #\a #\z #\A #
16860 5c 5a 29 29 0a 20 20 20 20 28 61 6c 70 68 61 20 \Z)). (alpha
16870 2e 20 61 6c 70 68 61 62 65 74 69 63 29 0a 20 20 . alphabetic).
16880 20 20 28 61 6c 70 68 61 6e 75 6d 65 72 69 63 20 (alphanumeric
16890 2e 20 28 2f 20 23 5c 61 20 23 5c 7a 20 23 5c 41 . (/ #\a #\z #\A
168a0 20 23 5c 5a 20 23 5c 30 20 23 5c 39 29 29 0a 20 #\Z #\0 #\9)).
168b0 20 20 20 28 61 6c 70 68 61 6e 75 6d 20 2e 20 61 (alphanum . a
168c0 6c 70 68 61 6e 75 6d 65 72 69 63 29 0a 20 20 20 lphanumeric).
168d0 20 28 61 6c 6e 75 6d 20 2e 20 61 6c 70 68 61 6e (alnum . alphan
168e0 75 6d 65 72 69 63 29 0a 20 20 20 20 28 6c 6f 77 umeric). (low
168f0 65 72 2d 63 61 73 65 20 2e 20 28 2f 20 23 5c 61 er-case . (/ #\a
16900 20 23 5c 7a 29 29 0a 20 20 20 20 28 6c 6f 77 65 #\z)). (lowe
16910 72 20 2e 20 6c 6f 77 65 72 2d 63 61 73 65 29 0a r . lower-case).
16920 20 20 20 20 28 75 70 70 65 72 2d 63 61 73 65 20 (upper-case
16930 2e 20 28 2f 20 23 5c 41 20 23 5c 5a 29 29 0a 20 . (/ #\A #\Z)).
16940 20 20 20 28 75 70 70 65 72 20 2e 20 75 70 70 65 (upper . uppe
16950 72 2d 63 61 73 65 29 0a 20 20 20 20 28 6e 75 6d r-case). (num
16960 65 72 69 63 20 2e 20 28 2f 20 23 5c 30 20 23 5c eric . (/ #\0 #\
16970 39 29 29 0a 20 20 20 20 28 6e 75 6d 20 2e 20 6e 9)). (num . n
16980 75 6d 65 72 69 63 29 0a 20 20 20 20 28 64 69 67 umeric). (dig
16990 69 74 20 2e 20 6e 75 6d 65 72 69 63 29 0a 20 20 it . numeric).
169a0 20 20 28 70 75 6e 63 74 75 61 74 69 6f 6e 20 2e (punctuation .
169b0 20 28 6f 72 20 23 5c 21 20 23 5c 22 20 23 5c 23 (or #\! #\" #\#
169c0 20 23 5c 25 20 23 5c 26 20 23 5c 27 20 23 5c 28 #\% #\& #\' #\(
169d0 20 23 5c 29 20 23 5c 2a 20 23 5c 2c 20 23 5c 2d #\) #\* #\, #\-
169e0 20 23 5c 2e 0a 20 20 20 20 20 20 20 20 20 20 20 #\..
169f0 20 20 20 20 20 20 20 20 20 20 20 20 23 5c 2f 20 #\/
16a00 23 5c 3a 20 23 5c 3b 20 23 5c 3f 20 23 5c 40 20 #\: #\; #\? #\@
16a10 23 5c 5b 20 23 5c 5c 20 23 5c 5d 20 23 5c 5f 20 #\[ #\\ #\] #\_
16a20 23 5c 7b 20 23 5c 7d 29 29 0a 20 20 20 20 28 70 #\{ #\})). (p
16a30 75 6e 63 74 20 2e 20 70 75 6e 63 74 75 61 74 69 unct . punctuati
16a40 6f 6e 29 0a 20 20 20 20 28 67 72 61 70 68 69 63 on). (graphic
16a50 0a 20 20 20 20 20 2e 20 28 6f 72 20 61 6c 70 68 . . (or alph
16a60 61 6e 75 6d 65 72 69 63 20 70 75 6e 63 74 75 61 anumeric punctua
16a70 74 69 6f 6e 20 23 5c 24 20 23 5c 2b 20 23 5c 3c tion #\$ #\+ #\<
16a80 20 23 5c 3d 20 23 5c 3e 20 23 5c 5e 20 23 5c 60 #\= #\> #\^ #\`
16a90 20 23 5c 7c 20 23 5c 7e 29 29 0a 20 20 20 20 28 #\| #\~)). (
16aa0 67 72 61 70 68 20 2e 20 67 72 61 70 68 69 63 29 graph . graphic)
16ab0 0a 20 20 20 20 28 62 6c 61 6e 6b 20 2e 20 28 6f . (blank . (o
16ac0 72 20 23 5c 73 70 61 63 65 20 2c 28 69 6e 74 65 r #\space ,(inte
16ad0 67 65 72 2d 3e 63 68 61 72 20 28 2d 20 28 63 68 ger->char (- (ch
16ae0 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 ar->integer #\sp
16af0 61 63 65 29 20 32 33 29 29 29 29 0a 20 20 20 20 ace) 23)))).
16b00 3b 3b 20 30 42 20 2d 20 76 65 72 74 69 63 61 6c ;; 0B - vertical
16b10 20 74 61 62 2c 20 30 43 20 2d 20 66 6f 72 6d 20 tab, 0C - form
16b20 66 65 65 64 0a 20 20 20 20 28 77 68 69 74 65 73 feed. (whites
16b30 70 61 63 65 20 2e 20 28 6f 72 20 62 6c 61 6e 6b pace . (or blank
16b40 20 23 5c 6e 65 77 6c 69 6e 65 20 23 5c 78 30 43 #\newline #\x0C
16b50 20 23 5c 72 65 74 75 72 6e 20 23 5c 78 30 42 29 #\return #\x0B)
16b60 29 0a 20 20 20 20 28 73 70 61 63 65 20 2e 20 77 ). (space . w
16b70 68 69 74 65 73 70 61 63 65 29 0a 20 20 20 20 28 hitespace). (
16b80 77 68 69 74 65 20 2e 20 77 68 69 74 65 73 70 61 white . whitespa
16b90 63 65 29 0a 20 20 20 20 28 70 72 69 6e 74 69 6e ce). (printin
16ba0 67 20 2e 20 28 6f 72 20 67 72 61 70 68 69 63 20 g . (or graphic
16bb0 77 68 69 74 65 73 70 61 63 65 29 29 0a 20 20 20 whitespace)).
16bc0 20 28 70 72 69 6e 74 20 2e 20 70 72 69 6e 74 69 (print . printi
16bd0 6e 67 29 0a 0a 20 20 20 20 3b 3b 20 58 58 58 58 ng).. ;; XXXX
16be0 20 77 65 20 61 73 73 75 6d 65 20 61 20 28 70 6f we assume a (po
16bf0 73 73 69 62 6c 79 20 73 68 69 66 74 65 64 29 20 ssibly shifted)
16c00 41 53 43 49 49 2d 62 61 73 65 64 20 6f 72 64 65 ASCII-based orde
16c10 72 69 6e 67 0a 20 20 20 20 28 63 6f 6e 74 72 6f ring. (contro
16c20 6c 20 2e 20 28 2f 20 2c 28 69 6e 74 65 67 65 72 l . (/ ,(integer
16c30 2d 3e 63 68 61 72 20 28 2d 20 28 63 68 61 72 2d ->char (- (char-
16c40 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 61 63 65 >integer #\space
16c50 29 20 33 32 29 29 0a 20 20 20 20 20 20 20 20 20 ) 32)).
16c60 20 20 20 20 20 20 20 20 20 2c 28 69 6e 74 65 67 ,(integ
16c70 65 72 2d 3e 63 68 61 72 20 28 2d 20 28 63 68 61 er->char (- (cha
16c80 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 61 r->integer #\spa
16c90 63 65 29 20 31 29 29 29 29 0a 20 20 20 20 28 63 ce) 1)))). (c
16ca0 6e 74 72 6c 20 2e 20 63 6f 6e 74 72 6f 6c 29 0a ntrl . control).
16cb0 20 20 20 20 28 68 65 78 2d 64 69 67 69 74 20 2e (hex-digit .
16cc0 20 28 6f 72 20 6e 75 6d 65 72 69 63 20 28 2f 20 (or numeric (/
16cd0 23 5c 61 20 23 5c 66 20 23 5c 41 20 23 5c 46 29 #\a #\f #\A #\F)
16ce0 29 29 0a 20 20 20 20 28 78 64 69 67 69 74 20 2e )). (xdigit .
16cf0 20 68 65 78 2d 64 69 67 69 74 29 0a 20 20 20 20 hex-digit).
16d00 28 61 73 63 69 69 20 2e 20 28 2f 20 2c 28 69 6e (ascii . (/ ,(in
16d10 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2d 20 28 teger->char (- (
16d20 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c char->integer #\
16d30 73 70 61 63 65 29 20 33 32 29 29 0a 20 20 20 20 space) 32)).
16d40 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 69 6e ,(in
16d50 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 teger->char (+ (
16d60 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c char->integer #\
16d70 73 70 61 63 65 29 20 39 35 29 29 29 29 0a 20 20 space) 95)))).
16d80 20 20 28 61 73 63 69 69 2d 6e 6f 6e 6c 20 2e 20 (ascii-nonl .
16d90 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 (/ ,(integer->ch
16da0 61 72 20 28 2d 20 28 63 68 61 72 2d 3e 69 6e 74 ar (- (char->int
16db0 65 67 65 72 20 23 5c 73 70 61 63 65 29 20 33 32 eger #\space) 32
16dc0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
16dd0 20 20 20 20 20 20 20 20 2c 28 69 6e 74 65 67 65 ,(intege
16de0 72 2d 3e 63 68 61 72 20 28 2d 20 28 63 68 61 72 r->char (- (char
16df0 2d 3e 69 6e 74 65 67 65 72 20 23 5c 6e 65 77 6c ->integer #\newl
16e00 69 6e 65 29 20 31 29 29 0a 20 20 20 20 20 20 20 ine) 1)).
16e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 ,(
16e20 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b integer->char (+
16e30 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
16e40 23 5c 6e 65 77 6c 69 6e 65 29 20 31 29 29 0a 20 #\newline) 1)).
16e50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16e60 20 20 20 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 ,(integer->c
16e70 68 61 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e har (+ (char->in
16e80 74 65 67 65 72 20 23 5c 73 70 61 63 65 29 20 39 teger #\space) 9
16e90 35 29 29 29 29 0a 20 20 20 20 28 6e 65 77 6c 69 5)))). (newli
16ea0 6e 65 20 2e 20 28 6f 72 20 28 73 65 71 20 2c 28 ne . (or (seq ,(
16eb0 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b integer->char (+
16ec0 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
16ed0 23 5c 6e 65 77 6c 69 6e 65 29 20 33 29 29 0a 20 #\newline) 3)).
16ee0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16ef0 20 20 20 20 20 20 20 23 5c 6e 65 77 6c 69 6e 65 #\newline
16f00 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
16f10 20 20 20 20 20 28 2f 20 23 5c 6e 65 77 6c 69 6e (/ #\newlin
16f20 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
16f30 20 20 20 20 20 20 20 20 2c 28 69 6e 74 65 67 65 ,(intege
16f40 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 61 72 r->char (+ (char
16f50 2d 3e 69 6e 74 65 67 65 72 20 23 5c 6e 65 77 6c ->integer #\newl
16f60 69 6e 65 29 20 33 29 29 29 29 29 0a 0a 20 20 20 ine) 3)))))..
16f70 20 3b 3b 20 2e 2e 2e 20 69 74 27 73 20 72 65 61 ;; ... it's rea
16f80 6c 6c 79 20 61 6e 6e 6f 79 69 6e 67 20 74 6f 20 lly annoying to
16f90 73 75 70 70 6f 72 74 20 6f 6c 64 20 53 63 68 65 support old Sche
16fa0 6d 65 34 38 0a 20 20 20 20 28 77 6f 72 64 20 2e me48. (word .
16fb0 20 28 73 65 71 20 62 6f 77 20 28 2b 20 28 6f 72 (seq bow (+ (or
16fc0 20 61 6c 70 68 61 6e 75 6d 65 72 69 63 20 23 5c alphanumeric #\
16fd0 5f 29 29 20 65 6f 77 29 29 0a 20 20 20 20 28 75 _)) eow)). (u
16fe0 74 66 38 2d 74 61 69 6c 2d 63 68 61 72 20 2e 20 tf8-tail-char .
16ff0 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 (/ ,(integer->ch
17000 61 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 ar (+ (char->int
17010 65 67 65 72 20 23 5c 73 70 61 63 65 29 20 23 78 eger #\space) #x
17020 36 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 60)).
17030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 ,(
17040 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b integer->char (+
17050 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
17060 23 5c 73 70 61 63 65 29 20 23 78 41 31 29 29 29 #\space) #xA1)))
17070 29 0a 20 20 20 20 28 75 74 66 38 2d 32 2d 63 68 ). (utf8-2-ch
17080 61 72 20 2e 20 28 73 65 71 20 28 2f 20 2c 28 69 ar . (seq (/ ,(i
17090 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 nteger->char (+
170a0 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 (char->integer #
170b0 5c 73 70 61 63 65 29 20 23 78 41 32 29 29 0a 20 \space) #xA2)).
170c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
170d0 20 20 20 20 20 20 20 20 20 20 2c 28 69 6e 74 65 ,(inte
170e0 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 ger->char (+ (ch
170f0 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 ar->integer #\sp
17100 61 63 65 29 20 23 78 42 46 29 29 29 0a 20 20 20 ace) #xBF))).
17110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17120 20 20 20 20 20 75 74 66 38 2d 74 61 69 6c 2d 63 utf8-tail-c
17130 68 61 72 29 29 0a 20 20 20 20 28 75 74 66 38 2d har)). (utf8-
17140 33 2d 63 68 61 72 20 2e 20 28 73 65 71 20 28 2f 3-char . (seq (/
17150 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 ,(integer->char
17160 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 (+ (char->integ
17170 65 72 20 23 5c 73 70 61 63 65 29 20 23 78 43 30 er #\space) #xC0
17180 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
17190 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 ,(
171a0 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b integer->char (+
171b0 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
171c0 23 5c 73 70 61 63 65 29 20 23 78 43 46 29 29 29 #\space) #xCF)))
171d0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
171e0 20 20 20 20 20 20 20 20 20 75 74 66 38 2d 74 61 utf8-ta
171f0 69 6c 2d 63 68 61 72 0a 20 20 20 20 20 20 20 20 il-char.
17200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17210 75 74 66 38 2d 74 61 69 6c 2d 63 68 61 72 29 29 utf8-tail-char))
17220 0a 20 20 20 20 28 75 74 66 38 2d 34 2d 63 68 61 . (utf8-4-cha
17230 72 20 2e 20 28 73 65 71 20 28 2f 20 2c 28 69 6e r . (seq (/ ,(in
17240 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 teger->char (+ (
17250 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c char->integer #\
17260 73 70 61 63 65 29 20 23 78 44 30 29 29 0a 20 20 space) #xD0)).
17270 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17280 20 20 20 20 20 20 20 20 20 2c 28 69 6e 74 65 67 ,(integ
17290 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 61 er->char (+ (cha
172a0 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 61 r->integer #\spa
172b0 63 65 29 20 23 78 44 37 29 29 29 0a 20 20 20 20 ce) #xD7))).
172c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
172d0 20 20 20 20 75 74 66 38 2d 74 61 69 6c 2d 63 68 utf8-tail-ch
172e0 61 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ar.
172f0 20 20 20 20 20 20 20 20 20 20 20 75 74 66 38 2d utf8-
17300 74 61 69 6c 2d 63 68 61 72 0a 20 20 20 20 20 20 tail-char.
17310 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17320 20 20 75 74 66 38 2d 74 61 69 6c 2d 63 68 61 72 utf8-tail-char
17330 29 29 0a 20 20 20 20 28 75 74 66 38 2d 61 6e 79 )). (utf8-any
17340 20 2e 20 28 6f 72 20 61 73 63 69 69 20 75 74 66 . (or ascii utf
17350 38 2d 32 2d 63 68 61 72 20 75 74 66 38 2d 33 2d 8-2-char utf8-3-
17360 63 68 61 72 20 75 74 66 38 2d 34 2d 63 68 61 72 char utf8-4-char
17370 29 29 0a 20 20 20 20 28 75 74 66 38 2d 6e 6f 6e )). (utf8-non
17380 6c 20 2e 20 28 6f 72 20 61 73 63 69 69 2d 6e 6f l . (or ascii-no
17390 6e 6c 20 75 74 66 38 2d 32 2d 63 68 61 72 20 75 nl utf8-2-char u
173a0 74 66 38 2d 33 2d 63 68 61 72 20 75 74 66 38 2d tf8-3-char utf8-
173b0 34 2d 63 68 61 72 29 29 0a 0a 20 20 20 20 3b 3b 4-char)).. ;;
173c0 20 65 78 74 65 6e 64 65 64 20 6c 69 62 72 61 72 extended librar
173d0 79 20 70 61 74 74 65 72 6e 73 0a 20 20 20 20 28 y patterns. (
173e0 69 6e 74 65 67 65 72 20 2e 20 28 73 65 71 20 28 integer . (seq (
173f0 3f 20 28 6f 72 20 23 5c 2b 20 23 5c 2d 29 29 20 ? (or #\+ #\-))
17400 28 2b 20 6e 75 6d 65 72 69 63 29 29 29 0a 20 20 (+ numeric))).
17410 20 20 28 72 65 61 6c 20 2e 20 28 73 65 71 20 28 (real . (seq (
17420 3f 20 28 6f 72 20 23 5c 2b 20 23 5c 2d 29 29 0a ? (or #\+ #\-)).
17430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17440 20 28 2b 20 6e 75 6d 65 72 69 63 29 20 28 3f 20 (+ numeric) (?
17450 23 5c 2e 20 28 2b 20 6e 75 6d 65 72 69 63 29 29 #\. (+ numeric))
17460 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
17470 20 20 28 3f 20 28 6f 72 20 23 5c 65 20 23 5c 45 (? (or #\e #\E
17480 29 20 69 6e 74 65 67 65 72 29 29 29 0a 20 20 20 ) integer))).
17490 20 3b 3b 20 73 6c 69 67 68 74 6c 79 20 6d 6f 72 ;; slightly mor
174a0 65 20 6c 61 78 20 74 68 61 6e 20 52 35 52 53 2c e lax than R5RS,
174b0 20 61 6c 6c 6f 77 20 2d 3e 66 6f 6f 2c 20 65 74 allow ->foo, et
174c0 63 2e 0a 20 20 20 20 28 73 79 6d 62 6f 6c 2d 69 c.. (symbol-i
174d0 6e 69 74 69 61 6c 20 2e 20 28 6f 72 20 61 6c 70 nitial . (or alp
174e0 68 61 20 28 22 21 24 25 26 2a 2f 3a 3c 3d 3e 3f ha ("!$%&*/:<=>?
174f0 5e 5f 7e 22 29 29 29 0a 20 20 20 20 28 73 79 6d ^_~"))). (sym
17500 62 6f 6c 2d 73 75 62 73 65 71 75 65 6e 74 20 2e bol-subsequent .
17510 20 28 6f 72 20 73 79 6d 62 6f 6c 2d 69 6e 69 74 (or symbol-init
17520 69 61 6c 20 64 69 67 69 74 20 28 22 2b 2d 2e 40 ial digit ("+-.@
17530 22 29 29 29 0a 20 20 20 20 28 73 79 6d 62 6f 6c "))). (symbol
17540 20 2e 20 28 6f 72 20 28 73 65 71 20 73 79 6d 62 . (or (seq symb
17550 6f 6c 2d 69 6e 69 74 69 61 6c 20 28 2a 20 73 79 ol-initial (* sy
17560 6d 62 6f 6c 2d 73 75 62 73 65 71 75 65 6e 74 29 mbol-subsequent)
17570 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
17580 20 20 20 20 28 73 65 71 20 28 22 2b 2d 22 29 20 (seq ("+-")
17590 28 3f 20 73 79 6d 62 6f 6c 2d 69 6e 69 74 69 61 (? symbol-initia
175a0 6c 20 28 2a 20 73 79 6d 62 6f 6c 2d 73 75 62 73 l (* symbol-subs
175b0 65 71 75 65 6e 74 29 29 29 0a 20 20 20 20 20 20 equent))).
175c0 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 71 (seq
175d0 20 22 2e 2e 22 20 28 2a 20 22 2e 22 29 29 29 29 ".." (* "."))))
175e0 0a 20 20 20 20 28 73 65 78 70 2d 73 70 61 63 65 . (sexp-space
175f0 20 2e 20 28 73 65 71 20 28 2a 20 28 2a 20 73 70 . (seq (* (* sp
17600 61 63 65 29 20 22 3b 22 20 28 2a 20 6e 6f 6e 6c ace) ";" (* nonl
17610 29 20 6e 65 77 6c 69 6e 65 29 20 28 2b 20 73 70 ) newline) (+ sp
17620 61 63 65 29 29 29 0a 20 20 20 20 28 73 74 72 69 ace))). (stri
17630 6e 67 20 2e 20 28 73 65 71 20 23 5c 22 20 28 65 ng . (seq #\" (e
17640 73 63 61 70 65 20 23 5c 5c 20 23 5c 22 29 20 23 scape #\\ #\") #
17650 5c 22 29 29 0a 20 20 20 20 28 65 73 63 61 70 65 \")). (escape
17660 20 2e 20 2c 28 6c 61 6d 62 64 61 20 28 65 73 63 . ,(lambda (esc
17670 20 2e 20 6f 29 20 60 28 2a 20 28 6f 72 20 28 7e . o) `(* (or (~
17680 20 2c 65 73 63 20 2c 40 6f 29 20 28 73 65 71 20 ,esc ,@o) (seq
17690 2c 65 73 63 20 61 6e 79 29 29 29 29 29 0a 0a 20 ,esc any)))))..
176a0 20 20 20 28 69 70 76 34 2d 64 69 67 69 74 20 2e (ipv4-digit .
176b0 20 28 73 65 71 20 28 3f 20 28 2f 20 22 31 32 22 (seq (? (/ "12"
176c0 29 29 20 28 3f 20 6e 75 6d 65 72 69 63 29 20 6e )) (? numeric) n
176d0 75 6d 65 72 69 63 29 29 0a 20 20 20 20 28 69 70 umeric)). (ip
176e0 76 34 2d 61 64 64 72 65 73 73 20 2e 20 28 73 65 v4-address . (se
176f0 71 20 69 70 76 34 2d 64 69 67 69 74 20 28 3d 20 q ipv4-digit (=
17700 33 20 23 5c 2e 20 69 70 76 34 2d 64 69 67 69 74 3 #\. ipv4-digit
17710 29 29 29 0a 20 20 20 20 3b 3b 20 58 58 58 58 20 ))). ;; XXXX
17720 6c 61 78 2c 20 61 6c 6c 6f 77 73 20 6d 75 6c 74 lax, allows mult
17730 69 70 6c 65 20 64 6f 75 62 6c 65 2d 63 6f 6c 6f iple double-colo
17740 6e 73 20 6f 72 20 3c 20 38 20 74 65 72 6d 73 20 ns or < 8 terms
17750 77 2f 6f 20 61 20 3a 3a 0a 20 20 20 20 28 69 70 w/o a ::. (ip
17760 76 36 2d 61 64 64 72 65 73 73 20 2e 20 28 73 65 v6-address . (se
17770 71 20 28 2a 2a 20 30 20 34 20 68 65 78 2d 64 69 q (** 0 4 hex-di
17780 67 69 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 git).
17790 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2a (*
177a0 2a 20 31 20 37 20 23 5c 3a 20 28 3f 20 23 5c 3a * 1 7 #\: (? #\:
177b0 29 20 28 2a 2a 20 30 20 34 20 68 65 78 2d 64 69 ) (** 0 4 hex-di
177c0 67 69 74 29 29 29 29 0a 20 20 20 20 28 69 70 2d git)))). (ip-
177d0 61 64 64 72 65 73 73 20 2e 20 28 6f 72 20 69 70 address . (or ip
177e0 76 34 2d 61 64 64 72 65 73 73 20 69 70 76 36 2d v4-address ipv6-
177f0 61 64 64 72 65 73 73 29 29 0a 20 20 20 20 28 64 address)). (d
17800 6f 6d 61 69 6e 2d 61 74 6f 6d 20 2e 20 28 2b 20 omain-atom . (+
17810 28 6f 72 20 61 6c 70 68 61 6e 75 6d 65 72 69 63 (or alphanumeric
17820 20 23 5c 5f 20 23 5c 2d 29 29 29 0a 20 20 20 20 #\_ #\-))).
17830 28 64 6f 6d 61 69 6e 20 2e 20 28 73 65 71 20 64 (domain . (seq d
17840 6f 6d 61 69 6e 2d 61 74 6f 6d 20 28 2b 20 23 5c omain-atom (+ #\
17850 2e 20 64 6f 6d 61 69 6e 2d 61 74 6f 6d 29 29 29 . domain-atom)))
17860 0a 20 20 20 20 3b 3b 20 58 58 58 58 20 6e 6f 77 . ;; XXXX now
17870 20 61 6e 79 74 68 69 6e 67 20 63 61 6e 20 62 65 anything can be
17880 20 61 20 74 6f 70 2d 6c 65 76 65 6c 20 64 6f 6d a top-level dom
17890 61 69 6e 2c 20 62 75 74 20 74 68 69 73 20 69 73 ain, but this is
178a0 20 73 74 69 6c 6c 20 68 61 6e 64 79 0a 20 20 20 still handy.
178b0 20 28 74 6f 70 2d 6c 65 76 65 6c 2d 64 6f 6d 61 (top-level-doma
178c0 69 6e 20 2e 20 28 77 2f 6e 6f 63 61 73 65 20 28 in . (w/nocase (
178d0 6f 72 20 22 61 72 70 61 22 20 22 63 6f 6d 22 20 or "arpa" "com"
178e0 22 67 6f 76 22 20 22 6d 69 6c 22 20 22 6e 65 74 "gov" "mil" "net
178f0 22 20 22 6f 72 67 22 0a 20 20 20 20 20 20 20 20 " "org".
17900 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 65 "e
17920 64 75 22 20 22 61 65 72 6f 22 20 22 62 69 7a 22 du" "aero" "biz"
17930 20 22 63 6f 6f 70 22 20 22 69 6e 66 6f 22 0a 20 "coop" "info".
17940 20 20 20 20 20 20 20 20 20 20 20 20 20 22 6d 75 "mu
17950 73 65 75 6d 22 20 22 6e 61 6d 65 22 20 22 70 72 seum" "name" "pr
17960 6f 22 20 28 3d 20 32 20 61 6c 70 68 61 29 29 29 o" (= 2 alpha)))
17970 29 0a 20 20 20 20 28 64 6f 6d 61 69 6e 2f 63 6f ). (domain/co
17980 6d 6d 6f 6e 20 2e 20 28 73 65 71 20 28 2b 20 64 mmon . (seq (+ d
17990 6f 6d 61 69 6e 2d 61 74 6f 6d 20 23 5c 2e 29 20 omain-atom #\.)
179a0 74 6f 70 2d 6c 65 76 65 6c 2d 64 6f 6d 61 69 6e top-level-domain
179b0 29 29 0a 20 20 20 20 3b 3b 28 65 6d 61 69 6c 2d )). ;;(email-
179c0 6c 6f 63 61 6c 2d 70 61 72 74 20 2e 20 28 73 65 local-part . (se
179d0 71 20 28 2b 20 28 6f 72 20 28 7e 20 23 5c 22 29 q (+ (or (~ #\")
179e0 20 73 74 72 69 6e 67 29 29 29 29 0a 20 20 20 20 string)))).
179f0 28 65 6d 61 69 6c 2d 6c 6f 63 61 6c 2d 70 61 72 (email-local-par
17a00 74 20 2e 20 28 2b 20 28 6f 72 20 61 6c 70 68 61 t . (+ (or alpha
17a10 6e 75 6d 65 72 69 63 20 23 5c 5f 20 23 5c 2d 20 numeric #\_ #\-
17a20 23 5c 2e 20 23 5c 2b 29 29 29 0a 20 20 20 20 28 #\. #\+))). (
17a30 65 6d 61 69 6c 20 2e 20 28 73 65 71 20 65 6d 61 email . (seq ema
17a40 69 6c 2d 6c 6f 63 61 6c 2d 70 61 72 74 20 23 5c il-local-part #\
17a50 40 20 64 6f 6d 61 69 6e 29 29 0a 20 20 20 20 28 @ domain)). (
17a60 75 72 6c 2d 63 68 61 72 20 2e 20 28 6f 72 20 61 url-char . (or a
17a70 6c 6e 75 6d 20 23 5c 5f 20 23 5c 2d 20 23 5c 2b lnum #\_ #\- #\+
17a80 20 23 5c 5c 20 23 5c 3d 20 23 5c 7e 20 23 5c 2e #\\ #\= #\~ #\.
17a90 20 23 5c 2c 20 23 5c 26 20 23 5c 3b 0a 20 20 20 #\, #\& #\;.
17aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17ab0 20 28 73 65 71 20 22 25 22 20 68 65 78 2d 64 69 (seq "%" hex-di
17ac0 67 69 74 20 68 65 78 2d 64 69 67 69 74 29 29 29 git hex-digit)))
17ad0 0a 20 20 20 20 28 75 72 6c 2d 66 69 6e 61 6c 2d . (url-final-
17ae0 63 68 61 72 20 2e 20 28 6f 72 20 61 6c 6e 75 6d char . (or alnum
17af0 20 23 5c 5f 20 23 5c 2d 20 23 5c 2b 20 23 5c 5c #\_ #\- #\+ #\\
17b00 20 23 5c 3d 20 23 5c 7e 20 23 5c 26 0a 20 20 20 #\= #\~ #\&.
17b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17b20 20 20 20 20 20 20 20 28 73 65 71 20 22 25 22 20 (seq "%"
17b30 68 65 78 2d 64 69 67 69 74 20 68 65 78 2d 64 69 hex-digit hex-di
17b40 67 69 74 29 29 29 0a 20 20 20 20 28 68 74 74 70 git))). (http
17b50 2d 75 72 6c 20 2e 20 28 77 2f 6e 6f 63 61 73 65 -url . (w/nocase
17b60 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
17b70 20 20 22 68 74 74 70 22 20 28 3f 20 22 73 22 29 "http" (? "s")
17b80 20 22 3a 2f 2f 22 0a 20 20 20 20 20 20 20 20 20 "://".
17b90 20 20 20 20 20 20 20 20 28 6f 72 20 64 6f 6d 61 (or doma
17ba0 69 6e 20 69 70 76 34 2d 61 64 64 72 65 73 73 29 in ipv4-address)
17bb0 20 3b 3b 20 28 73 65 71 20 22 5b 22 20 69 70 76 ;; (seq "[" ipv
17bc0 36 2d 61 64 64 72 65 73 73 20 22 5d 22 29 0a 20 6-address "]").
17bd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17be0 28 3f 20 22 3a 22 20 28 2b 20 6e 75 6d 65 72 69 (? ":" (+ numeri
17bf0 63 29 29 20 3b 3b 20 70 6f 72 74 0a 20 20 20 20 c)) ;; port.
17c00 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
17c10 70 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 path.
17c20 20 20 20 20 20 20 28 3f 20 22 2f 22 20 28 2a 20 (? "/" (*
17c30 28 6f 72 20 75 72 6c 2d 63 68 61 72 20 22 2f 22 (or url-char "/"
17c40 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
17c50 20 20 20 20 20 20 20 28 3f 20 22 3f 22 20 28 2a (? "?" (*
17c60 20 75 72 6c 2d 63 68 61 72 29 29 20 20 20 20 20 url-char))
17c70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c80 20 3b 3b 20 71 75 65 72 79 0a 20 20 20 20 20 20 ;; query.
17c90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3f (?
17ca0 20 22 23 22 20 28 3f 20 28 2a 20 75 72 6c 2d 63 "#" (? (* url-c
17cb0 68 61 72 29 20 75 72 6c 2d 66 69 6e 61 6c 2d 63 har) url-final-c
17cc0 68 61 72 29 29 20 3b 3b 20 66 72 61 67 6d 65 6e har)) ;; fragmen
17cd0 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
17ce0 20 20 20 20 20 20 29 29 29 0a 0a 20 20 20 20 29 ))).. )
17cf0 29 0a 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b )...;;;;;;;;;;;;
17d00 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
17d10 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
17d20 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
17d30 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b ;;;;;;;;;;;;.;;;
17d40 3b 20 53 52 45 2d 3e 74 4e 46 41 20 63 6f 6d 70 ; SRE->tNFA comp
17d50 69 6c 61 74 69 6f 6e 0a 3b 3b 0a 3b 3b 20 41 20 ilation.;;.;; A
17d60 74 61 67 67 65 64 20 4e 46 41 20 28 74 4e 46 41 tagged NFA (tNFA
17d70 29 20 73 74 61 74 65 20 69 73 20 61 20 6e 75 6d ) state is a num
17d80 62 65 72 65 64 20 6e 6f 64 65 20 77 69 74 68 20 bered node with
17d90 61 20 6c 69 73 74 20 6f 66 0a 3b 3b 20 70 61 74 a list of.;; pat
17da0 74 65 72 6e 2d 3e 6e 75 6d 62 65 72 20 74 72 61 tern->number tra
17db0 6e 73 69 74 69 6f 6e 73 2c 20 77 68 65 72 65 20 nsitions, where
17dc0 70 61 74 74 65 72 6e 20 69 73 20 63 68 61 72 61 pattern is chara
17dd0 63 74 65 72 20 73 65 74 20 72 61 6e 67 65 2c 0a cter set range,.
17de0 3b 3b 20 6f 72 20 65 70 73 69 6c 6f 6e 20 28 69 ;; or epsilon (i
17df0 6e 64 69 63 61 74 69 6e 67 20 61 6e 20 65 6d 70 ndicating an emp
17e00 74 79 20 74 72 61 6e 73 69 74 69 6f 6e 29 2e 0a ty transition)..
17e10 3b 3b 0a 3b 3b 20 28 4f 6e 6c 79 29 20 65 70 73 ;;.;; (Only) eps
17e20 69 6c 6f 6e 20 74 72 61 6e 73 69 74 69 6f 6e 73 ilon transitions
17e30 20 6d 61 79 20 62 65 20 2a 74 61 67 67 65 64 2a may be *tagged*
17e40 2e 20 20 45 61 63 68 20 74 61 67 20 72 65 70 72 . Each tag repr
17e50 65 73 65 6e 74 73 0a 3b 3b 20 65 69 74 68 65 72 esents.;; either
17e60 20 74 68 65 20 73 74 61 72 74 20 6f 72 20 74 68 the start or th
17e70 65 20 65 6e 64 20 6f 66 20 61 20 73 75 62 6d 61 e end of a subma
17e80 74 63 68 2e 0a 3b 3b 0a 3b 3b 20 54 68 65 72 65 tch..;;.;; There
17e90 20 6d 61 79 20 62 65 20 6f 76 65 72 6c 61 70 70 may be overlapp
17ea0 69 6e 67 20 72 61 6e 67 65 73 20 2d 20 73 69 6e ing ranges - sin
17eb0 63 65 20 69 74 27 73 20 61 6e 20 4e 46 41 20 77 ce it's an NFA w
17ec0 65 20 70 72 6f 63 65 73 73 20 69 74 0a 3b 3b 20 e process it.;;
17ed0 62 79 20 63 6f 6e 73 69 64 65 72 69 6e 67 20 61 by considering a
17ee0 6c 6c 20 70 6f 73 73 69 62 6c 65 20 74 72 61 6e ll possible tran
17ef0 73 69 74 69 6f 6e 73 2e 0a 0a 28 64 65 66 69 6e sitions...(defin
17f00 65 20 2a 6e 66 61 2d 70 72 65 73 69 7a 65 2a 20 e *nfa-presize*
17f10 31 32 38 29 20 20 3b 3b 20 63 6f 6e 73 74 61 6e 128) ;; constan
17f20 74 0a 28 64 65 66 69 6e 65 20 2a 6e 66 61 2d 6e t.(define *nfa-n
17f30 75 6d 2d 66 69 65 6c 64 73 2a 20 34 29 20 3b 3b um-fields* 4) ;;
17f40 20 63 6f 6e 73 74 61 6e 74 0a 0a 28 64 65 66 69 constant..(defi
17f50 6e 65 20 28 6e 66 61 2d 6e 75 6d 2d 73 74 61 74 ne (nfa-num-stat
17f60 65 73 20 6e 66 61 29 20 28 71 75 6f 74 69 65 6e es nfa) (quotien
17f70 74 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 t (vector-length
17f80 20 6e 66 61 29 20 2a 6e 66 61 2d 6e 75 6d 2d 66 nfa) *nfa-num-f
17f90 69 65 6c 64 73 2a 29 29 0a 28 64 65 66 69 6e 65 ields*)).(define
17fa0 20 28 6e 66 61 2d 73 74 61 72 74 2d 73 74 61 74 (nfa-start-stat
17fb0 65 20 6e 66 61 29 20 28 2d 20 28 6e 66 61 2d 6e e nfa) (- (nfa-n
17fc0 75 6d 2d 73 74 61 74 65 73 20 6e 66 61 29 20 31 um-states nfa) 1
17fd0 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6e 66 61 ))..(define (nfa
17fe0 2d 6e 75 6d 2d 74 61 67 73 20 6e 66 61 29 0a 20 -num-tags nfa).
17ff0 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6e 66 61 (vector-ref nfa
18000 20 30 29 29 0a 28 64 65 66 69 6e 65 20 28 6e 66 0)).(define (nf
18010 61 2d 68 69 67 68 65 73 74 2d 6d 61 70 2d 69 6e a-highest-map-in
18020 64 65 78 20 6e 66 61 29 0a 20 20 28 76 65 63 74 dex nfa). (vect
18030 6f 72 2d 72 65 66 20 6e 66 61 20 31 29 29 0a 28 or-ref nfa 1)).(
18040 64 65 66 69 6e 65 20 28 6e 66 61 2d 73 65 74 2d define (nfa-set-
18050 68 69 67 68 65 73 74 2d 6d 61 70 2d 69 6e 64 65 highest-map-inde
18060 78 21 20 6e 66 61 20 69 64 78 29 0a 20 20 28 76 x! nfa idx). (v
18070 65 63 74 6f 72 2d 73 65 74 21 20 6e 66 61 20 31 ector-set! nfa 1
18080 20 69 64 78 29 29 0a 0a 28 64 65 66 69 6e 65 20 idx))..(define
18090 28 6e 66 61 2d 67 65 74 2d 73 74 61 74 65 2d 74 (nfa-get-state-t
180a0 72 61 6e 73 20 6e 66 61 20 69 29 0a 20 20 28 69 rans nfa i). (i
180b0 66 20 28 3d 20 69 20 30 29 20 27 28 29 20 28 76 f (= i 0) '() (v
180c0 65 63 74 6f 72 2d 72 65 66 20 6e 66 61 20 28 2a ector-ref nfa (*
180d0 20 69 20 2a 6e 66 61 2d 6e 75 6d 2d 66 69 65 6c i *nfa-num-fiel
180e0 64 73 2a 29 29 29 29 0a 28 64 65 66 69 6e 65 20 ds*)))).(define
180f0 28 6e 66 61 2d 73 65 74 2d 73 74 61 74 65 2d 74 (nfa-set-state-t
18100 72 61 6e 73 21 20 6e 66 61 20 69 20 78 29 0a 20 rans! nfa i x).
18110 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6e 66 (vector-set! nf
18120 61 20 28 2a 20 69 20 2a 6e 66 61 2d 6e 75 6d 2d a (* i *nfa-num-
18130 66 69 65 6c 64 73 2a 29 20 78 29 29 0a 0a 28 64 fields*) x))..(d
18140 65 66 69 6e 65 20 28 6e 66 61 2d 67 65 74 2d 65 efine (nfa-get-e
18150 70 73 69 6c 6f 6e 73 20 6e 66 61 20 69 29 0a 20 psilons nfa i).
18160 20 28 69 66 20 28 3d 20 69 20 30 29 20 27 28 29 (if (= i 0) '()
18170 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6e 66 61 (vector-ref nfa
18180 20 28 2b 20 28 2a 20 69 20 2a 6e 66 61 2d 6e 75 (+ (* i *nfa-nu
18190 6d 2d 66 69 65 6c 64 73 2a 29 20 31 29 29 29 29 m-fields*) 1))))
181a0 0a 28 64 65 66 69 6e 65 20 28 6e 66 61 2d 73 65 .(define (nfa-se
181b0 74 2d 65 70 73 69 6c 6f 6e 73 21 20 6e 66 61 20 t-epsilons! nfa
181c0 69 20 78 29 0a 20 20 28 76 65 63 74 6f 72 2d 73 i x). (vector-s
181d0 65 74 21 20 6e 66 61 20 28 2b 20 28 2a 20 69 20 et! nfa (+ (* i
181e0 2a 6e 66 61 2d 6e 75 6d 2d 66 69 65 6c 64 73 2a *nfa-num-fields*
181f0 29 20 31 29 20 78 29 29 0a 28 64 65 66 69 6e 65 ) 1) x)).(define
18200 20 28 6e 66 61 2d 61 64 64 2d 65 70 73 69 6c 6f (nfa-add-epsilo
18210 6e 21 20 6e 66 61 20 69 20 78 20 74 29 0a 20 20 n! nfa i x t).
18220 28 6c 65 74 20 28 28 65 70 73 20 28 6e 66 61 2d (let ((eps (nfa-
18230 67 65 74 2d 65 70 73 69 6c 6f 6e 73 20 6e 66 61 get-epsilons nfa
18240 20 69 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e i))). (if (n
18250 6f 74 20 28 61 73 73 76 20 78 20 65 70 73 29 29 ot (assv x eps))
18260 0a 20 20 20 20 20 20 20 20 28 6e 66 61 2d 73 65 . (nfa-se
18270 74 2d 65 70 73 69 6c 6f 6e 73 21 20 6e 66 61 20 t-epsilons! nfa
18280 69 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 78 20 i (cons (cons x
18290 74 29 20 65 70 73 29 29 29 29 29 0a 0a 28 64 65 t) eps)))))..(de
182a0 66 69 6e 65 20 28 6e 66 61 2d 67 65 74 2d 72 65 fine (nfa-get-re
182b0 6f 72 64 65 72 2d 63 6f 6d 6d 61 6e 64 73 20 6e order-commands n
182c0 66 61 20 6d 73 74 29 0a 20 20 28 63 6f 6e 64 20 fa mst). (cond
182d0 28 28 61 73 73 6f 63 20 6d 73 74 20 28 76 65 63 ((assoc mst (vec
182e0 74 6f 72 2d 72 65 66 20 6e 66 61 20 28 2b 20 28 tor-ref nfa (+ (
182f0 2a 20 28 6d 73 74 2d 68 61 73 68 20 6d 73 74 29 * (mst-hash mst)
18300 20 2a 6e 66 61 2d 6e 75 6d 2d 66 69 65 6c 64 73 *nfa-num-fields
18310 2a 29 20 32 29 29 29 0a 20 20 20 20 20 20 20 20 *) 2))).
18320 20 3d 3e 20 63 64 72 29 0a 20 20 20 20 20 20 20 => cdr).
18330 20 28 65 6c 73 65 20 23 66 29 29 29 0a 28 64 65 (else #f))).(de
18340 66 69 6e 65 20 28 6e 66 61 2d 73 65 74 2d 72 65 fine (nfa-set-re
18350 6f 72 64 65 72 2d 63 6f 6d 6d 61 6e 64 73 21 20 order-commands!
18360 6e 66 61 20 6d 73 74 20 78 29 0a 20 20 28 6c 65 nfa mst x). (le
18370 74 20 28 28 69 20 28 2b 20 28 2a 20 28 6d 73 74 t ((i (+ (* (mst
18380 2d 68 61 73 68 20 6d 73 74 29 20 2a 6e 66 61 2d -hash mst) *nfa-
18390 6e 75 6d 2d 66 69 65 6c 64 73 2a 29 20 32 29 29 num-fields*) 2))
183a0 29 0a 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 ). (vector-se
183b0 74 21 20 6e 66 61 20 69 20 28 63 6f 6e 73 20 28 t! nfa i (cons (
183c0 63 6f 6e 73 20 6d 73 74 20 78 29 20 28 76 65 63 cons mst x) (vec
183d0 74 6f 72 2d 72 65 66 20 6e 66 61 20 69 29 29 29 tor-ref nfa i)))
183e0 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6e 66 61 ))..(define (nfa
183f0 2d 67 65 74 2d 63 6c 6f 73 75 72 65 20 6e 66 61 -get-closure nfa
18400 20 6d 73 74 29 0a 20 20 28 63 6f 6e 64 20 28 28 mst). (cond ((
18410 61 73 73 6f 63 20 6d 73 74 20 28 76 65 63 74 6f assoc mst (vecto
18420 72 2d 72 65 66 20 6e 66 61 20 28 2b 20 28 2a 20 r-ref nfa (+ (*
18430 28 6d 73 74 2d 68 61 73 68 20 6d 73 74 29 20 2a (mst-hash mst) *
18440 6e 66 61 2d 6e 75 6d 2d 66 69 65 6c 64 73 2a 29 nfa-num-fields*)
18450 20 33 29 29 29 0a 20 20 20 20 20 20 20 20 20 3d 3))). =
18460 3e 20 63 64 72 29 0a 20 20 20 20 20 20 20 20 28 > cdr). (
18470 65 6c 73 65 20 23 66 29 29 29 0a 28 64 65 66 69 else #f))).(defi
18480 6e 65 20 28 6e 66 61 2d 61 64 64 2d 63 6c 6f 73 ne (nfa-add-clos
18490 75 72 65 21 20 6e 66 61 20 6d 73 74 20 78 29 0a ure! nfa mst x).
184a0 20 20 28 6c 65 74 20 28 28 69 20 28 2b 20 28 2a (let ((i (+ (*
184b0 20 28 6d 73 74 2d 68 61 73 68 20 6d 73 74 29 20 (mst-hash mst)
184c0 2a 6e 66 61 2d 6e 75 6d 2d 66 69 65 6c 64 73 2a *nfa-num-fields*
184d0 29 20 33 29 29 29 0a 20 20 20 20 28 76 65 63 74 ) 3))). (vect
184e0 6f 72 2d 73 65 74 21 20 6e 66 61 20 69 20 28 63 or-set! nfa i (c
184f0 6f 6e 73 20 28 63 6f 6e 73 20 6d 73 74 20 78 29 ons (cons mst x)
18500 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6e 66 61 (vector-ref nfa
18510 20 69 29 29 29 29 29 0a 0a 3b 3b 20 43 6f 6d 70 i)))))..;; Comp
18520 69 6c 65 20 61 6e 64 20 72 65 74 75 72 6e 20 74 ile and return t
18530 68 65 20 76 65 63 74 6f 72 20 6f 66 20 4e 46 41 he vector of NFA
18540 20 73 74 61 74 65 73 20 28 69 6e 20 67 72 6f 75 states (in grou
18550 70 73 20 6f 66 0a 3b 3b 20 2a 6e 66 61 2d 6e 75 ps of.;; *nfa-nu
18560 6d 2d 66 69 65 6c 64 73 2a 20 70 61 63 6b 65 64 m-fields* packed
18570 20 65 6c 65 6d 65 6e 74 73 29 2e 20 20 54 68 65 elements). The
18580 20 73 74 61 72 74 20 73 74 61 74 65 20 77 69 6c start state wil
18590 6c 20 62 65 20 74 68 65 0a 3b 3b 20 6c 61 73 74 l be the.;; last
185a0 20 65 6c 65 6d 65 6e 74 28 73 29 20 6f 66 20 74 element(s) of t
185b0 68 65 20 76 65 63 74 6f 72 2c 20 61 6e 64 20 61 he vector, and a
185c0 6c 6c 20 72 65 6d 61 69 6e 69 6e 67 20 73 74 61 ll remaining sta
185d0 74 65 73 20 77 69 6c 6c 20 62 65 20 69 6e 0a 3b tes will be in.;
185e0 3b 20 64 65 73 63 65 6e 64 69 6e 67 20 6e 75 6d ; descending num
185f0 65 72 69 63 20 6f 72 64 65 72 2c 20 77 69 74 68 eric order, with
18600 20 73 74 61 74 65 20 30 20 62 65 69 6e 67 20 74 state 0 being t
18610 68 65 20 75 6e 69 71 75 65 20 61 63 63 65 70 74 he unique accept
18620 69 6e 67 0a 3b 3b 20 73 74 61 74 65 2e 0a 28 64 ing.;; state..(d
18630 65 66 69 6e 65 20 28 73 72 65 2d 3e 6e 66 61 20 efine (sre->nfa
18640 73 72 65 20 69 6e 69 74 2d 66 6c 61 67 73 29 0a sre init-flags).
18650 20 20 28 6c 65 74 2a 20 28 28 62 75 66 20 28 6d (let* ((buf (m
18660 61 6b 65 2d 76 65 63 74 6f 72 20 28 2a 20 2a 6e ake-vector (* *n
18670 66 61 2d 70 72 65 73 69 7a 65 2a 20 2a 6e 66 61 fa-presize* *nfa
18680 2d 6e 75 6d 2d 66 69 65 6c 64 73 2a 29 20 27 28 -num-fields*) '(
18690 29 29 29 0a 20 20 20 20 20 20 20 20 20 3b 3b 20 ))). ;;
186a0 47 65 74 20 63 6f 6e 73 20 63 65 6c 6c 73 20 61 Get cons cells a
186b0 6e 64 20 6d 61 70 20 74 68 65 6d 20 74 6f 20 6e nd map them to n
186c0 75 6d 65 72 69 63 20 73 75 62 6d 61 74 63 68 20 umeric submatch
186d0 69 6e 64 65 78 65 73 2e 0a 20 20 20 20 20 20 20 indexes..
186e0 20 20 3b 3b 20 44 6f 69 6e 67 20 69 74 20 68 65 ;; Doing it he
186f0 72 65 20 69 73 20 73 6c 69 67 68 74 6c 79 20 65 re is slightly e
18700 61 73 69 65 72 20 74 68 61 6e 20 69 6e 74 65 67 asier than integ
18710 72 61 74 69 6e 67 20 69 6e 74 6f 20 74 68 65 20 rating into the
18720 6c 6f 6f 70 20 62 65 6c 6f 77 0a 20 20 20 20 20 loop below.
18730 20 20 20 20 28 6d 61 74 63 68 2d 69 6e 64 65 78 (match-index
18740 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 . (let
18750 6c 70 20 28 28 73 72 65 20 28 6c 69 73 74 20 73 lp ((sre (list s
18760 72 65 29 29 20 28 6d 61 78 20 30 29 20 28 72 65 re)) (max 0) (re
18770 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 s '())).
18780 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
18790 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 70 61 ((not (pa
187a0 69 72 3f 20 73 72 65 29 29 0a 20 20 20 20 20 20 ir? sre)).
187b0 20 20 20 20 20 20 20 20 3b 3b 20 57 65 20 61 62 ;; We ab
187c0 75 73 65 20 74 68 65 20 74 72 61 6e 73 69 74 69 use the transiti
187d0 6f 6e 73 20 73 6c 6f 74 20 66 6f 72 20 73 74 61 ons slot for sta
187e0 74 65 20 30 20 28 74 68 65 20 66 69 6e 61 6c 20 te 0 (the final
187f0 73 74 61 74 65 2c 0a 20 20 20 20 20 20 20 20 20 state,.
18800 20 20 20 20 20 3b 3b 20 77 68 69 63 68 20 63 61 ;; which ca
18810 6e 20 68 61 76 65 20 6e 6f 20 74 72 61 6e 73 69 n have no transi
18820 74 69 6f 6e 73 29 20 74 6f 20 73 74 6f 72 65 20 tions) to store
18830 74 68 65 20 6e 75 6d 62 65 72 20 6f 66 20 74 61 the number of ta
18840 67 73 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 gs..
18850 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 62 (vector-set! b
18860 75 66 20 30 20 28 2a 20 6d 61 78 20 32 29 29 0a uf 0 (* max 2)).
18870 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
18880 20 57 65 20 61 62 75 73 65 20 74 68 65 20 65 70 We abuse the ep
18890 73 69 6c 6f 6e 73 20 73 6c 6f 74 20 66 6f 72 20 silons slot for
188a0 73 74 61 74 65 20 30 20 74 6f 20 73 74 6f 72 65 state 0 to store
188b0 20 74 68 65 20 68 69 67 68 65 73 74 0a 20 20 20 the highest.
188c0 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 65 6e ;; en
188d0 63 6f 75 6e 74 65 72 65 64 20 6d 65 6d 6f 72 79 countered memory
188e0 20 73 6c 6f 74 20 6d 61 70 70 69 6e 67 20 69 6e slot mapping in
188f0 64 65 78 2e 20 20 49 6e 69 74 69 61 6c 69 7a 65 dex. Initialize
18900 20 74 6f 20 2d 31 2e 0a 20 20 20 20 20 20 20 20 to -1..
18910 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
18920 74 21 20 62 75 66 20 31 20 2d 31 29 0a 20 20 20 t! buf 1 -1).
18930 20 20 20 20 20 20 20 20 20 20 20 72 65 73 29 0a res).
18940 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 ((p
18950 61 69 72 3f 20 28 63 61 72 20 73 72 65 29 29 0a air? (car sre)).
18960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
18970 20 54 68 65 20 61 70 70 65 6e 64 73 20 68 65 72 The appends her
18980 65 20 73 68 6f 75 6c 64 20 62 65 20 73 61 66 65 e should be safe
18990 20 28 61 72 65 20 74 68 65 79 3f 29 0a 20 20 20 (are they?).
189a0 20 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 (case
189b0 20 28 63 61 61 72 20 73 72 65 29 0a 20 20 20 20 (caar sre).
189c0 20 20 20 20 20 20 20 20 20 20 20 20 28 28 24 20 (($
189d0 73 75 62 6d 61 74 63 68 20 3d 3e 20 73 75 62 6d submatch => subm
189e0 61 74 63 68 2d 6e 61 6d 65 64 29 0a 20 20 20 20 atch-named).
189f0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
18a00 20 28 61 70 70 65 6e 64 20 28 63 64 61 72 20 73 (append (cdar s
18a10 72 65 29 20 28 63 64 72 20 73 72 65 29 29 20 28 re) (cdr sre)) (
18a20 2b 20 6d 61 78 20 31 29 0a 20 20 20 20 20 20 20 + max 1).
18a30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
18a40 6f 6e 73 20 28 63 6f 6e 73 20 28 63 61 72 20 73 ons (cons (car s
18a50 72 65 29 20 6d 61 78 29 20 72 65 73 29 29 29 0a re) max) res))).
18a60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18a70 28 65 6c 73 65 20 28 6c 70 20 28 61 70 70 65 6e (else (lp (appen
18a80 64 20 28 63 61 72 20 73 72 65 29 20 28 63 64 72 d (car sre) (cdr
18a90 20 73 72 65 29 29 20 6d 61 78 20 72 65 73 29 29 sre)) max res))
18aa0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
18ab0 28 65 6c 73 65 20 28 6c 70 20 28 63 64 72 20 73 (else (lp (cdr s
18ac0 72 65 29 20 6d 61 78 20 72 65 73 29 29 29 29 29 re) max res)))))
18ad0 29 0a 20 20 20 20 3b 3b 20 77 65 20 6c 6f 6f 70 ). ;; we loop
18ae0 20 6f 76 65 72 20 61 6e 20 69 6d 70 6c 69 63 69 over an implici
18af0 74 20 73 65 71 75 65 6e 63 65 20 6c 69 73 74 0a t sequence list.
18b00 20 20 20 20 28 64 65 66 69 6e 65 20 28 6c 70 20 (define (lp
18b10 6c 73 20 6e 20 66 6c 61 67 73 20 6e 65 78 74 29 ls n flags next)
18b20 0a 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 . (define (
18b30 6e 65 77 2d 73 74 61 74 65 2d 6e 75 6d 62 65 72 new-state-number
18b40 20 73 74 61 74 65 29 0a 20 20 20 20 20 20 20 20 state).
18b50 28 6d 61 78 20 6e 20 28 2b 20 31 20 73 74 61 74 (max n (+ 1 stat
18b60 65 29 29 29 0a 20 20 20 20 20 20 28 64 65 66 69 e))). (defi
18b70 6e 65 20 28 61 64 64 2d 73 74 61 74 65 21 20 6e ne (add-state! n
18b80 32 20 74 72 61 6e 73 2d 6c 73 29 0a 20 20 20 20 2 trans-ls).
18b90 20 20 20 20 28 69 66 20 28 3e 3d 20 28 2a 20 6e (if (>= (* n
18ba0 32 20 2a 6e 66 61 2d 6e 75 6d 2d 66 69 65 6c 64 2 *nfa-num-field
18bb0 73 2a 29 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 s*) (vector-leng
18bc0 74 68 20 62 75 66 29 29 0a 20 20 20 20 20 20 20 th buf)).
18bd0 20 20 20 20 20 28 6c 65 74 20 28 28 74 6d 70 20 (let ((tmp
18be0 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 2a 20 (make-vector (*
18bf0 32 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 2 (vector-length
18c00 20 62 75 66 29 29 20 27 28 29 29 29 29 0a 20 20 buf)) '()))).
18c10 20 20 20 20 20 20 20 20 20 20 20 20 28 64 6f 20 (do
18c20 28 28 69 20 28 2d 20 28 76 65 63 74 6f 72 2d 6c ((i (- (vector-l
18c30 65 6e 67 74 68 20 62 75 66 29 20 31 29 20 28 2d ength buf) 1) (-
18c40 20 69 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 i 1))).
18c50 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 69 20 ((< i
18c60 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0)).
18c70 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
18c80 20 74 6d 70 20 69 20 28 76 65 63 74 6f 72 2d 72 tmp i (vector-r
18c90 65 66 20 62 75 66 20 69 29 29 29 0a 20 20 20 20 ef buf i))).
18ca0 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set!
18cb0 62 75 66 20 74 6d 70 29 29 29 0a 20 20 20 20 20 buf tmp))).
18cc0 20 20 20 28 6e 66 61 2d 73 65 74 2d 73 74 61 74 (nfa-set-stat
18cd0 65 2d 74 72 61 6e 73 21 20 62 75 66 20 6e 32 20 e-trans! buf n2
18ce0 74 72 61 6e 73 2d 6c 73 29 0a 20 20 20 20 20 20 trans-ls).
18cf0 20 20 6e 32 29 0a 20 20 20 20 20 20 28 64 65 66 n2). (def
18d00 69 6e 65 20 28 65 78 74 65 6e 64 2d 73 74 61 74 ine (extend-stat
18d10 65 21 20 6e 65 78 74 20 74 72 61 6e 73 2d 63 73 e! next trans-cs
18d20 29 0a 20 20 20 20 20 20 20 20 28 61 6e 64 20 6e ). (and n
18d30 65 78 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 ext.
18d40 20 28 61 64 64 2d 73 74 61 74 65 21 20 28 6e 65 (add-state! (ne
18d50 77 2d 73 74 61 74 65 2d 6e 75 6d 62 65 72 20 6e w-state-number n
18d60 65 78 74 29 20 28 63 6f 6e 73 20 74 72 61 6e 73 ext) (cons trans
18d70 2d 63 73 20 6e 65 78 74 29 29 29 29 0a 20 20 20 -cs next)))).
18d80 20 20 20 28 64 65 66 69 6e 65 20 28 61 64 64 2d (define (add-
18d90 63 68 61 72 2d 73 74 61 74 65 21 20 6e 65 78 74 char-state! next
18da0 20 63 68 29 0a 20 20 20 20 20 20 20 20 28 6c 65 ch). (le
18db0 74 20 28 28 61 6c 74 20 28 63 68 61 72 2d 61 6c t ((alt (char-al
18dc0 74 63 61 73 65 20 63 68 29 29 29 0a 20 20 20 20 tcase ch))).
18dd0 20 20 20 20 20 20 28 69 66 20 28 66 6c 61 67 2d (if (flag-
18de0 73 65 74 3f 20 66 6c 61 67 73 20 7e 63 61 73 65 set? flags ~case
18df0 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 0a 20 -insensitive?).
18e00 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 78 (ex
18e10 74 65 6e 64 2d 73 74 61 74 65 21 20 6e 65 78 74 tend-state! next
18e20 20 28 63 73 65 74 2d 75 6e 69 6f 6e 20 28 63 68 (cset-union (ch
18e30 61 72 2d 3e 63 73 65 74 20 63 68 29 20 28 63 68 ar->cset ch) (ch
18e40 61 72 2d 3e 63 73 65 74 20 61 6c 74 29 29 29 0a ar->cset alt))).
18e50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
18e60 78 74 65 6e 64 2d 73 74 61 74 65 21 20 6e 65 78 xtend-state! nex
18e70 74 20 28 63 68 61 72 2d 3e 63 73 65 74 20 63 68 t (char->cset ch
18e80 29 29 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 ))))). (if
18e90 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 (null? ls).
18ea0 20 20 20 20 20 6e 65 78 74 0a 20 20 20 20 20 20 next.
18eb0 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
18ec0 20 20 20 20 20 28 28 6f 72 20 28 65 71 3f 20 27 ((or (eq? '
18ed0 65 70 73 69 6c 6f 6e 20 28 63 61 72 20 6c 73 29 epsilon (car ls)
18ee0 29 20 28 65 71 75 61 6c 3f 20 22 22 20 28 63 61 ) (equal? "" (ca
18ef0 72 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 r ls))).
18f00 20 20 20 20 3b 3b 20 63 68 61 72 73 20 61 6e 64 ;; chars and
18f10 20 65 70 73 69 6c 6f 6e 73 20 67 6f 20 64 69 72 epsilons go dir
18f20 65 63 74 6c 79 20 69 6e 74 6f 20 74 68 65 20 74 ectly into the t
18f30 72 61 6e 73 69 74 69 6f 6e 20 74 61 62 6c 65 0a ransition table.
18f40 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
18f50 20 28 28 6e 65 78 74 20 28 6c 70 20 28 63 64 72 ((next (lp (cdr
18f60 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e 65 78 ls) n flags nex
18f70 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
18f80 20 20 20 28 61 6e 64 20 6e 65 78 74 0a 20 20 20 (and next.
18f90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18fa0 28 6c 65 74 20 28 28 6e 65 77 20 28 61 64 64 2d (let ((new (add-
18fb0 73 74 61 74 65 21 20 28 6e 65 77 2d 73 74 61 74 state! (new-stat
18fc0 65 2d 6e 75 6d 62 65 72 20 6e 65 78 74 29 20 27 e-number next) '
18fd0 28 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ()))).
18fe0 20 20 20 20 20 20 20 20 20 20 20 28 6e 66 61 2d (nfa-
18ff0 61 64 64 2d 65 70 73 69 6c 6f 6e 21 20 62 75 66 add-epsilon! buf
19000 20 6e 65 77 20 6e 65 78 74 20 23 66 29 0a 20 20 new next #f).
19010 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19020 20 20 20 6e 65 77 29 29 29 29 0a 20 20 20 20 20 new)))).
19030 20 20 20 20 20 20 28 28 73 74 72 69 6e 67 3f 20 ((string?
19040 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 (car ls)).
19050 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 73 73 ;; process
19060 20 6c 69 74 65 72 61 6c 20 73 74 72 69 6e 67 73 literal strings
19070 20 61 20 63 68 61 72 20 61 74 20 61 20 74 69 6d a char at a tim
19080 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c e. (l
19090 65 74 20 28 28 6e 65 78 74 20 28 6c 70 20 28 63 et ((next (lp (c
190a0 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e dr ls) n flags n
190b0 65 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 ext))).
190c0 20 20 20 20 20 28 61 6e 64 20 6e 65 78 74 0a 20 (and next.
190d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
190e0 20 20 28 6c 65 74 20 6c 70 32 20 28 28 69 20 28 (let lp2 ((i (
190f0 2d 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 - (string-length
19100 20 28 63 61 72 20 6c 73 29 29 20 31 29 29 0a 20 (car ls)) 1)).
19110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19120 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 (nex
19130 74 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 t next)).
19140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
19150 66 20 28 3c 20 69 20 30 29 0a 20 20 20 20 20 20 f (< i 0).
19160 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19170 20 20 20 6e 65 78 74 0a 20 20 20 20 20 20 20 20 next.
19180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19190 20 28 6c 70 32 20 28 2d 20 69 20 31 29 0a 20 20 (lp2 (- i 1).
191a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
191b0 20 20 20 20 20 20 20 20 20 20 20 20 28 61 64 64 (add
191c0 2d 63 68 61 72 2d 73 74 61 74 65 21 20 6e 65 78 -char-state! nex
191d0 74 20 28 73 74 72 69 6e 67 2d 72 65 66 20 28 63 t (string-ref (c
191e0 61 72 20 6c 73 29 20 69 29 29 29 29 0a 20 20 20 ar ls) i)))).
191f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19200 20 20 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 )))).
19210 20 20 28 28 63 68 61 72 3f 20 28 63 61 72 20 6c ((char? (car l
19220 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
19230 28 61 64 64 2d 63 68 61 72 2d 73 74 61 74 65 21 (add-char-state!
19240 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 6e 20 (lp (cdr ls) n
19250 66 6c 61 67 73 20 6e 65 78 74 29 20 28 63 61 72 flags next) (car
19260 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 ls))).
19270 20 20 28 28 73 79 6d 62 6f 6c 3f 20 28 63 61 72 ((symbol? (car
19280 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls)).
19290 20 20 28 6c 65 74 20 28 28 63 65 6c 6c 20 28 61 (let ((cell (a
192a0 73 73 71 20 28 63 61 72 20 6c 73 29 20 73 72 65 ssq (car ls) sre
192b0 2d 6e 61 6d 65 64 2d 64 65 66 69 6e 69 74 69 6f -named-definitio
192c0 6e 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ns))).
192d0 20 20 20 20 28 61 6e 64 20 63 65 6c 6c 0a 20 20 (and cell.
192e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
192f0 20 28 6c 70 20 28 63 6f 6e 73 20 28 69 66 20 28 (lp (cons (if (
19300 70 72 6f 63 65 64 75 72 65 3f 20 28 63 64 72 20 procedure? (cdr
19310 63 65 6c 6c 29 29 0a 20 20 20 20 20 20 20 20 20 cell)).
19320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19330 20 20 20 20 20 20 20 20 28 28 63 64 72 20 63 65 ((cdr ce
19340 6c 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ll)).
19350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19360 20 20 20 20 20 20 28 63 64 72 20 63 65 6c 6c 29 (cdr cell)
19370 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
19380 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19390 63 64 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 cdr ls)).
193a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
193b0 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
193c0 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 0a 20 flags.
193d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
193e0 20 20 20 20 20 20 6e 65 78 74 29 29 29 29 0a 20 next)))).
193f0 20 20 20 20 20 20 20 20 20 20 28 28 70 61 69 72 ((pair
19400 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 ? (car ls)).
19410 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
19420 20 20 20 20 20 20 20 20 20 20 20 28 28 73 74 72 ((str
19430 69 6e 67 3f 20 28 63 61 61 72 20 6c 73 29 29 20 ing? (caar ls))
19440 20 20 20 20 20 20 3b 20 45 6e 75 6d 65 72 61 74 ; Enumerat
19450 65 64 20 63 68 61 72 61 63 74 65 72 20 73 65 74 ed character set
19460 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
19470 6c 65 74 20 28 28 73 65 74 20 28 69 66 20 28 66 let ((set (if (f
19480 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e lag-set? flags ~
19490 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 case-insensitive
194a0 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?).
194b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
194c0 28 63 73 65 74 2d 63 61 73 65 2d 69 6e 73 65 6e (cset-case-insen
194d0 73 69 74 69 76 65 20 28 73 74 72 69 6e 67 2d 3e sitive (string->
194e0 63 73 65 74 20 28 63 61 61 72 20 6c 73 29 29 29 cset (caar ls)))
194f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19500 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
19510 74 72 69 6e 67 2d 3e 63 73 65 74 20 28 63 61 61 tring->cset (caa
19520 72 20 6c 73 29 29 29 29 29 0a 20 20 20 20 20 20 r ls))))).
19530 20 20 20 20 20 20 20 20 20 28 65 78 74 65 6e 64 (extend
19540 2d 73 74 61 74 65 21 20 28 6c 70 20 28 63 64 72 -state! (lp (cdr
19550 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e 65 78 ls) n flags nex
19560 74 29 20 73 65 74 29 29 29 0a 20 20 20 20 20 20 t) set))).
19570 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
19580 20 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 (case
19590 20 28 63 61 61 72 20 6c 73 29 0a 20 20 20 20 20 (caar ls).
195a0 20 20 20 20 20 20 20 20 20 20 20 28 28 73 65 71 ((seq
195b0 20 3a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 :).
195c0 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 6e 20 65 ;; for an e
195d0 78 70 6c 69 63 69 74 20 73 65 71 75 65 6e 63 65 xplicit sequence
195e0 2c 20 6a 75 73 74 20 61 70 70 65 6e 64 20 74 6f , just append to
195f0 20 74 68 65 20 6c 69 73 74 0a 20 20 20 20 20 20 the list.
19600 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
19610 61 70 70 65 6e 64 20 28 63 64 61 72 20 6c 73 29 append (cdar ls)
19620 20 28 63 64 72 20 6c 73 29 29 20 6e 20 66 6c 61 (cdr ls)) n fla
19630 67 73 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 gs next)).
19640 20 20 20 20 20 20 20 20 20 20 28 28 77 2f 63 61 ((w/ca
19650 73 65 20 77 2f 6e 6f 63 61 73 65 20 77 2f 75 74 se w/nocase w/ut
19660 66 38 20 77 2f 6e 6f 75 74 66 38 29 0a 20 20 20 f8 w/noutf8).
19670 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
19680 65 74 2a 20 28 28 6e 65 78 74 20 28 6c 70 20 28 et* ((next (lp (
19690 63 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 cdr ls) n flags
196a0 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 20 20 next)).
196b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
196c0 66 6c 61 67 73 20 28 28 69 66 20 28 6d 65 6d 71 flags ((if (memq
196d0 20 28 63 61 61 72 20 6c 73 29 20 27 28 77 2f 63 (caar ls) '(w/c
196e0 61 73 65 20 77 2f 75 74 66 38 29 29 0a 20 20 20 ase w/utf8)).
196f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19700 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19710 20 66 6c 61 67 2d 63 6c 65 61 72 0a 20 20 20 20 flag-clear.
19720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19730 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19740 66 6c 61 67 2d 6a 6f 69 6e 29 0a 20 20 20 20 20 flag-join).
19750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19760 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 flags
19770 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19780 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19790 20 28 69 66 20 28 6d 65 6d 71 20 28 63 61 61 72 (if (memq (caar
197a0 20 6c 73 29 20 27 28 77 2f 63 61 73 65 20 77 2f ls) '(w/case w/
197b0 6e 6f 63 61 73 65 29 29 0a 20 20 20 20 20 20 20 nocase)).
197c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
197d0 20 20 20 20 20 20 20 20 20 20 20 20 20 7e 63 61 ~ca
197e0 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 0a se-insensitive?.
197f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19800 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19810 20 20 20 20 7e 75 74 66 38 3f 29 29 29 29 0a 20 ~utf8?)))).
19820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19830 20 20 28 61 6e 64 20 6e 65 78 74 0a 20 20 20 20 (and next.
19840 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19850 20 20 20 20 28 6c 70 20 28 63 64 61 72 20 6c 73 (lp (cdar ls
19860 29 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 6d ) (new-state-num
19870 62 65 72 20 6e 65 78 74 29 20 66 6c 61 67 73 20 ber next) flags
19880 6e 65 78 74 29 29 29 29 0a 20 20 20 20 20 20 20 next)))).
19890 20 20 20 20 20 20 20 20 20 28 28 2f 20 2d 20 26 ((/ - &
198a0 20 7e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ~).
198b0 20 20 20 20 20 28 6c 65 74 20 28 28 72 61 6e 67 (let ((rang
198c0 65 20 28 73 72 65 2d 3e 63 73 65 74 20 28 63 61 e (sre->cset (ca
198d0 72 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 r ls).
198e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
198f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19900 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 flag-set? flags
19910 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 ~case-insensitiv
19920 65 3f 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 e?)))).
19930 20 20 20 20 20 20 20 20 20 20 28 65 78 74 65 6e (exten
19940 64 2d 73 74 61 74 65 21 20 28 6c 70 20 28 63 64 d-state! (lp (cd
19950 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e 65 r ls) n flags ne
19960 78 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 xt).
19970 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19980 20 20 20 20 20 20 72 61 6e 67 65 29 29 29 0a 20 range))).
19990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
199a0 28 6f 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 (or).
199b0 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 78 (let ((nex
199c0 74 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 6e t (lp (cdr ls) n
199d0 20 66 6c 61 67 73 20 6e 65 78 74 29 29 29 0a 20 flags next))).
199e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
199f0 20 20 28 61 6e 64 0a 20 20 20 20 20 20 20 20 20 (and.
19a00 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 0a next.
19a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 28 (if (null? (
19a30 63 64 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 cdar ls)).
19a40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a50 20 20 3b 3b 20 65 6d 70 74 79 20 28 6f 72 29 20 ;; empty (or)
19a60 61 6c 77 61 79 73 20 66 61 69 6c 73 0a 20 20 20 always fails.
19a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a80 20 20 20 20 20 28 61 64 64 2d 73 74 61 74 65 21 (add-state!
19a90 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 6d 62 (new-state-numb
19aa0 65 72 20 6e 65 78 74 29 20 27 28 29 29 0a 20 20 er next) '()).
19ab0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ac0 20 20 20 20 20 20 3b 3b 20 63 6f 6d 70 69 6c 65 ;; compile
19ad0 20 62 6f 74 68 20 62 72 61 6e 63 68 65 73 20 61 both branches a
19ae0 6e 64 20 69 6e 73 65 72 74 20 65 70 73 69 6c 6f nd insert epsilo
19af0 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
19b00 20 20 20 20 20 20 20 20 20 20 3b 3b 20 74 72 61 ;; tra
19b10 6e 73 69 74 69 6f 6e 73 20 74 6f 20 65 69 74 68 nsitions to eith
19b20 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 er.
19b30 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
19b40 20 28 28 62 20 28 6c 70 20 28 6c 69 73 74 20 28 ((b (lp (list (
19b50 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 28 63 sre-alternate (c
19b60 64 64 61 72 20 6c 73 29 29 29 0a 20 20 20 20 20 ddar ls))).
19b70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b90 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 6d 62 (new-state-numb
19ba0 65 72 20 6e 65 78 74 29 0a 20 20 20 20 20 20 20 er next).
19bb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19bc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
19bd0 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
19be0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19bf0 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 29 next)
19c00 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
19c10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c20 20 28 61 20 28 61 6e 64 20 62 0a 20 20 20 20 20 (a (and b.
19c30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c50 20 20 28 6c 70 20 28 6c 69 73 74 20 28 63 61 64 (lp (list (cad
19c60 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 ar ls)).
19c70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c90 20 20 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 (new-state-nu
19ca0 6d 62 65 72 20 28 6d 61 78 20 62 20 6e 65 78 74 mber (max b next
19cb0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
19cc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19cd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6c fl
19ce0 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ags.
19cf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
19d10 65 78 74 29 29 29 29 0a 20 20 20 20 20 20 20 20 ext)))).
19d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d30 20 20 28 61 6e 64 20 61 0a 20 20 20 20 20 20 20 (and a.
19d40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d50 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 (let ((c
19d60 20 28 61 64 64 2d 73 74 61 74 65 21 20 28 6e 65 (add-state! (ne
19d70 77 2d 73 74 61 74 65 2d 6e 75 6d 62 65 72 20 28 w-state-number (
19d80 6d 61 78 20 61 20 62 29 29 0a 20 20 20 20 20 20 max a b)).
19d90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19da0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19db0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 '(
19dc0 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
19dd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19de0 20 20 20 20 20 20 28 6e 66 61 2d 61 64 64 2d 65 (nfa-add-e
19df0 70 73 69 6c 6f 6e 21 20 62 75 66 20 63 20 61 20 psilon! buf c a
19e00 23 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 #f).
19e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19e20 20 20 20 20 20 28 6e 66 61 2d 61 64 64 2d 65 70 (nfa-add-ep
19e30 73 69 6c 6f 6e 21 20 62 75 66 20 63 20 62 20 23 silon! buf c b #
19e40 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 f).
19e50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19e60 20 20 20 20 63 29 29 29 29 29 29 29 0a 20 20 20 c))))))).
19e70 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3f ((?
19e80 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
19e90 20 20 20 28 6c 65 74 20 28 28 6e 65 78 74 20 28 (let ((next (
19ea0 6c 70 20 28 63 64 72 20 6c 73 29 20 6e 20 66 6c lp (cdr ls) n fl
19eb0 61 67 73 20 6e 65 78 74 29 29 29 0a 20 20 20 20 ags next))).
19ec0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
19ed0 3b 20 69 6e 73 65 72 74 20 61 6e 20 65 70 73 69 ; insert an epsi
19ee0 6c 6f 6e 20 74 72 61 6e 73 69 74 69 6f 6e 20 64 lon transition d
19ef0 69 72 65 63 74 6c 79 20 74 6f 20 6e 65 78 74 0a irectly to next.
19f00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f10 20 20 20 28 61 6e 64 0a 20 20 20 20 20 20 20 20 (and.
19f20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 next
19f30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19f40 20 20 20 20 20 28 6c 65 74 20 28 28 61 20 28 6c (let ((a (l
19f50 70 20 28 63 64 61 72 20 6c 73 29 20 28 6e 65 77 p (cdar ls) (new
19f60 2d 73 74 61 74 65 2d 6e 75 6d 62 65 72 20 6e 65 -state-number ne
19f70 78 74 29 20 66 6c 61 67 73 20 6e 65 78 74 29 29 xt) flags next))
19f80 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
19f90 20 20 20 20 20 20 20 20 28 69 66 20 61 0a 20 20 (if a.
19fa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19fb0 20 20 20 20 20 20 20 20 28 6e 66 61 2d 61 64 64 (nfa-add
19fc0 2d 65 70 73 69 6c 6f 6e 21 20 62 75 66 20 61 20 -epsilon! buf a
19fd0 6e 65 78 74 20 23 66 29 29 0a 20 20 20 20 20 20 next #f)).
19fe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ff0 61 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 a)))).
1a000 20 20 20 20 20 20 28 28 2b 20 2a 29 0a 20 20 20 ((+ *).
1a010 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1a020 65 74 20 28 28 6e 65 78 74 20 28 6c 70 20 28 63 et ((next (lp (c
1a030 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e dr ls) n flags n
1a040 65 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 ext))).
1a050 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 0a 20 (and.
1a060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a070 20 20 20 6e 65 78 74 0a 20 20 20 20 20 20 20 20 next.
1a080 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
1a090 2a 20 28 28 6e 65 77 20 28 6c 70 20 27 28 65 70 * ((new (lp '(ep
1a0a0 73 69 6c 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 silon).
1a0b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a0c0 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 2d (new-
1a0d0 73 74 61 74 65 2d 6e 75 6d 62 65 72 20 6e 65 78 state-number nex
1a0e0 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
1a0f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a100 20 20 20 20 20 20 20 66 6c 61 67 73 0a 20 20 20 flags.
1a110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a120 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a130 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 20 next)).
1a140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a150 20 20 20 28 61 20 28 6c 70 20 28 63 64 61 72 20 (a (lp (cdar
1a160 6c 73 29 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e ls) (new-state-n
1a170 75 6d 62 65 72 20 6e 65 77 29 20 66 6c 61 67 73 umber new) flags
1a180 20 6e 65 77 29 29 29 0a 20 20 20 20 20 20 20 20 new))).
1a190 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
1a1a0 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ond.
1a1b0 20 20 20 20 20 20 20 20 20 20 20 28 61 0a 20 20 (a.
1a1c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a1d0 20 20 20 20 20 20 3b 3b 20 66 6f 72 20 2a 2c 20 ;; for *,
1a1e0 69 6e 73 65 72 74 20 61 6e 20 65 70 73 69 6c 6f insert an epsilo
1a1f0 6e 20 74 72 61 6e 73 69 74 69 6f 6e 20 61 73 20 n transition as
1a200 69 6e 20 3f 20 61 62 6f 76 65 0a 20 20 20 20 20 in ? above.
1a210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a220 20 20 20 28 69 66 20 28 65 71 3f 20 27 2a 20 28 (if (eq? '* (
1a230 63 61 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 caar ls)).
1a240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a250 20 20 20 20 20 20 28 6e 66 61 2d 61 64 64 2d 65 (nfa-add-e
1a260 70 73 69 6c 6f 6e 21 20 62 75 66 20 61 20 6e 65 psilon! buf a ne
1a270 77 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 20 w #f)).
1a280 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
1a290 3b 20 66 6f 72 20 62 6f 74 68 2c 20 69 6e 73 65 ; for both, inse
1a2a0 72 74 20 61 20 6c 6f 6f 70 20 62 61 63 6b 20 74 rt a loop back t
1a2b0 6f 20 73 65 6c 66 0a 20 20 20 20 20 20 20 20 20 o self.
1a2c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1a2d0 6e 66 61 2d 61 64 64 2d 65 70 73 69 6c 6f 6e 21 nfa-add-epsilon!
1a2e0 20 62 75 66 20 6e 65 77 20 61 20 23 66 29 29 29 buf new a #f)))
1a2f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a300 20 20 20 20 20 20 20 61 29 29 29 29 0a 20 20 20 a)))).
1a310 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
1a320 6e 65 65 64 20 74 6f 20 61 64 64 20 74 68 65 73 need to add thes
1a330 65 20 74 6f 20 74 68 65 20 6d 61 74 63 68 20 65 e to the match e
1a340 78 74 72 61 63 74 6f 72 20 66 69 72 73 74 2c 0a xtractor first,.
1a350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a360 3b 3b 20 62 75 74 20 74 68 65 79 20 74 65 6e 64 ;; but they tend
1a370 20 74 6f 20 67 65 6e 65 72 61 74 65 20 6c 61 72 to generate lar
1a380 67 65 20 44 46 41 73 0a 20 20 20 20 20 20 20 20 ge DFAs.
1a390 20 20 20 20 20 20 20 20 3b 3b 28 28 3d 29 0a 20 ;;((=).
1a3a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
1a3b0 3b 20 28 6c 70 20 28 61 70 70 65 6e 64 20 28 76 ; (lp (append (v
1a3c0 65 63 74 6f 72 2d 3e 6c 69 73 74 0a 20 20 20 20 ector->list.
1a3d0 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
1a3e0 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b (mak
1a3f0 65 2d 76 65 63 74 6f 72 20 28 63 61 64 61 72 20 e-vector (cadar
1a400 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
1a410 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 ;;
1a420 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a430 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 (sre-sequence (
1a440 63 64 64 61 72 20 6c 73 29 29 29 29 0a 20 20 20 cddar ls)))).
1a450 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
1a460 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 (cdr
1a470 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls)).
1a480 20 20 20 20 20 20 3b 3b 20 20 20 20 20 6e 20 66 ;; n f
1a490 6c 61 67 73 20 6e 65 78 74 29 29 0a 20 20 20 20 lags next)).
1a4a0 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 28 28 ;;((
1a4b0 3e 3d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 >=).
1a4c0 20 20 20 20 3b 3b 20 28 6c 70 20 28 61 70 70 65 ;; (lp (appe
1a4d0 6e 64 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 nd (vector->list
1a4e0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a4f0 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
1a500 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 2d (make-vector (-
1a510 20 28 63 61 64 61 72 20 6c 73 29 20 31 29 0a 20 (cadar ls) 1).
1a520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
1a530 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
1a540 20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 65 (sre
1a550 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 61 72 -sequence (cddar
1a560 20 6c 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 ls)))).
1a570 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 ;;
1a580 20 20 20 20 20 20 20 28 63 6f 6e 73 20 60 28 2b (cons `(+
1a590 20 2c 40 28 63 64 64 61 72 20 6c 73 29 29 20 28 ,@(cddar ls)) (
1a5a0 63 64 72 20 6c 73 29 29 29 0a 20 20 20 20 20 20 cdr ls))).
1a5b0 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 20 ;;
1a5c0 20 6e 20 66 6c 61 67 73 20 6e 65 78 74 29 29 0a n flags next)).
1a5d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a5e0 3b 3b 28 28 2a 2a 29 0a 20 20 20 20 20 20 20 20 ;;((**).
1a5f0 20 20 20 20 20 20 20 20 3b 3b 20 28 6c 70 20 28 ;; (lp (
1a600 61 70 70 65 6e 64 20 28 76 65 63 74 6f 72 2d 3e append (vector->
1a610 6c 69 73 74 0a 20 20 20 20 20 20 20 20 20 20 20 list.
1a620 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 ;;
1a630 20 20 20 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f (make-vecto
1a640 72 20 28 63 61 64 61 72 20 6c 73 29 0a 20 20 20 r (cadar ls).
1a650 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
1a660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a670 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 73 (sre-s
1a680 65 71 75 65 6e 63 65 20 28 63 64 64 64 61 72 20 equence (cdddar
1a690 6c 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 ls)))).
1a6a0 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 ;;
1a6b0 20 20 20 20 20 20 28 6d 61 70 0a 20 20 20 20 20 (map.
1a6c0 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 20 ;;
1a6d0 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
1a6e0 64 61 20 28 78 29 20 60 28 3f 20 2c 78 29 29 0a da (x) `(? ,x)).
1a6f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a700 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
1a710 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 0a 20 20 (vector->list.
1a720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
1a730 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1a740 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 2d 20 28 make-vector (- (
1a750 63 61 64 64 61 72 20 6c 73 29 20 28 63 61 64 61 caddar ls) (cada
1a760 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 r ls)).
1a770 20 20 20 20 20 20 20 3b 3b 20 20 20 20 20 20 20 ;;
1a780 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a790 20 20 20 20 20 28 73 72 65 2d 73 65 71 75 65 6e (sre-sequen
1a7a0 63 65 20 28 63 64 64 64 61 72 20 6c 73 29 29 29 ce (cdddar ls)))
1a7b0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1a7c0 20 20 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 ;;
1a7d0 20 20 28 63 64 72 20 6c 73 29 29 0a 20 20 20 20 (cdr ls)).
1a7e0 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 20 ;;
1a7f0 20 20 20 6e 20 66 6c 61 67 73 20 6e 65 78 74 29 n flags next)
1a800 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1a810 20 20 3b 3b 20 69 67 6e 6f 72 65 20 73 75 62 6d ;; ignore subm
1a820 61 74 63 68 65 73 20 61 6c 74 6f 67 65 74 68 65 atches altogethe
1a830 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
1a840 20 20 28 28 24 20 73 75 62 6d 61 74 63 68 29 0a (($ submatch).
1a850 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a860 20 28 6c 65 74 2a 20 28 28 70 72 65 2d 74 61 67 (let* ((pre-tag
1a870 20 28 2a 20 28 63 64 72 20 28 61 73 73 71 20 28 (* (cdr (assq (
1a880 63 61 72 20 6c 73 29 20 6d 61 74 63 68 2d 69 6e car ls) match-in
1a890 64 65 78 29 29 20 32 29 29 0a 20 20 20 20 20 20 dex)) 2)).
1a8a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a8b0 20 20 28 70 6f 73 74 2d 74 61 67 20 28 2b 20 70 (post-tag (+ p
1a8c0 72 65 2d 74 61 67 20 31 29 29 0a 20 20 20 20 20 re-tag 1)).
1a8d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a8e0 20 20 20 28 6e 65 78 74 20 28 6c 70 20 28 63 64 (next (lp (cd
1a8f0 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e 65 r ls) n flags ne
1a900 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 xt))).
1a910 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 6e 65 (and ne
1a920 78 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 xt.
1a930 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
1a940 20 28 28 61 66 74 65 72 20 28 61 64 64 2d 73 74 ((after (add-st
1a950 61 74 65 21 20 28 6e 65 77 2d 73 74 61 74 65 2d ate! (new-state-
1a960 6e 75 6d 62 65 72 20 6e 65 78 74 29 20 27 28 29 number next) '()
1a970 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1a980 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a990 20 20 28 73 75 62 20 28 6c 70 20 28 6c 69 73 74 (sub (lp (list
1a9a0 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 (sre-sequence (
1a9b0 63 64 61 72 20 6c 73 29 29 29 0a 20 20 20 20 20 cdar ls))).
1a9c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a9d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a9e0 20 20 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 (new-state-nu
1a9f0 6d 62 65 72 20 61 66 74 65 72 29 20 66 6c 61 67 mber after) flag
1aa00 73 20 61 66 74 65 72 29 29 0a 20 20 20 20 20 20 s after)).
1aa10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aa20 20 20 20 20 20 20 20 20 20 28 62 65 66 6f 72 65 (before
1aa30 20 28 61 6e 64 20 73 75 62 20 28 61 64 64 2d 73 (and sub (add-s
1aa40 74 61 74 65 21 20 28 6e 65 77 2d 73 74 61 74 65 tate! (new-state
1aa50 2d 6e 75 6d 62 65 72 20 73 75 62 29 20 27 28 29 -number sub) '()
1aa60 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
1aa70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1aa80 63 6f 6e 64 20 28 62 65 66 6f 72 65 0a 20 20 20 cond (before.
1aa90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aaa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e (n
1aab0 66 61 2d 61 64 64 2d 65 70 73 69 6c 6f 6e 21 20 fa-add-epsilon!
1aac0 62 75 66 20 62 65 66 6f 72 65 20 73 75 62 20 70 buf before sub p
1aad0 72 65 2d 74 61 67 29 0a 20 20 20 20 20 20 20 20 re-tag).
1aae0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aaf0 20 20 20 20 20 20 20 20 20 28 6e 66 61 2d 61 64 (nfa-ad
1ab00 64 2d 65 70 73 69 6c 6f 6e 21 20 62 75 66 20 61 d-epsilon! buf a
1ab10 66 74 65 72 20 6e 65 78 74 20 70 6f 73 74 2d 74 fter next post-t
1ab20 61 67 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ag))).
1ab30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ab40 62 65 66 6f 72 65 29 29 29 29 0a 20 20 20 20 20 before)))).
1ab50 20 20 20 20 20 20 20 20 20 20 20 28 28 3d 3e 20 ((=>
1ab60 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a submatch-named).
1ab70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ab80 20 28 6c 65 74 2a 20 28 28 70 72 65 2d 74 61 67 (let* ((pre-tag
1ab90 20 28 2a 20 28 63 64 72 20 28 61 73 73 71 20 28 (* (cdr (assq (
1aba0 63 61 72 20 6c 73 29 20 6d 61 74 63 68 2d 69 6e car ls) match-in
1abb0 64 65 78 29 29 20 32 29 29 0a 20 20 20 20 20 20 dex)) 2)).
1abc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1abd0 20 20 28 70 6f 73 74 2d 74 61 67 20 28 2b 20 70 (post-tag (+ p
1abe0 72 65 2d 74 61 67 20 31 29 29 0a 20 20 20 20 20 re-tag 1)).
1abf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ac00 20 20 20 28 6e 65 78 74 20 28 6c 70 20 28 63 64 (next (lp (cd
1ac10 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e 65 r ls) n flags ne
1ac20 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 xt))).
1ac30 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 6e 65 (and ne
1ac40 78 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 xt.
1ac50 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
1ac60 20 28 28 61 66 74 65 72 20 28 61 64 64 2d 73 74 ((after (add-st
1ac70 61 74 65 21 20 28 6e 65 77 2d 73 74 61 74 65 2d ate! (new-state-
1ac80 6e 75 6d 62 65 72 20 6e 65 78 74 29 20 27 28 29 number next) '()
1ac90 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1aca0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1acb0 20 20 28 73 75 62 20 28 6c 70 20 28 6c 69 73 74 (sub (lp (list
1acc0 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 (sre-sequence (
1acd0 63 64 64 61 72 20 6c 73 29 29 29 0a 20 20 20 20 cddar ls))).
1ace0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1acf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ad00 20 20 20 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e (new-state-n
1ad10 75 6d 62 65 72 20 61 66 74 65 72 29 20 66 6c 61 umber after) fla
1ad20 67 73 20 61 66 74 65 72 29 29 0a 20 20 20 20 20 gs after)).
1ad30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ad40 20 20 20 20 20 20 20 20 20 20 28 62 65 66 6f 72 (befor
1ad50 65 20 28 61 6e 64 20 73 75 62 20 28 61 64 64 2d e (and sub (add-
1ad60 73 74 61 74 65 21 20 28 6e 65 77 2d 73 74 61 74 state! (new-stat
1ad70 65 2d 6e 75 6d 62 65 72 20 73 75 62 29 20 27 28 e-number sub) '(
1ad80 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
1ad90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ada0 28 63 6f 6e 64 20 28 62 65 66 6f 72 65 0a 20 20 (cond (before.
1adb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1adc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1add0 6e 66 61 2d 61 64 64 2d 65 70 73 69 6c 6f 6e 21 nfa-add-epsilon!
1ade0 20 62 75 66 20 62 65 66 6f 72 65 20 73 75 62 20 buf before sub
1adf0 70 72 65 2d 74 61 67 29 0a 20 20 20 20 20 20 20 pre-tag).
1ae00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ae10 20 20 20 20 20 20 20 20 20 20 28 6e 66 61 2d 61 (nfa-a
1ae20 64 64 2d 65 70 73 69 6c 6f 6e 21 20 62 75 66 20 dd-epsilon! buf
1ae30 61 66 74 65 72 20 6e 65 78 74 20 70 6f 73 74 2d after next post-
1ae40 74 61 67 29 29 29 0a 20 20 20 20 20 20 20 20 20 tag))).
1ae50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ae60 20 62 65 66 6f 72 65 29 29 29 29 0a 20 20 20 20 before)))).
1ae70 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
1ae80 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
1ae90 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
1aea0 20 20 20 20 20 20 20 20 20 20 20 28 28 61 73 73 ((ass
1aeb0 71 20 28 63 61 61 72 20 6c 73 29 20 73 72 65 2d q (caar ls) sre-
1aec0 6e 61 6d 65 64 2d 64 65 66 69 6e 69 74 69 6f 6e named-definition
1aed0 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
1aee0 20 20 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 => (lambda
1aef0 20 28 63 65 6c 6c 29 0a 20 20 20 20 20 20 20 20 (cell).
1af00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af10 28 69 66 20 28 70 72 6f 63 65 64 75 72 65 3f 20 (if (procedure?
1af20 28 63 64 72 20 63 65 6c 6c 29 29 0a 20 20 20 20 (cdr cell)).
1af30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af40 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 6f 6e (lp (con
1af50 73 20 28 61 70 70 6c 79 20 28 63 64 72 20 63 65 s (apply (cdr ce
1af60 6c 6c 29 20 28 63 64 61 72 20 6c 73 29 29 20 28 ll) (cdar ls)) (
1af70 63 64 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 cdr ls)).
1af80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af90 20 20 20 20 20 20 20 20 20 6e 20 66 6c 61 67 73 n flags
1afa0 20 6e 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 next).
1afb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1afc0 20 20 20 28 65 72 72 6f 72 20 22 6e 6f 6e 2d 70 (error "non-p
1afd0 72 6f 63 65 64 75 72 65 20 69 6e 20 6f 70 20 70 rocedure in op p
1afe0 6f 73 69 74 69 6f 6e 22 20 28 63 61 61 72 20 6c osition" (caar l
1aff0 73 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 s))))).
1b000 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 23 (else #
1b010 66 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 f))))))).
1b020 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
1b030 20 20 20 20 20 20 23 66 29 29 29 29 0a 20 20 20 #f)))).
1b040 20 28 6c 65 74 20 28 28 6c 65 6e 20 28 6c 70 20 (let ((len (lp
1b050 28 6c 69 73 74 20 73 72 65 29 20 31 20 69 6e 69 (list sre) 1 ini
1b060 74 2d 66 6c 61 67 73 20 30 29 29 29 0a 20 20 20 t-flags 0))).
1b070 20 20 20 28 61 6e 64 20 6c 65 6e 0a 20 20 20 20 (and len.
1b080 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 66 (let ((nf
1b090 61 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 a (make-vector (
1b0a0 2a 20 2a 6e 66 61 2d 6e 75 6d 2d 66 69 65 6c 64 * *nfa-num-field
1b0b0 73 2a 20 28 2b 20 6c 65 6e 20 31 29 29 29 29 29 s* (+ len 1)))))
1b0c0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 . (d
1b0d0 6f 20 28 28 69 20 28 2d 20 28 76 65 63 74 6f 72 o ((i (- (vector
1b0e0 2d 6c 65 6e 67 74 68 20 6e 66 61 29 20 31 29 20 -length nfa) 1)
1b0f0 28 2d 20 69 20 31 29 29 29 0a 20 20 20 20 20 20 (- i 1))).
1b100 20 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 69 ((< i
1b110 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 0)).
1b120 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 (vector-set!
1b130 20 6e 66 61 20 69 20 28 76 65 63 74 6f 72 2d 72 nfa i (vector-r
1b140 65 66 20 62 75 66 20 69 29 29 29 0a 20 20 20 20 ef buf i))).
1b150 20 20 20 20 20 20 20 20 20 6e 66 61 29 29 29 29 nfa))))
1b160 29 0a 0a 3b 3b 20 57 65 20 64 6f 6e 27 74 20 72 )..;; We don't r
1b170 65 61 6c 6c 79 20 77 61 6e 74 20 74 6f 20 75 73 eally want to us
1b180 65 20 74 68 69 73 2c 20 77 65 20 75 73 65 20 74 e this, we use t
1b190 68 65 20 63 6c 6f 73 75 72 65 20 63 6f 6d 70 69 he closure compi
1b1a0 6c 61 74 69 6f 6e 0a 3b 3b 20 62 65 6c 6f 77 20 lation.;; below
1b1b0 69 6e 73 74 65 61 64 2c 20 62 75 74 20 74 68 69 instead, but thi
1b1c0 73 20 69 73 20 69 6e 63 6c 75 64 65 64 20 66 6f s is included fo
1b1d0 72 20 72 65 66 65 72 65 6e 63 65 20 61 6e 64 20 r reference and
1b1e0 74 65 73 74 69 6e 67 20 74 68 65 0a 3b 3b 20 73 testing the.;; s
1b1f0 72 65 2d 3e 6e 66 61 20 63 6f 6e 76 65 72 73 69 re->nfa conversi
1b200 6f 6e 2e 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 on...;; (define
1b210 28 6e 66 61 2d 6d 61 74 63 68 20 6e 66 61 20 73 (nfa-match nfa s
1b220 74 72 29 0a 3b 3b 20 20 20 28 6c 65 74 20 28 28 tr).;; (let ((
1b230 6d 61 74 63 68 65 73 20 28 6d 61 6b 65 2d 76 65 matches (make-ve
1b240 63 74 6f 72 20 28 6e 66 61 2d 6e 75 6d 2d 74 61 ctor (nfa-num-ta
1b250 67 73 20 6e 66 61 29 20 23 66 29 29 29 0a 3b 3b gs nfa) #f))).;;
1b260 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 70 (let lp ((p
1b270 6f 73 20 30 29 20 28 6c 73 20 28 73 74 72 69 6e os 0) (ls (strin
1b280 67 2d 3e 6c 69 73 74 20 73 74 72 29 29 20 28 73 g->list str)) (s
1b290 74 61 74 65 20 28 6e 66 61 2d 73 74 61 72 74 2d tate (nfa-start-
1b2a0 73 74 61 74 65 20 6e 66 61 29 29 20 28 65 70 73 state nfa)) (eps
1b2b0 69 6c 6f 6e 73 20 27 28 29 29 29 0a 3b 3b 20 20 ilons '())).;;
1b2c0 20 20 20 20 20 28 61 6e 64 20 28 6f 72 20 28 61 (and (or (a
1b2d0 6e 64 20 28 6e 75 6c 6c 3f 20 6c 73 29 20 28 7a nd (null? ls) (z
1b2e0 65 72 6f 3f 20 73 74 61 74 65 29 29 0a 3b 3b 20 ero? state)).;;
1b2f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1b300 6c 65 74 20 28 28 74 20 28 6e 66 61 2d 67 65 74 let ((t (nfa-get
1b310 2d 73 74 61 74 65 2d 74 72 61 6e 73 20 6e 66 61 -state-trans nfa
1b320 20 73 74 61 74 65 29 29 29 0a 3b 3b 20 20 20 20 state))).;;
1b330 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
1b340 6e 64 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 74 nd (not (null? t
1b350 29 29 20 28 6e 6f 74 20 28 6e 75 6c 6c 3f 20 6c )) (not (null? l
1b360 73 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 s)).;;
1b370 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 73 (cs
1b380 65 74 2d 63 6f 6e 74 61 69 6e 73 3f 20 28 63 61 et-contains? (ca
1b390 72 20 74 29 20 28 63 61 72 20 6c 73 29 29 0a 3b r t) (car ls)).;
1b3a0 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
1b3b0 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 70 (lp (+ p
1b3c0 6f 73 20 31 29 20 28 63 64 72 20 6c 73 29 20 28 os 1) (cdr ls) (
1b3d0 63 64 72 20 74 29 20 27 28 29 29 29 29 0a 3b 3b cdr t) '()))).;;
1b3e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b3f0 28 61 6e 79 20 28 6c 61 6d 62 64 61 20 28 65 29 (any (lambda (e)
1b400 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
1b410 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
1b420 28 6f 6c 64 2d 6d 61 74 63 68 65 73 20 28 76 65 (old-matches (ve
1b430 63 74 6f 72 2d 63 6f 70 79 20 6d 61 74 63 68 65 ctor-copy matche
1b440 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 s))).;;
1b450 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b460 28 63 6f 6e 64 20 28 28 63 64 72 20 65 29 0a 3b (cond ((cdr e).;
1b470 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
1b480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b490 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 61 (vector-set! ma
1b4a0 74 63 68 65 73 20 28 63 64 72 20 65 29 20 70 6f tches (cdr e) po
1b4b0 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 s))).;;
1b4c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b4d0 28 6f 72 20 28 61 6e 64 20 28 6e 6f 74 20 28 6d (or (and (not (m
1b4e0 65 6d 76 20 28 63 61 72 20 65 29 20 65 70 73 69 emv (car e) epsi
1b4f0 6c 6f 6e 73 29 29 0a 3b 3b 20 20 20 20 20 20 20 lons)).;;
1b500 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b510 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 70 (lp p
1b520 6f 73 20 6c 73 20 28 63 61 72 20 65 29 20 28 63 os ls (car e) (c
1b530 6f 6e 73 20 28 63 61 72 20 65 29 20 65 70 73 69 ons (car e) epsi
1b540 6c 6f 6e 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 lons))).;;
1b550 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b560 20 20 20 20 20 20 20 3b 3b 20 72 65 73 65 74 20 ;; reset
1b570 6d 61 74 63 68 2c 20 61 70 70 61 72 65 6e 74 6c match, apparentl
1b580 79 20 74 68 69 73 20 62 72 61 6e 63 68 20 66 61 y this branch fa
1b590 69 6c 65 64 0a 3b 3b 20 20 20 20 20 20 20 20 20 iled.;;
1b5a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b5b0 20 20 20 20 28 62 65 67 69 6e 20 28 73 65 74 21 (begin (set!
1b5c0 20 6d 61 74 63 68 65 73 20 6f 6c 64 2d 6d 61 74 matches old-mat
1b5d0 63 68 65 73 29 20 23 66 29 29 29 29 0a 3b 3b 20 ches) #f)))).;;
1b5e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b5f0 20 20 20 20 28 6e 66 61 2d 67 65 74 2d 65 70 73 (nfa-get-eps
1b600 69 6c 6f 6e 73 20 6e 66 61 20 73 74 61 74 65 29 ilons nfa state)
1b610 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 )).;;
1b620 20 6d 61 74 63 68 65 73 29 29 29 29 0a 0a 3b 3b matches))))..;;
1b630 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1b640 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1b650 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1b660 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1b670 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b 3b 20 4e 46 41 20 ;;;;;;.;;;; NFA
1b680 6d 75 6c 74 69 2d 73 74 61 74 65 20 72 65 70 72 multi-state repr
1b690 65 73 65 6e 74 61 74 69 6f 6e 0a 0a 28 64 65 66 esentation..(def
1b6a0 69 6e 65 20 2a 6d 73 74 2d 66 69 72 73 74 2d 73 ine *mst-first-s
1b6b0 74 61 74 65 2d 69 6e 64 65 78 2a 20 33 29 0a 0a tate-index* 3)..
1b6c0 28 64 65 66 69 6e 65 20 28 6d 73 74 2d 6d 61 70 (define (mst-map
1b6d0 70 69 6e 67 73 2d 73 75 6d 6d 61 72 79 20 6d 73 pings-summary ms
1b6e0 74 29 0a 20 20 28 76 65 63 74 6f 72 2d 72 65 66 t). (vector-ref
1b6f0 20 6d 73 74 20 30 29 29 0a 0a 28 64 65 66 69 6e mst 0))..(defin
1b700 65 20 28 6d 73 74 2d 6e 75 6d 2d 73 74 61 74 65 e (mst-num-state
1b710 73 20 6d 73 74 29 0a 20 20 28 76 65 63 74 6f 72 s mst). (vector
1b720 2d 72 65 66 20 6d 73 74 20 31 29 29 0a 0a 28 64 -ref mst 1))..(d
1b730 65 66 69 6e 65 20 28 6d 73 74 2d 6e 75 6d 2d 73 efine (mst-num-s
1b740 74 61 74 65 73 2d 73 65 74 21 20 6d 73 74 20 6e tates-set! mst n
1b750 75 6d 29 0a 20 20 28 76 65 63 74 6f 72 2d 73 65 um). (vector-se
1b760 74 21 20 6d 73 74 20 31 20 6e 75 6d 29 29 0a 0a t! mst 1 num))..
1b770 28 64 65 66 69 6e 65 20 28 6d 73 74 2d 68 61 73 (define (mst-has
1b780 68 20 6d 73 74 29 0a 20 20 3b 3b 20 57 65 20 63 h mst). ;; We c
1b790 6f 75 6c 64 20 64 6f 20 28 6d 6f 64 75 6c 6f 20 ould do (modulo
1b7a0 58 20 28 6e 66 61 2d 6e 75 6d 2d 73 74 61 74 65 X (nfa-num-state
1b7b0 73 20 6e 66 61 29 29 20 68 65 72 65 20 77 68 69 s nfa)) here whi
1b7c0 63 68 20 77 6f 75 6c 64 20 62 65 20 66 61 73 74 ch would be fast
1b7d0 65 72 2c 0a 20 20 3b 3b 20 62 75 74 20 77 65 20 er,. ;; but we
1b7e0 63 61 6e 27 74 20 61 73 73 75 6d 65 20 61 20 66 can't assume a f
1b7f0 75 6c 6c 20 6e 75 6d 65 72 69 63 61 6c 20 74 6f ull numerical to
1b800 77 65 72 20 28 61 6e 64 20 75 70 64 61 74 69 6e wer (and updatin
1b810 67 20 2a 63 6f 75 6c 64 2a 0a 20 20 3b 3b 20 70 g *could*. ;; p
1b820 72 6f 64 75 63 65 20 61 20 62 69 67 6e 75 6d 29 roduce a bignum)
1b830 2c 20 73 6f 20 77 65 20 64 6f 20 69 74 20 65 61 , so we do it ea
1b840 63 68 20 74 69 6d 65 20 77 68 65 6e 20 75 70 64 ch time when upd
1b850 61 74 69 6e 67 20 74 68 65 20 68 61 73 68 2e 0a ating the hash..
1b860 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 73 (vector-ref ms
1b870 74 20 32 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 t 2))..(define (
1b880 6d 73 74 2d 68 61 73 68 2d 73 65 74 21 20 6d 73 mst-hash-set! ms
1b890 74 20 68 61 73 68 29 0a 20 20 28 76 65 63 74 6f t hash). (vecto
1b8a0 72 2d 73 65 74 21 20 6d 73 74 20 32 20 68 61 73 r-set! mst 2 has
1b8b0 68 29 29 0a 0a 3b 3b 20 52 65 74 75 72 6e 73 20 h))..;; Returns
1b8c0 23 66 20 69 66 20 4e 46 41 20 73 74 61 74 65 20 #f if NFA state
1b8d0 64 6f 65 73 20 6e 6f 74 20 6f 63 63 75 72 20 69 does not occur i
1b8e0 6e 20 6d 75 6c 74 69 2d 73 74 61 74 65 0a 28 64 n multi-state.(d
1b8f0 65 66 69 6e 65 20 28 6d 73 74 2d 73 74 61 74 65 efine (mst-state
1b900 2d 6d 61 70 70 69 6e 67 73 20 6d 73 74 20 73 74 -mappings mst st
1b910 61 74 65 29 0a 20 20 28 76 65 63 74 6f 72 2d 72 ate). (vector-r
1b920 65 66 20 6d 73 74 20 28 2b 20 73 74 61 74 65 20 ef mst (+ state
1b930 2a 6d 73 74 2d 66 69 72 73 74 2d 73 74 61 74 65 *mst-first-state
1b940 2d 69 6e 64 65 78 2a 29 29 29 0a 0a 28 64 65 66 -index*)))..(def
1b950 69 6e 65 20 28 6d 73 74 2d 73 74 61 74 65 2d 6d ine (mst-state-m
1b960 61 70 70 69 6e 67 73 2d 73 65 74 21 20 6d 73 74 appings-set! mst
1b970 20 73 74 61 74 65 20 6d 61 70 70 69 6e 67 73 29 state mappings)
1b980 0a 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
1b990 6d 73 74 20 28 2b 20 73 74 61 74 65 20 2a 6d 73 mst (+ state *ms
1b9a0 74 2d 66 69 72 73 74 2d 73 74 61 74 65 2d 69 6e t-first-state-in
1b9b0 64 65 78 2a 29 20 6d 61 70 70 69 6e 67 73 29 29 dex*) mappings))
1b9c0 0a 0a 3b 3b 20 41 20 6d 75 6c 74 69 2d 73 74 61 ..;; A multi-sta
1b9d0 74 65 20 68 6f 6c 64 73 20 61 20 73 65 74 20 6f te holds a set o
1b9e0 66 20 73 74 61 74 65 73 20 77 69 74 68 20 74 68 f states with th
1b9f0 65 69 72 20 74 61 67 2d 74 6f 2d 73 6c 6f 74 20 eir tag-to-slot
1ba00 6d 61 70 70 69 6e 67 73 2e 0a 3b 3b 20 53 6c 6f mappings..;; Slo
1ba10 74 20 30 20 63 6f 6e 74 61 69 6e 73 20 61 20 73 t 0 contains a s
1ba20 75 6d 6d 61 72 79 20 6f 66 20 61 6c 6c 20 6d 61 ummary of all ma
1ba30 70 70 69 6e 67 73 20 66 6f 72 20 61 6c 6c 20 73 ppings for all s
1ba40 74 61 74 65 73 20 69 6e 20 74 68 65 20 6d 75 6c tates in the mul
1ba50 74 69 2d 73 74 61 74 65 2e 0a 3b 3b 20 53 6c 6f ti-state..;; Slo
1ba60 74 20 31 20 63 6f 6e 74 61 69 6e 73 20 74 68 65 t 1 contains the
1ba70 20 74 6f 74 61 6c 20 6e 75 6d 62 65 72 20 6f 66 total number of
1ba80 20 73 74 61 74 65 73 20 69 6e 20 74 68 65 20 6d states in the m
1ba90 75 6c 74 69 2d 73 74 61 74 65 2e 0a 3b 3b 20 53 ulti-state..;; S
1baa0 6c 6f 74 20 32 20 63 6f 6e 74 61 69 6e 73 20 61 lot 2 contains a
1bab0 20 68 61 73 68 20 76 61 6c 75 65 2c 20 77 68 69 hash value, whi
1bac0 63 68 20 69 73 20 75 73 65 64 20 66 6f 72 20 71 ch is used for q
1bad0 75 69 63 6b 20 6c 6f 6f 6b 75 70 20 6f 66 20 63 uick lookup of c
1bae0 61 63 68 65 64 0a 3b 3b 20 72 65 6f 72 64 65 72 ached.;; reorder
1baf0 2d 63 6f 6d 6d 61 6e 64 73 20 6f 72 20 65 70 73 -commands or eps
1bb00 69 6c 6f 6e 2d 63 6c 6f 73 75 72 65 20 69 6e 20 ilon-closure in
1bb10 74 68 65 20 4e 46 41 2e 20 20 54 68 69 73 20 69 the NFA. This i
1bb20 73 20 74 68 65 20 73 75 6d 20 6f 66 20 61 6c 6c s the sum of all
1bb30 0a 3b 3b 20 73 74 61 74 65 20 6e 75 6d 62 65 72 .;; state number
1bb40 73 20 70 6c 75 73 20 65 61 63 68 20 74 61 67 20 s plus each tag
1bb50 76 61 6c 75 65 20 28 6f 6e 63 65 20 70 65 72 20 value (once per
1bb60 6f 63 63 75 72 72 65 6e 63 65 29 2e 20 20 54 68 occurrence). Th
1bb70 69 73 20 69 73 20 61 20 73 69 6c 6c 79 0a 3b 3b is is a silly.;;
1bb80 20 68 61 73 68 69 6e 67 20 63 61 6c 63 75 6c 61 hashing calcula
1bb90 74 69 6f 6e 2c 20 62 75 74 20 69 74 20 73 65 65 tion, but it see
1bba0 6d 73 20 74 6f 20 70 72 6f 64 75 63 65 20 61 20 ms to produce a
1bbb0 77 65 6c 6c 2d 73 70 72 65 61 64 20 6f 75 74 20 well-spread out
1bbc0 68 61 73 68 20 74 61 62 6c 65 20 61 6e 64 0a 3b hash table and.;
1bbd0 3b 20 69 74 20 68 61 73 20 74 68 65 20 61 64 64 ; it has the add
1bbe0 65 64 20 61 64 76 61 6e 74 61 67 65 20 74 68 61 ed advantage tha
1bbf0 74 20 77 65 20 63 61 6e 20 75 73 65 20 74 68 65 t we can use the
1bc00 20 76 61 6c 75 65 20 61 73 20 61 20 71 75 69 63 value as a quic
1bc10 6b 20 63 68 65 63 6b 20 69 66 20 74 68 65 0a 3b k check if the.;
1bc20 3b 20 73 74 61 74 65 20 69 73 20 64 65 66 69 6e ; state is defin
1bc30 69 74 65 6c 79 20 4e 4f 54 20 65 71 75 69 76 61 itely NOT equiva
1bc40 6c 65 6e 74 20 74 6f 20 61 6e 6f 74 68 65 72 20 lent to another
1bc50 69 6e 20 6d 73 74 2d 73 61 6d 65 2d 73 74 61 74 in mst-same-stat
1bc60 65 73 3f 0a 3b 3b 20 54 68 65 20 6f 74 68 65 72 es?.;; The other
1bc70 20 73 6c 6f 74 73 20 63 6f 6e 74 61 69 6e 20 6d slots contain m
1bc80 61 70 70 69 6e 67 73 20 66 6f 72 20 65 61 63 68 appings for each
1bc90 20 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 73 corresponding s
1bca0 74 61 74 65 2e 0a 0a 28 64 65 66 69 6e 65 20 28 tate...(define (
1bcb0 6d 61 6b 65 2d 6d 73 74 20 6e 66 61 29 0a 20 20 make-mst nfa).
1bcc0 28 6c 65 74 20 28 28 6d 73 74 20 28 6d 61 6b 65 (let ((mst (make
1bcd0 2d 76 65 63 74 6f 72 20 28 2b 20 28 6e 66 61 2d -vector (+ (nfa-
1bce0 6e 75 6d 2d 73 74 61 74 65 73 20 6e 66 61 29 20 num-states nfa)
1bcf0 2a 6d 73 74 2d 66 69 72 73 74 2d 73 74 61 74 65 *mst-first-state
1bd00 2d 69 6e 64 65 78 2a 29 20 23 66 29 29 29 0a 20 -index*) #f))).
1bd10 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
1bd20 6d 73 74 20 30 20 28 6d 61 6b 65 2d 76 65 63 74 mst 0 (make-vect
1bd30 6f 72 20 28 6e 66 61 2d 6e 75 6d 2d 74 61 67 73 or (nfa-num-tags
1bd40 20 6e 66 61 29 20 27 28 29 29 29 20 3b 20 74 61 nfa) '())) ; ta
1bd50 67 20 73 75 6d 6d 61 72 79 0a 20 20 20 20 28 76 g summary. (v
1bd60 65 63 74 6f 72 2d 73 65 74 21 20 6d 73 74 20 31 ector-set! mst 1
1bd70 20 30 29 20 20 20 20 20 20 20 20 20 20 20 20 20 0)
1bd80 20 20 3b 20 74 6f 74 61 6c 20 6e 75 6d 62 65 72 ; total number
1bd90 20 6f 66 20 73 74 61 74 65 73 0a 20 20 20 20 28 of states. (
1bda0 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 73 74 20 vector-set! mst
1bdb0 32 20 30 29 20 20 20 20 20 20 20 20 20 20 20 20 2 0)
1bdc0 20 20 20 3b 20 73 74 61 74 65 73 20 61 6e 64 20 ; states and
1bdd0 74 61 67 73 20 68 61 73 68 0a 20 20 20 20 6d 73 tags hash. ms
1bde0 74 29 29 0a 0a 3b 3b 20 4e 4f 54 45 3a 20 54 68 t))..;; NOTE: Th
1bdf0 69 73 20 64 6f 65 73 6e 27 74 20 64 6f 20 61 20 is doesn't do a
1be00 64 65 65 70 20 63 6f 70 79 20 6f 66 20 74 68 65 deep copy of the
1be10 20 6d 61 70 70 69 6e 67 73 2e 20 20 44 6f 6e 27 mappings. Don'
1be20 74 20 6d 75 74 61 74 65 20 74 68 65 6d 21 0a 28 t mutate them!.(
1be30 64 65 66 69 6e 65 20 28 6d 73 74 2d 63 6f 70 79 define (mst-copy
1be40 20 6d 73 74 29 0a 20 20 28 6c 65 74 20 28 28 76 mst). (let ((v
1be50 20 28 76 65 63 74 6f 72 2d 63 6f 70 79 20 6d 73 (vector-copy ms
1be60 74 29 29 29 0a 20 20 20 20 28 76 65 63 74 6f 72 t))). (vector
1be70 2d 73 65 74 21 20 76 20 30 20 28 76 65 63 74 6f -set! v 0 (vecto
1be80 72 2d 63 6f 70 79 20 28 76 65 63 74 6f 72 2d 72 r-copy (vector-r
1be90 65 66 20 6d 73 74 20 30 29 29 29 0a 20 20 20 20 ef mst 0))).
1bea0 76 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6e 66 v))..(define (nf
1beb0 61 2d 73 74 61 74 65 2d 3e 6d 73 74 20 6e 66 61 a-state->mst nfa
1bec0 20 73 74 61 74 65 20 6d 61 70 70 69 6e 67 73 29 state mappings)
1bed0 0a 20 20 28 6c 65 74 20 28 28 6d 73 74 20 28 6d . (let ((mst (m
1bee0 61 6b 65 2d 6d 73 74 20 6e 66 61 29 29 29 0a 20 ake-mst nfa))).
1bef0 20 20 20 28 6d 73 74 2d 61 64 64 21 20 6e 66 61 (mst-add! nfa
1bf00 20 6d 73 74 20 73 74 61 74 65 20 6d 61 70 70 69 mst state mappi
1bf10 6e 67 73 29 0a 20 20 20 20 6d 73 74 29 29 0a 0a ngs). mst))..
1bf20 3b 3b 20 45 78 74 65 6e 64 20 6d 75 6c 74 69 2d ;; Extend multi-
1bf30 73 74 61 74 65 20 77 69 74 68 20 61 20 73 74 61 state with a sta
1bf40 74 65 20 61 6e 64 20 61 64 64 20 69 74 73 20 74 te and add its t
1bf50 61 67 2d 3e 73 6c 6f 74 20 6d 61 70 70 69 6e 67 ag->slot mapping
1bf60 73 2e 0a 28 64 65 66 69 6e 65 20 28 6d 73 74 2d s..(define (mst-
1bf70 61 64 64 21 20 6e 66 61 20 6d 73 74 20 73 74 61 add! nfa mst sta
1bf80 74 65 20 6d 61 70 70 69 6e 67 73 29 0a 20 20 28 te mappings). (
1bf90 6c 65 74 20 28 28 68 61 73 68 2d 76 61 6c 75 65 let ((hash-value
1bfa0 20 28 6d 73 74 2d 68 61 73 68 20 6d 73 74 29 29 (mst-hash mst))
1bfb0 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 6f ). (cond ((no
1bfc0 74 20 28 6d 73 74 2d 73 74 61 74 65 2d 6d 61 70 t (mst-state-map
1bfd0 70 69 6e 67 73 20 6d 73 74 20 73 74 61 74 65 29 pings mst state)
1bfe0 29 20 3b 20 20 55 70 64 61 74 65 20 73 74 61 74 ) ; Update stat
1bff0 65 20 68 61 73 68 20 26 20 63 6f 75 6e 74 3f 0a e hash & count?.
1c000 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set!
1c010 20 68 61 73 68 2d 76 61 6c 75 65 20 28 2b 20 68 hash-value (+ h
1c020 61 73 68 2d 76 61 6c 75 65 20 73 74 61 74 65 29 ash-value state)
1c030 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6d 73 ). (ms
1c040 74 2d 6e 75 6d 2d 73 74 61 74 65 73 2d 73 65 74 t-num-states-set
1c050 21 20 6d 73 74 20 28 2b 20 28 6d 73 74 2d 6e 75 ! mst (+ (mst-nu
1c060 6d 2d 73 74 61 74 65 73 20 6d 73 74 29 20 31 29 m-states mst) 1)
1c070 29 29 29 0a 20 20 20 20 28 6d 73 74 2d 73 74 61 ))). (mst-sta
1c080 74 65 2d 6d 61 70 70 69 6e 67 73 2d 73 65 74 21 te-mappings-set!
1c090 20 6d 73 74 20 73 74 61 74 65 20 6d 61 70 70 69 mst state mappi
1c0a0 6e 67 73 29 0a 20 20 20 20 28 6c 65 74 20 28 28 ngs). (let ((
1c0b0 61 6c 6c 2d 6d 61 70 70 69 6e 67 73 20 28 6d 73 all-mappings (ms
1c0c0 74 2d 6d 61 70 70 69 6e 67 73 2d 73 75 6d 6d 61 t-mappings-summa
1c0d0 72 79 20 6d 73 74 29 29 29 0a 20 20 20 20 20 20 ry mst))).
1c0e0 28 66 6f 72 2d 65 61 63 68 0a 20 20 20 20 20 20 (for-each.
1c0f0 20 28 6c 61 6d 62 64 61 20 28 74 61 67 26 73 6c (lambda (tag&sl
1c100 6f 74 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 ot). (le
1c110 74 2a 20 28 28 74 20 28 63 61 72 20 74 61 67 26 t* ((t (car tag&
1c120 73 6c 6f 74 29 29 0a 20 20 20 20 20 20 20 20 20 slot)).
1c130 20 20 20 20 20 20 20 28 73 20 28 63 64 72 20 74 (s (cdr t
1c140 61 67 26 73 6c 6f 74 29 29 0a 20 20 20 20 20 20 ag&slot)).
1c150 20 20 20 20 20 20 20 20 20 20 28 6d 20 28 76 65 (m (ve
1c160 63 74 6f 72 2d 72 65 66 20 61 6c 6c 2d 6d 61 70 ctor-ref all-map
1c170 70 69 6e 67 73 20 74 29 29 29 0a 20 20 20 20 20 pings t))).
1c180 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 6f (cond ((no
1c190 74 20 28 6d 65 6d 76 20 73 20 6d 29 29 0a 20 20 t (memv s m)).
1c1a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c1b0 28 73 65 74 21 20 68 61 73 68 2d 76 61 6c 75 65 (set! hash-value
1c1c0 20 28 2b 20 68 61 73 68 2d 76 61 6c 75 65 20 74 (+ hash-value t
1c1d0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1c1e0 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 (vector-set
1c1f0 21 20 61 6c 6c 2d 6d 61 70 70 69 6e 67 73 20 74 ! all-mappings t
1c200 20 28 63 6f 6e 73 20 73 20 6d 29 29 29 29 29 29 (cons s m))))))
1c210 0a 20 20 20 20 20 20 20 6d 61 70 70 69 6e 67 73 . mappings
1c220 29 29 0a 20 20 20 20 28 6d 73 74 2d 68 61 73 68 )). (mst-hash
1c230 2d 73 65 74 21 20 6d 73 74 20 28 6d 6f 64 75 6c -set! mst (modul
1c240 6f 20 68 61 73 68 2d 76 61 6c 75 65 20 28 6e 66 o hash-value (nf
1c250 61 2d 6e 75 6d 2d 73 74 61 74 65 73 20 6e 66 61 a-num-states nfa
1c260 29 29 29 29 29 0a 0a 3b 3b 20 53 61 6d 65 20 61 )))))..;; Same a
1c270 73 20 61 62 6f 76 65 2c 20 62 75 74 20 73 6b 69 s above, but ski
1c280 70 20 75 70 64 61 74 69 6e 67 20 6d 61 70 70 69 p updating mappi
1c290 6e 67 73 20 73 75 6d 6d 61 72 79 2e 0a 3b 3b 20 ngs summary..;;
1c2a0 43 61 6c 6c 65 64 20 77 68 65 6e 20 77 65 20 6b Called when we k
1c2b0 6e 6f 77 20 61 6c 6c 20 74 68 65 20 74 61 67 2d now all the tag-
1c2c0 3e 73 6c 6f 74 20 6d 61 70 70 69 6e 67 73 20 61 >slot mappings a
1c2d0 72 65 20 61 6c 72 65 61 64 79 20 69 6e 20 74 68 re already in th
1c2e0 65 20 73 75 6d 6d 61 72 79 2e 0a 28 64 65 66 69 e summary..(defi
1c2f0 6e 65 20 28 6d 73 74 2d 61 64 64 2f 66 61 73 74 ne (mst-add/fast
1c300 21 20 6e 66 61 20 6d 73 74 20 73 74 61 74 65 20 ! nfa mst state
1c310 6d 61 70 70 69 6e 67 73 29 0a 20 20 28 63 6f 6e mappings). (con
1c320 64 20 28 28 6e 6f 74 20 28 6d 73 74 2d 73 74 61 d ((not (mst-sta
1c330 74 65 2d 6d 61 70 70 69 6e 67 73 20 6d 73 74 20 te-mappings mst
1c340 73 74 61 74 65 29 29 20 3b 20 20 55 70 64 61 74 state)) ; Updat
1c350 65 20 73 74 61 74 65 20 68 61 73 68 20 26 20 63 e state hash & c
1c360 6f 75 6e 74 3f 0a 20 20 20 20 20 20 20 20 20 28 ount?. (
1c370 6d 73 74 2d 68 61 73 68 2d 73 65 74 21 0a 20 20 mst-hash-set!.
1c380 20 20 20 20 20 20 20 20 6d 73 74 20 28 6d 6f 64 mst (mod
1c390 75 6c 6f 20 28 2b 20 28 6d 73 74 2d 68 61 73 68 ulo (+ (mst-hash
1c3a0 20 6d 73 74 29 20 73 74 61 74 65 29 0a 20 20 20 mst) state).
1c3b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c3c0 20 20 20 28 6e 66 61 2d 6e 75 6d 2d 73 74 61 74 (nfa-num-stat
1c3d0 65 73 20 6e 66 61 29 29 29 0a 20 20 20 20 20 20 es nfa))).
1c3e0 20 20 20 28 6d 73 74 2d 6e 75 6d 2d 73 74 61 74 (mst-num-stat
1c3f0 65 73 2d 73 65 74 21 20 6d 73 74 20 28 2b 20 28 es-set! mst (+ (
1c400 6d 73 74 2d 6e 75 6d 2d 73 74 61 74 65 73 20 6d mst-num-states m
1c410 73 74 29 20 31 29 29 29 29 0a 20 20 28 6d 73 74 st) 1)))). (mst
1c420 2d 73 74 61 74 65 2d 6d 61 70 70 69 6e 67 73 2d -state-mappings-
1c430 73 65 74 21 20 6d 73 74 20 73 74 61 74 65 20 6d set! mst state m
1c440 61 70 70 69 6e 67 73 29 29 0a 0a 3b 3b 20 53 61 appings))..;; Sa
1c450 6d 65 20 61 73 20 61 62 6f 76 65 2c 20 61 73 73 me as above, ass
1c460 69 67 6e 69 6e 67 20 61 20 6e 65 77 20 73 6c 6f igning a new slo
1c470 74 20 66 6f 72 20 61 20 74 61 67 2e 20 20 54 68 t for a tag. Th
1c480 69 73 20 73 6c 6f 74 20 69 73 20 74 68 65 6e 0a is slot is then.
1c490 3b 3b 20 61 64 64 65 64 20 74 6f 20 74 68 65 20 ;; added to the
1c4a0 73 75 6d 6d 61 72 79 2c 20 69 66 20 69 74 20 69 summary, if it i
1c4b0 73 6e 27 74 20 69 6e 20 74 68 65 72 65 20 79 65 sn't in there ye
1c4c0 74 2e 20 20 54 68 69 73 20 69 73 20 6d 6f 72 65 t. This is more
1c4d0 20 65 66 66 69 63 69 65 6e 74 0a 3b 3b 20 74 68 efficient.;; th
1c4e0 61 6e 20 6c 6f 6f 70 69 6e 67 20 74 68 72 6f 75 an looping throu
1c4f0 67 68 20 61 6c 6c 20 74 68 65 20 6d 61 70 70 69 gh all the mappi
1c500 6e 67 73 2e 0a 28 64 65 66 69 6e 65 20 28 6d 73 ngs..(define (ms
1c510 74 2d 61 64 64 2d 74 61 67 67 65 64 21 20 6e 66 t-add-tagged! nf
1c520 61 20 6d 73 74 20 73 74 61 74 65 20 6d 61 70 70 a mst state mapp
1c530 69 6e 67 73 20 74 61 67 20 73 6c 6f 74 29 0a 20 ings tag slot).
1c540 20 28 6c 65 74 2a 20 28 28 6d 61 70 70 69 6e 67 (let* ((mapping
1c550 73 2d 73 75 6d 6d 61 72 79 20 28 6d 73 74 2d 6d s-summary (mst-m
1c560 61 70 70 69 6e 67 73 2d 73 75 6d 6d 61 72 79 20 appings-summary
1c570 6d 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 28 mst)). (
1c580 73 75 6d 6d 61 72 79 2d 74 61 67 2d 73 6c 6f 74 summary-tag-slot
1c590 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 61 s (vector-ref ma
1c5a0 70 70 69 6e 67 73 2d 73 75 6d 6d 61 72 79 20 74 ppings-summary t
1c5b0 61 67 29 29 0a 20 20 20 20 20 20 20 20 20 28 6e ag)). (n
1c5c0 65 77 2d 6d 61 70 70 69 6e 67 73 20 28 6c 65 74 ew-mappings (let
1c5d0 20 6c 70 20 28 28 6d 20 6d 61 70 70 69 6e 67 73 lp ((m mappings
1c5e0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1c5f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c600 20 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 (res '())).
1c610 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c620 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 (cond ((nu
1c630 6c 6c 3f 20 6d 29 20 28 63 6f 6e 73 20 28 63 6f ll? m) (cons (co
1c640 6e 73 20 74 61 67 20 73 6c 6f 74 29 20 72 65 73 ns tag slot) res
1c650 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1c660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c670 20 20 28 28 3d 20 28 63 61 61 72 20 6d 29 20 74 ((= (caar m) t
1c680 61 67 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ag).
1c690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c6a0 20 20 20 20 28 61 70 70 65 6e 64 20 72 65 73 20 (append res
1c6b0 28 63 6f 6e 73 20 28 63 6f 6e 73 20 74 61 67 20 (cons (cons tag
1c6c0 73 6c 6f 74 29 20 28 63 64 72 20 6d 29 29 29 29 slot) (cdr m))))
1c6d0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1c6e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c6f0 28 65 6c 73 65 20 28 6c 70 20 28 63 64 72 20 6d (else (lp (cdr m
1c700 29 20 28 63 6f 6e 73 20 28 63 61 72 20 6d 29 20 ) (cons (car m)
1c710 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 20 20 res)))))).
1c720 20 20 20 28 68 61 73 68 2d 76 61 6c 75 65 20 28 (hash-value (
1c730 6d 73 74 2d 68 61 73 68 20 6d 73 74 29 29 29 0a mst-hash mst))).
1c740 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 6f 74 20 (cond ((not
1c750 28 6d 73 74 2d 73 74 61 74 65 2d 6d 61 70 70 69 (mst-state-mappi
1c760 6e 67 73 20 6d 73 74 20 73 74 61 74 65 29 29 20 ngs mst state))
1c770 3b 20 20 55 70 64 61 74 65 20 73 74 61 74 65 20 ; Update state
1c780 68 61 73 68 20 26 20 63 6f 75 6e 74 3f 0a 20 20 hash & count?.
1c790 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 68 (set! h
1c7a0 61 73 68 2d 76 61 6c 75 65 20 28 2b 20 68 61 73 ash-value (+ has
1c7b0 68 2d 76 61 6c 75 65 20 73 74 61 74 65 29 29 0a h-value state)).
1c7c0 20 20 20 20 20 20 20 20 20 20 20 28 6d 73 74 2d (mst-
1c7d0 6e 75 6d 2d 73 74 61 74 65 73 2d 73 65 74 21 20 num-states-set!
1c7e0 6d 73 74 20 28 2b 20 28 6d 73 74 2d 6e 75 6d 2d mst (+ (mst-num-
1c7f0 73 74 61 74 65 73 20 6d 73 74 29 20 31 29 29 29 states mst) 1)))
1c800 29 0a 20 20 20 20 28 6d 73 74 2d 73 74 61 74 65 ). (mst-state
1c810 2d 6d 61 70 70 69 6e 67 73 2d 73 65 74 21 20 6d -mappings-set! m
1c820 73 74 20 73 74 61 74 65 20 6e 65 77 2d 6d 61 70 st state new-map
1c830 70 69 6e 67 73 29 0a 20 20 20 20 28 63 6f 6e 64 pings). (cond
1c840 20 28 28 6e 6f 74 20 28 6d 65 6d 76 20 73 6c 6f ((not (memv slo
1c850 74 20 73 75 6d 6d 61 72 79 2d 74 61 67 2d 73 6c t summary-tag-sl
1c860 6f 74 73 29 29 20 3b 20 55 70 64 61 74 65 20 74 ots)) ; Update t
1c870 61 67 2f 73 6c 6f 74 20 73 75 6d 6d 61 72 79 0a ag/slot summary.
1c880 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set!
1c890 20 68 61 73 68 2d 76 61 6c 75 65 20 28 2b 20 68 hash-value (+ h
1c8a0 61 73 68 2d 76 61 6c 75 65 20 74 61 67 29 29 0a ash-value tag)).
1c8b0 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 (vect
1c8c0 6f 72 2d 73 65 74 21 20 6d 61 70 70 69 6e 67 73 or-set! mappings
1c8d0 2d 73 75 6d 6d 61 72 79 20 74 61 67 20 28 63 6f -summary tag (co
1c8e0 6e 73 20 73 6c 6f 74 20 73 75 6d 6d 61 72 79 2d ns slot summary-
1c8f0 74 61 67 2d 73 6c 6f 74 73 29 29 29 29 0a 20 20 tag-slots)))).
1c900 20 20 28 6d 73 74 2d 68 61 73 68 2d 73 65 74 21 (mst-hash-set!
1c910 20 6d 73 74 20 28 6d 6f 64 75 6c 6f 20 68 61 73 mst (modulo has
1c920 68 2d 76 61 6c 75 65 20 28 6e 66 61 2d 6e 75 6d h-value (nfa-num
1c930 2d 73 74 61 74 65 73 20 6e 66 61 29 29 29 0a 20 -states nfa))).
1c940 20 20 20 6e 65 77 2d 6d 61 70 70 69 6e 67 73 29 new-mappings)
1c950 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 73 74 2d )..(define (mst-
1c960 73 61 6d 65 2d 73 74 61 74 65 73 3f 20 61 20 62 same-states? a b
1c970 29 0a 20 20 3b 3b 20 46 69 72 73 74 20 63 68 65 ). ;; First che
1c980 63 6b 20 69 66 20 68 61 73 68 20 61 6e 64 20 73 ck if hash and s
1c990 74 61 74 65 20 63 6f 75 6e 74 73 20 6d 61 74 63 tate counts matc
1c9a0 68 2c 20 74 68 65 6e 20 63 68 65 63 6b 20 65 61 h, then check ea
1c9b0 63 68 20 73 74 61 74 65 0a 20 20 28 61 6e 64 20 ch state. (and
1c9c0 28 3d 20 28 6d 73 74 2d 68 61 73 68 20 61 29 20 (= (mst-hash a)
1c9d0 28 6d 73 74 2d 68 61 73 68 20 62 29 29 0a 20 20 (mst-hash b)).
1c9e0 20 20 20 20 20 28 3d 20 28 6d 73 74 2d 6e 75 6d (= (mst-num
1c9f0 2d 73 74 61 74 65 73 20 61 29 20 28 6d 73 74 2d -states a) (mst-
1ca00 6e 75 6d 2d 73 74 61 74 65 73 20 62 29 29 0a 20 num-states b)).
1ca10 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e (let ((len
1ca20 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
1ca30 61 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c a))). (l
1ca40 65 74 20 6c 70 20 28 28 69 20 2a 6d 73 74 2d 66 et lp ((i *mst-f
1ca50 69 72 73 74 2d 73 74 61 74 65 2d 69 6e 64 65 78 irst-state-index
1ca60 2a 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 *)). (
1ca70 6f 72 20 28 3d 20 69 20 6c 65 6e 29 0a 20 20 20 or (= i len).
1ca80 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
1ca90 20 28 65 71 75 61 6c 3f 20 28 6e 6f 74 20 28 76 (equal? (not (v
1caa0 65 63 74 6f 72 2d 72 65 66 20 61 20 69 29 29 0a ector-ref a i)).
1cab0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cac0 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 (not
1cad0 20 28 76 65 63 74 6f 72 2d 72 65 66 20 62 20 69 (vector-ref b i
1cae0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1caf0 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 (lp (+ i
1cb00 20 31 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 1))))))))..(def
1cb10 69 6e 65 20 28 6d 73 74 2d 66 6f 6c 64 20 6d 73 ine (mst-fold ms
1cb20 74 20 6b 6f 6e 73 20 6b 6e 69 6c 29 0a 20 20 28 t kons knil). (
1cb30 6c 65 74 20 28 28 6c 69 6d 69 74 20 28 76 65 63 let ((limit (vec
1cb40 74 6f 72 2d 6c 65 6e 67 74 68 20 6d 73 74 29 29 tor-length mst))
1cb50 29 0a 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 ). (let lp ((
1cb60 69 20 2a 6d 73 74 2d 66 69 72 73 74 2d 73 74 61 i *mst-first-sta
1cb70 74 65 2d 69 6e 64 65 78 2a 29 0a 20 20 20 20 20 te-index*).
1cb80 20 20 20 20 20 20 20 20 28 61 63 63 20 6b 6e 69 (acc kni
1cb90 6c 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 3d l)). (if (=
1cba0 20 69 20 6c 69 6d 69 74 29 0a 20 20 20 20 20 20 i limit).
1cbb0 20 20 20 20 61 63 63 0a 20 20 20 20 20 20 20 20 acc.
1cbc0 20 20 28 6c 65 74 20 28 28 6d 20 28 76 65 63 74 (let ((m (vect
1cbd0 6f 72 2d 72 65 66 20 6d 73 74 20 69 29 29 29 0a or-ref mst i))).
1cbe0 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
1cbf0 28 2b 20 69 20 31 29 20 28 69 66 20 6d 20 28 6b (+ i 1) (if m (k
1cc00 6f 6e 73 20 28 2d 20 69 20 2a 6d 73 74 2d 66 69 ons (- i *mst-fi
1cc10 72 73 74 2d 73 74 61 74 65 2d 69 6e 64 65 78 2a rst-state-index*
1cc20 29 20 6d 20 61 63 63 29 20 61 63 63 29 29 29 29 ) m acc) acc))))
1cc30 29 29 29 0a 0a 3b 3b 20 46 69 6e 64 20 74 68 65 )))..;; Find the
1cc40 20 6c 6f 77 65 73 74 20 66 72 65 73 68 20 69 6e lowest fresh in
1cc50 64 65 78 20 66 6f 72 20 74 68 69 73 20 74 61 67 dex for this tag
1cc60 20 74 68 61 74 27 73 20 75 6e 75 73 65 64 0a 3b that's unused.;
1cc70 3b 20 69 6e 20 74 68 65 20 6d 75 6c 74 69 2d 73 ; in the multi-s
1cc80 74 61 74 65 2e 20 20 54 68 69 73 20 61 6c 73 6f tate. This also
1cc90 20 75 70 64 61 74 65 73 20 74 68 65 20 6e 66 61 updates the nfa
1cca0 27 73 20 68 69 67 68 65 73 74 0a 3b 3b 20 74 61 's highest.;; ta
1ccb0 67 20 63 6f 75 6e 74 65 72 20 69 66 20 61 20 63 g counter if a c
1ccc0 6f 6d 70 6c 65 74 65 6c 79 20 6e 65 77 20 73 6c ompletely new sl
1ccd0 6f 74 20 6e 75 6d 62 65 72 20 77 61 73 20 61 73 ot number was as
1cce0 73 69 67 6e 65 64 2e 0a 28 64 65 66 69 6e 65 20 signed..(define
1ccf0 28 6e 65 78 74 2d 69 6e 64 65 78 2d 66 6f 72 2d (next-index-for-
1cd00 74 61 67 21 20 6e 66 61 20 74 61 67 20 6d 73 74 tag! nfa tag mst
1cd10 29 0a 20 20 28 6c 65 74 2a 20 28 28 68 69 67 68 ). (let* ((high
1cd20 65 73 74 20 28 6e 66 61 2d 68 69 67 68 65 73 74 est (nfa-highest
1cd30 2d 6d 61 70 2d 69 6e 64 65 78 20 6e 66 61 29 29 -map-index nfa))
1cd40 0a 20 20 20 20 20 20 20 20 20 28 74 61 67 2d 73 . (tag-s
1cd50 6c 6f 74 73 20 28 76 65 63 74 6f 72 2d 72 65 66 lots (vector-ref
1cd60 20 28 6d 73 74 2d 6d 61 70 70 69 6e 67 73 2d 73 (mst-mappings-s
1cd70 75 6d 6d 61 72 79 20 6d 73 74 29 20 74 61 67 29 ummary mst) tag)
1cd80 29 0a 20 20 20 20 20 20 20 20 20 28 6e 65 77 2d ). (new-
1cd90 69 6e 64 65 78 20 28 64 6f 20 28 28 73 6c 6f 74 index (do ((slot
1cda0 20 30 20 28 2b 20 73 6c 6f 74 20 31 29 29 29 0a 0 (+ slot 1))).
1cdb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1cdc0 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 28 6d ((not (m
1cdd0 65 6d 76 20 73 6c 6f 74 20 74 61 67 2d 73 6c 6f emv slot tag-slo
1cde0 74 73 29 29 20 73 6c 6f 74 29 29 29 29 0a 20 20 ts)) slot)))).
1cdf0 20 20 28 63 6f 6e 64 20 28 28 3e 20 6e 65 77 2d (cond ((> new-
1ce00 69 6e 64 65 78 20 68 69 67 68 65 73 74 29 0a 20 index highest).
1ce10 20 20 20 20 20 20 20 20 20 20 28 6e 66 61 2d 73 (nfa-s
1ce20 65 74 2d 68 69 67 68 65 73 74 2d 6d 61 70 2d 69 et-highest-map-i
1ce30 6e 64 65 78 21 20 6e 66 61 20 6e 65 77 2d 69 6e ndex! nfa new-in
1ce40 64 65 78 29 29 29 0a 20 20 20 20 6e 65 77 2d 69 dex))). new-i
1ce50 6e 64 65 78 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b ndex))..;;;;;;;;
1ce60 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1ce70 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1ce80 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1ce90 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1cea0 0a 3b 3b 3b 3b 20 74 4e 46 41 2d 3e 44 46 41 20 .;;;; tNFA->DFA
1ceb0 63 6f 6d 70 69 6c 61 74 69 6f 6e 0a 3b 3b 20 44 compilation.;; D
1cec0 75 72 69 6e 67 20 70 72 6f 63 65 73 73 69 6e 67 uring processing
1ced0 2c 20 74 68 65 20 44 46 41 20 69 73 20 61 20 6c , the DFA is a l
1cee0 69 73 74 20 6f 66 20 74 68 65 20 66 6f 72 6d 3a ist of the form:
1cef0 0a 3b 3b 0a 3b 3b 20 20 20 28 28 61 6e 6e 6f 74 .;;.;; ((annot
1cf00 61 74 65 64 2d 74 4e 46 41 2d 73 74 61 74 65 73 ated-tNFA-states
1cf10 20 2e 2e 2e 29 20 66 69 6e 61 6c 69 7a 65 72 20 ...) finalizer
1cf20 74 72 61 6e 73 69 74 69 6f 6e 73 20 2e 2e 2e 29 transitions ...)
1cf30 0a 3b 3b 0a 3b 3b 20 77 68 65 72 65 20 74 68 65 .;;.;; where the
1cf40 20 74 72 61 6e 73 69 74 69 6f 6e 73 20 61 72 65 transitions are
1cf50 20 61 73 20 69 6e 20 74 68 65 20 4e 46 41 2c 20 as in the NFA,
1cf60 65 78 63 65 70 74 20 74 68 65 72 65 20 61 72 65 except there are
1cf70 20 6e 6f 0a 3b 3b 20 65 70 73 69 6c 6f 6e 73 2c no.;; epsilons,
1cf80 20 64 75 70 6c 69 63 61 74 65 20 63 68 61 72 61 duplicate chara
1cf90 63 74 65 72 73 20 6f 72 20 6f 76 65 72 6c 61 70 cters or overlap
1cfa0 70 69 6e 67 20 63 68 61 72 2d 73 65 74 20 72 61 ping char-set ra
1cfb0 6e 67 65 73 2c 20 61 6e 64 0a 3b 3b 20 74 68 65 nges, and.;; the
1cfc0 20 73 74 61 74 65 73 20 6d 6f 76 65 64 20 74 6f states moved to
1cfd0 20 61 72 65 20 63 6c 6f 73 75 72 65 73 20 28 73 are closures (s
1cfe0 65 74 73 20 6f 66 20 4e 46 41 20 73 74 61 74 65 ets of NFA state
1cff0 73 29 2e 20 20 4d 75 6c 74 69 70 6c 65 0a 3b 3b s). Multiple.;;
1d000 20 44 46 41 20 73 74 61 74 65 73 20 6d 61 79 20 DFA states may
1d010 62 65 20 61 63 63 65 70 74 69 6e 67 20 73 74 61 be accepting sta
1d020 74 65 73 2e 20 20 49 66 20 74 68 65 20 73 74 61 tes. If the sta
1d030 74 65 20 69 73 20 61 6e 20 61 63 63 65 70 74 69 te is an accepti
1d040 6e 67 20 73 74 61 74 65 2c 0a 3b 3b 20 74 68 65 ng state,.;; the
1d050 20 66 69 6e 61 6c 69 7a 65 72 20 69 73 20 61 20 finalizer is a
1d060 6c 69 73 74 20 6f 66 20 28 74 61 67 20 2e 20 6d list of (tag . m
1d070 65 6d 6f 72 79 2d 73 6c 6f 74 29 20 72 65 74 72 emory-slot) retr
1d080 69 65 76 61 6c 20 63 6f 6d 6d 61 6e 64 73 2e 0a ieval commands..
1d090 3b 3b 20 74 4e 46 41 2d 73 74 61 74 65 73 20 61 ;; tNFA-states a
1d0a0 72 65 20 61 6e 6e 6f 74 61 74 65 64 20 77 69 74 re annotated wit
1d0b0 68 20 6d 61 70 70 69 6e 67 73 20 77 68 69 63 68 h mappings which
1d0c0 20 73 74 6f 72 65 20 74 68 65 20 74 61 67 20 76 store the tag v
1d0d0 61 6c 75 65 73 20 6f 66 0a 3b 3b 20 6d 65 6d 6f alues of.;; memo
1d0e0 72 79 20 73 6c 6f 74 73 2c 20 69 66 20 61 6e 79 ry slots, if any
1d0f0 2e 20 20 54 68 65 72 65 20 69 73 20 61 6c 77 61 . There is alwa
1d100 79 73 20 61 74 20 6d 6f 73 74 20 6f 6e 65 20 73 ys at most one s
1d110 6c 6f 74 20 66 6f 72 20 61 20 74 61 67 2e 0a 3b lot for a tag..;
1d120 3b 0a 3b 3b 20 54 68 65 20 44 46 41 20 69 74 73 ;.;; The DFA its
1d130 65 6c 66 20 73 69 6d 75 6c 61 74 65 73 20 61 20 elf simulates a
1d140 4e 46 41 20 62 79 20 72 65 70 72 65 73 65 6e 74 NFA by represent
1d150 69 6e 67 20 61 6c 6c 20 74 68 65 20 73 69 6d 75 ing all the simu
1d160 6c 74 61 6e 65 6f 75 73 0a 3b 3b 20 73 74 61 74 ltaneous.;; stat
1d170 65 73 20 74 68 65 20 4e 46 41 20 63 61 6e 20 62 es the NFA can b
1d180 65 20 69 6e 20 61 74 20 61 6e 79 20 67 69 76 65 e in at any give
1d190 6e 20 70 6f 69 6e 74 20 69 6e 20 74 69 6d 65 20 n point in time
1d1a0 61 73 20 6f 6e 65 20 44 46 41 20 73 74 61 74 65 as one DFA state
1d1b0 2e 0a 3b 3b 20 54 68 65 20 74 61 67 20 76 61 6c ..;; The tag val
1d1c0 75 65 73 20 61 72 65 20 61 6d 62 69 67 75 6f 75 ues are ambiguou
1d1d0 73 20 73 69 6e 63 65 20 65 61 63 68 20 4e 46 41 s since each NFA
1d1e0 20 74 72 61 6e 73 69 74 69 6f 6e 20 63 61 6e 20 transition can
1d1f0 73 65 74 20 61 20 74 61 67 2e 0a 3b 3b 20 54 6f set a tag..;; To
1d200 20 73 6f 6c 76 65 20 74 68 69 73 20 77 65 20 6b solve this we k
1d210 65 65 70 20 61 20 62 61 6e 6b 20 6f 66 20 6d 65 eep a bank of me
1d220 6d 6f 72 79 20 73 6c 6f 74 73 20 61 72 6f 75 6e mory slots aroun
1d230 64 20 77 68 69 63 68 20 74 72 61 63 6b 73 20 74 d which tracks t
1d240 61 67 0a 3b 3b 20 76 61 6c 75 65 73 20 66 6f 72 ag.;; values for
1d250 20 65 61 63 68 20 64 69 73 74 69 6e 63 74 20 70 each distinct p
1d260 61 74 68 20 74 68 72 6f 75 67 68 20 74 68 65 20 ath through the
1d270 4e 46 41 2e 0a 3b 3b 0a 3b 3b 20 4f 6e 63 65 20 NFA..;;.;; Once
1d280 77 65 20 67 65 74 20 74 6f 20 61 20 66 69 6e 61 we get to a fina
1d290 6c 20 73 74 61 74 65 20 77 65 20 63 61 6e 20 70 l state we can p
1d2a0 6c 75 63 6b 20 74 68 65 20 74 61 67 20 76 61 6c luck the tag val
1d2b0 75 65 73 20 66 72 6f 6d 20 74 68 65 0a 3b 3b 20 ues from the.;;
1d2c0 6d 65 6d 6f 72 79 20 73 6c 6f 74 73 20 63 6f 72 memory slots cor
1d2d0 72 65 73 70 6f 6e 64 69 6e 67 20 74 6f 20 74 68 responding to th
1d2e0 65 20 70 61 74 68 20 74 68 72 6f 75 67 68 20 77 e path through w
1d2f0 68 69 63 68 20 74 68 65 20 4e 46 41 20 63 6f 75 hich the NFA cou
1d300 6c 64 20 68 61 76 65 0a 3b 3b 20 72 65 61 63 68 ld have.;; reach
1d310 65 64 20 74 68 65 20 66 69 6e 61 6c 20 73 74 61 ed the final sta
1d320 74 65 2e 20 20 54 6f 20 72 65 73 6f 6c 76 65 20 te. To resolve
1d330 61 6d 62 69 67 75 69 74 69 65 73 2c 20 73 74 61 ambiguities, sta
1d340 74 65 73 20 61 72 65 20 61 73 73 69 67 6e 65 64 tes are assigned
1d350 0a 3b 3b 20 70 72 69 6f 72 69 74 69 65 73 2c 20 .;; priorities,
1d360 61 6e 64 20 74 68 65 20 70 61 74 68 20 74 6f 20 and the path to
1d370 74 68 65 20 66 69 6e 61 6c 20 73 74 61 74 65 20 the final state
1d380 69 73 20 63 68 6f 73 65 6e 20 63 6f 72 72 65 73 is chosen corres
1d390 70 6f 6e 64 69 6e 67 6c 79 2e 0a 3b 3b 0a 3b 3b pondingly..;;.;;
1d3a0 20 46 6f 72 20 61 20 6d 6f 72 65 20 64 65 74 61 For a more deta
1d3b0 69 6c 65 64 20 65 78 70 6c 61 6e 61 74 69 6f 6e iled explanation
1d3c0 20 61 62 6f 75 74 20 74 68 69 73 20 70 72 6f 63 about this proc
1d3d0 65 73 73 2c 20 73 65 65 0a 3b 3b 20 56 69 6c 6c ess, see.;; Vill
1d3e0 65 20 4c 61 75 72 69 6b 61 72 69 3b 20 60 60 4e e Laurikari; ``N
1d3f0 46 41 73 20 77 69 74 68 20 54 61 67 67 65 64 20 FAs with Tagged
1d400 54 72 61 6e 73 69 74 69 6f 6e 73 2c 20 74 68 65 Transitions, the
1d410 69 72 20 43 6f 6e 76 65 72 73 69 6f 6e 20 74 6f ir Conversion to
1d420 0a 3b 3b 20 44 65 74 65 72 6d 69 6e 69 73 74 69 .;; Deterministi
1d430 63 20 41 75 74 6f 6d 61 74 61 20 61 6e 64 20 41 c Automata and A
1d440 70 70 6c 69 63 61 74 69 6f 6e 20 74 6f 20 52 65 pplication to Re
1d450 67 75 6c 61 72 20 45 78 70 72 65 73 73 69 6f 6e gular Expression
1d460 73 27 27 20 28 32 30 30 30 29 2e 0a 3b 3b 20 4c s'' (2000)..;; L
1d470 61 75 72 69 6b 61 72 69 20 61 6c 73 6f 20 77 72 aurikari also wr
1d480 6f 74 65 20 61 20 6d 61 73 74 65 72 27 73 20 74 ote a master's t
1d490 68 65 73 69 73 20 61 62 6f 75 74 20 74 68 69 73 hesis about this
1d4a0 20 61 70 70 72 6f 61 63 68 20 77 68 69 63 68 20 approach which
1d4b0 69 73 0a 3b 3b 20 6c 65 73 73 20 74 65 72 73 65 is.;; less terse
1d4c0 20 62 75 74 20 74 68 65 20 61 6c 67 6f 72 69 74 but the algorit
1d4d0 68 6d 73 20 61 72 65 20 6e 6f 74 20 65 78 61 63 hms are not exac
1d4e0 74 6c 79 20 74 68 65 20 73 61 6d 65 2e 0a 3b 3b tly the same..;;
1d4f0 20 60 60 45 66 66 69 63 69 65 6e 74 20 73 75 62 ``Efficient sub
1d500 6d 61 74 63 68 20 61 64 64 72 65 73 73 69 6e 67 match addressing
1d510 20 66 6f 72 20 72 65 67 75 6c 61 72 20 65 78 70 for regular exp
1d520 72 65 73 73 69 6f 6e 73 27 27 20 28 32 30 30 31 ressions'' (2001
1d530 29 2e 0a 3b 3b 20 54 68 69 73 20 69 6d 70 6c 65 )..;; This imple
1d540 6d 65 6e 74 61 74 69 6f 6e 20 66 6f 6c 6c 6f 77 mentation follow
1d550 73 20 74 68 65 20 32 30 30 30 20 70 61 70 65 72 s the 2000 paper
1d560 20 77 68 65 72 65 20 74 68 65 79 20 64 69 66 66 where they diff
1d570 65 72 2e 0a 0a 28 64 65 66 69 6e 65 20 28 6e 66 er...(define (nf
1d580 61 2d 3e 64 66 61 20 6e 66 61 20 2e 20 6f 29 0a a->dfa nfa . o).
1d590 20 20 28 6c 65 74 2a 20 28 28 6d 61 78 2d 73 74 (let* ((max-st
1d5a0 61 74 65 73 20 28 61 6e 64 20 28 70 61 69 72 3f ates (and (pair?
1d5b0 20 6f 29 20 28 63 61 72 20 6f 29 29 29 0a 20 20 o) (car o))).
1d5c0 20 20 20 20 20 20 20 28 73 74 61 72 74 20 28 6e (start (n
1d5d0 66 61 2d 73 74 61 74 65 2d 3e 6d 73 74 20 6e 66 fa-state->mst nf
1d5e0 61 20 28 6e 66 61 2d 73 74 61 72 74 2d 73 74 61 a (nfa-start-sta
1d5f0 74 65 20 6e 66 61 29 20 27 28 29 29 29 0a 20 20 te nfa) '())).
1d600 20 20 20 20 20 20 20 28 73 74 61 72 74 2d 63 6c (start-cl
1d610 6f 73 75 72 65 20 28 6e 66 61 2d 65 70 73 69 6c osure (nfa-epsil
1d620 6f 6e 2d 63 6c 6f 73 75 72 65 20 6e 66 61 20 73 on-closure nfa s
1d630 74 61 72 74 29 29 0a 20 20 20 20 20 20 20 20 20 tart)).
1d640 3b 3b 20 53 65 74 20 75 70 20 61 20 73 70 65 63 ;; Set up a spec
1d650 69 61 6c 20 22 69 6e 69 74 69 61 6c 69 7a 65 72 ial "initializer
1d660 22 20 73 74 61 74 65 20 66 72 6f 6d 20 77 68 69 " state from whi
1d670 63 68 20 77 65 20 72 65 61 63 68 20 74 68 65 0a ch we reach the.
1d680 20 20 20 20 20 20 20 20 20 3b 3b 20 73 74 61 72 ;; star
1d690 74 2d 63 6c 6f 73 75 72 65 20 74 6f 20 65 6e 73 t-closure to ens
1d6a0 75 72 65 20 74 68 61 74 20 6c 65 61 64 69 6e 67 ure that leading
1d6b0 20 74 61 67 73 20 61 72 65 20 73 65 74 20 70 72 tags are set pr
1d6c0 6f 70 65 72 6c 79 2e 0a 20 20 20 20 20 20 20 20 operly..
1d6d0 20 28 69 6e 69 74 2d 73 65 74 20 28 74 61 67 2d (init-set (tag-
1d6e0 73 65 74 2d 63 6f 6d 6d 61 6e 64 73 2d 66 6f 72 set-commands-for
1d6f0 2d 63 6c 6f 73 75 72 65 20 6e 66 61 20 73 74 61 -closure nfa sta
1d700 72 74 20 73 74 61 72 74 2d 63 6c 6f 73 75 72 65 rt start-closure
1d710 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 '())).
1d720 28 64 75 6d 6d 79 20 28 6d 61 6b 65 2d 6d 73 74 (dummy (make-mst
1d730 20 6e 66 61 29 29 0a 20 20 20 20 20 20 20 20 20 nfa)).
1d740 28 69 6e 69 74 2d 73 74 61 74 65 20 28 6c 69 73 (init-state (lis
1d750 74 20 64 75 6d 6d 79 20 23 66 20 60 28 28 2c 73 t dummy #f `((,s
1d760 74 61 72 74 2d 63 6c 6f 73 75 72 65 20 23 66 20 tart-closure #f
1d770 28 29 20 2e 20 2c 69 6e 69 74 2d 73 65 74 29 29 () . ,init-set))
1d780 29 29 29 0a 20 20 20 20 3b 3b 20 55 6e 6d 61 72 ))). ;; Unmar
1d790 6b 65 64 20 73 74 61 74 65 73 20 61 72 65 20 6a ked states are j
1d7a0 75 73 74 20 73 65 74 73 20 6f 66 20 4e 46 41 20 ust sets of NFA
1d7b0 73 74 61 74 65 73 20 77 69 74 68 20 74 61 67 2d states with tag-
1d7c0 6d 61 70 73 2c 20 6d 61 72 6b 65 64 20 73 74 61 maps, marked sta
1d7d0 74 65 73 0a 20 20 20 20 3b 3b 20 61 72 65 20 73 tes. ;; are s
1d7e0 65 74 73 20 6f 66 20 4e 46 41 20 73 74 61 74 65 ets of NFA state
1d7f0 73 20 77 69 74 68 20 74 72 61 6e 73 69 74 69 6f s with transitio
1d800 6e 73 20 74 6f 20 73 65 74 73 20 6f 66 20 4e 46 ns to sets of NF
1d810 41 20 73 74 61 74 65 73 0a 20 20 20 20 28 6c 65 A states. (le
1d820 74 20 6c 70 20 28 28 75 6e 6d 61 72 6b 65 64 2d t lp ((unmarked-
1d830 73 74 61 74 65 73 20 28 6c 69 73 74 20 73 74 61 states (list sta
1d840 72 74 2d 63 6c 6f 73 75 72 65 29 29 0a 20 20 20 rt-closure)).
1d850 20 20 20 20 20 20 20 20 20 20 28 6d 61 72 6b 65 (marke
1d860 64 2d 73 74 61 74 65 73 20 28 6c 69 73 74 20 69 d-states (list i
1d870 6e 69 74 2d 73 74 61 74 65 29 29 0a 20 20 20 20 nit-state)).
1d880 20 20 20 20 20 20 20 20 20 28 64 66 61 2d 73 69 (dfa-si
1d890 7a 65 20 30 29 29 0a 20 20 20 20 20 20 28 63 6f ze 0)). (co
1d8a0 6e 64 0a 20 20 20 20 20 20 20 28 28 6e 75 6c 6c nd. ((null
1d8b0 3f 20 75 6e 6d 61 72 6b 65 64 2d 73 74 61 74 65 ? unmarked-state
1d8c0 73 29 0a 20 20 20 20 20 20 20 20 3b 3b 20 41 62 s). ;; Ab
1d8d0 75 73 65 20 66 69 6e 61 6c 69 7a 65 72 20 73 6c use finalizer sl
1d8e0 6f 74 20 66 6f 72 20 73 74 6f 72 69 6e 67 20 74 ot for storing t
1d8f0 68 65 20 6e 75 6d 62 65 72 20 6f 66 20 6d 65 6d he number of mem
1d900 6f 72 79 20 73 6c 6f 74 73 20 77 65 20 6e 65 65 ory slots we nee
1d910 64 0a 20 20 20 20 20 20 20 20 28 73 65 74 2d 63 d. (set-c
1d920 61 72 21 20 28 63 64 72 20 69 6e 69 74 2d 73 74 ar! (cdr init-st
1d930 61 74 65 29 20 28 2b 20 28 6e 66 61 2d 68 69 67 ate) (+ (nfa-hig
1d940 68 65 73 74 2d 6d 61 70 2d 69 6e 64 65 78 20 6e hest-map-index n
1d950 66 61 29 20 31 29 29 0a 20 20 20 20 20 20 20 20 fa) 1)).
1d960 28 64 66 61 2d 72 65 6e 75 6d 62 65 72 20 28 72 (dfa-renumber (r
1d970 65 76 65 72 73 65 20 6d 61 72 6b 65 64 2d 73 74 everse marked-st
1d980 61 74 65 73 29 29 29 0a 20 20 20 20 20 20 20 28 ates))). (
1d990 28 61 6e 64 20 6d 61 78 2d 73 74 61 74 65 73 20 (and max-states
1d9a0 28 3e 20 64 66 61 2d 73 69 7a 65 20 6d 61 78 2d (> dfa-size max-
1d9b0 73 74 61 74 65 73 29 29 20 3b 20 54 6f 6f 20 6d states)) ; Too m
1d9c0 61 6e 79 20 44 46 41 20 73 74 61 74 65 73 0a 20 any DFA states.
1d9d0 20 20 20 20 20 20 20 23 66 29 0a 20 20 20 20 20 #f).
1d9e0 20 20 28 28 61 73 73 6f 63 20 28 63 61 72 20 75 ((assoc (car u
1d9f0 6e 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 29 20 nmarked-states)
1da00 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 29 20 3b marked-states) ;
1da10 20 53 65 65 6e 20 73 65 74 20 6f 66 20 4e 46 41 Seen set of NFA
1da20 2d 73 74 61 74 65 73 3f 0a 20 20 20 20 20 20 20 -states?.
1da30 20 28 6c 70 20 28 63 64 72 20 75 6e 6d 61 72 6b (lp (cdr unmark
1da40 65 64 2d 73 74 61 74 65 73 29 20 6d 61 72 6b 65 ed-states) marke
1da50 64 2d 73 74 61 74 65 73 20 64 66 61 2d 73 69 7a d-states dfa-siz
1da60 65 29 29 0a 20 20 20 20 20 20 20 28 65 6c 73 65 e)). (else
1da70 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 . (let ((
1da80 64 66 61 2d 73 74 61 74 65 20 28 63 61 72 20 75 dfa-state (car u
1da90 6e 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 29 29 nmarked-states))
1daa0 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 ). (let
1dab0 20 6c 70 32 20 28 28 74 72 61 6e 73 20 28 67 65 lp2 ((trans (ge
1dac0 74 2d 64 69 73 74 69 6e 63 74 2d 74 72 61 6e 73 t-distinct-trans
1dad0 69 74 69 6f 6e 73 20 6e 66 61 20 64 66 61 2d 73 itions nfa dfa-s
1dae0 74 61 74 65 29 29 0a 20 20 20 20 20 20 20 20 20 tate)).
1daf0 20 20 20 20 20 20 20 20 20 20 20 28 75 6e 6d 61 (unma
1db00 72 6b 65 64 2d 73 74 61 74 65 73 20 28 63 64 72 rked-states (cdr
1db10 20 75 6e 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 unmarked-states
1db20 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1db30 20 20 20 20 20 20 20 28 64 66 61 2d 74 72 61 6e (dfa-tran
1db40 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 s '())).
1db50 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 (if (null? t
1db60 72 61 6e 73 29 0a 20 20 20 20 20 20 20 20 20 20 rans).
1db70 20 20 20 20 20 20 28 6c 65 74 20 28 28 66 69 6e (let ((fin
1db80 61 6c 69 7a 65 72 20 28 6d 73 74 2d 73 74 61 74 alizer (mst-stat
1db90 65 2d 6d 61 70 70 69 6e 67 73 20 64 66 61 2d 73 e-mappings dfa-s
1dba0 74 61 74 65 20 30 29 29 29 0a 20 20 20 20 20 20 tate 0))).
1dbb0 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
1dbc0 75 6e 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 0a unmarked-states.
1dbd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dbe0 20 20 20 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 (cons (lis
1dbf0 74 20 64 66 61 2d 73 74 61 74 65 20 66 69 6e 61 t dfa-state fina
1dc00 6c 69 7a 65 72 20 64 66 61 2d 74 72 61 6e 73 29 lizer dfa-trans)
1dc10 20 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 29 0a marked-states).
1dc20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dc30 20 20 20 20 20 20 28 2b 20 64 66 61 2d 73 69 7a (+ dfa-siz
1dc40 65 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 e 1))).
1dc50 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 (let* ((c
1dc60 6c 6f 73 75 72 65 20 28 6e 66 61 2d 65 70 73 69 losure (nfa-epsi
1dc70 6c 6f 6e 2d 63 6c 6f 73 75 72 65 20 6e 66 61 20 lon-closure nfa
1dc80 28 63 64 61 72 20 74 72 61 6e 73 29 29 29 0a 20 (cdar trans))).
1dc90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dca0 20 20 20 20 20 20 28 72 65 6f 72 64 65 72 65 64 (reordered
1dcb0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1dcc0 20 20 20 20 20 20 20 20 20 28 66 69 6e 64 2d 72 (find-r
1dcd0 65 6f 72 64 65 72 2d 63 6f 6d 6d 61 6e 64 73 20 eorder-commands
1dce0 6e 66 61 20 63 6c 6f 73 75 72 65 20 6d 61 72 6b nfa closure mark
1dcf0 65 64 2d 73 74 61 74 65 73 29 29 0a 20 20 20 20 ed-states)).
1dd00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dd10 20 20 20 28 63 6f 70 79 2d 63 6d 64 73 20 28 69 (copy-cmds (i
1dd20 66 20 72 65 6f 72 64 65 72 65 64 20 28 63 64 72 f reordered (cdr
1dd30 20 72 65 6f 72 64 65 72 65 64 29 20 27 28 29 29 reordered) '())
1dd40 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1dd50 20 20 20 20 20 20 20 20 20 3b 3b 20 4c 61 75 72 ;; Laur
1dd60 69 6b 61 72 69 20 64 6f 65 73 6e 27 74 20 6d 65 ikari doesn't me
1dd70 6e 74 69 6f 6e 20 77 68 61 74 20 22 6b 22 20 69 ntion what "k" i
1dd80 73 2c 20 62 75 74 20 69 74 20 73 65 65 6d 73 20 s, but it seems
1dd90 69 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 it.
1dda0 20 20 20 20 20 20 20 20 20 20 3b 3b 20 6d 75 73 ;; mus
1ddb0 74 20 62 65 20 74 68 65 20 6d 61 70 70 69 6e 67 t be the mapping
1ddc0 73 20 6f 66 20 74 68 65 20 73 74 61 74 65 27 73 s of the state's
1ddd0 20 72 65 61 63 68 0a 20 20 20 20 20 20 20 20 20 reach.
1dde0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
1ddf0 65 74 2d 63 6d 64 73 20 28 74 61 67 2d 73 65 74 et-cmds (tag-set
1de00 2d 63 6f 6d 6d 61 6e 64 73 2d 66 6f 72 2d 63 6c -commands-for-cl
1de10 6f 73 75 72 65 0a 20 20 20 20 20 20 20 20 20 20 osure.
1de20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1de30 20 20 20 20 20 20 20 20 6e 66 61 20 28 63 64 61 nfa (cda
1de40 72 20 74 72 61 6e 73 29 20 63 6c 6f 73 75 72 65 r trans) closure
1de50 20 63 6f 70 79 2d 63 6d 64 73 29 29 0a 20 20 20 copy-cmds)).
1de60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1de70 20 20 20 20 28 74 72 61 6e 73 2d 63 6c 6f 73 75 (trans-closu
1de80 72 65 20 28 69 66 20 72 65 6f 72 64 65 72 65 64 re (if reordered
1de90 20 28 63 61 72 20 72 65 6f 72 64 65 72 65 64 29 (car reordered)
1dea0 20 63 6c 6f 73 75 72 65 29 29 29 0a 20 20 20 20 closure))).
1deb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1dec0 70 32 20 28 63 64 72 20 74 72 61 6e 73 29 0a 20 p2 (cdr trans).
1ded0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dee0 20 20 20 20 20 20 28 69 66 20 72 65 6f 72 64 65 (if reorde
1def0 72 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 red.
1df00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 75 u
1df10 6e 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 0a 20 nmarked-states.
1df20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1df30 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 (cons
1df40 74 72 61 6e 73 2d 63 6c 6f 73 75 72 65 20 75 6e trans-closure un
1df50 6d 61 72 6b 65 64 2d 73 74 61 74 65 73 29 29 0a marked-states)).
1df60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1df70 20 20 20 20 20 20 20 28 63 6f 6e 73 20 60 28 2c (cons `(,
1df80 74 72 61 6e 73 2d 63 6c 6f 73 75 72 65 0a 20 20 trans-closure.
1df90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dfa0 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 63 ,(c
1dfb0 61 61 72 20 74 72 61 6e 73 29 20 2c 63 6f 70 79 aar trans) ,copy
1dfc0 2d 63 6d 64 73 20 2e 20 2c 73 65 74 2d 63 6d 64 -cmds . ,set-cmd
1dfd0 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
1dfe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dff0 64 66 61 2d 74 72 61 6e 73 29 29 29 29 29 29 29 dfa-trans)))))))
1e000 29 29 29 29 0a 0a 3b 3b 20 57 68 65 6e 20 74 68 ))))..;; When th
1e010 65 20 63 6f 6e 76 65 72 73 69 6f 6e 20 69 73 20 e conversion is
1e020 63 6f 6d 70 6c 65 74 65 20 77 65 20 72 65 6e 75 complete we renu
1e030 6d 62 65 72 20 74 68 65 20 44 46 41 20 73 65 74 mber the DFA set
1e040 73 2d 6f 66 2d 73 74 61 74 65 73 0a 3b 3b 20 69 s-of-states.;; i
1e050 6e 20 6f 72 64 65 72 20 61 6e 64 20 63 6f 6e 76 n order and conv
1e060 65 72 74 20 74 68 65 20 72 65 73 75 6c 74 20 74 ert the result t
1e070 6f 20 61 20 76 65 63 74 6f 72 20 66 6f 72 20 66 o a vector for f
1e080 61 73 74 20 6c 6f 6f 6b 75 70 2e 0a 3b 3b 20 43 ast lookup..;; C
1e090 68 61 72 73 65 74 73 20 63 6f 6e 74 61 69 6e 69 harsets containi
1e0a0 6e 67 20 73 69 6e 67 6c 65 20 63 68 61 72 61 63 ng single charac
1e0b0 74 65 72 73 20 61 72 65 20 63 6f 6e 76 65 72 74 ters are convert
1e0c0 65 64 20 74 6f 20 74 68 6f 73 65 20 63 68 61 72 ed to those char
1e0d0 61 63 74 65 72 73 0a 3b 3b 20 66 6f 72 20 71 75 acters.;; for qu
1e0e0 69 63 6b 20 6d 61 74 63 68 69 6e 67 20 6f 66 20 ick matching of
1e0f0 74 68 65 20 6c 69 74 65 72 61 6c 20 70 61 72 74 the literal part
1e100 73 20 69 6e 20 61 20 72 65 67 65 78 2e 0a 28 64 s in a regex..(d
1e110 65 66 69 6e 65 20 28 64 66 61 2d 72 65 6e 75 6d efine (dfa-renum
1e120 62 65 72 20 73 74 61 74 65 73 29 0a 20 20 28 6c ber states). (l
1e130 65 74 20 28 28 69 6e 64 65 78 65 73 20 28 6c 65 et ((indexes (le
1e140 74 20 6c 70 20 28 28 69 20 30 29 20 28 73 74 61 t lp ((i 0) (sta
1e150 74 65 73 20 73 74 61 74 65 73 29 20 28 69 6e 64 tes states) (ind
1e160 65 78 65 73 20 27 28 29 29 29 0a 20 20 20 20 20 exes '())).
1e170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1e180 66 20 28 6e 75 6c 6c 3f 20 73 74 61 74 65 73 29 f (null? states)
1e190 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1e1a0 20 20 20 20 20 20 20 20 69 6e 64 65 78 65 73 0a indexes.
1e1b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e1c0 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
1e1d0 31 29 20 28 63 64 72 20 73 74 61 74 65 73 29 0a 1) (cdr states).
1e1e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e1f0 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
1e200 20 28 63 6f 6e 73 20 28 63 61 61 72 20 73 74 61 (cons (caar sta
1e210 74 65 73 29 20 69 29 20 69 6e 64 65 78 65 73 29 tes) i) indexes)
1e220 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 64 66 )))). (df
1e230 61 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 a (make-vector (
1e240 6c 65 6e 67 74 68 20 73 74 61 74 65 73 29 29 29 length states)))
1e250 29 0a 20 20 20 20 28 64 6f 20 28 28 69 20 30 20 ). (do ((i 0
1e260 28 2b 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 (+ i 1)).
1e270 20 20 28 73 74 61 74 65 73 20 73 74 61 74 65 73 (states states
1e280 20 28 63 64 72 20 73 74 61 74 65 73 29 29 29 0a (cdr states))).
1e290 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 ((null?
1e2a0 73 74 61 74 65 73 29 20 64 66 61 29 0a 20 20 20 states) dfa).
1e2b0 20 20 20 28 6c 65 74 20 28 28 6d 61 79 62 65 2d (let ((maybe-
1e2c0 66 69 6e 61 6c 69 7a 65 72 20 28 63 61 64 61 72 finalizer (cadar
1e2d0 20 73 74 61 74 65 73 29 29 0a 20 20 20 20 20 20 states)).
1e2e0 20 20 20 20 20 20 28 74 72 61 6e 73 69 74 69 6f (transitio
1e2f0 6e 73 20 28 63 61 64 64 61 72 20 73 74 61 74 65 ns (caddar state
1e300 73 29 29 29 0a 20 20 20 20 20 20 20 28 76 65 63 s))). (vec
1e310 74 6f 72 2d 73 65 74 21 0a 20 20 20 20 20 20 20 tor-set!.
1e320 20 64 66 61 20 69 0a 20 20 20 20 20 20 20 20 28 dfa i. (
1e330 63 6f 6e 73 20 6d 61 79 62 65 2d 66 69 6e 61 6c cons maybe-final
1e340 69 7a 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 izer.
1e350 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
1e360 28 74 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 (tr).
1e370 20 20 20 20 20 20 20 20 20 20 60 28 2c 28 61 6e `(,(an
1e380 64 20 28 63 61 64 72 20 74 72 29 20 28 6d 61 79 d (cadr tr) (may
1e390 62 65 2d 63 73 65 74 2d 3e 63 68 61 72 20 28 63 be-cset->char (c
1e3a0 61 64 72 20 74 72 29 29 29 0a 20 20 20 20 20 20 adr tr))).
1e3b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e3c0 20 2c 28 63 64 72 20 28 61 73 73 6f 63 20 28 63 ,(cdr (assoc (c
1e3d0 61 72 20 74 72 29 20 69 6e 64 65 78 65 73 29 29 ar tr) indexes))
1e3e0 20 2e 20 2c 28 63 64 64 72 20 74 72 29 29 29 0a . ,(cddr tr))).
1e3f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e400 20 20 20 74 72 61 6e 73 69 74 69 6f 6e 73 29 29 transitions))
1e410 29 29 29 29 29 0a 0a 3b 3b 20 45 78 74 72 61 63 )))))..;; Extrac
1e420 74 20 61 6c 6c 20 64 69 73 74 69 6e 63 74 20 72 t all distinct r
1e430 61 6e 67 65 73 20 61 6e 64 20 74 68 65 20 70 6f anges and the po
1e440 74 65 6e 74 69 61 6c 20 73 74 61 74 65 73 20 74 tential states t
1e450 68 65 79 20 63 61 6e 20 74 72 61 6e 73 69 74 69 hey can transiti
1e460 6f 6e 0a 3b 3b 20 74 6f 20 66 72 6f 6d 20 61 20 on.;; to from a
1e470 67 69 76 65 6e 20 73 65 74 20 6f 66 20 73 74 61 given set of sta
1e480 74 65 73 2e 20 20 41 6e 79 20 72 61 6e 67 65 73 tes. Any ranges
1e490 20 74 68 61 74 20 77 6f 75 6c 64 20 6f 76 65 72 that would over
1e4a0 6c 61 70 20 77 69 74 68 0a 3b 3b 20 64 69 73 74 lap with.;; dist
1e4b0 69 6e 63 74 20 63 68 61 72 61 63 74 65 72 73 20 inct characters
1e4c0 61 72 65 20 73 70 6c 69 74 20 61 63 63 6f 72 64 are split accord
1e4d0 69 6e 67 6c 79 2e 0a 3b 3b 20 54 68 69 73 20 66 ingly..;; This f
1e4e0 75 6e 63 74 69 6f 6e 20 69 73 20 6c 69 6b 65 20 unction is like
1e4f0 22 72 65 61 63 68 22 20 69 6e 20 4c 61 75 72 69 "reach" in Lauri
1e500 6b 61 72 69 27 73 20 70 61 70 65 72 73 2c 20 62 kari's papers, b
1e510 75 74 20 66 6f 72 20 65 61 63 68 0a 3b 3b 20 70 ut for each.;; p
1e520 6f 73 73 69 62 6c 65 20 64 69 73 74 69 6e 63 74 ossible distinct
1e530 20 72 61 6e 67 65 20 6f 66 20 63 68 61 72 61 63 range of charac
1e540 74 65 72 73 20 72 61 74 68 65 72 20 74 68 61 6e ters rather than
1e550 20 70 65 72 20 63 68 61 72 61 63 74 65 72 2e 0a per character..
1e560 28 64 65 66 69 6e 65 20 28 67 65 74 2d 64 69 73 (define (get-dis
1e570 74 69 6e 63 74 2d 74 72 61 6e 73 69 74 69 6f 6e tinct-transition
1e580 73 20 6e 66 61 20 61 6e 6e 6f 74 61 74 65 64 2d s nfa annotated-
1e590 73 74 61 74 65 73 29 0a 20 20 28 64 65 66 69 6e states). (defin
1e5a0 65 20 28 63 73 65 74 73 2d 69 6e 74 65 72 73 65 e (csets-interse
1e5b0 63 74 3f 20 61 20 62 29 0a 20 20 20 20 28 6c 65 ct? a b). (le
1e5c0 74 20 28 28 69 20 28 63 73 65 74 2d 69 6e 74 65 t ((i (cset-inte
1e5d0 72 73 65 63 74 69 6f 6e 20 61 20 62 29 29 29 0a rsection a b))).
1e5e0 20 20 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 (and (not
1e5f0 28 63 73 65 74 2d 65 6d 70 74 79 3f 20 69 29 29 (cset-empty? i))
1e600 20 69 29 29 29 0a 20 20 28 6d 73 74 2d 66 6f 6c i))). (mst-fol
1e610 64 0a 20 20 20 61 6e 6e 6f 74 61 74 65 64 2d 73 d. annotated-s
1e620 74 61 74 65 73 0a 20 20 20 28 6c 61 6d 62 64 61 tates. (lambda
1e630 20 28 73 74 20 6d 61 70 70 69 6e 67 73 20 72 65 (st mappings re
1e640 73 29 0a 20 20 20 20 20 28 6c 65 74 20 28 28 74 s). (let ((t
1e650 72 61 6e 73 20 28 6e 66 61 2d 67 65 74 2d 73 74 rans (nfa-get-st
1e660 61 74 65 2d 74 72 61 6e 73 20 6e 66 61 20 73 74 ate-trans nfa st
1e670 29 29 29 20 3b 20 41 6c 77 61 79 73 20 6f 6e 65 ))) ; Always one
1e680 20 73 74 61 74 65 20 70 65 72 20 74 72 61 6e 73 state per trans
1e690 0a 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c . (if (nul
1e6a0 6c 3f 20 74 72 61 6e 73 29 0a 20 20 20 20 20 20 l? trans).
1e6b0 20 20 20 20 20 72 65 73 0a 20 20 20 20 20 20 20 res.
1e6c0 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 (let lp ((ls
1e6d0 20 72 65 73 29 20 28 63 73 20 28 63 61 72 20 74 res) (cs (car t
1e6e0 72 61 6e 73 29 29 20 28 73 74 61 74 65 20 28 63 rans)) (state (c
1e6f0 64 72 20 74 72 61 6e 73 29 29 20 28 72 65 73 20 dr trans)) (res
1e700 27 28 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 '())).
1e710 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
1e720 20 20 20 20 20 20 20 3b 3b 20 53 74 61 74 65 20 ;; State
1e730 6e 6f 74 20 73 65 65 6e 20 79 65 74 3f 20 20 41 not seen yet? A
1e740 64 64 20 61 20 6e 65 77 20 73 74 61 74 65 20 74 dd a new state t
1e750 72 61 6e 73 69 74 69 6f 6e 0a 20 20 20 20 20 20 ransition.
1e760 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 ((null?
1e770 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
1e780 20 20 20 3b 3b 20 54 4f 44 4f 3a 20 57 65 20 73 ;; TODO: We s
1e790 68 6f 75 6c 64 20 74 72 79 20 74 6f 20 66 69 6e hould try to fin
1e7a0 64 20 61 6e 20 65 78 69 73 74 69 6e 67 20 44 46 d an existing DF
1e7b0 41 20 73 74 61 74 65 0a 20 20 20 20 20 20 20 20 A state.
1e7c0 20 20 20 20 20 20 20 3b 3b 20 77 69 74 68 20 6f ;; with o
1e7d0 6e 6c 79 20 74 68 69 73 20 4e 46 41 20 73 74 61 nly this NFA sta
1e7e0 74 65 20 69 6e 20 69 74 2c 20 61 6e 64 20 65 78 te in it, and ex
1e7f0 74 65 6e 64 20 74 68 65 20 63 73 65 74 0a 20 20 tend the cset.
1e800 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
1e810 77 69 74 68 20 74 68 65 20 63 75 72 72 65 6e 74 with the current
1e820 20 6f 6e 65 2e 20 20 54 68 69 73 20 70 72 6f 64 one. This prod
1e830 75 63 65 73 20 73 6d 61 6c 6c 65 72 20 44 46 41 uces smaller DFA
1e840 73 2c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s,.
1e850 20 20 3b 3b 20 62 75 74 20 74 61 6b 65 73 20 6c ;; but takes l
1e860 6f 6e 67 65 72 20 74 6f 20 63 6f 6d 70 69 6c 65 onger to compile
1e870 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ..
1e880 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 63 73 20 (cons (cons cs
1e890 28 6e 66 61 2d 73 74 61 74 65 2d 3e 6d 73 74 20 (nfa-state->mst
1e8a0 6e 66 61 20 73 74 61 74 65 20 6d 61 70 70 69 6e nfa state mappin
1e8b0 67 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 gs)).
1e8c0 20 20 20 20 20 20 20 20 20 20 72 65 73 29 29 0a res)).
1e8d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
1e8e0 63 73 65 74 3d 3f 20 63 73 20 28 63 61 61 72 20 cset=? cs (caar
1e8f0 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls)).
1e900 20 20 20 20 3b 3b 20 41 64 64 20 73 74 61 74 65 ;; Add state
1e910 20 74 6f 20 65 78 69 73 74 69 6e 67 20 73 65 74 to existing set
1e920 20 66 6f 72 20 74 68 69 73 20 63 68 61 72 73 65 for this charse
1e930 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
1e940 20 28 6d 73 74 2d 61 64 64 21 20 6e 66 61 20 28 (mst-add! nfa (
1e950 63 64 61 72 20 6c 73 29 20 73 74 61 74 65 20 6d cdar ls) state m
1e960 61 70 70 69 6e 67 73 29 0a 20 20 20 20 20 20 20 appings).
1e970 20 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 (append
1e980 6c 73 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 ls res)).
1e990 20 20 20 20 20 20 20 28 28 63 73 65 74 73 2d 69 ((csets-i
1e9a0 6e 74 65 72 73 65 63 74 3f 20 63 73 20 28 63 61 ntersect? cs (ca
1e9b0 61 72 20 6c 73 29 29 20 3d 3e 0a 20 20 20 20 20 ar ls)) =>.
1e9c0 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
1e9d0 61 20 28 69 6e 74 65 72 73 65 63 74 69 6f 6e 29 a (intersection)
1e9e0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1e9f0 20 20 28 6c 65 74 2a 20 28 28 6f 6e 6c 79 2d 69 (let* ((only-i
1ea00 6e 2d 6e 65 77 20 28 63 73 65 74 2d 64 69 66 66 n-new (cset-diff
1ea10 65 72 65 6e 63 65 20 63 73 20 28 63 61 61 72 20 erence cs (caar
1ea20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls))).
1ea30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
1ea40 6e 6c 79 2d 69 6e 2d 6f 6c 64 20 28 63 73 65 74 nly-in-old (cset
1ea50 2d 64 69 66 66 65 72 65 6e 63 65 20 28 63 61 61 -difference (caa
1ea60 72 20 6c 73 29 20 63 73 29 29 0a 20 20 20 20 20 r ls) cs)).
1ea70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ea80 20 20 20 28 73 74 61 74 65 73 2d 69 6e 2d 62 6f (states-in-bo
1ea90 74 68 20 28 63 64 61 72 20 6c 73 29 29 0a 20 20 th (cdar ls)).
1eaa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eab0 20 20 20 20 20 20 28 73 74 61 74 65 73 2d 66 6f (states-fo
1eac0 72 2d 6f 6c 64 0a 20 20 20 20 20 20 20 20 20 20 r-old.
1ead0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1eae0 61 6e 64 20 28 6e 6f 74 20 28 63 73 65 74 2d 65 and (not (cset-e
1eaf0 6d 70 74 79 3f 20 6f 6e 6c 79 2d 69 6e 2d 6f 6c mpty? only-in-ol
1eb00 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 d)).
1eb10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eb20 20 20 28 6d 73 74 2d 63 6f 70 79 20 73 74 61 74 (mst-copy stat
1eb30 65 73 2d 69 6e 2d 62 6f 74 68 29 29 29 0a 20 20 es-in-both))).
1eb40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eb50 20 20 20 20 20 20 28 72 65 73 20 28 69 66 20 73 (res (if s
1eb60 74 61 74 65 73 2d 66 6f 72 2d 6f 6c 64 0a 20 20 tates-for-old.
1eb70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eb80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1eb90 63 6f 6e 73 20 28 63 6f 6e 73 20 6f 6e 6c 79 2d cons (cons only-
1eba0 69 6e 2d 6f 6c 64 20 73 74 61 74 65 73 2d 66 6f in-old states-fo
1ebb0 72 2d 6f 6c 64 29 20 72 65 73 29 0a 20 20 20 20 r-old) res).
1ebc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ebd0 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 res
1ebe0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1ebf0 20 20 20 20 20 20 20 28 6d 73 74 2d 61 64 64 21 (mst-add!
1ec00 20 6e 66 61 20 73 74 61 74 65 73 2d 69 6e 2d 62 nfa states-in-b
1ec10 6f 74 68 20 73 74 61 74 65 20 6d 61 70 70 69 6e oth state mappin
1ec20 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 gs).
1ec30 20 20 20 20 20 20 20 3b 3b 20 41 64 64 20 74 68 ;; Add th
1ec40 69 73 20 73 74 61 74 65 20 74 6f 20 74 68 65 20 is state to the
1ec50 73 74 61 74 65 73 20 61 6c 72 65 61 64 79 20 68 states already h
1ec60 65 72 65 20 61 6e 64 0a 20 20 20 20 20 20 20 20 ere and.
1ec70 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 72 65 ;; re
1ec80 73 74 72 69 63 74 20 74 6f 20 74 68 65 20 6f 76 strict to the ov
1ec90 65 72 6c 61 70 70 69 6e 67 20 63 68 61 72 73 65 erlapping charse
1eca0 74 20 61 6e 64 20 63 6f 6e 74 69 6e 75 65 0a 20 t and continue.
1ecb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ecc0 20 20 3b 3b 20 77 69 74 68 20 74 68 65 20 72 65 ;; with the re
1ecd0 6d 61 69 6e 69 6e 67 20 73 75 62 73 65 74 20 6f maining subset o
1ece0 66 20 74 68 65 20 6e 65 77 20 63 73 65 74 20 28 f the new cset (
1ecf0 69 66 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 if.
1ed00 20 20 20 20 20 20 3b 3b 20 6e 6f 6e 65 6d 70 74 ;; nonempt
1ed10 79 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 y).
1ed20 20 20 20 20 20 20 28 69 66 20 28 63 73 65 74 2d (if (cset-
1ed30 65 6d 70 74 79 3f 20 6f 6e 6c 79 2d 69 6e 2d 6e empty? only-in-n
1ed40 65 77 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ew).
1ed50 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
1ed60 20 28 63 6f 6e 73 20 69 6e 74 65 72 73 65 63 74 (cons intersect
1ed70 69 6f 6e 20 73 74 61 74 65 73 2d 69 6e 2d 62 6f ion states-in-bo
1ed80 74 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 th).
1ed90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eda0 20 28 61 70 70 65 6e 64 20 28 63 64 72 20 6c 73 (append (cdr ls
1edb0 29 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 ) res)).
1edc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1edd0 6c 70 20 28 63 64 72 20 6c 73 29 20 6f 6e 6c 79 lp (cdr ls) only
1ede0 2d 69 6e 2d 6e 65 77 20 73 74 61 74 65 0a 20 20 -in-new state.
1edf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ee00 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 (cons (
1ee10 63 6f 6e 73 20 69 6e 74 65 72 73 65 63 74 69 6f cons intersectio
1ee20 6e 20 73 74 61 74 65 73 2d 69 6e 2d 62 6f 74 68 n states-in-both
1ee30 29 20 72 65 73 29 29 29 29 29 29 0a 20 20 20 20 ) res)))))).
1ee40 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
1ee50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1ee60 6c 70 20 28 63 64 72 20 6c 73 29 20 63 73 20 73 lp (cdr ls) cs s
1ee70 74 61 74 65 20 28 63 6f 6e 73 20 28 63 61 72 20 tate (cons (car
1ee80 6c 73 29 20 72 65 73 29 29 29 29 29 29 29 29 0a ls) res)))))))).
1ee90 20 20 20 27 28 29 29 29 0a 0a 3b 3b 20 54 68 65 '()))..;; The
1eea0 20 65 70 73 69 6c 6f 6e 2d 63 6c 6f 73 75 72 65 epsilon-closure
1eeb0 20 6f 66 20 61 20 73 65 74 20 6f 66 20 73 74 61 of a set of sta
1eec0 74 65 73 20 69 73 20 61 6c 6c 20 74 68 65 20 73 tes is all the s
1eed0 74 61 74 65 73 20 72 65 61 63 68 61 62 6c 65 0a tates reachable.
1eee0 3b 3b 20 74 68 72 6f 75 67 68 20 65 70 73 69 6c ;; through epsil
1eef0 6f 6e 20 74 72 61 6e 73 69 74 69 6f 6e 73 2c 20 on transitions,
1ef00 77 69 74 68 20 74 68 65 20 74 61 67 73 20 65 6e with the tags en
1ef10 63 6f 75 6e 74 65 72 65 64 20 6f 6e 20 74 68 65 countered on the
1ef20 20 77 61 79 2e 0a 28 64 65 66 69 6e 65 20 28 6e way..(define (n
1ef30 66 61 2d 65 70 73 69 6c 6f 6e 2d 63 6c 6f 73 75 fa-epsilon-closu
1ef40 72 65 2d 69 6e 74 65 72 6e 61 6c 20 6e 66 61 20 re-internal nfa
1ef50 61 6e 6e 6f 74 61 74 65 64 2d 73 74 61 74 65 73 annotated-states
1ef60 29 0a 20 20 3b 3b 20 54 68 65 20 73 74 61 63 6b ). ;; The stack
1ef70 20 5f 4d 55 53 54 5f 20 62 65 20 69 6e 20 74 68 _MUST_ be in th
1ef80 69 73 20 6f 72 64 65 72 20 66 6f 72 20 73 6f 6d is order for som
1ef90 65 20 72 65 61 73 6f 6e 20 49 20 64 6f 6e 27 74 e reason I don't
1efa0 20 66 75 6c 6c 79 20 75 6e 64 65 72 73 74 61 6e fully understan
1efb0 64 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 73 74 d. (let lp ((st
1efc0 61 63 6b 20 28 6d 73 74 2d 66 6f 6c 64 20 61 6e ack (mst-fold an
1efd0 6e 6f 74 61 74 65 64 2d 73 74 61 74 65 73 0a 20 notated-states.
1efe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eff0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f000 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
1f010 73 74 20 6d 20 72 65 73 29 0a 20 20 20 20 20 20 st m res).
1f020 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f040 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 (cons (cons
1f050 73 74 20 6d 29 20 72 65 73 29 29 0a 20 20 20 20 st m) res)).
1f060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f070 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f080 20 20 20 20 27 28 29 29 29 0a 20 20 20 20 20 20 '())).
1f090 20 20 20 20 20 28 70 72 69 6f 72 69 74 69 65 73 (priorities
1f0a0 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 6e (make-vector (n
1f0b0 66 61 2d 6e 75 6d 2d 73 74 61 74 65 73 20 6e 66 fa-num-states nf
1f0c0 61 29 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 a) 0)).
1f0d0 20 20 28 63 6c 6f 73 75 72 65 20 28 6d 73 74 2d (closure (mst-
1f0e0 63 6f 70 79 20 61 6e 6e 6f 74 61 74 65 64 2d 73 copy annotated-s
1f0f0 74 61 74 65 73 29 29 29 0a 20 20 20 20 28 69 66 tates))). (if
1f100 20 28 6e 75 6c 6c 3f 20 73 74 61 63 6b 29 0a 20 (null? stack).
1f110 20 20 20 20 20 20 20 63 6c 6f 73 75 72 65 0a 20 closure.
1f120 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 72 (let ((pr
1f130 69 6f 2f 6f 72 69 67 2d 73 74 61 74 65 20 28 63 io/orig-state (c
1f140 61 61 72 20 73 74 61 63 6b 29 29 20 3b 20 70 72 aar stack)) ; pr
1f150 69 6f 72 69 74 79 20 69 73 20 6a 75 73 74 20 74 iority is just t
1f160 68 65 20 73 74 61 74 65 20 6e 72 2e 0a 20 20 20 he state nr..
1f170 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 70 (mapp
1f180 69 6e 67 73 20 28 63 64 61 72 20 73 74 61 63 6b ings (cdar stack
1f190 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c ))). (l
1f1a0 65 74 20 6c 70 32 20 28 28 74 72 61 6e 73 20 28 et lp2 ((trans (
1f1b0 6e 66 61 2d 67 65 74 2d 65 70 73 69 6c 6f 6e 73 nfa-get-epsilons
1f1c0 20 6e 66 61 20 70 72 69 6f 2f 6f 72 69 67 2d 73 nfa prio/orig-s
1f1d0 74 61 74 65 29 29 0a 20 20 20 20 20 20 20 20 20 tate)).
1f1e0 20 20 20 20 20 20 20 20 20 20 20 28 73 74 61 63 (stac
1f1f0 6b 20 28 63 64 72 20 73 74 61 63 6b 29 29 29 0a k (cdr stack))).
1f200 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
1f210 28 6e 75 6c 6c 3f 20 74 72 61 6e 73 29 0a 20 20 (null? trans).
1f220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1f230 70 20 73 74 61 63 6b 20 70 72 69 6f 72 69 74 69 p stack prioriti
1f240 65 73 20 63 6c 6f 73 75 72 65 29 0a 20 20 20 20 es closure).
1f250 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
1f260 20 28 28 73 74 61 74 65 20 28 63 61 61 72 20 74 ((state (caar t
1f270 72 61 6e 73 29 29 29 0a 20 20 20 20 20 20 20 20 rans))).
1f280 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
1f290 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f2a0 20 20 20 3b 3b 20 4f 75 72 20 70 72 69 6f 72 69 ;; Our priori
1f2b0 74 69 65 73 20 61 72 65 20 69 6e 76 65 72 74 65 ties are inverte
1f2c0 64 20 62 65 63 61 75 73 65 20 77 65 20 73 74 61 d because we sta
1f2d0 72 74 20 61 74 0a 20 20 20 20 20 20 20 20 20 20 rt at.
1f2e0 20 20 20 20 20 20 20 20 20 3b 3b 20 74 68 65 20 ;; the
1f2f0 68 69 67 68 65 73 74 20 73 74 61 74 65 20 6e 75 highest state nu
1f300 6d 62 65 72 20 61 6e 64 20 67 6f 20 64 6f 77 6e mber and go down
1f310 77 61 72 64 73 20 74 6f 20 30 2e 0a 20 20 20 20 wards to 0..
1f320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1f330 28 3e 20 70 72 69 6f 2f 6f 72 69 67 2d 73 74 61 (> prio/orig-sta
1f340 74 65 20 28 76 65 63 74 6f 72 2d 72 65 66 20 70 te (vector-ref p
1f350 72 69 6f 72 69 74 69 65 73 20 73 74 61 74 65 29 riorities state)
1f360 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1f370 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
1f380 74 21 20 70 72 69 6f 72 69 74 69 65 73 20 73 74 t! priorities st
1f390 61 74 65 20 70 72 69 6f 2f 6f 72 69 67 2d 73 74 ate prio/orig-st
1f3a0 61 74 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ate).
1f3b0 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
1f3c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f3d0 20 20 20 20 28 28 63 64 61 72 20 74 72 61 6e 73 ((cdar trans
1f3e0 29 20 3d 3e 20 20 20 3b 20 74 61 67 67 65 64 20 ) => ; tagged
1f3f0 74 72 61 6e 73 69 74 69 6f 6e 3f 0a 20 20 20 20 transition?.
1f400 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f410 20 20 28 6c 61 6d 62 64 61 20 28 74 61 67 29 0a (lambda (tag).
1f420 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f430 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 69 (let* ((i
1f440 6e 64 65 78 20 28 6e 65 78 74 2d 69 6e 64 65 78 ndex (next-index
1f450 2d 66 6f 72 2d 74 61 67 21 20 6e 66 61 20 74 61 -for-tag! nfa ta
1f460 67 20 63 6c 6f 73 75 72 65 29 29 0a 20 20 20 20 g closure)).
1f470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f480 20 20 20 20 20 20 20 20 20 20 28 6e 65 77 2d 6d (new-m
1f490 61 70 70 69 6e 67 73 0a 20 20 20 20 20 20 20 20 appings.
1f4a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f4b0 20 20 20 20 20 20 20 28 6d 73 74 2d 61 64 64 2d (mst-add-
1f4c0 74 61 67 67 65 64 21 0a 20 20 20 20 20 20 20 20 tagged!.
1f4d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f4e0 20 20 20 20 20 20 20 20 6e 66 61 20 63 6c 6f 73 nfa clos
1f4f0 75 72 65 20 73 74 61 74 65 20 6d 61 70 70 69 6e ure state mappin
1f500 67 73 20 74 61 67 20 69 6e 64 65 78 29 29 29 0a gs tag index))).
1f510 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f520 20 20 20 20 20 20 20 20 20 28 6c 70 32 20 28 63 (lp2 (c
1f530 64 72 20 74 72 61 6e 73 29 0a 20 20 20 20 20 20 dr trans).
1f540 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f550 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 (cons (c
1f560 6f 6e 73 20 73 74 61 74 65 20 6e 65 77 2d 6d 61 ons state new-ma
1f570 70 70 69 6e 67 73 29 20 73 74 61 63 6b 29 29 29 ppings) stack)))
1f580 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1f590 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
1f5a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f5b0 20 20 20 20 28 6d 73 74 2d 61 64 64 2f 66 61 73 (mst-add/fas
1f5c0 74 21 20 6e 66 61 20 63 6c 6f 73 75 72 65 20 73 t! nfa closure s
1f5d0 74 61 74 65 20 6d 61 70 70 69 6e 67 73 29 0a 20 tate mappings).
1f5e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f5f0 20 20 20 20 20 28 6c 70 32 20 28 63 64 72 20 74 (lp2 (cdr t
1f600 72 61 6e 73 29 20 28 63 6f 6e 73 20 28 63 6f 6e rans) (cons (con
1f610 73 20 73 74 61 74 65 20 6d 61 70 70 69 6e 67 73 s state mappings
1f620 29 20 73 74 61 63 6b 29 29 29 29 29 0a 20 20 20 ) stack))))).
1f630 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f640 28 65 6c 73 65 20 28 6c 70 32 20 28 63 64 72 20 (else (lp2 (cdr
1f650 74 72 61 6e 73 29 20 73 74 61 63 6b 29 29 29 29 trans) stack))))
1f660 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
1f670 28 6e 66 61 2d 65 70 73 69 6c 6f 6e 2d 63 6c 6f (nfa-epsilon-clo
1f680 73 75 72 65 20 6e 66 61 20 73 74 61 74 65 73 29 sure nfa states)
1f690 0a 20 20 28 6f 72 20 28 6e 66 61 2d 67 65 74 2d . (or (nfa-get-
1f6a0 63 6c 6f 73 75 72 65 20 6e 66 61 20 73 74 61 74 closure nfa stat
1f6b0 65 73 29 0a 20 20 20 20 20 20 28 6c 65 74 20 28 es). (let (
1f6c0 28 72 65 73 20 28 6e 66 61 2d 65 70 73 69 6c 6f (res (nfa-epsilo
1f6d0 6e 2d 63 6c 6f 73 75 72 65 2d 69 6e 74 65 72 6e n-closure-intern
1f6e0 61 6c 20 6e 66 61 20 73 74 61 74 65 73 29 29 29 al nfa states)))
1f6f0 0a 20 20 20 20 20 20 20 20 28 6e 66 61 2d 61 64 . (nfa-ad
1f700 64 2d 63 6c 6f 73 75 72 65 21 20 6e 66 61 20 73 d-closure! nfa s
1f710 74 61 74 65 73 20 72 65 73 29 0a 20 20 20 20 20 tates res).
1f720 20 20 20 72 65 73 29 29 29 0a 0a 3b 3b 20 47 65 res)))..;; Ge
1f730 6e 65 72 61 74 65 20 22 73 65 74 22 20 63 6f 6d nerate "set" com
1f740 6d 61 6e 64 73 20 66 6f 72 20 61 6c 6c 20 74 61 mands for all ta
1f750 67 73 20 69 6e 20 74 68 65 20 63 6c 6f 73 75 72 gs in the closur
1f760 65 20 74 68 61 74 20 61 72 65 0a 3b 3b 20 6e 6f e that are.;; no
1f770 74 20 70 72 65 73 65 6e 74 20 69 6e 20 74 68 65 t present in the
1f780 20 6f 72 69 67 69 6e 61 6c 20 73 74 61 74 65 2e original state.
1f790 0a 28 64 65 66 69 6e 65 20 28 74 61 67 2d 73 65 .(define (tag-se
1f7a0 74 2d 63 6f 6d 6d 61 6e 64 73 2d 66 6f 72 2d 63 t-commands-for-c
1f7b0 6c 6f 73 75 72 65 20 6e 66 61 20 6f 72 69 67 2d losure nfa orig-
1f7c0 73 74 61 74 65 20 63 6c 6f 73 75 72 65 20 63 6f state closure co
1f7d0 70 79 2d 63 6d 64 73 29 0a 20 20 28 6c 65 74 20 py-cmds). (let
1f7e0 28 28 6e 75 6d 2d 74 61 67 73 20 28 6e 66 61 2d ((num-tags (nfa-
1f7f0 6e 75 6d 2d 74 61 67 73 20 6e 66 61 29 29 0a 20 num-tags nfa)).
1f800 20 20 20 20 20 20 20 28 63 6c 6f 73 75 72 65 2d (closure-
1f810 73 75 6d 6d 61 72 79 20 28 6d 73 74 2d 6d 61 70 summary (mst-map
1f820 70 69 6e 67 73 2d 73 75 6d 6d 61 72 79 20 63 6c pings-summary cl
1f830 6f 73 75 72 65 29 29 0a 20 20 20 20 20 20 20 20 osure)).
1f840 28 73 74 61 74 65 2d 73 75 6d 6d 61 72 79 20 28 (state-summary (
1f850 6d 73 74 2d 6d 61 70 70 69 6e 67 73 2d 73 75 6d mst-mappings-sum
1f860 6d 61 72 79 20 6f 72 69 67 2d 73 74 61 74 65 29 mary orig-state)
1f870 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 70 20 28 )). (let lp (
1f880 28 74 20 30 29 20 28 63 6d 64 73 20 27 28 29 29 (t 0) (cmds '())
1f890 29 0a 20 20 20 20 20 20 28 69 66 20 28 3d 20 74 ). (if (= t
1f8a0 20 6e 75 6d 2d 74 61 67 73 29 0a 20 20 20 20 20 num-tags).
1f8b0 20 20 20 20 20 63 6d 64 73 0a 20 20 20 20 20 20 cmds.
1f8c0 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 28 73 (let lp2 ((s
1f8d0 31 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6c 1 (vector-ref cl
1f8e0 6f 73 75 72 65 2d 73 75 6d 6d 61 72 79 20 74 29 osure-summary t)
1f8f0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1f900 20 20 20 20 20 20 28 73 32 20 28 76 65 63 74 6f (s2 (vecto
1f910 72 2d 72 65 66 20 73 74 61 74 65 2d 73 75 6d 6d r-ref state-summ
1f920 61 72 79 20 74 29 29 0a 20 20 20 20 20 20 20 20 ary t)).
1f930 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6d 64 (cmd
1f940 73 20 63 6d 64 73 29 29 0a 20 20 20 20 20 20 20 s cmds)).
1f950 20 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c (cond ((nul
1f960 6c 3f 20 73 31 29 20 28 6c 70 20 28 2b 20 74 20 l? s1) (lp (+ t
1f970 31 29 20 63 6d 64 73 29 29 0a 20 20 20 20 20 20 1) cmds)).
1f980 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 ((or
1f990 20 28 6d 65 6d 76 20 28 63 61 72 20 73 31 29 20 (memv (car s1)
1f9a0 73 32 29 20 3b 20 54 61 67 20 69 6e 20 6f 72 69 s2) ; Tag in ori
1f9b0 67 69 6e 61 6c 20 73 74 61 74 65 3f 0a 20 20 20 ginal state?.
1f9c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1f9d0 20 20 20 20 3b 3b 20 54 72 79 20 74 6f 20 61 76 ;; Try to av
1f9e0 6f 69 64 20 67 65 6e 65 72 61 74 69 6e 67 20 73 oid generating s
1f9f0 65 74 2d 63 6f 6d 6d 61 6e 64 73 20 66 6f 72 20 et-commands for
1fa00 61 6e 79 20 73 6c 6f 74 73 0a 20 20 20 20 20 20 any slots.
1fa10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fa20 20 3b 3b 20 74 68 61 74 20 77 69 6c 6c 20 62 65 ;; that will be
1fa30 20 6f 76 65 72 77 72 69 74 74 65 6e 20 62 79 20 overwritten by
1fa40 63 6f 70 79 20 63 6f 6d 6d 61 6e 64 73 2c 20 62 copy commands, b
1fa50 75 74 20 6f 6e 6c 79 0a 20 20 20 20 20 20 20 20 ut only.
1fa60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
1fa70 3b 20 69 66 20 74 68 61 74 20 73 6c 6f 74 20 69 ; if that slot i
1fa80 73 6e 27 74 20 63 6f 70 69 65 64 20 74 6f 20 61 sn't copied to a
1fa90 6e 6f 74 68 65 72 20 73 6c 6f 74 2e 0a 20 20 20 nother slot..
1faa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fab0 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 28 6e (and (not (n
1fac0 75 6c 6c 3f 20 63 6f 70 79 2d 63 6d 64 73 29 29 ull? copy-cmds))
1fad0 20 3b 20 6e 75 6c 6c 20 63 68 65 63 6b 20 66 6f ; null check fo
1fae0 72 20 70 65 72 66 6f 72 6d 61 6e 63 65 0a 20 20 r performance.
1faf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fb00 20 20 20 20 20 20 20 20 20 20 3b 3b 20 4c 6f 6f ;; Loo
1fb10 6b 20 66 6f 72 20 63 6f 70 79 20 63 6f 6d 6d 61 k for copy comma
1fb20 6e 64 20 6f 76 65 72 77 72 69 74 69 6e 67 20 74 nd overwriting t
1fb30 68 69 73 20 74 61 67 2d 73 6c 6f 74 0a 20 20 20 his tag-slot.
1fb40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fb50 20 20 20 20 20 20 20 20 20 28 61 6e 79 20 28 6c (any (l
1fb60 61 6d 62 64 61 20 28 63 29 0a 20 20 20 20 20 20 ambda (c).
1fb70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fb80 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
1fb90 64 20 28 3d 20 28 76 65 63 74 6f 72 2d 72 65 66 d (= (vector-ref
1fba0 20 63 20 30 29 20 74 29 0a 20 20 20 20 20 20 20 c 0) t).
1fbb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fbc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fbd0 20 28 3d 20 28 76 65 63 74 6f 72 2d 72 65 66 20 (= (vector-ref
1fbe0 63 20 32 29 20 28 63 61 72 20 73 31 29 29 29 29 c 2) (car s1))))
1fbf0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1fc00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fc10 20 20 63 6f 70 79 2d 63 6d 64 73 29 0a 20 20 20 copy-cmds).
1fc20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fc30 20 20 20 20 20 20 20 20 20 3b 3b 20 45 6e 73 75 ;; Ensu
1fc40 72 65 20 69 74 27 73 20 6e 6f 74 20 63 6f 70 69 re it's not copi
1fc50 65 64 20 74 6f 20 61 6e 6f 74 68 65 72 20 73 6c ed to another sl
1fc60 6f 74 20 62 65 66 6f 72 65 0a 20 20 20 20 20 20 ot before.
1fc70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fc80 20 20 20 20 20 20 3b 3b 20 64 69 73 63 61 72 64 ;; discard
1fc90 69 6e 67 20 74 68 65 20 73 65 74 2d 63 6f 6d 6d ing the set-comm
1fca0 61 6e 64 2e 0a 20 20 20 20 20 20 20 20 20 20 20 and..
1fcb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fcc0 20 28 6e 6f 74 20 28 61 6e 79 20 28 6c 61 6d 62 (not (any (lamb
1fcd0 64 61 20 28 63 29 0a 20 20 20 20 20 20 20 20 20 da (c).
1fce0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fcf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1fd00 61 6e 64 20 28 3d 20 28 76 65 63 74 6f 72 2d 72 and (= (vector-r
1fd10 65 66 20 63 20 30 29 20 74 29 0a 20 20 20 20 20 ef c 0) t).
1fd20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fd30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fd40 20 20 20 20 20 20 20 20 28 3d 20 28 76 65 63 74 (= (vect
1fd50 6f 72 2d 72 65 66 20 63 20 31 29 20 28 63 61 72 or-ref c 1) (car
1fd60 20 73 31 29 29 29 29 0a 20 20 20 20 20 20 20 20 s1)))).
1fd70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fd80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6f co
1fd90 70 79 2d 63 6d 64 73 29 29 29 29 0a 20 20 20 20 py-cmds)))).
1fda0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1fdb0 6c 70 32 20 28 63 64 72 20 73 31 29 20 73 32 20 lp2 (cdr s1) s2
1fdc0 63 6d 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 cmds)).
1fdd0 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 (else (
1fde0 6c 70 32 20 28 63 64 72 20 73 31 29 20 73 32 0a lp2 (cdr s1) s2.
1fdf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1fe00 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
1fe10 6e 73 20 28 63 6f 6e 73 20 74 20 28 63 61 72 20 ns (cons t (car
1fe20 73 31 29 29 20 63 6d 64 73 29 29 29 29 29 29 29 s1)) cmds)))))))
1fe30 29 29 0a 0a 3b 3b 20 4c 6f 6f 6b 20 69 6e 20 64 ))..;; Look in d
1fe40 66 61 2d 73 74 61 74 65 73 20 66 6f 72 20 61 6e fa-states for an
1fe50 20 61 6c 72 65 61 64 79 20 65 78 69 73 74 69 6e already existin
1fe60 67 20 73 74 61 74 65 20 77 68 69 63 68 20 6d 61 g state which ma
1fe70 74 63 68 65 73 0a 3b 3b 20 63 6c 6f 73 75 72 65 tches.;; closure
1fe80 2c 20 62 75 74 20 68 61 73 20 64 69 66 66 65 72 , but has differ
1fe90 65 6e 74 20 74 61 67 20 76 61 6c 75 65 20 6d 61 ent tag value ma
1fea0 70 70 69 6e 67 73 2e 0a 3b 3b 20 49 66 20 66 6f ppings..;; If fo
1feb0 75 6e 64 2c 20 63 61 6c 63 75 6c 61 74 65 20 72 und, calculate r
1fec0 65 6f 72 64 65 72 69 6e 67 20 63 6f 6d 6d 61 6e eordering comman
1fed0 64 73 20 73 6f 20 77 65 20 63 61 6e 20 6d 61 70 ds so we can map
1fee0 20 74 68 65 20 63 6c 6f 73 75 72 65 0a 3b 3b 20 the closure.;;
1fef0 74 6f 20 74 68 61 74 20 73 74 61 74 65 20 69 6e to that state in
1ff00 73 74 65 61 64 20 6f 66 20 61 64 64 69 6e 67 20 stead of adding
1ff10 61 20 6e 65 77 20 44 46 41 20 73 74 61 74 65 2e a new DFA state.
1ff20 0a 3b 3b 20 54 68 69 73 20 69 73 20 63 6f 6d 70 .;; This is comp
1ff30 6c 65 74 65 6c 79 20 68 61 6e 64 77 61 76 65 64 letely handwaved
1ff40 20 61 77 61 79 20 69 6e 20 4c 61 75 72 69 6b 61 away in Laurika
1ff50 72 69 27 73 20 70 61 70 65 72 20 28 69 74 20 62 ri's paper (it b
1ff60 61 73 69 63 61 6c 6c 79 0a 3b 3b 20 73 61 79 73 asically.;; says
1ff70 20 22 69 6e 73 65 72 74 20 72 65 6f 72 64 65 72 "insert reorder
1ff80 69 6e 67 20 61 6c 67 6f 72 69 74 68 6d 20 68 65 ing algorithm he
1ff90 72 65 22 29 2c 20 73 6f 20 74 68 69 73 20 63 6f re"), so this co
1ffa0 64 65 20 77 61 73 20 63 6f 6e 73 74 72 75 63 74 de was construct
1ffb0 65 64 0a 3b 3b 20 61 66 74 65 72 20 73 6f 6d 65 ed.;; after some
1ffc0 20 65 78 70 65 72 69 6d 65 6e 74 61 74 69 6f 6e experimentation
1ffd0 2e 20 20 49 6e 20 6f 74 68 65 72 20 77 6f 72 64 . In other word
1ffe0 73 2c 20 62 75 67 73 20 62 65 20 68 65 72 65 2e s, bugs be here.
1fff0 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 2d 72 .(define (find-r
20000 65 6f 72 64 65 72 2d 63 6f 6d 6d 61 6e 64 73 2d eorder-commands-
20010 69 6e 74 65 72 6e 61 6c 20 6e 66 61 20 63 6c 6f internal nfa clo
20020 73 75 72 65 20 64 66 61 2d 73 74 61 74 65 73 29 sure dfa-states)
20030 0a 20 20 28 6c 65 74 20 28 28 6e 75 6d 2d 74 61 . (let ((num-ta
20040 67 73 20 28 6e 66 61 2d 6e 75 6d 2d 74 61 67 73 gs (nfa-num-tags
20050 20 6e 66 61 29 29 0a 20 20 20 20 20 20 20 20 28 nfa)). (
20060 63 6c 6f 73 75 72 65 2d 73 75 6d 6d 61 72 79 20 closure-summary
20070 28 6d 73 74 2d 6d 61 70 70 69 6e 67 73 2d 73 75 (mst-mappings-su
20080 6d 6d 61 72 79 20 63 6c 6f 73 75 72 65 29 29 29 mmary closure)))
20090 0a 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 64 . (let lp ((d
200a0 66 61 2d 73 74 61 74 65 73 20 64 66 61 2d 73 74 fa-states dfa-st
200b0 61 74 65 73 29 29 0a 20 20 20 20 20 20 28 69 66 ates)). (if
200c0 20 28 6e 75 6c 6c 3f 20 64 66 61 2d 73 74 61 74 (null? dfa-stat
200d0 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 23 66 es). #f
200e0 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 . (if (
200f0 6e 6f 74 20 28 6d 73 74 2d 73 61 6d 65 2d 73 74 not (mst-same-st
20100 61 74 65 73 3f 20 28 63 61 61 72 20 64 66 61 2d ates? (caar dfa-
20110 73 74 61 74 65 73 29 20 63 6c 6f 73 75 72 65 29 states) closure)
20120 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
20130 28 6c 70 20 28 63 64 72 20 64 66 61 2d 73 74 61 (lp (cdr dfa-sta
20140 74 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 tes)).
20150 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 28 73 (let lp2 ((s
20160 74 61 74 65 2d 73 75 6d 6d 61 72 79 20 28 6d 73 tate-summary (ms
20170 74 2d 6d 61 70 70 69 6e 67 73 2d 73 75 6d 6d 61 t-mappings-summa
20180 72 79 20 28 63 61 61 72 20 64 66 61 2d 73 74 61 ry (caar dfa-sta
20190 74 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 tes))).
201a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
201b0 74 20 30 29 20 28 63 6d 64 73 20 27 28 29 29 29 t 0) (cmds '()))
201c0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
201d0 20 28 69 66 20 28 3d 20 74 20 6e 75 6d 2d 74 61 (if (= t num-ta
201e0 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 gs).
201f0 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 (cons (c
20200 61 61 72 20 64 66 61 2d 73 74 61 74 65 73 29 20 aar dfa-states)
20210 63 6d 64 73 29 0a 20 20 20 20 20 20 20 20 20 20 cmds).
20220 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c (let l
20230 70 33 20 28 28 63 6c 6f 73 75 72 65 2d 73 6c 6f p3 ((closure-slo
20240 74 73 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 ts (vector-ref c
20250 6c 6f 73 75 72 65 2d 73 75 6d 6d 61 72 79 20 74 losure-summary t
20260 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
20270 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20280 20 28 73 74 61 74 65 2d 73 6c 6f 74 73 20 28 76 (state-slots (v
20290 65 63 74 6f 72 2d 72 65 66 20 73 74 61 74 65 2d ector-ref state-
202a0 73 75 6d 6d 61 72 79 20 74 29 29 0a 20 20 20 20 summary t)).
202b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
202c0 20 20 20 20 20 20 20 20 20 20 28 63 6d 64 73 20 (cmds
202d0 63 6d 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 cmds)).
202e0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
202f0 6e 64 20 28 28 6e 75 6c 6c 3f 20 63 6c 6f 73 75 nd ((null? closu
20300 72 65 2d 73 6c 6f 74 73 29 0a 20 20 20 20 20 20 re-slots).
20310 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20320 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
20330 3f 20 73 74 61 74 65 2d 73 6c 6f 74 73 29 0a 20 ? state-slots).
20340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20360 28 6c 70 32 20 73 74 61 74 65 2d 73 75 6d 6d 61 (lp2 state-summa
20370 72 79 20 28 2b 20 74 20 31 29 20 63 6d 64 73 29 ry (+ t 1) cmds)
20380 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
20390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
203a0 20 20 28 6c 70 20 28 63 64 72 20 64 66 61 2d 73 (lp (cdr dfa-s
203b0 74 61 74 65 73 29 29 29 29 0a 20 20 20 20 20 20 tates)))).
203c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
203d0 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 73 74 ((null? st
203e0 61 74 65 2d 73 6c 6f 74 73 29 20 28 6c 70 20 28 ate-slots) (lp (
203f0 63 64 72 20 64 66 61 2d 73 74 61 74 65 73 29 29 cdr dfa-states))
20400 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
20410 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
20420 6c 73 65 20 28 6c 70 33 20 28 63 64 72 20 63 6c lse (lp3 (cdr cl
20430 6f 73 75 72 65 2d 73 6c 6f 74 73 29 0a 20 20 20 osure-slots).
20440 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20450 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20460 20 20 20 20 28 63 64 72 20 73 74 61 74 65 2d 73 (cdr state-s
20470 6c 6f 74 73 29 0a 20 20 20 20 20 20 20 20 20 20 lots).
20480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20490 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
204a0 20 28 3d 20 28 63 61 72 20 63 6c 6f 73 75 72 65 (= (car closure
204b0 2d 73 6c 6f 74 73 29 20 28 63 61 72 20 73 74 61 -slots) (car sta
204c0 74 65 2d 73 6c 6f 74 73 29 29 0a 20 20 20 20 20 te-slots)).
204d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
204e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
204f0 20 20 20 20 20 20 63 6d 64 73 0a 20 20 20 20 20 cmds.
20500 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20510 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20520 20 20 20 20 20 20 28 63 6f 6e 73 20 28 76 65 63 (cons (vec
20530 74 6f 72 20 74 20 28 63 61 72 20 63 6c 6f 73 75 tor t (car closu
20540 72 65 2d 73 6c 6f 74 73 29 20 28 63 61 72 20 73 re-slots) (car s
20550 74 61 74 65 2d 73 6c 6f 74 73 29 29 0a 20 20 20 tate-slots)).
20560 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20570 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20580 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6d cm
20590 64 73 29 29 29 29 29 29 29 29 29 29 29 29 29 0a ds))))))))))))).
205a0 0a 28 64 65 66 69 6e 65 20 28 66 69 6e 64 2d 72 .(define (find-r
205b0 65 6f 72 64 65 72 2d 63 6f 6d 6d 61 6e 64 73 20 eorder-commands
205c0 6e 66 61 20 63 6c 6f 73 75 72 65 20 64 66 61 2d nfa closure dfa-
205d0 73 74 61 74 65 73 29 0a 20 20 28 6f 72 20 28 6e states). (or (n
205e0 66 61 2d 67 65 74 2d 72 65 6f 72 64 65 72 2d 63 fa-get-reorder-c
205f0 6f 6d 6d 61 6e 64 73 20 6e 66 61 20 63 6c 6f 73 ommands nfa clos
20600 75 72 65 29 0a 20 20 20 20 20 20 28 6c 65 74 20 ure). (let
20610 28 28 72 65 73 20 28 66 69 6e 64 2d 72 65 6f 72 ((res (find-reor
20620 64 65 72 2d 63 6f 6d 6d 61 6e 64 73 2d 69 6e 74 der-commands-int
20630 65 72 6e 61 6c 20 6e 66 61 20 63 6c 6f 73 75 72 ernal nfa closur
20640 65 20 64 66 61 2d 73 74 61 74 65 73 29 29 29 0a e dfa-states))).
20650 20 20 20 20 20 20 20 20 28 6e 66 61 2d 73 65 74 (nfa-set
20660 2d 72 65 6f 72 64 65 72 2d 63 6f 6d 6d 61 6e 64 -reorder-command
20670 73 21 20 6e 66 61 20 63 6c 6f 73 75 72 65 20 72 s! nfa closure r
20680 65 73 29 0a 20 20 20 20 20 20 20 20 72 65 73 29 es). res)
20690 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ))..;;;;;;;;;;;;
206a0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
206b0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
206c0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
206d0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 3b ;;;;;;;;;;;;.;;;
206e0 3b 20 43 6c 6f 73 75 72 65 20 43 6f 6d 70 69 6c ; Closure Compil
206f0 61 74 69 6f 6e 0a 3b 3b 0a 3b 3b 20 57 65 20 75 ation.;;.;; We u
20700 73 65 20 74 68 69 73 20 66 6f 72 20 6e 6f 6e 2d se this for non-
20710 72 65 67 75 6c 61 72 20 65 78 70 72 65 73 73 69 regular expressi
20720 6f 6e 73 20 69 6e 73 74 65 61 64 20 6f 66 20 61 ons instead of a
20730 6e 20 69 6e 74 65 72 70 72 65 74 65 64 0a 3b 3b n interpreted.;;
20740 20 4e 46 41 20 6d 61 74 63 68 65 72 2e 20 20 57 NFA matcher. W
20750 65 20 75 73 65 20 62 61 63 6b 74 72 61 63 6b 69 e use backtracki
20760 6e 67 20 61 6e 79 77 61 79 2c 20 62 75 74 20 74 ng anyway, but t
20770 68 69 73 20 67 69 76 65 73 20 75 73 20 6d 6f 72 his gives us mor
20780 65 0a 3b 3b 20 66 72 65 65 64 6f 6d 20 6f 66 20 e.;; freedom of
20790 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 2c 20 implementation,
207a0 61 6c 6c 6f 77 69 6e 67 20 75 73 20 74 6f 20 73 allowing us to s
207b0 75 70 70 6f 72 74 20 70 61 74 74 65 72 6e 73 20 upport patterns
207c0 74 68 61 74 0a 3b 3b 20 63 61 6e 27 74 20 62 65 that.;; can't be
207d0 20 72 65 70 72 65 73 65 6e 74 65 64 20 69 6e 20 represented in
207e0 74 68 65 20 61 62 6f 76 65 20 4e 46 41 20 72 65 the above NFA re
207f0 70 72 65 73 65 6e 74 61 74 69 6f 6e 2e 0a 0a 28 presentation...(
20800 64 65 66 69 6e 65 20 28 73 72 65 2d 3e 70 72 6f define (sre->pro
20810 63 65 64 75 72 65 20 73 72 65 20 2e 20 6f 29 0a cedure sre . o).
20820 20 20 28 64 65 66 69 6e 65 20 6e 61 6d 65 73 0a (define names.
20830 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 70 61 (if (and (pa
20840 69 72 3f 20 6f 29 20 28 70 61 69 72 3f 20 28 63 ir? o) (pair? (c
20850 64 72 20 6f 29 29 29 20 28 63 61 64 72 20 6f 29 dr o))) (cadr o)
20860 20 28 73 72 65 2d 6e 61 6d 65 73 20 73 72 65 20 (sre-names sre
20870 31 20 27 28 29 29 29 29 0a 20 20 28 6c 65 74 20 1 '()))). (let
20880 6c 70 20 28 28 73 72 65 20 73 72 65 29 0a 20 20 lp ((sre sre).
20890 20 20 20 20 20 20 20 20 20 28 6e 20 31 29 0a 20 (n 1).
208a0 20 20 20 20 20 20 20 20 20 20 28 66 6c 61 67 73 (flags
208b0 20 28 69 66 20 28 70 61 69 72 3f 20 6f 29 20 28 (if (pair? o) (
208c0 63 61 72 20 6f 29 20 7e 6e 6f 6e 65 29 29 0a 20 car o) ~none)).
208d0 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
208e0 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 (lambda (cnk ini
208f0 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
20900 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 matches fail).
20910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20920 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
20930 73 74 61 72 74 2d 63 68 75 6e 6b 2d 73 65 74 21 start-chunk-set!
20940 20 6d 61 74 63 68 65 73 20 30 20 28 63 61 72 20 matches 0 (car
20950 69 6e 69 74 29 29 0a 20 20 20 20 20 20 20 20 20 init)).
20960 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 67 (irreg
20970 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 ex-match-start-i
20980 6e 64 65 78 2d 73 65 74 21 20 6d 61 74 63 68 65 ndex-set! matche
20990 73 20 30 20 28 63 64 72 20 69 6e 69 74 29 29 0a s 0 (cdr init)).
209a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
209b0 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
209c0 68 2d 65 6e 64 2d 63 68 75 6e 6b 2d 73 65 74 21 h-end-chunk-set!
209d0 20 6d 61 74 63 68 65 73 20 30 20 73 72 63 29 0a matches 0 src).
209e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
209f0 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
20a00 68 2d 65 6e 64 2d 69 6e 64 65 78 2d 73 65 74 21 h-end-index-set!
20a10 20 6d 61 74 63 68 65 73 20 30 20 69 29 0a 20 20 matches 0 i).
20a20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20a30 20 28 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (%irregex-match
20a40 2d 66 61 69 6c 2d 73 65 74 21 20 6d 61 74 63 68 -fail-set! match
20a50 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
20a60 20 20 20 20 20 20 20 20 20 20 20 20 6d 61 74 63 matc
20a70 68 65 73 29 29 29 0a 20 20 20 20 3b 3b 20 58 58 hes))). ;; XX
20a80 58 58 20 74 68 69 73 20 73 68 6f 75 6c 64 20 62 XX this should b
20a90 65 20 69 6e 6c 69 6e 65 64 0a 20 20 20 20 28 64 e inlined. (d
20aa0 65 66 69 6e 65 20 28 72 65 63 20 73 72 65 29 20 efine (rec sre)
20ab0 28 6c 70 20 73 72 65 20 6e 20 66 6c 61 67 73 20 (lp sre n flags
20ac0 6e 65 78 74 29 29 0a 20 20 20 20 28 63 6f 6e 64 next)). (cond
20ad0 0a 20 20 20 20 20 28 28 70 61 69 72 3f 20 73 72 . ((pair? sr
20ae0 65 29 0a 20 20 20 20 20 20 28 69 66 20 28 73 74 e). (if (st
20af0 72 69 6e 67 3f 20 28 63 61 72 20 73 72 65 29 29 ring? (car sre))
20b00 0a 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d . (sre-
20b10 63 73 65 74 2d 3e 70 72 6f 63 65 64 75 72 65 0a cset->procedure.
20b20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d (sre-
20b30 3e 63 73 65 74 20 28 63 61 72 20 73 72 65 29 20 >cset (car sre)
20b40 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 (flag-set? flags
20b50 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 ~case-insensiti
20b60 76 65 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 ve?)).
20b70 20 6e 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 next).
20b80 20 28 63 61 73 65 20 28 63 61 72 20 73 72 65 29 (case (car sre)
20b90 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 7e . ((~
20ba0 20 2d 20 26 20 2f 29 0a 20 20 20 20 20 20 20 20 - & /).
20bb0 20 20 20 20 20 28 73 72 65 2d 63 73 65 74 2d 3e (sre-cset->
20bc0 70 72 6f 63 65 64 75 72 65 0a 20 20 20 20 20 20 procedure.
20bd0 20 20 20 20 20 20 20 20 28 73 72 65 2d 3e 63 73 (sre->cs
20be0 65 74 20 73 72 65 20 28 66 6c 61 67 2d 73 65 74 et sre (flag-set
20bf0 3f 20 66 6c 61 67 73 20 7e 63 61 73 65 2d 69 6e ? flags ~case-in
20c00 73 65 6e 73 69 74 69 76 65 3f 29 29 0a 20 20 20 sensitive?)).
20c10 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 29 next)
20c20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
20c30 6f 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 or).
20c40 20 28 63 61 73 65 20 28 6c 65 6e 67 74 68 20 28 (case (length (
20c50 63 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 cdr sre)).
20c60 20 20 20 20 20 20 20 20 20 28 28 30 29 20 28 6c ((0) (l
20c70 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 ambda (cnk init
20c80 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
20c90 74 63 68 65 73 20 66 61 69 6c 29 20 28 66 61 69 tches fail) (fai
20ca0 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 l))).
20cb0 20 20 20 20 28 28 31 29 20 28 72 65 63 20 28 63 ((1) (rec (c
20cc0 61 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 adr sre))).
20cd0 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
20ce0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20cf0 28 6c 65 74 2a 20 28 28 66 69 72 73 74 20 28 72 (let* ((first (r
20d00 65 63 20 28 63 61 64 72 20 73 72 65 29 29 29 0a ec (cadr sre))).
20d10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20d20 20 20 20 20 20 20 20 28 72 65 73 74 20 28 6c 70 (rest (lp
20d30 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 (sre-alternate
20d40 28 63 64 64 72 20 73 72 65 29 29 0a 20 20 20 20 (cddr sre)).
20d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20d60 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 (+
20d70 6e 20 28 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 n (sre-count-sub
20d80 6d 61 74 63 68 65 73 20 28 63 61 64 72 20 73 72 matches (cadr sr
20d90 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 e))).
20da0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20db0 20 20 20 20 20 20 66 6c 61 67 73 0a 20 20 20 20 flags.
20dc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20dd0 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 nex
20de0 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
20df0 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
20e00 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
20e10 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 i end matches f
20e20 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
20e30 20 20 20 20 20 20 20 20 20 28 66 69 72 73 74 20 (first
20e40 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
20e50 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 i end matches.
20e60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20e70 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
20e80 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 a ().
20e90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
20ea0 20 20 28 72 65 73 74 20 63 6e 6b 20 69 6e 69 74 (rest cnk init
20eb0 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
20ec0 61 74 63 68 65 73 20 66 61 69 6c 29 29 29 29 29 atches fail)))))
20ed0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
20ee0 28 28 77 2f 63 61 73 65 29 0a 20 20 20 20 20 20 ((w/case).
20ef0 20 20 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d (lp (sre-
20f00 73 65 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 sequence (cdr sr
20f10 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e)).
20f20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 20 20 n.
20f30 20 20 20 20 20 20 20 20 28 66 6c 61 67 2d 63 6c (flag-cl
20f40 65 61 72 20 66 6c 61 67 73 20 7e 63 61 73 65 2d ear flags ~case-
20f50 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 0a 20 20 insensitive?).
20f60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
20f70 65 78 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 ext)).
20f80 20 20 28 28 77 2f 6e 6f 63 61 73 65 29 0a 20 20 ((w/nocase).
20f90 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
20fa0 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
20fb0 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
20fc0 20 20 20 20 20 20 20 20 20 6e 0a 20 20 20 20 20 n.
20fd0 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6c 61 (fla
20fe0 67 2d 6a 6f 69 6e 20 66 6c 61 67 73 20 7e 63 61 g-join flags ~ca
20ff0 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 se-insensitive?)
21000 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
21010 20 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 next)).
21020 20 20 20 20 20 28 28 77 2f 75 74 66 38 29 0a 20 ((w/utf8).
21030 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
21040 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 (sre-sequence (c
21050 64 72 20 73 72 65 29 29 20 6e 20 28 66 6c 61 67 dr sre)) n (flag
21060 2d 6a 6f 69 6e 20 66 6c 61 67 73 20 7e 75 74 66 -join flags ~utf
21070 38 3f 29 20 6e 65 78 74 29 29 0a 20 20 20 20 20 8?) next)).
21080 20 20 20 20 20 20 20 28 28 77 2f 6e 6f 75 74 66 ((w/noutf
21090 38 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 8).
210a0 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 (lp (sre-sequenc
210b0 65 20 28 63 64 72 20 73 72 65 29 29 20 6e 20 28 e (cdr sre)) n (
210c0 66 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 73 flag-clear flags
210d0 20 7e 75 74 66 38 3f 29 20 6e 65 78 74 29 29 0a ~utf8?) next)).
210e0 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 65 ((se
210f0 71 20 3a 29 0a 20 20 20 20 20 20 20 20 20 20 20 q :).
21100 20 20 28 63 61 73 65 20 28 6c 65 6e 67 74 68 20 (case (length
21110 28 63 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 (cdr sre)).
21120 20 20 20 20 20 20 20 20 20 20 28 28 30 29 20 6e ((0) n
21130 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ext).
21140 20 20 20 20 28 28 31 29 20 28 72 65 63 20 28 63 ((1) (rec (c
21150 61 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 adr sre))).
21160 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
21170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21180 28 6c 65 74 20 28 28 72 65 73 74 20 28 6c 70 20 (let ((rest (lp
21190 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 (sre-sequence (c
211a0 64 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 ddr sre)).
211b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
211c0 20 20 20 20 20 20 20 20 20 20 28 2b 20 6e 20 28 (+ n (
211d0 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 sre-count-submat
211e0 63 68 65 73 20 28 63 61 64 72 20 73 72 65 29 29 ches (cadr sre))
211f0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
21200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21210 20 20 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 flags.
21220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21230 20 20 20 20 20 20 20 20 6e 65 78 74 29 29 29 0a next))).
21240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21250 20 20 28 6c 70 20 28 63 61 64 72 20 73 72 65 29 (lp (cadr sre)
21260 20 6e 20 66 6c 61 67 73 20 72 65 73 74 29 29 29 n flags rest)))
21270 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
21280 28 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 (?).
21290 20 28 6c 65 74 20 28 28 62 6f 64 79 20 28 72 65 (let ((body (re
212a0 63 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 c (sre-sequence
212b0 28 63 64 72 20 73 72 65 29 29 29 29 29 0a 20 20 (cdr sre))))).
212c0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
212d0 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 mbda (cnk init s
212e0 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
212f0 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
21300 20 20 20 20 20 20 20 20 20 20 20 20 28 62 6f 64 (bod
21310 79 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 y cnk init src s
21320 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
21330 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
21340 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
21350 28 29 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 () (next cnk ini
21360 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
21370 6d 61 74 63 68 65 73 20 66 61 69 6c 29 29 29 29 matches fail))))
21380 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
21390 28 3f 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 (??).
213a0 20 20 28 6c 65 74 20 28 28 62 6f 64 79 20 28 72 (let ((body (r
213b0 65 63 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 ec (sre-sequence
213c0 20 28 63 64 72 20 73 72 65 29 29 29 29 29 0a 20 (cdr sre))))).
213d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
213e0 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 ambda (cnk init
213f0 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
21400 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 tches fail).
21410 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
21420 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 xt cnk init src
21430 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
21440 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
21450 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
21460 20 28 29 20 28 62 6f 64 79 20 63 6e 6b 20 69 6e () (body cnk in
21470 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
21480 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 29 29 matches fail)))
21490 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
214a0 28 28 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 ((*).
214b0 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
214c0 20 20 20 20 20 20 28 28 73 72 65 2d 65 6d 70 74 ((sre-empt
214d0 79 3f 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 y? (sre-sequence
214e0 20 28 63 64 72 20 73 72 65 29 29 29 0a 20 20 20 (cdr sre))).
214f0 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err
21500 6f 72 20 22 69 6e 76 61 6c 69 64 20 73 72 65 3a or "invalid sre:
21510 20 65 6d 70 74 79 20 2a 22 20 73 72 65 29 29 0a empty *" sre)).
21520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
21530 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
21540 20 20 20 28 6c 65 74 20 28 28 62 6f 64 79 20 28 (let ((body (
21550 72 65 63 20 28 6c 69 73 74 20 27 2b 20 28 73 72 rec (list '+ (sr
21560 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 72 20 e-sequence (cdr
21570 73 72 65 29 29 29 29 29 29 0a 20 20 20 20 20 20 sre)))))).
21580 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
21590 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 da (cnk init src
215a0 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
215b0 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
215c0 20 20 20 20 20 20 20 20 20 20 20 20 28 62 6f 64 (bod
215d0 79 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 y cnk init src s
215e0 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
215f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
21600 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
21610 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 a ().
21620 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21630 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 (next cnk init s
21640 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
21650 63 68 65 73 20 66 61 69 6c 29 29 29 29 29 29 29 ches fail)))))))
21660 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
21670 2a 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 *?).
21680 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond.
21690 20 20 20 20 20 28 28 73 72 65 2d 65 6d 70 74 79 ((sre-empty
216a0 3f 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 ? (sre-sequence
216b0 28 63 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 (cdr sre))).
216c0 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro
216d0 72 20 22 69 6e 76 61 6c 69 64 20 73 72 65 3a 20 r "invalid sre:
216e0 65 6d 70 74 79 20 2a 3f 22 20 73 72 65 29 29 0a empty *?" sre)).
216f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
21700 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
21710 20 20 20 28 6c 65 74 72 65 63 0a 20 20 20 20 20 (letrec.
21720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
21730 62 6f 64 79 0a 20 20 20 20 20 20 20 20 20 20 20 body.
21740 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 73 (lp (s
21750 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 72 re-sequence (cdr
21760 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
21770 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21780 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
21790 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 flags
217a0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
217b0 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
217c0 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 a (cnk init src
217d0 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
217e0 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
217f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21800 20 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 (next cnk ini
21810 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
21820 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 matches.
21830 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21840 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
21850 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ().
21860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21870 20 20 20 20 20 20 20 28 62 6f 64 79 20 63 6e 6b (body cnk
21880 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
21890 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
218a0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
218b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
218c0 20 20 20 20 20 29 29 29 29 29 29 0a 20 20 20 20 )))))).
218d0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
218e0 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 mbda (cnk init s
218f0 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
21900 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
21910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e (n
21920 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 ext cnk init src
21930 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
21940 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 es.
21950 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
21960 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 20 bda ().
21970 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21980 20 20 28 62 6f 64 79 20 63 6e 6b 20 69 6e 69 74 (body cnk init
21990 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
219a0 61 74 63 68 65 73 20 66 61 69 6c 29 29 29 29 29 atches fail)))))
219b0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
219c0 28 28 2b 29 0a 20 20 20 20 20 20 20 20 20 20 20 ((+).
219d0 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
219e0 20 20 20 20 20 20 28 28 73 72 65 2d 65 6d 70 74 ((sre-empt
219f0 79 3f 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 y? (sre-sequence
21a00 20 28 63 64 72 20 73 72 65 29 29 29 0a 20 20 20 (cdr sre))).
21a10 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err
21a20 6f 72 20 22 69 6e 76 61 6c 69 64 20 73 72 65 3a or "invalid sre:
21a30 20 65 6d 70 74 79 20 2b 22 20 73 72 65 29 29 0a empty +" sre)).
21a40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
21a50 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 lse.
21a60 20 20 20 28 6c 65 74 72 65 63 0a 20 20 20 20 20 (letrec.
21a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
21a80 62 6f 64 79 0a 20 20 20 20 20 20 20 20 20 20 20 body.
21a90 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 73 (lp (s
21aa0 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 72 re-sequence (cdr
21ab0 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
21ac0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21ad0 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
21ae0 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 flags
21af0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
21b00 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
21b10 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 a (cnk init src
21b20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
21b30 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
21b40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21b50 20 20 20 28 62 6f 64 79 20 63 6e 6b 20 69 6e 69 (body cnk ini
21b60 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
21b70 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 matches.
21b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21b90 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
21ba0 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ().
21bb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21bc0 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e 6b (next cnk
21bd0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
21be0 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
21bf0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
21c00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21c10 20 20 20 20 20 29 29 29 29 29 29 0a 20 20 20 20 )))))).
21c20 20 20 20 20 20 20 20 20 20 20 20 20 20 62 6f 64 bod
21c30 79 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 y)))).
21c40 20 20 28 28 3d 29 0a 20 20 20 20 20 20 20 20 20 ((=).
21c50 20 20 20 20 28 72 65 63 20 60 28 2a 2a 20 2c 28 (rec `(** ,(
21c60 63 61 64 72 20 73 72 65 29 20 2c 28 63 61 64 72 cadr sre) ,(cadr
21c70 20 73 72 65 29 20 2c 40 28 63 64 64 72 20 73 72 sre) ,@(cddr sr
21c80 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 e)))).
21c90 20 20 28 28 3e 3d 29 0a 20 20 20 20 20 20 20 20 ((>=).
21ca0 20 20 20 20 20 28 72 65 63 20 60 28 2a 2a 20 2c (rec `(** ,
21cb0 28 63 61 64 72 20 73 72 65 29 20 23 66 20 2c 40 (cadr sre) #f ,@
21cc0 28 63 64 64 72 20 73 72 65 29 29 29 29 0a 20 20 (cddr sre)))).
21cd0 20 20 20 20 20 20 20 20 20 20 28 28 2a 2a 29 0a ((**).
21ce0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
21cf0 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
21d00 20 28 28 6f 72 20 28 61 6e 64 20 28 6e 75 6d 62 ((or (and (numb
21d10 65 72 3f 20 28 63 61 64 72 20 73 72 65 29 29 0a er? (cadr sre)).
21d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21d30 20 20 20 20 20 20 20 20 28 6e 75 6d 62 65 72 3f (number?
21d40 20 28 63 61 64 64 72 20 73 72 65 29 29 0a 20 20 (caddr sre)).
21d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21d60 20 20 20 20 20 20 28 3e 20 28 63 61 64 72 20 73 (> (cadr s
21d70 72 65 29 20 28 63 61 64 64 72 20 73 72 65 29 29 re) (caddr sre))
21d80 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
21d90 20 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 28 (and (not (
21da0 63 61 64 72 20 73 72 65 29 29 20 28 63 61 64 64 cadr sre)) (cadd
21db0 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 r sre))).
21dc0 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
21dd0 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 (cnk init src st
21de0 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 r i end matches
21df0 66 61 69 6c 29 20 28 66 61 69 6c 29 29 29 0a 20 fail) (fail))).
21e00 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
21e10 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
21e20 20 20 28 6c 65 74 72 65 63 0a 20 20 20 20 20 20 (letrec.
21e30 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 66 ((f
21e40 72 6f 6d 20 28 63 61 64 72 20 73 72 65 29 29 0a rom (cadr sre)).
21e50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21e60 20 20 20 20 28 74 6f 20 28 63 61 64 64 72 20 73 (to (caddr s
21e70 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 re)).
21e80 20 20 20 20 20 20 20 20 20 28 62 6f 64 79 2d 63 (body-c
21e90 6f 6e 74 65 6e 74 73 20 28 73 72 65 2d 73 65 71 ontents (sre-seq
21ea0 75 65 6e 63 65 20 28 63 64 64 64 72 20 73 72 65 uence (cdddr sre
21eb0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
21ec0 20 20 20 20 20 20 20 20 28 62 6f 64 79 0a 20 20 (body.
21ed0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21ee0 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6f 75 6e (lambda (coun
21ef0 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
21f00 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 62 6f (lp bo
21f10 64 79 2d 63 6f 6e 74 65 6e 74 73 0a 20 20 20 20 dy-contents.
21f20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f30 20 20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 n.
21f40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f50 20 20 20 20 66 6c 61 67 73 0a 20 20 20 20 20 20 flags.
21f60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21f70 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e (lambda (cn
21f80 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
21f90 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 end matches fai
21fa0 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
21fb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21fc0 28 69 66 20 28 61 6e 64 20 74 6f 20 28 3d 20 63 (if (and to (= c
21fd0 6f 75 6e 74 20 74 6f 29 29 0a 20 20 20 20 20 20 ount to)).
21fe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21ff0 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 (next
22000 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 cnk init src st
22010 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 r i end matches
22020 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
22030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22040 20 20 20 20 20 20 20 28 28 62 6f 64 79 20 28 2b ((body (+
22050 20 31 20 63 6f 75 6e 74 29 29 0a 20 20 20 20 20 1 count)).
22060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22070 20 20 20 20 20 20 20 20 20 20 20 20 20 63 6e 6b cnk
22080 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
22090 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 20 20 20 end matches.
220a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
220b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
220c0 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
220d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
220e0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
220f0 20 28 3e 3d 20 63 6f 75 6e 74 20 66 72 6f 6d 29 (>= count from)
22100 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
22110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22120 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 (next c
22130 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
22140 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
22150 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 il).
22160 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22170 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 (fai
22180 6c 29 29 29 29 29 29 29 29 29 29 0a 20 20 20 20 l)))))))))).
22190 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
221a0 20 28 61 6e 64 20 28 7a 65 72 6f 3f 20 66 72 6f (and (zero? fro
221b0 6d 29 20 74 6f 20 28 7a 65 72 6f 3f 20 74 6f 29 m) to (zero? to)
221c0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
221d0 20 20 20 20 20 20 20 6e 65 78 74 0a 20 20 20 20 next.
221e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
221f0 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e (lambda (cnk in
22200 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
22210 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 matches fail).
22220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22230 20 20 20 20 20 20 28 28 62 6f 64 79 20 31 29 20 ((body 1)
22240 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
22250 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 i end matches.
22260 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22270 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
22280 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
22290 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
222a0 28 7a 65 72 6f 3f 20 66 72 6f 6d 29 0a 20 20 20 (zero? from).
222b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
222c0 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 (next
222d0 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 cnk init src st
222e0 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 r i end matches
222f0 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
22300 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22310 20 20 20 20 28 66 61 69 6c 29 29 29 29 29 29 29 (fail)))))))
22320 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
22330 28 28 2a 2a 3f 29 0a 20 20 20 20 20 20 20 20 20 ((**?).
22340 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
22350 20 20 20 20 20 20 20 20 28 28 6f 72 20 28 61 6e ((or (an
22360 64 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 72 d (number? (cadr
22370 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
22380 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
22390 6e 75 6d 62 65 72 3f 20 28 63 61 64 64 72 20 73 number? (caddr s
223a0 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 re)).
223b0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3e 20 (>
223c0 28 63 61 64 72 20 73 72 65 29 20 28 63 61 64 64 (cadr sre) (cadd
223d0 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 r sre))).
223e0 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
223f0 20 28 6e 6f 74 20 28 63 61 64 72 20 73 72 65 29 (not (cadr sre)
22400 29 20 28 63 61 64 64 72 20 73 72 65 29 29 29 0a ) (caddr sre))).
22410 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
22420 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
22430 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
22440 61 74 63 68 65 73 20 66 61 69 6c 29 20 28 66 61 atches fail) (fa
22450 69 6c 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 il))).
22460 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
22470 20 20 20 20 20 20 20 20 20 28 6c 65 74 72 65 63 (letrec
22480 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
22490 20 20 20 20 28 28 66 72 6f 6d 20 28 63 61 64 72 ((from (cadr
224a0 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
224b0 20 20 20 20 20 20 20 20 20 20 20 28 74 6f 20 28 (to (
224c0 63 61 64 64 72 20 73 72 65 29 29 0a 20 20 20 20 caddr sre)).
224d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
224e0 28 62 6f 64 79 2d 63 6f 6e 74 65 6e 74 73 20 28 (body-contents (
224f0 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
22500 64 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 ddr sre))).
22510 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
22520 62 6f 64 79 0a 20 20 20 20 20 20 20 20 20 20 20 body.
22530 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
22540 61 20 28 63 6f 75 6e 74 29 0a 20 20 20 20 20 20 a (count).
22550 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22560 20 28 6c 70 20 62 6f 64 79 2d 63 6f 6e 74 65 6e (lp body-conten
22570 74 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ts.
22580 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 0a n.
22590 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
225a0 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 flags
225b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
225c0 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
225d0 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 bda (cnk init sr
225e0 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 c str i end matc
225f0 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 hes fail).
22600 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22610 20 20 20 20 20 20 20 28 69 66 20 28 3c 20 63 6f (if (< co
22620 75 6e 74 20 66 72 6f 6d 29 0a 20 20 20 20 20 20 unt from).
22630 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22640 20 20 20 20 20 20 20 20 20 20 20 28 28 62 6f 64 ((bod
22650 79 20 28 2b 20 31 20 63 6f 75 6e 74 29 29 20 63 y (+ 1 count)) c
22660 6e 6b 20 69 6e 69 74 0a 20 20 20 20 20 20 20 20 nk init.
22670 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22680 20 20 20 20 20 20 20 20 20 20 73 72 63 20 73 74 src st
22690 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 r i end matches
226a0 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
226b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
226c0 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e 6b (next cnk
226d0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
226e0 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 20 20 20 end matches.
226f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22700 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22710 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 (lambda ().
22720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22730 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22740 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
22750 74 6f 20 28 3d 20 63 6f 75 6e 74 20 74 6f 29 29 to (= count to))
22760 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
22770 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22780 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
22790 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
227a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
227b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
227c0 20 20 28 28 62 6f 64 79 20 28 2b 20 31 20 63 6f ((body (+ 1 co
227d0 75 6e 74 29 29 20 63 6e 6b 20 69 6e 69 74 0a 20 unt)) cnk init.
227e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
227f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22800 20 20 20 20 20 20 20 20 20 20 20 20 20 73 72 63 src
22810 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
22820 65 73 20 66 61 69 6c 29 29 29 29 29 29 29 29 29 es fail)))))))))
22830 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
22840 20 20 20 28 69 66 20 28 61 6e 64 20 28 7a 65 72 (if (and (zer
22850 6f 3f 20 66 72 6f 6d 29 20 74 6f 20 28 7a 65 72 o? from) to (zer
22860 6f 3f 20 74 6f 29 29 0a 20 20 20 20 20 20 20 20 o? to)).
22870 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 nex
22880 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
22890 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
228a0 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
228b0 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 i end matches f
228c0 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
228d0 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
228e0 28 7a 65 72 6f 3f 20 66 72 6f 6d 29 0a 20 20 20 (zero? from).
228f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22900 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e (next cn
22910 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
22920 20 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 20 20 end matches.
22930 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22940 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
22950 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
22960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22970 20 20 20 20 20 20 20 20 20 20 20 20 28 28 62 6f ((bo
22980 64 79 20 31 29 20 63 6e 6b 20 69 6e 69 74 20 73 dy 1) cnk init s
22990 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
229a0 63 68 65 73 20 66 61 69 6c 29 29 29 0a 20 20 20 ches fail))).
229b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
229c0 20 20 20 20 20 20 20 20 28 28 62 6f 64 79 20 31 ((body 1
229d0 29 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 ) cnk init src s
229e0 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
229f0 20 66 61 69 6c 29 29 29 29 29 29 29 29 0a 20 20 fail)))))))).
22a00 20 20 20 20 20 20 20 20 20 20 28 28 77 6f 72 64 ((word
22a10 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
22a20 72 65 63 20 60 28 73 65 71 20 62 6f 77 20 2c 40 rec `(seq bow ,@
22a30 28 63 64 72 20 73 72 65 29 20 65 6f 77 29 29 29 (cdr sre) eow)))
22a40 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 77 . ((w
22a50 6f 72 64 2b 29 0a 20 20 20 20 20 20 20 20 20 20 ord+).
22a60 20 20 20 28 72 65 63 20 60 28 73 65 71 20 62 6f (rec `(seq bo
22a70 77 20 28 2b 20 28 26 20 28 6f 72 20 61 6c 70 68 w (+ (& (or alph
22a80 61 6e 75 6d 65 72 69 63 20 22 5f 22 29 0a 20 20 anumeric "_").
22a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22ab0 28 6f 72 20 2c 40 28 63 64 72 20 73 72 65 29 29 (or ,@(cdr sre))
22ac0 29 29 20 65 6f 77 29 29 29 0a 20 20 20 20 20 20 )) eow))).
22ad0 20 20 20 20 20 20 28 28 70 6f 73 69 78 2d 73 74 ((posix-st
22ae0 72 69 6e 67 29 0a 20 20 20 20 20 20 20 20 20 20 ring).
22af0 20 20 20 28 72 65 63 20 28 73 74 72 69 6e 67 2d (rec (string-
22b00 3e 73 72 65 20 28 63 61 64 72 20 73 72 65 29 29 >sre (cadr sre))
22b10 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
22b20 28 6c 6f 6f 6b 2d 61 68 65 61 64 29 0a 20 20 20 (look-ahead).
22b30 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
22b40 28 63 68 65 63 6b 0a 20 20 20 20 20 20 20 20 20 (check.
22b50 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
22b60 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
22b70 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
22b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22b90 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
22ba0 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 0a flags.
22bb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22bc0 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
22bd0 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 (cnk init src st
22be0 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 r i end matches
22bf0 66 61 69 6c 29 20 69 29 29 29 29 0a 20 20 20 20 fail) i)))).
22c00 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
22c10 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 da (cnk init src
22c20 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
22c30 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
22c40 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 63 (if (c
22c50 68 65 63 6b 20 63 6e 6b 20 69 6e 69 74 20 73 72 heck cnk init sr
22c60 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 c str i end matc
22c70 68 65 73 20 28 6c 61 6d 62 64 61 20 28 29 20 23 hes (lambda () #
22c80 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 f)).
22c90 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 (next c
22ca0 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
22cb0 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
22cc0 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 il).
22cd0 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 (fail))
22ce0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
22cf0 28 28 6e 65 67 2d 6c 6f 6f 6b 2d 61 68 65 61 64 ((neg-look-ahead
22d00 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
22d10 6c 65 74 20 28 28 63 68 65 63 6b 0a 20 20 20 20 let ((check.
22d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d30 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 (lp (sre-sequenc
22d40 65 20 28 63 64 72 20 73 72 65 29 29 0a 20 20 20 e (cdr sre)).
22d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22d60 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 20 20 n.
22d70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
22d80 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
22d90 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
22da0 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 mbda (cnk init s
22db0 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
22dc0 63 68 65 73 20 66 61 69 6c 29 20 69 29 29 29 29 ches fail) i))))
22dd0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
22de0 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 (lambda (cnk ini
22df0 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
22e00 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 matches fail).
22e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
22e20 69 66 20 28 63 68 65 63 6b 20 63 6e 6b 20 69 6e if (check cnk in
22e30 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
22e40 20 6d 61 74 63 68 65 73 20 28 6c 61 6d 62 64 61 matches (lambda
22e50 20 28 29 20 23 66 29 29 0a 20 20 20 20 20 20 20 () #f)).
22e60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
22e70 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
22e80 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
22e90 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
22ea0 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 i end matches f
22eb0 61 69 6c 29 29 29 29 29 0a 20 20 20 20 20 20 20 ail))))).
22ec0 20 20 20 20 20 28 28 6c 6f 6f 6b 2d 62 65 68 69 ((look-behi
22ed0 6e 64 20 6e 65 67 2d 6c 6f 6f 6b 2d 62 65 68 69 nd neg-look-behi
22ee0 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
22ef0 20 28 6c 65 74 20 28 28 63 68 65 63 6b 0a 20 20 (let ((check.
22f00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22f10 20 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 (lp (sre-seque
22f20 6e 63 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 nce.
22f30 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
22f40 6e 73 20 27 28 2a 20 61 6e 79 29 20 28 61 70 70 ns '(* any) (app
22f50 65 6e 64 20 28 63 64 72 20 73 72 65 29 20 27 28 end (cdr sre) '(
22f60 65 6f 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 eos)))).
22f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22f80 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 n.
22f90 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 0a flags.
22fa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
22fb0 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
22fc0 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 (cnk init src st
22fd0 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 r i end matches
22fe0 66 61 69 6c 29 20 69 29 29 29 29 0a 20 20 20 20 fail) i)))).
22ff0 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
23000 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 da (cnk init src
23010 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
23020 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
23030 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 (let*
23040 28 28 63 6e 6b 2a 20 28 77 72 61 70 2d 65 6e 64 ((cnk* (wrap-end
23050 2d 63 68 75 6e 6b 65 72 20 63 6e 6b 20 73 72 63 -chunker cnk src
23060 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i)).
23070 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
23080 72 2a 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 r* ((chunker-get
23090 2d 73 74 72 20 63 6e 6b 2a 29 20 28 63 61 72 20 -str cnk*) (car
230a0 69 6e 69 74 29 29 29 0a 20 20 20 20 20 20 20 20 init))).
230b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
230c0 28 69 2a 20 28 63 64 72 20 69 6e 69 74 29 29 0a (i* (cdr init)).
230d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
230e0 20 20 20 20 20 20 20 20 28 65 6e 64 2a 20 28 28 (end* ((
230f0 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 chunker-get-end
23100 63 6e 6b 2a 29 20 28 63 61 72 20 69 6e 69 74 29 cnk*) (car init)
23110 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
23120 20 20 20 20 20 20 20 28 69 66 20 28 28 69 66 20 (if ((if
23130 28 65 71 3f 20 28 63 61 72 20 73 72 65 29 20 27 (eq? (car sre) '
23140 6c 6f 6f 6b 2d 62 65 68 69 6e 64 29 20 28 6c 61 look-behind) (la
23150 6d 62 64 61 20 28 78 29 20 78 29 20 6e 6f 74 29 mbda (x) x) not)
23160 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
23170 20 20 20 20 20 20 20 20 20 28 63 68 65 63 6b 20 (check
23180 63 6e 6b 2a 20 69 6e 69 74 20 28 63 61 72 20 69 cnk* init (car i
23190 6e 69 74 29 20 73 74 72 2a 20 69 2a 20 65 6e 64 nit) str* i* end
231a0 2a 20 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 * matches.
231b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
231c0 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
231d0 20 28 29 20 23 66 29 29 29 0a 20 20 20 20 20 20 () #f))).
231e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
231f0 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 (next cnk init
23200 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
23210 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 tches fail).
23220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23230 20 20 20 28 66 61 69 6c 29 29 29 29 29 29 0a 20 (fail)))))).
23240 20 20 20 20 20 20 20 20 20 20 20 28 28 61 74 6f ((ato
23250 6d 69 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 mic).
23260 20 20 28 6c 65 74 20 28 28 6f 6e 63 65 0a 20 20 (let ((once.
23270 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23280 20 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 (lp (sre-seque
23290 6e 63 65 20 28 63 64 72 20 73 72 65 29 29 0a 20 nce (cdr sre)).
232a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
232b0 20 20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 n.
232c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
232d0 20 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 flags.
232e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
232f0 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
23300 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
23310 61 74 63 68 65 73 20 66 61 69 6c 29 20 69 29 29 atches fail) i))
23320 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
23330 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 (lambda (cnk i
23340 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
23350 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a d matches fail).
23360 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23370 20 28 6c 65 74 20 28 28 6a 20 28 6f 6e 63 65 20 (let ((j (once
23380 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
23390 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 28 i end matches (
233a0 6c 61 6d 62 64 61 20 28 29 20 23 66 29 29 29 29 lambda () #f))))
233b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
233c0 20 20 20 20 28 69 66 20 6a 0a 20 20 20 20 20 20 (if j.
233d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
233e0 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 (next cnk init
233f0 73 72 63 20 73 74 72 20 6a 20 65 6e 64 20 6d 61 src str j end ma
23400 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 tches fail).
23410 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23420 20 20 20 28 66 61 69 6c 29 29 29 29 29 29 0a 20 (fail)))))).
23430 20 20 20 20 20 20 20 20 20 20 20 28 28 69 66 29 ((if)
23440 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c . (l
23450 65 74 2a 20 28 28 74 65 73 74 2d 73 75 62 6d 61 et* ((test-subma
23460 74 63 68 65 73 20 28 73 72 65 2d 63 6f 75 6e 74 tches (sre-count
23470 2d 73 75 62 6d 61 74 63 68 65 73 20 28 63 61 64 -submatches (cad
23480 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 r sre))).
23490 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 61 (pa
234a0 73 73 20 28 6c 70 20 28 63 61 64 64 72 20 73 72 ss (lp (caddr sr
234b0 65 29 20 66 6c 61 67 73 20 28 2b 20 6e 20 74 65 e) flags (+ n te
234c0 73 74 2d 73 75 62 6d 61 74 63 68 65 73 29 20 6e st-submatches) n
234d0 65 78 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 ext)).
234e0 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 20 (fail
234f0 28 69 66 20 28 70 61 69 72 3f 20 28 63 64 64 64 (if (pair? (cddd
23500 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
23510 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23520 20 20 20 20 20 20 28 6c 70 20 28 63 61 64 64 64 (lp (caddd
23530 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 r sre).
23540 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23550 20 20 20 20 20 20 20 20 20 28 2b 20 6e 20 74 65 (+ n te
23560 73 74 2d 73 75 62 6d 61 74 63 68 65 73 0a 20 20 st-submatches.
23570 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23580 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23590 20 20 20 28 73 72 65 2d 63 6f 75 6e 74 2d 73 75 (sre-count-su
235a0 62 6d 61 74 63 68 65 73 20 28 63 61 64 64 72 20 bmatches (caddr
235b0 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 sre))).
235c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
235d0 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 0a 20 flags.
235e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
235f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23600 20 6e 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 next).
23610 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23620 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e (lambda (cn
23630 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
23640 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 end matches fai
23650 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
23660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23670 20 20 20 28 66 61 69 6c 29 29 29 29 29 0a 20 20 (fail))))).
23680 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
23690 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
236a0 20 20 20 28 28 6f 72 20 28 6e 75 6d 62 65 72 3f ((or (number?
236b0 20 28 63 61 64 72 20 73 72 65 29 29 20 28 73 79 (cadr sre)) (sy
236c0 6d 62 6f 6c 3f 20 28 63 61 64 72 20 73 72 65 29 mbol? (cadr sre)
236d0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
236e0 20 20 20 20 28 6c 65 74 20 28 28 69 6e 64 65 78 (let ((index
236f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
23700 20 20 20 20 20 20 20 20 20 28 69 66 20 28 73 79 (if (sy
23710 6d 62 6f 6c 3f 20 28 63 61 64 72 20 73 72 65 29 mbol? (cadr sre)
23720 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
23730 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
23740 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ond.
23750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23760 20 28 28 61 73 73 71 20 28 63 61 64 72 20 73 72 ((assq (cadr sr
23770 65 29 20 6e 61 6d 65 73 29 20 3d 3e 20 63 64 72 e) names) => cdr
23780 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
23790 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
237a0 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
237b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
237c0 20 20 20 28 65 72 72 6f 72 20 22 75 6e 6b 6e 6f (error "unkno
237d0 77 6e 20 6e 61 6d 65 64 20 62 61 63 6b 72 65 66 wn named backref
237e0 20 69 6e 20 53 52 45 20 49 46 22 20 73 72 65 29 in SRE IF" sre)
237f0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
23800 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
23810 63 61 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 cadr sre)))).
23820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23830 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 (lambda (cnk ini
23840 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
23850 6d 61 74 63 68 65 73 20 66 61 69 6c 32 29 0a 20 matches fail2).
23860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23870 20 20 20 20 28 69 66 20 28 25 69 72 72 65 67 65 (if (%irrege
23880 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 63 68 75 6e x-match-end-chun
23890 6b 20 6d 61 74 63 68 65 73 20 69 6e 64 65 78 29 k matches index)
238a0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
238b0 20 20 20 20 20 20 20 20 20 20 28 70 61 73 73 20 (pass
238c0 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
238d0 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 i end matches f
238e0 61 69 6c 32 29 0a 20 20 20 20 20 20 20 20 20 20 ail2).
238f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
23900 66 61 69 6c 20 63 6e 6b 20 69 6e 69 74 20 73 72 fail cnk init sr
23910 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 c str i end matc
23920 68 65 73 20 66 61 69 6c 32 29 29 29 29 29 0a 20 hes fail2))))).
23930 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
23940 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
23950 20 20 20 20 20 20 28 6c 65 74 20 28 28 74 65 73 (let ((tes
23960 74 20 28 6c 70 20 28 63 61 64 72 20 73 72 65 29 t (lp (cadr sre)
23970 20 6e 20 66 6c 61 67 73 20 70 61 73 73 29 29 29 n flags pass)))
23980 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
23990 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b (lambda (cnk
239a0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
239b0 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
239c0 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2).
239d0 20 20 20 20 20 20 20 20 28 74 65 73 74 20 63 6e (test cn
239e0 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
239f0 20 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 20 20 end matches.
23a00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23a10 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
23a20 28 29 20 28 66 61 69 6c 20 63 6e 6b 20 69 6e 69 () (fail cnk ini
23a30 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
23a40 6d 61 74 63 68 65 73 20 66 61 69 6c 32 29 29 29 matches fail2)))
23a50 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
23a60 20 20 20 20 20 20 29 29 29 29 29 29 0a 20 20 20 )))))).
23a70 20 20 20 20 20 20 20 20 20 28 28 62 61 63 6b 72 ((backr
23a80 65 66 20 62 61 63 6b 72 65 66 2d 63 69 29 0a 20 ef backref-ci).
23a90 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
23aa0 20 28 28 6e 20 28 63 6f 6e 64 20 28 28 6e 75 6d ((n (cond ((num
23ab0 62 65 72 3f 20 28 63 61 64 72 20 73 72 65 29 29 ber? (cadr sre))
23ac0 20 28 63 61 64 72 20 73 72 65 29 29 0a 20 20 20 (cadr sre)).
23ad0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23ae0 20 20 20 20 20 20 20 20 20 28 28 61 73 73 71 20 ((assq
23af0 28 63 61 64 72 20 73 72 65 29 20 6e 61 6d 65 73 (cadr sre) names
23b00 29 20 3d 3e 20 63 64 72 29 0a 20 20 20 20 20 20 ) => cdr).
23b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23b20 20 20 20 20 20 20 28 65 6c 73 65 20 28 65 72 72 (else (err
23b30 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 62 61 63 6b or "unknown back
23b40 72 65 66 65 72 65 6e 63 65 22 20 28 63 61 64 72 reference" (cadr
23b50 20 73 72 65 29 29 29 29 29 0a 20 20 20 20 20 20 sre))))).
23b60 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
23b70 6d 70 61 72 65 20 28 69 66 20 28 6f 72 20 28 65 mpare (if (or (e
23b80 71 3f 20 28 63 61 72 20 73 72 65 29 20 27 62 61 q? (car sre) 'ba
23b90 63 6b 72 65 66 2d 63 69 29 0a 20 20 20 20 20 20 ckref-ci).
23ba0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23bb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
23bc0 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e lag-set? flags ~
23bd0 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 case-insensitive
23be0 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ?)).
23bf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23c00 20 20 20 20 73 74 72 69 6e 67 2d 63 69 3d 3f 0a string-ci=?.
23c10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23c20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23c30 73 74 72 69 6e 67 3d 3f 29 29 29 0a 20 20 20 20 string=?))).
23c40 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
23c50 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 da (cnk init src
23c60 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
23c70 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
23c80 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
23c90 28 73 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (s (irregex-matc
23ca0 68 2d 73 75 62 73 74 72 69 6e 67 20 6d 61 74 63 h-substring matc
23cb0 68 65 73 20 6e 29 29 29 0a 20 20 20 20 20 20 20 hes n))).
23cc0 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
23cd0 28 6e 6f 74 20 73 29 0a 20 20 20 20 20 20 20 20 (not s).
23ce0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
23cf0 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
23d00 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
23d10 58 58 58 58 20 63 72 65 61 74 65 20 61 6e 20 61 XXXX create an a
23d20 62 73 74 72 61 63 74 20 73 75 62 63 68 75 6e 6b bstract subchunk
23d30 2d 63 6f 6d 70 61 72 65 0a 20 20 20 20 20 20 20 -compare.
23d40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23d50 28 6c 65 74 20 6c 70 20 28 28 73 72 63 20 73 72 (let lp ((src sr
23d60 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c).
23d70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23d80 20 20 20 28 73 74 72 20 73 74 72 29 0a 20 20 20 (str str).
23d90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23da0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 20 (i
23db0 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
23dc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23dd0 20 20 20 28 65 6e 64 20 65 6e 64 29 0a 20 20 20 (end end).
23de0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23df0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6a 20 (j
23e00 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0).
23e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23e20 20 20 20 28 6c 65 6e 20 28 73 74 72 69 6e 67 2d (len (string-
23e30 6c 65 6e 67 74 68 20 73 29 29 29 0a 20 20 20 20 length s))).
23e40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23e50 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
23e60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23e70 20 20 20 20 20 28 28 3c 3d 20 6c 65 6e 20 28 2d ((<= len (-
23e80 20 65 6e 64 20 69 29 29 0a 20 20 20 20 20 20 20 end i)).
23e90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23ea0 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
23eb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23ec0 20 20 20 20 20 20 28 28 63 6f 6d 70 61 72 65 20 ((compare
23ed0 28 73 75 62 73 74 72 69 6e 67 20 73 20 6a 20 28 (substring s j (
23ee0 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 29 string-length s)
23ef0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
23f00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23f10 20 20 20 20 20 20 20 20 28 73 75 62 73 74 72 69 (substri
23f20 6e 67 20 73 74 72 20 69 20 28 2b 20 69 20 6c 65 ng str i (+ i le
23f30 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 n))).
23f40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23f50 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 (next cnk init
23f60 20 73 72 63 20 73 74 72 20 28 2b 20 69 20 6c 65 src str (+ i le
23f70 6e 29 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 n) end matches f
23f80 61 69 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 ail)).
23f90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23fa0 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
23fb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23fc0 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 0a 20 (fail)))).
23fd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23fe0 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
23ff0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24000 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
24010 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24020 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 6f ((co
24030 6d 70 61 72 65 20 28 73 75 62 73 74 72 69 6e 67 mpare (substring
24040 20 73 20 6a 20 28 2b 20 6a 20 28 2d 20 65 6e 64 s j (+ j (- end
24050 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 i))).
24060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24070 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 62 (sub
24080 73 74 72 69 6e 67 20 73 74 72 20 69 20 65 6e 64 string str i end
24090 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
240a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
240b0 28 6c 65 74 20 28 28 73 72 63 32 20 28 28 63 68 (let ((src2 ((ch
240c0 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 unker-get-next c
240d0 6e 6b 29 20 73 72 63 29 29 29 0a 20 20 20 20 20 nk) src))).
240e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
240f0 20 20 20 20 20 20 20 20 20 20 28 69 66 20 73 72 (if sr
24100 63 32 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c2.
24110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24120 20 20 20 20 20 20 28 6c 70 20 73 72 63 32 0a 20 (lp src2.
24130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24150 20 20 20 20 20 20 28 28 63 68 75 6e 6b 65 72 2d ((chunker-
24160 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 73 72 63 get-str cnk) src
24170 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2).
24180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24190 20 20 20 20 20 20 20 20 20 20 28 28 63 68 75 6e ((chun
241a0 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e ker-get-start cn
241b0 6b 29 20 73 72 63 32 29 0a 20 20 20 20 20 20 20 k) src2).
241c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
241d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
241e0 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e ((chunker-get-en
241f0 64 20 63 6e 6b 29 20 73 72 63 32 29 0a 20 20 20 d cnk) src2).
24200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24220 20 20 20 20 28 2b 20 6a 20 28 2d 20 65 6e 64 20 (+ j (- end
24230 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i)).
24240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24250 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 6c 65 (- le
24260 6e 20 28 2d 20 65 6e 64 20 69 29 29 29 0a 20 20 n (- end i))).
24270 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24280 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24290 20 28 66 61 69 6c 29 29 29 29 0a 20 20 20 20 20 (fail)))).
242a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
242b0 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
242c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
242d0 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 (fail)
242e0 29 29 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 )))))))))).
242f0 20 20 20 20 20 20 20 28 28 64 73 6d 29 0a 20 20 ((dsm).
24300 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
24310 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
24320 64 64 72 20 73 72 65 29 29 20 28 2b 20 6e 20 28 ddr sre)) (+ n (
24330 63 61 64 72 20 73 72 65 29 29 20 66 6c 61 67 73 cadr sre)) flags
24340 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 20 next)).
24350 20 20 20 20 28 28 24 20 73 75 62 6d 61 74 63 68 (($ submatch
24360 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
24370 6c 65 74 20 28 28 62 6f 64 79 0a 20 20 20 20 20 let ((body.
24380 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
24390 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 lp (sre-sequence
243a0 20 28 63 64 72 20 73 72 65 29 29 0a 20 20 20 20 (cdr sre)).
243b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
243c0 20 20 20 20 28 2b 20 6e 20 31 29 0a 20 20 20 20 (+ n 1).
243d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
243e0 20 20 20 20 66 6c 61 67 73 0a 20 20 20 20 20 20 flags.
243f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24400 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 (lambda (cnk i
24410 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
24420 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a d matches fail).
24430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24440 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
24450 28 6f 6c 64 2d 73 6f 75 72 63 65 0a 20 20 20 20 (old-source.
24460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24470 20 20 20 20 20 20 20 20 20 20 20 20 20 28 25 69 (%i
24480 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
24490 2d 63 68 75 6e 6b 20 6d 61 74 63 68 65 73 20 6e -chunk matches n
244a0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
244b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
244c0 20 20 20 28 6f 6c 64 2d 69 6e 64 65 78 0a 20 20 (old-index.
244d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
244e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
244f0 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 %irregex-match-e
24500 6e 64 2d 69 6e 64 65 78 20 6d 61 74 63 68 65 73 nd-index matches
24510 20 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 n))).
24520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24530 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (irregex-match
24540 2d 65 6e 64 2d 63 68 75 6e 6b 2d 73 65 74 21 20 -end-chunk-set!
24550 6d 61 74 63 68 65 73 20 6e 20 73 72 63 29 0a 20 matches n src).
24560 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24570 20 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 (irre
24580 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e gex-match-end-in
24590 64 65 78 2d 73 65 74 21 20 6d 61 74 63 68 65 73 dex-set! matches
245a0 20 6e 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 n i).
245b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
245c0 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 (next cnk init
245d0 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
245e0 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 20 atches.
245f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24600 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
24610 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ().
24620 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24630 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 (irregex
24640 2d 6d 61 74 63 68 2d 65 6e 64 2d 63 68 75 6e 6b -match-end-chunk
24650 2d 73 65 74 21 0a 20 20 20 20 20 20 20 20 20 20 -set!.
24660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24670 20 20 20 20 20 20 20 20 20 20 20 6d 61 74 63 68 match
24680 65 73 20 6e 20 6f 6c 64 2d 73 6f 75 72 63 65 29 es n old-source)
24690 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
246a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
246b0 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 (irregex-ma
246c0 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 2d 73 65 tch-end-index-se
246d0 74 21 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t!.
246e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
246f0 20 20 20 20 20 20 20 20 6d 61 74 63 68 65 73 20 matches
24700 6e 20 6f 6c 64 2d 69 6e 64 65 78 29 0a 20 20 20 n old-index).
24710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24730 20 28 66 61 69 6c 29 29 29 29 29 29 29 29 0a 20 (fail)))))))).
24740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
24750 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 ambda (cnk init
24760 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
24770 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 tches fail).
24780 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
24790 74 20 28 28 6f 6c 64 2d 73 6f 75 72 63 65 20 28 t ((old-source (
247a0 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 %irregex-match-s
247b0 74 61 72 74 2d 63 68 75 6e 6b 20 6d 61 74 63 68 tart-chunk match
247c0 65 73 20 6e 29 29 0a 20 20 20 20 20 20 20 20 20 es n)).
247d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
247e0 6c 64 2d 69 6e 64 65 78 20 28 25 69 72 72 65 67 ld-index (%irreg
247f0 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 ex-match-start-i
24800 6e 64 65 78 20 6d 61 74 63 68 65 73 20 6e 29 29 ndex matches n))
24810 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
24820 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 (irregex-ma
24830 74 63 68 2d 73 74 61 72 74 2d 63 68 75 6e 6b 2d tch-start-chunk-
24840 73 65 74 21 20 6d 61 74 63 68 65 73 20 6e 20 73 set! matches n s
24850 72 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rc).
24860 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
24870 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 match-start-inde
24880 78 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 6e x-set! matches n
24890 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i).
248a0 20 20 20 20 20 20 20 28 62 6f 64 79 20 63 6e 6b (body cnk
248b0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
248c0 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 20 20 20 end matches.
248d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
248e0 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a (lambda ().
248f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24900 20 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 (irre
24910 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d gex-match-start-
24920 63 68 75 6e 6b 2d 73 65 74 21 0a 20 20 20 20 20 chunk-set!.
24930 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24940 20 20 20 20 20 20 20 6d 61 74 63 68 65 73 20 6e matches n
24950 20 6f 6c 64 2d 73 6f 75 72 63 65 29 0a 20 20 20 old-source).
24960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24970 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 (irregex
24980 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 -match-start-ind
24990 65 78 2d 73 65 74 21 0a 20 20 20 20 20 20 20 20 ex-set!.
249a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
249b0 20 20 20 20 6d 61 74 63 68 65 73 20 6e 20 6f 6c matches n ol
249c0 64 2d 69 6e 64 65 78 29 0a 20 20 20 20 20 20 20 d-index).
249d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
249e0 20 20 20 20 28 66 61 69 6c 29 29 29 29 29 29 29 (fail)))))))
249f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3d . ((=
24a00 3e 20 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 > submatch-named
24a10 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
24a20 72 65 63 20 60 28 73 75 62 6d 61 74 63 68 20 2c rec `(submatch ,
24a30 40 28 63 64 64 72 20 73 72 65 29 29 29 29 0a 20 @(cddr sre)))).
24a40 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
24a50 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 . (e
24a60 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 72 65 rror "unknown re
24a70 67 65 78 70 20 6f 70 65 72 61 74 6f 72 22 20 73 gexp operator" s
24a80 72 65 29 29 29 29 29 0a 20 20 20 20 20 28 28 73 re))))). ((s
24a90 79 6d 62 6f 6c 3f 20 73 72 65 29 0a 20 20 20 20 ymbol? sre).
24aa0 20 20 28 63 61 73 65 20 73 72 65 0a 20 20 20 20 (case sre.
24ab0 20 20 20 20 28 28 61 6e 79 29 0a 20 20 20 20 20 ((any).
24ac0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b (lambda (cnk
24ad0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
24ae0 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
24af0 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 66 ). (if
24b00 20 28 3c 20 69 20 65 6e 64 29 0a 20 20 20 20 20 (< i end).
24b10 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
24b20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
24b30 20 28 2b 20 69 20 31 29 20 65 6e 64 20 6d 61 74 (+ i 1) end mat
24b40 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
24b50 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
24b60 28 73 72 63 32 20 28 28 63 68 75 6e 6b 65 72 2d (src2 ((chunker-
24b70 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 get-next cnk) sr
24b80 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 c))).
24b90 20 20 20 20 20 20 28 69 66 20 73 72 63 32 0a 20 (if src2.
24ba0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24bb0 20 20 20 20 28 6c 65 74 20 28 28 73 74 72 32 20 (let ((str2
24bc0 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 ((chunker-get-st
24bd0 72 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 r cnk) src2)).
24be0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24bf0 20 20 20 20 20 20 20 20 20 28 69 32 20 28 28 63 (i2 ((c
24c00 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 hunker-get-start
24c10 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 cnk) src2)).
24c20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24c30 20 20 20 20 20 20 20 20 28 65 6e 64 32 20 28 28 (end2 ((
24c40 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 chunker-get-end
24c50 63 6e 6b 29 20 73 72 63 32 29 29 29 0a 20 20 20 cnk) src2))).
24c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24c70 20 20 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e (next cnk in
24c80 69 74 20 73 72 63 32 20 73 74 72 32 20 28 2b 20 it src2 str2 (+
24c90 69 32 20 31 29 20 65 6e 64 32 20 6d 61 74 63 68 i2 1) end2 match
24ca0 65 73 20 66 61 69 6c 29 29 0a 20 20 20 20 20 20 es fail)).
24cb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
24cc0 66 61 69 6c 29 29 29 29 29 29 0a 20 20 20 20 20 fail)))))).
24cd0 20 20 20 28 28 6e 6f 6e 6c 29 0a 20 20 20 20 20 ((nonl).
24ce0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b (lambda (cnk
24cf0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
24d00 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
24d10 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 66 ). (if
24d20 20 28 3c 20 69 20 65 6e 64 29 0a 20 20 20 20 20 (< i end).
24d30 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
24d40 6f 74 20 28 65 71 76 3f 20 23 5c 6e 65 77 6c 69 ot (eqv? #\newli
24d50 6e 65 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 ne (string-ref s
24d60 74 72 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 tr i))).
24d70 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 (next
24d80 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 cnk init src st
24d90 72 20 28 2b 20 69 20 31 29 20 65 6e 64 20 6d 61 r (+ i 1) end ma
24da0 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 tches fail).
24db0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
24dc0 66 61 69 6c 29 29 0a 20 20 20 20 20 20 20 20 20 fail)).
24dd0 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 72 63 (let ((src
24de0 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 2 ((chunker-get-
24df0 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 29 29 29 next cnk) src)))
24e00 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
24e10 20 20 28 69 66 20 73 72 63 32 0a 20 20 20 20 20 (if src2.
24e20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24e30 28 6c 65 74 20 28 28 73 74 72 32 20 28 28 63 68 (let ((str2 ((ch
24e40 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 20 63 6e unker-get-str cn
24e50 6b 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 20 k) src2)).
24e60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24e70 20 20 20 20 20 28 69 32 20 28 28 63 68 75 6e 6b (i2 ((chunk
24e80 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b er-get-start cnk
24e90 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 20 20 ) src2)).
24ea0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24eb0 20 20 20 20 28 65 6e 64 32 20 28 28 63 68 75 6e (end2 ((chun
24ec0 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 6e 6b 29 ker-get-end cnk)
24ed0 20 73 72 63 32 29 29 29 0a 20 20 20 20 20 20 20 src2))).
24ee0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24ef0 28 69 66 20 28 6e 6f 74 20 28 65 71 76 3f 20 23 (if (not (eqv? #
24f00 5c 6e 65 77 6c 69 6e 65 20 28 73 74 72 69 6e 67 \newline (string
24f10 2d 72 65 66 20 73 74 72 32 20 69 32 29 29 29 0a -ref str2 i2))).
24f20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24f30 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 (next
24f40 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 32 20 73 cnk init src2 s
24f50 74 72 32 20 28 2b 20 69 32 20 31 29 20 65 6e 64 tr2 (+ i2 1) end
24f60 32 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 2 matches fail).
24f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
24f80 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c (fail
24f90 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
24fa0 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 (fail))
24fb0 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 62 )))). ((b
24fc0 6f 73 29 0a 20 20 20 20 20 20 20 20 20 28 6c 61 os). (la
24fd0 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 mbda (cnk init s
24fe0 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
24ff0 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
25000 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
25010 65 71 3f 20 73 72 63 20 28 63 61 72 20 69 6e 69 eq? src (car ini
25020 74 29 29 20 28 65 71 76 3f 20 69 20 28 63 64 72 t)) (eqv? i (cdr
25030 20 69 6e 69 74 29 29 29 0a 20 20 20 20 20 20 20 init))).
25040 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e (next cn
25050 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
25060 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 end matches fai
25070 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
25080 20 20 28 66 61 69 6c 29 29 29 29 0a 20 20 20 20 (fail)))).
25090 20 20 20 20 28 28 62 6f 6c 29 0a 20 20 20 20 20 ((bol).
250a0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b (lambda (cnk
250b0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
250c0 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
250d0 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 66 ). (if
250e0 20 28 6c 65 74 20 28 28 63 68 20 28 69 66 20 28 (let ((ch (if (
250f0 3e 20 69 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 > i ((chunker-ge
25100 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 63 t-start cnk) src
25110 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
25120 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25130 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
25140 28 2d 20 69 20 31 29 29 0a 20 20 20 20 20 20 20 (- i 1)).
25150 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25160 20 20 20 20 20 20 28 63 68 75 6e 6b 65 72 2d 70 (chunker-p
25170 72 65 76 2d 63 68 61 72 20 63 6e 6b 20 69 6e 69 rev-char cnk ini
25180 74 20 73 72 63 29 29 29 29 0a 20 20 20 20 20 20 t src)))).
25190 20 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 (or (
251a0 6e 6f 74 20 63 68 29 20 28 65 71 76 3f 20 23 5c not ch) (eqv? #\
251b0 6e 65 77 6c 69 6e 65 20 63 68 29 29 29 0a 20 20 newline ch))).
251c0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
251d0 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 xt cnk init src
251e0 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
251f0 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
25200 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 (fail))))
25210 0a 20 20 20 20 20 20 20 20 28 28 62 6f 77 29 0a . ((bow).
25220 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
25230 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 (cnk init src s
25240 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
25250 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
25260 20 20 28 69 66 20 28 61 6e 64 20 28 69 66 20 28 (if (and (if (
25270 3e 20 69 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 > i ((chunker-ge
25280 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 63 t-start cnk) src
25290 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
252a0 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 (not
252b0 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d 65 72 (char-alphanumer
252c0 69 63 3f 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ic? (string-ref
252d0 73 74 72 20 28 2d 20 69 20 31 29 29 29 29 0a 20 str (- i 1)))).
252e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
252f0 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 68 (let ((ch
25300 20 28 63 68 75 6e 6b 65 72 2d 70 72 65 76 2d 63 (chunker-prev-c
25310 68 61 72 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 har cnk init src
25320 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
25330 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
25340 72 20 28 6e 6f 74 20 63 68 29 20 28 6e 6f 74 20 r (not ch) (not
25350 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d 65 72 (char-alphanumer
25360 69 63 3f 20 63 68 29 29 29 29 29 0a 20 20 20 20 ic? ch))))).
25370 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25380 28 69 66 20 28 3c 20 69 20 65 6e 64 29 0a 20 20 (if (< i end).
25390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
253a0 20 20 20 20 20 20 28 63 68 61 72 2d 61 6c 70 68 (char-alph
253b0 61 6e 75 6d 65 72 69 63 3f 20 28 73 74 72 69 6e anumeric? (strin
253c0 67 2d 72 65 66 20 73 74 72 20 69 29 29 0a 20 20 g-ref str i)).
253d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
253e0 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 78 (let ((nex
253f0 74 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d t ((chunker-get-
25400 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 29 29 29 next cnk) src)))
25410 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
25420 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
25430 6e 65 78 74 0a 20 20 20 20 20 20 20 20 20 20 20 next.
25440 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25450 20 20 20 20 28 63 68 61 72 2d 61 6c 70 68 61 6e (char-alphan
25460 75 6d 65 72 69 63 3f 0a 20 20 20 20 20 20 20 20 umeric?.
25470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25480 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d (string-
25490 72 65 66 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 ref ((chunker-ge
254a0 74 2d 73 74 72 20 63 6e 6b 29 20 6e 65 78 74 29 t-str cnk) next)
254b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
254c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
254d0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 ((c
254e0 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 hunker-get-start
254f0 20 63 6e 6b 29 20 6e 65 78 74 29 29 29 29 29 29 cnk) next))))))
25500 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
25510 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 (next cnk init
25520 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
25530 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 tches fail).
25540 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c (fail
25550 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 65 )))). ((e
25560 6f 73 29 0a 20 20 20 20 20 20 20 20 20 28 6c 61 os). (la
25570 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 mbda (cnk init s
25580 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
25590 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
255a0 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 (if (and (
255b0 3e 3d 20 69 20 65 6e 64 29 20 28 6e 6f 74 20 28 >= i end) (not (
255c0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 (chunker-get-nex
255d0 74 20 63 6e 6b 29 20 73 72 63 29 29 29 0a 20 20 t cnk) src))).
255e0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
255f0 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 xt cnk init src
25600 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
25610 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
25620 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 (fail))))
25630 0a 20 20 20 20 20 20 20 20 28 28 65 6f 6c 29 0a . ((eol).
25640 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
25650 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 (cnk init src s
25660 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
25670 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
25680 20 20 28 69 66 20 28 69 66 20 28 3c 20 69 20 65 (if (if (< i e
25690 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
256a0 20 20 20 20 20 20 20 28 65 71 76 3f 20 23 5c 6e (eqv? #\n
256b0 65 77 6c 69 6e 65 20 28 73 74 72 69 6e 67 2d 72 ewline (string-r
256c0 65 66 20 73 74 72 20 69 29 29 0a 20 20 20 20 20 ef str i)).
256d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
256e0 65 74 20 28 28 73 72 63 32 20 28 28 63 68 75 6e et ((src2 ((chun
256f0 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b ker-get-next cnk
25700 29 20 73 72 63 29 29 29 0a 20 20 20 20 20 20 20 ) src))).
25710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
25720 66 20 28 6e 6f 74 20 73 72 63 32 29 0a 20 20 20 f (not src2).
25730 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25740 20 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 20 #t.
25750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25760 20 20 28 65 71 76 3f 20 23 5c 6e 65 77 6c 69 6e (eqv? #\newlin
25770 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
25780 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25790 20 28 73 74 72 69 6e 67 2d 72 65 66 20 28 28 63 (string-ref ((c
257a0 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 20 63 hunker-get-str c
257b0 6e 6b 29 20 73 72 63 32 29 0a 20 20 20 20 20 20 nk) src2).
257c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
257d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
257e0 20 20 20 20 20 28 28 63 68 75 6e 6b 65 72 2d 67 ((chunker-g
257f0 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 et-start cnk) sr
25800 63 32 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 c2)))))).
25810 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e (next cn
25820 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
25830 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 end matches fai
25840 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
25850 20 20 28 66 61 69 6c 29 29 29 29 0a 20 20 20 20 (fail)))).
25860 20 20 20 20 28 28 65 6f 77 29 0a 20 20 20 20 20 ((eow).
25870 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b (lambda (cnk
25880 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
25890 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
258a0 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 66 ). (if
258b0 20 28 61 6e 64 20 28 69 66 20 28 3c 20 69 20 65 (and (if (< i e
258c0 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
258d0 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 (not
258e0 20 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d 65 (char-alphanume
258f0 72 69 63 3f 20 28 73 74 72 69 6e 67 2d 72 65 66 ric? (string-ref
25900 20 73 74 72 20 69 29 29 29 0a 20 20 20 20 20 20 str i))).
25910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25920 20 20 28 6c 65 74 20 28 28 63 68 20 28 63 68 75 (let ((ch (chu
25930 6e 6b 65 72 2d 6e 65 78 74 2d 63 68 61 72 20 63 nker-next-char c
25940 6e 6b 20 73 72 63 29 29 29 0a 20 20 20 20 20 20 nk src))).
25950 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25960 20 20 20 20 28 6f 72 20 28 6e 6f 74 20 63 68 29 (or (not ch)
25970 20 28 6e 6f 74 20 28 63 68 61 72 2d 61 6c 70 68 (not (char-alph
25980 61 6e 75 6d 65 72 69 63 3f 20 63 68 29 29 29 29 anumeric? ch))))
25990 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
259a0 20 20 20 20 20 20 28 69 66 20 28 3e 20 69 20 28 (if (> i (
259b0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 (chunker-get-sta
259c0 72 74 20 63 6e 6b 29 20 73 72 63 29 29 0a 20 20 rt cnk) src)).
259d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
259e0 20 20 20 20 20 20 28 63 68 61 72 2d 61 6c 70 68 (char-alph
259f0 61 6e 75 6d 65 72 69 63 3f 20 28 73 74 72 69 6e anumeric? (strin
25a00 67 2d 72 65 66 20 73 74 72 20 28 2d 20 69 20 31 g-ref str (- i 1
25a10 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
25a20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
25a30 20 28 28 70 72 65 76 20 28 63 68 75 6e 6b 65 72 ((prev (chunker
25a40 2d 70 72 65 76 2d 63 68 61 72 20 63 6e 6b 20 69 -prev-char cnk i
25a50 6e 69 74 20 73 72 63 29 29 29 0a 20 20 20 20 20 nit src))).
25a60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25a70 20 20 20 20 20 28 6f 72 20 28 6e 6f 74 20 70 72 (or (not pr
25a80 65 76 29 20 28 63 68 61 72 2d 61 6c 70 68 61 6e ev) (char-alphan
25a90 75 6d 65 72 69 63 3f 20 70 72 65 76 29 29 29 29 umeric? prev))))
25aa0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
25ab0 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 (next cnk init
25ac0 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
25ad0 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 tches fail).
25ae0 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c (fail
25af0 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 6e )))). ((n
25b00 77 62 29 20 20 3b 3b 20 6e 6f 6e 2d 77 6f 72 64 wb) ;; non-word
25b10 2d 62 6f 75 6e 64 61 72 79 0a 20 20 20 20 20 20 -boundary.
25b20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 (lambda (cnk
25b30 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 init src str i e
25b40 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 nd matches fail)
25b50 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 . (let
25b60 20 28 28 63 31 20 28 69 66 20 28 3c 20 69 20 65 ((c1 (if (< i e
25b70 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
25b80 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
25b90 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 0a ring-ref str i).
25ba0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25bb0 20 20 20 20 20 20 20 20 20 28 63 68 75 6e 6b 65 (chunke
25bc0 72 2d 6e 65 78 74 2d 63 68 61 72 20 63 6e 6b 20 r-next-char cnk
25bd0 73 72 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 src))).
25be0 20 20 20 20 20 20 20 20 28 63 32 20 28 69 66 20 (c2 (if
25bf0 28 3e 20 69 20 28 28 63 68 75 6e 6b 65 72 2d 67 (> i ((chunker-g
25c00 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 et-start cnk) sr
25c10 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 c)).
25c20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
25c30 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2d 20 ring-ref str (-
25c40 69 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 i 1)).
25c50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
25c60 63 68 75 6e 6b 65 72 2d 70 72 65 76 2d 63 68 61 chunker-prev-cha
25c70 72 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 29 29 r cnk init src))
25c80 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
25c90 28 69 66 20 28 61 6e 64 20 63 31 20 63 32 0a 20 (if (and c1 c2.
25ca0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25cb0 20 20 20 20 20 28 69 66 20 28 63 68 61 72 2d 61 (if (char-a
25cc0 6c 70 68 61 6e 75 6d 65 72 69 63 3f 20 63 31 29 lphanumeric? c1)
25cd0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
25ce0 20 20 20 20 20 20 20 20 20 20 20 28 63 68 61 72 (char
25cf0 2d 61 6c 70 68 61 6e 75 6d 65 72 69 63 3f 20 63 -alphanumeric? c
25d00 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2).
25d10 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 6f (no
25d20 74 20 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d t (char-alphanum
25d30 65 72 69 63 3f 20 63 32 29 29 29 29 0a 20 20 20 eric? c2)))).
25d40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e (n
25d50 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 ext cnk init src
25d60 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
25d70 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
25d80 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 (fail)
25d90 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 65 )))). ((e
25da0 70 73 69 6c 6f 6e 29 0a 20 20 20 20 20 20 20 20 psilon).
25db0 20 6e 65 78 74 29 0a 20 20 20 20 20 20 20 20 28 next). (
25dc0 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 28 6c else. (l
25dd0 65 74 20 28 28 63 65 6c 6c 20 28 61 73 73 71 20 et ((cell (assq
25de0 73 72 65 20 73 72 65 2d 6e 61 6d 65 64 2d 64 65 sre sre-named-de
25df0 66 69 6e 69 74 69 6f 6e 73 29 29 29 0a 20 20 20 finitions))).
25e00 20 20 20 20 20 20 20 20 28 69 66 20 63 65 6c 6c (if cell
25e10 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
25e20 28 72 65 63 20 28 63 64 72 20 63 65 6c 6c 29 29 (rec (cdr cell))
25e30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
25e40 28 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 (error "unknown
25e50 72 65 67 65 78 70 22 20 73 72 65 29 29 29 29 29 regexp" sre)))))
25e60 29 0a 20 20 20 20 20 28 28 63 68 61 72 3f 20 73 ). ((char? s
25e70 72 65 29 0a 20 20 20 20 20 20 28 69 66 20 28 66 re). (if (f
25e80 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e lag-set? flags ~
25e90 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 case-insensitive
25ea0 3f 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ?). ;;
25eb0 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 case-insensitive
25ec0 0a 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 . (lamb
25ed0 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 da (cnk init src
25ee0 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
25ef0 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
25f00 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 20 65 (if (>= i e
25f10 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
25f20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 73 72 (let lp ((sr
25f30 63 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 c2 ((chunker-get
25f40 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 29 29 -next cnk) src))
25f50 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
25f60 20 20 20 20 28 69 66 20 73 72 63 32 0a 20 20 20 (if src2.
25f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25f80 20 20 20 28 6c 65 74 20 28 28 73 74 72 32 20 28 (let ((str2 (
25f90 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 (chunker-get-str
25fa0 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 cnk) src2)).
25fb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25fc0 20 20 20 20 20 20 20 20 20 28 69 32 20 28 28 63 (i2 ((c
25fd0 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 hunker-get-start
25fe0 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 cnk) src2)).
25ff0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26000 20 20 20 20 20 20 20 20 20 28 65 6e 64 32 20 28 (end2 (
26010 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 (chunker-get-end
26020 20 63 6e 6b 29 20 73 72 63 32 29 29 29 0a 20 20 cnk) src2))).
26030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26040 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 32 (if (>= i2
26050 20 65 6e 64 32 29 0a 20 20 20 20 20 20 20 20 20 end2).
26060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26070 20 20 20 28 6c 70 20 28 28 63 68 75 6e 6b 65 72 (lp ((chunker
26080 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 73 -get-next cnk) s
26090 72 63 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 rc2)).
260a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
260b0 20 20 28 69 66 20 28 63 68 61 72 2d 63 69 3d 3f (if (char-ci=?
260c0 20 73 72 65 20 28 73 74 72 69 6e 67 2d 72 65 66 sre (string-ref
260d0 20 73 74 72 32 20 69 32 29 29 0a 20 20 20 20 20 str2 i2)).
260e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
260f0 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 (next
26100 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 32 20 73 cnk init src2 s
26110 74 72 32 20 28 2b 20 69 32 20 31 29 20 65 6e 64 tr2 (+ i2 1) end
26120 32 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2.
26130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26140 20 20 20 20 20 20 20 20 6d 61 74 63 68 65 73 20 matches
26150 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
26160 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26170 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 0a (fail)))).
26180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26190 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 0a 20 (fail))).
261a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
261b0 69 66 20 28 63 68 61 72 2d 63 69 3d 3f 20 73 72 if (char-ci=? sr
261c0 65 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 e (string-ref st
261d0 72 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 r i)).
261e0 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
261f0 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
26200 20 28 2b 20 69 20 31 29 20 65 6e 64 20 6d 61 74 (+ i 1) end mat
26210 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
26220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
26230 66 61 69 6c 29 29 29 29 0a 20 20 20 20 20 20 20 fail)))).
26240 20 20 20 3b 3b 20 63 61 73 65 2d 73 65 6e 73 69 ;; case-sensi
26250 74 69 76 65 0a 20 20 20 20 20 20 20 20 20 20 28 tive. (
26260 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
26270 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
26280 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 atches fail).
26290 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3e 3d (if (>=
262a0 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 i end).
262b0 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 (let lp
262c0 28 28 73 72 63 32 20 28 28 63 68 75 6e 6b 65 72 ((src2 ((chunker
262d0 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 73 -get-next cnk) s
262e0 72 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 rc))).
262f0 20 20 20 20 20 20 20 20 28 69 66 20 73 72 63 32 (if src2
26300 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
26310 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 (let ((st
26320 72 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 r2 ((chunker-get
26330 2d 73 74 72 20 63 6e 6b 29 20 73 72 63 32 29 29 -str cnk) src2))
26340 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
26350 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 32 (i2
26360 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 ((chunker-get-s
26370 74 61 72 74 20 63 6e 6b 29 20 73 72 63 32 29 29 tart cnk) src2))
26380 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
26390 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6e (en
263a0 64 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 d2 ((chunker-get
263b0 2d 65 6e 64 20 63 6e 6b 29 20 73 72 63 32 29 29 -end cnk) src2))
263c0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
263d0 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3e (if (>
263e0 3d 20 69 32 20 65 6e 64 32 29 0a 20 20 20 20 20 = i2 end2).
263f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26400 20 20 20 20 20 20 20 28 6c 70 20 28 28 63 68 75 (lp ((chu
26410 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e nker-get-next cn
26420 6b 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 20 k) src2)).
26430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26440 20 20 20 20 20 20 28 69 66 20 28 63 68 61 72 3d (if (char=
26450 3f 20 73 72 65 20 28 73 74 72 69 6e 67 2d 72 65 ? sre (string-re
26460 66 20 73 74 72 32 20 69 32 29 29 0a 20 20 20 20 f str2 i2)).
26470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26480 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 (nex
26490 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 32 20 t cnk init src2
264a0 73 74 72 32 20 28 2b 20 69 32 20 31 29 20 65 6e str2 (+ i2 1) en
264b0 64 32 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d2.
264c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
264d0 20 20 20 20 20 20 20 20 20 6d 61 74 63 68 65 73 matches
264e0 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
264f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26500 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 (fail))))
26510 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
26520 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 0a (fail))).
26530 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26540 28 69 66 20 28 63 68 61 72 3d 3f 20 73 72 65 20 (if (char=? sre
26550 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
26560 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i)).
26570 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e (next cn
26580 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 28 k init src str (
26590 2b 20 69 20 31 29 20 65 6e 64 20 6d 61 74 63 68 + i 1) end match
265a0 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
265b0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 (fa
265c0 69 6c 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 il)))).
265d0 20 29 29 0a 20 20 20 20 20 28 28 73 74 72 69 6e )). ((strin
265e0 67 3f 20 73 72 65 29 0a 20 20 20 20 20 20 28 72 g? sre). (r
265f0 65 63 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 ec (sre-sequence
26600 20 28 73 74 72 69 6e 67 2d 3e 6c 69 73 74 20 73 (string->list s
26610 72 65 29 29 29 0a 3b 3b 20 58 58 58 58 20 72 65 re))).;; XXXX re
26620 69 6e 74 72 6f 64 75 63 65 20 66 61 73 74 65 72 introduce faster
26630 20 73 74 72 69 6e 67 20 6d 61 74 63 68 69 6e 67 string matching
26640 20 6f 6e 20 63 68 75 6e 6b 73 0a 3b 3b 20 20 20 on chunks.;;
26650 20 20 20 20 28 69 66 20 28 66 6c 61 67 2d 73 65 (if (flag-se
26660 74 3f 20 66 6c 61 67 73 20 7e 63 61 73 65 2d 69 t? flags ~case-i
26670 6e 73 65 6e 73 69 74 69 76 65 3f 29 0a 3b 3b 20 nsensitive?).;;
26680 20 20 20 20 20 20 20 20 20 20 28 72 65 63 20 28 (rec (
26690 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 73 74 sre-sequence (st
266a0 72 69 6e 67 2d 3e 6c 69 73 74 20 73 72 65 29 29 ring->list sre))
266b0 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 28 ).;; (
266c0 6c 65 74 20 28 28 6c 65 6e 20 28 73 74 72 69 6e let ((len (strin
266d0 67 2d 6c 65 6e 67 74 68 20 73 72 65 29 29 29 0a g-length sre))).
266e0 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ;; (
266f0 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
26700 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
26710 61 74 63 68 65 73 20 66 61 69 6c 29 0a 3b 3b 20 atches fail).;;
26720 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
26730 66 20 28 61 6e 64 20 28 3c 3d 20 28 2b 20 69 20 f (and (<= (+ i
26740 6c 65 6e 29 20 65 6e 64 29 0a 3b 3b 20 20 20 20 len) end).;;
26750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26760 20 20 20 20 28 25 73 75 62 73 74 72 69 6e 67 3d (%substring=
26770 3f 20 73 72 65 20 73 74 72 20 30 20 69 20 6c 65 ? sre str 0 i le
26780 6e 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 n)).;;
26790 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 73 (next s
267a0 74 72 20 28 2b 20 69 20 6c 65 6e 29 20 6d 61 74 tr (+ i len) mat
267b0 63 68 65 73 20 66 61 69 6c 29 0a 3b 3b 20 20 20 ches fail).;;
267c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
267d0 28 66 61 69 6c 29 29 29 29 29 0a 20 20 20 20 20 (fail))))).
267e0 20 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 ). (else.
267f0 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e 6b 6e (error "unkn
26800 6f 77 6e 20 72 65 67 65 78 70 22 20 73 72 65 29 own regexp" sre)
26810 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ))))..;;;;;;;;;;
26820 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
26830 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
26840 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
26850 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b ;;;;;;;;;;;;;;.;
26860 3b 3b 3b 20 43 68 61 72 61 63 74 65 72 20 53 65 ;;; Character Se
26870 74 73 0a 3b 3b 0a 3b 3b 20 53 69 6d 70 6c 65 20 ts.;;.;; Simple
26880 63 68 61 72 61 63 74 65 72 20 73 65 74 73 20 61 character sets a
26890 73 20 6c 69 73 74 73 20 6f 66 20 72 61 6e 67 65 s lists of range
268a0 73 2c 20 61 73 20 75 73 65 64 20 69 6e 20 74 68 s, as used in th
268b0 65 20 4e 46 41 2f 44 46 41 0a 3b 3b 20 63 6f 6d e NFA/DFA.;; com
268c0 70 69 6c 61 74 69 6f 6e 2e 20 20 54 68 69 73 20 pilation. This
268d0 69 73 20 6e 6f 74 20 65 73 70 65 63 69 61 6c 6c is not especiall
268e0 79 20 65 66 66 69 63 69 65 6e 74 2c 20 62 75 74 y efficient, but
268f0 20 69 73 20 70 6f 72 74 61 62 6c 65 20 61 6e 64 is portable and
26900 0a 3b 3b 20 73 63 61 6c 61 62 6c 65 20 66 6f 72 .;; scalable for
26910 20 61 6e 79 20 72 61 6e 67 65 20 6f 66 20 63 68 any range of ch
26920 61 72 61 63 74 65 72 20 73 65 74 73 2e 0a 0a 28 aracter sets...(
26930 64 65 66 69 6e 65 20 28 73 72 65 2d 63 73 65 74 define (sre-cset
26940 2d 3e 70 72 6f 63 65 64 75 72 65 20 63 73 65 74 ->procedure cset
26950 20 6e 65 78 74 29 0a 20 20 28 6c 61 6d 62 64 61 next). (lambda
26960 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 (cnk init src s
26970 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
26980 20 66 61 69 6c 29 0a 20 20 20 20 28 69 66 20 28 fail). (if (
26990 3c 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 20 < i end).
269a0 20 28 69 66 20 28 63 73 65 74 2d 63 6f 6e 74 61 (if (cset-conta
269b0 69 6e 73 3f 20 63 73 65 74 20 28 73 74 72 69 6e ins? cset (strin
269c0 67 2d 72 65 66 20 73 74 72 20 69 29 29 0a 20 20 g-ref str i)).
269d0 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
269e0 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
269f0 20 28 2b 20 69 20 31 29 20 65 6e 64 20 6d 61 74 (+ i 1) end mat
26a00 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
26a10 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 0a 20 (fail)).
26a20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 72 (let ((sr
26a30 63 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 c2 ((chunker-get
26a40 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 29 29 -next cnk) src))
26a50 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 20 ). (if
26a60 73 72 63 32 0a 20 20 20 20 20 20 20 20 20 20 20 src2.
26a70 20 20 20 28 6c 65 74 20 28 28 73 74 72 32 20 28 (let ((str2 (
26a80 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 (chunker-get-str
26a90 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 cnk) src2)).
26aa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26ab0 20 28 69 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 (i2 ((chunker-g
26ac0 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 et-start cnk) sr
26ad0 63 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 c2)).
26ae0 20 20 20 20 20 20 20 20 20 28 65 6e 64 32 20 28 (end2 (
26af0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 (chunker-get-end
26b00 20 63 6e 6b 29 20 73 72 63 32 29 29 29 0a 20 20 cnk) src2))).
26b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
26b20 66 20 28 63 73 65 74 2d 63 6f 6e 74 61 69 6e 73 f (cset-contains
26b30 3f 20 63 73 65 74 20 28 73 74 72 69 6e 67 2d 72 ? cset (string-r
26b40 65 66 20 73 74 72 32 20 69 32 29 29 0a 20 20 20 ef str2 i2)).
26b50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26b60 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 (next cnk init
26b70 73 72 63 32 20 73 74 72 32 20 28 2b 20 69 32 20 src2 str2 (+ i2
26b80 31 29 20 65 6e 64 32 20 6d 61 74 63 68 65 73 20 1) end2 matches
26b90 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
26ba0 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 (fail)
26bb0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
26bc0 20 28 66 61 69 6c 29 29 29 29 29 29 0a 0a 28 64 (fail))))))..(d
26bd0 65 66 69 6e 65 20 28 6d 61 6b 65 2d 63 73 65 74 efine (make-cset
26be0 29 20 28 76 65 63 74 6f 72 29 29 0a 28 64 65 66 ) (vector)).(def
26bf0 69 6e 65 20 28 72 61 6e 67 65 2d 3e 63 73 65 74 ine (range->cset
26c00 20 66 72 6f 6d 20 74 6f 29 20 28 76 65 63 74 6f from to) (vecto
26c10 72 20 28 63 6f 6e 73 20 66 72 6f 6d 20 74 6f 29 r (cons from to)
26c20 29 29 0a 28 64 65 66 69 6e 65 20 28 63 68 61 72 )).(define (char
26c30 2d 3e 63 73 65 74 20 63 68 29 20 28 76 65 63 74 ->cset ch) (vect
26c40 6f 72 20 28 63 6f 6e 73 20 63 68 20 63 68 29 29 or (cons ch ch))
26c50 29 0a 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d ).(define (cset-
26c60 65 6d 70 74 79 3f 20 63 73 29 20 28 7a 65 72 6f empty? cs) (zero
26c70 3f 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 ? (vector-length
26c80 20 63 73 29 29 29 0a 28 64 65 66 69 6e 65 20 28 cs))).(define (
26c90 6d 61 79 62 65 2d 63 73 65 74 2d 3e 63 68 61 72 maybe-cset->char
26ca0 20 63 73 29 0a 20 20 28 69 66 20 28 61 6e 64 20 cs). (if (and
26cb0 28 3d 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 (= (vector-lengt
26cc0 68 20 63 73 29 20 31 29 0a 20 20 20 20 20 20 20 h cs) 1).
26cd0 20 20 20 20 28 63 68 61 72 3d 3f 20 28 63 61 72 (char=? (car
26ce0 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 73 20 (vector-ref cs
26cf0 30 29 29 20 28 63 64 72 20 28 76 65 63 74 6f 72 0)) (cdr (vector
26d00 2d 72 65 66 20 63 73 20 30 29 29 29 29 0a 20 20 -ref cs 0)))).
26d10 20 20 20 20 28 63 61 72 20 28 76 65 63 74 6f 72 (car (vector
26d20 2d 72 65 66 20 63 73 20 30 29 29 0a 20 20 20 20 -ref cs 0)).
26d30 20 20 63 73 29 29 0a 0a 3b 3b 20 53 69 6e 63 65 cs))..;; Since
26d40 20 63 73 65 74 73 20 61 72 65 20 73 6f 72 74 65 csets are sorte
26d50 64 2c 20 74 68 65 72 65 27 73 20 6f 6e 6c 79 20 d, there's only
26d60 6f 6e 65 20 70 6f 73 73 69 62 6c 65 20 72 65 70 one possible rep
26d70 72 65 73 65 6e 74 61 74 69 6f 6e 20 6f 66 20 61 resentation of a
26d80 6e 79 20 63 73 65 74 0a 28 64 65 66 69 6e 65 20 ny cset.(define
26d90 63 73 65 74 3d 3f 20 65 71 75 61 6c 3f 29 0a 0a cset=? equal?)..
26da0 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d 73 69 (define (cset-si
26db0 7a 65 20 63 73 29 0a 20 20 28 6c 65 74 20 28 28 ze cs). (let ((
26dc0 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 len (vector-leng
26dd0 74 68 20 63 73 29 29 29 0a 20 20 20 28 6c 65 74 th cs))). (let
26de0 20 6c 70 20 28 28 69 20 30 29 20 28 73 69 7a 65 lp ((i 0) (size
26df0 20 30 29 29 0a 20 20 20 20 20 28 69 66 20 28 3d 0)). (if (=
26e00 20 69 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 i len).
26e10 20 73 69 7a 65 0a 20 20 20 20 20 20 20 20 20 28 size. (
26e20 6c 70 20 28 2b 20 69 20 31 29 20 28 2b 20 73 69 lp (+ i 1) (+ si
26e30 7a 65 20 31 0a 20 20 20 20 20 20 20 20 20 20 20 ze 1.
26e40 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 (-
26e50 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 28 (char->integer (
26e60 63 64 72 20 28 76 65 63 74 6f 72 2d 72 65 66 20 cdr (vector-ref
26e70 63 73 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 cs i))).
26e80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26e90 20 20 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 (char->intege
26ea0 72 20 28 63 61 72 20 28 76 65 63 74 6f 72 2d 72 r (car (vector-r
26eb0 65 66 20 63 73 20 69 29 29 29 29 29 29 29 29 29 ef cs i)))))))))
26ec0 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 73 65 74 )..(define (cset
26ed0 2d 3e 70 6c 69 73 74 20 63 73 29 0a 20 20 28 6c ->plist cs). (l
26ee0 65 74 20 6c 70 20 28 28 69 20 28 2d 20 28 76 65 et lp ((i (- (ve
26ef0 63 74 6f 72 2d 6c 65 6e 67 74 68 20 63 73 29 20 ctor-length cs)
26f00 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 1)). (
26f10 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 69 res '())). (i
26f20 66 20 28 3d 20 69 20 2d 31 29 0a 20 20 20 20 20 f (= i -1).
26f30 20 20 20 72 65 73 0a 20 20 20 20 20 20 20 20 28 res. (
26f40 6c 70 20 28 2d 20 69 20 31 29 20 28 63 6f 6e 73 lp (- i 1) (cons
26f50 20 28 63 61 72 20 28 76 65 63 74 6f 72 2d 72 65 (car (vector-re
26f60 66 20 63 73 20 69 29 29 0a 20 20 20 20 20 20 20 f cs i)).
26f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
26f80 20 20 20 28 63 6f 6e 73 20 28 63 64 72 20 28 76 (cons (cdr (v
26f90 65 63 74 6f 72 2d 72 65 66 20 63 73 20 69 29 29 ector-ref cs i))
26fa0 20 72 65 73 29 29 29 29 29 29 0a 0a 28 64 65 66 res))))))..(def
26fb0 69 6e 65 20 28 70 6c 69 73 74 2d 3e 63 73 65 74 ine (plist->cset
26fc0 20 6c 73 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 ls). (let lp (
26fd0 28 6c 73 20 6c 73 29 20 28 72 65 73 20 28 6d 61 (ls ls) (res (ma
26fe0 6b 65 2d 63 73 65 74 29 29 29 0a 20 20 20 20 28 ke-cset))). (
26ff0 69 66 20 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 if (null? ls).
27000 20 20 20 20 20 20 72 65 73 0a 20 20 20 20 20 20 res.
27010 20 20 28 6c 70 20 28 63 64 64 72 20 6c 73 29 20 (lp (cddr ls)
27020 28 63 73 65 74 2d 75 6e 69 6f 6e 20 28 72 61 6e (cset-union (ran
27030 67 65 2d 3e 63 73 65 74 20 28 63 61 72 20 6c 73 ge->cset (car ls
27040 29 20 28 63 61 64 72 20 6c 73 29 29 20 72 65 73 ) (cadr ls)) res
27050 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
27060 73 74 72 69 6e 67 2d 3e 63 73 65 74 20 73 29 0a string->cset s).
27070 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 (fold (lambda
27080 28 63 68 20 63 73 29 0a 20 20 20 20 20 20 20 20 (ch cs).
27090 20 20 28 63 73 65 74 2d 61 64 6a 6f 69 6e 20 63 (cset-adjoin c
270a0 73 20 63 68 29 29 0a 20 20 20 20 20 20 20 20 28 s ch)). (
270b0 6d 61 6b 65 2d 63 73 65 74 29 0a 20 20 20 20 20 make-cset).
270c0 20 20 20 28 73 74 72 69 6e 67 2d 3e 6c 69 73 74 (string->list
270d0 20 73 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 s)))..(define (
270e0 73 72 65 2d 3e 63 73 65 74 20 73 72 65 20 2e 20 sre->cset sre .
270f0 6f 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 73 o). (let lp ((s
27100 72 65 20 73 72 65 29 20 28 63 69 3f 20 28 61 6e re sre) (ci? (an
27110 64 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 72 d (pair? o) (car
27120 20 6f 29 29 29 29 0a 20 20 20 20 28 64 65 66 69 o)))). (defi
27130 6e 65 20 28 72 65 63 20 73 72 65 29 20 28 6c 70 ne (rec sre) (lp
27140 20 73 72 65 20 63 69 3f 29 29 0a 20 20 20 20 28 sre ci?)). (
27150 63 6f 6e 64 0a 20 20 20 20 20 28 28 70 61 69 72 cond. ((pair
27160 3f 20 73 72 65 29 0a 20 20 20 20 20 20 28 69 66 ? sre). (if
27170 20 28 73 74 72 69 6e 67 3f 20 28 63 61 72 20 73 (string? (car s
27180 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 re)). (
27190 69 66 20 63 69 3f 0a 20 20 20 20 20 20 20 20 20 if ci?.
271a0 20 20 20 20 20 28 63 73 65 74 2d 63 61 73 65 2d (cset-case-
271b0 69 6e 73 65 6e 73 69 74 69 76 65 20 28 73 74 72 insensitive (str
271c0 69 6e 67 2d 3e 63 73 65 74 20 28 63 61 72 20 73 ing->cset (car s
271d0 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 re))).
271e0 20 20 20 20 28 73 74 72 69 6e 67 2d 3e 63 73 65 (string->cse
271f0 74 20 28 63 61 72 20 73 72 65 29 29 29 0a 20 20 t (car sre))).
27200 20 20 20 20 20 20 20 20 28 63 61 73 65 20 28 63 (case (c
27210 61 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 ar sre).
27220 20 20 20 20 28 28 7e 29 0a 20 20 20 20 20 20 20 ((~).
27230 20 20 20 20 20 20 28 63 73 65 74 2d 63 6f 6d 70 (cset-comp
27240 6c 65 6d 65 6e 74 0a 20 20 20 20 20 20 20 20 20 lement.
27250 20 20 20 20 20 28 66 6f 6c 64 20 63 73 65 74 2d (fold cset-
27260 75 6e 69 6f 6e 20 28 72 65 63 20 28 63 61 64 72 union (rec (cadr
27270 20 73 72 65 29 29 20 28 6d 61 70 20 72 65 63 20 sre)) (map rec
27280 28 63 64 64 72 20 73 72 65 29 29 29 29 29 0a 20 (cddr sre))))).
27290 20 20 20 20 20 20 20 20 20 20 20 28 28 26 29 0a ((&).
272a0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6f (fo
272b0 6c 64 20 63 73 65 74 2d 69 6e 74 65 72 73 65 63 ld cset-intersec
272c0 74 69 6f 6e 20 28 72 65 63 20 28 63 61 64 72 20 tion (rec (cadr
272d0 73 72 65 29 29 20 28 6d 61 70 20 72 65 63 20 28 sre)) (map rec (
272e0 63 64 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 cddr sre)))).
272f0 20 20 20 20 20 20 20 20 20 28 28 2d 29 0a 20 20 ((-).
27300 20 20 20 20 20 20 20 20 20 20 20 28 66 6f 6c 64 (fold
27310 20 28 6c 61 6d 62 64 61 20 28 78 20 72 65 73 29 (lambda (x res)
27320 20 28 63 73 65 74 2d 64 69 66 66 65 72 65 6e 63 (cset-differenc
27330 65 20 72 65 73 20 78 29 29 0a 20 20 20 20 20 20 e res x)).
27340 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
27350 63 20 28 63 61 64 72 20 73 72 65 29 29 0a 20 20 c (cadr sre)).
27360 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27370 20 28 6d 61 70 20 72 65 63 20 28 63 64 64 72 20 (map rec (cddr
27380 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
27390 20 20 20 20 28 28 2f 29 0a 20 20 20 20 20 20 20 ((/).
273a0 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
273b0 20 28 70 6c 69 73 74 2d 3e 63 73 65 74 20 28 73 (plist->cset (s
273c0 72 65 2d 66 6c 61 74 74 65 6e 2d 72 61 6e 67 65 re-flatten-range
273d0 73 20 28 63 64 72 20 73 72 65 29 29 29 29 29 0a s (cdr sre))))).
273e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
273f0 69 66 20 63 69 3f 0a 20 20 20 20 20 20 20 20 20 if ci?.
27400 20 20 20 20 20 20 20 20 20 20 28 63 73 65 74 2d (cset-
27410 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 case-insensitive
27420 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 res).
27430 20 20 20 20 20 20 20 20 20 72 65 73 29 29 29 0a res))).
27440 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 ((or
27450 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
27460 66 6f 6c 64 20 63 73 65 74 2d 75 6e 69 6f 6e 20 fold cset-union
27470 28 72 65 63 20 28 63 61 64 72 20 73 72 65 29 29 (rec (cadr sre))
27480 20 28 6d 61 70 20 72 65 63 20 28 63 64 64 72 20 (map rec (cddr
27490 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
274a0 20 20 20 20 28 28 77 2f 63 61 73 65 29 0a 20 20 ((w/case).
274b0 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
274c0 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 28 63 sre-alternate (c
274d0 64 72 20 73 72 65 29 29 20 23 66 29 29 0a 20 20 dr sre)) #f)).
274e0 20 20 20 20 20 20 20 20 20 20 28 28 77 2f 6e 6f ((w/no
274f0 63 61 73 65 29 0a 20 20 20 20 20 20 20 20 20 20 case).
27500 20 20 20 28 6c 70 20 28 73 72 65 2d 61 6c 74 65 (lp (sre-alte
27510 72 6e 61 74 65 20 28 63 64 72 20 73 72 65 29 29 rnate (cdr sre))
27520 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 #t)).
27530 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
27540 20 20 20 20 20 28 65 72 72 6f 72 20 22 6e 6f 74 (error "not
27550 20 61 20 76 61 6c 69 64 20 73 72 65 20 63 68 61 a valid sre cha
27560 72 2d 73 65 74 20 6f 70 65 72 61 74 6f 72 22 20 r-set operator"
27570 73 72 65 29 29 29 29 29 0a 20 20 20 20 20 28 28 sre))))). ((
27580 63 68 61 72 3f 20 73 72 65 29 20 28 69 66 20 63 char? sre) (if c
27590 69 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i?.
275a0 20 20 20 20 20 20 20 20 20 28 63 73 65 74 2d 63 (cset-c
275b0 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 20 ase-insensitive
275c0 28 72 61 6e 67 65 2d 3e 63 73 65 74 20 73 72 65 (range->cset sre
275d0 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
275e0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 61 (ra
275f0 6e 67 65 2d 3e 63 73 65 74 20 73 72 65 20 73 72 nge->cset sre sr
27600 65 29 29 29 0a 20 20 20 20 20 28 28 73 74 72 69 e))). ((stri
27610 6e 67 3f 20 73 72 65 29 20 28 72 65 63 20 28 6c ng? sre) (rec (l
27620 69 73 74 20 73 72 65 29 29 29 0a 20 20 20 20 20 ist sre))).
27630 28 65 6c 73 65 0a 20 20 20 20 20 20 28 6c 65 74 (else. (let
27640 20 28 28 63 65 6c 6c 20 28 61 73 73 71 20 73 72 ((cell (assq sr
27650 65 20 73 72 65 2d 6e 61 6d 65 64 2d 64 65 66 69 e sre-named-defi
27660 6e 69 74 69 6f 6e 73 29 29 29 0a 20 20 20 20 20 nitions))).
27670 20 20 20 28 69 66 20 63 65 6c 6c 0a 20 20 20 20 (if cell.
27680 20 20 20 20 20 20 20 20 28 72 65 63 20 28 63 64 (rec (cd
27690 72 20 63 65 6c 6c 29 29 0a 20 20 20 20 20 20 20 r cell)).
276a0 20 20 20 20 20 28 65 72 72 6f 72 20 22 6e 6f 74 (error "not
276b0 20 61 20 76 61 6c 69 64 20 73 72 65 20 63 68 61 a valid sre cha
276c0 72 2d 73 65 74 22 20 73 72 65 29 29 29 29 29 29 r-set" sre))))))
276d0 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 73 65 74 )..(define (cset
276e0 2d 3e 73 72 65 20 63 73 65 74 29 0a 20 20 28 63 ->sre cset). (c
276f0 6f 6e 73 20 27 2f 0a 20 20 20 20 20 20 20 20 28 ons '/. (
27700 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 28 78 20 fold (lambda (x
27710 72 65 73 29 20 28 63 6f 6e 73 20 28 63 61 72 20 res) (cons (car
27720 78 29 20 28 63 6f 6e 73 20 28 63 64 72 20 78 29 x) (cons (cdr x)
27730 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 res))).
27740 20 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 20 '().
27750 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
27760 3e 6c 69 73 74 20 63 73 65 74 29 29 29 29 0a 0a >list cset))))..
27770 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d 63 6f (define (cset-co
27780 6e 74 61 69 6e 73 3f 20 63 73 65 74 20 63 68 29 ntains? cset ch)
27790 0a 20 20 28 6c 65 74 20 28 28 6c 65 6e 20 28 76 . (let ((len (v
277a0 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 63 73 65 ector-length cse
277b0 74 29 29 29 0a 20 20 20 20 28 63 61 73 65 20 6c t))). (case l
277c0 65 6e 0a 20 20 20 20 20 20 28 28 30 29 20 23 66 en. ((0) #f
277d0 29 0a 20 20 20 20 20 20 28 28 31 29 20 28 6c 65 ). ((1) (le
277e0 74 20 28 28 72 61 6e 67 65 20 28 76 65 63 74 6f t ((range (vecto
277f0 72 2d 72 65 66 20 63 73 65 74 20 30 29 29 29 0a r-ref cset 0))).
27800 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
27810 64 20 28 63 68 61 72 3c 3d 3f 20 63 68 20 28 63 d (char<=? ch (c
27820 64 72 20 72 61 6e 67 65 29 29 20 28 63 68 61 72 dr range)) (char
27830 3c 3d 3f 20 28 63 61 72 20 72 61 6e 67 65 29 20 <=? (car range)
27840 63 68 29 29 29 29 0a 20 20 20 20 20 20 28 65 6c ch)))). (el
27850 73 65 20 28 6c 65 74 20 6c 70 20 28 28 6c 6f 77 se (let lp ((low
27860 65 72 20 30 29 20 28 75 70 70 65 72 20 6c 65 6e er 0) (upper len
27870 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
27880 20 28 6c 65 74 2a 20 28 28 6d 69 64 64 6c 65 20 (let* ((middle
27890 28 71 75 6f 74 69 65 6e 74 20 28 2b 20 75 70 70 (quotient (+ upp
278a0 65 72 20 6c 6f 77 65 72 29 20 32 29 29 0a 20 20 er lower) 2)).
278b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
278c0 20 20 20 28 72 61 6e 67 65 20 28 76 65 63 74 6f (range (vecto
278d0 72 2d 72 65 66 20 63 73 65 74 20 6d 69 64 64 6c r-ref cset middl
278e0 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 e))).
278f0 20 20 20 20 20 28 63 6f 6e 64 20 28 28 63 68 61 (cond ((cha
27900 72 3c 3f 20 28 63 64 72 20 72 61 6e 67 65 29 20 r<? (cdr range)
27910 63 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ch).
27920 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
27930 28 28 6e 65 78 74 20 28 2b 20 6d 69 64 64 6c 65 ((next (+ middle
27940 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 1))).
27950 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
27960 61 6e 64 20 28 3c 20 6e 65 78 74 20 75 70 70 65 and (< next uppe
27970 72 29 20 28 6c 70 20 6e 65 78 74 20 75 70 70 65 r) (lp next uppe
27980 72 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 r)))).
27990 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 68 ((ch
279a0 61 72 3c 3f 20 63 68 20 28 63 61 72 20 72 61 6e ar<? ch (car ran
279b0 67 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ge)).
279c0 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
279d0 20 28 3c 20 6c 6f 77 65 72 20 6d 69 64 64 6c 65 (< lower middle
279e0 29 20 28 6c 70 20 6c 6f 77 65 72 20 6d 69 64 64 ) (lp lower midd
279f0 6c 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 le))).
27a00 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
27a10 65 20 23 74 29 29 29 29 29 29 29 29 0a 0a 28 64 e #t))))))))..(d
27a20 65 66 69 6e 65 20 28 63 68 61 72 2d 72 61 6e 67 efine (char-rang
27a30 65 73 2d 75 6e 69 6f 6e 20 61 20 62 29 0a 20 20 es-union a b).
27a40 28 63 6f 6e 73 20 28 69 66 20 28 63 68 61 72 3c (cons (if (char<
27a50 3d 3f 20 28 63 61 72 20 61 29 20 28 63 61 72 20 =? (car a) (car
27a60 62 29 29 20 28 63 61 72 20 61 29 20 28 63 61 72 b)) (car a) (car
27a70 20 62 29 29 0a 20 20 20 20 20 20 20 20 28 69 66 b)). (if
27a80 20 28 63 68 61 72 3e 3d 3f 20 28 63 64 72 20 61 (char>=? (cdr a
27a90 29 20 28 63 64 72 20 62 29 29 20 28 63 64 72 20 ) (cdr b)) (cdr
27aa0 61 29 20 28 63 64 72 20 62 29 29 29 29 0a 0a 28 a) (cdr b))))..(
27ab0 64 65 66 69 6e 65 20 28 63 73 65 74 2d 75 6e 69 define (cset-uni
27ac0 6f 6e 20 61 20 62 29 0a 20 20 28 6c 65 74 20 75 on a b). (let u
27ad0 6e 69 6f 6e 2d 72 61 6e 67 65 20 28 28 61 20 28 nion-range ((a (
27ae0 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 61 29 29 vector->list a))
27af0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
27b00 20 20 20 20 20 28 62 20 28 76 65 63 74 6f 72 2d (b (vector-
27b10 3e 6c 69 73 74 20 62 29 29 0a 20 20 20 20 20 20 >list b)).
27b20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
27b30 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 63 6f es '())). (co
27b40 6e 64 0a 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 nd. ((null?
27b50 61 29 20 28 6c 69 73 74 2d 3e 76 65 63 74 6f 72 a) (list->vector
27b60 20 28 72 65 76 65 72 73 65 20 28 61 70 70 65 6e (reverse (appen
27b70 64 20 28 72 65 76 65 72 73 65 20 62 29 20 72 65 d (reverse b) re
27b80 73 29 29 29 29 0a 20 20 20 20 20 28 28 6e 75 6c s)))). ((nul
27b90 6c 3f 20 62 29 20 28 6c 69 73 74 2d 3e 76 65 63 l? b) (list->vec
27ba0 74 6f 72 20 28 72 65 76 65 72 73 65 20 28 61 70 tor (reverse (ap
27bb0 70 65 6e 64 20 28 72 65 76 65 72 73 65 20 61 29 pend (reverse a)
27bc0 20 72 65 73 29 29 29 29 0a 20 20 20 20 20 28 65 res)))). (e
27bd0 6c 73 65 0a 20 20 20 20 20 20 28 6c 65 74 20 28 lse. (let (
27be0 28 61 2d 72 61 6e 67 65 20 28 63 61 72 20 61 29 (a-range (car a)
27bf0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 62 ). (b
27c00 2d 72 61 6e 67 65 20 28 63 61 72 20 62 29 29 29 -range (car b)))
27c10 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 . (cond.
27c20 20 20 20 20 20 20 20 20 3b 3b 20 43 61 6e 27 74 ;; Can't
27c30 20 75 73 65 20 6e 65 78 74 2d 63 68 61 72 20 68 use next-char h
27c40 65 72 65 20 73 69 6e 63 65 20 69 74 20 77 69 6c ere since it wil
27c50 6c 20 63 61 75 73 65 20 61 6e 20 65 72 72 6f 72 l cause an error
27c60 20 69 66 20 77 65 20 61 72 65 0a 20 20 20 20 20 if we are.
27c70 20 20 20 20 3b 3b 20 63 6f 6d 70 61 72 69 6e 67 ;; comparing
27c80 20 61 20 63 73 65 74 20 77 69 74 68 20 74 68 65 a cset with the
27c90 20 6d 61 78 69 6d 75 6d 20 63 68 61 72 61 63 74 maximum charact
27ca0 65 72 20 61 73 20 68 69 67 68 20 63 68 61 72 2e er as high char.
27cb0 0a 20 20 20 20 20 20 20 20 20 28 28 3c 20 28 2b . ((< (+
27cc0 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
27cd0 28 63 64 72 20 61 2d 72 61 6e 67 65 29 29 20 31 (cdr a-range)) 1
27ce0 29 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 ) (char->integer
27cf0 20 28 63 61 72 20 62 2d 72 61 6e 67 65 29 29 29 (car b-range)))
27d00 0a 20 20 20 20 20 20 20 20 20 20 28 75 6e 69 6f . (unio
27d10 6e 2d 72 61 6e 67 65 20 28 63 64 72 20 61 29 20 n-range (cdr a)
27d20 62 20 28 63 6f 6e 73 20 61 2d 72 61 6e 67 65 20 b (cons a-range
27d30 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 res))).
27d40 28 28 3e 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 ((> (char->integ
27d50 65 72 20 28 63 61 72 20 61 2d 72 61 6e 67 65 29 er (car a-range)
27d60 29 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 ) (+ (char->inte
27d70 67 65 72 20 28 63 64 72 20 62 2d 72 61 6e 67 65 ger (cdr b-range
27d80 29 29 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 )) 1)).
27d90 20 28 75 6e 69 6f 6e 2d 72 61 6e 67 65 20 28 63 (union-range (c
27da0 64 72 20 62 29 20 61 20 28 63 6f 6e 73 20 62 2d dr b) a (cons b-
27db0 72 61 6e 67 65 20 72 65 73 29 29 29 0a 20 20 20 range res))).
27dc0 20 20 20 20 20 20 28 28 63 68 61 72 3e 3d 3f 20 ((char>=?
27dd0 28 63 64 72 20 61 2d 72 61 6e 67 65 29 20 28 63 (cdr a-range) (c
27de0 61 72 20 62 2d 72 61 6e 67 65 29 29 0a 20 20 20 ar b-range)).
27df0 20 20 20 20 20 20 20 28 75 6e 69 6f 6e 2d 72 61 (union-ra
27e00 6e 67 65 20 28 63 6f 6e 73 20 28 63 68 61 72 2d nge (cons (char-
27e10 72 61 6e 67 65 73 2d 75 6e 69 6f 6e 20 61 2d 72 ranges-union a-r
27e20 61 6e 67 65 20 62 2d 72 61 6e 67 65 29 20 28 63 ange b-range) (c
27e30 64 72 20 61 29 29 0a 20 20 20 20 20 20 20 20 20 dr a)).
27e40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
27e50 64 72 20 62 29 0a 20 20 20 20 20 20 20 20 20 20 dr b).
27e60 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 res
27e70 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 73 )). (els
27e80 65 20 28 75 6e 69 6f 6e 2d 72 61 6e 67 65 20 28 e (union-range (
27e90 63 64 72 20 61 29 0a 20 20 20 20 20 20 20 20 20 cdr a).
27ea0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27eb0 20 20 20 28 63 6f 6e 73 20 28 63 68 61 72 2d 72 (cons (char-r
27ec0 61 6e 67 65 73 2d 75 6e 69 6f 6e 20 61 2d 72 61 anges-union a-ra
27ed0 6e 67 65 20 62 2d 72 61 6e 67 65 29 20 28 63 64 nge b-range) (cd
27ee0 72 20 62 29 29 0a 20 20 20 20 20 20 20 20 20 20 r b)).
27ef0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27f00 20 20 72 65 73 29 29 29 29 29 29 29 29 0a 0a 28 res))))))))..(
27f10 64 65 66 69 6e 65 20 28 63 73 65 74 2d 61 64 6a define (cset-adj
27f20 6f 69 6e 20 63 73 20 63 68 29 20 28 63 73 65 74 oin cs ch) (cset
27f30 2d 75 6e 69 6f 6e 20 63 73 20 28 63 68 61 72 2d -union cs (char-
27f40 3e 63 73 65 74 20 63 68 29 29 29 0a 0a 28 64 65 >cset ch)))..(de
27f50 66 69 6e 65 20 28 6e 65 78 74 2d 63 68 61 72 20 fine (next-char
27f60 63 29 0a 20 20 28 69 6e 74 65 67 65 72 2d 3e 63 c). (integer->c
27f70 68 61 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e har (+ (char->in
27f80 74 65 67 65 72 20 63 29 20 31 29 29 29 0a 0a 28 teger c) 1)))..(
27f90 64 65 66 69 6e 65 20 28 70 72 65 76 2d 63 68 61 define (prev-cha
27fa0 72 20 63 29 0a 20 20 28 69 6e 74 65 67 65 72 2d r c). (integer-
27fb0 3e 63 68 61 72 20 28 2d 20 28 63 68 61 72 2d 3e >char (- (char->
27fc0 69 6e 74 65 67 65 72 20 63 29 20 31 29 29 29 0a integer c) 1))).
27fd0 0a 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d 64 .(define (cset-d
27fe0 69 66 66 65 72 65 6e 63 65 20 61 20 62 29 0a 20 ifference a b).
27ff0 20 28 6c 65 74 20 64 69 66 66 20 28 28 61 20 28 (let diff ((a (
28000 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 61 29 29 vector->list a))
28010 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 . (b
28020 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 62 (vector->list b
28030 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
28040 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 (res '())). (
28050 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 61 29 20 cond ((null? a)
28060 28 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 28 72 (list->vector (r
28070 65 76 65 72 73 65 20 72 65 73 29 29 29 0a 20 20 everse res))).
28080 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 ((null?
28090 62 29 20 28 6c 69 73 74 2d 3e 76 65 63 74 6f 72 b) (list->vector
280a0 20 28 61 70 70 65 6e 64 20 28 72 65 76 65 72 73 (append (revers
280b0 65 20 72 65 73 29 20 61 29 29 29 0a 20 20 20 20 e res) a))).
280c0 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
280d0 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 2d (let ((a-
280e0 72 61 6e 67 65 20 28 63 61 72 20 61 29 29 0a 20 range (car a)).
280f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28100 28 62 2d 72 61 6e 67 65 20 28 63 61 72 20 62 29 (b-range (car b)
28110 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
28120 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
28130 20 20 20 20 28 28 63 68 61 72 3c 3f 20 28 63 64 ((char<? (cd
28140 72 20 61 2d 72 61 6e 67 65 29 20 28 63 61 72 20 r a-range) (car
28150 62 2d 72 61 6e 67 65 29 29 0a 20 20 20 20 20 20 b-range)).
28160 20 20 20 20 20 20 20 20 20 28 64 69 66 66 20 28 (diff (
28170 63 64 72 20 61 29 20 62 20 28 63 6f 6e 73 20 61 cdr a) b (cons a
28180 2d 72 61 6e 67 65 20 72 65 73 29 29 29 0a 20 20 -range res))).
28190 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 68 ((ch
281a0 61 72 3e 3f 20 28 63 61 72 20 61 2d 72 61 6e 67 ar>? (car a-rang
281b0 65 29 20 28 63 64 72 20 62 2d 72 61 6e 67 65 29 e) (cdr b-range)
281c0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
281d0 20 28 64 69 66 66 20 61 20 28 63 64 72 20 62 29 (diff a (cdr b)
281e0 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 res)).
281f0 20 20 20 20 20 28 28 61 6e 64 20 28 63 68 61 72 ((and (char
28200 3c 3d 3f 20 28 63 61 72 20 62 2d 72 61 6e 67 65 <=? (car b-range
28210 29 20 28 63 61 72 20 61 2d 72 61 6e 67 65 29 29 ) (car a-range))
28220 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
28230 20 20 20 20 20 28 63 68 61 72 3e 3d 3f 20 28 63 (char>=? (c
28240 64 72 20 62 2d 72 61 6e 67 65 29 20 28 63 64 72 dr b-range) (cdr
28250 20 61 2d 72 61 6e 67 65 29 29 29 0a 20 20 20 20 a-range))).
28260 20 20 20 20 20 20 20 20 20 20 20 28 64 69 66 66 (diff
28270 20 28 63 64 72 20 61 29 20 62 20 72 65 73 29 29 (cdr a) b res))
28280 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
28290 65 6c 73 65 20 28 6c 65 74 20 28 28 6c 65 66 74 else (let ((left
282a0 20 28 61 6e 64 20 28 63 68 61 72 3c 3f 20 28 63 (and (char<? (c
282b0 61 72 20 61 2d 72 61 6e 67 65 29 20 28 63 61 72 ar a-range) (car
282c0 20 62 2d 72 61 6e 67 65 29 29 0a 20 20 20 20 20 b-range)).
282d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
282e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
282f0 28 63 6f 6e 73 20 28 63 61 72 20 61 2d 72 61 6e (cons (car a-ran
28300 67 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ge).
28310 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
28330 70 72 65 76 2d 63 68 61 72 20 28 63 61 72 20 62 prev-char (car b
28340 2d 72 61 6e 67 65 29 29 29 29 29 0a 20 20 20 20 -range))))).
28350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28360 20 20 20 20 20 20 28 72 69 67 68 74 20 28 61 6e (right (an
28370 64 20 28 63 68 61 72 3e 3f 20 28 63 64 72 20 61 d (char>? (cdr a
28380 2d 72 61 6e 67 65 29 20 28 63 64 72 20 62 2d 72 -range) (cdr b-r
28390 61 6e 67 65 29 29 0a 20 20 20 20 20 20 20 20 20 ange)).
283a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
283b0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
283c0 6e 73 20 28 6e 65 78 74 2d 63 68 61 72 20 28 63 ns (next-char (c
283d0 64 72 20 62 2d 72 61 6e 67 65 29 29 0a 20 20 20 dr b-range)).
283e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
283f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28400 20 20 20 20 20 20 20 20 20 28 63 64 72 20 61 2d (cdr a-
28410 72 61 6e 67 65 29 29 29 29 29 0a 20 20 20 20 20 range))))).
28420 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28430 20 28 64 69 66 66 20 28 69 66 20 72 69 67 68 74 (diff (if right
28440 20 28 63 6f 6e 73 20 72 69 67 68 74 20 28 63 64 (cons right (cd
28450 72 20 61 29 29 20 28 63 64 72 20 61 29 29 0a 20 r a)) (cdr a)).
28460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28470 20 20 20 20 20 20 20 20 20 20 20 62 0a 20 20 20 b.
28480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28490 20 20 20 20 20 20 20 20 20 28 69 66 20 6c 65 66 (if lef
284a0 74 20 28 63 6f 6e 73 20 6c 65 66 74 20 72 65 73 t (cons left res
284b0 29 20 72 65 73 29 29 29 29 29 29 29 29 29 29 0a ) res)))))))))).
284c0 0a 28 64 65 66 69 6e 65 20 28 6d 69 6e 2d 63 68 .(define (min-ch
284d0 61 72 20 61 20 62 29 0a 20 20 28 69 66 20 28 63 ar a b). (if (c
284e0 68 61 72 3c 3f 20 61 20 62 29 20 61 20 62 29 29 har<? a b) a b))
284f0 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 78 2d 63 ..(define (max-c
28500 68 61 72 20 61 20 62 29 0a 20 20 28 69 66 20 28 har a b). (if (
28510 63 68 61 72 3c 3f 20 61 20 62 29 20 62 20 61 29 char<? a b) b a)
28520 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 73 65 74 )..(define (cset
28530 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 61 20 -intersection a
28540 62 29 0a 20 20 28 6c 65 74 20 69 6e 74 65 72 73 b). (let inters
28550 65 63 74 20 28 28 61 20 28 76 65 63 74 6f 72 2d ect ((a (vector-
28560 3e 6c 69 73 74 20 61 29 29 0a 20 20 20 20 20 20 >list a)).
28570 20 20 20 20 20 20 20 20 20 20 20 20 28 62 20 28 (b (
28580 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 62 29 29 vector->list b))
28590 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
285a0 20 20 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 (res '())).
285b0 20 20 28 69 66 20 28 6f 72 20 28 6e 75 6c 6c 3f (if (or (null?
285c0 20 61 29 20 28 6e 75 6c 6c 3f 20 62 29 29 0a 20 a) (null? b)).
285d0 20 20 20 20 20 20 20 28 6c 69 73 74 2d 3e 76 65 (list->ve
285e0 63 74 6f 72 20 28 72 65 76 65 72 73 65 20 72 65 ctor (reverse re
285f0 73 29 29 0a 20 20 20 20 20 20 20 20 28 6c 65 74 s)). (let
28600 20 28 28 61 2d 72 61 6e 67 65 20 28 63 61 72 20 ((a-range (car
28610 61 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 a)).
28620 20 20 28 62 2d 72 61 6e 67 65 20 28 63 61 72 20 (b-range (car
28630 62 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 b))). (
28640 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
28650 28 28 63 68 61 72 3c 3f 20 28 63 64 72 20 61 2d ((char<? (cdr a-
28660 72 61 6e 67 65 29 20 28 63 61 72 20 62 2d 72 61 range) (car b-ra
28670 6e 67 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 nge)).
28680 20 20 28 69 6e 74 65 72 73 65 63 74 20 28 63 64 (intersect (cd
28690 72 20 61 29 20 62 20 72 65 73 29 29 0a 20 20 20 r a) b res)).
286a0 20 20 20 20 20 20 20 20 28 28 63 68 61 72 3e 3f ((char>?
286b0 20 28 63 61 72 20 61 2d 72 61 6e 67 65 29 20 28 (car a-range) (
286c0 63 64 72 20 62 2d 72 61 6e 67 65 29 29 0a 20 20 cdr b-range)).
286d0 20 20 20 20 20 20 20 20 20 20 28 69 6e 74 65 72 (inter
286e0 73 65 63 74 20 61 20 28 63 64 72 20 62 29 20 72 sect a (cdr b) r
286f0 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
28700 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
28710 20 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 20 (let ((result
28720 28 63 6f 6e 73 20 28 6d 61 78 2d 63 68 61 72 20 (cons (max-char
28730 28 63 61 72 20 62 2d 72 61 6e 67 65 29 20 28 63 (car b-range) (c
28740 61 72 20 61 2d 72 61 6e 67 65 29 29 0a 20 20 20 ar a-range)).
28750 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28760 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 69 (mi
28770 6e 2d 63 68 61 72 20 28 63 64 72 20 61 2d 72 61 n-char (cdr a-ra
28780 6e 67 65 29 20 28 63 64 72 20 62 2d 72 61 6e 67 nge) (cdr b-rang
28790 65 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 e))))).
287a0 20 20 20 20 20 28 69 6e 74 65 72 73 65 63 74 20 (intersect
287b0 28 69 66 20 28 63 68 61 72 3e 3f 20 28 63 64 72 (if (char>? (cdr
287c0 20 61 2d 72 61 6e 67 65 29 20 28 63 64 72 20 72 a-range) (cdr r
287d0 65 73 75 6c 74 29 29 0a 20 20 20 20 20 20 20 20 esult)).
287e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
287f0 20 20 20 20 20 61 20 28 63 64 72 20 61 29 29 0a a (cdr a)).
28800 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28810 20 20 20 20 20 20 20 20 20 28 69 66 20 28 63 68 (if (ch
28820 61 72 3e 3f 20 28 63 64 72 20 62 2d 72 61 6e 67 ar>? (cdr b-rang
28830 65 29 20 28 63 64 72 20 72 65 73 75 6c 74 29 29 e) (cdr result))
28840 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
28850 20 20 20 20 20 20 20 20 20 20 20 20 20 20 62 20 b
28860 28 63 64 72 20 62 29 29 0a 20 20 20 20 20 20 20 (cdr b)).
28870 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28880 20 20 28 63 6f 6e 73 20 72 65 73 75 6c 74 20 72 (cons result r
28890 65 73 29 29 29 29 29 29 29 29 29 0a 0a 28 64 65 es)))))))))..(de
288a0 66 69 6e 65 20 28 63 73 65 74 2d 63 6f 6d 70 6c fine (cset-compl
288b0 65 6d 65 6e 74 20 61 29 0a 20 20 28 63 73 65 74 ement a). (cset
288c0 2d 64 69 66 66 65 72 65 6e 63 65 20 28 73 72 65 -difference (sre
288d0 2d 3e 63 73 65 74 20 2a 61 6c 6c 2d 63 68 61 72 ->cset *all-char
288e0 73 2a 29 20 61 29 29 0a 0a 3b 3b 20 54 68 69 73 s*) a))..;; This
288f0 20 63 6f 75 6c 64 20 75 73 65 20 73 6f 6d 65 20 could use some
28900 6f 70 74 69 6d 69 7a 61 74 69 6f 6e 20 3a 29 0a optimization :).
28910 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d 63 61 (define (cset-ca
28920 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 20 61 se-insensitive a
28930 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 ). (let lp ((ls
28940 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 61 (vector->list a
28950 29 29 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 )) (res '())).
28960 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 (cond ((null?
28970 6c 73 29 20 28 6c 69 73 74 2d 3e 76 65 63 74 6f ls) (list->vecto
28980 72 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 r (reverse res))
28990 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 61 6e ). ((an
289a0 64 20 28 63 68 61 72 2d 61 6c 70 68 61 62 65 74 d (char-alphabet
289b0 69 63 3f 20 28 63 61 61 72 20 6c 73 29 29 0a 20 ic? (caar ls)).
289c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
289d0 63 68 61 72 2d 61 6c 70 68 61 62 65 74 69 63 3f char-alphabetic?
289e0 20 28 63 64 61 72 20 6c 73 29 29 29 0a 20 20 20 (cdar ls))).
289f0 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 (lp (cdr
28a00 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls).
28a10 20 20 20 20 28 72 65 76 65 72 73 65 0a 20 20 20 (reverse.
28a20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
28a30 63 74 6f 72 2d 3e 6c 69 73 74 0a 20 20 20 20 20 ctor->list.
28a40 20 20 20 20 20 20 20 20 20 20 20 20 28 63 73 65 (cse
28a50 74 2d 75 6e 69 6f 6e 20 28 63 73 65 74 2d 75 6e t-union (cset-un
28a60 69 6f 6e 20 28 6c 69 73 74 2d 3e 76 65 63 74 6f ion (list->vecto
28a70 72 20 28 72 65 76 65 72 73 65 20 72 65 73 29 29 r (reverse res))
28a80 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
28a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28aa0 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
28ab0 72 20 28 63 61 72 20 6c 73 29 29 29 0a 20 20 20 r (car ls))).
28ac0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28ad0 20 20 20 20 20 20 20 20 20 20 28 72 61 6e 67 65 (range
28ae0 2d 3e 63 73 65 74 20 28 63 68 61 72 2d 61 6c 74 ->cset (char-alt
28af0 63 61 73 65 20 28 63 61 61 72 20 6c 73 29 29 0a case (caar ls)).
28b00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28b20 20 20 20 20 20 20 20 20 20 20 28 63 68 61 72 2d (char-
28b30 61 6c 74 63 61 73 65 20 28 63 64 61 72 20 6c 73 altcase (cdar ls
28b40 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 )))))))).
28b50 20 20 20 28 65 6c 73 65 20 28 6c 70 20 28 63 64 (else (lp (cd
28b60 72 20 6c 73 29 20 28 72 65 76 65 72 73 65 20 28 r ls) (reverse (
28b70 76 65 63 74 6f 72 2d 3e 6c 69 73 74 0a 20 20 20 vector->list.
28b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28b90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28ba0 20 20 20 20 28 63 73 65 74 2d 75 6e 69 6f 6e 20 (cset-union
28bb0 28 6c 69 73 74 2d 3e 76 65 63 74 6f 72 20 28 72 (list->vector (r
28bc0 65 76 65 72 73 65 20 72 65 73 29 29 0a 20 20 20 everse res)).
28bd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28be0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28bf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28c00 28 76 65 63 74 6f 72 20 28 63 61 72 20 6c 73 29 (vector (car ls)
28c10 29 29 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b )))))))))..;;;;;
28c20 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
28c30 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
28c40 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
28c50 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
28c60 3b 3b 3b 0a 3b 3b 3b 3b 20 4d 61 74 63 68 20 61 ;;;.;;;; Match a
28c70 6e 64 20 52 65 70 6c 61 63 65 20 55 74 69 6c 69 nd Replace Utili
28c80 74 69 65 73 0a 0a 28 64 65 66 69 6e 65 20 28 69 ties..(define (i
28c90 72 72 65 67 65 78 2d 66 6f 6c 64 2f 66 61 73 74 rregex-fold/fast
28ca0 20 69 72 78 20 6b 6f 6e 73 20 6b 6e 69 6c 20 73 irx kons knil s
28cb0 74 72 20 2e 20 6f 29 0a 20 20 28 69 66 20 28 6e tr . o). (if (n
28cc0 6f 74 20 28 73 74 72 69 6e 67 3f 20 73 74 72 29 ot (string? str)
28cd0 29 20 28 65 72 72 6f 72 20 22 69 72 72 65 67 65 ) (error "irrege
28ce0 78 2d 66 6f 6c 64 3a 20 6e 6f 74 20 61 20 73 74 x-fold: not a st
28cf0 72 69 6e 67 22 20 73 74 72 29 29 0a 20 20 28 6c ring" str)). (l
28d00 65 74 2a 20 28 28 69 72 78 20 28 69 72 72 65 67 et* ((irx (irreg
28d10 65 78 20 69 72 78 29 29 0a 20 20 20 20 20 20 20 ex irx)).
28d20 20 20 28 6d 61 74 63 68 65 73 20 28 69 72 72 65 (matches (irre
28d30 67 65 78 2d 6e 65 77 2d 6d 61 74 63 68 65 73 20 gex-new-matches
28d40 69 72 78 29 29 0a 20 20 20 20 20 20 20 20 20 28 irx)). (
28d50 66 69 6e 69 73 68 20 28 6f 72 20 28 61 6e 64 20 finish (or (and
28d60 28 70 61 69 72 3f 20 6f 29 20 28 63 61 72 20 6f (pair? o) (car o
28d70 29 29 20 28 6c 61 6d 62 64 61 20 28 69 20 61 63 )) (lambda (i ac
28d80 63 29 20 61 63 63 29 29 29 0a 20 20 20 20 20 20 c) acc))).
28d90 20 20 20 28 73 74 61 72 74 20 28 69 66 20 28 61 (start (if (a
28da0 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 28 70 61 nd (pair? o) (pa
28db0 69 72 3f 20 28 63 64 72 20 6f 29 29 29 20 28 63 ir? (cdr o))) (c
28dc0 61 64 72 20 6f 29 20 30 29 29 0a 20 20 20 20 20 adr o) 0)).
28dd0 20 20 20 20 28 65 6e 64 20 28 69 66 20 28 61 6e (end (if (an
28de0 64 20 28 70 61 69 72 3f 20 6f 29 20 28 70 61 69 d (pair? o) (pai
28df0 72 3f 20 28 63 64 72 20 6f 29 29 20 28 70 61 69 r? (cdr o)) (pai
28e00 72 3f 20 28 63 64 64 72 20 6f 29 29 29 0a 20 20 r? (cddr o))).
28e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
28e20 28 63 61 64 64 72 20 6f 29 0a 20 20 20 20 20 20 (caddr o).
28e30 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 72 (str
28e40 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 ing-length str))
28e50 29 0a 20 20 20 20 20 20 20 20 20 28 69 6e 69 74 ). (init
28e60 2d 73 72 63 20 28 6c 69 73 74 20 73 74 72 20 73 -src (list str s
28e70 74 61 72 74 20 65 6e 64 29 29 0a 20 20 20 20 20 tart end)).
28e80 20 20 20 20 28 69 6e 69 74 20 28 63 6f 6e 73 20 (init (cons
28e90 69 6e 69 74 2d 73 72 63 20 73 74 61 72 74 29 29 init-src start))
28ea0 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
28eb0 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 73 74 and (integer? st
28ec0 61 72 74 29 20 28 65 78 61 63 74 3f 20 73 74 61 art) (exact? sta
28ed0 72 74 29 29 29 0a 20 20 20 20 20 20 20 20 28 65 rt))). (e
28ee0 72 72 6f 72 20 22 69 72 72 65 67 65 78 2d 66 6f rror "irregex-fo
28ef0 6c 64 3a 20 6e 6f 74 20 61 6e 20 65 78 61 63 74 ld: not an exact
28f00 20 69 6e 74 65 67 65 72 22 20 73 74 61 72 74 29 integer" start)
28f10 29 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 ). (if (not (
28f20 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 65 6e and (integer? en
28f30 64 29 20 28 65 78 61 63 74 3f 20 65 6e 64 29 29 d) (exact? end))
28f40 29 0a 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 ). (error
28f50 20 22 69 72 72 65 67 65 78 2d 66 6f 6c 64 3a 20 "irregex-fold:
28f60 6e 6f 74 20 61 6e 20 65 78 61 63 74 20 69 6e 74 not an exact int
28f70 65 67 65 72 22 20 65 6e 64 29 29 0a 20 20 20 20 eger" end)).
28f80 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 63 (irregex-match-c
28f90 68 75 6e 6b 65 72 2d 73 65 74 21 20 6d 61 74 63 hunker-set! matc
28fa0 68 65 73 20 69 72 72 65 67 65 78 2d 62 61 73 69 hes irregex-basi
28fb0 63 2d 73 74 72 69 6e 67 2d 63 68 75 6e 6b 65 72 c-string-chunker
28fc0 29 0a 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 ). (let lp ((
28fd0 73 72 63 20 69 6e 69 74 2d 73 72 63 29 20 28 66 src init-src) (f
28fe0 72 6f 6d 20 73 74 61 72 74 29 20 28 69 20 73 74 rom start) (i st
28ff0 61 72 74 29 20 28 61 63 63 20 6b 6e 69 6c 29 29 art) (acc knil))
29000 0a 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 . (if (>= i
29010 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
29020 28 66 69 6e 69 73 68 20 66 72 6f 6d 20 61 63 63 (finish from acc
29030 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 ). (let
29040 20 28 28 6d 20 28 69 72 72 65 67 65 78 2d 73 65 ((m (irregex-se
29050 61 72 63 68 2f 6d 61 74 63 68 65 73 0a 20 20 20 arch/matches.
29060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29070 20 69 72 78 0a 20 20 20 20 20 20 20 20 20 20 20 irx.
29080 20 20 20 20 20 20 20 20 20 69 72 72 65 67 65 78 irregex
29090 2d 62 61 73 69 63 2d 73 74 72 69 6e 67 2d 63 68 -basic-string-ch
290a0 75 6e 6b 65 72 0a 20 20 20 20 20 20 20 20 20 20 unker.
290b0 20 20 20 20 20 20 20 20 20 20 69 6e 69 74 0a 20 init.
290c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
290d0 20 20 20 73 72 63 0a 20 20 20 20 20 20 20 20 20 src.
290e0 20 20 20 20 20 20 20 20 20 20 20 69 0a 20 20 20 i.
290f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29100 20 6d 61 74 63 68 65 73 29 29 29 0a 20 20 20 20 matches))).
29110 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 (if (not
29120 20 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 m).
29130 20 20 20 20 28 66 69 6e 69 73 68 20 66 72 6f 6d (finish from
29140 20 61 63 63 29 0a 20 20 20 20 20 20 20 20 20 20 acc).
29150 20 20 20 20 20 20 28 6c 65 74 20 28 28 6a 2d 73 (let ((j-s
29160 74 61 72 74 20 28 25 69 72 72 65 67 65 78 2d 6d tart (%irregex-m
29170 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 atch-start-index
29180 20 6d 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 m 0)).
29190 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6a 20 (j
291a0 28 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (%irregex-match-
291b0 65 6e 64 2d 69 6e 64 65 78 20 6d 20 30 29 29 0a end-index m 0)).
291c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
291d0 20 20 20 20 20 20 28 61 63 63 20 28 6b 6f 6e 73 (acc (kons
291e0 20 66 72 6f 6d 20 6d 20 61 63 63 29 29 29 0a 20 from m acc))).
291f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29200 20 28 69 72 72 65 67 65 78 2d 72 65 73 65 74 2d (irregex-reset-
29210 6d 61 74 63 68 65 73 21 20 6d 61 74 63 68 65 73 matches! matches
29220 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
29230 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
29240 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 66 ((f
29250 6c 61 67 2d 73 65 74 3f 20 28 69 72 72 65 67 65 lag-set? (irrege
29260 78 2d 66 6c 61 67 73 20 69 72 78 29 20 7e 63 6f x-flags irx) ~co
29270 6e 73 75 6d 65 72 3f 29 0a 20 20 20 20 20 20 20 nsumer?).
29280 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 69 (fi
29290 6e 69 73 68 20 6a 20 61 63 63 29 29 0a 20 20 20 nish j acc)).
292a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
292b0 28 28 3d 20 6a 20 6a 2d 73 74 61 72 74 29 0a 20 ((= j j-start).
292c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
292d0 20 20 20 3b 3b 20 73 6b 69 70 20 6f 6e 65 20 63 ;; skip one c
292e0 68 61 72 20 66 6f 72 77 61 72 64 20 69 66 20 77 har forward if w
292f0 65 20 6d 61 74 63 68 20 74 68 65 20 65 6d 70 74 e match the empt
29300 79 20 73 74 72 69 6e 67 0a 20 20 20 20 20 20 20 y string.
29310 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
29320 20 28 6c 69 73 74 20 73 74 72 20 6a 20 65 6e 64 (list str j end
29330 29 20 6a 20 28 2b 20 6a 20 31 29 20 61 63 63 29 ) j (+ j 1) acc)
29340 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
29350 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
29360 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
29370 6c 70 20 28 6c 69 73 74 20 73 74 72 20 6a 20 65 lp (list str j e
29380 6e 64 29 20 6a 20 6a 20 61 63 63 29 29 29 29 29 nd) j j acc)))))
29390 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
293a0 69 72 72 65 67 65 78 2d 66 6f 6c 64 20 69 72 78 irregex-fold irx
293b0 20 6b 6f 6e 73 20 2e 20 61 72 67 73 29 0a 20 20 kons . args).
293c0 28 69 66 20 28 6e 6f 74 20 28 70 72 6f 63 65 64 (if (not (proced
293d0 75 72 65 3f 20 6b 6f 6e 73 29 29 20 28 65 72 72 ure? kons)) (err
293e0 6f 72 20 22 69 72 72 65 67 65 78 2d 66 6f 6c 64 or "irregex-fold
293f0 3a 20 6e 6f 74 20 61 20 70 72 6f 63 65 64 75 72 : not a procedur
29400 65 22 20 6b 6f 6e 73 29 29 0a 20 20 28 6c 65 74 e" kons)). (let
29410 20 28 28 6b 6f 6e 73 32 20 28 6c 61 6d 62 64 61 ((kons2 (lambda
29420 20 28 69 20 6d 20 61 63 63 29 20 28 6b 6f 6e 73 (i m acc) (kons
29430 20 69 20 28 69 72 72 65 67 65 78 2d 63 6f 70 79 i (irregex-copy
29440 2d 6d 61 74 63 68 65 73 20 6d 29 20 61 63 63 29 -matches m) acc)
29450 29 29 29 0a 20 20 20 20 28 61 70 70 6c 79 20 69 ))). (apply i
29460 72 72 65 67 65 78 2d 66 6f 6c 64 2f 66 61 73 74 rregex-fold/fast
29470 20 69 72 78 20 6b 6f 6e 73 32 20 61 72 67 73 29 irx kons2 args)
29480 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 ))..(define (irr
29490 65 67 65 78 2d 66 6f 6c 64 2f 63 68 75 6e 6b 65 egex-fold/chunke
294a0 64 2f 66 61 73 74 20 69 72 78 20 6b 6f 6e 73 20 d/fast irx kons
294b0 6b 6e 69 6c 20 63 6e 6b 20 73 74 61 72 74 20 2e knil cnk start .
294c0 20 6f 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 72 o). (let* ((ir
294d0 78 20 28 69 72 72 65 67 65 78 20 69 72 78 29 29 x (irregex irx))
294e0 0a 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 . (match
294f0 65 73 20 28 69 72 72 65 67 65 78 2d 6e 65 77 2d es (irregex-new-
29500 6d 61 74 63 68 65 73 20 69 72 78 29 29 0a 20 20 matches irx)).
29510 20 20 20 20 20 20 20 28 66 69 6e 69 73 68 20 28 (finish (
29520 6f 72 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f or (and (pair? o
29530 29 20 28 63 61 72 20 6f 29 29 20 28 6c 61 6d 62 ) (car o)) (lamb
29540 64 61 20 28 73 72 63 20 69 20 61 63 63 29 20 61 da (src i acc) a
29550 63 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 cc))). (
29560 69 20 28 69 66 20 28 61 6e 64 20 28 70 61 69 72 i (if (and (pair
29570 3f 20 6f 29 20 28 70 61 69 72 3f 20 28 63 64 72 ? o) (pair? (cdr
29580 20 6f 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 o))).
29590 20 20 20 20 20 20 28 63 61 64 72 20 6f 29 0a 20 (cadr o).
295a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
295b0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 (chunker-get-sta
295c0 72 74 20 63 6e 6b 29 20 73 74 61 72 74 29 29 29 rt cnk) start)))
295d0 0a 20 20 20 20 20 20 20 20 20 28 69 6e 69 74 20 . (init
295e0 28 63 6f 6e 73 20 73 74 61 72 74 20 69 29 29 29 (cons start i)))
295f0 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 28 69 . (if (not (i
29600 6e 74 65 67 65 72 3f 20 69 29 29 20 28 65 72 72 nteger? i)) (err
29610 6f 72 20 22 69 72 72 65 67 65 78 2d 66 6f 6c 64 or "irregex-fold
29620 2f 63 68 75 6e 6b 65 64 3a 20 6e 6f 74 20 61 6e /chunked: not an
29630 20 69 6e 74 65 67 65 72 22 20 69 29 29 0a 20 20 integer" i)).
29640 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (irregex-match
29650 2d 63 68 75 6e 6b 65 72 2d 73 65 74 21 20 6d 61 -chunker-set! ma
29660 74 63 68 65 73 20 63 6e 6b 29 0a 20 20 20 20 28 tches cnk). (
29670 6c 65 74 20 6c 70 20 28 28 73 74 61 72 74 20 73 let lp ((start s
29680 74 61 72 74 29 20 28 69 20 69 29 20 28 61 63 63 tart) (i i) (acc
29690 20 6b 6e 69 6c 29 29 0a 20 20 20 20 20 20 28 69 knil)). (i
296a0 66 20 28 6e 6f 74 20 73 74 61 72 74 29 0a 20 20 f (not start).
296b0 20 20 20 20 20 20 20 20 28 66 69 6e 69 73 68 20 (finish
296c0 73 74 61 72 74 20 69 20 61 63 63 29 0a 20 20 20 start i acc).
296d0 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6d 20 (let ((m
296e0 28 69 72 72 65 67 65 78 2d 73 65 61 72 63 68 2f (irregex-search/
296f0 6d 61 74 63 68 65 73 20 69 72 78 20 63 6e 6b 20 matches irx cnk
29700 69 6e 69 74 20 73 74 61 72 74 20 69 20 6d 61 74 init start i mat
29710 63 68 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 ches))).
29720 20 20 20 20 28 69 66 20 28 6e 6f 74 20 6d 29 0a (if (not m).
29730 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29740 28 66 69 6e 69 73 68 20 73 74 61 72 74 20 69 20 (finish start i
29750 61 63 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 acc).
29760 20 20 20 20 20 28 6c 65 74 20 28 28 65 6e 64 2d (let ((end-
29770 73 72 63 20 28 25 69 72 72 65 67 65 78 2d 6d 61 src (%irregex-ma
29780 74 63 68 2d 65 6e 64 2d 63 68 75 6e 6b 20 6d 20 tch-end-chunk m
29790 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0)).
297a0 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 2d 69 (end-i
297b0 6e 64 65 78 20 28 25 69 72 72 65 67 65 78 2d 6d ndex (%irregex-m
297c0 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 6d atch-end-index m
297d0 20 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 0))).
297e0 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 (if (and
297f0 20 28 65 71 3f 20 65 6e 64 2d 73 72 63 20 73 74 (eq? end-src st
29800 61 72 74 29 20 28 3d 20 65 6e 64 2d 69 6e 64 65 art) (= end-inde
29810 78 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 x i)).
29820 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
29830 28 3e 3d 20 65 6e 64 2d 69 6e 64 65 78 20 28 28 (>= end-index ((
29840 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 chunker-get-end
29850 63 6e 6b 29 20 65 6e 64 2d 73 72 63 20 29 29 0a cnk) end-src )).
29860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29870 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
29880 28 6e 65 78 74 20 28 28 63 68 75 6e 6b 65 72 2d (next ((chunker-
29890 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 65 6e get-next cnk) en
298a0 64 2d 73 72 63 29 29 29 0a 20 20 20 20 20 20 20 d-src))).
298b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
298c0 20 20 20 20 20 28 6c 70 20 6e 65 78 74 20 28 28 (lp next ((
298d0 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 chunker-get-star
298e0 74 20 63 6e 6b 29 20 6e 65 78 74 29 20 61 63 63 t cnk) next) acc
298f0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
29900 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
29910 20 65 6e 64 2d 73 72 63 20 28 2b 20 65 6e 64 2d end-src (+ end-
29920 69 6e 64 65 78 20 31 29 20 61 63 63 29 29 0a 20 index 1) acc)).
29930 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29940 20 20 20 20 20 28 6c 65 74 20 28 28 61 63 63 20 (let ((acc
29950 28 6b 6f 6e 73 20 73 74 61 72 74 20 69 20 6d 20 (kons start i m
29960 61 63 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 acc))).
29970 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
29980 69 72 72 65 67 65 78 2d 72 65 73 65 74 2d 6d 61 irregex-reset-ma
29990 74 63 68 65 73 21 20 6d 61 74 63 68 65 73 29 0a tches! matches).
299a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
299b0 20 20 20 20 20 20 20 20 28 69 66 20 28 66 6c 61 (if (fla
299c0 67 2d 73 65 74 3f 20 28 69 72 72 65 67 65 78 2d g-set? (irregex-
299d0 66 6c 61 67 73 20 69 72 78 29 20 7e 63 6f 6e 73 flags irx) ~cons
299e0 75 6d 65 72 3f 29 0a 20 20 20 20 20 20 20 20 20 umer?).
299f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29a00 20 20 20 28 66 69 6e 69 73 68 20 65 6e 64 2d 73 (finish end-s
29a10 72 63 20 65 6e 64 2d 69 6e 64 65 78 20 61 63 63 rc end-index acc
29a20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
29a30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
29a40 70 20 65 6e 64 2d 73 72 63 20 65 6e 64 2d 69 6e p end-src end-in
29a50 64 65 78 20 61 63 63 29 29 29 29 29 29 29 29 29 dex acc)))))))))
29a60 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 ))..(define (irr
29a70 65 67 65 78 2d 66 6f 6c 64 2f 63 68 75 6e 6b 65 egex-fold/chunke
29a80 64 20 69 72 78 20 6b 6f 6e 73 20 2e 20 61 72 67 d irx kons . arg
29a90 73 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 70 s). (if (not (p
29aa0 72 6f 63 65 64 75 72 65 3f 20 6b 6f 6e 73 29 29 rocedure? kons))
29ab0 20 28 65 72 72 6f 72 20 22 69 72 72 65 67 65 78 (error "irregex
29ac0 2d 66 6f 6c 64 2f 63 68 75 6e 6b 65 64 3a 20 6e -fold/chunked: n
29ad0 6f 74 20 61 20 70 72 6f 63 65 64 75 72 65 22 20 ot a procedure"
29ae0 6b 6f 6e 73 29 29 0a 20 20 28 6c 65 74 20 28 28 kons)). (let ((
29af0 6b 6f 6e 73 32 20 28 6c 61 6d 62 64 61 20 28 73 kons2 (lambda (s
29b00 20 69 20 6d 20 61 63 63 29 20 28 6b 6f 6e 73 20 i m acc) (kons
29b10 73 20 69 20 28 69 72 72 65 67 65 78 2d 63 6f 70 s i (irregex-cop
29b20 79 2d 6d 61 74 63 68 65 73 20 6d 29 20 61 63 63 y-matches m) acc
29b30 29 29 29 29 0a 20 20 20 20 28 61 70 70 6c 79 20 )))). (apply
29b40 69 72 72 65 67 65 78 2d 66 6f 6c 64 2f 63 68 75 irregex-fold/chu
29b50 6e 6b 65 64 2f 66 61 73 74 20 69 72 78 20 6b 6f nked/fast irx ko
29b60 6e 73 32 20 61 72 67 73 29 29 29 0a 0a 28 64 65 ns2 args)))..(de
29b70 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 72 65 fine (irregex-re
29b80 70 6c 61 63 65 20 69 72 78 20 73 74 72 20 2e 20 place irx str .
29b90 6f 29 0a 20 20 28 69 66 20 28 6e 6f 74 20 28 73 o). (if (not (s
29ba0 74 72 69 6e 67 3f 20 73 74 72 29 29 20 28 65 72 tring? str)) (er
29bb0 72 6f 72 20 22 69 72 72 65 67 65 78 2d 72 65 70 ror "irregex-rep
29bc0 6c 61 63 65 3a 20 6e 6f 74 20 61 20 73 74 72 69 lace: not a stri
29bd0 6e 67 22 20 73 74 72 29 29 0a 20 20 28 6c 65 74 ng" str)). (let
29be0 20 28 28 6d 20 28 69 72 72 65 67 65 78 2d 73 65 ((m (irregex-se
29bf0 61 72 63 68 20 69 72 78 20 73 74 72 29 29 29 0a arch irx str))).
29c00 20 20 20 20 28 69 66 20 6d 0a 20 20 20 20 20 20 (if m.
29c10 20 20 28 73 74 72 69 6e 67 2d 63 61 74 2d 72 65 (string-cat-re
29c20 76 65 72 73 65 0a 20 20 20 20 20 20 20 20 20 28 verse. (
29c30 63 6f 6e 73 20 28 73 75 62 73 74 72 69 6e 67 20 cons (substring
29c40 73 74 72 20 28 25 69 72 72 65 67 65 78 2d 6d 61 str (%irregex-ma
29c50 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 6d 20 tch-end-index m
29c60 30 29 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 0) (string-lengt
29c70 68 20 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 h str)).
29c80 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 (append (
29c90 69 72 72 65 67 65 78 2d 61 70 70 6c 79 2d 6d 61 irregex-apply-ma
29ca0 74 63 68 20 6d 20 6f 29 0a 20 20 20 20 20 20 20 tch m o).
29cb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29cc0 28 6c 69 73 74 20 28 73 75 62 73 74 72 69 6e 67 (list (substring
29cd0 20 73 74 72 20 30 20 28 25 69 72 72 65 67 65 78 str 0 (%irregex
29ce0 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 -match-start-ind
29cf0 65 78 20 6d 20 30 29 29 29 0a 20 20 20 20 20 20 ex m 0))).
29d00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29d10 20 29 29 29 0a 20 20 20 20 20 20 20 20 73 74 72 ))). str
29d20 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 )))..(define (ir
29d30 72 65 67 65 78 2d 72 65 70 6c 61 63 65 2f 61 6c regex-replace/al
29d40 6c 20 69 72 78 20 73 74 72 20 2e 20 6f 29 0a 20 l irx str . o).
29d50 20 28 69 66 20 28 6e 6f 74 20 28 73 74 72 69 6e (if (not (strin
29d60 67 3f 20 73 74 72 29 29 20 28 65 72 72 6f 72 20 g? str)) (error
29d70 22 69 72 72 65 67 65 78 2d 72 65 70 6c 61 63 65 "irregex-replace
29d80 2f 61 6c 6c 3a 20 6e 6f 74 20 61 20 73 74 72 69 /all: not a stri
29d90 6e 67 22 20 73 74 72 29 29 0a 20 20 28 69 72 72 ng" str)). (irr
29da0 65 67 65 78 2d 66 6f 6c 64 2f 66 61 73 74 0a 20 egex-fold/fast.
29db0 20 20 69 72 78 0a 20 20 20 28 6c 61 6d 62 64 61 irx. (lambda
29dc0 20 28 69 20 6d 20 61 63 63 29 0a 20 20 20 20 20 (i m acc).
29dd0 28 6c 65 74 20 28 28 6d 2d 73 74 61 72 74 20 28 (let ((m-start (
29de0 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 %irregex-match-s
29df0 74 61 72 74 2d 69 6e 64 65 78 20 6d 20 30 29 29 tart-index m 0))
29e00 29 0a 20 20 20 20 20 20 20 28 69 66 20 28 3e 3d ). (if (>=
29e10 20 69 20 6d 2d 73 74 61 72 74 29 0a 20 20 20 20 i m-start).
29e20 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 (append (
29e30 69 72 72 65 67 65 78 2d 61 70 70 6c 79 2d 6d 61 irregex-apply-ma
29e40 74 63 68 20 6d 20 6f 29 20 61 63 63 29 0a 20 20 tch m o) acc).
29e50 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 (append
29e60 20 28 69 72 72 65 67 65 78 2d 61 70 70 6c 79 2d (irregex-apply-
29e70 6d 61 74 63 68 20 6d 20 6f 29 0a 20 20 20 20 20 match m o).
29e80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
29e90 6f 6e 73 20 28 73 75 62 73 74 72 69 6e 67 20 73 ons (substring s
29ea0 74 72 20 69 20 6d 2d 73 74 61 72 74 29 20 61 63 tr i m-start) ac
29eb0 63 29 29 29 29 29 0a 20 20 20 27 28 29 0a 20 20 c))))). '().
29ec0 20 73 74 72 0a 20 20 20 28 6c 61 6d 62 64 61 20 str. (lambda
29ed0 28 69 20 61 63 63 29 0a 20 20 20 20 20 28 6c 65 (i acc). (le
29ee0 74 20 28 28 65 6e 64 20 28 73 74 72 69 6e 67 2d t ((end (string-
29ef0 6c 65 6e 67 74 68 20 73 74 72 29 29 29 0a 20 20 length str))).
29f00 20 20 20 20 20 28 73 74 72 69 6e 67 2d 63 61 74 (string-cat
29f10 2d 72 65 76 65 72 73 65 20 28 69 66 20 28 3e 3d -reverse (if (>=
29f20 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 i end).
29f30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29f40 20 20 20 20 20 20 20 61 63 63 0a 20 20 20 20 20 acc.
29f50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
29f60 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 (cons
29f70 28 73 75 62 73 74 72 69 6e 67 20 73 74 72 20 69 (substring str i
29f80 20 65 6e 64 29 20 61 63 63 29 29 29 29 29 29 29 end) acc)))))))
29f90 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 ..(define (irreg
29fa0 65 78 2d 61 70 70 6c 79 2d 6d 61 74 63 68 20 6d ex-apply-match m
29fb0 20 6c 73 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 ls). (let lp (
29fc0 28 6c 73 20 6c 73 29 20 28 72 65 73 20 27 28 29 (ls ls) (res '()
29fd0 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
29fe0 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 72 65 ? ls). re
29ff0 73 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a s. (cond.
2a000 20 20 20 20 20 20 20 20 20 28 28 69 6e 74 65 67 ((integ
2a010 65 72 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 er? (car ls)).
2a020 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 (lp (cdr
2a030 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls).
2a040 20 20 20 28 63 6f 6e 73 20 28 6f 72 20 28 69 72 (cons (or (ir
2a050 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 75 62 73 regex-match-subs
2a060 74 72 69 6e 67 20 6d 20 28 63 61 72 20 6c 73 29 tring m (car ls)
2a070 29 20 22 22 29 20 72 65 73 29 29 29 0a 20 20 20 ) "") res))).
2a080 20 20 20 20 20 20 28 28 70 72 6f 63 65 64 75 72 ((procedur
2a090 65 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 20 e? (car ls)).
2a0a0 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 (lp (cdr
2a0b0 6c 73 29 20 28 63 6f 6e 73 20 28 28 63 61 72 20 ls) (cons ((car
2a0c0 6c 73 29 20 6d 29 20 72 65 73 29 29 29 0a 20 20 ls) m) res))).
2a0d0 20 20 20 20 20 20 20 28 28 73 79 6d 62 6f 6c 3f ((symbol?
2a0e0 20 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 (car ls)).
2a0f0 20 20 20 20 20 28 63 61 73 65 20 28 63 61 72 20 (case (car
2a100 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
2a110 28 28 70 72 65 29 0a 20 20 20 20 20 20 20 20 20 ((pre).
2a120 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 29 (lp (cdr ls)
2a130 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2a140 20 20 28 63 6f 6e 73 20 28 73 75 62 73 74 72 69 (cons (substri
2a150 6e 67 20 28 63 61 72 20 28 25 69 72 72 65 67 65 ng (car (%irrege
2a160 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 63 68 x-match-start-ch
2a170 75 6e 6b 20 6d 20 30 29 29 0a 20 20 20 20 20 20 unk m 0)).
2a180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a190 20 20 20 20 20 20 20 20 20 20 20 20 30 0a 20 20 0.
2a1a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a1b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a1c0 28 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (%irregex-match-
2a1d0 73 74 61 72 74 2d 69 6e 64 65 78 20 6d 20 30 29 start-index m 0)
2a1e0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2a1f0 20 20 20 20 20 20 20 20 20 72 65 73 29 29 29 0a res))).
2a200 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 6f ((po
2a210 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 st).
2a220 20 28 6c 65 74 20 28 28 73 74 72 20 28 63 61 72 (let ((str (car
2a230 20 28 25 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (%irregex-match
2a240 2d 73 74 61 72 74 2d 63 68 75 6e 6b 20 6d 20 30 -start-chunk m 0
2a250 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
2a260 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 29 (lp (cdr ls)
2a270 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2a280 20 20 20 20 28 63 6f 6e 73 20 28 73 75 62 73 74 (cons (subst
2a290 72 69 6e 67 20 73 74 72 0a 20 20 20 20 20 20 20 ring str.
2a2a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a2b0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 25 69 (%i
2a2c0 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
2a2d0 2d 69 6e 64 65 78 20 6d 20 30 29 0a 20 20 20 20 -index m 0).
2a2e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a2f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a300 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 (string-length s
2a310 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 tr)).
2a320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 re
2a330 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 s)))).
2a340 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
2a350 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
2a360 20 20 20 20 20 20 20 20 20 28 28 61 73 73 71 20 ((assq
2a370 28 63 61 72 20 6c 73 29 20 28 69 72 72 65 67 65 (car ls) (irrege
2a380 78 2d 6d 61 74 63 68 2d 6e 61 6d 65 73 20 6d 29 x-match-names m)
2a390 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2a3a0 20 3d 3e 20 28 6c 61 6d 62 64 61 20 28 78 29 20 => (lambda (x)
2a3b0 28 6c 70 20 28 63 6f 6e 73 20 28 63 64 72 20 78 (lp (cons (cdr x
2a3c0 29 20 28 63 64 72 20 6c 73 29 29 20 72 65 73 29 ) (cdr ls)) res)
2a3d0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
2a3e0 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
2a3f0 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e (error "un
2a400 6b 6e 6f 77 6e 20 6d 61 74 63 68 20 72 65 70 6c known match repl
2a410 61 63 65 6d 65 6e 74 22 20 28 63 61 72 20 6c 73 acement" (car ls
2a420 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
2a430 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 (else.
2a440 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 28 63 (lp (cdr ls) (c
2a450 6f 6e 73 20 28 63 61 72 20 6c 73 29 20 72 65 73 ons (car ls) res
2a460 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
2a470 20 28 69 72 72 65 67 65 78 2d 65 78 74 72 61 63 (irregex-extrac
2a480 74 20 69 72 78 20 73 74 72 20 2e 20 6f 29 0a 20 t irx str . o).
2a490 20 28 69 66 20 28 6e 6f 74 20 28 73 74 72 69 6e (if (not (strin
2a4a0 67 3f 20 73 74 72 29 29 20 28 65 72 72 6f 72 20 g? str)) (error
2a4b0 22 69 72 72 65 67 65 78 2d 65 78 74 72 61 63 74 "irregex-extract
2a4c0 3a 20 6e 6f 74 20 61 20 73 74 72 69 6e 67 22 20 : not a string"
2a4d0 73 74 72 29 29 0a 20 20 28 61 70 70 6c 79 20 69 str)). (apply i
2a4e0 72 72 65 67 65 78 2d 66 6f 6c 64 2f 66 61 73 74 rregex-fold/fast
2a4f0 0a 20 20 20 20 20 20 20 20 20 69 72 78 0a 20 20 . irx.
2a500 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
2a510 69 20 6d 20 61 29 20 28 63 6f 6e 73 20 28 69 72 i m a) (cons (ir
2a520 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 75 62 73 regex-match-subs
2a530 74 72 69 6e 67 20 6d 29 20 61 29 29 0a 20 20 20 tring m) a)).
2a540 20 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 20 '().
2a550 20 20 20 73 74 72 0a 20 20 20 20 20 20 20 20 20 str.
2a560 28 6c 61 6d 62 64 61 20 28 69 20 61 29 20 28 72 (lambda (i a) (r
2a570 65 76 65 72 73 65 20 61 29 29 0a 20 20 20 20 20 everse a)).
2a580 20 20 20 20 6f 29 29 0a 0a 28 64 65 66 69 6e 65 o))..(define
2a590 20 28 69 72 72 65 67 65 78 2d 73 70 6c 69 74 20 (irregex-split
2a5a0 69 72 78 20 73 74 72 20 2e 20 6f 29 0a 20 20 28 irx str . o). (
2a5b0 69 66 20 28 6e 6f 74 20 28 73 74 72 69 6e 67 3f if (not (string?
2a5c0 20 73 74 72 29 29 20 28 65 72 72 6f 72 20 22 69 str)) (error "i
2a5d0 72 72 65 67 65 78 2d 73 70 6c 69 74 3a 20 6e 6f rregex-split: no
2a5e0 74 20 61 20 73 74 72 69 6e 67 22 20 73 74 72 29 t a string" str)
2a5f0 29 0a 20 20 28 6c 65 74 20 28 28 73 74 61 72 74 ). (let ((start
2a600 20 28 69 66 20 28 70 61 69 72 3f 20 6f 29 20 28 (if (pair? o) (
2a610 63 61 72 20 6f 29 20 30 29 29 0a 20 20 20 20 20 car o) 0)).
2a620 20 20 20 28 65 6e 64 20 28 69 66 20 28 61 6e 64 (end (if (and
2a630 20 28 70 61 69 72 3f 20 6f 29 20 28 70 61 69 72 (pair? o) (pair
2a640 3f 20 28 63 64 72 20 6f 29 29 29 20 28 63 61 64 ? (cdr o))) (cad
2a650 72 20 6f 29 20 28 73 74 72 69 6e 67 2d 6c 65 6e r o) (string-len
2a660 67 74 68 20 73 74 72 29 29 29 29 0a 20 20 20 20 gth str)))).
2a670 28 69 72 72 65 67 65 78 2d 66 6f 6c 64 2f 66 61 (irregex-fold/fa
2a680 73 74 0a 20 20 20 20 20 69 72 78 0a 20 20 20 20 st. irx.
2a690 20 28 6c 61 6d 62 64 61 20 28 69 20 6d 20 61 29 (lambda (i m a)
2a6a0 0a 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 . (cond.
2a6b0 20 20 20 20 20 20 28 28 3d 20 69 20 28 25 69 72 ((= i (%ir
2a6c0 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 regex-match-star
2a6d0 74 2d 69 6e 64 65 78 20 6d 20 30 29 29 0a 20 20 t-index m 0)).
2a6e0 20 20 20 20 20 20 20 61 29 0a 20 20 20 20 20 20 a).
2a6f0 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
2a700 20 28 63 6f 6e 73 20 28 73 75 62 73 74 72 69 6e (cons (substrin
2a710 67 20 73 74 72 20 69 20 28 25 69 72 72 65 67 65 g str i (%irrege
2a720 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 6e x-match-start-in
2a730 64 65 78 20 6d 20 30 29 29 20 61 29 29 29 29 0a dex m 0)) a)))).
2a740 20 20 20 20 20 27 28 29 0a 20 20 20 20 20 73 74 '(). st
2a750 72 0a 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 r. (lambda (
2a760 69 20 61 29 0a 20 20 20 20 20 20 20 28 6c 65 74 i a). (let
2a770 20 6c 70 20 28 28 6c 73 20 28 69 66 20 28 3d 20 lp ((ls (if (=
2a780 69 20 65 6e 64 29 20 61 20 28 63 6f 6e 73 20 28 i end) a (cons (
2a790 73 75 62 73 74 72 69 6e 67 20 73 74 72 20 69 20 substring str i
2a7a0 65 6e 64 29 20 61 29 29 29 0a 20 20 20 20 20 20 end) a))).
2a7b0 20 20 20 20 20 20 20 20 20 20 28 72 65 73 20 27 (res '
2a7c0 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ()).
2a7d0 20 20 20 20 28 77 61 73 2d 63 68 61 72 3f 20 23 (was-char? #
2a7e0 66 29 29 0a 20 20 20 20 20 20 20 20 20 28 63 6f f)). (co
2a7f0 6e 64 0a 20 20 20 20 20 20 20 20 20 20 28 28 6e nd. ((n
2a800 75 6c 6c 3f 20 6c 73 29 20 72 65 73 29 0a 20 20 ull? ls) res).
2a810 20 20 20 20 20 20 20 20 28 28 63 68 61 72 3f 20 ((char?
2a820 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 (car ls)).
2a830 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 (lp (cdr ls
2a840 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2a850 20 28 69 66 20 28 6f 72 20 77 61 73 2d 63 68 61 (if (or was-cha
2a860 72 3f 20 28 6e 75 6c 6c 3f 20 72 65 73 29 29 0a r? (null? res)).
2a870 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a880 20 20 20 28 63 6f 6e 73 20 28 73 74 72 69 6e 67 (cons (string
2a890 20 28 63 61 72 20 6c 73 29 29 20 72 65 73 29 0a (car ls)) res).
2a8a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2a8b0 20 20 20 28 63 6f 6e 73 20 28 73 74 72 69 6e 67 (cons (string
2a8c0 2d 61 70 70 65 6e 64 20 28 73 74 72 69 6e 67 20 -append (string
2a8d0 28 63 61 72 20 6c 73 29 29 20 28 63 61 72 20 72 (car ls)) (car r
2a8e0 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
2a8f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
2a900 64 72 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 dr res))).
2a910 20 20 20 20 20 20 20 20 20 23 74 29 29 0a 20 20 #t)).
2a920 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 6c (else (l
2a930 70 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 p (cdr ls) (cons
2a940 20 28 63 61 72 20 6c 73 29 20 72 65 73 29 20 23 (car ls) res) #
2a950 66 29 29 29 29 29 0a 20 20 20 20 20 73 74 61 72 f))))). star
2a960 74 0a 20 20 20 20 20 65 6e 64 29 29 29 0a 29 0a t. end))).).