0000: 3b 3b 3b 3b 20 69 72 72 65 67 65 78 2e 73 63 6d ;;;; irregex.scm
0010: 20 2d 2d 20 49 72 52 65 67 75 6c 61 72 20 45 78 -- IrRegular Ex
0020: 70 72 65 73 73 69 6f 6e 73 0a 3b 3b 0a 3b 3b 20 pressions.;;.;;
0030: 43 6f 70 79 72 69 67 68 74 20 28 63 29 20 32 30 Copyright (c) 20
0040: 30 35 2d 32 30 30 39 20 41 6c 65 78 20 53 68 69 05-2009 Alex Shi
0050: 6e 6e 2e 20 20 41 6c 6c 20 72 69 67 68 74 73 20 nn. All rights
0060: 72 65 73 65 72 76 65 64 2e 0a 3b 3b 20 42 53 44 reserved..;; BSD
0070: 2d 73 74 79 6c 65 20 6c 69 63 65 6e 73 65 3a 20 -style license:
0080: 68 74 74 70 3a 2f 2f 73 79 6e 74 68 63 6f 64 65 http://synthcode
0090: 2e 63 6f 6d 2f 6c 69 63 65 6e 73 65 2e 74 78 74 .com/license.txt
00a0: 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
00b0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
00c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
00d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
00e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 41 74 ;;;;;;;;;;.;; At
00f0: 20 74 68 69 73 20 6d 6f 6d 65 6e 74 20 74 68 65 this moment the
0100: 72 65 20 77 61 73 20 61 20 6c 6f 75 64 20 72 69 re was a loud ri
0110: 6e 67 20 61 74 20 74 68 65 20 62 65 6c 6c 2c 20 ng at the bell,
0120: 61 6e 64 20 49 20 63 6f 75 6c 64 0a 3b 3b 20 68 and I could.;; h
0130: 65 61 72 20 4d 72 73 2e 20 48 75 64 73 6f 6e 2c ear Mrs. Hudson,
0140: 20 6f 75 72 20 6c 61 6e 64 6c 61 64 79 2c 20 72 our landlady, r
0150: 61 69 73 69 6e 67 20 68 65 72 20 76 6f 69 63 65 aising her voice
0160: 20 69 6e 20 61 20 77 61 69 6c 20 6f 66 0a 3b 3b in a wail of.;;
0170: 20 65 78 70 6f 73 74 75 6c 61 74 69 6f 6e 20 61 expostulation a
0180: 6e 64 20 64 69 73 6d 61 79 2e 0a 3b 3b 0a 3b 3b nd dismay..;;.;;
0190: 20 22 42 79 20 68 65 61 76 65 6e 2c 20 48 6f 6c "By heaven, Hol
01a0: 6d 65 73 2c 22 20 49 20 73 61 69 64 2c 20 68 61 mes," I said, ha
01b0: 6c 66 20 72 69 73 69 6e 67 2c 20 22 49 20 62 65 lf rising, "I be
01c0: 6c 69 65 76 65 20 74 68 61 74 0a 3b 3b 20 74 68 lieve that.;; th
01d0: 65 79 20 61 72 65 20 72 65 61 6c 6c 79 20 61 66 ey are really af
01e0: 74 65 72 20 75 73 2e 22 0a 3b 3b 0a 3b 3b 20 22 ter us.".;;.;; "
01f0: 4e 6f 2c 20 69 74 27 73 20 6e 6f 74 20 71 75 69 No, it's not qui
0200: 74 65 20 73 6f 20 62 61 64 20 61 73 20 74 68 61 te so bad as tha
0210: 74 2e 20 20 49 74 20 69 73 20 74 68 65 20 75 6e t. It is the un
0220: 6f 66 66 69 63 69 61 6c 0a 3b 3b 20 66 6f 72 63 official.;; forc
0230: 65 2c 20 2d 2d 20 74 68 65 20 42 61 6b 65 72 20 e, -- the Baker
0240: 53 74 72 65 65 74 20 69 72 72 65 67 75 6c 61 72 Street irregular
0250: 73 2e 22 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b s."..;;;;;;;;;;;
0260: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0270: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0280: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0290: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b ;;;;;;;;;;;;;.;;
02a0: 20 4e 6f 74 65 73 0a 3b 3b 0a 3b 3b 20 54 68 69 Notes.;;.;; Thi
02b0: 73 20 63 6f 64 65 20 73 68 6f 75 6c 64 20 6e 6f s code should no
02c0: 74 20 72 65 71 75 69 72 65 20 61 6e 79 20 70 6f t require any po
02d0: 72 74 69 6e 67 20 2d 20 69 74 20 73 68 6f 75 6c rting - it shoul
02e0: 64 20 77 6f 72 6b 20 6f 75 74 20 6f 66 0a 3b 3b d work out of.;;
02f0: 20 74 68 65 20 62 6f 78 20 69 6e 20 61 6e 79 20 the box in any
0300: 52 5b 34 35 5d 52 53 20 53 63 68 65 6d 65 20 69 R[45]RS Scheme i
0310: 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 2e 20 20 mplementation.
0320: 53 6c 69 67 68 74 20 6d 6f 64 69 66 69 63 61 74 Slight modificat
0330: 69 6f 6e 73 0a 3b 3b 20 61 72 65 20 6e 65 65 64 ions.;; are need
0340: 65 64 20 66 6f 72 20 52 36 52 53 20 28 61 20 73 ed for R6RS (a s
0350: 65 70 61 72 61 74 65 20 52 36 52 53 2d 63 6f 6d eparate R6RS-com
0360: 70 61 74 69 62 6c 65 20 76 65 72 73 69 6f 6e 20 patible version
0370: 69 73 20 69 6e 63 6c 75 64 65 64 0a 3b 3b 20 69 is included.;; i
0380: 6e 20 74 68 65 20 64 69 73 74 72 69 62 75 74 69 n the distributi
0390: 6f 6e 20 61 73 20 69 72 72 65 67 65 78 2d 72 36 on as irregex-r6
03a0: 72 73 2e 73 63 6d 29 2e 0a 3b 3b 0a 3b 3b 20 54 rs.scm)..;;.;; T
03b0: 68 65 20 67 6f 61 6c 20 6f 66 20 70 6f 72 74 61 he goal of porta
03c0: 62 69 6c 69 74 79 20 6d 61 6b 65 73 20 74 68 69 bility makes thi
03d0: 73 20 63 6f 64 65 20 61 20 6c 69 74 74 6c 65 20 s code a little
03e0: 63 6c 75 6d 73 79 20 61 6e 64 0a 3b 3b 20 69 6e clumsy and.;; in
03f0: 65 66 66 69 63 69 65 6e 74 2e 20 20 46 75 74 75 efficient. Futu
0400: 72 65 20 76 65 72 73 69 6f 6e 73 20 77 69 6c 6c re versions will
0410: 20 69 6e 63 6c 75 64 65 20 62 6f 74 68 20 63 6c include both cl
0420: 65 61 6e 75 70 20 61 6e 64 0a 3b 3b 20 70 65 72 eanup and.;; per
0430: 66 6f 72 6d 61 6e 63 65 20 74 75 6e 69 6e 67 2c formance tuning,
0440: 20 62 75 74 20 79 6f 75 20 63 61 6e 20 6f 6e 6c but you can onl
0450: 79 20 67 6f 20 73 6f 20 66 61 72 20 77 68 69 6c y go so far whil
0460: 65 20 73 74 61 79 69 6e 67 0a 3b 3b 20 70 6f 72 e staying.;; por
0470: 74 61 62 6c 65 2e 20 20 41 4e 44 2d 4c 45 54 2a table. AND-LET*
0480: 2c 20 53 52 46 49 2d 39 20 72 65 63 6f 72 64 73 , SRFI-9 records
0490: 20 61 6e 64 20 63 75 73 74 6f 6d 20 6d 61 63 72 and custom macr
04a0: 6f 73 20 77 6f 75 6c 64 27 76 65 20 62 65 65 6e os would've been
04b0: 0a 3b 3b 20 6e 69 63 65 2e 0a 0a 3b 3b 3b 3b 3b .;; nice...;;;;;
04c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
04d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
04e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
04f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
0500: 3b 3b 3b 0a 3b 3b 20 48 69 73 74 6f 72 79 0a 3b ;;;.;; History.;
0510: 3b 0a 3b 3b 20 30 2e 37 2e 33 3a 20 32 30 30 39 ;.;; 0.7.3: 2009
0520: 2f 30 34 2f 31 34 20 2d 20 61 64 64 69 6e 67 20 /04/14 - adding
0530: 69 72 72 65 67 65 78 2d 66 6f 6c 64 2f 63 68 75 irregex-fold/chu
0540: 6e 6b 65 64 2c 20 6d 69 6e 6f 72 20 64 6f 63 20 nked, minor doc
0550: 66 69 78 65 73 0a 3b 3b 20 30 2e 37 2e 32 3a 20 fixes.;; 0.7.2:
0560: 32 30 30 39 2f 30 32 2f 31 31 20 2d 20 73 6f 6d 2009/02/11 - som
0570: 65 20 62 75 67 66 69 78 65 73 2c 20 6d 75 63 68 e bugfixes, much
0580: 20 69 6d 70 72 6f 76 65 64 20 64 6f 63 75 6d 65 improved docume
0590: 6e 74 61 74 69 6f 6e 0a 3b 3b 20 30 2e 37 2e 31 ntation.;; 0.7.1
05a0: 3a 20 32 30 30 38 2f 31 30 2f 33 30 20 2d 20 73 : 2008/10/30 - s
05b0: 65 76 65 72 61 6c 20 62 75 67 66 69 78 65 73 20 everal bugfixes
05c0: 28 74 68 61 6e 6b 73 20 74 6f 20 44 65 72 69 63 (thanks to Deric
05d0: 6b 20 45 64 64 69 6e 67 74 6f 6e 29 0a 3b 3b 20 k Eddington).;;
05e0: 30 2e 37 2e 30 3a 20 32 30 30 38 2f 31 30 2f 32 0.7.0: 2008/10/2
05f0: 30 20 2d 20 73 75 70 70 6f 72 74 20 61 62 73 74 0 - support abst
0600: 72 61 63 74 20 63 68 75 6e 6b 65 64 20 73 74 72 ract chunked str
0610: 69 6e 67 73 0a 3b 3b 20 30 2e 36 2e 32 3a 20 32 ings.;; 0.6.2: 2
0620: 30 30 38 2f 30 37 2f 32 36 20 2d 20 6d 69 6e 6f 008/07/26 - mino
0630: 72 20 62 75 67 66 69 78 65 73 2c 20 61 6c 6c 6f r bugfixes, allo
0640: 77 20 67 6c 6f 62 61 6c 20 64 69 73 61 62 6c 69 w global disabli
0650: 6e 67 20 6f 66 20 75 74 66 38 20 6d 6f 64 65 2c ng of utf8 mode,
0660: 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
0670: 20 20 20 20 20 20 20 20 66 72 69 65 6e 64 6c 69 friendli
0680: 65 72 20 65 72 72 6f 72 20 6d 65 73 73 61 67 65 er error message
0690: 73 20 69 6e 20 70 61 72 73 69 6e 67 2c 20 5c 51 s in parsing, \Q
06a0: 2e 2e 5c 45 20 73 75 70 70 6f 72 74 0a 3b 3b 20 ..\E support.;;
06b0: 30 2e 36 2e 31 3a 20 32 30 30 38 2f 30 37 2f 32 0.6.1: 2008/07/2
06c0: 31 20 2d 20 61 64 64 65 64 20 75 74 66 38 20 6d 1 - added utf8 m
06d0: 6f 64 65 2c 20 6d 6f 72 65 20 75 74 69 6c 73 2c ode, more utils,
06e0: 20 62 75 67 66 69 78 65 73 0a 3b 3b 20 20 20 30 bugfixes.;; 0
06f0: 2e 36 3a 20 32 30 30 38 2f 30 35 2f 30 31 20 2d .6: 2008/05/01 -
0700: 20 6d 6f 73 74 20 6f 66 20 50 43 52 45 20 73 75 most of PCRE su
0710: 70 70 6f 72 74 65 64 0a 3b 3b 20 20 20 30 2e 35 pported.;; 0.5
0720: 3a 20 32 30 30 38 2f 30 34 2f 32 34 20 2d 20 66 : 2008/04/24 - f
0730: 75 6c 6c 79 20 70 6f 72 74 61 62 6c 65 20 52 34 ully portable R4
0740: 52 53 2c 20 6d 61 6e 79 20 50 43 52 45 20 66 65 RS, many PCRE fe
0750: 61 74 75 72 65 73 20 69 6d 70 6c 65 6d 65 6e 74 atures implement
0760: 65 64 0a 3b 3b 20 20 20 30 2e 34 3a 20 32 30 30 ed.;; 0.4: 200
0770: 38 2f 30 34 2f 31 37 20 2d 20 72 65 77 72 69 74 8/04/17 - rewrit
0780: 69 6e 67 20 4e 46 41 20 74 6f 20 75 73 65 20 65 ing NFA to use e
0790: 66 66 69 63 69 65 6e 74 20 63 6c 6f 73 75 72 65 fficient closure
07a0: 20 63 6f 6d 70 69 6c 61 74 69 6f 6e 2c 0a 3b 3b compilation,.;;
07b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
07c0: 20 20 20 20 20 6e 6f 72 6d 61 6c 20 73 74 72 69 normal stri
07d0: 6e 67 73 20 6f 6e 6c 79 2c 20 62 75 74 20 61 6c ngs only, but al
07e0: 6c 20 6f 66 20 74 68 65 20 73 70 65 6e 63 65 72 l of the spencer
07f0: 20 74 65 73 74 73 20 70 61 73 73 0a 3b 3b 20 20 tests pass.;;
0800: 20 30 2e 33 3a 20 32 30 30 38 2f 30 33 2f 31 30 0.3: 2008/03/10
0810: 20 2d 20 61 64 64 69 6e 67 20 44 46 41 20 63 6f - adding DFA co
0820: 6e 76 65 72 74 65 72 20 28 6e 6f 72 6d 61 6c 20 nverter (normal
0830: 73 74 72 69 6e 67 73 20 6f 6e 6c 79 29 0a 3b 3b strings only).;;
0840: 20 20 20 30 2e 32 3a 20 32 30 30 35 2f 30 39 2f 0.2: 2005/09/
0850: 32 37 20 2d 20 61 64 64 69 6e 67 20 69 72 72 65 27 - adding irre
0860: 67 65 78 2d 6f 70 74 20 28 6c 69 6b 65 20 65 6c gex-opt (like el
0870: 69 73 70 27 73 20 72 65 67 65 78 70 2d 6f 70 74 isp's regexp-opt
0880: 29 20 75 74 69 6c 69 74 79 0a 3b 3b 20 20 20 30 ) utility.;; 0
0890: 2e 31 3a 20 32 30 30 35 2f 30 38 2f 31 38 20 2d .1: 2005/08/18 -
08a0: 20 73 69 6d 70 6c 65 20 4e 46 41 20 69 6e 74 65 simple NFA inte
08b0: 72 70 72 65 74 65 72 20 6f 76 65 72 20 61 62 73 rpreter over abs
08c0: 74 72 61 63 74 20 63 68 75 6e 6b 65 64 20 73 74 tract chunked st
08d0: 72 69 6e 67 73 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b rings..;;;;;;;;;
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 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a ;;;;;;;;;;;;;;;.
0920: 3b 3b 20 64 61 74 61 20 73 74 72 75 63 74 75 72 ;; data structur
0930: 65 73 0a 0a 28 64 65 66 69 6e 65 20 69 72 72 65 es..(define irre
0940: 67 65 78 2d 74 61 67 20 27 2a 69 72 72 65 67 65 gex-tag '*irrege
0950: 78 2d 74 61 67 2a 29 0a 0a 28 64 65 66 69 6e 65 x-tag*)..(define
0960: 20 28 6d 61 6b 65 2d 69 72 72 65 67 65 78 20 64 (make-irregex d
0970: 66 61 20 64 66 61 2f 73 65 61 72 63 68 20 64 66 fa dfa/search df
0980: 61 2f 65 78 74 72 61 63 74 20 6e 66 61 20 66 6c a/extract nfa fl
0990: 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 ags.
09a0: 20 20 20 20 20 20 20 20 20 20 73 75 62 6d 61 74 submat
09b0: 63 68 65 73 20 6c 65 6e 67 74 68 73 20 6e 61 6d ches lengths nam
09c0: 65 73 29 0a 20 20 28 76 65 63 74 6f 72 20 69 72 es). (vector ir
09d0: 72 65 67 65 78 2d 74 61 67 20 64 66 61 20 64 66 regex-tag dfa df
09e0: 61 2f 73 65 61 72 63 68 20 64 66 61 2f 65 78 74 a/search dfa/ext
09f0: 72 61 63 74 20 6e 66 61 20 66 6c 61 67 73 0a 20 ract nfa flags.
0a00: 20 20 20 20 20 20 20 20 20 73 75 62 6d 61 74 63 submatc
0a10: 68 65 73 20 6c 65 6e 67 74 68 73 20 6e 61 6d 65 hes lengths name
0a20: 73 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 s))..(define (ir
0a30: 72 65 67 65 78 3f 20 6f 62 6a 29 0a 20 20 28 61 regex? obj). (a
0a40: 6e 64 20 28 76 65 63 74 6f 72 3f 20 6f 62 6a 29 nd (vector? obj)
0a50: 0a 20 20 20 20 20 20 20 28 3d 20 39 20 28 76 65 . (= 9 (ve
0a60: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6f 62 6a 29 ctor-length obj)
0a70: 29 0a 20 20 20 20 20 20 20 28 65 71 3f 20 69 72 ). (eq? ir
0a80: 72 65 67 65 78 2d 74 61 67 20 28 76 65 63 74 6f regex-tag (vecto
0a90: 72 2d 72 65 66 20 6f 62 6a 20 30 29 29 29 29 0a r-ref obj 0)))).
0aa0: 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 .(define (irrege
0ab0: 78 2d 64 66 61 20 78 29 20 28 76 65 63 74 6f 72 x-dfa x) (vector
0ac0: 2d 72 65 66 20 78 20 31 29 29 0a 28 64 65 66 69 -ref x 1)).(defi
0ad0: 6e 65 20 28 69 72 72 65 67 65 78 2d 64 66 61 2f ne (irregex-dfa/
0ae0: 73 65 61 72 63 68 20 78 29 20 28 76 65 63 74 6f search x) (vecto
0af0: 72 2d 72 65 66 20 78 20 32 29 29 0a 28 64 65 66 r-ref x 2)).(def
0b00: 69 6e 65 20 28 69 72 72 65 67 65 78 2d 64 66 61 ine (irregex-dfa
0b10: 2f 65 78 74 72 61 63 74 20 78 29 20 28 76 65 63 /extract x) (vec
0b20: 74 6f 72 2d 72 65 66 20 78 20 33 29 29 0a 28 64 tor-ref x 3)).(d
0b30: 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6e efine (irregex-n
0b40: 66 61 20 78 29 20 28 76 65 63 74 6f 72 2d 72 65 fa x) (vector-re
0b50: 66 20 78 20 34 29 29 0a 28 64 65 66 69 6e 65 20 f x 4)).(define
0b60: 28 69 72 72 65 67 65 78 2d 66 6c 61 67 73 20 78 (irregex-flags x
0b70: 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 ) (vector-ref x
0b80: 35 29 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 5)).(define (irr
0b90: 65 67 65 78 2d 6e 75 6d 2d 73 75 62 6d 61 74 63 egex-num-submatc
0ba0: 68 65 73 20 78 29 20 28 76 65 63 74 6f 72 2d 72 hes x) (vector-r
0bb0: 65 66 20 78 20 36 29 29 0a 28 64 65 66 69 6e 65 ef x 6)).(define
0bc0: 20 28 69 72 72 65 67 65 78 2d 6c 65 6e 67 74 68 (irregex-length
0bd0: 73 20 78 29 20 28 76 65 63 74 6f 72 2d 72 65 66 s x) (vector-ref
0be0: 20 78 20 37 29 29 0a 28 64 65 66 69 6e 65 20 28 x 7)).(define (
0bf0: 69 72 72 65 67 65 78 2d 6e 61 6d 65 73 20 78 29 irregex-names x)
0c00: 20 28 76 65 63 74 6f 72 2d 72 65 66 20 78 20 38 (vector-ref x 8
0c10: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 ))..(define (irr
0c20: 65 67 65 78 2d 6e 65 77 2d 6d 61 74 63 68 65 73 egex-new-matches
0c30: 20 69 72 78 29 0a 20 20 28 6d 61 6b 65 2d 69 72 irx). (make-ir
0c40: 72 65 67 65 78 2d 6d 61 74 63 68 20 28 69 72 72 regex-match (irr
0c50: 65 67 65 78 2d 6e 75 6d 2d 73 75 62 6d 61 74 63 egex-num-submatc
0c60: 68 65 73 20 69 72 78 29 20 28 69 72 72 65 67 65 hes irx) (irrege
0c70: 78 2d 6e 61 6d 65 73 20 69 72 78 29 29 29 0a 0a x-names irx)))..
0c80: 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 (define (irregex
0c90: 2d 72 65 73 65 74 2d 6d 61 74 63 68 65 73 21 20 -reset-matches!
0ca0: 6d 29 0a 20 20 28 64 6f 20 28 28 69 20 28 2d 20 m). (do ((i (-
0cb0: 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6d (vector-length m
0cc0: 29 20 31 29 20 28 2d 20 69 20 31 29 29 29 0a 20 ) 1) (- i 1))).
0cd0: 20 20 20 20 20 28 28 3c 3d 20 69 20 33 29 20 6d ((<= i 3) m
0ce0: 29 0a 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 ). (vector-se
0cf0: 74 21 20 6d 20 69 20 23 66 29 29 29 0a 0a 28 64 t! m i #f)))..(d
0d00: 65 66 69 6e 65 20 69 72 72 65 67 65 78 2d 6d 61 efine irregex-ma
0d10: 74 63 68 2d 74 61 67 20 27 2a 69 72 72 65 67 65 tch-tag '*irrege
0d20: 78 2d 6d 61 74 63 68 2d 74 61 67 2a 29 0a 0a 28 x-match-tag*)..(
0d30: 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d define (irregex-
0d40: 6d 61 74 63 68 2d 64 61 74 61 3f 20 6f 62 6a 29 match-data? obj)
0d50: 0a 20 20 28 61 6e 64 20 28 76 65 63 74 6f 72 3f . (and (vector?
0d60: 20 6f 62 6a 29 0a 20 20 20 20 20 20 20 28 3e 3d obj). (>=
0d70: 20 28 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 (vector-length
0d80: 6f 62 6a 29 20 31 31 29 0a 20 20 20 20 20 20 20 obj) 11).
0d90: 28 65 71 3f 20 69 72 72 65 67 65 78 2d 6d 61 74 (eq? irregex-mat
0da0: 63 68 2d 74 61 67 20 28 76 65 63 74 6f 72 2d 72 ch-tag (vector-r
0db0: 65 66 20 6f 62 6a 20 30 29 29 29 29 0a 0a 28 64 ef obj 0))))..(d
0dc0: 65 66 69 6e 65 20 28 6d 61 6b 65 2d 69 72 72 65 efine (make-irre
0dd0: 67 65 78 2d 6d 61 74 63 68 20 63 6f 75 6e 74 20 gex-match count
0de0: 6e 61 6d 65 73 29 0a 20 20 28 6c 65 74 20 28 28 names). (let ((
0df0: 72 65 73 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 res (make-vector
0e00: 20 28 2b 20 28 2a 20 34 20 28 2b 20 32 20 63 6f (+ (* 4 (+ 2 co
0e10: 75 6e 74 29 29 20 33 29 20 23 66 29 29 29 0a 20 unt)) 3) #f))).
0e20: 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
0e30: 72 65 73 20 30 20 69 72 72 65 67 65 78 2d 6d 61 res 0 irregex-ma
0e40: 74 63 68 2d 74 61 67 29 0a 20 20 20 20 28 76 65 tch-tag). (ve
0e50: 63 74 6f 72 2d 73 65 74 21 20 72 65 73 20 32 20 ctor-set! res 2
0e60: 6e 61 6d 65 73 29 0a 20 20 20 20 72 65 73 29 29 names). res))
0e70: 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 ..(define (irreg
0e80: 65 78 2d 6d 61 74 63 68 2d 6e 75 6d 2d 73 75 62 ex-match-num-sub
0e90: 6d 61 74 63 68 65 73 20 6d 29 0a 20 20 28 2d 20 matches m). (-
0ea0: 28 71 75 6f 74 69 65 6e 74 20 28 2d 20 28 76 65 (quotient (- (ve
0eb0: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6d 29 20 33 ctor-length m) 3
0ec0: 29 20 34 29 20 32 29 29 0a 0a 28 64 65 66 69 6e ) 4) 2))..(defin
0ed0: 65 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 e (irregex-match
0ee0: 2d 63 68 75 6e 6b 65 72 20 6d 29 0a 20 20 28 76 -chunker m). (v
0ef0: 65 63 74 6f 72 2d 72 65 66 20 6d 20 31 29 29 0a ector-ref m 1)).
0f00: 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 (define (irregex
0f10: 2d 6d 61 74 63 68 2d 6e 61 6d 65 73 20 6d 29 0a -match-names m).
0f20: 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 20 (vector-ref m
0f30: 32 29 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 2)).(define (irr
0f40: 65 67 65 78 2d 6d 61 74 63 68 2d 63 68 75 6e 6b egex-match-chunk
0f50: 65 72 2d 73 65 74 21 20 6d 20 73 74 72 29 0a 20 er-set! m str).
0f60: 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 20 (vector-set! m
0f70: 31 20 73 74 72 29 29 0a 0a 28 64 65 66 69 6e 65 1 str))..(define
0f80: 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
0f90: 73 74 61 72 74 2d 73 6f 75 72 63 65 20 6d 20 6e start-source m n
0fa0: 29 0a 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 ). (vector-ref
0fb0: 6d 20 28 2b 20 33 20 28 2a 20 6e 20 34 29 29 29 m (+ 3 (* n 4)))
0fc0: 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 ).(define (irreg
0fd0: 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 ex-match-start-i
0fe0: 6e 64 65 78 20 6d 20 6e 29 0a 20 20 28 76 65 63 ndex m n). (vec
0ff0: 74 6f 72 2d 72 65 66 20 6d 20 28 2b 20 34 20 28 tor-ref m (+ 4 (
1000: 2a 20 6e 20 34 29 29 29 29 0a 28 64 65 66 69 6e * n 4)))).(defin
1010: 65 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 e (irregex-match
1020: 2d 65 6e 64 2d 73 6f 75 72 63 65 20 6d 20 6e 29 -end-source m n)
1030: 0a 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d . (vector-ref m
1040: 20 28 2b 20 35 20 28 2a 20 6e 20 34 29 29 29 29 (+ 5 (* n 4))))
1050: 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 .(define (irrege
1060: 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 x-match-end-inde
1070: 78 20 6d 20 6e 29 0a 20 20 28 76 65 63 74 6f 72 x m n). (vector
1080: 2d 72 65 66 20 6d 20 28 2b 20 36 20 28 2a 20 6e -ref m (+ 6 (* n
1090: 20 34 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 4))))..(define
10a0: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 (irregex-match-s
10b0: 74 61 72 74 2d 73 6f 75 72 63 65 2d 73 65 74 21 tart-source-set!
10c0: 20 6d 20 6e 20 73 74 61 72 74 29 0a 20 20 28 76 m n start). (v
10d0: 65 63 74 6f 72 2d 73 65 74 21 20 6d 20 28 2b 20 ector-set! m (+
10e0: 33 20 28 2a 20 6e 20 34 29 29 20 73 74 61 72 74 3 (* n 4)) start
10f0: 29 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 )).(define (irre
1100: 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d gex-match-start-
1110: 69 6e 64 65 78 2d 73 65 74 21 20 6d 20 6e 20 73 index-set! m n s
1120: 74 61 72 74 29 0a 20 20 28 76 65 63 74 6f 72 2d tart). (vector-
1130: 73 65 74 21 20 6d 20 28 2b 20 34 20 28 2a 20 6e set! m (+ 4 (* n
1140: 20 34 29 29 20 73 74 61 72 74 29 29 0a 28 64 65 4)) start)).(de
1150: 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 fine (irregex-ma
1160: 74 63 68 2d 65 6e 64 2d 73 6f 75 72 63 65 2d 73 tch-end-source-s
1170: 65 74 21 20 6d 20 6e 20 65 6e 64 29 0a 20 20 28 et! m n end). (
1180: 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 20 28 2b vector-set! m (+
1190: 20 35 20 28 2a 20 6e 20 34 29 29 20 65 6e 64 29 5 (* n 4)) end)
11a0: 29 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 ).(define (irreg
11b0: 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 ex-match-end-ind
11c0: 65 78 2d 73 65 74 21 20 6d 20 6e 20 65 6e 64 29 ex-set! m n end)
11d0: 0a 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 . (vector-set!
11e0: 6d 20 28 2b 20 36 20 28 2a 20 6e 20 34 29 29 20 m (+ 6 (* n 4))
11f0: 65 6e 64 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 end))..(define (
1200: 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 69 6e irregex-match-in
1210: 64 65 78 20 6d 20 6f 70 74 29 0a 20 20 28 69 66 dex m opt). (if
1220: 20 28 70 61 69 72 3f 20 6f 70 74 29 0a 20 20 20 (pair? opt).
1230: 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6d 62 65 (cond ((numbe
1240: 72 3f 20 28 63 61 72 20 6f 70 74 29 29 20 28 63 r? (car opt)) (c
1250: 61 72 20 6f 70 74 29 29 0a 20 20 20 20 20 20 20 ar opt)).
1260: 20 20 20 20 20 28 28 61 73 73 71 20 28 63 61 72 ((assq (car
1270: 20 6f 70 74 29 20 28 69 72 72 65 67 65 78 2d 6d opt) (irregex-m
1280: 61 74 63 68 2d 6e 61 6d 65 73 20 6d 29 29 20 3d atch-names m)) =
1290: 3e 20 63 64 72 29 0a 20 20 20 20 20 20 20 20 20 > cdr).
12a0: 20 20 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 (else (error
12b0: 22 75 6e 6b 6e 6f 77 6e 20 6d 61 74 63 68 20 6e "unknown match n
12c0: 61 6d 65 22 20 28 63 61 72 20 6f 70 74 29 29 29 ame" (car opt)))
12d0: 29 0a 20 20 20 20 20 20 30 29 29 0a 0a 28 64 65 ). 0))..(de
12e0: 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 fine (irregex-ma
12f0: 74 63 68 2d 76 61 6c 69 64 2d 69 6e 64 65 78 3f tch-valid-index?
1300: 20 6d 20 6e 29 0a 20 20 28 61 6e 64 20 28 3c 20 m n). (and (<
1310: 28 2b 20 33 20 28 2a 20 6e 20 34 29 29 20 28 76 (+ 3 (* n 4)) (v
1320: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 6d 29 29 ector-length m))
1330: 0a 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d . (vector-
1340: 72 65 66 20 6d 20 28 2b 20 34 20 28 2a 20 6e 20 ref m (+ 4 (* n
1350: 34 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 4)))))..(define
1360: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 (irregex-match-s
1370: 75 62 73 74 72 69 6e 67 20 6d 20 2e 20 6f 70 74 ubstring m . opt
1380: 29 0a 20 20 28 6c 65 74 2a 20 28 28 63 6e 6b 20 ). (let* ((cnk
1390: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 63 (irregex-match-c
13a0: 68 75 6e 6b 65 72 20 6d 29 29 0a 20 20 20 20 20 hunker m)).
13b0: 20 20 20 20 28 6e 20 28 69 72 72 65 67 65 78 2d (n (irregex-
13c0: 6d 61 74 63 68 2d 69 6e 64 65 78 20 6d 20 6f 70 match-index m op
13d0: 74 29 29 29 0a 20 20 20 20 28 61 6e 64 20 28 69 t))). (and (i
13e0: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 76 61 6c rregex-match-val
13f0: 69 64 2d 69 6e 64 65 78 3f 20 6d 20 6e 29 0a 20 id-index? m n).
1400: 20 20 20 20 20 20 20 20 28 28 63 68 75 6e 6b 65 ((chunke
1410: 72 2d 67 65 74 2d 73 75 62 73 74 72 69 6e 67 20 r-get-substring
1420: 63 6e 6b 29 0a 20 20 20 20 20 20 20 20 20 20 28 cnk). (
1430: 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 irregex-match-st
1440: 61 72 74 2d 73 6f 75 72 63 65 20 6d 20 6e 29 0a art-source m n).
1450: 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 67 (irreg
1460: 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d 69 ex-match-start-i
1470: 6e 64 65 78 20 6d 20 6e 29 0a 20 20 20 20 20 20 ndex m n).
1480: 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 (irregex-mat
1490: 63 68 2d 65 6e 64 2d 73 6f 75 72 63 65 20 6d 20 ch-end-source m
14a0: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 72 n). (ir
14b0: 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d regex-match-end-
14c0: 69 6e 64 65 78 20 6d 20 6e 29 29 29 29 29 0a 0a index m n)))))..
14d0: 28 64 65 66 69 6e 65 20 28 69 72 72 65 67 65 78 (define (irregex
14e0: 2d 6d 61 74 63 68 2d 73 75 62 63 68 75 6e 6b 20 -match-subchunk
14f0: 6d 20 2e 20 6f 70 74 29 0a 20 20 28 6c 65 74 2a m . opt). (let*
1500: 20 28 28 63 6e 6b 20 28 69 72 72 65 67 65 78 2d ((cnk (irregex-
1510: 6d 61 74 63 68 2d 63 68 75 6e 6b 65 72 20 6d 29 match-chunker m)
1520: 29 0a 20 20 20 20 20 20 20 20 20 28 6e 20 28 69 ). (n (i
1530: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 69 6e 64 rregex-match-ind
1540: 65 78 20 6d 20 6f 70 74 29 29 0a 20 20 20 20 20 ex m opt)).
1550: 20 20 20 20 28 67 65 74 2d 73 75 62 63 68 75 6e (get-subchun
1560: 6b 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 k (chunker-get-s
1570: 75 62 63 68 75 6e 6b 20 63 6e 6b 29 29 29 0a 20 ubchunk cnk))).
1580: 20 20 20 28 69 66 20 28 6e 6f 74 20 67 65 74 2d (if (not get-
1590: 73 75 62 63 68 75 6e 6b 29 0a 20 20 20 20 20 20 subchunk).
15a0: 20 20 28 65 72 72 6f 72 20 22 74 68 69 73 20 63 (error "this c
15b0: 68 75 6e 6b 20 74 79 70 65 20 64 6f 65 73 20 6e hunk type does n
15c0: 6f 74 20 73 75 70 70 6f 72 74 20 6d 61 74 63 68 ot support match
15d0: 20 73 75 62 63 68 75 6e 6b 73 22 29 0a 20 20 20 subchunks").
15e0: 20 20 20 20 20 28 61 6e 64 20 28 69 72 72 65 67 (and (irreg
15f0: 65 78 2d 6d 61 74 63 68 2d 76 61 6c 69 64 2d 69 ex-match-valid-i
1600: 6e 64 65 78 3f 20 6d 20 6e 29 0a 20 20 20 20 20 ndex? m n).
1610: 20 20 20 20 20 20 20 20 28 67 65 74 2d 73 75 62 (get-sub
1620: 63 68 75 6e 6b 0a 20 20 20 20 20 20 20 20 20 20 chunk.
1630: 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 (irregex-mat
1640: 63 68 2d 73 74 61 72 74 2d 73 6f 75 72 63 65 20 ch-start-source
1650: 6d 20 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 m n).
1660: 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
1670: 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 20 6d 20 h-start-index m
1680: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
1690: 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
16a0: 65 6e 64 2d 73 6f 75 72 63 65 20 6d 20 6e 29 0a end-source m n).
16b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
16c0: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
16d0: 2d 69 6e 64 65 78 20 6d 20 6e 29 29 29 29 29 29 -index m n))))))
16e0: 0a 0a 3b 3b 20 63 68 75 6e 6b 65 72 73 20 74 65 ..;; chunkers te
16f0: 6c 6c 20 75 73 20 68 6f 77 20 74 6f 20 6e 61 76 ll us how to nav
1700: 69 67 61 74 65 20 74 68 72 6f 75 67 68 20 63 68 igate through ch
1710: 61 69 6e 65 64 20 63 68 75 6e 6b 73 20 6f 66 20 ained chunks of
1720: 73 74 72 69 6e 67 73 0a 0a 28 64 65 66 69 6e 65 strings..(define
1730: 20 28 6d 61 6b 65 2d 69 72 72 65 67 65 78 2d 63 (make-irregex-c
1740: 68 75 6e 6b 65 72 20 67 65 74 2d 6e 65 78 74 20 hunker get-next
1750: 67 65 74 2d 73 74 72 20 2e 20 6f 29 0a 20 20 28 get-str . o). (
1760: 6c 65 74 2a 20 28 28 67 65 74 2d 73 74 61 72 74 let* ((get-start
1770: 20 28 6f 72 20 28 61 6e 64 20 28 70 61 69 72 3f (or (and (pair?
1780: 20 6f 29 20 28 63 61 72 20 6f 29 29 20 28 6c 61 o) (car o)) (la
1790: 6d 62 64 61 20 28 63 6e 6b 29 20 30 29 29 29 0a mbda (cnk) 0))).
17a0: 20 20 20 20 20 20 20 20 20 28 6f 20 28 69 66 20 (o (if
17b0: 28 70 61 69 72 3f 20 6f 29 20 28 63 64 72 20 6f (pair? o) (cdr o
17c0: 29 20 6f 29 29 0a 20 20 20 20 20 20 20 20 20 28 ) o)). (
17d0: 67 65 74 2d 65 6e 64 20 28 6f 72 20 28 61 6e 64 get-end (or (and
17e0: 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 72 20 (pair? o) (car
17f0: 6f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 o)).
1800: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
1810: 61 20 28 63 6e 6b 29 20 28 73 74 72 69 6e 67 2d a (cnk) (string-
1820: 6c 65 6e 67 74 68 20 28 67 65 74 2d 73 74 72 20 length (get-str
1830: 63 6e 6b 29 29 29 29 29 0a 20 20 20 20 20 20 20 cnk))))).
1840: 20 20 28 6f 20 28 69 66 20 28 70 61 69 72 3f 20 (o (if (pair?
1850: 6f 29 20 28 63 64 72 20 6f 29 20 6f 29 29 0a 20 o) (cdr o) o)).
1860: 20 20 20 20 20 20 20 20 28 67 65 74 2d 73 75 62 (get-sub
1870: 73 74 72 0a 20 20 20 20 20 20 20 20 20 20 28 6f str. (o
1880: 72 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 r (and (pair? o)
1890: 20 28 63 61 72 20 6f 29 29 0a 20 20 20 20 20 20 (car o)).
18a0: 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
18b0: 28 63 6e 6b 31 20 73 74 61 72 74 20 63 6e 6b 32 (cnk1 start cnk2
18c0: 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
18d0: 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 63 (if (eq? c
18e0: 6e 6b 31 20 63 6e 6b 32 29 0a 20 20 20 20 20 20 nk1 cnk2).
18f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
1900: 75 62 73 74 72 69 6e 67 20 28 67 65 74 2d 73 74 ubstring (get-st
1910: 72 20 63 6e 6b 31 29 20 73 74 61 72 74 20 65 6e r cnk1) start en
1920: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
1930: 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f 70 (let loop
1940: 20 28 28 63 6e 6b 20 28 63 64 72 20 63 6e 6b 31 ((cnk (cdr cnk1
1950: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1970: 20 20 28 72 65 73 20 28 6c 69 73 74 20 28 73 75 (res (list (su
1980: 62 73 74 72 69 6e 67 20 28 67 65 74 2d 73 74 72 bstring (get-str
1990: 20 63 6e 6b 31 29 0a 20 20 20 20 20 20 20 20 20 cnk1).
19a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c0: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 72 star
19d0: 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a00: 20 20 20 20 20 20 20 28 67 65 74 2d 65 6e 64 20 (get-end
1a10: 63 6e 6b 31 29 29 29 29 29 0a 20 20 20 20 20 20 cnk1))))).
1a20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a30: 28 69 66 20 28 65 71 3f 20 63 6e 6b 20 63 6e 6b (if (eq? cnk cnk
1a40: 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2).
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
1a60: 72 69 6e 67 2d 63 61 74 2d 72 65 76 65 72 73 65 ring-cat-reverse
1a70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a80: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
1a90: 73 20 28 73 75 62 73 74 72 69 6e 67 20 28 67 65 s (substring (ge
1aa0: 74 2d 73 74 72 20 63 6e 6b 29 0a 20 20 20 20 20 t-str cnk).
1ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ad0: 20 20 20 20 20 20 20 28 67 65 74 2d 73 74 61 72 (get-star
1ae0: 74 20 63 6e 6b 29 0a 20 20 20 20 20 20 20 20 20 t cnk).
1af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b10: 20 20 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 end).
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b30: 20 20 20 20 20 20 20 20 20 72 65 73 29 29 0a 20 res)).
1b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b50: 20 20 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 (loop (
1b60: 63 64 72 20 63 6e 6b 29 0a 20 20 20 20 20 20 20 cdr cnk).
1b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b80: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 (cons (
1b90: 73 75 62 73 74 72 69 6e 67 20 28 67 65 74 2d 73 substring (get-s
1ba0: 74 72 20 63 6e 6b 29 0a 20 20 20 20 20 20 20 20 tr cnk).
1bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bd0: 20 20 20 20 20 20 20 20 20 28 67 65 74 2d 73 74 (get-st
1be0: 61 72 74 20 63 6e 6b 29 0a 20 20 20 20 20 20 20 art cnk).
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c10: 20 20 20 20 20 20 20 20 20 20 28 67 65 74 2d 65 (get-e
1c20: 6e 64 20 63 6e 6b 29 29 0a 20 20 20 20 20 20 20 nd cnk)).
1c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
1c50: 65 73 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 es)))))))).
1c60: 20 20 20 20 28 6f 20 28 69 66 20 28 70 61 69 72 (o (if (pair
1c70: 3f 20 6f 29 20 28 63 64 72 20 6f 29 20 6f 29 29 ? o) (cdr o) o))
1c80: 0a 20 20 20 20 20 20 20 20 20 28 67 65 74 2d 73 . (get-s
1c90: 75 62 63 68 75 6e 6b 20 28 61 6e 64 20 28 70 61 ubchunk (and (pa
1ca0: 69 72 3f 20 6f 29 20 28 63 61 72 20 6f 29 29 29 ir? o) (car o)))
1cb0: 29 0a 20 20 20 20 28 76 65 63 74 6f 72 20 67 65 ). (vector ge
1cc0: 74 2d 6e 65 78 74 20 67 65 74 2d 73 74 72 20 67 t-next get-str g
1cd0: 65 74 2d 73 74 61 72 74 20 67 65 74 2d 65 6e 64 et-start get-end
1ce0: 20 67 65 74 2d 73 75 62 73 74 72 20 67 65 74 2d get-substr get-
1cf0: 73 75 62 63 68 75 6e 6b 29 29 29 0a 0a 28 64 65 subchunk)))..(de
1d00: 66 69 6e 65 20 28 63 68 75 6e 6b 65 72 2d 67 65 fine (chunker-ge
1d10: 74 2d 6e 65 78 74 20 63 6e 6b 29 20 28 76 65 63 t-next cnk) (vec
1d20: 74 6f 72 2d 72 65 66 20 63 6e 6b 20 30 29 29 0a tor-ref cnk 0)).
1d30: 28 64 65 66 69 6e 65 20 28 63 68 75 6e 6b 65 72 (define (chunker
1d40: 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 28 76 -get-str cnk) (v
1d50: 65 63 74 6f 72 2d 72 65 66 20 63 6e 6b 20 31 29 ector-ref cnk 1)
1d60: 29 0a 28 64 65 66 69 6e 65 20 28 63 68 75 6e 6b ).(define (chunk
1d70: 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b er-get-start cnk
1d80: 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 6e ) (vector-ref cn
1d90: 6b 20 32 29 29 0a 28 64 65 66 69 6e 65 20 28 63 k 2)).(define (c
1da0: 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 hunker-get-end c
1db0: 6e 6b 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 nk) (vector-ref
1dc0: 63 6e 6b 20 33 29 29 0a 28 64 65 66 69 6e 65 20 cnk 3)).(define
1dd0: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 75 62 (chunker-get-sub
1de0: 73 74 72 69 6e 67 20 63 6e 6b 29 20 28 76 65 63 string cnk) (vec
1df0: 74 6f 72 2d 72 65 66 20 63 6e 6b 20 34 29 29 0a tor-ref cnk 4)).
1e00: 28 64 65 66 69 6e 65 20 28 63 68 75 6e 6b 65 72 (define (chunker
1e10: 2d 67 65 74 2d 73 75 62 63 68 75 6e 6b 20 63 6e -get-subchunk cn
1e20: 6b 29 20 28 76 65 63 74 6f 72 2d 72 65 66 20 63 k) (vector-ref c
1e30: 6e 6b 20 35 29 29 0a 0a 28 64 65 66 69 6e 65 20 nk 5))..(define
1e40: 28 63 68 75 6e 6b 65 72 2d 70 72 65 76 2d 63 68 (chunker-prev-ch
1e50: 75 6e 6b 20 63 6e 6b 20 73 74 61 72 74 20 65 6e unk cnk start en
1e60: 64 29 0a 20 20 28 69 66 20 28 65 71 3f 20 73 74 d). (if (eq? st
1e70: 61 72 74 20 65 6e 64 29 0a 20 20 20 20 20 20 23 art end). #
1e80: 66 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 67 f. (let ((g
1e90: 65 74 2d 6e 65 78 74 20 28 63 68 75 6e 6b 65 72 et-next (chunker
1ea0: 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 29 29 -get-next cnk)))
1eb0: 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 . (let lp
1ec0: 20 28 28 73 74 61 72 74 20 73 74 61 72 74 29 29 ((start start))
1ed0: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 . (let
1ee0: 28 28 6e 65 78 74 20 28 67 65 74 2d 6e 65 78 74 ((next (get-next
1ef0: 20 73 74 61 72 74 29 29 29 0a 20 20 20 20 20 20 start))).
1f00: 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 6e (if (eq? n
1f10: 65 78 74 20 65 6e 64 29 0a 20 20 20 20 20 20 20 ext end).
1f20: 20 20 20 20 20 20 20 20 20 73 74 61 72 74 0a 20 start.
1f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1f40: 61 6e 64 20 6e 65 78 74 20 28 6c 70 20 6e 65 78 and next (lp nex
1f50: 74 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 t))))))))..(defi
1f60: 6e 65 20 28 63 68 75 6e 6b 65 72 2d 70 72 65 76 ne (chunker-prev
1f70: 2d 63 68 61 72 20 63 6e 6b 20 73 74 61 72 74 20 -char cnk start
1f80: 65 6e 64 29 0a 20 20 28 6c 65 74 20 28 28 70 72 end). (let ((pr
1f90: 65 76 20 28 63 68 75 6e 6b 65 72 2d 70 72 65 76 ev (chunker-prev
1fa0: 2d 63 68 75 6e 6b 20 63 6e 6b 20 73 74 61 72 74 -chunk cnk start
1fb0: 20 65 6e 64 29 29 29 0a 20 20 20 20 28 61 6e 64 end))). (and
1fc0: 20 70 72 65 76 0a 20 20 20 20 20 20 20 20 20 28 prev. (
1fd0: 73 74 72 69 6e 67 2d 72 65 66 20 28 28 63 68 75 string-ref ((chu
1fe0: 6e 6b 65 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b nker-get-str cnk
1ff0: 29 20 70 72 65 76 29 0a 20 20 20 20 20 20 20 20 ) prev).
2000: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2d 20 (-
2010: 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e ((chunker-get-en
2020: 64 20 63 6e 6b 29 20 70 72 65 76 29 20 31 29 29 d cnk) prev) 1))
2030: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 )))..(define (ch
2040: 75 6e 6b 65 72 2d 6e 65 78 74 2d 63 68 61 72 20 unker-next-char
2050: 63 6e 6b 20 73 72 63 29 0a 20 20 28 6c 65 74 20 cnk src). (let
2060: 28 28 6e 65 78 74 20 28 28 63 68 75 6e 6b 65 72 ((next ((chunker
2070: 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 73 -get-next cnk) s
2080: 72 63 29 29 29 0a 20 20 20 20 28 61 6e 64 20 6e rc))). (and n
2090: 65 78 74 0a 20 20 20 20 20 20 20 20 20 28 73 74 ext. (st
20a0: 72 69 6e 67 2d 72 65 66 20 28 28 63 68 75 6e 6b ring-ref ((chunk
20b0: 65 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 er-get-str cnk)
20c0: 6e 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 20 next).
20d0: 20 20 20 20 20 20 20 20 20 20 20 28 28 63 68 75 ((chu
20e0: 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 nker-get-start c
20f0: 6e 6b 29 20 6e 65 78 74 29 29 29 29 29 0a 0a 28 nk) next)))))..(
2100: 64 65 66 69 6e 65 20 28 63 68 75 6e 6b 2d 62 65 define (chunk-be
2110: 66 6f 72 65 3f 20 63 6e 6b 20 61 20 62 29 0a 20 fore? cnk a b).
2120: 20 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 3f 20 (and (not (eq?
2130: 61 20 62 29 29 0a 20 20 20 20 20 20 20 28 6c 65 a b)). (le
2140: 74 20 28 28 6e 65 78 74 20 28 28 63 68 75 6e 6b t ((next ((chunk
2150: 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 er-get-next cnk)
2160: 20 61 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 a))). (
2170: 61 6e 64 20 6e 65 78 74 0a 20 20 20 20 20 20 20 and next.
2180: 20 20 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 (if (eq?
2190: 6e 65 78 74 20 62 29 0a 20 20 20 20 20 20 20 20 next b).
21a0: 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 20 20 #t.
21b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
21c0: 63 68 75 6e 6b 2d 62 65 66 6f 72 65 3f 20 63 6e chunk-before? cn
21d0: 6b 20 6e 65 78 74 20 62 29 29 29 29 29 29 0a 0a k next b))))))..
21e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
21f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2200: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2210: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2220: 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 73 74 72 69 ;;;;;;;;.;; stri
2230: 6e 67 20 75 74 69 6c 69 74 69 65 73 0a 0a 3b 3b ng utilities..;;
2240: 3b 3b 20 55 6e 69 63 6f 64 65 20 76 65 72 73 69 ;; Unicode versi
2250: 6f 6e 20 28 73 6b 69 70 20 73 75 72 72 6f 67 61 on (skip surroga
2260: 74 65 73 29 0a 28 64 65 66 69 6e 65 20 2a 61 6c tes).(define *al
2270: 6c 2d 63 68 61 72 73 2a 0a 20 20 60 28 2f 20 2c l-chars*. `(/ ,
2280: 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 30 (integer->char 0
2290: 29 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 ) ,(integer->cha
22a0: 72 20 23 78 44 37 46 46 29 0a 20 20 20 20 20 20 r #xD7FF).
22b0: 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
22c0: 23 78 45 30 30 30 29 20 2c 28 69 6e 74 65 67 65 #xE000) ,(intege
22d0: 72 2d 3e 63 68 61 72 20 23 78 31 30 46 46 46 46 r->char #x10FFFF
22e0: 29 29 29 0a 0a 3b 3b 3b 3b 20 41 53 43 49 49 20 )))..;;;; ASCII
22f0: 76 65 72 73 69 6f 6e 2c 20 6f 66 66 73 65 74 20 version, offset
2300: 74 6f 20 6e 6f 74 20 61 73 73 75 6d 65 20 30 2d to not assume 0-
2310: 32 35 35 0a 3b 3b 20 28 64 65 66 69 6e 65 20 2a 255.;; (define *
2320: 61 6c 6c 2d 63 68 61 72 73 2a 20 60 28 2f 20 2c all-chars* `(/ ,
2330: 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 (integer->char (
2340: 2d 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 - (char->integer
2350: 20 23 5c 73 70 61 63 65 29 20 33 32 29 29 20 2c #\space) 32)) ,
2360: 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 (integer->char (
2370: 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 + (char->integer
2380: 20 23 5c 73 70 61 63 65 29 20 32 32 33 29 29 29 #\space) 223)))
2390: 29 0a 0a 3b 3b 20 73 65 74 20 74 6f 20 23 66 20 )..;; set to #f
23a0: 74 6f 20 69 67 6e 6f 72 65 20 65 76 65 6e 20 61 to ignore even a
23b0: 6e 20 65 78 70 6c 69 63 69 74 20 72 65 71 75 65 n explicit reque
23c0: 73 74 20 66 6f 72 20 75 74 66 38 20 68 61 6e 64 st for utf8 hand
23d0: 6c 69 6e 67 0a 28 64 65 66 69 6e 65 20 2a 61 6c ling.(define *al
23e0: 6c 6f 77 2d 75 74 66 38 2d 6d 6f 64 65 3f 2a 20 low-utf8-mode?*
23f0: 23 66 29 0a 0a 3b 3b 20 28 64 65 66 69 6e 65 20 #f)..;; (define
2400: 2a 6e 61 6d 65 64 2d 63 68 61 72 2d 70 72 6f 70 *named-char-prop
2410: 65 72 74 69 65 73 2a 20 27 28 29 29 0a 0a 28 64 erties* '())..(d
2420: 65 66 69 6e 65 20 28 73 74 72 69 6e 67 2d 73 63 efine (string-sc
2430: 61 6e 2d 63 68 61 72 20 73 74 72 20 63 20 2e 20 an-char str c .
2440: 6f 29 0a 20 20 28 6c 65 74 20 28 28 65 6e 64 20 o). (let ((end
2450: 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 (string-length s
2460: 74 72 29 29 29 0a 20 20 20 20 28 6c 65 74 20 73 tr))). (let s
2470: 63 61 6e 20 28 28 69 20 28 69 66 20 28 70 61 69 can ((i (if (pai
2480: 72 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 30 29 r? o) (car o) 0)
2490: 29 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 20 28 )). (cond (
24a0: 28 3d 20 69 20 65 6e 64 29 20 23 66 29 0a 20 20 (= i end) #f).
24b0: 20 20 20 20 20 20 20 20 20 20 28 28 65 71 76 3f ((eqv?
24c0: 20 63 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 c (string-ref s
24d0: 74 72 20 69 29 29 20 69 29 0a 20 20 20 20 20 20 tr i)) i).
24e0: 20 20 20 20 20 20 28 65 6c 73 65 20 28 73 63 61 (else (sca
24f0: 6e 20 28 2b 20 69 20 31 29 29 29 29 29 29 29 0a n (+ i 1))))))).
2500: 0a 28 64 65 66 69 6e 65 20 28 73 74 72 69 6e 67 .(define (string
2510: 2d 73 63 61 6e 2d 63 68 61 72 2d 65 73 63 61 70 -scan-char-escap
2520: 65 20 73 74 72 20 63 20 2e 20 6f 29 0a 20 20 28 e str c . o). (
2530: 6c 65 74 20 28 28 65 6e 64 20 28 73 74 72 69 6e let ((end (strin
2540: 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 29 0a g-length str))).
2550: 20 20 20 20 28 6c 65 74 20 73 63 61 6e 20 28 28 (let scan ((
2560: 69 20 28 69 66 20 28 70 61 69 72 3f 20 6f 29 20 i (if (pair? o)
2570: 28 63 61 72 20 6f 29 20 30 29 29 29 0a 20 20 20 (car o) 0))).
2580: 20 20 20 28 63 6f 6e 64 20 28 28 3d 20 69 20 65 (cond ((= i e
2590: 6e 64 29 20 23 66 29 0a 20 20 20 20 20 20 20 20 nd) #f).
25a0: 20 20 20 20 28 28 65 71 76 3f 20 63 20 28 73 74 ((eqv? c (st
25b0: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 29 ring-ref str i))
25c0: 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i).
25d0: 28 28 65 71 76 3f 20 63 20 23 5c 5c 29 20 28 73 ((eqv? c #\\) (s
25e0: 63 61 6e 20 28 2b 20 69 20 32 29 29 29 0a 20 20 can (+ i 2))).
25f0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 (else
2600: 28 73 63 61 6e 20 28 2b 20 69 20 31 29 29 29 29 (scan (+ i 1))))
2610: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 74 )))..(define (st
2620: 72 69 6e 67 2d 73 63 61 6e 2d 70 72 65 64 20 73 ring-scan-pred s
2630: 74 72 20 70 72 65 64 20 2e 20 6f 29 0a 20 20 28 tr pred . o). (
2640: 6c 65 74 20 28 28 65 6e 64 20 28 73 74 72 69 6e let ((end (strin
2650: 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 29 0a g-length str))).
2660: 20 20 20 20 28 6c 65 74 20 73 63 61 6e 20 28 28 (let scan ((
2670: 69 20 28 69 66 20 28 70 61 69 72 3f 20 6f 29 20 i (if (pair? o)
2680: 28 63 61 72 20 6f 29 20 30 29 29 29 0a 20 20 20 (car o) 0))).
2690: 20 20 20 28 63 6f 6e 64 20 28 28 3d 20 69 20 65 (cond ((= i e
26a0: 6e 64 29 20 23 66 29 0a 20 20 20 20 20 20 20 20 nd) #f).
26b0: 20 20 20 20 28 28 70 72 65 64 20 28 73 74 72 69 ((pred (stri
26c0: 6e 67 2d 72 65 66 20 73 74 72 20 69 29 29 20 69 ng-ref str i)) i
26d0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65 ). (e
26e0: 6c 73 65 20 28 73 63 61 6e 20 28 2b 20 69 20 31 lse (scan (+ i 1
26f0: 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
2700: 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 2d 63 (string-split-c
2710: 68 61 72 20 73 74 72 20 63 29 0a 20 20 28 6c 65 har str c). (le
2720: 74 20 28 28 65 6e 64 20 28 73 74 72 69 6e 67 2d t ((end (string-
2730: 6c 65 6e 67 74 68 20 73 74 72 29 29 29 0a 20 20 length str))).
2740: 20 20 28 6c 65 74 20 6c 70 20 28 28 69 20 30 29 (let lp ((i 0)
2750: 20 28 66 72 6f 6d 20 30 29 20 28 72 65 73 20 27 (from 0) (res '
2760: 28 29 29 29 0a 20 20 20 20 20 20 28 64 65 66 69 ())). (defi
2770: 6e 65 20 28 63 6f 6c 6c 65 63 74 29 20 28 63 6f ne (collect) (co
2780: 6e 73 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 ns (substring st
2790: 72 20 66 72 6f 6d 20 69 29 20 72 65 73 29 29 0a r from i) res)).
27a0: 20 20 20 20 20 20 28 63 6f 6e 64 20 28 28 3e 3d (cond ((>=
27b0: 20 69 20 65 6e 64 29 20 28 72 65 76 65 72 73 65 i end) (reverse
27c0: 20 28 63 6f 6c 6c 65 63 74 29 29 29 0a 20 20 20 (collect))).
27d0: 20 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 ((eqv?
27e0: 63 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 c (string-ref st
27f0: 72 20 69 29 29 20 28 6c 70 20 28 2b 20 69 20 31 r i)) (lp (+ i 1
2800: 29 20 28 2b 20 69 20 31 29 20 28 63 6f 6c 6c 65 ) (+ i 1) (colle
2810: 63 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ct))).
2820: 20 20 28 65 6c 73 65 20 28 6c 70 20 28 2b 20 69 (else (lp (+ i
2830: 20 31 29 20 66 72 6f 6d 20 72 65 73 29 29 29 29 1) from res))))
2840: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 61 ))..(define (cha
2850: 72 2d 61 6c 70 68 61 6e 75 6d 65 72 69 63 3f 20 r-alphanumeric?
2860: 63 29 0a 20 20 28 6f 72 20 28 63 68 61 72 2d 61 c). (or (char-a
2870: 6c 70 68 61 62 65 74 69 63 3f 20 63 29 20 28 63 lphabetic? c) (c
2880: 68 61 72 2d 6e 75 6d 65 72 69 63 3f 20 63 29 29 har-numeric? c))
2890: 29 0a 0a 28 64 65 66 69 6e 65 20 28 25 73 75 62 )..(define (%sub
28a0: 73 74 72 69 6e 67 3d 3f 20 61 20 62 20 73 74 61 string=? a b sta
28b0: 72 74 31 20 73 74 61 72 74 32 20 6c 65 6e 29 0a rt1 start2 len).
28c0: 20 20 28 6c 65 74 20 6c 70 20 28 28 69 20 30 29 (let lp ((i 0)
28d0: 29 0a 20 20 20 20 28 63 6f 6e 64 20 28 28 3e 3d ). (cond ((>=
28e0: 20 69 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 i len).
28f0: 20 20 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 #t).
2900: 20 28 28 63 68 61 72 3d 3f 20 28 73 74 72 69 6e ((char=? (strin
2910: 67 2d 72 65 66 20 61 20 28 2b 20 73 74 61 72 74 g-ref a (+ start
2920: 31 20 69 29 29 20 28 73 74 72 69 6e 67 2d 72 65 1 i)) (string-re
2930: 66 20 62 20 28 2b 20 73 74 61 72 74 32 20 69 29 f b (+ start2 i)
2940: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c )). (l
2950: 70 20 28 2b 20 69 20 31 29 29 29 0a 20 20 20 20 p (+ i 1))).
2960: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
2970: 20 20 20 20 20 20 20 23 66 29 29 29 29 0a 0a 3b #f))))..;
2980: 3b 20 53 52 46 49 2d 31 33 20 65 78 74 72 61 63 ; SRFI-13 extrac
2990: 74 73 0a 0a 28 64 65 66 69 6e 65 20 28 25 25 73 ts..(define (%%s
29a0: 74 72 69 6e 67 2d 63 6f 70 79 21 20 74 6f 20 74 tring-copy! to t
29b0: 73 74 61 72 74 20 66 72 6f 6d 20 66 73 74 61 72 start from fstar
29c0: 74 20 66 65 6e 64 29 0a 20 20 28 64 6f 20 28 28 t fend). (do ((
29d0: 69 20 66 73 74 61 72 74 20 28 2b 20 69 20 31 29 i fstart (+ i 1)
29e0: 29 0a 20 20 20 20 20 20 20 28 6a 20 74 73 74 61 ). (j tsta
29f0: 72 74 20 28 2b 20 6a 20 31 29 29 29 0a 20 20 20 rt (+ j 1))).
2a00: 20 20 20 28 28 3e 3d 20 69 20 66 65 6e 64 29 29 ((>= i fend))
2a10: 0a 20 20 20 20 28 73 74 72 69 6e 67 2d 73 65 74 . (string-set
2a20: 21 20 74 6f 20 6a 20 28 73 74 72 69 6e 67 2d 72 ! to j (string-r
2a30: 65 66 20 66 72 6f 6d 20 69 29 29 29 29 0a 0a 28 ef from i))))..(
2a40: 64 65 66 69 6e 65 20 28 73 74 72 69 6e 67 2d 63 define (string-c
2a50: 61 74 2d 72 65 76 65 72 73 65 20 73 74 72 69 6e at-reverse strin
2a60: 67 2d 6c 69 73 74 29 0a 20 20 28 73 74 72 69 6e g-list). (strin
2a70: 67 2d 63 61 74 2d 72 65 76 65 72 73 65 2f 61 75 g-cat-reverse/au
2a80: 78 0a 20 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 x. (fold (lamb
2a90: 64 61 20 28 73 20 61 29 20 28 2b 20 28 73 74 72 da (s a) (+ (str
2aa0: 69 6e 67 2d 6c 65 6e 67 74 68 20 73 29 20 61 29 ing-length s) a)
2ab0: 29 20 30 20 73 74 72 69 6e 67 2d 6c 69 73 74 29 ) 0 string-list)
2ac0: 0a 20 20 20 73 74 72 69 6e 67 2d 6c 69 73 74 29 . string-list)
2ad0: 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 74 72 69 )..(define (stri
2ae0: 6e 67 2d 63 61 74 2d 72 65 76 65 72 73 65 2f 61 ng-cat-reverse/a
2af0: 75 78 20 6c 65 6e 20 73 74 72 69 6e 67 2d 6c 69 ux len string-li
2b00: 73 74 29 0a 20 20 28 6c 65 74 20 28 28 72 65 73 st). (let ((res
2b10: 20 28 6d 61 6b 65 2d 73 74 72 69 6e 67 20 6c 65 (make-string le
2b20: 6e 29 29 29 0a 20 20 20 20 28 6c 65 74 20 6c 70 n))). (let lp
2b30: 20 28 28 69 20 6c 65 6e 29 20 28 6c 73 20 73 74 ((i len) (ls st
2b40: 72 69 6e 67 2d 6c 69 73 74 29 29 0a 20 20 20 20 ring-list)).
2b50: 20 20 28 69 66 20 28 70 61 69 72 3f 20 6c 73 29 (if (pair? ls)
2b60: 0a 09 20 20 28 6c 65 74 2a 20 28 28 73 20 28 63 .. (let* ((s (c
2b70: 61 72 20 6c 73 29 29 0a 09 09 20 28 73 6c 65 6e ar ls))... (slen
2b80: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
2b90: 73 29 29 0a 09 09 20 28 69 20 28 2d 20 69 20 73 s))... (i (- i s
2ba0: 6c 65 6e 29 29 29 0a 09 20 20 20 20 28 25 25 73 len))).. (%%s
2bb0: 74 72 69 6e 67 2d 63 6f 70 79 21 20 72 65 73 20 tring-copy! res
2bc0: 69 20 73 20 30 20 73 6c 65 6e 29 0a 09 20 20 20 i s 0 slen)..
2bd0: 20 28 6c 70 20 69 20 28 63 64 72 20 6c 73 29 29 (lp i (cdr ls))
2be0: 29 29 29 0a 20 20 20 20 72 65 73 29 29 0a 0a 3b ))). res))..;
2bf0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2c00: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2c10: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2c20: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2c30: 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 6c 69 73 74 20 ;;;;;;;.;; list
2c40: 75 74 69 6c 69 74 69 65 73 0a 0a 3b 3b 20 6c 69 utilities..;; li
2c50: 6b 65 20 74 68 65 20 6f 6e 65 2d 61 72 67 20 49 ke the one-arg I
2c60: 4f 54 41 20 63 61 73 65 0a 28 64 65 66 69 6e 65 OTA case.(define
2c70: 20 28 7a 65 72 6f 2d 74 6f 20 6e 29 0a 20 20 28 (zero-to n). (
2c80: 69 66 20 28 3c 3d 20 6e 20 30 29 0a 20 20 20 20 if (<= n 0).
2c90: 20 20 27 28 29 0a 20 20 20 20 20 20 28 6c 65 74 '(). (let
2ca0: 20 6c 70 20 28 28 69 20 28 2d 20 6e 20 31 29 29 lp ((i (- n 1))
2cb0: 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 (res '())).
2cc0: 20 20 20 20 28 69 66 20 28 7a 65 72 6f 3f 20 69 (if (zero? i
2cd0: 29 20 28 63 6f 6e 73 20 30 20 72 65 73 29 20 28 ) (cons 0 res) (
2ce0: 6c 70 20 28 2d 20 69 20 31 29 20 28 63 6f 6e 73 lp (- i 1) (cons
2cf0: 20 69 20 72 65 73 29 29 29 29 29 29 0a 0a 3b 3b i res))))))..;;
2d00: 20 74 61 6b 65 20 74 68 65 20 68 65 61 64 20 6f take the head o
2d10: 66 20 6c 69 73 74 20 46 52 4f 4d 20 75 70 20 74 f list FROM up t
2d20: 6f 20 62 75 74 20 6e 6f 74 20 69 6e 63 6c 75 64 o but not includ
2d30: 69 6e 67 20 54 4f 2c 20 77 68 69 63 68 20 6d 75 ing TO, which mu
2d40: 73 74 0a 3b 3b 20 62 65 20 61 20 74 61 69 6c 20 st.;; be a tail
2d50: 6f 66 20 74 68 65 20 6c 69 73 74 0a 28 64 65 66 of the list.(def
2d60: 69 6e 65 20 28 74 61 6b 65 2d 75 70 2d 74 6f 20 ine (take-up-to
2d70: 66 72 6f 6d 20 74 6f 29 0a 20 20 28 6c 65 74 20 from to). (let
2d80: 6c 70 20 28 28 6c 73 20 66 72 6f 6d 29 20 28 72 lp ((ls from) (r
2d90: 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 69 66 es '())). (if
2da0: 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6c 73 29 (and (pair? ls)
2db0: 20 28 6e 6f 74 20 28 65 71 3f 20 6c 73 20 74 6f (not (eq? ls to
2dc0: 29 29 29 0a 20 20 20 20 20 20 20 20 28 6c 70 20 ))). (lp
2dd0: 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 20 28 (cdr ls) (cons (
2de0: 63 61 72 20 6c 73 29 20 72 65 73 29 29 0a 20 20 car ls) res)).
2df0: 20 20 20 20 20 20 28 72 65 76 65 72 73 65 20 72 (reverse r
2e00: 65 73 29 29 29 29 0a 0a 3b 3b 20 53 52 46 49 2d es))))..;; SRFI-
2e10: 31 20 65 78 74 72 61 63 74 73 20 28 73 69 6d 70 1 extracts (simp
2e20: 6c 69 66 69 65 64 20 31 2d 61 72 79 20 76 65 72 lified 1-ary ver
2e30: 73 69 6f 6e 73 29 0a 0a 28 64 65 66 69 6e 65 20 sions)..(define
2e40: 28 66 69 6e 64 2d 74 61 69 6c 20 70 72 65 64 20 (find-tail pred
2e50: 6c 73 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 ls). (let lp ((
2e60: 6c 73 20 6c 73 29 29 0a 20 20 20 20 28 63 6f 6e ls ls)). (con
2e70: 64 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 20 23 66 d ((null? ls) #f
2e80: 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 70 72 ). ((pr
2e90: 65 64 20 28 63 61 72 20 6c 73 29 29 20 6c 73 29 ed (car ls)) ls)
2ea0: 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 . (else
2eb0: 20 28 6c 70 20 28 63 64 72 20 6c 73 29 29 29 29 (lp (cdr ls))))
2ec0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6c 61 73 ))..(define (las
2ed0: 74 20 6c 73 29 0a 20 20 28 69 66 20 28 6e 6f 74 t ls). (if (not
2ee0: 20 28 70 61 69 72 3f 20 6c 73 29 29 0a 20 20 20 (pair? ls)).
2ef0: 20 20 20 28 65 72 72 6f 72 20 22 63 61 6e 27 74 (error "can't
2f00: 20 74 61 6b 65 20 6c 61 73 74 20 6f 66 20 65 6d take last of em
2f10: 70 74 79 20 6c 69 73 74 22 20 6c 73 29 0a 20 20 pty list" ls).
2f20: 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 (let lp ((ls
2f30: 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 28 69 ls)). (i
2f40: 66 20 28 70 61 69 72 3f 20 28 63 64 72 20 6c 73 f (pair? (cdr ls
2f50: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
2f60: 6c 70 20 28 63 64 72 20 6c 73 29 29 0a 20 20 20 lp (cdr ls)).
2f70: 20 20 20 20 20 20 20 20 20 28 63 61 72 20 6c 73 (car ls
2f80: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 )))))..(define (
2f90: 61 6e 79 20 70 72 65 64 20 6c 73 29 0a 20 20 28 any pred ls). (
2fa0: 61 6e 64 20 28 70 61 69 72 3f 20 6c 73 29 0a 20 and (pair? ls).
2fb0: 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 (let lp ((
2fc0: 68 65 61 64 20 28 63 61 72 20 6c 73 29 29 20 28 head (car ls)) (
2fd0: 74 61 69 6c 20 28 63 64 72 20 6c 73 29 29 29 0a tail (cdr ls))).
2fe0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
2ff0: 6c 6c 3f 20 74 61 69 6c 29 0a 20 20 20 20 20 20 ll? tail).
3000: 20 20 20 20 20 20 20 28 70 72 65 64 20 68 65 61 (pred hea
3010: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
3020: 28 6f 72 20 28 70 72 65 64 20 68 65 61 64 29 20 (or (pred head)
3030: 28 6c 70 20 28 63 61 72 20 74 61 69 6c 29 20 28 (lp (car tail) (
3040: 63 64 72 20 74 61 69 6c 29 29 29 29 29 29 29 0a cdr tail))))))).
3050: 0a 28 64 65 66 69 6e 65 20 28 65 76 65 72 79 20 .(define (every
3060: 70 72 65 64 20 6c 73 29 0a 20 20 28 6f 72 20 28 pred ls). (or (
3070: 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 null? ls).
3080: 28 6c 65 74 20 6c 70 20 28 28 68 65 61 64 20 28 (let lp ((head (
3090: 63 61 72 20 6c 73 29 29 20 20 28 74 61 69 6c 20 car ls)) (tail
30a0: 28 63 64 72 20 6c 73 29 29 29 0a 20 20 20 20 20 (cdr ls))).
30b0: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 (if (null? ta
30c0: 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 il).
30d0: 28 70 72 65 64 20 68 65 61 64 29 0a 20 20 20 20 (pred head).
30e0: 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 70 72 (and (pr
30f0: 65 64 20 68 65 61 64 29 20 28 6c 70 20 28 63 61 ed head) (lp (ca
3100: 72 20 74 61 69 6c 29 20 28 63 64 72 20 74 61 69 r tail) (cdr tai
3110: 6c 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e l)))))))..(defin
3120: 65 20 28 66 6f 6c 64 20 6b 6f 6e 73 20 6b 6e 69 e (fold kons kni
3130: 6c 20 6c 73 29 0a 20 20 28 6c 65 74 20 6c 70 20 l ls). (let lp
3140: 28 28 6c 73 20 6c 73 29 20 28 72 65 73 20 6b 6e ((ls ls) (res kn
3150: 69 6c 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 il)). (if (nu
3160: 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 ll? ls).
3170: 72 65 73 0a 20 20 20 20 20 20 20 20 28 6c 70 20 res. (lp
3180: 28 63 64 72 20 6c 73 29 20 28 6b 6f 6e 73 20 28 (cdr ls) (kons (
3190: 63 61 72 20 6c 73 29 20 72 65 73 29 29 29 29 29 car ls) res)))))
31a0: 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
31b0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
31c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
31d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
31e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 66 6c ;;;;;;;;;;.;; fl
31f0: 61 67 73 0a 0a 28 64 65 66 69 6e 65 20 28 62 69 ags..(define (bi
3200: 74 2d 73 68 72 20 6e 20 69 29 0a 20 20 28 71 75 t-shr n i). (qu
3210: 6f 74 69 65 6e 74 20 6e 20 28 65 78 70 74 20 32 otient n (expt 2
3220: 20 69 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 i)))..(define (
3230: 62 69 74 2d 73 68 6c 20 6e 20 69 29 0a 20 20 28 bit-shl n i). (
3240: 2a 20 6e 20 28 65 78 70 74 20 32 20 69 29 29 29 * n (expt 2 i)))
3250: 0a 0a 28 64 65 66 69 6e 65 20 28 62 69 74 2d 6e ..(define (bit-n
3260: 6f 74 20 6e 29 20 28 2d 20 23 78 46 46 46 46 20 ot n) (- #xFFFF
3270: 6e 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 62 69 n))..(define (bi
3280: 74 2d 69 6f 72 20 61 20 62 29 0a 20 20 28 63 6f t-ior a b). (co
3290: 6e 64 0a 20 20 20 28 28 7a 65 72 6f 3f 20 61 29 nd. ((zero? a)
32a0: 20 62 29 0a 20 20 20 28 28 7a 65 72 6f 3f 20 62 b). ((zero? b
32b0: 29 20 61 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 ) a). (else.
32c0: 20 20 28 2b 20 28 69 66 20 28 6f 72 20 28 6f 64 (+ (if (or (od
32d0: 64 3f 20 61 29 20 28 6f 64 64 3f 20 62 29 29 20 d? a) (odd? b))
32e0: 31 20 30 29 0a 20 20 20 20 20 20 20 28 2a 20 32 1 0). (* 2
32f0: 20 28 62 69 74 2d 69 6f 72 20 28 71 75 6f 74 69 (bit-ior (quoti
3300: 65 6e 74 20 61 20 32 29 20 28 71 75 6f 74 69 65 ent a 2) (quotie
3310: 6e 74 20 62 20 32 29 29 29 29 29 29 29 0a 0a 28 nt b 2)))))))..(
3320: 64 65 66 69 6e 65 20 28 62 69 74 2d 61 6e 64 20 define (bit-and
3330: 61 20 62 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 a b). (cond.
3340: 28 28 7a 65 72 6f 3f 20 61 29 20 30 29 0a 20 20 ((zero? a) 0).
3350: 20 28 28 7a 65 72 6f 3f 20 62 29 20 30 29 0a 20 ((zero? b) 0).
3360: 20 20 28 65 6c 73 65 0a 20 20 20 20 28 2b 20 28 (else. (+ (
3370: 69 66 20 28 61 6e 64 20 28 6f 64 64 3f 20 61 29 if (and (odd? a)
3380: 20 28 6f 64 64 3f 20 62 29 29 20 31 20 30 29 0a (odd? b)) 1 0).
3390: 20 20 20 20 20 20 20 28 2a 20 32 20 28 62 69 74 (* 2 (bit
33a0: 2d 61 6e 64 20 28 71 75 6f 74 69 65 6e 74 20 61 -and (quotient a
33b0: 20 32 29 20 28 71 75 6f 74 69 65 6e 74 20 62 20 2) (quotient b
33c0: 32 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 2)))))))..(defin
33d0: 65 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 e (flag-set? fla
33e0: 67 73 20 69 29 0a 20 20 28 3d 20 69 20 28 62 69 gs i). (= i (bi
33f0: 74 2d 61 6e 64 20 66 6c 61 67 73 20 69 29 29 29 t-and flags i)))
3400: 0a 28 64 65 66 69 6e 65 20 28 66 6c 61 67 2d 6a .(define (flag-j
3410: 6f 69 6e 20 61 20 62 29 0a 20 20 28 69 66 20 62 oin a b). (if b
3420: 20 28 62 69 74 2d 69 6f 72 20 61 20 62 29 20 61 (bit-ior a b) a
3430: 29 29 0a 28 64 65 66 69 6e 65 20 28 66 6c 61 67 )).(define (flag
3440: 2d 63 6c 65 61 72 20 61 20 62 29 0a 20 20 28 62 -clear a b). (b
3450: 69 74 2d 61 6e 64 20 61 20 28 62 69 74 2d 6e 6f it-and a (bit-no
3460: 74 20 62 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 t b)))..(define
3470: 7e 6e 6f 6e 65 20 30 29 0a 28 64 65 66 69 6e 65 ~none 0).(define
3480: 20 7e 73 65 61 72 63 68 65 72 3f 20 31 29 0a 28 ~searcher? 1).(
3490: 64 65 66 69 6e 65 20 7e 63 6f 6e 73 75 6d 65 72 define ~consumer
34a0: 3f 20 32 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ? 2)..;;;;;;;;;;
34b0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
34c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
34d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
34e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b ;;;;;;;;;;;;;;.;
34f0: 3b 20 70 61 72 73 69 6e 67 20 70 63 72 65 20 73 ; parsing pcre s
3500: 74 72 69 6e 67 73 20 28 79 75 63 6b 29 0a 0a 28 trings (yuck)..(
3510: 64 65 66 69 6e 65 20 7e 73 61 76 65 3f 20 31 29 define ~save? 1)
3520: 0a 28 64 65 66 69 6e 65 20 7e 63 61 73 65 2d 69 .(define ~case-i
3530: 6e 73 65 6e 73 69 74 69 76 65 3f 20 32 29 0a 28 nsensitive? 2).(
3540: 64 65 66 69 6e 65 20 7e 6d 75 6c 74 69 2d 6c 69 define ~multi-li
3550: 6e 65 3f 20 34 29 0a 28 64 65 66 69 6e 65 20 7e ne? 4).(define ~
3560: 73 69 6e 67 6c 65 2d 6c 69 6e 65 3f 20 38 29 0a single-line? 8).
3570: 28 64 65 66 69 6e 65 20 7e 69 67 6e 6f 72 65 2d (define ~ignore-
3580: 73 70 61 63 65 3f 20 31 36 29 0a 28 64 65 66 69 space? 16).(defi
3590: 6e 65 20 7e 75 74 66 38 3f 20 33 32 29 0a 0a 28 ne ~utf8? 32)..(
35a0: 64 65 66 69 6e 65 20 28 73 79 6d 62 6f 6c 2d 6c define (symbol-l
35b0: 69 73 74 2d 3e 66 6c 61 67 73 20 6c 73 29 0a 20 ist->flags ls).
35c0: 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 20 6c 73 (let lp ((ls ls
35d0: 29 20 28 72 65 73 20 7e 6e 6f 6e 65 29 29 0a 20 ) (res ~none)).
35e0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 70 61 69 (if (not (pai
35f0: 72 3f 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 r? ls)).
3600: 72 65 73 0a 20 20 20 20 20 20 20 20 28 6c 70 20 res. (lp
3610: 28 63 64 72 20 6c 73 29 0a 20 20 20 20 20 20 20 (cdr ls).
3620: 20 20 20 20 20 28 66 6c 61 67 2d 6a 6f 69 6e 0a (flag-join.
3630: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 73 res
3640: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 . (c
3650: 61 73 65 20 28 63 61 72 20 6c 73 29 0a 20 20 20 ase (car ls).
3660: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 69 20 ((i
3670: 63 69 20 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 ci case-insensit
3680: 69 76 65 29 20 7e 63 61 73 65 2d 69 6e 73 65 6e ive) ~case-insen
3690: 73 69 74 69 76 65 3f 29 0a 20 20 20 20 20 20 20 sitive?).
36a0: 20 20 20 20 20 20 20 20 28 28 6d 20 6d 75 6c 74 ((m mult
36b0: 69 2d 6c 69 6e 65 29 20 7e 6d 75 6c 74 69 2d 6c i-line) ~multi-l
36c0: 69 6e 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 ine?).
36d0: 20 20 20 20 20 28 28 73 20 73 69 6e 67 6c 65 2d ((s single-
36e0: 6c 69 6e 65 29 20 7e 73 69 6e 67 6c 65 2d 6c 69 line) ~single-li
36f0: 6e 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 ne?).
3700: 20 20 20 20 28 28 78 20 69 67 6e 6f 72 65 2d 73 ((x ignore-s
3710: 70 61 63 65 29 20 7e 69 67 6e 6f 72 65 2d 73 70 pace) ~ignore-sp
3720: 61 63 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 ace?).
3730: 20 20 20 20 20 28 28 75 20 75 74 66 38 29 20 28 ((u utf8) (
3740: 69 66 20 2a 61 6c 6c 6f 77 2d 75 74 66 38 2d 6d if *allow-utf8-m
3750: 6f 64 65 3f 2a 20 7e 75 74 66 38 3f 20 7e 6e 6f ode?* ~utf8? ~no
3760: 6e 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ne)).
3770: 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 29 (else #f))))
3780: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 )))..(define (ma
3790: 79 62 65 2d 73 74 72 69 6e 67 2d 3e 73 72 65 20 ybe-string->sre
37a0: 6f 62 6a 29 0a 20 20 28 69 66 20 28 73 74 72 69 obj). (if (stri
37b0: 6e 67 3f 20 6f 62 6a 29 20 28 73 74 72 69 6e 67 ng? obj) (string
37c0: 2d 3e 73 72 65 20 6f 62 6a 29 20 6f 62 6a 29 29 ->sre obj) obj))
37d0: 0a 0a 28 64 65 66 69 6e 65 20 28 73 74 72 69 6e ..(define (strin
37e0: 67 2d 3e 73 72 65 20 73 74 72 20 2e 20 6f 29 0a g->sre str . o).
37f0: 20 20 28 6c 65 74 20 28 28 65 6e 64 20 28 73 74 (let ((end (st
3800: 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 ring-length str)
3810: 29 0a 20 20 20 20 20 20 20 20 28 66 6c 61 67 73 ). (flags
3820: 20 28 73 79 6d 62 6f 6c 2d 6c 69 73 74 2d 3e 66 (symbol-list->f
3830: 6c 61 67 73 20 6f 29 29 29 0a 0a 20 20 20 20 28 lags o))).. (
3840: 6c 65 74 20 6c 70 20 28 28 69 20 30 29 20 28 66 let lp ((i 0) (f
3850: 72 6f 6d 20 30 29 20 28 66 6c 61 67 73 20 66 6c rom 0) (flags fl
3860: 61 67 73 29 20 28 72 65 73 20 27 28 29 29 20 28 ags) (res '()) (
3870: 73 74 20 27 28 29 29 29 0a 0a 20 20 20 20 20 20 st '()))..
3880: 3b 3b 20 68 61 6e 64 6c 65 20 63 61 73 65 20 73 ;; handle case s
3890: 65 6e 73 69 74 69 76 69 74 79 20 61 74 20 74 68 ensitivity at th
38a0: 65 20 6c 69 74 65 72 61 6c 20 63 68 61 72 2f 73 e literal char/s
38b0: 74 72 69 6e 67 20 6c 65 76 65 6c 0a 20 20 20 20 tring level.
38c0: 20 20 28 64 65 66 69 6e 65 20 28 63 61 73 65 64 (define (cased
38d0: 2d 63 68 61 72 20 63 68 29 0a 20 20 20 20 20 20 -char ch).
38e0: 20 20 28 69 66 20 28 61 6e 64 20 28 66 6c 61 67 (if (and (flag
38f0: 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e 63 61 73 -set? flags ~cas
3900: 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 0a e-insensitive?).
3910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3920: 20 28 63 68 61 72 2d 61 6c 70 68 61 62 65 74 69 (char-alphabeti
3930: 63 3f 20 63 68 29 29 0a 20 20 20 20 20 20 20 20 c? ch)).
3940: 20 20 20 20 60 28 6f 72 20 2c 63 68 20 2c 28 63 `(or ,ch ,(c
3950: 68 61 72 2d 61 6c 74 63 61 73 65 20 63 68 29 29 har-altcase ch))
3960: 0a 20 20 20 20 20 20 20 20 20 20 20 20 63 68 29 . ch)
3970: 29 0a 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 ). (define
3980: 28 63 61 73 65 64 2d 73 74 72 69 6e 67 20 73 74 (cased-string st
3990: 72 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 r). (if (
39a0: 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 flag-set? flags
39b0: 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 ~case-insensitiv
39c0: 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 e?).
39d0: 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 6d (sre-sequence (m
39e0: 61 70 20 63 61 73 65 64 2d 63 68 61 72 20 28 73 ap cased-char (s
39f0: 74 72 69 6e 67 2d 3e 6c 69 73 74 20 73 74 72 29 tring->list str)
3a00: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 73 )). s
3a10: 74 72 29 29 0a 20 20 20 20 20 20 3b 3b 20 61 63 tr)). ;; ac
3a20: 63 75 6d 75 6c 61 74 65 20 74 68 65 20 73 75 62 cumulate the sub
3a30: 73 74 72 69 6e 67 20 66 72 6f 6d 2e 2e 69 20 61 string from..i a
3a40: 73 20 6c 69 74 65 72 61 6c 20 74 65 78 74 0a 20 s literal text.
3a50: 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 63 6f (define (co
3a60: 6c 6c 65 63 74 29 0a 20 20 20 20 20 20 20 20 28 llect). (
3a70: 69 66 20 28 3d 20 69 20 66 72 6f 6d 29 20 72 65 if (= i from) re
3a80: 73 20 28 63 6f 6e 73 20 28 63 61 73 65 64 2d 73 s (cons (cased-s
3a90: 74 72 69 6e 67 20 28 73 75 62 73 74 72 69 6e 67 tring (substring
3aa0: 20 73 74 72 20 66 72 6f 6d 20 69 29 29 20 72 65 str from i)) re
3ab0: 73 29 29 29 0a 20 20 20 20 20 20 3b 3b 20 6c 69 s))). ;; li
3ac0: 6b 65 20 63 6f 6c 6c 65 63 74 20 62 75 74 20 62 ke collect but b
3ad0: 72 65 61 6b 73 20 6f 66 66 20 74 68 65 20 6c 61 reaks off the la
3ae0: 73 74 20 73 69 6e 67 6c 65 20 63 68 61 72 61 63 st single charac
3af0: 74 65 72 20 77 68 65 6e 0a 20 20 20 20 20 20 3b ter when. ;
3b00: 3b 20 63 6f 6c 6c 65 63 74 69 6e 67 20 6c 69 74 ; collecting lit
3b10: 65 72 61 6c 20 64 61 74 61 2c 20 61 73 20 74 68 eral data, as th
3b20: 65 20 61 72 67 75 6d 65 6e 74 20 74 6f 20 3f 2f e argument to ?/
3b30: 2a 2f 2b 20 65 74 63 2e 0a 20 20 20 20 20 20 28 */+ etc.. (
3b40: 64 65 66 69 6e 65 20 28 63 6f 6c 6c 65 63 74 2f define (collect/
3b50: 73 69 6e 67 6c 65 29 0a 20 20 20 20 20 20 20 20 single).
3b60: 28 6c 65 74 2a 20 28 28 75 74 66 38 3f 20 28 66 (let* ((utf8? (f
3b70: 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e lag-set? flags ~
3b80: 75 74 66 38 3f 29 29 0a 20 20 20 20 20 20 20 20 utf8?)).
3b90: 20 20 20 20 20 20 20 28 6a 20 28 69 66 20 28 61 (j (if (a
3ba0: 6e 64 20 75 74 66 38 3f 20 28 3e 20 69 20 31 29 nd utf8? (> i 1)
3bb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3bc0: 20 20 20 20 20 20 20 20 28 75 74 66 38 2d 62 61 (utf8-ba
3bd0: 63 6b 75 70 2d 74 6f 2d 69 6e 69 74 69 61 6c 2d ckup-to-initial-
3be0: 63 68 61 72 20 73 74 72 20 28 2d 20 69 20 31 29 char str (- i 1)
3bf0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
3c00: 20 20 20 20 20 20 20 20 28 2d 20 69 20 31 29 29 (- i 1))
3c10: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f )). (co
3c20: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 nd. ((
3c30: 3c 20 6a 20 66 72 6f 6d 29 0a 20 20 20 20 20 20 < j from).
3c40: 20 20 20 20 20 20 72 65 73 29 0a 20 20 20 20 20 res).
3c50: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
3c60: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 (let ((c
3c70: 20 28 63 61 73 65 64 2d 63 68 61 72 20 28 69 66 (cased-char (if
3c80: 20 75 74 66 38 3f 0a 20 20 20 20 20 20 20 20 20 utf8?.
3c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ca0: 20 20 20 20 20 20 20 20 20 20 20 20 28 75 74 66 (utf
3cb0: 38 2d 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 8-string-ref str
3cc0: 20 6a 20 28 2d 20 69 20 6a 29 20 29 0a 20 20 20 j (- i j) ).
3cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3cf0: 20 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 (string-ref st
3d00: 72 20 6a 29 29 29 29 29 0a 20 20 20 20 20 20 20 r j))))).
3d10: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3d 20 ((=
3d30: 6a 20 66 72 6f 6d 29 0a 20 20 20 20 20 20 20 20 j from).
3d40: 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 63 20 (cons c
3d50: 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 res)).
3d60: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
3d70: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
3d80: 20 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c.
3d90: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 (cons (
3da0: 63 61 73 65 64 2d 73 74 72 69 6e 67 20 28 73 75 cased-string (su
3db0: 62 73 74 72 69 6e 67 20 73 74 72 20 66 72 6f 6d bstring str from
3dc0: 20 6a 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 j)).
3dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3de0: 20 72 65 73 29 29 29 29 29 29 29 29 29 0a 20 20 res))))))))).
3df0: 20 20 20 20 3b 3b 20 63 6f 6c 6c 65 63 74 73 20 ;; collects
3e00: 66 6f 72 20 75 73 65 20 61 73 20 61 20 72 65 73 for use as a res
3e10: 75 6c 74 2c 20 72 65 76 65 72 73 69 6e 67 20 61 ult, reversing a
3e20: 6e 64 20 67 72 6f 75 70 69 6e 67 20 4f 52 0a 20 nd grouping OR.
3e30: 20 20 20 20 20 3b 3b 20 74 65 72 6d 73 2c 20 61 ;; terms, a
3e40: 6e 64 20 73 6f 6d 65 20 75 67 6c 79 20 74 77 65 nd some ugly twe
3e50: 61 6b 69 6e 67 20 6f 66 20 60 66 75 6e 63 74 69 aking of `functi
3e60: 6f 6e 2d 6c 69 6b 65 27 20 67 72 6f 75 70 73 20 on-like' groups
3e70: 61 6e 64 0a 20 20 20 20 20 20 3b 3b 20 63 6f 6e and. ;; con
3e80: 64 69 74 69 6f 6e 61 6c 73 0a 20 20 20 20 20 20 ditionals.
3e90: 28 64 65 66 69 6e 65 20 28 63 6f 6c 6c 65 63 74 (define (collect
3ea0: 2f 74 65 72 6d 73 29 0a 20 20 20 20 20 20 20 20 /terms).
3eb0: 28 6c 65 74 2a 20 28 28 6c 73 20 28 63 6f 6c 6c (let* ((ls (coll
3ec0: 65 63 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 ect)).
3ed0: 20 20 20 20 20 28 66 75 6e 63 0a 20 20 20 20 20 (func.
3ee0: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
3ef0: 28 70 61 69 72 3f 20 6c 73 29 0a 20 20 20 20 20 (pair? ls).
3f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f10: 28 6d 65 6d 71 20 28 6c 61 73 74 20 6c 73 29 0a (memq (last ls).
3f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f30: 20 20 20 20 20 20 20 20 20 20 20 27 28 61 74 6f '(ato
3f40: 6d 69 63 20 69 66 20 6c 6f 6f 6b 2d 61 68 65 61 mic if look-ahea
3f50: 64 20 6e 65 67 2d 6c 6f 6f 6b 2d 61 68 65 61 64 d neg-look-ahead
3f60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f80: 20 20 20 20 20 6c 6f 6f 6b 2d 62 65 68 69 6e 64 look-behind
3f90: 20 6e 65 67 2d 6c 6f 6f 6b 2d 62 65 68 69 6e 64 neg-look-behind
3fa0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fc0: 20 20 20 20 20 3d 3e 20 73 75 62 6d 61 74 63 68 => submatch
3fd0: 2d 6e 61 6d 65 64 0a 20 20 20 20 20 20 20 20 20 -named.
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ff0: 20 20 20 20 20 20 20 20 20 20 20 77 2f 75 74 66 w/utf
4000: 38 20 77 2f 6e 6f 75 74 66 38 29 29 29 29 0a 20 8 w/noutf8)))).
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 (p
4020: 72 65 66 69 78 20 28 69 66 20 28 61 6e 64 20 66 refix (if (and f
4030: 75 6e 63 20 28 6d 65 6d 71 20 28 63 61 72 20 66 unc (memq (car f
4040: 75 6e 63 29 20 27 28 3d 3e 20 73 75 62 6d 61 74 unc) '(=> submat
4050: 63 68 2d 6e 61 6d 65 64 29 29 29 0a 20 20 20 20 ch-named))).
4060: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4070: 20 20 20 20 20 20 20 28 6c 69 73 74 20 27 73 75 (list 'su
4080: 62 6d 61 74 63 68 2d 6e 61 6d 65 64 20 28 63 61 bmatch-named (ca
4090: 64 72 20 28 72 65 76 65 72 73 65 20 6c 73 29 29 dr (reverse ls))
40a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
40c0: 64 20 66 75 6e 63 20 28 6c 69 73 74 20 28 63 61 d func (list (ca
40d0: 72 20 66 75 6e 63 29 29 29 29 29 0a 20 20 20 20 r func))))).
40e0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 73 20 28 (ls (
40f0: 69 66 20 66 75 6e 63 0a 20 20 20 20 20 20 20 20 if func.
4100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4110: 69 66 20 28 6d 65 6d 71 20 28 63 61 72 20 66 75 if (memq (car fu
4120: 6e 63 29 20 27 28 3d 3e 20 73 75 62 6d 61 74 63 nc) '(=> submatc
4130: 68 2d 6e 61 6d 65 64 29 29 0a 20 20 20 20 20 20 h-named)).
4140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4150: 20 20 20 20 20 28 72 65 76 65 72 73 65 20 28 63 (reverse (c
4160: 64 64 72 20 28 72 65 76 65 72 73 65 20 6c 73 29 ddr (reverse ls)
4170: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
4190: 65 76 65 72 73 65 20 28 63 64 72 20 28 72 65 76 everse (cdr (rev
41a0: 65 72 73 65 20 6c 73 29 29 29 29 0a 20 20 20 20 erse ls)))).
41b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
41c0: 20 20 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 ls))).
41d0: 20 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 20 (let lp ((ls
41e0: 6c 73 29 20 28 74 65 72 6d 20 27 28 29 29 20 28 ls) (term '()) (
41f0: 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 res '())).
4200: 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 73 (define (s
4210: 68 69 66 74 29 0a 20 20 20 20 20 20 20 20 20 20 hift).
4220: 20 20 20 20 28 63 6f 6e 73 20 28 73 72 65 2d 73 (cons (sre-s
4230: 65 71 75 65 6e 63 65 20 74 65 72 6d 29 20 72 65 equence term) re
4240: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
4250: 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
4260: 20 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 ((null? ls).
4270: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
4280: 74 2a 20 28 28 72 65 73 20 28 73 72 65 2d 61 6c t* ((res (sre-al
4290: 74 65 72 6e 61 74 65 20 28 73 68 69 66 74 29 29 ternate (shift))
42a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
42b0: 20 20 20 20 20 20 20 28 72 65 73 20 28 69 66 20 (res (if
42c0: 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 (flag-set? flags
42d0: 20 7e 73 61 76 65 3f 29 0a 20 20 20 20 20 20 20 ~save?).
42e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42f0: 20 20 20 20 20 20 20 28 6c 69 73 74 20 27 73 75 (list 'su
4300: 62 6d 61 74 63 68 20 72 65 73 29 0a 20 20 20 20 bmatch res).
4310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4320: 20 20 20 20 20 20 20 20 20 20 72 65 73 29 29 29 res)))
4330: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4340: 20 28 69 66 20 70 72 65 66 69 78 0a 20 20 20 20 (if prefix.
4350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4360: 28 69 66 20 28 65 71 3f 20 27 69 66 20 28 63 61 (if (eq? 'if (ca
4370: 72 20 70 72 65 66 69 78 29 29 0a 20 20 20 20 20 r prefix)).
4380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4390: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
43a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
43b0: 20 20 28 28 6e 6f 74 20 28 70 61 69 72 3f 20 72 ((not (pair? r
43c0: 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 es)).
43d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
43e0: 65 70 73 69 6c 6f 6e 29 0a 20 20 20 20 20 20 20 epsilon).
43f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4400: 20 20 28 28 6d 65 6d 71 20 28 63 61 72 20 72 65 ((memq (car re
4410: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
4420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4430: 20 20 20 27 28 6c 6f 6f 6b 2d 61 68 65 61 64 20 '(look-ahead
4440: 6e 65 67 2d 6c 6f 6f 6b 2d 61 68 65 61 64 0a 20 neg-look-ahead.
4450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4470: 20 20 20 20 20 20 20 20 20 20 20 20 6c 6f 6f 6b look
4480: 2d 62 65 68 69 6e 64 20 6e 65 67 2d 6c 6f 6f 6b -behind neg-look
4490: 2d 62 65 68 69 6e 64 29 29 0a 20 20 20 20 20 20 -behind)).
44a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44b0: 20 20 20 20 72 65 73 29 0a 20 20 20 20 20 20 20 res).
44c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
44d0: 20 20 28 28 65 71 3f 20 27 73 65 71 20 28 63 61 ((eq? 'seq (ca
44e0: 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 r res)).
44f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4500: 20 20 60 28 69 66 20 2c 28 63 61 64 72 20 72 65 `(if ,(cadr re
4510: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
4520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4530: 20 20 2c 28 69 66 20 28 70 61 69 72 3f 20 28 63 ,(if (pair? (c
4540: 64 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 dr res)).
4550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4560: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 (sr
4570: 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 72 e-sequence (cddr
4580: 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 res)).
4590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45a0: 20 20 20 20 20 20 20 20 20 20 20 27 65 70 73 69 'epsi
45b0: 6c 6f 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 lon))).
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
45e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45f0: 60 28 69 66 20 2c 28 63 61 64 61 64 72 20 72 65 `(if ,(cadadr re
4600: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
4610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4620: 20 20 2c 28 69 66 20 28 70 61 69 72 3f 20 28 63 ,(if (pair? (c
4630: 64 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 dr res)).
4640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4650: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 (sr
4660: 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 61 e-sequence (cdda
4670: 64 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 dr res)).
4680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4690: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 65 70 'ep
46a0: 73 69 6c 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 silon).
46b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46c0: 20 20 20 20 20 20 2c 28 73 72 65 2d 61 6c 74 65 ,(sre-alte
46d0: 72 6e 61 74 65 0a 20 20 20 20 20 20 20 20 20 20 rnate.
46e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
46f0: 20 20 20 20 20 20 20 28 69 66 20 28 70 61 69 72 (if (pair
4700: 3f 20 28 63 64 72 20 72 65 73 29 29 20 28 63 64 ? (cdr res)) (cd
4710: 64 72 20 72 65 73 29 20 27 28 29 29 29 29 29 29 dr res) '())))))
4720: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4730: 20 20 20 20 20 20 20 20 20 60 28 2c 40 70 72 65 `(,@pre
4740: 66 69 78 20 2c 72 65 73 29 29 0a 20 20 20 20 20 fix ,res)).
4750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 r
4760: 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 es))).
4770: 20 20 20 28 28 65 71 3f 20 27 6f 72 20 28 63 61 ((eq? 'or (ca
4780: 72 20 6c 73 29 29 20 28 6c 70 20 28 63 64 72 20 r ls)) (lp (cdr
4790: 6c 73 29 20 27 28 29 20 28 73 68 69 66 74 29 29 ls) '() (shift))
47a0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
47b0: 65 6c 73 65 20 28 6c 70 20 28 63 64 72 20 6c 73 else (lp (cdr ls
47c0: 29 20 28 63 6f 6e 73 20 28 63 61 72 20 6c 73 29 ) (cons (car ls)
47d0: 20 74 65 72 6d 29 20 72 65 73 29 29 29 29 29 29 term) res))))))
47e0: 0a 20 20 20 20 20 20 28 64 65 66 69 6e 65 20 28 . (define (
47f0: 73 61 76 65 29 0a 20 20 20 20 20 20 20 20 28 63 save). (c
4800: 6f 6e 73 20 28 63 6f 6e 73 20 66 6c 61 67 73 20 ons (cons flags
4810: 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 0a (collect)) st)).
4820: 0a 20 20 20 20 20 20 3b 3b 20 6d 61 69 6e 20 70 . ;; main p
4830: 61 72 73 69 6e 67 0a 20 20 20 20 20 20 28 69 66 arsing. (if
4840: 20 28 3e 3d 20 69 20 65 6e 64 29 0a 20 20 20 20 (>= i end).
4850: 20 20 20 20 20 20 28 69 66 20 28 70 61 69 72 3f (if (pair?
4860: 20 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 st).
4870: 20 20 20 28 65 72 72 6f 72 20 22 75 6e 74 65 72 (error "unter
4880: 6d 69 6e 61 74 65 64 20 70 61 72 65 6e 74 68 65 minated parenthe
4890: 73 69 73 20 69 6e 20 72 65 67 65 78 70 22 20 73 sis in regexp" s
48a0: 74 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 tr).
48b0: 20 20 28 63 6f 6c 6c 65 63 74 2f 74 65 72 6d 73 (collect/terms
48c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 )). (le
48d0: 74 20 28 28 63 20 28 73 74 72 69 6e 67 2d 72 65 t ((c (string-re
48e0: 66 20 73 74 72 20 69 29 29 29 0a 20 20 20 20 20 f str i))).
48f0: 20 20 20 20 20 20 20 28 63 61 73 65 20 63 0a 20 (case c.
4900: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 ((#
4910: 5c 2e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 \.).
4920: 20 20 20 28 6c 70 20 28 2b 20 69 20 31 29 20 28 (lp (+ i 1) (
4930: 2b 20 69 20 31 29 20 66 6c 61 67 73 0a 20 20 20 + i 1) flags.
4940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4950: 28 63 6f 6e 73 20 28 69 66 20 28 66 6c 61 67 2d (cons (if (flag-
4960: 73 65 74 3f 20 66 6c 61 67 73 20 7e 73 69 6e 67 set? flags ~sing
4970: 6c 65 2d 6c 69 6e 65 3f 29 20 27 61 6e 79 20 27 le-line?) 'any '
4980: 6e 6f 6e 6c 29 0a 20 20 20 20 20 20 20 20 20 20 nonl).
4990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
49a0: 63 6f 6c 6c 65 63 74 29 29 0a 20 20 20 20 20 20 collect)).
49b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 74 29 st)
49c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
49d0: 28 28 23 5c 3f 29 0a 20 20 20 20 20 20 20 20 20 ((#\?).
49e0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 (let ((res
49f0: 20 28 63 6f 6c 6c 65 63 74 2f 73 69 6e 67 6c 65 (collect/single
4a00: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
4a10: 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
4a20: 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 res).
4a30: 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
4a40: 20 22 3f 20 63 61 6e 27 74 20 66 6f 6c 6c 6f 77 "? can't follow
4a50: 20 65 6d 70 74 79 20 73 72 65 22 20 73 74 72 20 empty sre" str
4a60: 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 res).
4a70: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
4a80: 28 78 20 28 63 61 72 20 72 65 73 29 29 29 0a 20 (x (car res))).
4a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4aa0: 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 31 (lp (+ i 1
4ab0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4ac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 (+
4ad0: 69 20 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 i 1).
4ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4af0: 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 flags.
4b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b10: 20 28 63 6f 6e 73 0a 20 20 20 20 20 20 20 20 20 (cons.
4b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b30: 20 20 20 28 69 66 20 28 70 61 69 72 3f 20 78 29 (if (pair? x)
4b40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b60: 20 28 63 61 73 65 20 28 63 61 72 20 78 29 0a 20 (case (car x).
4b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4b90: 20 28 28 2a 29 20 20 60 28 2a 3f 20 2c 40 28 63 ((*) `(*? ,@(c
4ba0: 64 72 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 dr x))).
4bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4bc0: 20 20 20 20 20 20 20 20 20 20 28 28 2b 29 20 20 ((+)
4bd0: 60 28 2a 2a 3f 20 31 20 23 66 20 2c 40 28 63 64 `(**? 1 #f ,@(cd
4be0: 72 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 r x))).
4bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c00: 20 20 20 20 20 20 20 20 20 28 28 3f 29 20 20 60 ((?) `
4c10: 28 3f 3f 20 2c 40 28 63 64 72 20 78 29 29 29 0a (?? ,@(cdr x))).
4c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c40: 20 20 28 28 2a 2a 29 20 60 28 2a 2a 3f 20 2c 40 ((**) `(**? ,@
4c50: 28 63 64 72 20 78 29 29 29 0a 20 20 20 20 20 20 (cdr x))).
4c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c70: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3d 29 ((=)
4c80: 20 20 60 28 2a 2a 3f 20 2c 28 63 61 64 72 20 78 `(**? ,(cadr x
4c90: 29 20 2c 40 28 63 64 72 20 78 29 29 29 0a 20 20 ) ,@(cdr x))).
4ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cc0: 28 28 3e 3d 29 20 20 60 28 2a 2a 3f 20 2c 28 63 ((>=) `(**? ,(c
4cd0: 61 64 72 20 78 29 20 23 66 20 2c 40 28 63 64 64 adr x) #f ,@(cdd
4ce0: 72 20 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 r x))).
4cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d00: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 60 (else `
4d10: 28 3f 20 2c 78 29 29 29 0a 20 20 20 20 20 20 20 (? ,x))).
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d30: 20 20 20 20 20 20 20 20 20 60 28 3f 20 2c 78 29 `(? ,x)
4d40: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
4d60: 64 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 dr res)).
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d80: 20 20 20 20 73 74 29 29 29 29 29 0a 20 20 20 20 st))))).
4d90: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 2b 20 ((#\+
4da0: 23 5c 2a 29 0a 20 20 20 20 20 20 20 20 20 20 20 #\*).
4db0: 20 20 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 (let* ((res
4dc0: 28 63 6f 6c 6c 65 63 74 2f 73 69 6e 67 6c 65 29 (collect/single)
4dd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4de0: 20 20 20 20 20 20 20 20 28 78 20 28 69 66 20 28 (x (if (
4df0: 70 61 69 72 3f 20 72 65 73 29 20 28 63 61 72 20 pair? res) (car
4e00: 72 65 73 29 20 27 65 70 73 69 6c 6f 6e 29 29 0a res) 'epsilon)).
4e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e20: 20 20 20 20 20 20 28 6f 70 20 28 73 74 72 69 6e (op (strin
4e30: 67 2d 3e 73 79 6d 62 6f 6c 20 28 73 74 72 69 6e g->symbol (strin
4e40: 67 20 63 29 29 29 29 0a 20 20 20 20 20 20 20 20 g c)))).
4e50: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
4e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e70: 20 28 28 73 72 65 2d 72 65 70 65 61 74 65 72 3f ((sre-repeater?
4e80: 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 x).
4e90: 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 64 (error "d
4ea0: 75 70 6c 69 63 61 74 65 20 72 65 70 65 74 69 74 uplicate repetit
4eb0: 69 6f 6e 20 28 65 2e 67 2e 20 2a 2a 29 20 69 6e ion (e.g. **) in
4ec0: 20 73 72 65 22 20 73 74 72 20 72 65 73 29 29 0a sre" str res)).
4ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ee0: 20 20 28 28 73 72 65 2d 65 6d 70 74 79 3f 20 78 ((sre-empty? x
4ef0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4f00: 20 20 20 20 20 28 65 72 72 6f 72 20 22 63 61 6e (error "can
4f10: 27 74 20 72 65 70 65 61 74 20 65 6d 70 74 79 20 't repeat empty
4f20: 73 72 65 20 28 65 2e 67 2e 20 28 29 2a 29 22 20 sre (e.g. ()*)"
4f30: 73 74 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 str res)).
4f40: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
4f50: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
4f60: 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 31 29 (lp (+ i 1)
4f70: 20 28 2b 20 69 20 31 29 20 66 6c 61 67 73 0a 20 (+ i 1) flags.
4f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f90: 20 20 20 20 20 20 28 63 6f 6e 73 20 28 6c 69 73 (cons (lis
4fa0: 74 20 6f 70 20 78 29 20 28 63 64 72 20 72 65 73 t op x) (cdr res
4fb0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4fc0: 20 20 20 20 20 20 20 20 20 20 73 74 29 29 29 29 st))))
4fd0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4fe0: 28 28 23 5c 28 29 0a 20 20 20 20 20 20 20 20 20 ((#\().
4ff0: 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 (cond.
5000: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3e 3d ((>=
5010: 20 28 2b 20 69 20 31 29 20 65 6e 64 29 0a 20 20 (+ i 1) end).
5020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5030: 65 72 72 6f 72 20 22 75 6e 74 65 72 6d 69 6e 61 error "untermina
5040: 74 65 64 20 70 61 72 65 6e 74 68 65 73 69 73 20 ted parenthesis
5050: 69 6e 20 72 65 67 65 78 70 22 20 73 74 72 29 29 in regexp" str))
5060: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5070: 20 28 28 6e 6f 74 20 28 65 71 76 3f 20 23 5c 3f ((not (eqv? #\?
5080: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
5090: 20 28 2b 20 69 20 31 29 29 29 29 0a 20 20 20 20 (+ i 1)))).
50a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
50b0: 20 28 2b 20 69 20 31 29 20 28 2b 20 69 20 31 29 (+ i 1) (+ i 1)
50c0: 20 28 66 6c 61 67 2d 6a 6f 69 6e 20 66 6c 61 67 (flag-join flag
50d0: 73 20 7e 73 61 76 65 3f 29 20 27 28 29 20 28 73 s ~save?) '() (s
50e0: 61 76 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 ave))).
50f0: 20 20 20 20 20 20 20 28 28 3e 3d 20 28 2b 20 69 ((>= (+ i
5100: 20 32 29 20 65 6e 64 29 0a 20 20 20 20 20 20 20 2) end).
5110: 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
5120: 20 22 75 6e 74 65 72 6d 69 6e 61 74 65 64 20 70 "unterminated p
5130: 61 72 65 6e 74 68 65 73 69 73 20 69 6e 20 72 65 arenthesis in re
5140: 67 65 78 70 22 20 73 74 72 29 29 0a 20 20 20 20 gexp" str)).
5150: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
5160: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
5170: 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e 67 (case (string
5180: 2d 72 65 66 20 73 74 72 20 28 2b 20 69 20 32 29 -ref str (+ i 2)
5190: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
51a0: 20 20 20 20 20 28 28 23 5c 23 29 0a 20 20 20 20 ((#\#).
51b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
51c0: 28 6c 65 74 20 28 28 6a 20 28 73 74 72 69 6e 67 (let ((j (string
51d0: 2d 73 63 61 6e 2d 63 68 61 72 20 73 74 72 20 23 -scan-char str #
51e0: 5c 29 20 28 2b 20 69 20 33 29 29 29 29 0a 20 20 \) (+ i 3)))).
51f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5200: 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 69 29 20 (lp (+ j i)
5210: 28 2b 20 6a 20 31 29 20 66 6c 61 67 73 20 28 63 (+ j 1) flags (c
5220: 6f 6c 6c 65 63 74 29 20 73 74 29 29 29 0a 20 20 ollect) st))).
5230: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5240: 20 28 28 23 5c 3a 29 0a 20 20 20 20 20 20 20 20 ((#\:).
5250: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
5260: 28 2b 20 69 20 33 29 20 28 2b 20 69 20 33 29 20 (+ i 3) (+ i 3)
5270: 28 66 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 (flag-clear flag
5280: 73 20 7e 73 61 76 65 3f 29 20 27 28 29 20 28 73 s ~save?) '() (s
5290: 61 76 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 ave))).
52a0: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 3d 29 ((#\=)
52b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
52c0: 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 33 29 (lp (+ i 3)
52d0: 20 28 2b 20 69 20 33 29 20 28 66 6c 61 67 2d 63 (+ i 3) (flag-c
52e0: 6c 65 61 72 20 66 6c 61 67 73 20 7e 73 61 76 65 lear flags ~save
52f0: 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?).
5300: 20 20 20 20 20 20 20 20 20 20 20 27 28 6c 6f 6f '(loo
5310: 6b 2d 61 68 65 61 64 29 20 28 73 61 76 65 29 29 k-ahead) (save))
5320: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5330: 20 20 20 20 20 28 28 23 5c 21 29 0a 20 20 20 20 ((#\!).
5340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5350: 28 6c 70 20 28 2b 20 69 20 33 29 20 28 2b 20 69 (lp (+ i 3) (+ i
5360: 20 33 29 20 28 66 6c 61 67 2d 63 6c 65 61 72 20 3) (flag-clear
5370: 66 6c 61 67 73 20 7e 73 61 76 65 3f 29 0a 20 20 flags ~save?).
5380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5390: 20 20 20 20 20 20 27 28 6e 65 67 2d 6c 6f 6f 6b '(neg-look
53a0: 2d 61 68 65 61 64 29 20 28 73 61 76 65 29 29 29 -ahead) (save)))
53b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
53c0: 20 20 20 20 28 28 23 5c 3c 29 0a 20 20 20 20 20 ((#\<).
53d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
53e0: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
53f0: 20 20 20 20 20 20 20 20 20 20 28 28 3e 3d 20 28 ((>= (
5400: 2b 20 69 20 33 29 20 65 6e 64 29 0a 20 20 20 20 + i 3) end).
5410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5420: 20 20 28 65 72 72 6f 72 20 22 75 6e 74 65 72 6d (error "unterm
5430: 69 6e 61 74 65 64 20 70 61 72 65 6e 74 68 65 73 inated parenthes
5440: 69 73 20 69 6e 20 72 65 67 65 78 70 22 20 73 74 is in regexp" st
5450: 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r)).
5460: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
5470: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5480: 20 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 (case (stri
5490: 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 69 20 ng-ref str (+ i
54a0: 33 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3)).
54b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c ((#\
54c0: 3d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 =).
54d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
54e0: 28 2b 20 69 20 34 29 20 28 2b 20 69 20 34 29 20 (+ i 4) (+ i 4)
54f0: 28 66 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 (flag-clear flag
5500: 73 20 7e 73 61 76 65 3f 29 0a 20 20 20 20 20 20 s ~save?).
5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5520: 20 20 20 20 20 20 20 27 28 6c 6f 6f 6b 2d 62 65 '(look-be
5530: 68 69 6e 64 29 20 28 73 61 76 65 29 29 29 0a 20 hind) (save))).
5540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5550: 20 20 20 20 20 20 20 28 28 23 5c 21 29 0a 20 20 ((#\!).
5560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5570: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
5580: 34 29 20 28 2b 20 69 20 34 29 20 28 66 6c 61 67 4) (+ i 4) (flag
5590: 2d 63 6c 65 61 72 20 66 6c 61 67 73 20 7e 73 61 -clear flags ~sa
55a0: 76 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 ve?).
55b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55c0: 20 20 27 28 6e 65 67 2d 6c 6f 6f 6b 2d 62 65 68 '(neg-look-beh
55d0: 69 6e 64 29 20 28 73 61 76 65 29 29 29 0a 20 20 ind) (save))).
55e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55f0: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
5600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5610: 20 20 20 20 20 28 6c 65 74 20 28 28 6a 20 28 61 (let ((j (a
5620: 6e 64 20 28 63 68 61 72 2d 61 6c 70 68 61 62 65 nd (char-alphabe
5630: 74 69 63 3f 0a 20 20 20 20 20 20 20 20 20 20 20 tic?.
5640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5650: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
5660: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 ring-ref str (+
5670: 69 20 33 29 29 29 0a 20 20 20 20 20 20 20 20 20 i 3))).
5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
56a0: 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 72 20 tring-scan-char
56b0: 73 74 72 20 23 5c 3e 20 28 2b 20 69 20 34 29 29 str #\> (+ i 4))
56c0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
56d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
56e0: 69 66 20 6a 0a 20 20 20 20 20 20 20 20 20 20 20 if j.
56f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5700: 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 29 20 (lp (+ j 1)
5710: 28 2b 20 6a 20 31 29 20 28 66 6c 61 67 2d 63 6c (+ j 1) (flag-cl
5720: 65 61 72 20 66 6c 61 67 73 20 7e 73 61 76 65 3f ear flags ~save?
5730: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5750: 20 20 20 20 20 60 28 2c 28 73 74 72 69 6e 67 2d `(,(string-
5760: 3e 73 79 6d 62 6f 6c 20 28 73 75 62 73 74 72 69 >symbol (substri
5770: 6e 67 20 73 74 72 20 28 2b 20 69 20 33 29 20 6a ng str (+ i 3) j
5780: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
5790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57a0: 20 20 20 20 20 20 20 20 73 75 62 6d 61 74 63 68 submatch
57b0: 2d 6e 61 6d 65 64 29 0a 20 20 20 20 20 20 20 20 -named).
57c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
57d0: 20 20 20 20 20 20 20 20 20 20 20 28 73 61 76 65 (save
57e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
57f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5800: 20 20 28 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 (error "invali
5810: 64 20 28 3f 3c 20 73 65 71 75 65 6e 63 65 22 20 d (?< sequence"
5820: 73 74 72 29 29 29 29 29 29 29 29 0a 20 20 20 20 str)))))))).
5830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5840: 28 23 5c 3e 29 0a 20 20 20 20 20 20 20 20 20 20 (#\>).
5850: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
5860: 20 69 20 33 29 20 28 2b 20 69 20 33 29 20 28 66 i 3) (+ i 3) (f
5870: 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 73 20 lag-clear flags
5880: 7e 73 61 76 65 3f 29 0a 20 20 20 20 20 20 20 20 ~save?).
5890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
58a0: 27 28 61 74 6f 6d 69 63 29 20 28 73 61 76 65 29 '(atomic) (save)
58b0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
58c0: 20 20 20 20 20 20 3b 3b 28 28 23 5c 27 20 23 5c ;;((#\' #\
58d0: 50 29 20 3b 20 6e 61 6d 65 64 20 73 75 62 70 61 P) ; named subpa
58e0: 74 74 65 72 6e 73 0a 20 20 20 20 20 20 20 20 20 tterns.
58f0: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 29 0a 20 ;; ).
5900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5910: 20 20 3b 3b 28 28 23 5c 52 29 20 3b 20 72 65 63 ;;((#\R) ; rec
5920: 75 72 73 69 6f 6e 0a 20 20 20 20 20 20 20 20 20 ursion.
5930: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 29 0a 20 ;; ).
5940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5950: 20 20 28 28 23 5c 28 29 0a 20 20 20 20 20 20 20 ((#\().
5960: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
5970: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
5980: 20 20 20 20 20 20 20 20 28 28 3e 3d 20 28 2b 20 ((>= (+
5990: 69 20 33 29 20 65 6e 64 29 0a 20 20 20 20 20 20 i 3) end).
59a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
59b0: 28 65 72 72 6f 72 20 22 75 6e 74 65 72 6d 69 6e (error "untermin
59c0: 61 74 65 64 20 70 61 72 65 6e 74 68 65 73 69 73 ated parenthesis
59d0: 20 69 6e 20 72 65 67 65 78 70 22 20 73 74 72 29 in regexp" str)
59e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
59f0: 20 20 20 20 20 20 20 28 28 63 68 61 72 2d 6e 75 ((char-nu
5a00: 6d 65 72 69 63 3f 20 28 73 74 72 69 6e 67 2d 72 meric? (string-r
5a10: 65 66 20 73 74 72 20 28 2b 20 69 20 33 29 29 29 ef str (+ i 3)))
5a20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5a30: 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6a (let* ((j
5a40: 20 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 (string-scan-ch
5a50: 61 72 20 73 74 72 20 23 5c 29 20 28 2b 20 69 20 ar str #\) (+ i
5a60: 33 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 3))).
5a70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5a80: 20 20 28 6e 20 28 73 74 72 69 6e 67 2d 3e 6e 75 (n (string->nu
5a90: 6d 62 65 72 20 28 73 75 62 73 74 72 69 6e 67 20 mber (substring
5aa0: 73 74 72 20 28 2b 20 69 20 33 29 20 6a 29 29 29 str (+ i 3) j)))
5ab0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5ac0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
5ad0: 6f 74 20 6e 29 0a 20 20 20 20 20 20 20 20 20 20 ot n).
5ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5af0: 20 20 28 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 (error "invali
5b00: 64 20 63 6f 6e 64 69 74 69 6f 6e 61 6c 20 72 65 d conditional re
5b10: 66 65 72 65 6e 63 65 22 20 73 74 72 29 0a 20 20 ference" str).
5b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b30: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
5b40: 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 20 28 66 j 1) (+ j 1) (f
5b50: 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 73 20 lag-clear flags
5b60: 7e 73 61 76 65 3f 29 0a 20 20 20 20 20 20 20 20 ~save?).
5b70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b80: 20 20 20 20 20 20 20 20 60 28 2c 6e 20 69 66 29 `(,n if)
5b90: 20 28 73 61 76 65 29 29 29 29 29 0a 20 20 20 20 (save))))).
5ba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bb0: 20 28 28 63 68 61 72 2d 61 6c 70 68 61 62 65 74 ((char-alphabet
5bc0: 69 63 3f 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ic? (string-ref
5bd0: 73 74 72 20 28 2b 20 69 20 33 29 29 29 0a 20 20 str (+ i 3))).
5be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5bf0: 20 20 20 20 28 6c 65 74 2a 20 28 28 6a 20 28 73 (let* ((j (s
5c00: 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 61 72 20 tring-scan-char
5c10: 73 74 72 20 23 5c 29 20 28 2b 20 69 20 33 29 29 str #\) (+ i 3))
5c20: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5c40: 73 20 28 73 74 72 69 6e 67 2d 3e 73 79 6d 62 6f s (string->symbo
5c50: 6c 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 72 l (substring str
5c60: 20 28 2b 20 69 20 33 29 20 6a 29 29 29 29 0a 20 (+ i 3) j)))).
5c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5c80: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 (lp (+ j
5c90: 31 29 20 28 2b 20 6a 20 31 29 20 28 66 6c 61 67 1) (+ j 1) (flag
5ca0: 2d 63 6c 65 61 72 20 66 6c 61 67 73 20 7e 73 61 -clear flags ~sa
5cb0: 76 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 ve?).
5cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5cd0: 20 60 28 2c 73 20 69 66 29 20 28 73 61 76 65 29 `(,s if) (save)
5ce0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
5cf0: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
5d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d10: 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 (lp (+ i 2)
5d20: 20 28 2b 20 69 20 32 29 20 28 66 6c 61 67 2d 63 (+ i 2) (flag-c
5d30: 6c 65 61 72 20 66 6c 61 67 73 20 7e 73 61 76 65 lear flags ~save
5d40: 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?).
5d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 69 '(i
5d60: 66 29 20 28 73 61 76 65 29 29 29 29 29 0a 20 20 f) (save))))).
5d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5d80: 20 28 28 23 5c 7b 29 0a 20 20 20 20 20 20 20 20 ((#\{).
5d90: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err
5da0: 6f 72 20 22 75 6e 73 75 70 70 6f 72 74 65 64 20 or "unsupported
5db0: 50 65 72 6c 2d 73 74 79 6c 65 20 63 6c 75 73 74 Perl-style clust
5dc0: 65 72 22 20 73 74 72 29 29 0a 20 20 20 20 20 20 er" str)).
5dd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
5de0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
5df0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6f 6c (let ((ol
5e00: 64 2d 66 6c 61 67 73 20 66 6c 61 67 73 29 29 0a d-flags flags)).
5e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e20: 20 20 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 (let lp2 (
5e30: 28 6a 20 28 2b 20 69 20 32 29 29 20 28 66 6c 61 (j (+ i 2)) (fla
5e40: 67 73 20 66 6c 61 67 73 29 20 28 69 6e 76 65 72 gs flags) (inver
5e50: 74 3f 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 t? #f)).
5e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5e70: 28 64 65 66 69 6e 65 20 28 6a 6f 69 6e 20 78 29 (define (join x)
5e80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5e90: 20 20 20 20 20 20 20 20 20 20 20 28 28 69 66 20 ((if
5ea0: 69 6e 76 65 72 74 3f 20 66 6c 61 67 2d 63 6c 65 invert? flag-cle
5eb0: 61 72 20 66 6c 61 67 2d 6a 6f 69 6e 29 20 66 6c ar flag-join) fl
5ec0: 61 67 73 20 78 29 29 0a 20 20 20 20 20 20 20 20 ags x)).
5ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ee0: 28 64 65 66 69 6e 65 20 28 6e 65 77 2d 72 65 73 (define (new-res
5ef0: 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 res).
5f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f10: 28 6c 65 74 20 28 28 62 65 66 6f 72 65 20 28 66 (let ((before (f
5f20: 6c 61 67 2d 73 65 74 3f 20 6f 6c 64 2d 66 6c 61 lag-set? old-fla
5f30: 67 73 20 7e 75 74 66 38 3f 29 29 0a 20 20 20 20 gs ~utf8?)).
5f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f50: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 66 74 (aft
5f60: 65 72 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c er (flag-set? fl
5f70: 61 67 73 20 7e 75 74 66 38 3f 29 29 29 0a 20 20 ags ~utf8?))).
5f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5f90: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 (if (e
5fa0: 71 3f 20 62 65 66 6f 72 65 20 61 66 74 65 72 29 q? before after)
5fb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fd0: 20 72 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 res.
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5ff0: 20 20 20 20 20 28 63 6f 6e 73 20 28 69 66 20 61 (cons (if a
6000: 66 74 65 72 20 27 77 2f 75 74 66 38 20 27 77 2f fter 'w/utf8 'w/
6010: 6e 6f 75 74 66 38 29 20 72 65 73 29 29 29 29 0a noutf8) res)))).
6020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6030: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
6040: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6050: 20 20 20 20 20 20 20 28 28 3e 3d 20 6a 20 65 6e ((>= j en
6060: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
6070: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
6080: 72 6f 72 20 22 69 6e 63 6f 6d 70 6c 65 74 65 20 ror "incomplete
6090: 63 6c 75 73 74 65 72 22 20 73 74 72 20 69 29 29 cluster" str i))
60a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
60b0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
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 28 63 61 73 65 20 (case
60e0: 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
60f0: 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j).
6100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6110: 28 23 5c 69 29 0a 20 20 20 20 20 20 20 20 20 20 (#\i).
6120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6130: 20 20 20 28 6c 70 32 20 28 2b 20 6a 20 31 29 20 (lp2 (+ j 1)
6140: 28 6a 6f 69 6e 20 7e 63 61 73 65 2d 69 6e 73 65 (join ~case-inse
6150: 6e 73 69 74 69 76 65 3f 29 20 69 6e 76 65 72 74 nsitive?) invert
6160: 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ?)).
6170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6180: 28 28 23 5c 6d 29 0a 20 20 20 20 20 20 20 20 20 ((#\m).
6190: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61a0: 20 20 20 20 28 6c 70 32 20 28 2b 20 6a 20 31 29 (lp2 (+ j 1)
61b0: 20 28 6a 6f 69 6e 20 7e 6d 75 6c 74 69 2d 6c 69 (join ~multi-li
61c0: 6e 65 3f 29 20 69 6e 76 65 72 74 3f 29 29 0a 20 ne?) invert?)).
61d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61e0: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 78 ((#\x
61f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6210: 6c 70 32 20 28 2b 20 6a 20 31 29 20 28 6a 6f 69 lp2 (+ j 1) (joi
6220: 6e 20 7e 69 67 6e 6f 72 65 2d 73 70 61 63 65 3f n ~ignore-space?
6230: 29 20 69 6e 76 65 72 74 3f 29 29 0a 20 20 20 20 ) invert?)).
6240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6250: 20 20 20 20 20 20 20 20 28 28 23 5c 75 29 0a 20 ((#\u).
6260: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6270: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
6280: 2a 61 6c 6c 6f 77 2d 75 74 66 38 2d 6d 6f 64 65 *allow-utf8-mode
6290: 3f 2a 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?*.
62a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62b0: 20 20 20 20 28 6c 70 32 20 28 2b 20 6a 20 31 29 (lp2 (+ j 1)
62c0: 20 28 6a 6f 69 6e 20 7e 75 74 66 38 3f 29 20 69 (join ~utf8?) i
62d0: 6e 76 65 72 74 3f 29 0a 20 20 20 20 20 20 20 20 nvert?).
62e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62f0: 20 20 20 20 20 20 20 20 20 28 6c 70 32 20 28 2b (lp2 (+
6300: 20 6a 20 31 29 20 66 6c 61 67 73 20 69 6e 76 65 j 1) flags inve
6310: 72 74 3f 29 29 29 0a 20 20 20 20 20 20 20 20 20 rt?))).
6320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6330: 20 20 20 28 28 23 5c 2d 29 0a 20 20 20 20 20 20 ((#\-).
6340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6350: 20 20 20 20 20 20 20 28 6c 70 32 20 28 2b 20 6a (lp2 (+ j
6360: 20 31 29 20 66 6c 61 67 73 20 28 6e 6f 74 20 69 1) flags (not i
6370: 6e 76 65 72 74 3f 29 29 29 0a 20 20 20 20 20 20 nvert?))).
6380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6390: 20 20 20 20 20 20 28 28 23 5c 29 29 0a 20 20 20 ((#\)).
63a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63b0: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
63c0: 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 20 66 6c j 1) (+ j 1) fl
63d0: 61 67 73 20 28 6e 65 77 2d 72 65 73 20 28 63 6f ags (new-res (co
63e0: 6c 6c 65 63 74 29 29 0a 20 20 20 20 20 20 20 20 llect)).
63f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6400: 20 20 20 20 20 20 20 20 20 73 74 29 29 0a 20 20 st)).
6410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6420: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 3a 29 ((#\:)
6430: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
6450: 70 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 p (+ j 1) (+ j 1
6460: 29 20 66 6c 61 67 73 20 28 6e 65 77 2d 72 65 73 ) flags (new-res
6470: 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 '()).
6480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6490: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 6f (cons (co
64a0: 6e 73 20 6f 6c 64 2d 66 6c 61 67 73 20 28 63 6f ns old-flags (co
64b0: 6c 6c 65 63 74 29 29 20 73 74 29 29 29 0a 20 20 llect)) st))).
64c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64d0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
64e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
64f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
6500: 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 72 65 67 ror "unknown reg
6510: 65 78 20 63 6c 75 73 74 65 72 20 6d 6f 64 69 66 ex cluster modif
6520: 69 65 72 22 20 73 74 72 29 0a 20 20 20 20 20 20 ier" str).
6530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6540: 20 20 20 20 20 20 20 29 29 29 29 29 29 29 29 29 )))))))))
6550: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6560: 20 28 28 23 5c 29 29 0a 20 20 20 20 20 20 20 20 ((#\)).
6570: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
6580: 3f 20 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 ? st).
6590: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 (error
65a0: 22 74 6f 6f 20 6d 61 6e 79 20 29 27 73 20 69 6e "too many )'s in
65b0: 20 72 65 67 65 78 70 22 20 73 74 72 29 0a 20 20 regexp" str).
65c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65d0: 20 28 6c 70 20 28 2b 20 69 20 31 29 0a 20 20 20 (lp (+ i 1).
65e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65f0: 20 20 20 20 28 2b 20 69 20 31 29 0a 20 20 20 20 (+ i 1).
6600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6610: 20 20 20 28 63 61 61 72 20 73 74 29 0a 20 20 20 (caar st).
6620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6630: 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6c 6c 65 (cons (colle
6640: 63 74 2f 74 65 72 6d 73 29 20 28 63 64 61 72 20 ct/terms) (cdar
6650: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
6660: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 (cdr
6670: 20 73 74 29 29 29 29 0a 20 20 20 20 20 20 20 20 st)))).
6680: 20 20 20 20 20 20 28 28 23 5c 5b 29 0a 20 20 20 ((#\[).
6690: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
66a0: 6c 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ly.
66b0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 72 65 20 (lambda (sre
66c0: 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 j).
66d0: 20 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 29 (lp (+ j 1)
66e0: 20 28 2b 20 6a 20 31 29 20 66 6c 61 67 73 20 28 (+ j 1) flags (
66f0: 63 6f 6e 73 20 73 72 65 20 28 63 6f 6c 6c 65 63 cons sre (collec
6700: 74 29 29 20 73 74 29 29 0a 20 20 20 20 20 20 20 t)) st)).
6710: 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
6720: 2d 70 61 72 73 65 2d 63 73 65 74 20 73 74 72 20 -parse-cset str
6730: 28 2b 20 69 20 31 29 20 66 6c 61 67 73 29 29 29 (+ i 1) flags)))
6740: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
6750: 28 23 5c 7b 29 0a 20 20 20 20 20 20 20 20 20 20 (#\{).
6760: 20 20 20 20 20 28 69 66 20 28 6f 72 20 28 3e 3d (if (or (>=
6770: 20 28 2b 20 69 20 31 29 20 65 6e 64 29 0a 20 20 (+ i 1) end).
6780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6790: 20 20 20 20 20 28 6e 6f 74 20 28 6f 72 20 28 63 (not (or (c
67a0: 68 61 72 2d 6e 75 6d 65 72 69 63 3f 20 28 73 74 har-numeric? (st
67b0: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 ring-ref str (+
67c0: 69 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 i 1))).
67d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67e0: 20 20 20 20 20 20 20 28 65 71 76 3f 20 23 5c 2c (eqv? #\,
67f0: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
6800: 20 28 2b 20 69 20 31 29 29 29 29 29 29 0a 20 20 (+ i 1)))))).
6810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6820: 20 28 6c 70 20 28 2b 20 69 20 31 29 20 66 72 6f (lp (+ i 1) fro
6830: 6d 20 66 6c 61 67 73 20 72 65 73 20 73 74 29 0a m flags res st).
6840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6850: 20 20 20 28 6c 65 74 2a 20 28 28 72 65 73 20 28 (let* ((res (
6860: 63 6f 6c 6c 65 63 74 2f 73 69 6e 67 6c 65 29 29 collect/single))
6870: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6880: 20 20 20 20 20 20 20 20 20 20 20 28 78 20 28 63 (x (c
6890: 61 72 20 72 65 73 29 29 0a 20 20 20 20 20 20 20 ar res)).
68a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68b0: 20 20 20 28 74 61 69 6c 20 28 63 64 72 20 72 65 (tail (cdr re
68c0: 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 s)).
68d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6a (j
68e0: 20 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 (string-scan-ch
68f0: 61 72 20 73 74 72 20 23 5c 7d 20 28 2b 20 69 20 ar str #\} (+ i
6900: 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 1))).
6910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6920: 73 32 20 28 73 74 72 69 6e 67 2d 73 70 6c 69 74 s2 (string-split
6930: 2d 63 68 61 72 20 28 73 75 62 73 74 72 69 6e 67 -char (substring
6940: 20 73 74 72 20 28 2b 20 69 20 31 29 20 6a 29 20 str (+ i 1) j)
6950: 23 5c 2c 29 29 0a 20 20 20 20 20 20 20 20 20 20 #\,)).
6960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6970: 28 6e 20 28 6f 72 20 28 73 74 72 69 6e 67 2d 3e (n (or (string->
6980: 6e 75 6d 62 65 72 20 28 63 61 72 20 73 32 29 29 number (car s2))
6990: 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 0)).
69a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
69b0: 6d 20 28 61 6e 64 20 28 70 61 69 72 3f 20 28 63 m (and (pair? (c
69c0: 64 72 20 73 32 29 29 20 28 73 74 72 69 6e 67 2d dr s2)) (string-
69d0: 3e 6e 75 6d 62 65 72 20 28 63 61 64 72 20 73 32 >number (cadr s2
69e0: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
69f0: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
6a00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6a10: 20 20 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 28 ((null? (
6a20: 63 64 72 20 73 32 29 29 0a 20 20 20 20 20 20 20 cdr s2)).
6a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a40: 28 6c 70 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a (lp (+ j 1) (+ j
6a50: 20 31 29 20 66 6c 61 67 73 20 60 28 28 3d 20 2c 1) flags `((= ,
6a60: 6e 20 2c 78 29 20 2c 40 74 61 69 6c 29 20 73 74 n ,x) ,@tail) st
6a70: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
6a80: 20 20 20 20 20 20 20 20 20 28 6d 0a 20 20 20 20 (m.
6a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6aa0: 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 29 20 28 (lp (+ j 1) (
6ab0: 2b 20 6a 20 31 29 20 66 6c 61 67 73 20 60 28 28 + j 1) flags `((
6ac0: 2a 2a 20 2c 6e 20 2c 6d 20 2c 78 29 20 2c 40 74 ** ,n ,m ,x) ,@t
6ad0: 61 69 6c 29 20 73 74 29 29 0a 20 20 20 20 20 20 ail) st)).
6ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6af0: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
6b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
6b10: 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 (+ j 1) (+ j 1)
6b20: 20 66 6c 61 67 73 20 60 28 28 3e 3d 20 2c 6e 20 flags `((>= ,n
6b30: 2c 78 29 20 2c 40 74 61 69 6c 29 20 73 74 29 0a ,x) ,@tail) st).
6b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b50: 20 20 20 20 20 20 20 29 29 29 29 29 0a 20 20 20 ))))).
6b60: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 5c ((#\\
6b70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6b80: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond.
6b90: 20 20 20 20 20 20 20 28 28 3e 3d 20 28 2b 20 69 ((>= (+ i
6ba0: 20 31 29 20 65 6e 64 29 0a 20 20 20 20 20 20 20 1) end).
6bb0: 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
6bc0: 20 22 69 6e 63 6f 6d 70 6c 65 74 65 20 65 73 63 "incomplete esc
6bd0: 61 70 65 20 73 65 71 75 65 6e 63 65 22 20 73 74 ape sequence" st
6be0: 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 r)).
6bf0: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
6c00: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
6c10: 28 28 63 20 28 73 74 72 69 6e 67 2d 72 65 66 20 ((c (string-ref
6c20: 73 74 72 20 28 2b 20 69 20 31 29 29 29 29 0a 20 str (+ i 1)))).
6c30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6c40: 20 20 28 63 61 73 65 20 63 0a 20 20 20 20 20 20 (case c.
6c50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6c60: 28 23 5c 64 29 0a 20 20 20 20 20 20 20 20 20 20 (#\d).
6c70: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
6c80: 28 2b 20 69 20 32 29 20 28 2b 20 69 20 32 29 20 (+ i 2) (+ i 2)
6c90: 66 6c 61 67 73 20 60 28 6e 75 6d 65 72 69 63 20 flags `(numeric
6ca0: 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 ,@(collect)) st)
6cb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6cc0: 20 20 20 20 20 20 20 28 28 23 5c 44 29 0a 20 20 ((#\D).
6cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ce0: 20 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 (lp (+ i 2)
6cf0: 28 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 (+ i 2) flags `(
6d00: 28 7e 20 6e 75 6d 65 72 69 63 29 20 2c 40 28 63 (~ numeric) ,@(c
6d10: 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 0a 20 20 ollect)) st)).
6d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d30: 20 20 20 28 28 23 5c 73 29 0a 20 20 20 20 20 20 ((#\s).
6d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6d50: 28 6c 70 20 28 2b 20 69 20 32 29 20 28 2b 20 69 (lp (+ i 2) (+ i
6d60: 20 32 29 20 66 6c 61 67 73 20 60 28 73 70 61 63 2) flags `(spac
6d70: 65 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 e ,@(collect)) s
6d80: 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
6d90: 20 20 20 20 20 20 20 20 20 28 28 23 5c 53 29 0a ((#\S).
6da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6db0: 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 32 (lp (+ i 2
6dc0: 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 73 20 ) (+ i 2) flags
6dd0: 60 28 28 7e 20 73 70 61 63 65 29 20 2c 40 28 63 `((~ space) ,@(c
6de0: 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 0a 20 20 ollect)) st)).
6df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e00: 20 20 20 28 28 23 5c 77 29 0a 20 20 20 20 20 20 ((#\w).
6e10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e20: 28 6c 70 20 28 2b 20 69 20 32 29 20 28 2b 20 69 (lp (+ i 2) (+ i
6e30: 20 32 29 20 66 6c 61 67 73 0a 20 20 20 20 20 20 2) flags.
6e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e50: 20 20 20 20 60 28 28 6f 72 20 61 6c 70 68 61 6e `((or alphan
6e60: 75 6d 65 72 69 63 20 28 22 5f 22 29 29 20 2c 40 umeric ("_")) ,@
6e70: 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 0a (collect)) st)).
6e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6e90: 20 20 20 20 20 28 28 23 5c 57 29 0a 20 20 20 20 ((#\W).
6ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6eb0: 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 2b (lp (+ i 2) (+
6ec0: 20 69 20 32 29 20 66 6c 61 67 73 0a 20 20 20 20 i 2) flags.
6ed0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ee0: 20 20 20 20 20 20 60 28 28 7e 20 28 6f 72 20 61 `((~ (or a
6ef0: 6c 70 68 61 6e 75 6d 65 72 69 63 20 28 22 5f 22 lphanumeric ("_"
6f00: 29 29 29 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 ))) ,@(collect))
6f10: 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 st)).
6f20: 20 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 62 ((#\b
6f30: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6f40: 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 (lp (+ i
6f50: 20 32 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 2) (+ i 2) flag
6f60: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
6f70: 20 20 20 20 20 20 20 20 20 20 20 20 60 28 28 6f `((o
6f80: 72 20 62 6f 77 20 65 6f 77 29 20 2c 40 28 63 6f r bow eow) ,@(co
6f90: 6c 6c 65 63 74 29 29 20 73 74 29 29 0a 20 20 20 llect)) st)).
6fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6fb0: 20 20 28 28 23 5c 42 29 0a 20 20 20 20 20 20 20 ((#\B).
6fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6fd0: 6c 70 20 28 2b 20 69 20 32 29 20 28 2b 20 69 20 lp (+ i 2) (+ i
6fe0: 32 29 20 66 6c 61 67 73 20 60 28 6e 77 62 20 2c 2) flags `(nwb ,
6ff0: 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 @(collect)) st))
7000: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7010: 20 20 20 20 20 20 28 28 23 5c 41 29 0a 20 20 20 ((#\A).
7020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7030: 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 (lp (+ i 2) (
7040: 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 62 + i 2) flags `(b
7050: 6f 73 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 os ,@(collect))
7060: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
7070: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 5a 29 ((#\Z)
7080: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7090: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
70a0: 32 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 73 2) (+ i 2) flags
70b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
70c0: 20 20 20 20 20 20 20 20 20 20 20 60 28 28 3f 20 `((?
70d0: 23 5c 6e 65 77 6c 69 6e 65 29 20 65 6f 73 20 2c #\newline) eos ,
70e0: 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 @(collect)) st))
70f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7100: 20 20 20 20 20 20 28 28 23 5c 7a 29 0a 20 20 20 ((#\z).
7110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7120: 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 (lp (+ i 2) (
7130: 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 65 + i 2) flags `(e
7140: 6f 73 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 os ,@(collect))
7150: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
7160: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 52 29 ((#\R)
7170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7180: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
7190: 32 29 20 28 2b 20 69 20 32 29 20 66 6c 61 67 73 2) (+ i 2) flags
71a0: 20 60 28 6e 65 77 6c 69 6e 65 20 2c 40 28 63 6f `(newline ,@(co
71b0: 6c 6c 65 63 74 29 29 20 73 74 29 29 0a 20 20 20 llect)) st)).
71c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
71d0: 20 20 28 28 23 5c 4b 29 0a 20 20 20 20 20 20 20 ((#\K).
71e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
71f0: 6c 70 20 28 2b 20 69 20 32 29 20 28 2b 20 69 20 lp (+ i 2) (+ i
7200: 32 29 20 66 6c 61 67 73 20 60 28 72 65 73 65 74 2) flags `(reset
7210: 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 ,@(collect)) st
7220: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
7230: 20 20 20 20 20 20 20 20 3b 3b 20 74 68 65 73 65 ;; these
7240: 20 74 77 6f 20 61 72 65 20 66 72 6f 6d 20 45 6d two are from Em
7250: 61 63 73 20 61 6e 64 20 54 52 45 2c 20 62 75 74 acs and TRE, but
7260: 20 6e 6f 74 20 69 6e 20 50 43 52 45 0a 20 20 20 not in PCRE.
7270: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7280: 20 20 28 28 23 5c 3c 29 0a 20 20 20 20 20 20 20 ((#\<).
7290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
72a0: 6c 70 20 28 2b 20 69 20 32 29 20 28 2b 20 69 20 lp (+ i 2) (+ i
72b0: 32 29 20 66 6c 61 67 73 20 60 28 62 6f 77 20 2c 2) flags `(bow ,
72c0: 40 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 @(collect)) st))
72d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
72e0: 20 20 20 20 20 20 28 28 23 5c 3e 29 0a 20 20 20 ((#\>).
72f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7300: 20 20 20 28 6c 70 20 28 2b 20 69 20 32 29 20 28 (lp (+ i 2) (
7310: 2b 20 69 20 32 29 20 66 6c 61 67 73 20 60 28 65 + i 2) flags `(e
7320: 6f 77 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 20 ow ,@(collect))
7330: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
7340: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 78 29 ((#\x)
7350: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7360: 20 20 20 20 20 20 20 28 61 70 70 6c 79 0a 20 20 (apply.
7370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7380: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 68 (lambda (ch
7390: 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 j).
73a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
73b0: 20 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 (+ j 1) (+ j 1)
73c0: 20 66 6c 61 67 73 20 60 28 2c 63 68 20 2c 40 28 flags `(,ch ,@(
73d0: 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 29 0a 20 collect)) st)).
73e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
73f0: 20 20 20 20 20 20 28 73 74 72 69 6e 67 2d 70 61 (string-pa
7400: 72 73 65 2d 68 65 78 2d 65 73 63 61 70 65 20 73 rse-hex-escape s
7410: 74 72 20 28 2b 20 69 20 32 29 20 65 6e 64 29 29 tr (+ i 2) end))
7420: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7430: 20 20 20 20 20 20 20 28 28 23 5c 6b 29 0a 20 20 ((#\k).
7440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7450: 20 20 20 20 28 6c 65 74 20 28 28 63 20 28 73 74 (let ((c (st
7460: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 ring-ref str (+
7470: 69 20 32 29 29 29 29 0a 20 20 20 20 20 20 20 20 i 2)))).
7480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7490: 28 69 66 20 28 6e 6f 74 20 28 6d 65 6d 76 20 63 (if (not (memv c
74a0: 20 27 28 23 5c 3c 20 23 5c 7b 20 23 5c 27 29 29 '(#\< #\{ #\'))
74b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
74c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
74d0: 72 72 6f 72 20 22 62 61 64 20 5c 5c 6b 20 75 73 rror "bad \\k us
74e0: 61 67 65 2c 20 65 78 70 65 63 74 65 64 20 5c 5c age, expected \\
74f0: 6b 3c 2e 2e 2e 3e 22 20 73 74 72 29 0a 20 20 20 k<...>" str).
7500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7510: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
7520: 28 74 65 72 6d 69 6e 61 6c 20 28 63 68 61 72 2d (terminal (char-
7530: 6d 69 72 72 6f 72 20 63 29 29 0a 20 20 20 20 20 mirror c)).
7540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6a (j
7560: 20 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 (string-scan-ch
7570: 61 72 20 73 74 72 20 74 65 72 6d 69 6e 61 6c 20 ar str terminal
7580: 28 2b 20 69 20 32 29 29 29 0a 20 20 20 20 20 20 (+ i 2))).
7590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 20 (s
75b0: 28 61 6e 64 20 6a 20 28 73 75 62 73 74 72 69 6e (and j (substrin
75c0: 67 20 73 74 72 20 28 2b 20 69 20 33 29 20 6a 29 g str (+ i 3) j)
75d0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
75e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
75f0: 20 20 20 20 20 20 28 62 61 63 6b 72 65 66 0a 20 (backref.
7600: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7620: 20 20 20 28 69 66 20 28 66 6c 61 67 2d 73 65 74 (if (flag-set
7630: 3f 20 66 6c 61 67 73 20 7e 63 61 73 65 2d 69 6e ? flags ~case-in
7640: 73 65 6e 73 69 74 69 76 65 3f 29 0a 20 20 20 20 sensitive?).
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 20 20 20 20 20
7670: 20 20 20 20 27 62 61 63 6b 72 65 66 2d 63 69 0a 'backref-ci.
7680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
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 27 62 61 63 6b 72 65 66 'backref
76b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
76c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76d0: 20 20 28 69 66 20 28 6e 6f 74 20 6a 29 0a 20 20 (if (not j).
76e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
76f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7700: 28 65 72 72 6f 72 20 22 75 6e 74 65 72 6d 69 6e (error "untermin
7710: 61 74 65 64 20 6e 61 6d 65 64 20 62 61 63 6b 72 ated named backr
7720: 65 66 22 20 73 74 72 29 0a 20 20 20 20 20 20 20 ef" str).
7730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7740: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
7750: 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 20 66 + j 1) (+ j 1) f
7760: 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
7770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7780: 20 20 20 20 20 20 20 20 20 20 20 60 28 28 2c 62 `((,b
7790: 61 63 6b 72 65 66 20 2c 28 73 74 72 69 6e 67 2d ackref ,(string-
77a0: 3e 73 79 6d 62 6f 6c 20 73 29 29 0a 20 20 20 20 >symbol s)).
77b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
77d0: 20 20 20 20 2c 40 28 63 6f 6c 6c 65 63 74 29 29 ,@(collect))
77e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
77f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7800: 20 20 20 20 20 20 20 73 74 29 29 29 29 29 29 0a st)))))).
7810: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7820: 20 20 20 20 20 28 28 23 5c 51 29 20 20 3b 3b 20 ((#\Q) ;;
7830: 5c 51 2e 2e 5c 45 20 65 73 63 61 70 65 73 0a 20 \Q..\E escapes.
7840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7850: 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 20 (let ((res
7860: 28 63 6f 6c 6c 65 63 74 29 29 29 0a 20 20 20 20 (collect))).
7870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7880: 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 28 6a (let lp2 ((j
7890: 20 28 2b 20 69 20 32 29 29 29 0a 20 20 20 20 20 (+ i 2))).
78a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
78b0: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
78c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
78d0: 20 20 20 20 20 20 28 28 3e 3d 20 6a 20 65 6e 64 ((>= j end
78e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
78f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
7900: 70 20 6a 20 28 2b 20 69 20 32 29 20 66 6c 61 67 p j (+ i 2) flag
7910: 73 20 72 65 73 20 73 74 29 29 0a 20 20 20 20 20 s res st)).
7920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7930: 20 20 20 20 20 20 28 28 65 71 76 3f 20 23 5c 5c ((eqv? #\\
7940: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
7950: 20 6a 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 j)).
7960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7970: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond.
7980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7990: 20 20 20 20 28 28 3e 3d 20 28 2b 20 6a 20 31 29 ((>= (+ j 1)
79a0: 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
79b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
79c0: 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 31 29 20 (lp (+ j 1)
79d0: 28 2b 20 69 20 32 29 20 66 6c 61 67 73 20 72 65 (+ i 2) flags re
79e0: 73 20 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 s st)).
79f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a00: 20 20 20 20 28 28 65 71 76 3f 20 23 5c 45 20 28 ((eqv? #\E (
7a10: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 string-ref str (
7a20: 2b 20 6a 20 31 29 29 29 0a 20 20 20 20 20 20 20 + j 1))).
7a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7a40: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 6a 20 (lp (+ j
7a50: 32 29 20 28 2b 20 6a 20 32 29 20 66 6c 61 67 73 2) (+ j 2) flags
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 20 20 20 20 20 20 20
7a80: 20 20 20 28 63 6f 6e 73 20 28 73 75 62 73 74 72 (cons (substr
7a90: 69 6e 67 20 73 74 72 20 28 2b 20 69 20 32 29 20 ing str (+ i 2)
7aa0: 6a 29 20 72 65 73 29 20 73 74 29 29 0a 20 20 20 j) res) st)).
7ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ac0: 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
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 20 20 20 20 20 20 28 6c (l
7af0: 70 32 20 28 2b 20 6a 20 32 29 29 29 29 29 0a 20 p2 (+ j 2))))).
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 20 28 65 6c 73 65 0a (else.
7b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b30: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 32 (lp2
7b40: 20 28 2b 20 6a 20 31 29 29 29 29 29 29 29 0a 20 (+ j 1))))))).
7b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7b60: 20 20 20 20 3b 3b 28 28 23 5c 70 29 20 20 3b 20 ;;((#\p) ;
7b70: 58 58 58 58 20 75 6e 69 63 6f 64 65 20 70 72 6f XXXX unicode pro
7b80: 70 65 72 74 69 65 73 0a 20 20 20 20 20 20 20 20 perties.
7b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
7ba0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
7bb0: 20 20 20 20 20 20 20 3b 3b 28 28 23 5c 50 29 0a ;;((#\P).
7bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7bd0: 20 20 20 20 20 3b 3b 20 29 0a 20 20 20 20 20 20 ;; ).
7be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
7bf0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
7c00: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
7c10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
7c20: 20 20 20 20 20 20 20 20 28 28 63 68 61 72 2d 6e ((char-n
7c30: 75 6d 65 72 69 63 3f 20 63 29 0a 20 20 20 20 20 umeric? c).
7c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7c50: 20 20 20 28 6c 65 74 2a 20 28 28 6a 20 28 6f 72 (let* ((j (or
7c60: 20 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 70 72 (string-scan-pr
7c70: 65 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ed.
7c80: 20 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 73 74 72 0a 20 20 str.
7ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7cc0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 29 (lambda (c)
7cd0: 20 28 6e 6f 74 20 28 63 68 61 72 2d 6e 75 6d 65 (not (char-nume
7ce0: 72 69 63 3f 20 63 29 29 29 0a 20 20 20 20 20 20 ric? c))).
7cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d10: 20 28 2b 20 69 20 32 29 29 0a 20 20 20 20 20 20 (+ i 2)).
7d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d40: 65 6e 64 29 29 0a 20 20 20 20 20 20 20 20 20 20 end)).
7d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d60: 20 20 20 20 20 28 62 61 63 6b 72 65 66 0a 20 20 (backref.
7d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
7d90: 66 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 f (flag-set? fla
7da0: 67 73 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 gs ~case-insensi
7db0: 74 69 76 65 3f 29 0a 20 20 20 20 20 20 20 20 20 tive?).
7dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7dd0: 20 20 20 20 20 20 20 20 20 20 20 27 62 61 63 6b 'back
7de0: 72 65 66 2d 63 69 0a 20 20 20 20 20 20 20 20 20 ref-ci.
7df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e00: 20 20 20 20 20 20 20 20 20 20 20 27 62 61 63 6b 'back
7e10: 72 65 66 29 29 0a 20 20 20 20 20 20 20 20 20 20 ref)).
7e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e30: 20 20 20 20 20 28 72 65 73 20 60 28 28 2c 62 61 (res `((,ba
7e40: 63 6b 72 65 66 20 2c 28 73 74 72 69 6e 67 2d 3e ckref ,(string->
7e50: 6e 75 6d 62 65 72 0a 20 20 20 20 20 20 20 20 20 number.
7e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7e80: 20 20 20 20 20 20 20 20 20 28 73 75 62 73 74 72 (substr
7e90: 69 6e 67 20 73 74 72 20 28 2b 20 69 20 31 29 20 ing str (+ i 1)
7ea0: 6a 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 j))).
7eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ec0: 20 20 20 20 20 20 20 20 20 20 20 2c 40 28 63 6f ,@(co
7ed0: 6c 6c 65 63 74 29 29 29 29 0a 20 20 20 20 20 20 llect)))).
7ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ef0: 20 20 20 20 28 6c 70 20 6a 20 6a 20 66 6c 61 67 (lp j j flag
7f00: 73 20 72 65 73 20 73 74 29 29 29 0a 20 20 20 20 s res st))).
7f10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f20: 20 20 20 28 28 63 68 61 72 2d 61 6c 70 68 61 62 ((char-alphab
7f30: 65 74 69 63 3f 20 63 29 0a 20 20 20 20 20 20 20 etic? c).
7f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f50: 20 28 6c 65 74 20 28 28 63 65 6c 6c 20 28 61 73 (let ((cell (as
7f60: 73 76 20 63 20 70 6f 73 69 78 2d 65 73 63 61 70 sv c posix-escap
7f70: 65 2d 73 65 71 75 65 6e 63 65 73 29 29 29 0a 20 e-sequences))).
7f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7f90: 20 20 20 20 20 20 20 20 20 28 69 66 20 63 65 6c (if cel
7fa0: 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 l.
7fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7fc0: 28 6c 70 20 28 2b 20 69 20 32 29 20 28 2b 20 69 (lp (+ i 2) (+ i
7fd0: 20 32 29 20 66 6c 61 67 73 0a 20 20 20 20 20 20 2) flags.
7fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
7ff0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
8000: 73 20 28 63 64 72 20 63 65 6c 6c 29 20 28 63 6f s (cdr cell) (co
8010: 6c 6c 65 63 74 29 29 20 73 74 29 0a 20 20 20 20 llect)) st).
8020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8030: 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
8040: 20 22 75 6e 6b 6e 6f 77 6e 20 65 73 63 61 70 65 "unknown escape
8050: 20 73 65 71 75 65 6e 63 65 22 20 73 74 72 20 63 sequence" str c
8060: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
8070: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
8080: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
8090: 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b (lp (+
80a0: 20 69 20 32 29 20 28 2b 20 69 20 31 29 20 66 6c i 2) (+ i 1) fl
80b0: 61 67 73 20 28 63 6f 6c 6c 65 63 74 29 20 73 74 ags (collect) st
80c0: 29 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 ))))))))).
80d0: 20 20 20 20 20 20 20 20 28 28 23 5c 7c 29 0a 20 ((#\|).
80e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
80f0: 70 20 28 2b 20 69 20 31 29 20 28 2b 20 69 20 31 p (+ i 1) (+ i 1
8100: 29 20 66 6c 61 67 73 20 28 63 6f 6e 73 20 27 6f ) flags (cons 'o
8110: 72 20 28 63 6f 6c 6c 65 63 74 29 29 20 73 74 29 r (collect)) st)
8120: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
8130: 28 28 23 5c 5e 29 0a 20 20 20 20 20 20 20 20 20 ((#\^).
8140: 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 79 6d (let ((sym
8150: 20 28 69 66 20 28 66 6c 61 67 2d 73 65 74 3f 20 (if (flag-set?
8160: 66 6c 61 67 73 20 7e 6d 75 6c 74 69 2d 6c 69 6e flags ~multi-lin
8170: 65 3f 29 20 27 62 6f 6c 20 27 62 6f 73 29 29 29 e?) 'bol 'bos)))
8180: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8190: 20 20 28 6c 70 20 28 2b 20 69 20 31 29 20 28 2b (lp (+ i 1) (+
81a0: 20 69 20 31 29 20 66 6c 61 67 73 20 28 63 6f 6e i 1) flags (con
81b0: 73 20 73 79 6d 20 28 63 6f 6c 6c 65 63 74 29 29 s sym (collect))
81c0: 20 73 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 st))).
81d0: 20 20 20 20 20 28 28 23 5c 24 29 0a 20 20 20 20 ((#\$).
81e0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
81f0: 28 28 73 79 6d 20 28 69 66 20 28 66 6c 61 67 2d ((sym (if (flag-
8200: 73 65 74 3f 20 66 6c 61 67 73 20 7e 6d 75 6c 74 set? flags ~mult
8210: 69 2d 6c 69 6e 65 3f 29 20 27 65 6f 6c 20 27 65 i-line?) 'eol 'e
8220: 6f 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 os))).
8230: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
8240: 31 29 20 28 2b 20 69 20 31 29 20 66 6c 61 67 73 1) (+ i 1) flags
8250: 20 28 63 6f 6e 73 20 73 79 6d 20 28 63 6f 6c 6c (cons sym (coll
8260: 65 63 74 29 29 20 73 74 29 29 29 0a 20 20 20 20 ect)) st))).
8270: 20 20 20 20 20 20 20 20 20 20 28 28 23 5c 73 70 ((#\sp
8280: 61 63 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ace).
8290: 20 20 20 20 28 69 66 20 28 66 6c 61 67 2d 73 65 (if (flag-se
82a0: 74 3f 20 66 6c 61 67 73 20 7e 69 67 6e 6f 72 65 t? flags ~ignore
82b0: 2d 73 70 61 63 65 3f 29 0a 20 20 20 20 20 20 20 -space?).
82c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
82d0: 28 2b 20 69 20 31 29 20 28 2b 20 69 20 31 29 20 (+ i 1) (+ i 1)
82e0: 66 6c 61 67 73 20 28 63 6f 6c 6c 65 63 74 29 20 flags (collect)
82f0: 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 st).
8300: 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 20 (lp (+ i
8310: 31 29 20 66 72 6f 6d 20 66 6c 61 67 73 20 72 65 1) from flags re
8320: 73 20 73 74 29 29 29 0a 20 20 20 20 20 20 20 20 s st))).
8330: 20 20 20 20 20 20 28 28 23 5c 23 29 0a 20 20 20 ((#\#).
8340: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
8350: 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 (flag-set? flags
8360: 20 7e 69 67 6e 6f 72 65 2d 73 70 61 63 65 3f 29 ~ignore-space?)
8370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8380: 20 20 20 20 28 6c 65 74 20 28 28 6a 20 28 6f 72 (let ((j (or
8390: 20 28 73 74 72 69 6e 67 2d 73 63 61 6e 2d 63 68 (string-scan-ch
83a0: 61 72 20 73 74 72 20 23 5c 6e 65 77 6c 69 6e 65 ar str #\newline
83b0: 20 28 2b 20 69 20 31 29 29 0a 20 20 20 20 20 20 (+ i 1)).
83c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
83d0: 20 20 20 20 20 20 20 20 20 20 28 2d 20 65 6e 64 (- end
83e0: 20 31 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 1)))).
83f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
8400: 28 2b 20 6a 20 31 29 20 28 2b 20 6a 20 31 29 20 (+ j 1) (+ j 1)
8410: 66 6c 61 67 73 20 28 63 6f 6c 6c 65 63 74 29 20 flags (collect)
8420: 73 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 st)).
8430: 20 20 20 20 20 20 20 20 28 6c 70 20 28 2b 20 69 (lp (+ i
8440: 20 31 29 20 66 72 6f 6d 20 66 6c 61 67 73 20 72 1) from flags r
8450: 65 73 20 73 74 29 29 29 0a 20 20 20 20 20 20 20 es st))).
8460: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
8470: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
8480: 28 2b 20 69 20 31 29 20 66 72 6f 6d 20 66 6c 61 (+ i 1) from fla
8490: 67 73 20 72 65 73 20 73 74 29 29 29 29 29 29 29 gs res st)))))))
84a0: 29 0a 0a 28 64 65 66 69 6e 65 20 70 6f 73 69 78 )..(define posix
84b0: 2d 65 73 63 61 70 65 2d 73 65 71 75 65 6e 63 65 -escape-sequence
84c0: 73 0a 20 20 60 28 28 23 5c 6e 20 2e 20 23 5c 6e s. `((#\n . #\n
84d0: 65 77 6c 69 6e 65 29 0a 20 20 20 20 28 23 5c 72 ewline). (#\r
84e0: 20 2e 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 . ,(integer->ch
84f0: 61 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 ar (+ (char->int
8500: 65 67 65 72 20 23 5c 6e 65 77 6c 69 6e 65 29 20 eger #\newline)
8510: 33 29 29 29 0a 20 20 20 20 28 23 5c 74 20 2e 20 3))). (#\t .
8520: 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
8530: 28 2d 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 (- (char->intege
8540: 72 20 23 5c 6e 65 77 6c 69 6e 65 29 20 31 29 29 r #\newline) 1))
8550: 29 0a 20 20 20 20 28 23 5c 61 20 2e 20 2c 28 69 ). (#\a . ,(i
8560: 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2d 20 nteger->char (-
8570: 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 (char->integer #
8580: 5c 6e 65 77 6c 69 6e 65 29 20 33 29 29 29 0a 20 \newline) 3))).
8590: 20 20 20 28 23 5c 65 20 2e 20 2c 28 69 6e 74 65 (#\e . ,(inte
85a0: 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 ger->char (+ (ch
85b0: 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 6e 65 ar->integer #\ne
85c0: 77 6c 69 6e 65 29 20 23 78 31 31 29 29 29 0a 20 wline) #x11))).
85d0: 20 20 20 28 23 5c 66 20 2e 20 2c 28 69 6e 74 65 (#\f . ,(inte
85e0: 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 ger->char (+ (ch
85f0: 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 6e 65 ar->integer #\ne
8600: 77 6c 69 6e 65 29 20 32 29 29 29 0a 20 20 20 20 wline) 2))).
8610: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 68 61 ))..(define (cha
8620: 72 2d 61 6c 74 63 61 73 65 20 63 29 0a 20 20 28 r-altcase c). (
8630: 69 66 20 28 63 68 61 72 2d 75 70 70 65 72 2d 63 if (char-upper-c
8640: 61 73 65 3f 20 63 29 20 28 63 68 61 72 2d 64 6f ase? c) (char-do
8650: 77 6e 63 61 73 65 20 63 29 20 28 63 68 61 72 2d wncase c) (char-
8660: 75 70 63 61 73 65 20 63 29 29 29 0a 0a 28 64 65 upcase c)))..(de
8670: 66 69 6e 65 20 28 63 68 61 72 2d 6d 69 72 72 6f fine (char-mirro
8680: 72 20 63 29 0a 20 20 28 63 61 73 65 20 63 20 28 r c). (case c (
8690: 28 23 5c 3c 29 20 23 5c 3e 29 20 28 28 23 5c 7b (#\<) #\>) ((#\{
86a0: 29 20 23 5c 7d 29 20 28 28 23 5c 28 29 20 23 5c ) #\}) ((#\() #\
86b0: 29 29 20 28 28 23 5c 5b 29 20 23 5c 5d 29 20 28 )) ((#\[) #\]) (
86c0: 65 6c 73 65 20 63 29 29 29 0a 0a 28 64 65 66 69 else c)))..(defi
86d0: 6e 65 20 28 73 74 72 69 6e 67 2d 70 61 72 73 65 ne (string-parse
86e0: 2d 68 65 78 2d 65 73 63 61 70 65 20 73 74 72 20 -hex-escape str
86f0: 69 20 65 6e 64 29 0a 20 20 28 63 6f 6e 64 0a 20 i end). (cond.
8700: 20 20 28 28 3e 3d 20 69 20 65 6e 64 29 0a 20 20 ((>= i end).
8710: 20 20 28 65 72 72 6f 72 20 22 69 6e 63 6f 6d 70 (error "incomp
8720: 6c 65 74 65 20 68 65 78 20 65 73 63 61 70 65 22 lete hex escape"
8730: 20 73 74 72 20 69 29 29 0a 20 20 20 28 28 65 71 str i)). ((eq
8740: 76 3f 20 23 5c 7b 20 28 73 74 72 69 6e 67 2d 72 v? #\{ (string-r
8750: 65 66 20 73 74 72 20 69 29 29 0a 20 20 20 20 28 ef str i)). (
8760: 6c 65 74 20 28 28 6a 20 28 73 74 72 69 6e 67 2d let ((j (string-
8770: 73 63 61 6e 2d 63 68 61 72 2d 65 73 63 61 70 65 scan-char-escape
8780: 20 73 74 72 20 23 5c 7d 20 28 2b 20 69 20 31 29 str #\} (+ i 1)
8790: 29 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 6e ))). (if (n
87a0: 6f 74 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 ot j).
87b0: 28 65 72 72 6f 72 20 22 69 6e 63 6f 6d 70 6c 65 (error "incomple
87c0: 74 65 20 68 65 78 20 62 72 61 63 65 20 65 73 63 te hex brace esc
87d0: 61 70 65 22 20 73 74 72 20 69 29 0a 20 20 20 20 ape" str i).
87e0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 20 (let* ((s
87f0: 28 73 75 62 73 74 72 69 6e 67 20 73 74 72 20 28 (substring str (
8800: 2b 20 69 20 31 29 20 6a 29 29 0a 20 20 20 20 20 + i 1) j)).
8810: 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 20 28 (n (
8820: 73 74 72 69 6e 67 2d 3e 6e 75 6d 62 65 72 20 73 string->number s
8830: 20 31 36 29 29 29 0a 20 20 20 20 20 20 20 20 20 16))).
8840: 20 20 20 28 69 66 20 6e 0a 20 20 20 20 20 20 20 (if n.
8850: 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 (list (
8860: 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 6e 29 integer->char n)
8870: 20 6a 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 j).
8880: 20 20 20 20 28 65 72 72 6f 72 20 22 62 61 64 20 (error "bad
8890: 68 65 78 20 62 72 61 63 65 20 65 73 63 61 70 65 hex brace escape
88a0: 22 20 73 29 29 29 29 29 29 0a 20 20 20 28 28 3e " s)))))). ((>
88b0: 3d 20 28 2b 20 69 20 31 29 20 65 6e 64 29 0a 20 = (+ i 1) end).
88c0: 20 20 20 28 65 72 72 6f 72 20 22 69 6e 63 6f 6d (error "incom
88d0: 70 6c 65 74 65 20 68 65 78 20 65 73 63 61 70 65 plete hex escape
88e0: 22 20 73 74 72 20 69 29 29 0a 20 20 20 28 65 6c " str i)). (el
88f0: 73 65 0a 20 20 20 20 28 6c 65 74 2a 20 28 28 73 se. (let* ((s
8900: 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 72 20 (substring str
8910: 69 20 28 2b 20 69 20 32 29 29 29 0a 20 20 20 20 i (+ i 2))).
8920: 20 20 20 20 20 20 20 28 6e 20 28 73 74 72 69 6e (n (strin
8930: 67 2d 3e 6e 75 6d 62 65 72 20 73 20 31 36 29 29 g->number s 16))
8940: 29 0a 20 20 20 20 20 20 28 69 66 20 6e 0a 20 20 ). (if n.
8950: 20 20 20 20 20 20 20 20 28 6c 69 73 74 20 28 69 (list (i
8960: 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 6e 29 20 nteger->char n)
8970: 28 2b 20 69 20 32 29 29 0a 20 20 20 20 20 20 20 (+ i 2)).
8980: 20 20 20 28 65 72 72 6f 72 20 22 62 61 64 20 68 (error "bad h
8990: 65 78 20 65 73 63 61 70 65 22 20 73 29 29 29 29 ex escape" s))))
89a0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 74 72 ))..(define (str
89b0: 69 6e 67 2d 70 61 72 73 65 2d 63 73 65 74 20 73 ing-parse-cset s
89c0: 74 72 20 73 74 61 72 74 20 66 6c 61 67 73 29 0a tr start flags).
89d0: 20 20 28 6c 65 74 2a 20 28 28 65 6e 64 20 28 73 (let* ((end (s
89e0: 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 tring-length str
89f0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 69 6e 76 )). (inv
8a00: 65 72 74 3f 20 28 61 6e 64 20 28 3c 20 73 74 61 ert? (and (< sta
8a10: 72 74 20 65 6e 64 29 20 28 65 71 76 3f 20 23 5c rt end) (eqv? #\
8a20: 5e 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 ^ (string-ref st
8a30: 72 20 73 74 61 72 74 29 29 29 29 0a 20 20 20 20 r start)))).
8a40: 20 20 20 20 20 28 75 74 66 38 3f 20 28 66 6c 61 (utf8? (fla
8a50: 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e 75 74 g-set? flags ~ut
8a60: 66 38 3f 29 29 29 0a 20 20 20 20 28 64 65 66 69 f8?))). (defi
8a70: 6e 65 20 28 67 6f 20 69 20 63 68 61 72 73 20 72 ne (go i chars r
8a80: 61 6e 67 65 73 29 0a 20 20 20 20 20 20 28 69 66 anges). (if
8a90: 20 28 3e 3d 20 69 20 65 6e 64 29 0a 20 20 20 20 (>= i end).
8aa0: 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 69 6e (error "in
8ab0: 63 6f 6d 70 6c 65 74 65 20 63 68 61 72 20 73 65 complete char se
8ac0: 74 22 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c t"). (l
8ad0: 65 74 20 28 28 63 20 28 73 74 72 69 6e 67 2d 72 et ((c (string-r
8ae0: 65 66 20 73 74 72 20 69 29 29 29 0a 20 20 20 20 ef str i))).
8af0: 20 20 20 20 20 20 20 20 28 63 61 73 65 20 63 0a (case c.
8b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
8b10: 23 5c 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 #\]).
8b20: 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 6e 75 (if (and (nu
8b30: 6c 6c 3f 20 63 68 61 72 73 29 20 28 6e 75 6c 6c ll? chars) (null
8b40: 3f 20 72 61 6e 67 65 73 29 29 0a 20 20 20 20 20 ? ranges)).
8b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 67 (g
8b60: 6f 20 28 2b 20 69 20 31 29 20 28 63 6f 6e 73 20 o (+ i 1) (cons
8b70: 23 5c 5d 20 63 68 61 72 73 29 20 72 61 6e 67 65 #\] chars) range
8b80: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
8b90: 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 69 3f (let ((ci?
8ba0: 20 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 (flag-set? flag
8bb0: 73 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 s ~case-insensit
8bc0: 69 76 65 3f 29 29 0a 20 20 20 20 20 20 20 20 20 ive?)).
8bd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8be0: 28 68 69 2d 63 68 61 72 73 20 28 69 66 20 75 74 (hi-chars (if ut
8bf0: 66 38 3f 20 28 66 69 6c 74 65 72 20 68 69 67 68 f8? (filter high
8c00: 2d 63 68 61 72 3f 20 63 68 61 72 73 29 20 27 28 -char? chars) '(
8c10: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
8c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 (ch
8c30: 61 72 73 20 28 69 66 20 75 74 66 38 3f 20 28 72 ars (if utf8? (r
8c40: 65 6d 6f 76 65 20 68 69 67 68 2d 63 68 61 72 3f emove high-char?
8c50: 20 63 68 61 72 73 29 20 63 68 61 72 73 29 29 29 chars) chars)))
8c60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8c70: 20 20 20 20 20 20 28 6c 69 73 74 0a 20 20 20 20 (list.
8c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8c90: 20 20 28 28 6c 61 6d 62 64 61 20 28 72 65 73 29 ((lambda (res)
8ca0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8cb0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 69 6e (if in
8cc0: 76 65 72 74 3f 20 28 63 6f 6e 73 20 27 7e 20 72 vert? (cons '~ r
8cd0: 65 73 29 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 es) (sre-alterna
8ce0: 74 65 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 te res))).
8cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d00: 20 28 61 70 70 65 6e 64 0a 20 20 20 20 20 20 20 (append.
8d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d20: 20 68 69 2d 63 68 61 72 73 0a 20 20 20 20 20 20 hi-chars.
8d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d40: 20 20 28 69 66 20 28 70 61 69 72 3f 20 63 68 61 (if (pair? cha
8d50: 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs).
8d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d70: 28 6c 69 73 74 0a 20 20 20 20 20 20 20 20 20 20 (list.
8d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8d90: 20 20 20 28 6c 69 73 74 20 28 6c 69 73 74 2d 3e (list (list->
8da0: 73 74 72 69 6e 67 0a 20 20 20 20 20 20 20 20 20 string.
8db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8dc0: 20 20 20 20 20 20 20 20 20 20 20 28 28 69 66 20 ((if
8dd0: 63 69 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 ci?.
8de0: 20 20 20 20 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 63 73 65 cse
8e00: 74 2d 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 t-case-insensiti
8e10: 76 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ve.
8e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e30: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
8e40: 62 64 61 20 28 78 29 20 78 29 29 0a 20 20 20 20 bda (x) x)).
8e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8e70: 20 28 72 65 76 65 72 73 65 20 63 68 61 72 73 29 (reverse chars)
8e80: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
8e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8ea0: 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 '()).
8eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
8ec0: 66 20 28 70 61 69 72 3f 20 72 61 6e 67 65 73 29 f (pair? ranges)
8ed0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
8ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
8ef0: 74 20 28 28 72 65 73 20 28 69 66 20 63 69 3f 0a t ((res (if ci?.
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 20 20 20 20 20 20 20 28 63 73 65 74 (cset
8f30: 2d 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 -case-insensitiv
8f40: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
8f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
8f70: 65 76 65 72 73 65 20 72 61 6e 67 65 73 29 29 0a everse ranges)).
8f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8f90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
8fa0: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 76 65 (reve
8fb0: 72 73 65 20 72 61 6e 67 65 73 29 29 29 29 0a 20 rse ranges)))).
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 20 20 28 6c 69 (li
8fe0: 73 74 20 28 63 6f 6e 73 20 27 2f 20 28 61 6c 69 st (cons '/ (ali
8ff0: 73 74 2d 3e 70 6c 69 73 74 20 72 65 73 29 29 29 st->plist res)))
9000: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 28 '(
9020: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
9030: 20 20 20 20 20 20 20 20 20 20 20 69 29 29 29 29 i))))
9040: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
9050: 28 23 5c 2d 29 0a 20 20 20 20 20 20 20 20 20 20 (#\-).
9060: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
9070: 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 ((or
9080: 28 3d 20 69 20 73 74 61 72 74 29 0a 20 20 20 20 (= i start).
9090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90a0: 20 28 61 6e 64 20 28 3d 20 69 20 28 2b 20 73 74 (and (= i (+ st
90b0: 61 72 74 20 31 29 29 20 28 65 71 76 3f 20 23 5c art 1)) (eqv? #\
90c0: 5e 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 ^ (string-ref st
90d0: 72 20 73 74 61 72 74 29 29 29 0a 20 20 20 20 20 r start))).
90e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
90f0: 28 65 71 76 3f 20 23 5c 5d 20 28 73 74 72 69 6e (eqv? #\] (strin
9100: 67 2d 72 65 66 20 73 74 72 20 28 2b 20 69 20 31 g-ref str (+ i 1
9110: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
9120: 20 20 20 20 20 20 28 67 6f 20 28 2b 20 69 20 31 (go (+ i 1
9130: 29 20 28 63 6f 6e 73 20 63 20 63 68 61 72 73 29 ) (cons c chars)
9140: 20 72 61 6e 67 65 73 29 29 0a 20 20 20 20 20 20 ranges)).
9150: 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c 6c ((null
9160: 3f 20 63 68 61 72 73 29 0a 20 20 20 20 20 20 20 ? chars).
9170: 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
9180: 20 22 62 61 64 20 63 68 61 72 2d 73 65 74 22 29 "bad char-set")
9190: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
91a0: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
91b0: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
91c0: 28 63 31 20 28 63 61 72 20 63 68 61 72 73 29 29 (c1 (car chars))
91d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
91e0: 20 20 20 20 20 20 20 20 20 28 63 32 20 28 73 74 (c2 (st
91f0: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 2b 20 ring-ref str (+
9200: 69 20 31 29 29 29 0a 20 20 20 20 20 20 20 20 20 i 1))).
9210: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
9220: 6c 65 6e 20 28 69 66 20 75 74 66 38 3f 20 28 75 len (if utf8? (u
9230: 74 66 38 2d 73 74 61 72 74 2d 63 68 61 72 2d 3e tf8-start-char->
9240: 6c 65 6e 67 74 68 20 63 32 29 20 31 29 29 0a 20 length c2) 1)).
9250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9260: 20 20 20 20 20 20 20 28 63 32 20 28 69 66 20 28 (c2 (if (
9270: 61 6e 64 20 75 74 66 38 3f 20 28 3c 3d 20 23 78 and utf8? (<= #x
9280: 38 30 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 80 (char->intege
9290: 72 20 63 32 29 20 23 78 46 46 29 29 0a 20 20 20 r c2) #xFF)).
92a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 75 74 (ut
92c0: 66 38 2d 73 74 72 69 6e 67 2d 72 65 66 20 73 74 f8-string-ref st
92d0: 72 20 28 2b 20 69 20 31 29 20 6c 65 6e 29 0a 20 r (+ i 1) len).
92e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
92f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
9300: 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 2))).
9310: 20 20 20 20 20 20 20 20 28 69 66 20 28 63 68 61 (if (cha
9320: 72 3c 3f 20 63 32 20 63 31 29 0a 20 20 20 20 20 r<? c2 c1).
9330: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9340: 20 20 28 65 72 72 6f 72 20 22 69 6e 76 65 72 74 (error "invert
9350: 65 64 20 72 61 6e 67 65 20 69 6e 20 63 68 61 72 ed range in char
9360: 2d 73 65 74 22 20 63 31 20 63 32 29 0a 20 20 20 -set" c1 c2).
9370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9380: 20 20 20 20 28 67 6f 20 28 2b 20 69 20 31 20 6c (go (+ i 1 l
9390: 65 6e 29 20 28 63 64 72 20 63 68 61 72 73 29 20 en) (cdr chars)
93a0: 28 63 6f 6e 73 20 28 63 6f 6e 73 20 63 31 20 63 (cons (cons c1 c
93b0: 32 29 20 72 61 6e 67 65 73 29 29 0a 20 20 20 20 2) ranges)).
93c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
93d0: 20 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 ))))).
93e0: 20 20 20 20 20 28 28 23 5c 5b 29 0a 20 20 20 20 ((#\[).
93f0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a (let*
9400: 20 28 28 69 6e 76 3f 20 28 65 71 76 3f 20 23 5c ((inv? (eqv? #\
9410: 5e 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 ^ (string-ref st
9420: 72 20 28 2b 20 69 20 31 29 29 29 29 0a 20 20 20 r (+ i 1)))).
9430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9440: 20 20 20 28 69 32 20 28 69 66 20 69 6e 76 3f 20 (i2 (if inv?
9450: 28 2b 20 69 20 32 29 20 28 2b 20 69 20 31 29 29 (+ i 2) (+ i 1))
9460: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
9470: 20 20 20 20 28 63 61 73 65 20 28 73 74 72 69 6e (case (strin
9480: 67 2d 72 65 66 20 73 74 72 20 69 32 29 0a 20 20 g-ref str i2).
9490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
94a0: 20 28 28 23 5c 3a 29 0a 20 20 20 20 20 20 20 20 ((#\:).
94b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
94c0: 20 28 28 6a 20 28 73 74 72 69 6e 67 2d 73 63 61 ((j (string-sca
94d0: 6e 2d 63 68 61 72 20 73 74 72 20 23 5c 3a 20 28 n-char str #\: (
94e0: 2b 20 69 32 20 31 29 29 29 29 0a 20 20 20 20 20 + i2 1)))).
94f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9500: 20 28 69 66 20 28 6f 72 20 28 6e 6f 74 20 6a 29 (if (or (not j)
9510: 20 28 6e 6f 74 20 28 65 71 76 3f 20 23 5c 5d 20 (not (eqv? #\]
9520: 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
9530: 28 2b 20 6a 20 31 29 29 29 29 29 0a 20 20 20 20 (+ j 1))))).
9540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9550: 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 69 6e (error "in
9560: 63 6f 6d 70 6c 65 74 65 20 63 68 61 72 61 63 74 complete charact
9570: 65 72 20 63 6c 61 73 73 22 20 73 74 72 29 0a 20 er class" str).
9580: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9590: 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
95a0: 28 63 73 65 74 20 28 73 72 65 2d 3e 63 73 65 74 (cset (sre->cset
95b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
95c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
95d0: 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
95e0: 2d 3e 73 79 6d 62 6f 6c 0a 20 20 20 20 20 20 20 ->symbol.
95f0: 20 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 20
9610: 20 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 72 (substring str
9620: 20 28 2b 20 69 32 20 31 29 20 6a 29 29 29 29 0a (+ i2 1) j)))).
9630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9650: 20 28 63 73 65 74 20 28 69 66 20 69 6e 76 3f 20 (cset (if inv?
9660: 28 63 73 65 74 2d 63 6f 6d 70 6c 65 6d 65 6e 74 (cset-complement
9670: 20 63 73 65 74 29 20 63 73 65 74 29 29 29 0a 20 cset) cset))).
9680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9690: 20 20 20 20 20 20 20 20 20 20 20 28 67 6f 20 28 (go (
96a0: 2b 20 6a 20 32 29 0a 20 20 20 20 20 20 20 20 20 + j 2).
96b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
96c0: 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 (append (
96d0: 66 69 6c 74 65 72 20 63 68 61 72 3f 20 63 73 65 filter char? cse
96e0: 74 29 20 63 68 61 72 73 29 0a 20 20 20 20 20 20 t) chars).
96f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9700: 20 20 20 20 20 20 20 20 20 20 28 61 70 70 65 6e (appen
9710: 64 20 28 66 69 6c 74 65 72 20 70 61 69 72 3f 20 d (filter pair?
9720: 63 73 65 74 29 20 72 61 6e 67 65 73 29 29 29 29 cset) ranges))))
9730: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
9740: 20 20 20 20 20 20 28 28 23 5c 3d 20 23 5c 2e 29 ((#\= #\.)
9750: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9760: 20 20 20 20 20 28 65 72 72 6f 72 20 22 63 6f 6c (error "col
9770: 6c 61 74 69 6e 67 20 73 65 71 75 65 6e 63 65 73 lating sequences
9780: 20 6e 6f 74 20 73 75 70 70 6f 72 74 65 64 22 20 not supported"
9790: 73 74 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 str)).
97a0: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
97b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
97c0: 20 20 20 28 65 72 72 6f 72 20 22 62 61 64 20 63 (error "bad c
97d0: 68 61 72 61 63 74 65 72 20 63 6c 61 73 73 22 20 haracter class"
97e0: 73 74 72 29 29 29 29 29 0a 20 20 20 20 20 20 20 str))))).
97f0: 20 20 20 20 20 20 20 28 28 23 5c 5c 29 0a 20 20 ((#\\).
9800: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
9810: 74 20 28 28 63 20 28 73 74 72 69 6e 67 2d 72 65 t ((c (string-re
9820: 66 20 73 74 72 20 28 2b 20 69 20 31 29 29 29 29 f str (+ i 1))))
9830: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
9840: 20 20 28 63 61 73 65 20 63 0a 20 20 20 20 20 20 (case c.
9850: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 23 ((#
9860: 5c 64 20 23 5c 44 20 23 5c 73 20 23 5c 53 20 23 \d #\D #\s #\S #
9870: 5c 77 20 23 5c 57 29 0a 20 20 20 20 20 20 20 20 \w #\W).
9880: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
9890: 20 28 28 63 73 65 74 20 28 73 72 65 2d 3e 63 73 ((cset (sre->cs
98a0: 65 74 20 28 73 74 72 69 6e 67 2d 3e 73 72 65 20 et (string->sre
98b0: 28 73 74 72 69 6e 67 20 23 5c 5c 20 63 29 29 29 (string #\\ c)))
98c0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
98d0: 20 20 20 20 20 20 20 20 20 28 67 6f 20 28 2b 20 (go (+
98e0: 69 20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 i 2).
98f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
9900: 61 70 70 65 6e 64 20 28 66 69 6c 74 65 72 20 63 append (filter c
9910: 68 61 72 3f 20 63 73 65 74 29 20 63 68 61 72 73 har? cset) chars
9920: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9930: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
9940: 65 6e 64 20 28 66 69 6c 74 65 72 20 70 61 69 72 end (filter pair
9950: 3f 20 63 73 65 74 29 20 72 61 6e 67 65 73 29 29 ? cset) ranges))
9960: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
9970: 20 20 20 20 20 20 28 28 23 5c 78 29 0a 20 20 20 ((#\x).
9980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9990: 20 28 61 70 70 6c 79 0a 20 20 20 20 20 20 20 20 (apply.
99a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
99b0: 6d 62 64 61 20 28 63 68 20 6a 29 0a 20 20 20 20 mbda (ch j).
99c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
99d0: 20 20 20 28 67 6f 20 28 2b 20 6a 20 31 29 20 28 (go (+ j 1) (
99e0: 63 6f 6e 73 20 63 68 20 63 68 61 72 73 29 20 72 cons ch chars) r
99f0: 61 6e 67 65 73 29 29 0a 20 20 20 20 20 20 20 20 anges)).
9a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
9a10: 72 69 6e 67 2d 70 61 72 73 65 2d 68 65 78 2d 65 ring-parse-hex-e
9a20: 73 63 61 70 65 20 73 74 72 20 28 2b 20 69 20 32 scape str (+ i 2
9a30: 29 20 65 6e 64 29 29 29 0a 20 20 20 20 20 20 20 ) end))).
9a40: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
9a50: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
9a60: 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 20 28 (let ((c (
9a70: 63 6f 6e 64 20 28 28 61 73 73 76 20 63 20 70 6f cond ((assv c po
9a80: 73 69 78 2d 65 73 63 61 70 65 2d 73 65 71 75 65 six-escape-seque
9a90: 6e 63 65 73 29 20 3d 3e 20 63 64 72 29 0a 20 20 nces) => cdr).
9aa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ac0: 20 28 65 6c 73 65 20 63 29 29 29 29 0a 20 20 20 (else c)))).
9ad0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ae0: 20 20 20 28 67 6f 20 28 2b 20 69 20 32 29 0a 20 (go (+ i 2).
9af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b00: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 (cons (
9b10: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 28 string-ref str (
9b20: 2b 20 69 20 31 29 29 20 28 63 6f 6e 73 20 63 20 + i 1)) (cons c
9b30: 63 68 61 72 73 29 29 0a 20 20 20 20 20 20 20 20 chars)).
9b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b50: 20 20 72 61 6e 67 65 73 29 29 29 29 29 29 0a 20 ranges)))))).
9b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
9b70: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
9b80: 20 20 28 69 66 20 28 61 6e 64 20 75 74 66 38 3f (if (and utf8?
9b90: 20 28 3c 3d 20 23 78 38 30 20 28 63 68 61 72 2d (<= #x80 (char-
9ba0: 3e 69 6e 74 65 67 65 72 20 63 29 20 23 78 46 46 >integer c) #xFF
9bb0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
9bc0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e (let ((len
9bd0: 20 28 75 74 66 38 2d 73 74 61 72 74 2d 63 68 61 (utf8-start-cha
9be0: 72 2d 3e 6c 65 6e 67 74 68 20 63 29 29 29 0a 20 r->length c))).
9bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9c00: 20 20 20 20 28 67 6f 20 28 2b 20 69 20 6c 65 6e (go (+ i len
9c10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
9c20: 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 (cons
9c30: 20 28 75 74 66 38 2d 73 74 72 69 6e 67 2d 72 65 (utf8-string-re
9c40: 66 20 73 74 72 20 69 20 6c 65 6e 29 20 63 68 61 f str i len) cha
9c50: 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs).
9c60: 20 20 20 20 20 20 20 20 20 20 20 20 20 72 61 6e ran
9c70: 67 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ges)).
9c80: 20 20 20 20 20 20 20 20 20 28 67 6f 20 28 2b 20 (go (+
9c90: 69 20 31 29 20 28 63 6f 6e 73 20 63 20 63 68 61 i 1) (cons c cha
9ca0: 72 73 29 20 72 61 6e 67 65 73 29 29 29 29 29 29 rs) ranges))))))
9cb0: 29 0a 20 20 20 20 28 69 66 20 69 6e 76 65 72 74 ). (if invert
9cc0: 3f 0a 20 20 20 20 20 20 20 20 28 67 6f 20 28 2b ?. (go (+
9cd0: 20 73 74 61 72 74 20 31 29 0a 20 20 20 20 20 20 start 1).
9ce0: 20 20 20 20 20 20 28 69 66 20 28 66 6c 61 67 2d (if (flag-
9cf0: 73 65 74 3f 20 66 6c 61 67 73 20 7e 6d 75 6c 74 set? flags ~mult
9d00: 69 2d 6c 69 6e 65 3f 29 20 27 28 23 5c 6e 65 77 i-line?) '(#\new
9d10: 6c 69 6e 65 29 20 27 28 29 29 0a 20 20 20 20 20 line) '()).
9d20: 20 20 20 20 20 20 20 27 28 29 29 0a 20 20 20 20 '()).
9d30: 20 20 20 20 28 67 6f 20 73 74 61 72 74 20 27 28 (go start '(
9d40: 29 20 27 28 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b ) '()))))..;;;;;
9d50: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
9d60: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
9d70: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
9d80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
9d90: 3b 3b 3b 0a 3b 3b 20 75 74 66 38 20 75 74 69 6c ;;;.;; utf8 util
9da0: 69 74 69 65 73 0a 0a 3b 3b 20 48 65 72 65 20 61 ities..;; Here a
9db0: 72 65 20 73 6f 6d 65 20 68 61 69 72 79 20 6f 70 re some hairy op
9dc0: 74 69 6d 69 7a 61 74 69 6f 6e 73 20 74 68 61 74 timizations that
9dd0: 20 6e 65 65 64 20 74 6f 20 62 65 20 64 6f 63 75 need to be docu
9de0: 6d 65 6e 74 65 64 0a 3b 3b 20 62 65 74 74 65 72 mented.;; better
9df0: 2e 20 20 54 68 61 6e 6b 73 20 74 6f 20 74 68 65 . Thanks to the
9e00: 73 65 2c 20 77 65 20 6e 65 76 65 72 20 64 6f 20 se, we never do
9e10: 61 6e 79 20 75 74 66 38 20 70 72 6f 63 65 73 73 any utf8 process
9e20: 69 6e 67 20 6f 6e 63 65 20 74 68 65 0a 3b 3b 20 ing once the.;;
9e30: 72 65 67 65 78 70 20 69 73 20 63 6f 6d 70 69 6c regexp is compil
9e40: 65 64 2e 0a 0a 3b 3b 20 74 77 6f 20 63 68 61 72 ed...;; two char
9e50: 73 3a 20 61 62 2e 2e 65 66 0a 3b 3b 20 20 20 20 s: ab..ef.;;
9e60: 20 20 20 20 20 20 20 20 61 5b 62 2e 2e 78 46 46 a[b..xFF
9e70: 5d 7c 5b 62 2d 64 5d 5b 78 38 30 2e 2e 78 46 46 ]|[b-d][x80..xFF
9e80: 5d 7c 65 5b 78 38 30 2e 2e 78 46 46 5d 0a 0a 3b ]|e[x80..xFF]..;
9e90: 3b 20 74 68 72 65 65 20 63 68 61 72 73 3a 20 61 ; three chars: a
9ea0: 62 63 2e 2e 67 68 69 0a 3b 3b 20 20 20 20 20 20 bc..ghi.;;
9eb0: 20 20 20 20 20 20 20 20 61 62 5b 63 2e 2e 78 46 ab[c..xF
9ec0: 46 5d 7c 61 5b 64 2e 2e 78 46 46 5d 5b 78 38 30 F]|a[d..xFF][x80
9ed0: 2e 2e 78 46 46 5d 7c 0a 3b 3b 20 20 20 20 20 20 ..xFF]|.;;
9ee0: 20 20 20 20 20 20 20 20 5b 62 2e 2e 66 5d 5b 78 [b..f][x
9ef0: 38 30 2e 2e 78 46 46 5d 5b 78 38 30 2e 2e 78 46 80..xFF][x80..xF
9f00: 46 5d 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 F]|.;;
9f10: 20 20 20 20 67 5b 78 38 30 2e 2e 67 5d 5b 78 38 g[x80..g][x8
9f20: 30 2e 2e 78 46 46 5d 7c 67 68 5b 78 38 30 2e 2e 0..xFF]|gh[x80..
9f30: 69 5d 0a 0a 3b 3b 20 66 6f 75 72 20 63 68 61 72 i]..;; four char
9f40: 73 3a 20 61 62 63 64 2e 2e 67 68 69 6a 0a 3b 3b s: abcd..ghij.;;
9f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 61 62 63 abc
9f60: 5b 64 2e 2e 78 46 46 5d 7c 61 62 5b 64 2e 2e 78 [d..xFF]|ab[d..x
9f70: 46 46 5d 5b 78 38 30 2e 2e 78 46 46 5d 7c 61 5b FF][x80..xFF]|a[
9f80: 63 2e 2e 78 46 46 5d 5b 78 38 30 2e 2e 78 46 46 c..xFF][x80..xFF
9f90: 5d 5b 78 38 30 2e 2e 78 46 46 5d 7c 0a 3b 3b 20 ][x80..xFF]|.;;
9fa0: 20 20 20 20 20 20 20 20 20 20 20 20 5b 62 2e 2e [b..
9fb0: 66 5d 5b 78 38 30 2e 2e 78 46 46 5d 5b 78 38 30 f][x80..xFF][x80
9fc0: 2e 2e 78 46 46 5d 5b 78 38 30 2e 2e 78 46 46 5d ..xFF][x80..xFF]
9fd0: 7c 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 |.;;
9fe0: 20 67 5b 78 38 30 2e 2e 67 5d 5b 78 38 30 2e 2e g[x80..g][x80..
9ff0: 78 46 46 5d 5b 78 38 30 2e 2e 78 46 46 5d 7c 67 xFF][x80..xFF]|g
a000: 68 5b 78 38 30 2e 2e 68 5d 5b 78 38 30 2e 2e 78 h[x80..h][x80..x
a010: 46 46 5d 7c 67 68 69 5b 78 38 30 2e 2e 6a 5d 0a FF]|ghi[x80..j].
a020: 0a 28 64 65 66 69 6e 65 20 28 68 69 67 68 2d 63 .(define (high-c
a030: 68 61 72 3f 20 63 29 20 28 3c 3d 20 23 78 38 30 har? c) (<= #x80
a040: 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
a050: 63 29 29 29 0a 0a 3b 3b 20 6e 75 6d 62 65 72 20 c)))..;; number
a060: 6f 66 20 74 6f 74 61 6c 20 62 79 74 65 73 20 69 of total bytes i
a070: 6e 20 61 20 75 74 66 38 20 63 68 61 72 20 67 69 n a utf8 char gi
a080: 76 65 6e 20 74 68 65 20 31 73 74 20 62 79 74 65 ven the 1st byte
a090: 0a 0a 28 64 65 66 69 6e 65 20 75 74 66 38 2d 73 ..(define utf8-s
a0a0: 74 61 72 74 2d 63 68 61 72 2d 3e 6c 65 6e 67 74 tart-char->lengt
a0b0: 68 0a 20 20 28 6c 65 74 20 28 28 74 61 62 6c 65 h. (let ((table
a0c0: 20 27 23 28 0a 31 20 31 20 31 20 31 20 31 20 31 '#(.1 1 1 1 1 1
a0d0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
a0e0: 20 31 20 31 20 3b 20 30 78 0a 31 20 31 20 31 20 1 1 ; 0x.1 1 1
a0f0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
a100: 31 20 31 20 31 20 31 20 31 20 3b 20 31 78 0a 31 1 1 1 1 1 ; 1x.1
a110: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
a120: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 3b 1 1 1 1 1 1 1 ;
a130: 20 32 78 0a 31 20 31 20 31 20 31 20 31 20 31 20 2x.1 1 1 1 1 1
a140: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
a150: 31 20 31 20 3b 20 33 78 0a 31 20 31 20 31 20 31 1 1 ; 3x.1 1 1 1
a160: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
a170: 20 31 20 31 20 31 20 31 20 3b 20 34 78 0a 31 20 1 1 1 1 ; 4x.1
a180: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
a190: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 3b 20 1 1 1 1 1 1 1 ;
a1a0: 35 78 0a 31 20 31 20 31 20 31 20 31 20 31 20 31 5x.1 1 1 1 1 1 1
a1b0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
a1c0: 20 31 20 3b 20 36 78 0a 31 20 31 20 31 20 31 20 1 ; 6x.1 1 1 1
a1d0: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
a1e0: 31 20 31 20 31 20 31 20 3b 20 37 78 0a 31 20 31 1 1 1 1 ; 7x.1 1
a1f0: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
a200: 20 31 20 31 20 31 20 31 20 31 20 31 20 3b 20 38 1 1 1 1 1 1 ; 8
a210: 78 0a 31 20 31 20 31 20 31 20 31 20 31 20 31 20 x.1 1 1 1 1 1 1
a220: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
a230: 31 20 3b 20 39 78 0a 31 20 31 20 31 20 31 20 31 1 ; 9x.1 1 1 1 1
a240: 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 1 1 1 1 1 1 1 1
a250: 20 31 20 31 20 31 20 3b 20 61 78 0a 31 20 31 20 1 1 1 ; ax.1 1
a260: 31 20 31 20 31 20 31 20 31 20 31 20 31 20 31 20 1 1 1 1 1 1 1 1
a270: 31 20 31 20 31 20 31 20 31 20 31 20 3b 20 62 78 1 1 1 1 1 1 ; bx
a280: 0a 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 .2 2 2 2 2 2 2 2
a290: 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 2 2 2 2 2 2 2 2
a2a0: 20 3b 20 63 78 0a 32 20 32 20 32 20 32 20 32 20 ; cx.2 2 2 2 2
a2b0: 32 20 32 20 32 20 32 20 32 20 32 20 32 20 32 20 2 2 2 2 2 2 2 2
a2c0: 32 20 32 20 32 20 3b 20 64 78 0a 33 20 33 20 33 2 2 2 ; dx.3 3 3
a2d0: 20 33 20 33 20 33 20 33 20 33 20 33 20 33 20 33 3 3 3 3 3 3 3 3
a2e0: 20 33 20 33 20 33 20 33 20 33 20 3b 20 65 78 0a 3 3 3 3 3 ; ex.
a2f0: 34 20 34 20 34 20 34 20 34 20 34 20 34 20 34 20 4 4 4 4 4 4 4 4
a300: 35 20 35 20 35 20 35 20 36 20 36 20 30 20 30 20 5 5 5 5 6 6 0 0
a310: 3b 20 66 78 0a 29 29 29 0a 20 20 20 20 28 6c 61 ; fx.))). (la
a320: 6d 62 64 61 20 28 63 29 20 28 76 65 63 74 6f 72 mbda (c) (vector
a330: 2d 72 65 66 20 74 61 62 6c 65 20 28 63 68 61 72 -ref table (char
a340: 2d 3e 69 6e 74 65 67 65 72 20 63 29 29 29 29 29 ->integer c)))))
a350: 0a 0a 28 64 65 66 69 6e 65 20 28 75 74 66 38 2d ..(define (utf8-
a360: 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 string-ref str i
a370: 20 6c 65 6e 29 20 73 74 72 29 0a 0a 28 64 65 66 len) str)..(def
a380: 69 6e 65 20 28 75 74 66 38 2d 62 61 63 6b 75 70 ine (utf8-backup
a390: 2d 74 6f 2d 69 6e 69 74 69 61 6c 2d 63 68 61 72 -to-initial-char
a3a0: 20 73 74 72 20 69 29 20 73 74 72 29 0a 0a 28 64 str i) str)..(d
a3b0: 65 66 69 6e 65 20 28 75 74 66 38 2d 6c 6f 77 65 efine (utf8-lowe
a3c0: 73 74 2d 64 69 67 69 74 2d 6f 66 2d 6c 65 6e 67 st-digit-of-leng
a3d0: 74 68 20 6c 65 6e 29 0a 20 20 28 63 61 73 65 20 th len). (case
a3e0: 6c 65 6e 0a 20 20 20 20 28 28 31 29 20 30 29 20 len. ((1) 0)
a3f0: 28 28 32 29 20 23 78 43 30 29 20 28 28 33 29 20 ((2) #xC0) ((3)
a400: 23 78 45 30 29 20 28 28 34 29 20 23 78 46 30 29 #xE0) ((4) #xF0)
a410: 0a 20 20 20 20 28 65 6c 73 65 20 28 65 72 72 6f . (else (erro
a420: 72 20 22 69 6e 76 61 6c 69 64 20 75 74 66 38 20 r "invalid utf8
a430: 6c 65 6e 67 74 68 22 20 6c 65 6e 29 29 29 29 0a length" len)))).
a440: 0a 28 64 65 66 69 6e 65 20 28 75 74 66 38 2d 68 .(define (utf8-h
a450: 69 67 68 65 73 74 2d 64 69 67 69 74 2d 6f 66 2d ighest-digit-of-
a460: 6c 65 6e 67 74 68 20 6c 65 6e 29 0a 20 20 28 63 length len). (c
a470: 61 73 65 20 6c 65 6e 0a 20 20 20 20 28 28 31 29 ase len. ((1)
a480: 20 23 78 37 46 29 20 28 28 32 29 20 23 78 44 46 #x7F) ((2) #xDF
a490: 29 20 28 28 33 29 20 23 78 45 46 29 20 28 28 34 ) ((3) #xEF) ((4
a4a0: 29 20 23 78 46 37 29 0a 20 20 20 20 28 65 6c 73 ) #xF7). (els
a4b0: 65 20 28 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 e (error "invali
a4c0: 64 20 75 74 66 38 20 6c 65 6e 67 74 68 22 20 6c d utf8 length" l
a4d0: 65 6e 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 en))))..(define
a4e0: 28 73 72 65 2d 61 64 6a 75 73 74 2d 75 74 66 38 (sre-adjust-utf8
a4f0: 20 73 72 65 20 66 6c 61 67 73 29 20 73 72 65 29 sre flags) sre)
a500: 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
a510: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
a520: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
a530: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
a540: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 63 6f ;;;;;;;;;;.;; co
a550: 6d 70 69 6c 61 74 69 6f 6e 0a 0a 28 64 65 66 69 mpilation..(defi
a560: 6e 65 20 28 69 72 72 65 67 65 78 20 78 20 2e 20 ne (irregex x .
a570: 6f 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 o). (cond. ((
a580: 69 72 72 65 67 65 78 3f 20 78 29 20 78 29 0a 20 irregex? x) x).
a590: 20 20 28 28 73 74 72 69 6e 67 3f 20 78 29 20 28 ((string? x) (
a5a0: 61 70 70 6c 79 20 73 74 72 69 6e 67 2d 3e 69 72 apply string->ir
a5b0: 72 65 67 65 78 20 78 20 6f 29 29 0a 20 20 20 28 regex x o)). (
a5c0: 65 6c 73 65 20 28 61 70 70 6c 79 20 73 72 65 2d else (apply sre-
a5d0: 3e 69 72 72 65 67 65 78 20 78 20 6f 29 29 29 29 >irregex x o))))
a5e0: 0a 0a 28 64 65 66 69 6e 65 20 28 73 74 72 69 6e ..(define (strin
a5f0: 67 2d 3e 69 72 72 65 67 65 78 20 73 74 72 20 2e g->irregex str .
a600: 20 6f 29 0a 20 20 28 61 70 70 6c 79 20 73 72 65 o). (apply sre
a610: 2d 3e 69 72 72 65 67 65 78 20 28 61 70 70 6c 79 ->irregex (apply
a620: 20 73 74 72 69 6e 67 2d 3e 73 72 65 20 73 74 72 string->sre str
a630: 20 6f 29 20 6f 29 29 0a 0a 28 64 65 66 69 6e 65 o) o))..(define
a640: 20 28 73 72 65 2d 3e 69 72 72 65 67 65 78 20 73 (sre->irregex s
a650: 72 65 20 2e 20 6f 29 0a 20 20 28 6c 65 74 2a 20 re . o). (let*
a660: 28 28 70 61 74 2d 66 6c 61 67 73 20 28 73 79 6d ((pat-flags (sym
a670: 62 6f 6c 2d 6c 69 73 74 2d 3e 66 6c 61 67 73 20 bol-list->flags
a680: 6f 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 72 o)). (sr
a690: 65 20 28 69 66 20 2a 61 6c 6c 6f 77 2d 75 74 66 e (if *allow-utf
a6a0: 38 2d 6d 6f 64 65 3f 2a 0a 20 20 20 20 20 20 20 8-mode?*.
a6b0: 20 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d (sre-
a6c0: 61 64 6a 75 73 74 2d 75 74 66 38 20 73 72 65 20 adjust-utf8 sre
a6d0: 70 61 74 2d 66 6c 61 67 73 29 0a 20 20 20 20 20 pat-flags).
a6e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 72 65 sre
a6f0: 29 29 0a 20 20 20 20 20 20 20 20 20 28 73 65 61 )). (sea
a700: 72 63 68 65 72 3f 20 28 73 72 65 2d 73 65 61 72 rcher? (sre-sear
a710: 63 68 65 72 3f 20 73 72 65 29 29 0a 20 20 20 20 cher? sre)).
a720: 20 20 20 20 20 28 73 72 65 2d 64 66 61 20 28 69 (sre-dfa (i
a730: 66 20 73 65 61 72 63 68 65 72 3f 20 28 73 72 65 f searcher? (sre
a740: 2d 72 65 6d 6f 76 65 2d 69 6e 69 74 69 61 6c 2d -remove-initial-
a750: 62 6f 73 20 73 72 65 29 20 73 72 65 29 29 0a 20 bos sre) sre)).
a760: 20 20 20 20 20 20 20 20 28 64 66 61 2d 6c 69 6d (dfa-lim
a770: 69 74 20 28 63 6f 6e 64 20 28 28 6d 65 6d 71 20 it (cond ((memq
a780: 27 73 6d 61 6c 6c 20 6f 29 20 31 29 20 28 28 6d 'small o) 1) ((m
a790: 65 6d 71 20 27 66 61 73 74 20 6f 29 20 35 30 29 emq 'fast o) 50)
a7a0: 20 28 65 6c 73 65 20 31 30 29 29 29 0a 20 20 20 (else 10))).
a7b0: 20 20 20 20 20 20 28 64 66 61 2f 73 65 61 72 63 (dfa/searc
a7c0: 68 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e h. (con
a7d0: 64 20 28 28 6d 65 6d 71 20 27 62 61 63 6b 74 72 d ((memq 'backtr
a7e0: 61 63 6b 20 6f 29 20 23 66 29 0a 20 20 20 20 20 ack o) #f).
a7f0: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 61 72 (sear
a800: 63 68 65 72 3f 20 23 74 29 0a 20 20 20 20 20 20 cher? #t).
a810: 20 20 20 20 20 20 20 20 20 20 28 28 73 72 65 2d ((sre-
a820: 3e 6e 66 61 20 60 28 73 65 71 20 28 2a 20 61 6e >nfa `(seq (* an
a830: 79 29 20 2c 73 72 65 2d 64 66 61 29 20 70 61 74 y) ,sre-dfa) pat
a840: 2d 66 6c 61 67 73 29 0a 20 20 20 20 20 20 20 20 -flags).
a850: 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 6d => (lam
a860: 62 64 61 20 28 6e 66 61 29 20 28 6e 66 61 2d 3e bda (nfa) (nfa->
a870: 64 66 61 20 6e 66 61 20 28 2a 20 64 66 61 2d 6c dfa nfa (* dfa-l
a880: 69 6d 69 74 20 28 6c 65 6e 67 74 68 20 6e 66 61 imit (length nfa
a890: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
a8a0: 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 (else #f))
a8b0: 29 0a 20 20 20 20 20 20 20 20 20 28 64 66 61 20 ). (dfa
a8c0: 28 63 6f 6e 64 20 28 28 61 6e 64 20 64 66 61 2f (cond ((and dfa/
a8d0: 73 65 61 72 63 68 20 28 73 72 65 2d 3e 6e 66 61 search (sre->nfa
a8e0: 20 73 72 65 2d 64 66 61 20 70 61 74 2d 66 6c 61 sre-dfa pat-fla
a8f0: 67 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 gs)).
a900: 20 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 => (la
a910: 6d 62 64 61 20 28 6e 66 61 29 20 28 6e 66 61 2d mbda (nfa) (nfa-
a920: 3e 64 66 61 20 6e 66 61 20 28 2a 20 64 66 61 2d >dfa nfa (* dfa-
a930: 6c 69 6d 69 74 20 28 6c 65 6e 67 74 68 20 6e 66 limit (length nf
a940: 61 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 a))))).
a950: 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 (else
a960: 20 23 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 #f))).
a970: 28 73 75 62 6d 61 74 63 68 65 73 20 28 73 72 65 (submatches (sre
a980: 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 68 65 -count-submatche
a990: 73 20 73 72 65 2d 64 66 61 29 29 0a 20 20 20 20 s sre-dfa)).
a9a0: 20 20 20 20 20 28 65 78 74 72 61 63 74 6f 72 0a (extractor.
a9b0: 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 64 (and d
a9c0: 66 61 20 64 66 61 2f 73 65 61 72 63 68 20 28 73 fa dfa/search (s
a9d0: 72 65 2d 6d 61 74 63 68 2d 65 78 74 72 61 63 74 re-match-extract
a9e0: 6f 72 20 73 72 65 2d 64 66 61 20 73 75 62 6d 61 or sre-dfa subma
a9f0: 74 63 68 65 73 29 29 29 0a 20 20 20 20 20 20 20 tches))).
aa00: 20 20 28 6e 61 6d 65 73 20 28 73 72 65 2d 6e 61 (names (sre-na
aa10: 6d 65 73 20 73 72 65 2d 64 66 61 20 31 20 27 28 mes sre-dfa 1 '(
aa20: 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 ))). (le
aa30: 6e 73 20 28 73 72 65 2d 6c 65 6e 67 74 68 2d 72 ns (sre-length-r
aa40: 61 6e 67 65 73 20 73 72 65 2d 64 66 61 20 6e 61 anges sre-dfa na
aa50: 6d 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 28 mes)). (
aa60: 66 6c 61 67 73 20 28 66 6c 61 67 2d 6a 6f 69 6e flags (flag-join
aa70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
aa80: 20 20 28 66 6c 61 67 2d 6a 6f 69 6e 20 7e 6e 6f (flag-join ~no
aa90: 6e 65 20 28 61 6e 64 20 73 65 61 72 63 68 65 72 ne (and searcher
aaa0: 3f 20 7e 73 65 61 72 63 68 65 72 3f 29 29 0a 20 ? ~searcher?)).
aab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aac0: 28 61 6e 64 20 28 73 72 65 2d 63 6f 6e 73 75 6d (and (sre-consum
aad0: 65 72 3f 20 73 72 65 29 20 7e 63 6f 6e 73 75 6d er? sre) ~consum
aae0: 65 72 3f 29 29 29 29 0a 20 20 20 20 28 63 6f 6e er?)))). (con
aaf0: 64 0a 20 20 20 20 20 28 64 66 61 0a 20 20 20 20 d. (dfa.
ab00: 20 20 28 6d 61 6b 65 2d 69 72 72 65 67 65 78 20 (make-irregex
ab10: 64 66 61 20 64 66 61 2f 73 65 61 72 63 68 20 65 dfa dfa/search e
ab20: 78 74 72 61 63 74 6f 72 20 23 66 20 66 6c 61 67 xtractor #f flag
ab30: 73 20 73 75 62 6d 61 74 63 68 65 73 20 6c 65 6e s submatches len
ab40: 73 20 6e 61 6d 65 73 29 29 0a 20 20 20 20 20 28 s names)). (
ab50: 65 6c 73 65 0a 20 20 20 20 20 20 28 6c 65 74 20 else. (let
ab60: 28 28 66 20 28 73 72 65 2d 3e 70 72 6f 63 65 64 ((f (sre->proced
ab70: 75 72 65 20 73 72 65 20 70 61 74 2d 66 6c 61 67 ure sre pat-flag
ab80: 73 20 6e 61 6d 65 73 29 29 29 0a 20 20 20 20 20 s names))).
ab90: 20 20 20 28 6d 61 6b 65 2d 69 72 72 65 67 65 78 (make-irregex
aba0: 20 23 66 20 23 66 20 23 66 20 66 20 66 6c 61 67 #f #f #f f flag
abb0: 73 20 73 75 62 6d 61 74 63 68 65 73 20 6c 65 6e s submatches len
abc0: 73 20 6e 61 6d 65 73 29 29 29 29 29 29 0a 0a 3b s names))))))..;
abd0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
abe0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
abf0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
ac00: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
ac10: 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 73 72 65 20 61 ;;;;;;;.;; sre a
ac20: 6e 61 6c 79 73 69 73 0a 0a 3b 3b 20 72 65 74 75 nalysis..;; retu
ac30: 72 6e 73 20 23 74 20 69 66 20 74 68 65 20 73 72 rns #t if the sr
ac40: 65 20 63 61 6e 20 65 76 65 72 20 62 65 20 65 6d e can ever be em
ac50: 70 74 79 0a 28 64 65 66 69 6e 65 20 28 73 72 65 pty.(define (sre
ac60: 2d 65 6d 70 74 79 3f 20 73 72 65 29 0a 20 20 28 -empty? sre). (
ac70: 69 66 20 28 70 61 69 72 3f 20 73 72 65 29 0a 20 if (pair? sre).
ac80: 20 20 20 20 20 28 63 61 73 65 20 28 63 61 72 20 (case (car
ac90: 73 72 65 29 0a 20 20 20 20 20 20 20 20 28 28 2a sre). ((*
aca0: 20 3f 20 6c 6f 6f 6b 2d 61 68 65 61 64 20 6c 6f ? look-ahead lo
acb0: 6f 6b 2d 62 65 68 69 6e 64 20 6e 65 67 2d 6c 6f ok-behind neg-lo
acc0: 6f 6b 2d 61 68 65 61 64 20 6e 65 67 2d 6c 6f 6f ok-ahead neg-loo
acd0: 6b 2d 62 65 68 69 6e 64 29 20 23 74 29 0a 20 20 k-behind) #t).
ace0: 20 20 20 20 20 20 28 28 2a 2a 29 20 28 6f 72 20 ((**) (or
acf0: 28 6e 6f 74 20 28 6e 75 6d 62 65 72 3f 20 28 63 (not (number? (c
ad00: 61 64 72 20 73 72 65 29 29 29 20 28 7a 65 72 6f adr sre))) (zero
ad10: 3f 20 28 63 61 64 72 20 73 72 65 29 29 29 29 0a ? (cadr sre)))).
ad20: 20 20 20 20 20 20 20 20 28 28 6f 72 29 20 28 61 ((or) (a
ad30: 6e 79 20 73 72 65 2d 65 6d 70 74 79 3f 20 28 63 ny sre-empty? (c
ad40: 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 dr sre))).
ad50: 20 20 28 28 3a 20 73 65 71 20 24 20 73 75 62 6d ((: seq $ subm
ad60: 61 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 atch => submatch
ad70: 2d 6e 61 6d 65 64 20 2b 20 61 74 6f 6d 69 63 29 -named + atomic)
ad80: 0a 20 20 20 20 20 20 20 20 20 28 65 76 65 72 79 . (every
ad90: 20 73 72 65 2d 65 6d 70 74 79 3f 20 28 63 64 72 sre-empty? (cdr
ada0: 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 sre))).
adb0: 28 65 6c 73 65 20 23 66 29 29 0a 20 20 20 20 20 (else #f)).
adc0: 20 28 6d 65 6d 71 20 73 72 65 20 27 28 65 70 73 (memq sre '(eps
add0: 69 6c 6f 6e 20 62 6f 73 20 65 6f 73 20 62 6f 6c ilon bos eos bol
ade0: 20 65 6f 6c 20 62 6f 77 20 65 6f 77 20 63 6f 6d eol bow eow com
adf0: 6d 69 74 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 mit))))..(define
ae00: 20 28 73 72 65 2d 61 6e 79 3f 20 73 72 65 29 0a (sre-any? sre).
ae10: 20 20 28 6f 72 20 28 65 71 3f 20 73 72 65 20 27 (or (eq? sre '
ae20: 61 6e 79 29 0a 20 20 20 20 20 20 28 61 6e 64 20 any). (and
ae30: 28 70 61 69 72 3f 20 73 72 65 29 0a 20 20 20 20 (pair? sre).
ae40: 20 20 20 20 20 20 20 28 63 61 73 65 20 28 63 61 (case (ca
ae50: 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 r sre).
ae60: 20 20 20 20 28 28 73 65 71 20 3a 20 24 20 73 75 ((seq : $ su
ae70: 62 6d 61 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 bmatch => submat
ae80: 63 68 2d 6e 61 6d 65 64 29 0a 20 20 20 20 20 20 ch-named).
ae90: 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 70 61 (and (pa
aea0: 69 72 3f 20 28 63 64 72 20 73 72 65 29 29 20 28 ir? (cdr sre)) (
aeb0: 6e 75 6c 6c 3f 20 28 63 64 64 72 20 73 72 65 29 null? (cddr sre)
aec0: 29 20 28 73 72 65 2d 61 6e 79 3f 20 28 63 61 64 ) (sre-any? (cad
aed0: 72 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 r sre)))).
aee0: 20 20 20 20 20 20 20 28 28 6f 72 29 20 28 65 76 ((or) (ev
aef0: 65 72 79 20 73 72 65 2d 61 6e 79 3f 20 28 63 64 ery sre-any? (cd
af00: 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 r sre))).
af10: 20 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 (else #f))
af20: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 72 )))..(define (sr
af30: 65 2d 72 65 70 65 61 74 65 72 3f 20 73 72 65 29 e-repeater? sre)
af40: 0a 20 20 28 61 6e 64 20 28 70 61 69 72 3f 20 73 . (and (pair? s
af50: 72 65 29 0a 20 20 20 20 20 20 20 28 6f 72 20 28 re). (or (
af60: 6d 65 6d 71 20 28 63 61 72 20 73 72 65 29 20 27 memq (car sre) '
af70: 28 2a 20 2b 29 29 0a 20 20 20 20 20 20 20 20 20 (* +)).
af80: 20 20 28 61 6e 64 20 28 6d 65 6d 71 20 28 63 61 (and (memq (ca
af90: 72 20 73 72 65 29 20 27 28 24 20 73 75 62 6d 61 r sre) '($ subma
afa0: 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 2d tch => submatch-
afb0: 6e 61 6d 65 64 20 73 65 71 20 3a 29 29 0a 20 20 named seq :)).
afc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70 (p
afd0: 61 69 72 3f 20 28 63 64 72 20 73 72 65 29 29 0a air? (cdr sre)).
afe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
aff0: 28 6e 75 6c 6c 3f 20 28 63 64 64 72 20 73 72 65 (null? (cddr sre
b000: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
b010: 20 20 20 28 73 72 65 2d 72 65 70 65 61 74 65 72 (sre-repeater
b020: 3f 20 28 63 61 64 72 20 73 72 65 29 29 29 29 29 ? (cadr sre)))))
b030: 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d )..(define (sre-
b040: 73 65 61 72 63 68 65 72 3f 20 73 72 65 29 0a 20 searcher? sre).
b050: 20 28 69 66 20 28 70 61 69 72 3f 20 73 72 65 29 (if (pair? sre)
b060: 0a 20 20 20 20 20 20 28 63 61 73 65 20 28 63 61 . (case (ca
b070: 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 28 r sre). (
b080: 28 2a 20 2b 29 20 28 73 72 65 2d 61 6e 79 3f 20 (* +) (sre-any?
b090: 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 (sre-sequence (c
b0a0: 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 dr sre)))).
b0b0: 20 20 20 28 28 73 65 71 20 3a 20 24 20 73 75 62 ((seq : $ sub
b0c0: 6d 61 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 match => submatc
b0d0: 68 2d 6e 61 6d 65 64 29 0a 20 20 20 20 20 20 20 h-named).
b0e0: 20 20 28 61 6e 64 20 28 70 61 69 72 3f 20 28 63 (and (pair? (c
b0f0: 64 72 20 73 72 65 29 29 20 28 73 72 65 2d 73 65 dr sre)) (sre-se
b100: 61 72 63 68 65 72 3f 20 28 63 61 64 72 20 73 72 archer? (cadr sr
b110: 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 e)))). ((
b120: 6f 72 29 20 28 65 76 65 72 79 20 73 72 65 2d 73 or) (every sre-s
b130: 65 61 72 63 68 65 72 3f 20 28 63 64 72 20 73 72 earcher? (cdr sr
b140: 65 29 29 29 0a 20 20 20 20 20 20 20 20 28 65 6c e))). (el
b150: 73 65 20 23 66 29 29 0a 20 20 20 20 20 20 28 65 se #f)). (e
b160: 71 3f 20 27 62 6f 73 20 73 72 65 29 29 29 0a 0a q? 'bos sre)))..
b170: 28 64 65 66 69 6e 65 20 28 73 72 65 2d 63 6f 6e (define (sre-con
b180: 73 75 6d 65 72 3f 20 73 72 65 29 0a 20 20 28 69 sumer? sre). (i
b190: 66 20 28 70 61 69 72 3f 20 73 72 65 29 0a 20 20 f (pair? sre).
b1a0: 20 20 20 20 28 63 61 73 65 20 28 63 61 72 20 73 (case (car s
b1b0: 72 65 29 0a 20 20 20 20 20 20 20 20 28 28 2a 20 re). ((*
b1c0: 2b 29 20 28 73 72 65 2d 61 6e 79 3f 20 28 73 72 +) (sre-any? (sr
b1d0: 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 72 20 e-sequence (cdr
b1e0: 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
b1f0: 28 28 73 65 71 20 3a 20 24 20 73 75 62 6d 61 74 ((seq : $ submat
b200: 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e ch => submatch-n
b210: 61 6d 65 64 29 0a 20 20 20 20 20 20 20 20 20 28 amed). (
b220: 61 6e 64 20 28 70 61 69 72 3f 20 28 63 64 72 20 and (pair? (cdr
b230: 73 72 65 29 29 20 28 73 72 65 2d 63 6f 6e 73 75 sre)) (sre-consu
b240: 6d 65 72 3f 20 28 6c 61 73 74 20 73 72 65 29 29 mer? (last sre))
b250: 29 29 0a 20 20 20 20 20 20 20 20 28 28 6f 72 29 )). ((or)
b260: 20 28 65 76 65 72 79 20 73 72 65 2d 63 6f 6e 73 (every sre-cons
b270: 75 6d 65 72 3f 20 28 63 64 72 20 73 72 65 29 29 umer? (cdr sre))
b280: 29 0a 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 ). (else
b290: 23 66 29 29 0a 20 20 20 20 20 20 28 65 71 3f 20 #f)). (eq?
b2a0: 27 65 6f 73 20 73 72 65 29 29 29 0a 0a 28 64 65 'eos sre)))..(de
b2b0: 66 69 6e 65 20 28 73 72 65 2d 68 61 73 2d 73 75 fine (sre-has-su
b2c0: 62 6d 61 74 63 68 65 73 3f 20 73 72 65 29 0a 20 bmatches? sre).
b2d0: 20 28 61 6e 64 20 28 70 61 69 72 3f 20 73 72 65 (and (pair? sre
b2e0: 29 0a 20 20 20 20 20 20 20 28 6f 72 20 28 6d 65 ). (or (me
b2f0: 6d 71 20 28 63 61 72 20 73 72 65 29 20 27 28 24 mq (car sre) '($
b300: 20 73 75 62 6d 61 74 63 68 20 3d 3e 20 73 75 62 submatch => sub
b310: 6d 61 74 63 68 2d 6e 61 6d 65 64 29 29 0a 20 20 match-named)).
b320: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 71 (if (eq
b330: 3f 20 27 70 6f 73 69 78 2d 73 74 72 69 6e 67 20 ? 'posix-string
b340: 28 63 61 72 20 73 72 65 29 29 0a 20 20 20 20 20 (car sre)).
b350: 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 68 (sre-h
b360: 61 73 2d 73 75 62 6d 61 74 63 68 65 73 3f 20 28 as-submatches? (
b370: 73 74 72 69 6e 67 2d 3e 73 72 65 20 28 63 61 64 string->sre (cad
b380: 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 r sre))).
b390: 20 20 20 20 20 20 20 20 28 61 6e 79 20 73 72 65 (any sre
b3a0: 2d 68 61 73 2d 73 75 62 6d 61 74 63 68 65 73 3f -has-submatches?
b3b0: 20 28 63 64 72 20 73 72 65 29 29 29 29 29 29 0a (cdr sre)))))).
b3c0: 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d 63 6f .(define (sre-co
b3d0: 75 6e 74 2d 73 75 62 6d 61 74 63 68 65 73 20 73 unt-submatches s
b3e0: 72 65 29 0a 20 20 28 6c 65 74 20 63 6f 75 6e 74 re). (let count
b3f0: 20 28 28 73 72 65 20 73 72 65 29 20 28 73 75 6d ((sre sre) (sum
b400: 20 30 29 29 0a 20 20 20 20 28 69 66 20 28 70 61 0)). (if (pa
b410: 69 72 3f 20 73 72 65 29 0a 20 20 20 20 20 20 20 ir? sre).
b420: 20 28 66 6f 6c 64 20 63 6f 75 6e 74 0a 20 20 20 (fold count.
b430: 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 73 75 (+ su
b440: 6d 20 28 63 61 73 65 20 28 63 61 72 20 73 72 65 m (case (car sre
b450: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b460: 20 20 20 20 20 20 20 20 20 28 28 24 20 73 75 62 (($ sub
b470: 6d 61 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 match => submatc
b480: 68 2d 6e 61 6d 65 64 29 20 31 29 0a 20 20 20 20 h-named) 1).
b490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b4a0: 20 20 20 28 28 64 73 6d 29 20 28 2b 20 28 63 61 ((dsm) (+ (ca
b4b0: 64 72 20 73 72 65 29 20 28 63 61 64 64 72 20 73 dr sre) (caddr s
b4c0: 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 re))).
b4d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 ((p
b4e0: 6f 73 69 78 2d 73 74 72 69 6e 67 29 0a 20 20 20 osix-string).
b4f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b500: 20 20 20 20 20 28 73 72 65 2d 63 6f 75 6e 74 2d (sre-count-
b510: 73 75 62 6d 61 74 63 68 65 73 20 28 73 74 72 69 submatches (stri
b520: 6e 67 2d 3e 73 72 65 20 28 63 61 64 72 20 73 72 ng->sre (cadr sr
b530: 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 e)))).
b540: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
b550: 73 65 20 30 29 29 29 0a 20 20 20 20 20 20 20 20 se 0))).
b560: 20 20 20 20 20 20 28 63 64 72 20 73 72 65 29 29 (cdr sre))
b570: 0a 20 20 20 20 20 20 20 20 73 75 6d 29 29 29 0a . sum))).
b580: 0a 28 64 65 66 69 6e 65 20 28 73 72 65 2d 6c 65 .(define (sre-le
b590: 6e 67 74 68 2d 72 61 6e 67 65 73 20 73 72 65 20 ngth-ranges sre
b5a0: 2e 20 6f 29 0a 20 20 28 6c 65 74 20 28 28 6e 61 . o). (let ((na
b5b0: 6d 65 73 20 28 69 66 20 28 70 61 69 72 3f 20 6f mes (if (pair? o
b5c0: 29 20 28 63 61 72 20 6f 29 20 28 73 72 65 2d 6e ) (car o) (sre-n
b5d0: 61 6d 65 73 20 73 72 65 20 31 20 27 28 29 29 29 ames sre 1 '()))
b5e0: 29 0a 20 20 20 20 20 20 20 20 28 73 75 62 6c 65 ). (suble
b5f0: 6e 73 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 ns (make-vector
b600: 28 2b 20 31 20 28 73 72 65 2d 63 6f 75 6e 74 2d (+ 1 (sre-count-
b610: 73 75 62 6d 61 74 63 68 65 73 20 73 72 65 29 29 submatches sre))
b620: 20 23 66 29 29 29 0a 20 20 20 20 28 76 65 63 74 #f))). (vect
b630: 6f 72 2d 73 65 74 21 0a 20 20 20 20 20 73 75 62 or-set!. sub
b640: 6c 65 6e 73 0a 20 20 20 20 20 30 0a 20 20 20 20 lens. 0.
b650: 20 28 6c 65 74 20 6c 70 20 28 28 73 72 65 20 73 (let lp ((sre s
b660: 72 65 29 20 28 6e 20 31 29 20 28 6c 6f 20 30 29 re) (n 1) (lo 0)
b670: 20 28 68 69 20 30 29 20 28 72 65 74 75 72 6e 20 (hi 0) (return
b680: 63 6f 6e 73 29 29 0a 20 20 20 20 20 20 20 28 64 cons)). (d
b690: 65 66 69 6e 65 20 28 67 72 6f 77 20 69 29 20 28 efine (grow i) (
b6a0: 72 65 74 75 72 6e 20 28 2b 20 6c 6f 20 69 29 20 return (+ lo i)
b6b0: 28 61 6e 64 20 68 69 20 28 2b 20 68 69 20 69 29 (and hi (+ hi i)
b6c0: 29 29 29 0a 20 20 20 20 20 20 20 28 63 6f 6e 64 ))). (cond
b6d0: 0a 20 20 20 20 20 20 20 20 28 28 70 61 69 72 3f . ((pair?
b6e0: 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 28 sre). (
b6f0: 69 66 20 28 73 74 72 69 6e 67 3f 20 28 63 61 72 if (string? (car
b700: 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
b710: 20 20 20 20 28 67 72 6f 77 20 31 29 0a 20 20 20 (grow 1).
b720: 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 20 (case
b730: 28 63 61 72 20 73 72 65 29 0a 20 20 20 20 20 20 (car sre).
b740: 20 20 20 20 20 20 20 20 20 28 28 2f 20 7e 20 26 ((/ ~ &
b750: 20 2d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 -).
b760: 20 20 20 20 28 67 72 6f 77 20 31 29 29 0a 20 20 (grow 1)).
b770: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 ((p
b780: 6f 73 69 78 2d 73 74 72 69 6e 67 29 0a 20 20 20 osix-string).
b790: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
b7a0: 20 28 73 74 72 69 6e 67 2d 3e 73 72 65 20 28 63 (string->sre (c
b7b0: 61 64 72 20 73 72 65 29 29 20 6e 20 6c 6f 20 68 adr sre)) n lo h
b7c0: 69 20 72 65 74 75 72 6e 29 29 0a 20 20 20 20 20 i return)).
b7d0: 20 20 20 20 20 20 20 20 20 20 28 28 73 65 71 20 ((seq
b7e0: 3a 20 77 2f 63 61 73 65 20 77 2f 6e 6f 63 61 73 : w/case w/nocas
b7f0: 65 20 61 74 6f 6d 69 63 29 0a 20 20 20 20 20 20 e atomic).
b800: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c (let l
b810: 70 32 20 28 28 6c 73 20 28 63 64 72 20 73 72 65 p2 ((ls (cdr sre
b820: 29 29 20 28 6e 20 6e 29 20 28 6c 6f 32 20 30 29 )) (n n) (lo2 0)
b830: 20 28 68 69 32 20 30 29 29 0a 20 20 20 20 20 20 (hi2 0)).
b840: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
b850: 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 (null? ls).
b860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b870: 20 28 72 65 74 75 72 6e 20 28 2b 20 6c 6f 20 6c (return (+ lo l
b880: 6f 32 29 20 28 61 6e 64 20 68 69 20 68 69 32 20 o2) (and hi hi2
b890: 28 2b 20 68 69 20 68 69 32 29 29 29 0a 20 20 20 (+ hi hi2))).
b8a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8b0: 20 20 20 28 6c 70 20 28 63 61 72 20 6c 73 29 20 (lp (car ls)
b8c0: 6e 20 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 n 0 0.
b8d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b8e0: 28 6c 61 6d 62 64 61 20 28 6c 6f 33 20 68 69 33 (lambda (lo3 hi3
b8f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
b900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
b910: 70 32 20 28 63 64 72 20 6c 73 29 0a 20 20 20 20 p2 (cdr ls).
b920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b930: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 (+
b940: 6e 20 28 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 n (sre-count-sub
b950: 6d 61 74 63 68 65 73 20 28 63 61 72 20 6c 73 29 matches (car ls)
b960: 29 29 0a 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 28 2b 20 6c 6f 32 20 6c 6f 33 29 0a (+ lo2 lo3).
b990: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
b9b0: 20 28 61 6e 64 20 68 69 32 20 68 69 33 20 28 2b (and hi2 hi3 (+
b9c0: 20 68 69 32 20 68 69 33 29 29 29 29 29 29 29 29 hi2 hi3))))))))
b9d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
b9e0: 28 28 6f 72 29 0a 20 20 20 20 20 20 20 20 20 20 ((or).
b9f0: 20 20 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 (let lp2 (
ba00: 28 6c 73 20 28 63 64 72 20 73 72 65 29 29 20 28 (ls (cdr sre)) (
ba10: 6e 20 6e 29 20 28 6c 6f 32 20 23 66 29 20 28 68 n n) (lo2 #f) (h
ba20: 69 32 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 i2 0)).
ba30: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
ba40: 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 ll? ls).
ba50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 (r
ba60: 65 74 75 72 6e 20 28 2b 20 6c 6f 20 6c 6f 32 29 eturn (+ lo lo2)
ba70: 20 28 61 6e 64 20 68 69 20 68 69 32 20 28 2b 20 (and hi hi2 (+
ba80: 68 69 20 68 69 32 29 29 29 0a 20 20 20 20 20 20 hi hi2))).
ba90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
baa0: 28 6c 70 20 28 63 61 72 20 6c 73 29 20 6e 20 30 (lp (car ls) n 0
bab0: 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
bac0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
bad0: 6d 62 64 61 20 28 6c 6f 33 20 68 69 33 29 0a 20 mbda (lo3 hi3).
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 20 20 20 28 6c 70 32 20 (lp2
bb00: 28 63 64 72 20 6c 73 29 0a 20 20 20 20 20 20 20 (cdr ls).
bb10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb20: 20 20 20 20 20 20 20 20 20 20 28 2b 20 6e 20 28 (+ n (
bb30: 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 sre-count-submat
bb40: 63 68 65 73 20 28 63 61 72 20 6c 73 29 29 29 0a ches (car ls))).
bb50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bb70: 20 28 69 66 20 6c 6f 32 20 28 6d 69 6e 20 6c 6f (if lo2 (min lo
bb80: 32 20 6c 6f 33 29 20 6c 6f 33 29 0a 20 20 20 20 2 lo3) lo3).
bb90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bba0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
bbb0: 64 20 68 69 32 20 68 69 33 20 28 6d 61 78 20 68 d hi2 hi3 (max h
bbc0: 69 32 20 68 69 33 29 29 29 29 29 29 29 29 0a 20 i2 hi3)))))))).
bbd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
bbe0: 69 66 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 if).
bbf0: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
bc00: 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 ((or
bc10: 28 6e 75 6c 6c 3f 20 28 63 64 72 20 73 72 65 29 (null? (cdr sre)
bc20: 29 20 28 6e 75 6c 6c 3f 20 28 63 64 64 72 20 73 ) (null? (cddr s
bc30: 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 re))).
bc40: 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 (return
bc50: 6c 6f 20 68 69 29 29 0a 20 20 20 20 20 20 20 20 lo hi)).
bc60: 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 (else.
bc70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bc80: 20 28 6c 65 74 20 28 28 6e 31 20 28 73 72 65 2d (let ((n1 (sre-
bc90: 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 68 65 73 count-submatches
bca0: 20 28 63 61 72 20 73 72 65 29 29 29 0a 20 20 20 (car sre))).
bcb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bcc0: 20 20 20 20 20 28 6e 32 20 28 73 72 65 2d 63 6f (n2 (sre-co
bcd0: 75 6e 74 2d 73 75 62 6d 61 74 63 68 65 73 20 28 unt-submatches (
bce0: 63 61 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 cadr sre)))).
bcf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd00: 20 28 6c 70 20 28 69 66 20 28 6f 72 20 28 6e 75 (lp (if (or (nu
bd10: 6d 62 65 72 3f 20 28 63 61 64 72 20 73 72 65 29 mber? (cadr sre)
bd20: 29 20 28 73 79 6d 62 6f 6c 3f 20 28 63 61 64 72 ) (symbol? (cadr
bd30: 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 sre))).
bd40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd50: 20 20 20 20 27 65 70 73 69 6c 6f 6e 0a 20 20 20 'epsilon.
bd60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bd70: 20 20 20 20 20 20 20 20 20 28 63 61 64 72 20 73 (cadr s
bd80: 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 re)).
bd90: 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 20 6c n l
bda0: 6f 20 68 69 0a 20 20 20 20 20 20 20 20 20 20 20 o hi.
bdb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
bdc0: 6d 62 64 61 20 28 6c 6f 32 20 68 69 32 29 0a 20 mbda (lo2 hi2).
bdd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bde0: 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 61 (lp (ca
bdf0: 64 64 72 20 73 72 65 29 20 28 2b 20 6e 20 6e 31 ddr sre) (+ n n1
be00: 29 20 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 ) 0 0.
be10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be20: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 6f 33 (lambda (lo3
be30: 20 68 69 33 29 0a 20 20 20 20 20 20 20 20 20 20 hi3).
be40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be50: 20 20 20 20 20 20 28 6c 70 20 28 69 66 20 28 70 (lp (if (p
be60: 61 69 72 3f 20 28 63 64 64 64 72 20 73 72 65 29 air? (cdddr sre)
be70: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
be80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
be90: 20 20 20 20 20 20 20 20 20 20 28 63 61 64 64 64 (caddd
bea0: 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 r sre).
beb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27 '
bed0: 65 70 73 69 6c 6f 6e 29 0a 20 20 20 20 20 20 20 epsilon).
bee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 (+
bf00: 6e 20 6e 31 20 6e 32 29 20 30 20 30 0a 20 20 20 n n1 n2) 0 0.
bf10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf30: 20 28 6c 61 6d 62 64 61 20 28 6c 6f 34 20 68 69 (lambda (lo4 hi
bf40: 34 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 4).
bf50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bf60: 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e (return
bf70: 20 28 2b 20 6c 6f 32 20 28 6d 69 6e 20 6c 6f 33 (+ lo2 (min lo3
bf80: 20 6c 6f 34 29 29 0a 20 20 20 20 20 20 20 20 20 lo4)).
bf90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfb0: 20 20 20 20 20 28 61 6e 64 20 68 69 32 20 68 69 (and hi2 hi
bfc0: 33 20 68 69 34 0a 20 20 20 20 20 20 20 20 20 20 3 hi4.
bfd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bfe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
bff0: 20 20 20 20 20 20 20 20 20 28 2b 20 68 69 32 20 (+ hi2
c000: 28 6d 61 78 20 68 69 33 20 68 69 34 29 29 0a 20 (max hi3 hi4)).
c010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c040: 20 20 29 29 29 29 29 29 29 29 29 29 29 29 0a 20 )))))))))))).
c050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
c060: 64 73 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 dsm).
c070: 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d 73 65 (lp (sre-se
c080: 71 75 65 6e 63 65 20 28 63 64 64 64 72 20 73 72 quence (cdddr sr
c090: 65 29 29 20 28 2b 20 6e 20 28 63 61 64 72 20 73 e)) (+ n (cadr s
c0a0: 72 65 29 29 20 6c 6f 20 68 69 20 72 65 74 75 72 re)) lo hi retur
c0b0: 6e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 n)).
c0c0: 20 20 20 28 28 24 20 73 75 62 6d 61 74 63 68 20 (($ submatch
c0d0: 3d 3e 20 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 => submatch-name
c0e0: 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
c0f0: 20 20 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 (lp (sre-sequ
c100: 65 6e 63 65 0a 20 20 20 20 20 20 20 20 20 20 20 ence.
c110: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 (if (e
c120: 71 3f 20 27 73 75 62 6d 61 74 63 68 20 28 63 61 q? 'submatch (ca
c130: 72 20 73 72 65 29 29 20 28 63 64 72 20 73 72 65 r sre)) (cdr sre
c140: 29 20 28 63 64 64 72 20 73 72 65 29 29 29 0a 20 ) (cddr sre))).
c150: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c160: 20 20 20 28 2b 20 6e 20 31 29 20 6c 6f 20 68 69 (+ n 1) lo hi
c170: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c180: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 6f (lambda (lo
c190: 32 20 68 69 32 29 0a 20 20 20 20 20 20 20 20 20 2 hi2).
c1a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
c1b0: 63 74 6f 72 2d 73 65 74 21 20 73 75 62 6c 65 6e ctor-set! sublen
c1c0: 73 20 6e 20 28 63 6f 6e 73 20 6c 6f 32 20 68 69 s n (cons lo2 hi
c1d0: 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 2)).
c1e0: 20 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 (retur
c1f0: 6e 20 6c 6f 32 20 68 69 32 29 29 29 29 0a 20 20 n lo2 hi2)))).
c200: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 62 ((b
c210: 61 63 6b 72 65 66 20 62 61 63 6b 72 65 66 2d 63 ackref backref-c
c220: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
c230: 20 20 20 28 6c 65 74 20 28 28 6e 20 28 63 6f 6e (let ((n (con
c240: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
c250: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 75 ((nu
c260: 6d 62 65 72 3f 20 28 63 61 64 72 20 73 72 65 29 mber? (cadr sre)
c270: 29 20 28 63 61 64 72 20 73 72 65 29 29 0a 20 20 ) (cadr sre)).
c280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c290: 20 20 20 20 20 20 20 20 28 28 61 73 73 71 20 28 ((assq (
c2a0: 63 61 64 72 20 73 72 65 29 20 6e 61 6d 65 73 29 cadr sre) names)
c2b0: 20 3d 3e 20 63 64 72 29 0a 20 20 20 20 20 20 20 => cdr).
c2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c2d0: 20 20 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 (else (error
c2e0: 22 75 6e 6b 6e 6f 77 6e 20 62 61 63 6b 72 65 66 "unknown backref
c2f0: 65 72 65 6e 63 65 22 20 28 63 61 64 72 20 73 72 erence" (cadr sr
c300: 65 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 e)))))).
c310: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
c320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c330: 20 20 20 28 28 6f 72 20 28 6e 6f 74 20 28 69 6e ((or (not (in
c340: 74 65 67 65 72 3f 20 6e 29 29 0a 20 20 20 20 20 teger? n)).
c350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c360: 20 20 20 28 6e 6f 74 20 28 3c 20 30 20 6e 20 28 (not (< 0 n (
c370: 76 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 73 75 vector-length su
c380: 62 6c 65 6e 73 29 29 29 29 0a 20 20 20 20 20 20 blens)))).
c390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
c3a0: 72 72 6f 72 20 22 73 72 65 2d 6c 65 6e 67 74 68 rror "sre-length
c3b0: 3a 20 69 6e 76 61 6c 69 64 20 62 61 63 6b 72 65 : invalid backre
c3c0: 66 65 72 65 6e 63 65 22 20 73 72 65 29 29 0a 20 ference" sre)).
c3d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c3e0: 20 20 28 28 6e 6f 74 20 28 76 65 63 74 6f 72 2d ((not (vector-
c3f0: 72 65 66 20 73 75 62 6c 65 6e 73 20 6e 29 29 0a ref sublens n)).
c400: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c410: 20 20 20 20 28 65 72 72 6f 72 20 22 73 72 65 2d (error "sre-
c420: 6c 65 6e 67 74 68 3a 20 69 6e 76 61 6c 69 64 20 length: invalid
c430: 66 6f 72 77 61 72 64 20 62 61 63 6b 72 65 66 65 forward backrefe
c440: 72 65 6e 63 65 22 20 73 72 65 29 29 0a 20 20 20 rence" sre)).
c450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c460: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
c470: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
c480: 28 6c 6f 32 20 28 63 61 72 20 28 76 65 63 74 6f (lo2 (car (vecto
c490: 72 2d 72 65 66 20 73 75 62 6c 65 6e 73 20 6e 29 r-ref sublens n)
c4a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
c4b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 68 69 (hi
c4c0: 32 20 28 63 64 72 20 28 76 65 63 74 6f 72 2d 72 2 (cdr (vector-r
c4d0: 65 66 20 73 75 62 6c 65 6e 73 20 6e 29 29 29 29 ef sublens n))))
c4e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c4f0: 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 28 (return (
c500: 2b 20 6c 6f 20 6c 6f 32 29 20 28 61 6e 64 20 68 + lo lo2) (and h
c510: 69 20 68 69 32 20 28 2b 20 68 69 20 68 69 32 29 i hi2 (+ hi hi2)
c520: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
c530: 20 20 20 20 20 20 20 28 28 2a 20 2a 3f 29 0a 20 ((* *?).
c540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c550: 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 lp (sre-sequence
c560: 20 28 63 64 72 20 73 72 65 29 29 20 6e 20 6c 6f (cdr sre)) n lo
c570: 20 68 69 20 28 6c 61 6d 62 64 61 20 28 6c 6f 20 hi (lambda (lo
c580: 68 69 29 20 23 66 29 29 0a 20 20 20 20 20 20 20 hi) #f)).
c590: 20 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e (return
c5a0: 20 6c 6f 20 23 66 29 29 0a 20 20 20 20 20 20 20 lo #f)).
c5b0: 20 20 20 20 20 20 20 20 28 28 2a 2a 20 2a 2a 3f ((** **?
c5c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
c5d0: 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
c5e0: 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 28 61 ((or (a
c5f0: 6e 64 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 nd (number? (cad
c600: 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
c610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c620: 20 20 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 (number? (cad
c630: 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 dr sre)).
c640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c650: 20 20 20 20 28 3e 20 28 63 61 64 72 20 73 72 65 (> (cadr sre
c660: 29 20 28 63 61 64 64 72 20 73 72 65 29 29 29 0a ) (caddr sre))).
c670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c680: 20 20 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 (and (not
c690: 28 63 61 64 72 20 73 72 65 29 29 20 28 63 61 64 (cadr sre)) (cad
c6a0: 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 dr sre))).
c6b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 74 (ret
c6c0: 75 72 6e 20 6c 6f 20 68 69 29 29 0a 20 20 20 20 urn lo hi)).
c6d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
c6e0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
c6f0: 20 20 20 20 20 28 69 66 20 28 63 61 64 64 72 20 (if (caddr
c700: 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 sre).
c710: 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
c720: 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
c730: 64 64 72 20 73 72 65 29 29 20 6e 20 30 20 30 0a ddr sre)) n 0 0.
c740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c750: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
c760: 61 20 28 6c 6f 32 20 68 69 32 29 0a 20 20 20 20 a (lo2 hi2).
c770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c780: 20 20 20 20 20 20 20 20 28 72 65 74 75 72 6e 20 (return
c790: 28 2b 20 6c 6f 20 28 2a 20 28 63 61 64 72 20 73 (+ lo (* (cadr s
c7a0: 72 65 29 20 6c 6f 32 29 29 0a 20 20 20 20 20 20 re) lo2)).
c7b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c7c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
c7d0: 6e 64 20 68 69 20 68 69 32 20 28 2b 20 68 69 20 nd hi hi2 (+ hi
c7e0: 28 2a 20 28 63 61 64 64 72 20 73 72 65 29 20 68 (* (caddr sre) h
c7f0: 69 32 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 i2)))))).
c800: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c810: 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 lp (sre-sequence
c820: 20 28 63 64 64 64 72 20 73 72 65 29 29 20 6e 20 (cdddr sre)) n
c830: 30 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 0 0.
c840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
c850: 61 6d 62 64 61 20 28 6c 6f 32 20 68 69 32 29 0a ambda (lo2 hi2).
c860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
c870: 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 74 (ret
c880: 75 72 6e 20 28 2b 20 6c 6f 20 28 2a 20 28 63 61 urn (+ lo (* (ca
c890: 64 72 20 73 72 65 29 20 6c 6f 32 29 29 20 23 66 dr sre) lo2)) #f
c8a0: 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
c8b0: 20 20 20 20 20 20 20 28 28 2b 29 0a 20 20 20 20 ((+).
c8c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
c8d0: 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 (sre-sequence (c
c8e0: 64 72 20 73 72 65 29 29 20 6e 20 6c 6f 20 68 69 dr sre)) n lo hi
c8f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
c900: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 6c 6f (lambda (lo
c910: 32 20 68 69 32 29 0a 20 20 20 20 20 20 20 20 20 2 hi2).
c920: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
c930: 74 75 72 6e 20 28 2b 20 6c 6f 20 6c 6f 32 29 20 turn (+ lo lo2)
c940: 23 66 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 #f)))).
c950: 20 20 20 20 20 20 28 28 3f 20 3f 3f 29 0a 20 20 ((? ??).
c960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
c970: 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 p (sre-sequence
c980: 28 63 64 72 20 73 72 65 29 29 20 6e 20 6c 6f 20 (cdr sre)) n lo
c990: 68 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 hi.
c9a0: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
c9b0: 6c 6f 32 20 68 69 32 29 0a 20 20 20 20 20 20 20 lo2 hi2).
c9c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
c9d0: 72 65 74 75 72 6e 20 6c 6f 20 28 61 6e 64 20 68 return lo (and h
c9e0: 69 20 68 69 32 20 28 2b 20 68 69 20 68 69 32 29 i hi2 (+ hi hi2)
c9f0: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
ca00: 20 20 20 20 20 28 28 3d 20 3d 3f 20 3e 3d 20 3e ((= =? >= >
ca10: 3d 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 =?).
ca20: 20 20 20 20 28 6c 70 20 60 28 2a 2a 20 2c 28 63 (lp `(** ,(c
ca30: 61 64 72 20 73 72 65 29 0a 20 20 20 20 20 20 20 adr sre).
ca40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ca50: 20 20 2c 28 69 66 20 28 6d 65 6d 71 20 28 63 61 ,(if (memq (ca
ca60: 72 20 73 72 65 29 20 27 28 3e 3d 20 3e 3d 3f 29 r sre) '(>= >=?)
ca70: 29 20 23 66 20 28 63 61 64 72 20 73 72 65 29 29 ) #f (cadr sre))
ca80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
ca90: 20 20 20 20 20 20 20 20 20 20 2c 40 28 63 64 64 ,@(cdd
caa0: 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
cab0: 20 20 20 20 20 20 20 20 20 20 20 20 6e 20 6c 6f n lo
cac0: 20 68 69 20 72 65 74 75 72 6e 29 29 0a 20 20 20 hi return)).
cad0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6c 6f ((lo
cae0: 6f 6b 2d 61 68 65 61 64 20 6e 65 67 2d 6c 6f 6f ok-ahead neg-loo
caf0: 6b 2d 61 68 65 61 64 20 6c 6f 6f 6b 2d 62 65 68 k-ahead look-beh
cb00: 69 6e 64 20 6e 65 67 2d 6c 6f 6f 6b 2d 62 65 68 ind neg-look-beh
cb10: 69 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 ind).
cb20: 20 20 20 20 20 28 72 65 74 75 72 6e 20 6c 6f 20 (return lo
cb30: 68 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 hi)).
cb40: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
cb50: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
cb60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cb70: 20 28 28 61 73 73 71 20 28 63 61 72 20 73 72 65 ((assq (car sre
cb80: 29 20 73 72 65 2d 6e 61 6d 65 64 2d 64 65 66 69 ) sre-named-defi
cb90: 6e 69 74 69 6f 6e 73 29 0a 20 20 20 20 20 20 20 nitions).
cba0: 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c => (l
cbb0: 61 6d 62 64 61 20 28 63 65 6c 6c 29 0a 20 20 20 ambda (cell).
cbc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cbd0: 20 20 20 20 28 6c 70 20 28 61 70 70 6c 79 20 28 (lp (apply (
cbe0: 63 64 72 20 63 65 6c 6c 29 20 28 63 64 72 20 73 cdr cell) (cdr s
cbf0: 72 65 29 29 20 6e 20 6c 6f 20 68 69 20 72 65 74 re)) n lo hi ret
cc00: 75 72 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 urn))).
cc10: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
cc20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
cc30: 28 65 72 72 6f 72 20 22 73 72 65 2d 6c 65 6e 67 (error "sre-leng
cc40: 74 68 2d 72 61 6e 67 65 73 3a 20 75 6e 6b 6e 6f th-ranges: unkno
cc50: 77 6e 20 73 72 65 20 6f 70 65 72 61 74 6f 72 22 wn sre operator"
cc60: 20 73 72 65 29 29 29 29 29 29 29 0a 20 20 20 20 sre))))))).
cc70: 20 20 20 20 28 28 63 68 61 72 3f 20 73 72 65 29 ((char? sre)
cc80: 0a 20 20 20 20 20 20 20 20 20 28 67 72 6f 77 20 . (grow
cc90: 31 29 29 0a 20 20 20 20 20 20 20 20 28 28 73 74 1)). ((st
cca0: 72 69 6e 67 3f 20 73 72 65 29 0a 20 20 20 20 20 ring? sre).
ccb0: 20 20 20 20 28 67 72 6f 77 20 28 73 74 72 69 6e (grow (strin
ccc0: 67 2d 6c 65 6e 67 74 68 20 73 72 65 29 29 29 0a g-length sre))).
ccd0: 20 20 20 20 20 20 20 20 28 28 6d 65 6d 71 20 73 ((memq s
cce0: 72 65 20 27 28 61 6e 79 20 6e 6f 6e 6c 29 29 0a re '(any nonl)).
ccf0: 20 20 20 20 20 20 20 20 20 28 67 72 6f 77 20 31 (grow 1
cd00: 29 29 0a 20 20 20 20 20 20 20 20 28 28 6d 65 6d )). ((mem
cd10: 71 20 73 72 65 20 27 28 65 70 73 69 6c 6f 6e 20 q sre '(epsilon
cd20: 62 6f 73 20 65 6f 73 20 62 6f 6c 20 65 6f 6c 20 bos eos bol eol
cd30: 62 6f 77 20 65 6f 77 20 6e 77 62 20 63 6f 6d 6d bow eow nwb comm
cd40: 69 74 29 29 0a 20 20 20 20 20 20 20 20 20 28 72 it)). (r
cd50: 65 74 75 72 6e 20 6c 6f 20 68 69 29 29 0a 20 20 eturn lo hi)).
cd60: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
cd70: 20 20 20 20 20 28 6c 65 74 20 28 28 63 65 6c 6c (let ((cell
cd80: 20 28 61 73 73 71 20 73 72 65 20 73 72 65 2d 6e (assq sre sre-n
cd90: 61 6d 65 64 2d 64 65 66 69 6e 69 74 69 6f 6e 73 amed-definitions
cda0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). (
cdb0: 69 66 20 63 65 6c 6c 0a 20 20 20 20 20 20 20 20 if cell.
cdc0: 20 20 20 20 20 20 20 28 6c 70 20 28 69 66 20 28 (lp (if (
cdd0: 70 72 6f 63 65 64 75 72 65 3f 20 28 63 64 72 20 procedure? (cdr
cde0: 63 65 6c 6c 29 29 20 28 28 63 64 72 20 63 65 6c cell)) ((cdr cel
cdf0: 6c 29 29 20 28 63 64 72 20 63 65 6c 6c 29 29 0a l)) (cdr cell)).
ce00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ce10: 20 20 20 6e 20 6c 6f 20 68 69 20 72 65 74 75 72 n lo hi retur
ce20: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 n).
ce30: 20 20 28 65 72 72 6f 72 20 22 73 72 65 2d 6c 65 (error "sre-le
ce40: 6e 67 74 68 2d 72 61 6e 67 65 73 3a 20 75 6e 6b ngth-ranges: unk
ce50: 6e 6f 77 6e 20 73 72 65 22 20 73 72 65 29 29 29 nown sre" sre)))
ce60: 29 29 29 29 0a 20 20 20 20 73 75 62 6c 65 6e 73 )))). sublens
ce70: 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ))..;;;;;;;;;;;;
ce80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
ce90: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
cea0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
ceb0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 ;;;;;;;;;;;;.;;
cec0: 73 72 65 20 6d 61 6e 69 70 75 6c 61 74 69 6f 6e sre manipulation
ced0: 0a 0a 3b 3b 20 62 75 69 6c 64 20 61 20 28 73 65 ..;; build a (se
cee0: 71 20 6c 73 20 2e 2e 2e 29 20 73 72 65 20 66 72 q ls ...) sre fr
cef0: 6f 6d 20 61 20 6c 69 73 74 0a 28 64 65 66 69 6e om a list.(defin
cf00: 65 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 e (sre-sequence
cf10: 6c 73 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 ls). (cond. (
cf20: 28 6e 75 6c 6c 3f 20 6c 73 29 20 27 65 70 73 69 (null? ls) 'epsi
cf30: 6c 6f 6e 29 0a 20 20 20 28 28 6e 75 6c 6c 3f 20 lon). ((null?
cf40: 28 63 64 72 20 6c 73 29 29 20 28 63 61 72 20 6c (cdr ls)) (car l
cf50: 73 29 29 0a 20 20 20 28 65 6c 73 65 20 28 63 6f s)). (else (co
cf60: 6e 73 20 27 73 65 71 20 6c 73 29 29 29 29 0a 0a ns 'seq ls))))..
cf70: 3b 3b 20 62 75 69 6c 64 20 61 20 28 6f 72 20 6c ;; build a (or l
cf80: 73 20 2e 2e 2e 29 20 73 72 65 20 66 72 6f 6d 20 s ...) sre from
cf90: 61 20 6c 69 73 74 0a 28 64 65 66 69 6e 65 20 28 a list.(define (
cfa0: 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 6c 73 sre-alternate ls
cfb0: 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 6e ). (cond. ((n
cfc0: 75 6c 6c 3f 20 6c 73 29 20 27 65 70 73 69 6c 6f ull? ls) 'epsilo
cfd0: 6e 29 0a 20 20 20 28 28 6e 75 6c 6c 3f 20 28 63 n). ((null? (c
cfe0: 64 72 20 6c 73 29 29 20 28 63 61 72 20 6c 73 29 dr ls)) (car ls)
cff0: 29 0a 20 20 20 28 65 6c 73 65 20 28 63 6f 6e 73 ). (else (cons
d000: 20 27 6f 72 20 6c 73 29 29 29 29 0a 0a 3b 3b 20 'or ls))))..;;
d010: 72 65 74 75 72 6e 73 20 61 6e 20 65 71 75 69 76 returns an equiv
d020: 61 6c 65 6e 74 20 53 52 45 20 77 69 74 68 6f 75 alent SRE withou
d030: 74 20 61 6e 79 20 6d 61 74 63 68 20 69 6e 66 6f t any match info
d040: 72 6d 61 74 69 6f 6e 0a 28 64 65 66 69 6e 65 20 rmation.(define
d050: 28 73 72 65 2d 73 74 72 69 70 2d 73 75 62 6d 61 (sre-strip-subma
d060: 74 63 68 65 73 20 73 72 65 29 0a 20 20 28 69 66 tches sre). (if
d070: 20 28 6e 6f 74 20 28 70 61 69 72 3f 20 73 72 65 (not (pair? sre
d080: 29 29 0a 20 20 20 20 20 20 73 72 65 0a 20 20 20 )). sre.
d090: 20 20 20 28 63 61 73 65 20 28 63 61 72 20 73 72 (case (car sr
d0a0: 65 29 0a 20 20 20 20 20 20 20 20 28 28 24 20 73 e). (($ s
d0b0: 75 62 6d 61 74 63 68 29 20 28 73 72 65 2d 73 74 ubmatch) (sre-st
d0c0: 72 69 70 2d 73 75 62 6d 61 74 63 68 65 73 20 28 rip-submatches (
d0d0: 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
d0e0: 72 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 r sre)))).
d0f0: 20 20 28 28 3d 3e 20 73 75 62 6d 61 74 63 68 2d ((=> submatch-
d100: 6e 61 6d 65 64 29 20 28 73 72 65 2d 73 74 72 69 named) (sre-stri
d110: 70 2d 73 75 62 6d 61 74 63 68 65 73 20 28 73 72 p-submatches (sr
d120: 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 72 e-sequence (cddr
d130: 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 sre)))).
d140: 20 28 28 64 73 6d 29 20 28 73 72 65 2d 73 74 72 ((dsm) (sre-str
d150: 69 70 2d 73 75 62 6d 61 74 63 68 65 73 20 28 73 ip-submatches (s
d160: 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 re-sequence (cdd
d170: 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 dr sre)))).
d180: 20 20 20 28 65 6c 73 65 20 28 6d 61 70 20 73 72 (else (map sr
d190: 65 2d 73 74 72 69 70 2d 73 75 62 6d 61 74 63 68 e-strip-submatch
d1a0: 65 73 20 73 72 65 29 29 29 29 29 0a 0a 3b 3b 20 es sre)))))..;;
d1b0: 67 69 76 65 6e 20 61 20 63 68 61 72 2d 73 65 74 given a char-set
d1c0: 20 6c 69 73 74 20 6f 66 20 63 68 61 72 73 20 61 list of chars a
d1d0: 6e 64 20 73 74 72 69 6e 67 73 2c 20 66 6c 61 74 nd strings, flat
d1e0: 74 65 6e 73 20 74 68 65 6d 20 69 6e 74 6f 0a 3b tens them into.;
d1f0: 3b 20 63 68 61 72 73 20 6f 6e 6c 79 0a 28 64 65 ; chars only.(de
d200: 66 69 6e 65 20 28 73 72 65 2d 66 6c 61 74 74 65 fine (sre-flatte
d210: 6e 2d 72 61 6e 67 65 73 20 6c 73 29 0a 20 20 28 n-ranges ls). (
d220: 6c 65 74 20 6c 70 20 28 28 6c 73 20 6c 73 29 20 let lp ((ls ls)
d230: 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 (res '())). (
d240: 63 6f 6e 64 0a 20 20 20 20 20 28 28 6e 75 6c 6c cond. ((null
d250: 3f 20 6c 73 29 0a 20 20 20 20 20 20 28 72 65 76 ? ls). (rev
d260: 65 72 73 65 20 72 65 73 29 29 0a 20 20 20 20 20 erse res)).
d270: 28 28 73 74 72 69 6e 67 3f 20 28 63 61 72 20 6c ((string? (car l
d280: 73 29 29 0a 20 20 20 20 20 20 28 6c 70 20 28 61 s)). (lp (a
d290: 70 70 65 6e 64 20 28 73 74 72 69 6e 67 2d 3e 6c ppend (string->l
d2a0: 69 73 74 20 28 63 61 72 20 6c 73 29 29 20 28 63 ist (car ls)) (c
d2b0: 64 72 20 6c 73 29 29 20 72 65 73 29 29 0a 20 20 dr ls)) res)).
d2c0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 28 (else. (
d2d0: 6c 70 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e lp (cdr ls) (con
d2e0: 73 20 28 63 61 72 20 6c 73 29 20 72 65 73 29 29 s (car ls) res))
d2f0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 73 ))))..(define (s
d300: 72 65 2d 6e 61 6d 65 73 20 73 72 65 20 6e 20 6e re-names sre n n
d310: 61 6d 65 73 29 0a 20 20 28 69 66 20 28 6e 6f 74 ames). (if (not
d320: 20 28 70 61 69 72 3f 20 73 72 65 29 29 0a 20 20 (pair? sre)).
d330: 20 20 20 20 6e 61 6d 65 73 0a 20 20 20 20 20 20 names.
d340: 28 63 61 73 65 20 28 63 61 72 20 73 72 65 29 0a (case (car sre).
d350: 20 20 20 20 20 20 20 20 28 28 24 20 73 75 62 6d (($ subm
d360: 61 74 63 68 29 0a 20 20 20 20 20 20 20 20 20 28 atch). (
d370: 73 72 65 2d 6e 61 6d 65 73 20 28 73 72 65 2d 73 sre-names (sre-s
d380: 65 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 equence (cdr sre
d390: 29 29 20 28 2b 20 6e 20 31 29 20 6e 61 6d 65 73 )) (+ n 1) names
d3a0: 29 29 0a 20 20 20 20 20 20 20 20 28 28 3d 3e 20 )). ((=>
d3b0: 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a submatch-named).
d3c0: 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 6e 61 (sre-na
d3d0: 6d 65 73 20 28 73 72 65 2d 73 65 71 75 65 6e 63 mes (sre-sequenc
d3e0: 65 20 28 63 64 64 72 20 73 72 65 29 29 0a 20 20 e (cddr sre)).
d3f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d400: 20 20 28 2b 20 6e 20 31 29 0a 20 20 20 20 20 20 (+ n 1).
d410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
d420: 6f 6e 73 20 28 63 6f 6e 73 20 28 63 61 64 72 20 ons (cons (cadr
d430: 73 72 65 29 20 6e 29 20 6e 61 6d 65 73 29 29 29 sre) n) names)))
d440: 0a 20 20 20 20 20 20 20 20 28 28 64 73 6d 29 0a . ((dsm).
d450: 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 6e 61 (sre-na
d460: 6d 65 73 20 28 73 72 65 2d 73 65 71 75 65 6e 63 mes (sre-sequenc
d470: 65 20 28 63 64 64 64 72 20 73 72 65 29 29 20 28 e (cdddr sre)) (
d480: 2b 20 6e 20 28 63 61 64 72 20 73 72 65 29 29 20 + n (cadr sre))
d490: 6e 61 6d 65 73 29 29 0a 20 20 20 20 20 20 20 20 names)).
d4a0: 28 28 73 65 71 20 3a 20 6f 72 20 2a 20 2b 20 3f ((seq : or * + ?
d4b0: 20 2a 3f 20 3f 3f 20 77 2f 63 61 73 65 20 77 2f *? ?? w/case w/
d4c0: 6e 6f 63 61 73 65 20 61 74 6f 6d 69 63 0a 20 20 nocase atomic.
d4d0: 20 20 20 20 20 20 20 20 6c 6f 6f 6b 2d 61 68 65 look-ahe
d4e0: 61 64 20 6c 6f 6f 6b 2d 62 65 68 69 6e 64 20 6e ad look-behind n
d4f0: 65 67 2d 6c 6f 6f 6b 2d 61 68 65 61 64 20 6e 65 eg-look-ahead ne
d500: 67 2d 6c 6f 6f 6b 2d 62 65 68 69 6e 64 29 0a 20 g-look-behind).
d510: 20 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 71 (sre-seq
d520: 75 65 6e 63 65 2d 6e 61 6d 65 73 20 28 63 64 72 uence-names (cdr
d530: 20 73 72 65 29 20 6e 20 6e 61 6d 65 73 29 29 0a sre) n names)).
d540: 20 20 20 20 20 20 20 20 28 28 3d 20 3e 3d 29 0a ((= >=).
d550: 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 (sre-se
d560: 71 75 65 6e 63 65 2d 6e 61 6d 65 73 20 28 63 64 quence-names (cd
d570: 64 72 20 73 72 65 29 20 6e 20 6e 61 6d 65 73 29 dr sre) n names)
d580: 29 0a 20 20 20 20 20 20 20 20 28 28 2a 2a 20 2a ). ((** *
d590: 2a 3f 29 0a 20 20 20 20 20 20 20 20 20 28 73 72 *?). (sr
d5a0: 65 2d 73 65 71 75 65 6e 63 65 2d 6e 61 6d 65 73 e-sequence-names
d5b0: 20 28 63 64 64 64 72 20 73 72 65 29 20 6e 20 6e (cdddr sre) n n
d5c0: 61 6d 65 73 29 29 0a 20 20 20 20 20 20 20 20 28 ames)). (
d5d0: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 6e 61 else. na
d5e0: 6d 65 73 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 mes))))..(define
d5f0: 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 2d 6e (sre-sequence-n
d600: 61 6d 65 73 20 6c 73 20 6e 20 6e 61 6d 65 73 29 ames ls n names)
d610: 0a 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 6c 73 . (if (null? ls
d620: 29 0a 20 20 20 20 20 20 6e 61 6d 65 73 0a 20 20 ). names.
d630: 20 20 20 20 28 73 72 65 2d 73 65 71 75 65 6e 63 (sre-sequenc
d640: 65 2d 6e 61 6d 65 73 20 28 63 64 72 20 6c 73 29 e-names (cdr ls)
d650: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d660: 20 20 20 20 20 20 20 20 20 20 20 28 2b 20 6e 20 (+ n
d670: 28 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 (sre-count-subma
d680: 74 63 68 65 73 20 28 63 61 72 20 6c 73 29 29 29 tches (car ls)))
d690: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
d6a0: 20 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d (sre-
d6b0: 6e 61 6d 65 73 20 28 63 61 72 20 6c 73 29 20 6e names (car ls) n
d6c0: 20 6e 61 6d 65 73 29 29 29 29 0a 0a 28 64 65 66 names))))..(def
d6d0: 69 6e 65 20 28 73 72 65 2d 72 65 6d 6f 76 65 2d ine (sre-remove-
d6e0: 69 6e 69 74 69 61 6c 2d 62 6f 73 20 73 72 65 29 initial-bos sre)
d6f0: 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 70 61 . (cond. ((pa
d700: 69 72 3f 20 73 72 65 29 0a 20 20 20 20 28 63 61 ir? sre). (ca
d710: 73 65 20 28 63 61 72 20 73 72 65 29 0a 20 20 20 se (car sre).
d720: 20 20 20 28 28 73 65 71 20 3a 20 24 20 73 75 62 ((seq : $ sub
d730: 6d 61 74 63 68 20 3d 3e 20 73 75 62 6d 61 74 63 match => submatc
d740: 68 2d 6e 61 6d 65 64 20 2a 20 2b 29 0a 20 20 20 h-named * +).
d750: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
d760: 20 20 28 28 6e 6f 74 20 28 70 61 69 72 3f 20 28 ((not (pair? (
d770: 63 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 cdr sre))).
d780: 20 20 20 20 73 72 65 29 0a 20 20 20 20 20 20 20 sre).
d790: 20 28 28 65 71 3f 20 27 62 6f 73 20 28 63 61 64 ((eq? 'bos (cad
d7a0: 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
d7b0: 20 28 63 6f 6e 73 20 28 63 61 72 20 73 72 65 29 (cons (car sre)
d7c0: 20 28 63 64 64 72 20 73 72 65 29 29 29 0a 20 20 (cddr sre))).
d7d0: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
d7e0: 20 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 (cons (car
d7f0: 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 sre).
d800: 20 20 20 20 28 63 6f 6e 73 20 28 73 72 65 2d 72 (cons (sre-r
d810: 65 6d 6f 76 65 2d 69 6e 69 74 69 61 6c 2d 62 6f emove-initial-bo
d820: 73 20 28 63 61 64 72 20 73 72 65 29 29 20 28 63 s (cadr sre)) (c
d830: 64 64 72 20 73 72 65 29 29 29 29 29 29 0a 20 20 ddr sre)))))).
d840: 20 20 20 20 28 28 6f 72 29 0a 20 20 20 20 20 20 ((or).
d850: 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 (sre-alternate
d860: 28 6d 61 70 20 73 72 65 2d 72 65 6d 6f 76 65 2d (map sre-remove-
d870: 69 6e 69 74 69 61 6c 2d 62 6f 73 20 28 63 64 72 initial-bos (cdr
d880: 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 28 sre)))). (
d890: 65 6c 73 65 0a 20 20 20 20 20 20 20 73 72 65 29 else. sre)
d8a0: 29 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 20 )). (else.
d8b0: 73 72 65 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b sre)))..;;;;;;;;
d8c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d8d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d8e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d8f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
d900: 0a 3b 3b 20 6d 61 74 63 68 69 6e 67 0a 0a 28 64 .;; matching..(d
d910: 65 66 69 6e 65 20 69 72 72 65 67 65 78 2d 62 61 efine irregex-ba
d920: 73 69 63 2d 73 74 72 69 6e 67 2d 63 68 75 6e 6b sic-string-chunk
d930: 65 72 0a 20 20 28 6d 61 6b 65 2d 69 72 72 65 67 er. (make-irreg
d940: 65 78 2d 63 68 75 6e 6b 65 72 20 28 6c 61 6d 62 ex-chunker (lamb
d950: 64 61 20 28 78 29 20 23 66 29 0a 20 20 20 20 20 da (x) #f).
d960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
d970: 20 20 20 63 61 72 0a 20 20 20 20 20 20 20 20 20 car.
d980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 63 c
d990: 61 64 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 adr.
d9a0: 20 20 20 20 20 20 20 20 20 20 20 20 63 61 64 64 cadd
d9b0: 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
d9c0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
d9d0: 61 20 28 73 72 63 31 20 69 20 73 72 63 32 20 6a a (src1 i src2 j
d9e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
d9f0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 75 62 (sub
da00: 73 74 72 69 6e 67 20 28 63 61 72 20 73 72 63 31 string (car src1
da10: 29 20 69 20 6a 29 29 29 29 0a 0a 28 64 65 66 69 ) i j))))..(defi
da20: 6e 65 20 28 69 72 72 65 67 65 78 2d 73 65 61 72 ne (irregex-sear
da30: 63 68 20 78 20 73 74 72 20 2e 20 6f 29 0a 20 20 ch x str . o).
da40: 28 6c 65 74 20 28 28 73 74 61 72 74 20 28 69 66 (let ((start (if
da50: 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 72 20 (pair? o) (car
da60: 6f 29 20 30 29 29 0a 20 20 20 20 20 20 20 20 28 o) 0)). (
da70: 65 6e 64 20 28 69 66 20 28 61 6e 64 20 28 70 61 end (if (and (pa
da80: 69 72 3f 20 6f 29 20 28 70 61 69 72 3f 20 28 63 ir? o) (pair? (c
da90: 64 72 20 6f 29 29 29 20 28 63 61 64 72 20 6f 29 dr o))) (cadr o)
daa0: 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
dab0: 73 74 72 29 29 29 29 0a 20 20 20 20 28 69 72 72 str)))). (irr
dac0: 65 67 65 78 2d 73 65 61 72 63 68 2f 63 68 75 6e egex-search/chun
dad0: 6b 65 64 20 78 0a 20 20 20 20 20 20 20 20 20 20 ked x.
dae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
daf0: 20 20 69 72 72 65 67 65 78 2d 62 61 73 69 63 2d irregex-basic-
db00: 73 74 72 69 6e 67 2d 63 68 75 6e 6b 65 72 0a 20 string-chunker.
db10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db20: 20 20 20 20 20 20 20 20 20 20 20 28 6c 69 73 74 (list
db30: 20 73 74 72 20 73 74 61 72 74 20 65 6e 64 29 0a str start end).
db40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
db50: 20 20 20 20 20 20 20 20 20 20 20 20 73 74 61 72 star
db60: 74 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 t)))..(define (i
db70: 72 72 65 67 65 78 2d 73 65 61 72 63 68 2f 63 68 rregex-search/ch
db80: 75 6e 6b 65 64 20 78 20 63 6e 6b 20 73 72 63 20 unked x cnk src
db90: 2e 20 6f 29 0a 20 20 28 6c 65 74 2a 20 28 28 69 . o). (let* ((i
dba0: 72 78 20 28 69 72 72 65 67 65 78 20 78 29 29 0a rx (irregex x)).
dbb0: 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 65 (matche
dbc0: 73 20 28 69 72 72 65 67 65 78 2d 6e 65 77 2d 6d s (irregex-new-m
dbd0: 61 74 63 68 65 73 20 69 72 78 29 29 0a 20 20 20 atches irx)).
dbe0: 20 20 20 20 20 20 28 69 20 28 69 66 20 28 70 61 (i (if (pa
dbf0: 69 72 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 28 ir? o) (car o) (
dc00: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 (chunker-get-sta
dc10: 72 74 20 63 6e 6b 29 20 73 72 63 29 29 29 29 0a rt cnk) src)))).
dc20: 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 (irregex-mat
dc30: 63 68 2d 63 68 75 6e 6b 65 72 2d 73 65 74 21 20 ch-chunker-set!
dc40: 6d 61 74 63 68 65 73 20 63 6e 6b 29 0a 20 20 20 matches cnk).
dc50: 20 28 69 72 72 65 67 65 78 2d 73 65 61 72 63 68 (irregex-search
dc60: 2f 6d 61 74 63 68 65 73 20 69 72 78 20 63 6e 6b /matches irx cnk
dc70: 20 73 72 63 20 69 20 6d 61 74 63 68 65 73 29 29 src i matches))
dc80: 29 0a 0a 3b 3b 20 69 6e 74 65 72 6e 61 6c 20 72 )..;; internal r
dc90: 6f 75 74 69 6e 65 2c 20 63 61 6e 20 62 65 20 75 outine, can be u
dca0: 73 65 64 20 69 6e 20 6c 6f 6f 70 73 20 74 6f 20 sed in loops to
dcb0: 61 76 6f 69 64 20 72 65 61 6c 6c 6f 63 61 74 69 avoid reallocati
dcc0: 6e 67 20 74 68 65 0a 3b 3b 20 6d 61 74 63 68 20 ng the.;; match
dcd0: 76 65 63 74 6f 72 0a 28 64 65 66 69 6e 65 20 28 vector.(define (
dce0: 69 72 72 65 67 65 78 2d 73 65 61 72 63 68 2f 6d irregex-search/m
dcf0: 61 74 63 68 65 73 20 69 72 78 20 63 6e 6b 20 73 atches irx cnk s
dd00: 72 63 20 69 20 6d 61 74 63 68 65 73 29 0a 20 20 rc i matches).
dd10: 28 63 6f 6e 64 0a 20 20 20 28 28 69 72 72 65 67 (cond. ((irreg
dd20: 65 78 2d 64 66 61 20 69 72 78 29 0a 20 20 20 20 ex-dfa irx).
dd30: 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 66 6c 61 (cond. ((fla
dd40: 67 2d 73 65 74 3f 20 28 69 72 72 65 67 65 78 2d g-set? (irregex-
dd50: 66 6c 61 67 73 20 69 72 78 29 20 7e 73 65 61 72 flags irx) ~sear
dd60: 63 68 65 72 3f 29 0a 20 20 20 20 20 20 28 63 6f cher?). (co
dd70: 6e 64 0a 20 20 20 20 20 20 20 28 28 64 66 61 2d nd. ((dfa-
dd80: 6d 61 74 63 68 2f 6c 6f 6e 67 65 73 74 20 28 69 match/longest (i
dd90: 72 72 65 67 65 78 2d 64 66 61 20 69 72 78 29 20 rregex-dfa irx)
dda0: 63 6e 6b 20 73 72 63 20 69 20 23 66 20 23 66 20 cnk src i #f #f
ddb0: 6d 61 74 63 68 65 73 20 30 29 0a 20 20 20 20 20 matches 0).
ddc0: 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
ddd0: 68 2d 73 74 61 72 74 2d 73 6f 75 72 63 65 2d 73 h-start-source-s
dde0: 65 74 21 20 6d 61 74 63 68 65 73 20 30 20 73 72 et! matches 0 sr
ddf0: 63 29 0a 20 20 20 20 20 20 20 20 28 69 72 72 65 c). (irre
de00: 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d gex-match-start-
de10: 69 6e 64 65 78 2d 73 65 74 21 20 6d 61 74 63 68 index-set! match
de20: 65 73 20 30 20 69 29 0a 20 20 20 20 20 20 20 20 es 0 i).
de30: 28 28 69 72 72 65 67 65 78 2d 64 66 61 2f 65 78 ((irregex-dfa/ex
de40: 74 72 61 63 74 20 69 72 78 29 0a 20 20 20 20 20 tract irx).
de50: 20 20 20 20 63 6e 6b 20 73 72 63 20 69 0a 20 20 cnk src i.
de60: 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
de70: 6d 61 74 63 68 2d 65 6e 64 2d 73 6f 75 72 63 65 match-end-source
de80: 20 6d 61 74 63 68 65 73 20 30 29 0a 20 20 20 20 matches 0).
de90: 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 (irregex-ma
dea0: 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 6d 61 tch-end-index ma
deb0: 74 63 68 65 73 20 30 29 0a 20 20 20 20 20 20 20 tches 0).
dec0: 20 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 matches).
ded0: 20 20 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 matches).
dee0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
def0: 20 23 66 29 29 29 0a 20 20 20 20 20 28 28 64 66 #f))). ((df
df00: 61 2d 6d 61 74 63 68 2f 73 68 6f 72 74 65 73 74 a-match/shortest
df10: 0a 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 . (irregex
df20: 2d 64 66 61 2f 73 65 61 72 63 68 20 69 72 78 29 -dfa/search irx)
df30: 20 63 6e 6b 20 73 72 63 20 69 20 6d 61 74 63 68 cnk src i match
df40: 65 73 20 30 29 0a 20 20 20 20 20 20 28 6c 65 74 es 0). (let
df50: 20 28 28 64 66 61 20 28 69 72 72 65 67 65 78 2d ((dfa (irregex-
df60: 64 66 61 20 69 72 78 29 29 0a 20 20 20 20 20 20 dfa irx)).
df70: 20 20 20 20 20 20 28 67 65 74 2d 73 74 61 72 74 (get-start
df80: 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 (chunker-get-st
df90: 61 72 74 20 63 6e 6b 29 29 0a 20 20 20 20 20 20 art cnk)).
dfa0: 20 20 20 20 20 20 28 67 65 74 2d 65 6e 64 20 28 (get-end (
dfb0: 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 chunker-get-end
dfc0: 63 6e 6b 29 29 0a 20 20 20 20 20 20 20 20 20 20 cnk)).
dfd0: 20 20 28 67 65 74 2d 6e 65 78 74 20 28 63 68 75 (get-next (chu
dfe0: 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e nker-get-next cn
dff0: 6b 29 29 29 0a 20 20 20 20 20 20 20 20 28 6c 65 k))). (le
e000: 74 20 6c 70 31 20 28 28 73 72 63 20 73 72 63 29 t lp1 ((src src)
e010: 20 28 69 20 69 29 29 0a 20 20 20 20 20 20 20 20 (i i)).
e020: 20 20 28 6c 65 74 20 28 28 65 6e 64 20 28 67 65 (let ((end (ge
e030: 74 2d 65 6e 64 20 73 72 63 29 29 29 0a 20 20 20 t-end src))).
e040: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 (let lp
e050: 32 20 28 28 69 20 69 29 29 0a 20 20 20 20 20 20 2 ((i i)).
e060: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
e070: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 64 ((d
e080: 66 61 2d 6d 61 74 63 68 2f 6c 6f 6e 67 65 73 74 fa-match/longest
e090: 20 64 66 61 20 63 6e 6b 20 73 72 63 20 69 20 23 dfa cnk src i #
e0a0: 66 20 23 66 20 6d 61 74 63 68 65 73 20 30 29 0a f #f matches 0).
e0b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e0c0: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 (irregex-match-s
e0d0: 74 61 72 74 2d 73 6f 75 72 63 65 2d 73 65 74 21 tart-source-set!
e0e0: 20 6d 61 74 63 68 65 73 20 30 20 73 72 63 29 0a matches 0 src).
e0f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e100: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 (irregex-match-s
e110: 74 61 72 74 2d 69 6e 64 65 78 2d 73 65 74 21 20 tart-index-set!
e120: 6d 61 74 63 68 65 73 20 30 20 69 29 0a 20 20 20 matches 0 i).
e130: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 69 ((i
e140: 72 72 65 67 65 78 2d 64 66 61 2f 65 78 74 72 61 rregex-dfa/extra
e150: 63 74 20 69 72 78 29 0a 20 20 20 20 20 20 20 20 ct irx).
e160: 20 20 20 20 20 20 20 20 20 63 6e 6b 20 73 72 63 cnk src
e170: 20 69 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i.
e180: 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 (irregex-mat
e190: 63 68 2d 65 6e 64 2d 73 6f 75 72 63 65 20 6d 61 ch-end-source ma
e1a0: 74 63 68 65 73 20 30 29 0a 20 20 20 20 20 20 20 tches 0).
e1b0: 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 67 (irreg
e1c0: 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 ex-match-end-ind
e1d0: 65 78 20 6d 61 74 63 68 65 73 20 30 29 0a 20 20 ex matches 0).
e1e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6d m
e1f0: 61 74 63 68 65 73 29 0a 20 20 20 20 20 20 20 20 atches).
e200: 20 20 20 20 20 20 20 20 6d 61 74 63 68 65 73 29 matches)
e210: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e220: 28 28 3e 3d 20 69 20 65 6e 64 29 0a 20 20 20 20 ((>= i end).
e230: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
e240: 20 28 28 6e 65 78 74 20 28 67 65 74 2d 6e 65 78 ((next (get-nex
e250: 74 20 73 72 63 29 29 29 0a 20 20 20 20 20 20 20 t src))).
e260: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
e270: 6e 65 78 74 20 28 6c 70 31 20 6e 65 78 74 20 28 next (lp1 next (
e280: 67 65 74 2d 73 74 61 72 74 20 6e 65 78 74 29 29 get-start next))
e290: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
e2a0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
e2b0: 20 20 20 20 20 20 20 20 20 28 6c 70 32 20 28 2b (lp2 (+
e2c0: 20 69 20 31 29 29 29 29 29 29 29 29 29 0a 20 20 i 1))))))))).
e2d0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 23 (else. #
e2e0: 66 29 29 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 f))). (else.
e2f0: 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 65 72 (let ((matcher
e300: 20 28 69 72 72 65 67 65 78 2d 6e 66 61 20 69 72 (irregex-nfa ir
e310: 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 73 x)). (s
e320: 74 72 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 tr ((chunker-get
e330: 2d 73 74 72 20 63 6e 6b 29 20 73 72 63 29 29 0a -str cnk) src)).
e340: 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 28 (end (
e350: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 (chunker-get-end
e360: 20 63 6e 6b 29 20 73 72 63 29 29 0a 20 20 20 20 cnk) src)).
e370: 20 20 20 20 20 20 28 67 65 74 2d 6e 65 78 74 20 (get-next
e380: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 (chunker-get-nex
e390: 74 20 63 6e 6b 29 29 29 0a 20 20 20 20 20 20 28 t cnk))). (
e3a0: 69 66 20 28 66 6c 61 67 2d 73 65 74 3f 20 28 69 if (flag-set? (i
e3b0: 72 72 65 67 65 78 2d 66 6c 61 67 73 20 69 72 78 rregex-flags irx
e3c0: 29 20 7e 73 65 61 72 63 68 65 72 3f 29 0a 20 20 ) ~searcher?).
e3d0: 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 65 72 (matcher
e3e0: 20 63 6e 6b 20 73 72 63 20 73 72 63 20 73 74 72 cnk src src str
e3f0: 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 28 i end matches (
e400: 6c 61 6d 62 64 61 20 28 29 20 23 66 29 29 0a 20 lambda () #f)).
e410: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 70 (let lp
e420: 20 28 28 73 72 63 32 20 73 72 63 29 0a 20 20 20 ((src2 src).
e430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e440: 28 73 74 72 20 73 74 72 29 0a 20 20 20 20 20 20 (str str).
e450: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 20 (i
e460: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
e470: 20 20 20 20 20 20 28 65 6e 64 20 65 6e 64 29 29 (end end))
e480: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f . (co
e490: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
e4a0: 28 28 6d 61 74 63 68 65 72 20 63 6e 6b 20 73 72 ((matcher cnk sr
e4b0: 63 20 73 72 63 32 20 73 74 72 20 69 20 65 6e 64 c src2 str i end
e4c0: 20 6d 61 74 63 68 65 73 20 28 6c 61 6d 62 64 61 matches (lambda
e4d0: 20 28 29 20 23 66 29 29 0a 20 20 20 20 20 20 20 () #f)).
e4e0: 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
e4f0: 6d 61 74 63 68 2d 73 74 61 72 74 2d 73 6f 75 72 match-start-sour
e500: 63 65 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 ce-set! matches
e510: 30 20 73 72 63 32 29 0a 20 20 20 20 20 20 20 20 0 src2).
e520: 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d (irregex-m
e530: 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 atch-start-index
e540: 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 30 20 -set! matches 0
e550: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
e560: 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 20 matches).
e570: 20 20 20 20 20 20 20 28 28 3c 20 69 20 65 6e 64 ((< i end
e580: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
e590: 28 6c 70 20 73 72 63 32 20 73 74 72 20 28 2b 20 (lp src2 str (+
e5a0: 69 20 31 29 20 65 6e 64 29 29 0a 20 20 20 20 20 i 1) end)).
e5b0: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
e5c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
e5d0: 20 28 28 73 72 63 32 20 28 67 65 74 2d 6e 65 78 ((src2 (get-nex
e5e0: 74 20 73 72 63 32 29 29 29 0a 20 20 20 20 20 20 t src2))).
e5f0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 73 72 (if sr
e600: 63 32 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c2.
e610: 20 20 20 20 20 20 20 28 6c 70 20 73 72 63 32 0a (lp src2.
e620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e630: 20 20 20 20 20 20 20 20 28 28 63 68 75 6e 6b 65 ((chunke
e640: 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 73 r-get-str cnk) s
e650: 72 63 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 rc2).
e660: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 ((c
e670: 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 hunker-get-start
e680: 20 63 6e 6b 29 20 73 72 63 32 29 0a 20 20 20 20 cnk) src2).
e690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e6a0: 20 20 20 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 ((chunker-ge
e6b0: 74 2d 65 6e 64 20 63 6e 6b 29 20 73 72 63 32 29 t-end cnk) src2)
e6c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
e6d0: 20 20 20 20 20 20 23 66 29 29 29 29 29 29 29 29 #f))))))))
e6e0: 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 ))..(define (irr
e6f0: 65 67 65 78 2d 6d 61 74 63 68 20 69 72 78 20 73 egex-match irx s
e700: 74 72 20 2e 20 6f 29 0a 20 20 28 6c 65 74 20 28 tr . o). (let (
e710: 28 73 74 61 72 74 20 28 69 66 20 28 70 61 69 72 (start (if (pair
e720: 3f 20 6f 29 20 28 63 61 72 20 6f 29 20 30 29 29 ? o) (car o) 0))
e730: 0a 20 20 20 20 20 20 20 20 28 65 6e 64 20 28 69 . (end (i
e740: 66 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 f (and (pair? o)
e750: 20 28 70 61 69 72 3f 20 28 63 64 72 20 6f 29 29 (pair? (cdr o))
e760: 29 20 28 63 61 64 72 20 6f 29 20 28 73 74 72 69 ) (cadr o) (stri
e770: 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 29 29 29 ng-length str)))
e780: 29 0a 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d ). (irregex-m
e790: 61 74 63 68 2f 63 68 75 6e 6b 65 64 20 69 72 78 atch/chunked irx
e7a0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
e7b0: 20 20 20 20 20 20 20 20 20 20 20 20 69 72 72 65 irre
e7c0: 67 65 78 2d 62 61 73 69 63 2d 73 74 72 69 6e 67 gex-basic-string
e7d0: 2d 63 68 75 6e 6b 65 72 0a 20 20 20 20 20 20 20 -chunker.
e7e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
e7f0: 20 20 20 20 28 6c 69 73 74 20 73 74 72 20 73 74 (list str st
e800: 61 72 74 20 65 6e 64 29 29 29 29 0a 0a 28 64 65 art end))))..(de
e810: 66 69 6e 65 20 28 69 72 72 65 67 65 78 2d 6d 61 fine (irregex-ma
e820: 74 63 68 2f 63 68 75 6e 6b 65 64 20 69 72 78 20 tch/chunked irx
e830: 63 6e 6b 20 73 72 63 29 0a 20 20 28 6c 65 74 2a cnk src). (let*
e840: 20 28 28 69 72 78 20 28 69 72 72 65 67 65 78 20 ((irx (irregex
e850: 69 72 78 29 29 0a 20 20 20 20 20 20 20 20 20 28 irx)). (
e860: 6d 61 74 63 68 65 73 20 28 69 72 72 65 67 65 78 matches (irregex
e870: 2d 6e 65 77 2d 6d 61 74 63 68 65 73 20 69 72 78 -new-matches irx
e880: 29 29 29 0a 20 20 20 20 28 69 72 72 65 67 65 78 ))). (irregex
e890: 2d 6d 61 74 63 68 2d 63 68 75 6e 6b 65 72 2d 73 -match-chunker-s
e8a0: 65 74 21 20 6d 61 74 63 68 65 73 20 63 6e 6b 29 et! matches cnk)
e8b0: 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 . (cond.
e8c0: 28 28 69 72 72 65 67 65 78 2d 64 66 61 20 69 72 ((irregex-dfa ir
e8d0: 78 29 0a 20 20 20 20 20 20 28 61 6e 64 0a 20 20 x). (and.
e8e0: 20 20 20 20 20 28 64 66 61 2d 6d 61 74 63 68 2f (dfa-match/
e8f0: 6c 6f 6e 67 65 73 74 0a 20 20 20 20 20 20 20 20 longest.
e900: 28 69 72 72 65 67 65 78 2d 64 66 61 20 69 72 78 (irregex-dfa irx
e910: 29 20 63 6e 6b 20 73 72 63 20 28 28 63 68 75 6e ) cnk src ((chun
e920: 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e ker-get-start cn
e930: 6b 29 20 73 72 63 29 20 23 66 20 23 66 20 6d 61 k) src) #f #f ma
e940: 74 63 68 65 73 20 30 29 0a 20 20 20 20 20 20 20 tches 0).
e950: 28 3d 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 (= ((chunker-get
e960: 2d 65 6e 64 20 63 6e 6b 29 20 28 69 72 72 65 67 -end cnk) (irreg
e970: 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 73 6f 75 ex-match-end-sou
e980: 72 63 65 20 6d 61 74 63 68 65 73 20 30 29 29 0a rce matches 0)).
e990: 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 67 (irreg
e9a0: 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 ex-match-end-ind
e9b0: 65 78 20 6d 61 74 63 68 65 73 20 30 29 29 0a 20 ex matches 0)).
e9c0: 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
e9d0: 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d (irregex-m
e9e0: 61 74 63 68 2d 73 74 61 72 74 2d 73 6f 75 72 63 atch-start-sourc
e9f0: 65 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 30 e-set! matches 0
ea00: 20 73 72 63 29 0a 20 20 20 20 20 20 20 20 20 28 src). (
ea10: 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 irregex-match-st
ea20: 61 72 74 2d 69 6e 64 65 78 2d 73 65 74 21 20 6d art-index-set! m
ea30: 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 20 atches.
ea40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
ea60: 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0.
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 28 28 63 68 75 ((chu
ea90: 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 nker-get-start c
eaa0: 6e 6b 29 20 73 72 63 29 29 0a 20 20 20 20 20 20 nk) src)).
eab0: 20 20 20 28 28 69 72 72 65 67 65 78 2d 64 66 61 ((irregex-dfa
eac0: 2f 65 78 74 72 61 63 74 20 69 72 78 29 0a 20 20 /extract irx).
ead0: 20 20 20 20 20 20 20 20 63 6e 6b 20 73 72 63 20 cnk src
eae0: 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 ((chunker-get-st
eaf0: 61 72 74 20 63 6e 6b 29 20 73 72 63 29 0a 20 20 art cnk) src).
eb00: 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 (irregex
eb10: 2d 6d 61 74 63 68 2d 65 6e 64 2d 73 6f 75 72 63 -match-end-sourc
eb20: 65 20 6d 61 74 63 68 65 73 20 30 29 0a 20 20 20 e matches 0).
eb30: 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
eb40: 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 20 match-end-index
eb50: 6d 61 74 63 68 65 73 20 30 29 0a 20 20 20 20 20 matches 0).
eb60: 20 20 20 20 20 6d 61 74 63 68 65 73 29 0a 20 20 matches).
eb70: 20 20 20 20 20 20 20 6d 61 74 63 68 65 73 29 29 matches))
eb80: 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 ). (else.
eb90: 20 20 20 28 6c 65 74 2a 20 28 28 6d 61 74 63 68 (let* ((match
eba0: 65 72 20 28 69 72 72 65 67 65 78 2d 6e 66 61 20 er (irregex-nfa
ebb0: 69 72 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 irx)).
ebc0: 20 20 20 28 73 74 72 20 28 28 63 68 75 6e 6b 65 (str ((chunke
ebd0: 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 73 r-get-str cnk) s
ebe0: 72 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 rc)).
ebf0: 20 20 28 69 20 28 28 63 68 75 6e 6b 65 72 2d 67 (i ((chunker-g
ec00: 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 et-start cnk) sr
ec10: 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 c)).
ec20: 20 28 65 6e 64 20 28 28 63 68 75 6e 6b 65 72 2d (end ((chunker-
ec30: 67 65 74 2d 65 6e 64 20 63 6e 6b 29 20 73 72 63 get-end cnk) src
ec40: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
ec50: 28 6d 20 28 6d 61 74 63 68 65 72 20 63 6e 6b 20 (m (matcher cnk
ec60: 73 72 63 20 73 72 63 20 73 74 72 20 69 20 65 6e src src str i en
ec70: 64 20 6d 61 74 63 68 65 73 20 28 6c 61 6d 62 64 d matches (lambd
ec80: 61 20 28 29 20 23 66 29 29 29 29 0a 20 20 20 20 a () #f)))).
ec90: 20 20 20 20 28 61 6e 64 20 6d 0a 20 20 20 20 20 (and m.
eca0: 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 28 63 (not ((c
ecb0: 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 hunker-get-next
ecc0: 63 6e 6b 29 20 28 69 72 72 65 67 65 78 2d 6d 61 cnk) (irregex-ma
ecd0: 74 63 68 2d 65 6e 64 2d 73 6f 75 72 63 65 20 6d tch-end-source m
ece0: 20 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 0))).
ecf0: 20 20 20 28 3d 20 28 28 63 68 75 6e 6b 65 72 2d (= ((chunker-
ed00: 67 65 74 2d 65 6e 64 20 63 6e 6b 29 20 28 69 72 get-end cnk) (ir
ed10: 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d regex-match-end-
ed20: 73 6f 75 72 63 65 20 6d 20 30 29 29 0a 20 20 20 source m 0)).
ed30: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 72 (ir
ed40: 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d regex-match-end-
ed50: 69 6e 64 65 78 20 6d 20 30 29 29 0a 20 20 20 20 index m 0)).
ed60: 20 20 20 20 20 20 20 20 20 6d 29 29 29 29 29 29 m))))))
ed70: 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
ed80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
ed90: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
eda0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
edb0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 44 46 ;;;;;;;;;;.;; DF
edc0: 41 20 6d 61 74 63 68 69 6e 67 0a 0a 3b 3b 20 69 A matching..;; i
edd0: 6e 6c 69 6e 65 20 74 68 65 73 65 0a 28 64 65 66 nline these.(def
ede0: 69 6e 65 20 28 64 66 61 2d 69 6e 69 74 2d 73 74 ine (dfa-init-st
edf0: 61 74 65 20 64 66 61 29 0a 20 20 28 76 65 63 74 ate dfa). (vect
ee00: 6f 72 2d 72 65 66 20 64 66 61 20 30 29 29 0a 28 or-ref dfa 0)).(
ee10: 64 65 66 69 6e 65 20 28 64 66 61 2d 6e 65 78 74 define (dfa-next
ee20: 2d 73 74 61 74 65 20 64 66 61 20 6e 6f 64 65 29 -state dfa node)
ee30: 0a 20 20 28 76 65 63 74 6f 72 2d 72 65 66 20 64 . (vector-ref d
ee40: 66 61 20 28 63 64 72 20 6e 6f 64 65 29 29 29 0a fa (cdr node))).
ee50: 28 64 65 66 69 6e 65 20 28 64 66 61 2d 66 69 6e (define (dfa-fin
ee60: 61 6c 2d 73 74 61 74 65 3f 20 64 66 61 20 73 74 al-state? dfa st
ee70: 61 74 65 29 0a 20 20 28 63 61 72 20 73 74 61 74 ate). (car stat
ee80: 65 29 29 0a 0a 3b 3b 20 74 68 69 73 20 73 65 61 e))..;; this sea
ee90: 72 63 68 65 73 20 66 6f 72 20 74 68 65 20 66 69 rches for the fi
eea0: 72 73 74 20 65 6e 64 20 69 6e 64 65 78 20 66 6f rst end index fo
eeb0: 72 20 77 68 69 63 68 20 61 20 6d 61 74 63 68 20 r which a match
eec0: 69 73 20 70 6f 73 73 69 62 6c 65 0a 28 64 65 66 is possible.(def
eed0: 69 6e 65 20 28 64 66 61 2d 6d 61 74 63 68 2f 73 ine (dfa-match/s
eee0: 68 6f 72 74 65 73 74 20 64 66 61 20 63 6e 6b 20 hortest dfa cnk
eef0: 73 72 63 20 73 74 61 72 74 20 6d 61 74 63 68 65 src start matche
ef00: 73 20 69 6e 64 65 78 29 0a 20 20 28 6c 65 74 20 s index). (let
ef10: 28 28 67 65 74 2d 73 74 72 20 28 63 68 75 6e 6b ((get-str (chunk
ef20: 65 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 29 er-get-str cnk))
ef30: 0a 20 20 20 20 20 20 20 20 28 67 65 74 2d 73 74 . (get-st
ef40: 61 72 74 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 art (chunker-get
ef50: 2d 73 74 61 72 74 20 63 6e 6b 29 29 0a 20 20 20 -start cnk)).
ef60: 20 20 20 20 20 28 67 65 74 2d 65 6e 64 20 28 63 (get-end (c
ef70: 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 hunker-get-end c
ef80: 6e 6b 29 29 0a 20 20 20 20 20 20 20 20 28 67 65 nk)). (ge
ef90: 74 2d 6e 65 78 74 20 28 63 68 75 6e 6b 65 72 2d t-next (chunker-
efa0: 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 29 29 0a get-next cnk))).
efb0: 20 20 20 20 28 6c 65 74 20 6c 70 31 20 28 28 73 (let lp1 ((s
efc0: 72 63 20 73 72 63 29 20 28 73 74 61 72 74 20 73 rc src) (start s
efd0: 74 61 72 74 29 20 28 73 74 61 74 65 20 28 64 66 tart) (state (df
efe0: 61 2d 69 6e 69 74 2d 73 74 61 74 65 20 64 66 61 a-init-state dfa
eff0: 29 29 29 0a 20 20 20 20 20 20 28 61 6e 64 0a 20 ))). (and.
f000: 20 20 20 20 20 20 73 72 63 0a 20 20 20 20 20 20 src.
f010: 20 28 6c 65 74 20 28 28 73 74 72 20 28 67 65 74 (let ((str (get
f020: 2d 73 74 72 20 73 72 63 29 29 0a 20 20 20 20 20 -str src)).
f030: 20 20 20 20 20 20 20 20 28 65 6e 64 20 28 67 65 (end (ge
f040: 74 2d 65 6e 64 20 73 72 63 29 29 29 0a 20 20 20 t-end src))).
f050: 20 20 20 20 20 20 28 6c 65 74 20 6c 70 32 20 28 (let lp2 (
f060: 28 69 20 73 74 61 72 74 29 20 28 73 74 61 74 65 (i start) (state
f070: 20 73 74 61 74 65 29 29 0a 20 20 20 20 20 20 20 state)).
f080: 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 (cond.
f090: 20 20 20 20 20 20 28 28 64 66 61 2d 66 69 6e 61 ((dfa-fina
f0a0: 6c 2d 73 74 61 74 65 3f 20 64 66 61 20 73 74 61 l-state? dfa sta
f0b0: 74 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 te).
f0c0: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond.
f0d0: 20 20 20 20 20 28 69 6e 64 65 78 0a 20 20 20 20 (index.
f0e0: 20 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 (irre
f0f0: 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 73 6f gex-match-end-so
f100: 75 72 63 65 2d 73 65 74 21 20 6d 61 74 63 68 65 urce-set! matche
f110: 73 20 69 6e 64 65 78 20 73 72 63 29 0a 20 20 20 s index src).
f120: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 72 72 (irr
f130: 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 egex-match-end-i
f140: 6e 64 65 78 2d 73 65 74 21 20 6d 61 74 63 68 65 ndex-set! matche
f150: 73 20 69 6e 64 65 78 20 69 29 29 29 0a 20 20 20 s index i))).
f160: 20 20 20 20 20 20 20 20 20 20 23 74 29 0a 20 20 #t).
f170: 20 20 20 20 20 20 20 20 20 20 28 28 3c 20 69 20 ((< i
f180: 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 end).
f190: 20 20 28 6c 65 74 2a 20 28 28 63 68 20 28 73 74 (let* ((ch (st
f1a0: 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 29 ring-ref str i))
f1b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
f1c0: 20 20 20 20 20 28 6e 65 78 74 20 28 66 69 6e 64 (next (find
f1d0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 (lambda (x).
f1e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f1f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
f200: 69 66 20 28 65 71 76 3f 20 63 68 20 28 63 61 72 if (eqv? ch (car
f210: 20 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 x)).
f220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f230: 20 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 20 #t.
f240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f260: 20 20 20 20 28 61 6e 64 20 28 70 61 69 72 3f 20 (and (pair?
f270: 28 63 61 72 20 78 29 29 0a 20 20 20 20 20 20 20 (car x)).
f280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f290: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f2a0: 20 20 20 20 28 63 68 61 72 3c 3d 3f 20 28 63 61 (char<=? (ca
f2b0: 61 72 20 78 29 20 63 68 29 0a 20 20 20 20 20 20 ar x) ch).
f2c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f2d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f2e0: 20 20 20 20 20 28 63 68 61 72 3c 3d 3f 20 63 68 (char<=? ch
f2f0: 20 28 63 64 61 72 20 78 29 29 29 29 29 0a 20 20 (cdar x))))).
f300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
f320: 64 72 20 73 74 61 74 65 29 29 29 29 0a 20 20 20 dr state)))).
f330: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
f340: 20 6e 65 78 74 20 28 6c 70 32 20 28 2b 20 69 20 next (lp2 (+ i
f350: 31 29 20 28 64 66 61 2d 6e 65 78 74 2d 73 74 61 1) (dfa-next-sta
f360: 74 65 20 64 66 61 20 6e 65 78 74 29 29 29 29 29 te dfa next)))))
f370: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c . (el
f380: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
f390: 28 6c 65 74 20 28 28 6e 65 78 74 20 28 67 65 74 (let ((next (get
f3a0: 2d 6e 65 78 74 20 73 72 63 29 29 29 0a 20 20 20 -next src))).
f3b0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
f3c0: 20 6e 65 78 74 20 28 6c 70 31 20 6e 65 78 74 20 next (lp1 next
f3d0: 28 67 65 74 2d 73 74 61 72 74 20 6e 65 78 74 29 (get-start next)
f3e0: 20 73 74 61 74 65 29 29 29 29 29 29 29 29 29 29 state))))))))))
f3f0: 29 0a 0a 3b 3b 20 74 68 69 73 20 66 69 6e 64 73 )..;; this finds
f400: 20 74 68 65 20 6c 6f 6e 67 65 73 74 20 6d 61 74 the longest mat
f410: 63 68 20 73 74 61 72 74 69 6e 67 20 61 74 20 61 ch starting at a
f420: 20 67 69 76 65 6e 20 69 6e 64 65 78 0a 28 64 65 given index.(de
f430: 66 69 6e 65 20 28 64 66 61 2d 6d 61 74 63 68 2f fine (dfa-match/
f440: 6c 6f 6e 67 65 73 74 20 64 66 61 20 63 6e 6b 20 longest dfa cnk
f450: 73 72 63 20 73 74 61 72 74 20 65 6e 64 2d 73 72 src start end-sr
f460: 63 20 65 6e 64 20 6d 61 74 63 68 65 73 20 69 6e c end matches in
f470: 64 65 78 29 0a 20 20 28 6c 65 74 20 28 28 67 65 dex). (let ((ge
f480: 74 2d 73 74 72 20 28 63 68 75 6e 6b 65 72 2d 67 t-str (chunker-g
f490: 65 74 2d 73 74 72 20 63 6e 6b 29 29 0a 20 20 20 et-str cnk)).
f4a0: 20 20 20 20 20 28 67 65 74 2d 73 74 61 72 74 20 (get-start
f4b0: 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 (chunker-get-sta
f4c0: 72 74 20 63 6e 6b 29 29 0a 20 20 20 20 20 20 20 rt cnk)).
f4d0: 20 28 67 65 74 2d 65 6e 64 20 28 63 68 75 6e 6b (get-end (chunk
f4e0: 65 72 2d 67 65 74 2d 65 6e 64 20 63 6e 6b 29 29 er-get-end cnk))
f4f0: 0a 20 20 20 20 20 20 20 20 28 67 65 74 2d 6e 65 . (get-ne
f500: 78 74 20 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d xt (chunker-get-
f510: 6e 65 78 74 20 63 6e 6b 29 29 0a 20 20 20 20 20 next cnk)).
f520: 20 20 20 28 73 74 61 72 74 2d 69 73 2d 66 69 6e (start-is-fin
f530: 61 6c 3f 20 28 64 66 61 2d 66 69 6e 61 6c 2d 73 al? (dfa-final-s
f540: 74 61 74 65 3f 20 64 66 61 20 28 64 66 61 2d 69 tate? dfa (dfa-i
f550: 6e 69 74 2d 73 74 61 74 65 20 64 66 61 29 29 29 nit-state dfa)))
f560: 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 ). (cond.
f570: 20 28 69 6e 64 65 78 0a 20 20 20 20 20 20 28 69 (index. (i
f580: 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 rregex-match-end
f590: 2d 73 6f 75 72 63 65 2d 73 65 74 21 20 6d 61 74 -source-set! mat
f5a0: 63 68 65 73 20 69 6e 64 65 78 20 23 66 29 0a 20 ches index #f).
f5b0: 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 (irregex-ma
f5c0: 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 2d 73 65 tch-end-index-se
f5d0: 74 21 20 6d 61 74 63 68 65 73 20 69 6e 64 65 78 t! matches index
f5e0: 20 23 66 29 29 29 0a 20 20 20 20 28 6c 65 74 20 #f))). (let
f5f0: 6c 70 31 20 28 28 73 72 63 20 73 72 63 29 0a 20 lp1 ((src src).
f600: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
f610: 61 72 74 20 73 74 61 72 74 29 0a 20 20 20 20 20 art start).
f620: 20 20 20 20 20 20 20 20 20 28 73 74 61 74 65 20 (state
f630: 28 64 66 61 2d 69 6e 69 74 2d 73 74 61 74 65 20 (dfa-init-state
f640: 64 66 61 29 29 0a 20 20 20 20 20 20 20 20 20 20 dfa)).
f650: 20 20 20 20 28 72 65 73 2d 73 72 63 20 28 61 6e (res-src (an
f660: 64 20 73 74 61 72 74 2d 69 73 2d 66 69 6e 61 6c d start-is-final
f670: 3f 20 73 72 63 29 29 0a 20 20 20 20 20 20 20 20 ? src)).
f680: 20 20 20 20 20 20 28 72 65 73 2d 69 6e 64 65 78 (res-index
f690: 20 28 61 6e 64 20 73 74 61 72 74 2d 69 73 2d 66 (and start-is-f
f6a0: 69 6e 61 6c 3f 20 73 74 61 72 74 29 29 29 0a 20 inal? start))).
f6b0: 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 72 20 (let ((str
f6c0: 28 67 65 74 2d 73 74 72 20 73 72 63 29 29 0a 20 (get-str src)).
f6d0: 20 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 (end
f6e0: 28 69 66 20 28 65 71 3f 20 73 72 63 20 65 6e 64 (if (eq? src end
f6f0: 2d 73 72 63 29 20 65 6e 64 20 28 67 65 74 2d 65 -src) end (get-e
f700: 6e 64 20 73 72 63 29 29 29 29 0a 20 20 20 20 20 nd src)))).
f710: 20 20 20 28 6c 65 74 20 6c 70 32 20 28 28 69 20 (let lp2 ((i
f720: 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 20 20 start).
f730: 20 20 20 20 20 20 20 20 20 28 73 74 61 74 65 20 (state
f740: 73 74 61 74 65 29 0a 20 20 20 20 20 20 20 20 20 state).
f750: 20 20 20 20 20 20 20 20 20 28 72 65 73 2d 73 72 (res-sr
f760: 63 20 72 65 73 2d 73 72 63 29 0a 20 20 20 20 20 c res-src).
f770: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
f780: 73 2d 69 6e 64 65 78 20 72 65 73 2d 69 6e 64 65 s-index res-inde
f790: 78 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 63 x)). (c
f7a0: 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 28 ond. (
f7b0: 28 3e 3d 20 69 20 65 6e 64 29 0a 20 20 20 20 20 (>= i end).
f7c0: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
f7d0: 20 20 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 ((and
f7e0: 69 6e 64 65 78 20 72 65 73 2d 73 72 63 29 0a 20 index res-src).
f7f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 72 (ir
f800: 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d regex-match-end-
f810: 73 6f 75 72 63 65 2d 73 65 74 21 20 6d 61 74 63 source-set! matc
f820: 68 65 73 20 69 6e 64 65 78 20 72 65 73 2d 73 72 hes index res-sr
f830: 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 c).
f840: 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
f850: 65 6e 64 2d 69 6e 64 65 78 2d 73 65 74 21 20 6d end-index-set! m
f860: 61 74 63 68 65 73 20 69 6e 64 65 78 20 72 65 73 atches index res
f870: 2d 69 6e 64 65 78 29 29 29 0a 20 20 20 20 20 20 -index))).
f880: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 78 (let ((nex
f890: 74 20 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 3f t (and (not (eq?
f8a0: 20 73 72 63 20 65 6e 64 2d 73 72 63 29 29 20 28 src end-src)) (
f8b0: 67 65 74 2d 6e 65 78 74 20 73 72 63 29 29 29 29 get-next src))))
f8c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . (
f8d0: 69 66 20 6e 65 78 74 0a 20 20 20 20 20 20 20 20 if next.
f8e0: 20 20 20 20 20 20 20 20 20 20 28 6c 70 31 20 6e (lp1 n
f8f0: 65 78 74 20 28 67 65 74 2d 73 74 61 72 74 20 6e ext (get-start n
f900: 65 78 74 29 20 73 74 61 74 65 20 72 65 73 2d 73 ext) state res-s
f910: 72 63 20 72 65 73 2d 69 6e 64 65 78 29 0a 20 20 rc res-index).
f920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f930: 28 61 6e 64 20 69 6e 64 65 78 0a 20 20 20 20 20 (and index.
f940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f950: 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (irregex-match
f960: 2d 65 6e 64 2d 73 6f 75 72 63 65 20 6d 61 74 63 -end-source matc
f970: 68 65 73 20 69 6e 64 65 78 29 0a 20 20 20 20 20 hes index).
f980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
f990: 20 20 23 74 29 29 29 29 0a 20 20 20 20 20 20 20 #t)))).
f9a0: 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
f9b0: 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 63 68 (let* ((ch
f9c0: 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
f9d0: 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i)).
f9e0: 20 20 20 20 20 20 20 20 28 63 65 6c 6c 20 28 66 (cell (f
f9f0: 69 6e 64 20 28 6c 61 6d 62 64 61 20 28 78 29 0a ind (lambda (x).
fa00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa20: 20 28 69 66 20 28 65 71 76 3f 20 63 68 20 28 63 (if (eqv? ch (c
fa30: 61 72 20 78 29 29 0a 20 20 20 20 20 20 20 20 20 ar x)).
fa40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa50: 20 20 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 #t.
fa60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fa80: 20 20 20 20 28 61 6e 64 20 28 70 61 69 72 3f 20 (and (pair?
fa90: 28 63 61 72 20 78 29 29 0a 20 20 20 20 20 20 20 (car x)).
faa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fac0: 20 20 20 28 63 68 61 72 3c 3d 3f 20 28 63 61 61 (char<=? (caa
fad0: 72 20 78 29 20 63 68 29 0a 20 20 20 20 20 20 20 r x) ch).
fae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
faf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb00: 20 20 20 28 63 68 61 72 3c 3d 3f 20 63 68 20 28 (char<=? ch (
fb10: 63 64 61 72 20 78 29 29 29 29 29 0a 20 20 20 20 cdar x))))).
fb20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fb30: 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 20 (cdr
fb40: 73 74 61 74 65 29 29 29 29 0a 20 20 20 20 20 20 state)))).
fb50: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
fb60: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 65 (ce
fb70: 6c 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ll.
fb80: 20 20 20 28 6c 65 74 20 28 28 6e 65 78 74 20 28 (let ((next (
fb90: 64 66 61 2d 6e 65 78 74 2d 73 74 61 74 65 20 64 dfa-next-state d
fba0: 66 61 20 63 65 6c 6c 29 29 29 0a 20 20 20 20 20 fa cell))).
fbb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
fbc0: 20 28 64 66 61 2d 66 69 6e 61 6c 2d 73 74 61 74 (dfa-final-stat
fbd0: 65 3f 20 64 66 61 20 6e 65 78 74 29 0a 20 20 20 e? dfa next).
fbe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fbf0: 20 20 20 28 6c 70 32 20 28 2b 20 69 20 31 29 20 (lp2 (+ i 1)
fc00: 6e 65 78 74 20 73 72 63 20 28 2b 20 69 20 31 29 next src (+ i 1)
fc10: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
fc20: 20 20 20 20 20 20 20 20 28 6c 70 32 20 28 2b 20 (lp2 (+
fc30: 69 20 31 29 20 6e 65 78 74 20 72 65 73 2d 73 72 i 1) next res-sr
fc40: 63 20 72 65 73 2d 69 6e 64 65 78 29 29 29 29 0a c res-index)))).
fc50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
fc60: 72 65 73 2d 73 72 63 0a 20 20 20 20 20 20 20 20 res-src.
fc70: 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
fc80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
fc90: 69 6e 64 65 78 0a 20 20 20 20 20 20 20 20 20 20 index.
fca0: 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 (irregex
fcb0: 2d 6d 61 74 63 68 2d 65 6e 64 2d 73 6f 75 72 63 -match-end-sourc
fcc0: 65 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 69 e-set! matches i
fcd0: 6e 64 65 78 20 72 65 73 2d 73 72 63 29 0a 20 20 ndex res-src).
fce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
fcf0: 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 (irregex-match-e
fd00: 6e 64 2d 69 6e 64 65 78 2d 73 65 74 21 20 6d 61 nd-index-set! ma
fd10: 74 63 68 65 73 20 69 6e 64 65 78 20 72 65 73 2d tches index res-
fd20: 69 6e 64 65 78 29 29 29 0a 20 20 20 20 20 20 20 index))).
fd30: 20 20 20 20 20 20 20 20 20 23 74 29 0a 20 20 20 #t).
fd40: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 6e ((an
fd50: 64 20 69 6e 64 65 78 20 28 69 72 72 65 67 65 78 d index (irregex
fd60: 2d 6d 61 74 63 68 2d 65 6e 64 2d 73 6f 75 72 63 -match-end-sourc
fd70: 65 20 6d 61 74 63 68 65 73 20 69 6e 64 65 78 29 e matches index)
fd80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
fd90: 20 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 #t).
fda0: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
fdb0: 20 20 20 20 20 20 20 20 20 20 20 23 66 29 29 29 #f)))
fdc0: 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b )))))))..;;;;;;;
fdd0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fde0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fdf0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fe00: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
fe10: 3b 0a 3b 3b 20 53 52 45 2d 3e 4e 46 41 20 63 6f ;.;; SRE->NFA co
fe20: 6d 70 69 6c 61 74 69 6f 6e 0a 3b 3b 0a 3b 3b 20 mpilation.;;.;;
fe30: 41 6e 20 4e 46 41 20 73 74 61 74 65 20 69 73 20 An NFA state is
fe40: 61 20 6e 75 6d 62 65 72 65 64 20 6e 6f 64 65 20 a numbered node
fe50: 77 69 74 68 20 61 20 6c 69 73 74 20 6f 66 20 70 with a list of p
fe60: 61 74 74 65 72 2d 3e 6e 75 6d 62 65 72 0a 3b 3b atter->number.;;
fe70: 20 74 72 61 6e 73 69 74 69 6f 6e 73 2c 20 77 68 transitions, wh
fe80: 65 72 65 20 70 61 74 74 65 72 6e 20 69 73 20 65 ere pattern is e
fe90: 69 74 68 65 72 20 61 20 63 68 61 72 61 63 74 65 ither a characte
fea0: 72 2c 20 28 6c 6f 20 2e 20 68 69 29 0a 3b 3b 20 r, (lo . hi).;;
feb0: 63 68 61 72 61 63 74 65 72 20 72 61 6e 67 65 2c character range,
fec0: 20 6f 72 20 65 70 73 69 6c 6f 6e 20 28 69 6e 64 or epsilon (ind
fed0: 69 63 61 74 69 6e 67 20 61 6e 20 65 6d 70 74 79 icating an empty
fee0: 20 74 72 61 6e 73 69 74 69 6f 6e 29 2e 0a 3b 3b transition)..;;
fef0: 20 54 68 65 72 65 20 6d 61 79 20 62 65 20 64 75 There may be du
ff00: 70 6c 69 63 61 74 65 20 63 68 61 72 61 63 74 65 plicate characte
ff10: 72 73 20 61 6e 64 20 6f 76 65 72 6c 61 70 70 69 rs and overlappi
ff20: 6e 67 20 72 61 6e 67 65 73 20 2d 20 73 69 6e 63 ng ranges - sinc
ff30: 65 0a 3b 3b 20 69 74 27 73 20 61 6e 20 4e 46 41 e.;; it's an NFA
ff40: 20 77 65 20 70 72 6f 63 65 73 73 20 69 74 20 62 we process it b
ff50: 79 20 63 6f 6e 73 69 64 65 72 69 6e 67 20 61 6c y considering al
ff60: 6c 20 70 6f 73 73 69 62 6c 65 20 74 72 61 6e 73 l possible trans
ff70: 69 74 69 6f 6e 73 2e 0a 0a 28 64 65 66 69 6e 65 itions...(define
ff80: 20 73 72 65 2d 6e 61 6d 65 64 2d 64 65 66 69 6e sre-named-defin
ff90: 69 74 69 6f 6e 73 0a 20 20 60 28 28 61 6e 79 20 itions. `((any
ffa0: 2e 20 2c 2a 61 6c 6c 2d 63 68 61 72 73 2a 29 0a . ,*all-chars*).
ffb0: 20 20 20 20 28 6e 6f 6e 6c 20 2e 20 28 2d 20 2c (nonl . (- ,
ffc0: 2a 61 6c 6c 2d 63 68 61 72 73 2a 20 28 2c 28 73 *all-chars* (,(s
ffd0: 74 72 69 6e 67 20 23 5c 6e 65 77 6c 69 6e 65 29 tring #\newline)
ffe0: 29 29 29 0a 20 20 20 20 28 61 6c 70 68 61 62 65 ))). (alphabe
fff0: 74 69 63 20 2e 20 28 2f 20 23 5c 61 20 23 5c 7a tic . (/ #\a #\z
10000 20 23 5c 41 20 23 5c 5a 29 29 0a 20 20 20 20 28 #\A #\Z)). (
10010 61 6c 70 68 61 20 2e 20 61 6c 70 68 61 62 65 74 alpha . alphabet
10020 69 63 29 0a 20 20 20 20 28 61 6c 70 68 61 6e 75 ic). (alphanu
10030 6d 65 72 69 63 20 2e 20 28 2f 20 23 5c 61 20 23 meric . (/ #\a #
10040 5c 7a 20 23 5c 41 20 23 5c 5a 20 23 5c 30 20 23 \z #\A #\Z #\0 #
10050 5c 39 29 29 0a 20 20 20 20 28 61 6c 70 68 61 6e \9)). (alphan
10060 75 6d 20 2e 20 61 6c 70 68 61 6e 75 6d 65 72 69 um . alphanumeri
10070 63 29 0a 20 20 20 20 28 61 6c 6e 75 6d 20 2e 20 c). (alnum .
10080 61 6c 70 68 61 6e 75 6d 65 72 69 63 29 0a 20 20 alphanumeric).
10090 20 20 28 6c 6f 77 65 72 2d 63 61 73 65 20 2e 20 (lower-case .
100a0 28 2f 20 23 5c 61 20 23 5c 7a 29 29 0a 20 20 20 (/ #\a #\z)).
100b0 20 28 6c 6f 77 65 72 20 2e 20 6c 6f 77 65 72 2d (lower . lower-
100c0 63 61 73 65 29 0a 20 20 20 20 28 75 70 70 65 72 case). (upper
100d0 2d 63 61 73 65 20 2e 20 28 2f 20 23 5c 41 20 23 -case . (/ #\A #
100e0 5c 5a 29 29 0a 20 20 20 20 28 75 70 70 65 72 20 \Z)). (upper
100f0 2e 20 75 70 70 65 72 2d 63 61 73 65 29 0a 20 20 . upper-case).
10100 20 20 28 6e 75 6d 65 72 69 63 20 2e 20 28 2f 20 (numeric . (/
10110 23 5c 30 20 23 5c 39 29 29 0a 20 20 20 20 28 6e #\0 #\9)). (n
10120 75 6d 20 2e 20 6e 75 6d 65 72 69 63 29 0a 20 20 um . numeric).
10130 20 20 28 64 69 67 69 74 20 2e 20 6e 75 6d 65 72 (digit . numer
10140 69 63 29 0a 20 20 20 20 28 70 75 6e 63 74 75 61 ic). (punctua
10150 74 69 6f 6e 20 2e 20 28 6f 72 20 23 5c 21 20 23 tion . (or #\! #
10160 5c 22 20 23 5c 23 20 23 5c 25 20 23 5c 26 20 23 \" #\# #\% #\& #
10170 5c 27 20 23 5c 28 20 23 5c 29 20 23 5c 2a 20 23 \' #\( #\) #\* #
10180 5c 2c 20 23 5c 2d 20 23 5c 2e 0a 20 20 20 20 20 \, #\- #\..
10190 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
101a0 20 20 23 5c 2f 20 23 5c 3a 20 23 5c 3b 20 23 5c #\/ #\: #\; #\
101b0 3f 20 23 5c 40 20 23 5c 5b 20 23 5c 5c 20 23 5c ? #\@ #\[ #\\ #\
101c0 5d 20 23 5c 5f 20 23 5c 7b 20 23 5c 7d 29 29 0a ] #\_ #\{ #\})).
101d0 20 20 20 20 28 70 75 6e 63 74 20 2e 20 70 75 6e (punct . pun
101e0 63 74 75 61 74 69 6f 6e 29 0a 20 20 20 20 28 67 ctuation). (g
101f0 72 61 70 68 69 63 0a 20 20 20 20 20 2e 20 28 6f raphic. . (o
10200 72 20 61 6c 70 68 61 6e 75 6d 65 72 69 63 20 70 r alphanumeric p
10210 75 6e 63 74 75 61 74 69 6f 6e 20 23 5c 24 20 23 unctuation #\$ #
10220 5c 2b 20 23 5c 3c 20 23 5c 3d 20 23 5c 3e 20 23 \+ #\< #\= #\> #
10230 5c 5e 20 23 5c 60 20 23 5c 7c 20 23 5c 7e 29 29 \^ #\` #\| #\~))
10240 0a 20 20 20 20 28 67 72 61 70 68 20 2e 20 67 72 . (graph . gr
10250 61 70 68 69 63 29 0a 20 20 20 20 28 62 6c 61 6e aphic). (blan
10260 6b 20 2e 20 28 6f 72 20 23 5c 73 70 61 63 65 20 k . (or #\space
10270 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
10280 28 2d 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 (- (char->intege
10290 72 20 23 5c 73 70 61 63 65 29 20 32 33 29 29 29 r #\space) 23)))
102a0 29 0a 20 20 20 20 28 77 68 69 74 65 73 70 61 63 ). (whitespac
102b0 65 20 2e 20 28 6f 72 20 62 6c 61 6e 6b 20 23 5c e . (or blank #\
102c0 6e 65 77 6c 69 6e 65 29 29 0a 20 20 20 20 28 73 newline)). (s
102d0 70 61 63 65 20 2e 20 77 68 69 74 65 73 70 61 63 pace . whitespac
102e0 65 29 0a 20 20 20 20 28 77 68 69 74 65 20 2e 20 e). (white .
102f0 77 68 69 74 65 73 70 61 63 65 29 0a 20 20 20 20 whitespace).
10300 28 70 72 69 6e 74 69 6e 67 20 6f 72 20 67 72 61 (printing or gra
10310 70 68 69 63 20 77 68 69 74 65 73 70 61 63 65 29 phic whitespace)
10320 0a 20 20 20 20 28 70 72 69 6e 74 20 2e 20 70 72 . (print . pr
10330 69 6e 74 69 6e 67 29 0a 0a 20 20 20 20 3b 3b 20 inting).. ;;
10340 58 58 58 58 20 77 65 20 61 73 73 75 6d 65 20 61 XXXX we assume a
10350 20 28 70 6f 73 73 69 62 6c 79 20 73 68 69 66 74 (possibly shift
10360 65 64 29 20 41 53 43 49 49 2d 62 61 73 65 64 20 ed) ASCII-based
10370 6f 72 64 65 72 69 6e 67 0a 20 20 20 20 28 63 6f ordering. (co
10380 6e 74 72 6f 6c 20 2e 20 28 2f 20 2c 28 69 6e 74 ntrol . (/ ,(int
10390 65 67 65 72 2d 3e 63 68 61 72 20 28 2d 20 28 63 eger->char (- (c
103a0 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 har->integer #\s
103b0 70 61 63 65 29 20 33 32 29 29 0a 20 20 20 20 20 pace) 32)).
103c0 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 69 ,(i
103d0 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2d 20 nteger->char (-
103e0 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 (char->integer #
103f0 5c 73 70 61 63 65 29 20 31 29 29 29 29 0a 20 20 \space) 1)))).
10400 20 20 28 63 6e 74 72 6c 20 2e 20 63 6f 6e 74 72 (cntrl . contr
10410 6f 6c 29 0a 20 20 20 20 28 68 65 78 2d 64 69 67 ol). (hex-dig
10420 69 74 20 2e 20 28 6f 72 20 6e 75 6d 65 72 69 63 it . (or numeric
10430 20 28 2f 20 23 5c 61 20 23 5c 66 20 23 5c 41 20 (/ #\a #\f #\A
10440 23 5c 46 29 29 29 0a 20 20 20 20 28 78 64 69 67 #\F))). (xdig
10450 69 74 20 2e 20 68 65 78 2d 64 69 67 69 74 29 0a it . hex-digit).
10460 20 20 20 20 28 61 73 63 69 69 20 2e 20 28 2f 20 (ascii . (/
10470 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
10480 28 2d 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 (- (char->intege
10490 72 20 23 5c 73 70 61 63 65 29 20 33 32 29 29 0a r #\space) 32)).
104a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
104b0 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
104c0 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 (+ (char->intege
104d0 72 20 23 5c 73 70 61 63 65 29 20 39 35 29 29 29 r #\space) 95)))
104e0 29 0a 20 20 20 20 28 61 73 63 69 69 2d 6e 6f 6e ). (ascii-non
104f0 6c 20 2e 20 28 2f 20 2c 28 69 6e 74 65 67 65 72 l . (/ ,(integer
10500 2d 3e 63 68 61 72 20 28 2d 20 28 63 68 61 72 2d ->char (- (char-
10510 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 61 63 65 >integer #\space
10520 29 20 33 32 29 29 0a 20 20 20 20 20 20 20 20 20 ) 32)).
10530 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 69 6e ,(in
10540 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2d 20 28 teger->char (- (
10550 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c char->integer #\
10560 6e 65 77 6c 69 6e 65 29 20 31 29 29 0a 20 20 20 newline) 1)).
10570 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10580 20 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 ,(integer->cha
10590 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 r (+ (char->inte
105a0 67 65 72 20 23 5c 6e 65 77 6c 69 6e 65 29 20 31 ger #\newline) 1
105b0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
105c0 20 20 20 20 20 20 20 20 2c 28 69 6e 74 65 67 65 ,(intege
105d0 72 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 61 72 r->char (+ (char
105e0 2d 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 61 63 ->integer #\spac
105f0 65 29 20 39 35 29 29 29 29 0a 20 20 20 20 28 6e e) 95)))). (n
10600 65 77 6c 69 6e 65 20 2e 20 28 6f 72 20 28 73 65 ewline . (or (se
10610 71 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 q ,(integer->cha
10620 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 r (+ (char->inte
10630 67 65 72 20 23 5c 6e 65 77 6c 69 6e 65 29 20 33 ger #\newline) 3
10640 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
10650 20 20 20 20 20 20 20 20 20 20 20 23 5c 6e 65 77 #\new
10660 6c 69 6e 65 29 0a 20 20 20 20 20 20 20 20 20 20 line).
10670 20 20 20 20 20 20 20 20 20 28 2f 20 23 5c 6e 65 (/ #\ne
10680 77 6c 69 6e 65 0a 20 20 20 20 20 20 20 20 20 20 wline.
10690 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 69 6e ,(in
106a0 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 teger->char (+ (
106b0 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 5c char->integer #\
106c0 6e 65 77 6c 69 6e 65 29 20 33 29 29 29 29 29 0a newline) 3))))).
106d0 0a 20 20 20 20 3b 3b 20 2e 2e 2e 20 69 74 27 73 . ;; ... it's
106e0 20 72 65 61 6c 6c 79 20 61 6e 6e 6f 79 69 6e 67 really annoying
106f0 20 74 6f 20 73 75 70 70 6f 72 74 20 6f 6c 64 20 to support old
10700 53 63 68 65 6d 65 34 38 0a 20 20 20 20 28 77 6f Scheme48. (wo
10710 72 64 20 2e 20 28 73 65 71 20 62 6f 77 20 28 2b rd . (seq bow (+
10720 20 28 6f 72 20 61 6c 70 68 61 6e 75 6d 65 72 69 (or alphanumeri
10730 63 20 23 5c 5f 29 29 20 65 6f 77 29 29 0a 20 20 c #\_)) eow)).
10740 20 20 28 75 74 66 38 2d 74 61 69 6c 2d 63 68 61 (utf8-tail-cha
10750 72 20 2e 20 28 2f 20 2c 28 69 6e 74 65 67 65 72 r . (/ ,(integer
10760 2d 3e 63 68 61 72 20 28 2b 20 28 63 68 61 72 2d ->char (+ (char-
10770 3e 69 6e 74 65 67 65 72 20 23 5c 73 70 61 63 65 >integer #\space
10780 29 20 23 78 36 30 29 29 0a 20 20 20 20 20 20 20 ) #x60)).
10790 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
107a0 20 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 ,(integer->cha
107b0 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 r (+ (char->inte
107c0 67 65 72 20 23 5c 73 70 61 63 65 29 20 23 78 41 ger #\space) #xA
107d0 31 29 29 29 29 0a 20 20 20 20 28 75 74 66 38 2d 1)))). (utf8-
107e0 32 2d 63 68 61 72 20 2e 20 28 73 65 71 20 28 2f 2-char . (seq (/
107f0 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 ,(integer->char
10800 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 (+ (char->integ
10810 65 72 20 23 5c 73 70 61 63 65 29 20 23 78 41 32 er #\space) #xA2
10820 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
10830 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 ,(
10840 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b integer->char (+
10850 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 (char->integer
10860 23 5c 73 70 61 63 65 29 20 23 78 42 46 29 29 29 #\space) #xBF)))
10870 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
10880 20 20 20 20 20 20 20 20 20 75 74 66 38 2d 74 61 utf8-ta
10890 69 6c 2d 63 68 61 72 29 29 0a 20 20 20 20 28 75 il-char)). (u
108a0 74 66 38 2d 33 2d 63 68 61 72 20 2e 20 28 73 65 tf8-3-char . (se
108b0 71 20 28 2f 20 2c 28 69 6e 74 65 67 65 72 2d 3e q (/ ,(integer->
108c0 63 68 61 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 char (+ (char->i
108d0 6e 74 65 67 65 72 20 23 5c 73 70 61 63 65 29 20 nteger #\space)
108e0 23 78 43 30 29 29 0a 20 20 20 20 20 20 20 20 20 #xC0)).
108f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10900 20 20 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 ,(integer->cha
10910 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 r (+ (char->inte
10920 67 65 72 20 23 5c 73 70 61 63 65 29 20 23 78 43 ger #\space) #xC
10930 46 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 F))).
10940 20 20 20 20 20 20 20 20 20 20 20 20 20 75 74 66 utf
10950 38 2d 74 61 69 6c 2d 63 68 61 72 0a 20 20 20 20 8-tail-char.
10960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10970 20 20 20 20 75 74 66 38 2d 74 61 69 6c 2d 63 68 utf8-tail-ch
10980 61 72 29 29 0a 20 20 20 20 28 75 74 66 38 2d 34 ar)). (utf8-4
10990 2d 63 68 61 72 20 2e 20 28 73 65 71 20 28 2f 20 -char . (seq (/
109a0 2c 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 ,(integer->char
109b0 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 (+ (char->intege
109c0 72 20 23 5c 73 70 61 63 65 29 20 23 78 44 30 29 r #\space) #xD0)
109d0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
109e0 20 20 20 20 20 20 20 20 20 20 20 20 20 2c 28 69 ,(i
109f0 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 nteger->char (+
10a00 28 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 23 (char->integer #
10a10 5c 73 70 61 63 65 29 20 23 78 44 37 29 29 29 0a \space) #xD7))).
10a20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10a30 20 20 20 20 20 20 20 20 75 74 66 38 2d 74 61 69 utf8-tai
10a40 6c 2d 63 68 61 72 0a 20 20 20 20 20 20 20 20 20 l-char.
10a50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 75 u
10a60 74 66 38 2d 74 61 69 6c 2d 63 68 61 72 0a 20 20 tf8-tail-char.
10a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10a80 20 20 20 20 20 20 75 74 66 38 2d 74 61 69 6c 2d utf8-tail-
10a90 63 68 61 72 29 29 0a 20 20 20 20 28 75 74 66 38 char)). (utf8
10aa0 2d 61 6e 79 20 2e 20 28 6f 72 20 61 73 63 69 69 -any . (or ascii
10ab0 20 75 74 66 38 2d 32 2d 63 68 61 72 20 75 74 66 utf8-2-char utf
10ac0 38 2d 33 2d 63 68 61 72 20 75 74 66 38 2d 34 2d 8-3-char utf8-4-
10ad0 63 68 61 72 29 29 0a 20 20 20 20 28 75 74 66 38 char)). (utf8
10ae0 2d 6e 6f 6e 6c 20 2e 20 28 6f 72 20 61 73 63 69 -nonl . (or asci
10af0 69 2d 6e 6f 6e 6c 20 75 74 66 38 2d 32 2d 63 68 i-nonl utf8-2-ch
10b00 61 72 20 75 74 66 38 2d 33 2d 63 68 61 72 20 75 ar utf8-3-char u
10b10 74 66 38 2d 34 2d 63 68 61 72 29 29 0a 0a 20 20 tf8-4-char))..
10b20 20 20 3b 3b 20 65 78 74 65 6e 64 65 64 20 6c 69 ;; extended li
10b30 62 72 61 72 79 20 70 61 74 74 65 72 6e 73 0a 20 brary patterns.
10b40 20 20 20 28 69 6e 74 65 67 65 72 20 2e 20 28 73 (integer . (s
10b50 65 71 20 28 3f 20 28 6f 72 20 23 5c 2b 20 23 5c eq (? (or #\+ #\
10b60 2d 29 29 20 28 2b 20 6e 75 6d 65 72 69 63 29 29 -)) (+ numeric))
10b70 29 0a 20 20 20 20 28 72 65 61 6c 20 2e 20 28 73 ). (real . (s
10b80 65 71 20 28 2b 20 6e 75 6d 65 72 69 63 29 20 28 eq (+ numeric) (
10b90 3f 20 23 5c 2e 20 28 2b 20 6e 75 6d 65 72 69 63 ? #\. (+ numeric
10ba0 29 29 20 28 3f 20 28 6f 72 20 23 5c 65 20 23 5c )) (? (or #\e #\
10bb0 45 29 20 69 6e 74 65 67 65 72 29 29 29 0a 20 20 E) integer))).
10bc0 20 20 28 73 74 72 69 6e 67 20 2e 20 28 73 65 71 (string . (seq
10bd0 20 23 5c 22 20 28 65 73 63 61 70 65 20 23 5c 5c #\" (escape #\\
10be0 20 23 5c 22 29 20 23 5c 22 29 29 0a 20 20 20 20 #\") #\")).
10bf0 28 65 73 63 61 70 65 20 2e 20 2c 28 6c 61 6d 62 (escape . ,(lamb
10c00 64 61 20 28 65 73 63 20 2e 20 6f 29 20 60 28 2a da (esc . o) `(*
10c10 20 28 6f 72 20 28 7e 20 2c 65 73 63 20 2c 40 6f (or (~ ,esc ,@o
10c20 29 20 28 73 65 71 20 2c 65 73 63 20 61 6e 79 29 ) (seq ,esc any)
10c30 29 29 29 29 0a 0a 20 20 20 20 28 69 70 76 34 2d )))).. (ipv4-
10c40 64 69 67 69 74 20 2e 20 28 73 65 71 20 28 3f 20 digit . (seq (?
10c50 28 2f 20 22 31 32 22 29 29 20 28 3f 20 6e 75 6d (/ "12")) (? num
10c60 65 72 69 63 29 20 6e 75 6d 65 72 69 63 29 29 0a eric) numeric)).
10c70 20 20 20 20 28 69 70 76 34 2d 61 64 64 72 65 73 (ipv4-addres
10c80 73 20 2e 20 28 73 65 71 20 69 70 76 34 2d 64 69 s . (seq ipv4-di
10c90 67 69 74 20 28 3d 20 33 20 23 5c 2e 20 69 70 76 git (= 3 #\. ipv
10ca0 34 2d 64 69 67 69 74 29 29 29 0a 20 20 20 20 3b 4-digit))). ;
10cb0 3b 20 58 58 58 58 20 6c 61 78 2c 20 61 6c 6c 6f ; XXXX lax, allo
10cc0 77 73 20 6d 75 6c 74 69 70 6c 65 20 64 6f 75 62 ws multiple doub
10cd0 6c 65 2d 63 6f 6c 6f 6e 73 20 6f 72 20 3c 20 38 le-colons or < 8
10ce0 20 74 65 72 6d 73 20 77 2f 6f 20 61 20 3a 3a 0a terms w/o a ::.
10cf0 20 20 20 20 28 69 70 76 36 2d 61 64 64 72 65 73 (ipv6-addres
10d00 73 20 2e 20 28 73 65 71 20 28 2a 2a 20 30 20 34 s . (seq (** 0 4
10d10 20 68 65 78 2d 64 69 67 69 74 29 0a 20 20 20 20 hex-digit).
10d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10d30 20 20 20 20 20 28 2a 2a 20 31 20 37 20 23 5c 3a (** 1 7 #\:
10d40 20 28 3f 20 23 5c 3a 29 20 28 2a 2a 20 30 20 34 (? #\:) (** 0 4
10d50 20 68 65 78 2d 64 69 67 69 74 29 29 29 29 0a 20 hex-digit)))).
10d60 20 20 20 28 69 70 2d 61 64 64 72 65 73 73 20 2e (ip-address .
10d70 20 28 6f 72 20 69 70 76 34 2d 61 64 64 72 65 73 (or ipv4-addres
10d80 73 20 69 70 76 36 2d 61 64 64 72 65 73 73 29 29 s ipv6-address))
10d90 0a 20 20 20 20 28 64 6f 6d 61 69 6e 2d 61 74 6f . (domain-ato
10da0 6d 20 2e 20 28 2b 20 28 6f 72 20 61 6c 70 68 61 m . (+ (or alpha
10db0 6e 75 6d 65 72 69 63 20 23 5c 5f 20 23 5c 2d 29 numeric #\_ #\-)
10dc0 29 29 0a 20 20 20 20 28 64 6f 6d 61 69 6e 20 2e )). (domain .
10dd0 20 28 73 65 71 20 64 6f 6d 61 69 6e 2d 61 74 6f (seq domain-ato
10de0 6d 20 28 2b 20 23 5c 2e 20 64 6f 6d 61 69 6e 2d m (+ #\. domain-
10df0 61 74 6f 6d 29 29 29 0a 20 20 20 20 3b 3b 20 58 atom))). ;; X
10e00 58 58 58 20 6e 6f 77 20 61 6e 79 74 68 69 6e 67 XXX now anything
10e10 20 63 61 6e 20 62 65 20 61 20 74 6f 70 2d 6c 65 can be a top-le
10e20 76 65 6c 20 64 6f 6d 61 69 6e 2c 20 62 75 74 20 vel domain, but
10e30 74 68 69 73 20 69 73 20 73 74 69 6c 6c 20 68 61 this is still ha
10e40 6e 64 79 0a 20 20 20 20 28 74 6f 70 2d 6c 65 76 ndy. (top-lev
10e50 65 6c 2d 64 6f 6d 61 69 6e 20 2e 20 28 77 2f 6e el-domain . (w/n
10e60 6f 63 61 73 65 20 28 6f 72 20 22 61 72 70 61 22 ocase (or "arpa"
10e70 20 22 63 6f 6d 22 20 22 67 6f 76 22 20 22 6d 69 "com" "gov" "mi
10e80 6c 22 20 22 6e 65 74 22 20 22 6f 72 67 22 0a 20 l" "net" "org".
10e90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10ea0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10eb0 20 20 20 20 20 22 61 65 72 6f 22 20 22 62 69 7a "aero" "biz
10ec0 22 20 22 63 6f 6f 70 22 20 22 69 6e 66 6f 22 20 " "coop" "info"
10ed0 22 6d 75 73 65 75 6d 22 0a 20 20 20 20 20 20 20 "museum".
10ee0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
10ef0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 "
10f00 6e 61 6d 65 22 20 22 70 72 6f 22 20 28 3d 20 32 name" "pro" (= 2
10f10 20 61 6c 70 68 61 29 29 29 29 0a 20 20 20 20 28 alpha)))). (
10f20 64 6f 6d 61 69 6e 2f 63 6f 6d 6d 6f 6e 20 2e 20 domain/common .
10f30 28 73 65 71 20 28 2b 20 64 6f 6d 61 69 6e 2d 61 (seq (+ domain-a
10f40 74 6f 6d 20 23 5c 2e 29 20 74 6f 70 2d 6c 65 76 tom #\.) top-lev
10f50 65 6c 2d 64 6f 6d 61 69 6e 29 29 0a 20 20 20 20 el-domain)).
10f60 3b 3b 28 65 6d 61 69 6c 2d 6c 6f 63 61 6c 2d 70 ;;(email-local-p
10f70 61 72 74 20 2e 20 28 73 65 71 20 28 2b 20 28 6f art . (seq (+ (o
10f80 72 20 28 7e 20 23 5c 22 29 20 73 74 72 69 6e 67 r (~ #\") string
10f90 29 29 29 29 0a 20 20 20 20 28 65 6d 61 69 6c 2d )))). (email-
10fa0 6c 6f 63 61 6c 2d 70 61 72 74 20 2e 20 28 2b 20 local-part . (+
10fb0 28 6f 72 20 61 6c 70 68 61 6e 75 6d 65 72 69 63 (or alphanumeric
10fc0 20 23 5c 5f 20 23 5c 2d 20 23 5c 2e 20 23 5c 2b #\_ #\- #\. #\+
10fd0 29 29 29 0a 20 20 20 20 28 65 6d 61 69 6c 20 2e ))). (email .
10fe0 20 28 73 65 71 20 65 6d 61 69 6c 2d 6c 6f 63 61 (seq email-loca
10ff0 6c 2d 70 61 72 74 20 23 5c 40 20 64 6f 6d 61 69 l-part #\@ domai
11000 6e 29 29 0a 20 20 20 20 28 75 72 6c 2d 63 68 61 n)). (url-cha
11010 72 20 2e 20 28 6f 72 20 61 6c 6e 75 6d 20 23 5c r . (or alnum #\
11020 5f 20 23 5c 2d 20 23 5c 2b 20 23 5c 5c 20 23 5c _ #\- #\+ #\\ #\
11030 3d 20 23 5c 7e 20 23 5c 2e 20 23 5c 2c 20 23 5c = #\~ #\. #\, #\
11040 26 20 23 5c 3b 0a 20 20 20 20 20 20 20 20 20 20 & #\;.
11050 20 20 20 20 20 20 20 20 20 20 28 73 65 71 20 22 (seq "
11060 25 22 20 68 65 78 2d 64 69 67 69 74 20 68 65 78 %" hex-digit hex
11070 2d 64 69 67 69 74 29 29 29 0a 20 20 20 20 28 75 -digit))). (u
11080 72 6c 2d 66 69 6e 61 6c 2d 63 68 61 72 20 2e 20 rl-final-char .
11090 28 6f 72 20 61 6c 6e 75 6d 20 23 5c 5f 20 23 5c (or alnum #\_ #\
110a0 2d 20 23 5c 2b 20 23 5c 5c 20 23 5c 3d 20 23 5c - #\+ #\\ #\= #\
110b0 7e 20 23 5c 26 0a 20 20 20 20 20 20 20 20 20 20 ~ #\&.
110c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
110d0 28 73 65 71 20 22 25 22 20 68 65 78 2d 64 69 67 (seq "%" hex-dig
110e0 69 74 20 68 65 78 2d 64 69 67 69 74 29 29 29 0a it hex-digit))).
110f0 20 20 20 20 28 68 74 74 70 2d 75 72 6c 20 2e 20 (http-url .
11100 28 77 2f 6e 6f 63 61 73 65 0a 20 20 20 20 20 20 (w/nocase.
11110 20 20 20 20 20 20 20 20 20 20 20 22 68 74 74 70 "http
11120 22 20 28 3f 20 22 73 22 29 20 22 3a 2f 2f 22 0a " (? "s") "://".
11130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11140 20 28 6f 72 20 64 6f 6d 61 69 6e 2f 63 6f 6d 6d (or domain/comm
11150 6f 6e 20 69 70 76 34 2d 61 64 64 72 65 73 73 29 on ipv4-address)
11160 20 3b 3b 20 28 73 65 71 20 22 5b 22 20 69 70 76 ;; (seq "[" ipv
11170 36 2d 61 64 64 72 65 73 73 20 22 5d 22 29 0a 20 6-address "]").
11180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11190 28 3f 20 22 3a 22 20 28 2b 20 6e 75 6d 65 72 69 (? ":" (+ numeri
111a0 63 29 29 20 3b 3b 20 70 6f 72 74 0a 20 20 20 20 c)) ;; port.
111b0 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
111c0 70 61 74 68 0a 20 20 20 20 20 20 20 20 20 20 20 path.
111d0 20 20 20 20 20 20 28 3f 20 22 2f 22 20 28 2a 20 (? "/" (*
111e0 75 72 6c 2d 63 68 61 72 29 0a 20 20 20 20 20 20 url-char).
111f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3f (?
11200 20 22 3f 22 20 28 2a 20 75 72 6c 2d 63 68 61 72 "?" (* url-char
11210 29 29 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ))
11220 20 20 20 20 20 20 20 20 3b 3b 20 71 75 65 72 79 ;; query
11230 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11240 20 20 20 20 20 28 3f 20 22 23 22 20 28 3f 20 28 (? "#" (? (
11250 2a 20 75 72 6c 2d 63 68 61 72 29 20 75 72 6c 2d * url-char) url-
11260 66 69 6e 61 6c 2d 63 68 61 72 29 29 20 3b 3b 20 final-char)) ;;
11270 66 72 61 67 6d 65 6e 74 0a 20 20 20 20 20 20 20 fragment.
11280 20 20 20 20 20 20 20 20 20 20 20 20 20 29 29 29 )))
11290 0a 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 43 6f 6d .. ))..;; Com
112a0 70 69 6c 65 20 61 6e 64 20 72 65 74 75 72 6e 20 pile and return
112b0 74 68 65 20 6c 69 73 74 20 6f 66 20 4e 46 41 20 the list of NFA
112c0 73 74 61 74 65 73 2e 20 20 54 68 65 20 73 74 61 states. The sta
112d0 72 74 20 73 74 61 74 65 20 77 69 6c 6c 20 62 65 rt state will be
112e0 0a 3b 3b 20 61 74 20 74 68 65 20 68 65 61 64 20 .;; at the head
112f0 6f 66 20 74 68 65 20 6c 69 73 74 2c 20 61 6e 64 of the list, and
11300 20 61 6c 6c 20 72 65 6d 61 69 6e 69 6e 67 20 73 all remaining s
11310 74 61 74 65 73 20 77 69 6c 6c 20 62 65 20 69 6e tates will be in
11320 0a 3b 3b 20 64 65 73 63 65 6e 64 69 6e 67 20 6e .;; descending n
11330 75 6d 65 72 69 63 20 6f 72 64 65 72 2c 20 77 69 umeric order, wi
11340 74 68 20 73 74 61 74 65 20 30 20 62 65 69 6e 67 th state 0 being
11350 20 74 68 65 20 75 6e 69 71 75 65 20 61 63 63 65 the unique acce
11360 70 74 69 6e 67 0a 3b 3b 20 73 74 61 74 65 2e 0a pting.;; state..
11370 28 64 65 66 69 6e 65 20 28 73 72 65 2d 3e 6e 66 (define (sre->nf
11380 61 20 73 72 65 20 2e 20 6f 29 0a 20 20 3b 3b 20 a sre . o). ;;
11390 77 65 20 6c 6f 6f 70 20 6f 76 65 72 20 61 6e 20 we loop over an
113a0 69 6d 70 6c 69 63 69 74 20 73 65 71 75 65 6e 63 implicit sequenc
113b0 65 20 6c 69 73 74 0a 20 20 28 6c 65 74 20 6c 70 e list. (let lp
113c0 20 28 28 6c 73 20 28 6c 69 73 74 20 73 72 65 29 ((ls (list sre)
113d0 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6e 20 ). (n
113e0 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 66 1). (f
113f0 6c 61 67 73 20 28 69 66 20 28 70 61 69 72 3f 20 lags (if (pair?
11400 6f 29 20 28 63 61 72 20 6f 29 20 7e 6e 6f 6e 65 o) (car o) ~none
11410 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6e )). (n
11420 65 78 74 20 28 6c 69 73 74 20 28 6c 69 73 74 20 ext (list (list
11430 30 29 29 29 29 0a 20 20 20 20 28 64 65 66 69 6e 0)))). (defin
11440 65 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 6d e (new-state-num
11450 62 65 72 20 73 74 61 74 65 29 0a 20 20 20 20 20 ber state).
11460 20 28 6d 61 78 20 6e 20 28 2b 20 31 20 28 63 61 (max n (+ 1 (ca
11470 61 72 20 73 74 61 74 65 29 29 29 29 0a 20 20 20 ar state)))).
11480 20 28 64 65 66 69 6e 65 20 28 65 78 74 65 6e 64 (define (extend
11490 2d 73 74 61 74 65 20 6e 65 78 74 20 2e 20 74 72 -state next . tr
114a0 61 6e 73 29 0a 20 20 20 20 20 20 28 61 6e 64 20 ans). (and
114b0 6e 65 78 74 0a 20 20 20 20 20 20 20 20 20 20 20 next.
114c0 28 63 6f 6e 73 20 28 63 6f 6e 73 20 28 6e 65 77 (cons (cons (new
114d0 2d 73 74 61 74 65 2d 6e 75 6d 62 65 72 20 6e 65 -state-number ne
114e0 78 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 xt).
114f0 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 20 (map
11500 28 6c 61 6d 62 64 61 20 28 78 29 20 28 63 6f 6e (lambda (x) (con
11510 73 20 78 20 28 63 61 61 72 20 6e 65 78 74 29 29 s x (caar next))
11520 29 20 74 72 61 6e 73 29 29 0a 20 20 20 20 20 20 ) trans)).
11530 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 29 next)
11540 29 29 0a 20 20 20 20 28 69 66 20 28 6e 75 6c 6c )). (if (null
11550 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 6e 65 ? ls). ne
11560 78 74 0a 20 20 20 20 20 20 20 20 28 63 6f 6e 64 xt. (cond
11570 0a 20 20 20 20 20 20 20 20 20 28 28 73 74 72 69 . ((stri
11580 6e 67 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 ng? (car ls)).
11590 20 20 20 20 20 20 20 20 3b 3b 20 70 72 6f 63 65 ;; proce
115a0 73 73 20 6c 69 74 65 72 61 6c 20 73 74 72 69 6e ss literal strin
115b0 67 73 20 61 20 63 68 61 72 20 61 74 20 61 20 74 gs a char at a t
115c0 69 6d 65 0a 20 20 20 20 20 20 20 20 20 20 28 6c ime. (l
115d0 70 20 28 61 70 70 65 6e 64 20 28 73 74 72 69 6e p (append (strin
115e0 67 2d 3e 6c 69 73 74 20 28 63 61 72 20 6c 73 29 g->list (car ls)
115f0 29 20 28 63 64 72 20 6c 73 29 29 20 6e 20 66 6c ) (cdr ls)) n fl
11600 61 67 73 20 6e 65 78 74 29 29 0a 20 20 20 20 20 ags next)).
11610 20 20 20 20 28 28 65 71 3f 20 27 65 70 73 69 6c ((eq? 'epsil
11620 6f 6e 20 28 63 61 72 20 6c 73 29 29 0a 20 20 20 on (car ls)).
11630 20 20 20 20 20 20 20 3b 3b 20 63 68 61 72 73 20 ;; chars
11640 61 6e 64 20 65 70 73 69 6c 6f 6e 73 20 67 6f 20 and epsilons go
11650 64 69 72 65 63 74 6c 79 20 69 6e 74 6f 20 74 68 directly into th
11660 65 20 74 72 61 6e 73 69 74 69 6f 6e 20 74 61 62 e transition tab
11670 6c 65 0a 20 20 20 20 20 20 20 20 20 20 28 65 78 le. (ex
11680 74 65 6e 64 2d 73 74 61 74 65 20 28 6c 70 20 28 tend-state (lp (
11690 63 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 cdr ls) n flags
116a0 6e 65 78 74 29 20 28 63 61 72 20 6c 73 29 29 29 next) (car ls)))
116b0 0a 20 20 20 20 20 20 20 20 20 28 28 63 68 61 72 . ((char
116c0 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 ? (car ls)).
116d0 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 6c 74 (let ((alt
116e0 20 28 63 68 61 72 2d 61 6c 74 63 61 73 65 20 28 (char-altcase (
116f0 63 61 72 20 6c 73 29 29 29 29 0a 20 20 20 20 20 car ls)))).
11700 20 20 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 (if (and
11710 28 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 (flag-set? flags
11720 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 ~case-insensiti
11730 76 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 ve?).
11740 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 (not (
11750 65 71 76 3f 20 28 63 61 72 20 6c 73 29 20 61 6c eqv? (car ls) al
11760 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
11770 20 20 20 20 20 28 65 78 74 65 6e 64 2d 73 74 61 (extend-sta
11780 74 65 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 te (lp (cdr ls)
11790 6e 20 66 6c 61 67 73 20 6e 65 78 74 29 20 28 63 n flags next) (c
117a0 61 72 20 6c 73 29 20 61 6c 74 29 0a 20 20 20 20 ar ls) alt).
117b0 20 20 20 20 20 20 20 20 20 20 20 20 28 65 78 74 (ext
117c0 65 6e 64 2d 73 74 61 74 65 20 28 6c 70 20 28 63 end-state (lp (c
117d0 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e dr ls) n flags n
117e0 65 78 74 29 20 28 63 61 72 20 6c 73 29 29 29 29 ext) (car ls))))
117f0 29 0a 20 20 20 20 20 20 20 20 20 28 28 73 79 6d ). ((sym
11800 62 6f 6c 3f 20 28 63 61 72 20 6c 73 29 29 0a 20 bol? (car ls)).
11810 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
11820 63 65 6c 6c 20 28 61 73 73 71 20 28 63 61 72 20 cell (assq (car
11830 6c 73 29 20 73 72 65 2d 6e 61 6d 65 64 2d 64 65 ls) sre-named-de
11840 66 69 6e 69 74 69 6f 6e 73 29 29 29 0a 20 20 20 finitions))).
11850 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 63 65 (and ce
11860 6c 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ll.
11870 20 20 20 20 28 6c 70 20 28 63 6f 6e 73 20 28 69 (lp (cons (i
11880 66 20 28 70 72 6f 63 65 64 75 72 65 3f 20 28 63 f (procedure? (c
11890 64 72 20 63 65 6c 6c 29 29 0a 20 20 20 20 20 20 dr cell)).
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 28 63 64 72 20 63 ((cdr c
118c0 65 6c 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 ell)).
118d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
118e0 20 20 20 20 20 28 63 64 72 20 63 65 6c 6c 29 29 (cdr cell))
118f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11900 20 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 (cdr
11910 20 6c 73 29 29 20 6e 20 66 6c 61 67 73 20 6e 65 ls)) n flags ne
11920 78 74 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 xt)))).
11930 28 28 70 61 69 72 3f 20 28 63 61 72 20 6c 73 29 ((pair? (car ls)
11940 29 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e ). (con
11950 64 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 73 d. ((s
11960 74 72 69 6e 67 3f 20 28 63 61 61 72 20 6c 73 29 tring? (caar ls)
11970 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ). ;;
11980 20 65 6e 75 6d 65 72 61 74 65 64 20 63 68 61 72 enumerated char
11990 61 63 74 65 72 20 73 65 74 0a 20 20 20 20 20 20 acter set.
119a0 20 20 20 20 20 20 28 6c 70 20 28 63 6f 6e 73 20 (lp (cons
119b0 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 28 (sre-alternate (
119c0 73 74 72 69 6e 67 2d 3e 6c 69 73 74 20 28 63 61 string->list (ca
119d0 61 72 20 6c 73 29 29 29 20 28 63 64 72 20 6c 73 ar ls))) (cdr ls
119e0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
119f0 20 20 20 6e 0a 20 20 20 20 20 20 20 20 20 20 20 n.
11a00 20 20 20 20 20 66 6c 61 67 73 0a 20 20 20 20 20 flags.
11a10 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 29 next)
11a20 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 65 6c ). (el
11a30 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 se. (
11a40 63 61 73 65 20 28 63 61 61 72 20 6c 73 29 0a 20 case (caar ls).
11a50 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 ((s
11a60 65 71 20 3a 29 0a 20 20 20 20 20 20 20 20 20 20 eq :).
11a70 20 20 20 20 20 3b 3b 20 66 6f 72 20 61 6e 20 65 ;; for an e
11a80 78 70 6c 69 63 69 74 20 73 65 71 75 65 6e 63 65 xplicit sequence
11a90 2c 20 6a 75 73 74 20 61 70 70 65 6e 64 20 74 6f , just append to
11aa0 20 74 68 65 20 6c 69 73 74 0a 20 20 20 20 20 20 the list.
11ab0 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 61 70 (lp (ap
11ac0 70 65 6e 64 20 28 63 64 61 72 20 6c 73 29 20 28 pend (cdar ls) (
11ad0 63 64 72 20 6c 73 29 29 20 6e 20 66 6c 61 67 73 cdr ls)) n flags
11ae0 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 20 next)).
11af0 20 20 20 20 20 20 28 28 77 2f 63 61 73 65 20 77 ((w/case w
11b00 2f 6e 6f 63 61 73 65 20 77 2f 75 74 66 38 20 77 /nocase w/utf8 w
11b10 2f 6e 6f 75 74 66 38 29 0a 20 20 20 20 20 20 20 /noutf8).
11b20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 (let* ((
11b30 6e 65 78 74 20 28 6c 70 20 28 63 64 72 20 6c 73 next (lp (cdr ls
11b40 29 20 6e 20 66 6c 61 67 73 20 6e 65 78 74 29 29 ) n flags next))
11b50 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11b60 20 20 20 20 20 20 20 28 66 6c 61 67 73 20 28 28 (flags ((
11b70 69 66 20 28 6d 65 6d 71 20 28 63 61 61 72 20 6c if (memq (caar l
11b80 73 29 20 27 28 77 2f 63 61 73 65 20 77 2f 75 74 s) '(w/case w/ut
11b90 66 38 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f8)).
11ba0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11bb0 20 20 20 20 20 20 20 66 6c 61 67 2d 63 6c 65 61 flag-clea
11bc0 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 r.
11bd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11be0 20 20 20 20 66 6c 61 67 2d 6a 6f 69 6e 29 0a 20 flag-join).
11bf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c00 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 fla
11c10 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 gs.
11c20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c30 20 28 69 66 20 28 6d 65 6d 71 20 28 63 61 61 72 (if (memq (caar
11c40 20 6c 73 29 20 27 28 77 2f 63 61 73 65 20 77 2f ls) '(w/case w/
11c50 6e 6f 63 61 73 65 29 29 0a 20 20 20 20 20 20 20 nocase)).
11c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11c70 20 20 20 20 20 20 20 20 20 20 20 7e 63 61 73 65 ~case
11c80 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 0a 20 20 -insensitive?.
11c90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ca0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11cb0 7e 75 74 66 38 3f 29 29 29 29 0a 20 20 20 20 20 ~utf8?)))).
11cc0 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
11cd0 20 6e 65 78 74 20 28 6c 70 20 28 63 64 61 72 20 next (lp (cdar
11ce0 6c 73 29 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e ls) (new-state-n
11cf0 75 6d 62 65 72 20 6e 65 78 74 29 20 66 6c 61 67 umber next) flag
11d00 73 20 6e 65 78 74 29 29 29 29 0a 20 20 20 20 20 s next)))).
11d10 20 20 20 20 20 20 20 20 20 28 28 2f 20 2d 20 26 ((/ - &
11d20 20 7e 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 ~) .
11d30 20 20 20 20 28 6c 65 74 20 28 28 72 61 6e 67 65 (let ((range
11d40 73 20 28 73 72 65 2d 3e 63 73 65 74 20 28 63 61 s (sre->cset (ca
11d50 72 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 r ls).
11d60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11d70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
11d80 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e lag-set? flags ~
11d90 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 case-insensitive
11da0 3f 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ?)))).
11db0 20 20 20 20 20 20 20 28 63 61 73 65 20 28 6c 65 (case (le
11dc0 6e 67 74 68 20 72 61 6e 67 65 73 29 0a 20 20 20 ngth ranges).
11dd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11de0 28 28 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 ((1).
11df0 20 20 20 20 20 20 20 20 20 28 65 78 74 65 6e 64 (extend
11e00 2d 73 74 61 74 65 20 28 6c 70 20 28 63 64 72 20 -state (lp (cdr
11e10 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e 65 78 74 ls) n flags next
11e20 29 20 28 63 61 72 20 72 61 6e 67 65 73 29 29 29 ) (car ranges)))
11e30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
11e40 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
11e50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
11e60 65 74 20 28 28 6e 65 78 74 20 28 6c 70 20 28 63 et ((next (lp (c
11e70 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e dr ls) n flags n
11e80 65 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 ext))).
11e90 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
11ea0 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d.
11eb0 20 20 20 20 20 20 20 20 20 6e 65 78 74 0a 20 20 next.
11ec0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11ed0 20 20 20 20 20 28 6c 70 20 28 6c 69 73 74 20 28 (lp (list (
11ee0 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 0a 20 20 sre-alternate.
11ef0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f10 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 (map (lambda (x)
11f20 20 28 69 66 20 28 70 61 69 72 3f 20 78 29 0a 20 (if (pair? x).
11f30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f60 20 28 6c 69 73 74 20 27 2f 20 28 63 61 72 20 78 (list '/ (car x
11f70 29 20 28 63 64 72 20 78 29 29 0a 20 20 20 20 20 ) (cdr x)).
11f80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11f90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
11fa0 20 20 20 20 20 20 20 20 20 20 20 20 20 78 29 29 x))
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 20 20 20 20 20 20 20 20 20
11fd0 20 20 20 20 20 20 20 20 72 61 6e 67 65 73 29 29 ranges))
11fe0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
11ff0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
12000 77 2d 73 74 61 74 65 2d 6e 75 6d 62 65 72 20 6e w-state-number n
12010 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 ext).
12020 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12030 28 66 6c 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 (flag-clear flag
12040 73 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 s ~case-insensit
12050 69 76 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 ive?).
12060 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12070 20 6e 65 78 74 29 29 29 29 29 29 29 0a 20 20 20 next))))))).
12080 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 29 ((or)
12090 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
120a0 28 6c 65 74 2a 20 28 28 6e 65 78 74 20 28 6c 70 (let* ((next (lp
120b0 20 28 63 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 (cdr ls) n flag
120c0 73 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 s next)).
120d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
120e0 62 20 28 61 6e 64 20 6e 65 78 74 0a 20 20 20 20 b (and next.
120f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12100 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 6c (lp (l
12110 69 73 74 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 ist (sre-alterna
12120 74 65 20 28 63 64 64 61 72 20 6c 73 29 29 29 0a te (cddar ls))).
12130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12150 20 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 6d (new-state-num
12160 62 65 72 20 6e 65 78 74 29 0a 20 20 20 20 20 20 ber next).
12170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12180 20 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 flag
12190 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
121a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
121b0 20 20 20 20 6e 65 78 74 29 29 29 0a 20 20 20 20 next))).
121c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
121d0 20 20 28 61 20 28 61 6e 64 20 62 20 28 6c 70 20 (a (and b (lp
121e0 28 6c 69 73 74 20 28 63 61 64 61 72 20 6c 73 29 (list (cadar ls)
121f0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12210 20 20 20 20 20 20 28 6e 65 77 2d 73 74 61 74 65 (new-state
12220 2d 6e 75 6d 62 65 72 20 62 29 0a 20 20 20 20 20 -number b).
12230 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
12250 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
12260 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12270 20 20 20 20 20 20 20 20 20 6e 65 78 74 29 29 29 next)))
12280 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12290 20 20 20 3b 3b 20 63 6f 6d 70 69 6c 65 20 62 6f ;; compile bo
122a0 74 68 20 62 72 61 6e 63 68 65 73 20 61 6e 64 20 th branches and
122b0 69 6e 73 65 72 74 20 65 70 73 69 6c 6f 6e 0a 20 insert epsilon.
122c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
122d0 3b 3b 20 74 72 61 6e 73 69 74 69 6f 6e 73 20 74 ;; transitions t
122e0 6f 20 65 69 74 68 65 72 0a 20 20 20 20 20 20 20 o either.
122f0 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 61 (and a
12300 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
12310 20 20 20 20 20 20 20 60 28 28 2c 28 6e 65 77 2d `((,(new-
12320 73 74 61 74 65 2d 6e 75 6d 62 65 72 20 61 29 0a state-number a).
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 28 65 70 73 69 6c 6f (epsilo
12350 6e 20 2e 20 2c 28 63 61 61 72 20 61 29 29 0a 20 n . ,(caar a)).
12360 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12370 20 20 20 20 20 20 20 20 28 65 70 73 69 6c 6f 6e (epsilon
12380 20 2e 20 2c 28 63 61 61 72 20 62 29 29 29 0a 20 . ,(caar b))).
12390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
123a0 20 20 20 20 20 20 20 2c 40 28 74 61 6b 65 2d 75 ,@(take-u
123b0 70 2d 74 6f 20 61 20 6e 65 78 74 29 0a 20 20 20 p-to a next).
123c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
123d0 20 20 20 20 20 2c 40 62 29 29 29 29 0a 20 20 20 ,@b)))).
123e0 20 20 20 20 20 20 20 20 20 20 20 28 28 3f 29 0a ((?).
123f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12400 6c 65 74 20 28 28 6e 65 78 74 20 28 6c 70 20 28 let ((next (lp (
12410 63 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 cdr ls) n flags
12420 6e 65 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 next))).
12430 20 20 20 20 20 20 20 20 20 3b 3b 20 69 6e 73 65 ;; inse
12440 72 74 20 61 6e 20 65 70 73 69 6c 6f 6e 20 74 72 rt an epsilon tr
12450 61 6e 73 69 74 69 6f 6e 20 64 69 72 65 63 74 6c ansition directl
12460 79 20 74 6f 20 6e 65 78 74 0a 20 20 20 20 20 20 y to next.
12470 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 0a (and.
12480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12490 20 20 6e 65 78 74 0a 20 20 20 20 20 20 20 20 20 next.
124a0 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
124b0 61 20 28 6c 70 20 28 63 64 61 72 20 6c 73 29 20 a (lp (cdar ls)
124c0 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 6d 62 65 (new-state-numbe
124d0 72 20 6e 65 78 74 29 20 66 6c 61 67 73 20 6e 65 r next) flags ne
124e0 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 xt))).
124f0 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
12500 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12510 20 20 20 20 20 28 61 0a 20 20 20 20 20 20 20 20 (a.
12520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
12530 60 28 28 2c 28 63 61 61 72 20 61 29 20 28 65 70 `((,(caar a) (ep
12540 73 69 6c 6f 6e 20 2e 20 2c 28 63 61 61 72 20 6e silon . ,(caar n
12550 65 78 74 29 29 20 2c 40 28 63 64 61 72 20 61 29 ext)) ,@(cdar a)
12560 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12570 20 20 20 20 20 20 20 20 3b 3b 20 20 2c 40 28 63 ;; ,@(c
12580 64 72 20 61 29 29 0a 20 20 20 20 20 20 20 20 20 dr a)).
12590 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 (se
125a0 74 2d 63 64 72 21 20 28 63 61 72 20 61 29 20 60 t-cdr! (car a) `
125b0 28 28 65 70 73 69 6c 6f 6e 20 2e 20 2c 28 63 61 ((epsilon . ,(ca
125c0 61 72 20 6e 65 78 74 29 29 20 2c 40 28 63 64 61 ar next)) ,@(cda
125d0 72 20 61 29 29 29 0a 20 20 20 20 20 20 20 20 20 r a))).
125e0 20 20 20 20 20 20 20 20 20 20 20 20 20 61 29 0a a).
125f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12600 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
12610 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12620 20 23 66 29 29 29 29 29 29 0a 20 20 20 20 20 20 #f)))))).
12630 20 20 20 20 20 20 20 20 28 28 2b 20 2a 29 0a 20 ((+ *).
12640 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
12650 65 74 20 28 28 6e 65 78 74 20 28 6c 70 20 28 63 et ((next (lp (c
12660 64 72 20 6c 73 29 20 6e 20 66 6c 61 67 73 20 6e dr ls) n flags n
12670 65 78 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 ext))).
12680 20 20 20 20 20 20 20 20 28 61 6e 64 0a 20 20 20 (and.
12690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
126a0 65 78 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 ext.
126b0 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 6e 65 (let* ((ne
126c0 77 20 28 6c 70 20 27 28 65 70 73 69 6c 6f 6e 29 w (lp '(epsilon)
126d0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
126e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
126f0 20 20 20 28 6e 65 77 2d 73 74 61 74 65 2d 6e 75 (new-state-nu
12700 6d 62 65 72 20 6e 65 78 74 29 0a 20 20 20 20 20 mber next).
12710 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12720 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 fla
12730 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 gs.
12740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12750 20 20 20 20 20 6e 65 78 74 29 29 0a 20 20 20 20 next)).
12760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12770 20 20 20 20 20 28 61 20 28 6c 70 20 28 63 64 61 (a (lp (cda
12780 72 20 6c 73 29 20 28 6e 65 77 2d 73 74 61 74 65 r ls) (new-state
12790 2d 6e 75 6d 62 65 72 20 6e 65 77 29 20 66 6c 61 -number new) fla
127a0 67 73 20 6e 65 77 29 29 29 0a 20 20 20 20 20 20 gs new))).
127b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
127c0 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
127d0 20 20 20 20 20 20 20 20 61 0a 20 20 20 20 20 20 a.
127e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
127f0 62 65 67 69 6e 0a 20 20 20 20 20 20 20 20 20 20 begin.
12800 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 ;;
12810 66 6f 72 20 2a 2c 20 69 6e 73 65 72 74 20 61 6e for *, insert an
12820 20 65 70 73 69 6c 6f 6e 20 74 72 61 6e 73 69 74 epsilon transit
12830 69 6f 6e 20 61 73 20 69 6e 20 3f 20 61 62 6f 76 ion as in ? abov
12840 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
12850 20 20 20 20 20 20 20 20 20 28 69 66 20 28 65 71 (if (eq
12860 3f 20 27 2a 20 28 63 61 61 72 20 6c 73 29 29 0a ? '* (caar ls)).
12870 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12880 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 2d (set-
12890 63 64 72 21 20 28 63 61 72 20 61 29 0a 20 20 20 cdr! (car a).
128a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
128b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
128c0 20 20 60 28 28 65 70 73 69 6c 6f 6e 20 2e 20 2c `((epsilon . ,
128d0 28 63 61 61 72 20 6e 65 77 29 29 20 2c 40 28 63 (caar new)) ,@(c
128e0 64 61 72 20 61 29 29 29 29 0a 20 20 20 20 20 20 dar a)))).
128f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12900 20 3b 3b 20 66 6f 72 20 62 6f 74 68 2c 20 69 6e ;; for both, in
12910 73 65 72 74 20 61 20 6c 6f 6f 70 20 62 61 63 6b sert a loop back
12920 20 74 6f 20 73 65 6c 66 0a 20 20 20 20 20 20 20 to self.
12930 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12940 28 73 65 74 2d 63 64 72 21 20 28 63 61 72 20 6e (set-cdr! (car n
12950 65 77 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ew).
12960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12970 20 20 20 20 20 60 28 28 65 70 73 69 6c 6f 6e 20 `((epsilon
12980 2e 20 2c 28 63 61 61 72 20 61 29 29 20 2c 40 28 . ,(caar a)) ,@(
12990 63 64 61 72 20 6e 65 77 29 29 29 0a 20 20 20 20 cdar new))).
129a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
129b0 20 20 20 61 29 29 29 29 29 29 0a 3b 3b 3b 3b 20 a)))))).;;;;
129c0 6e 65 65 64 20 74 6f 20 61 64 64 20 74 68 65 73 need to add thes
129d0 65 20 74 6f 20 74 68 65 20 6d 61 74 63 68 20 65 e to the match e
129e0 78 74 72 61 63 74 6f 72 20 66 69 72 73 74 0a 3b xtractor first.;
129f0 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
12a00 28 28 3d 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 ((=).;;
12a10 20 20 20 20 20 20 20 28 6c 70 20 28 61 70 70 65 (lp (appe
12a20 6e 64 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 nd (vector->list
12a30 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
12a40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12a50 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 63 61 (make-vector (ca
12a60 64 61 72 20 6c 73 29 0a 3b 3b 20 20 20 20 20 20 dar ls).;;
12a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12a80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12a90 20 20 20 20 28 73 72 65 2d 73 65 71 75 65 6e 63 (sre-sequenc
12aa0 65 20 28 63 64 64 61 72 20 6c 73 29 29 29 29 0a e (cddar ls)))).
12ab0 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
12ac0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
12ad0 64 72 20 6c 73 29 29 0a 3b 3b 20 20 20 20 20 20 dr ls)).;;
12ae0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 20 n
12af0 66 6c 61 67 73 20 6e 65 78 74 29 29 0a 3b 3b 20 flags next)).;;
12b00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
12b10 3e 3d 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 >=).;;
12b20 20 20 20 20 20 20 28 6c 70 20 28 61 70 70 65 6e (lp (appen
12b30 64 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 0a d (vector->list.
12b40 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;;
12b50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
12b60 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 2d 20 28 make-vector (- (
12b70 63 61 64 61 72 20 6c 73 29 20 31 29 0a 3b 3b 20 cadar ls) 1).;;
12b80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12b90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12ba0 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 (sre-se
12bb0 71 75 65 6e 63 65 20 28 63 64 64 61 72 20 6c 73 quence (cddar ls
12bc0 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 )))).;;
12bd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12be0 20 20 20 28 63 6f 6e 73 20 60 28 2b 20 2c 40 28 (cons `(+ ,@(
12bf0 63 64 64 61 72 20 6c 73 29 29 20 28 63 64 72 20 cddar ls)) (cdr
12c00 6c 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 ls))).;;
12c10 20 20 20 20 20 20 20 20 20 20 20 20 6e 20 66 6c n fl
12c20 61 67 73 20 6e 65 78 74 29 29 0a 3b 3b 20 20 20 ags next)).;;
12c30 20 20 20 20 20 20 20 20 20 20 20 20 28 28 2a 2a ((**
12c40 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ).;;
12c50 20 20 20 20 28 6c 70 20 28 61 70 70 65 6e 64 20 (lp (append
12c60 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 0a 3b 3b (vector->list.;;
12c70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12c80 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 (ma
12c90 6b 65 2d 76 65 63 74 6f 72 20 28 63 61 64 61 72 ke-vector (cadar
12ca0 20 6c 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 ls).;;
12cb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12cc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12cd0 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 (sre-sequence (
12ce0 63 64 64 64 61 72 20 6c 73 29 29 29 29 0a 3b 3b cdddar ls)))).;;
12cf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d00 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 (map
12d10 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
12d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d30 28 6c 61 6d 62 64 61 20 28 78 29 20 60 28 3f 20 (lambda (x) `(?
12d40 2c 78 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 ,x)).;;
12d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d60 20 20 20 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 (vector->lis
12d70 74 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 t.;;
12d80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12d90 20 20 28 6d 61 6b 65 2d 76 65 63 74 6f 72 20 28 (make-vector (
12da0 2d 20 28 63 61 64 64 61 72 20 6c 73 29 20 28 63 - (caddar ls) (c
12db0 61 64 61 72 20 6c 73 29 29 0a 3b 3b 20 20 20 20 adar ls)).;;
12dc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12dd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12de0 20 20 20 20 20 20 20 28 73 72 65 2d 73 65 71 75 (sre-sequ
12df0 65 6e 63 65 20 28 63 64 64 64 61 72 20 6c 73 29 ence (cdddar ls)
12e00 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 )))).;;
12e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e20 20 20 20 28 63 64 72 20 6c 73 29 29 0a 3b 3b 20 (cdr ls)).;;
12e30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12e40 20 20 20 6e 20 66 6c 61 67 73 20 6e 65 78 74 29 n flags next)
12e50 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
12e60 28 28 24 20 73 75 62 6d 61 74 63 68 20 3d 3e 20 (($ submatch =>
12e70 73 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a submatch-named).
12e80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
12e90 3b 20 69 67 6e 6f 72 65 20 73 75 62 6d 61 74 63 ; ignore submatc
12ea0 68 65 73 20 61 6c 74 6f 67 65 74 68 65 72 0a 20 hes altogether.
12eb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
12ec0 70 20 28 63 6f 6e 73 20 28 73 72 65 2d 73 65 71 p (cons (sre-seq
12ed0 75 65 6e 63 65 20 28 63 64 61 72 20 6c 73 29 29 uence (cdar ls))
12ee0 20 28 63 64 72 20 6c 73 29 29 20 6e 20 66 6c 61 (cdr ls)) n fla
12ef0 67 73 20 6e 65 78 74 29 29 0a 20 20 20 20 20 20 gs next)).
12f00 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
12f10 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
12f20 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nd.
12f30 20 20 20 28 28 61 73 73 71 20 28 63 61 61 72 20 ((assq (caar
12f40 6c 73 29 20 73 72 65 2d 6e 61 6d 65 64 2d 64 65 ls) sre-named-de
12f50 66 69 6e 69 74 69 6f 6e 73 29 0a 20 20 20 20 20 finitions).
12f60 20 20 20 20 20 20 20 20 20 20 20 20 3d 3e 20 28 => (
12f70 6c 61 6d 62 64 61 20 28 63 65 6c 6c 29 0a 20 20 lambda (cell).
12f80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12f90 20 20 20 20 28 69 66 20 28 70 72 6f 63 65 64 75 (if (procedu
12fa0 72 65 3f 20 28 63 64 72 20 63 65 6c 6c 29 29 0a re? (cdr cell)).
12fb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
12fc0 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 (lp (c
12fd0 6f 6e 73 20 28 61 70 70 6c 79 20 28 63 64 72 20 ons (apply (cdr
12fe0 63 65 6c 6c 29 20 28 63 64 61 72 20 6c 73 29 29 cell) (cdar ls))
12ff0 20 28 63 64 72 20 6c 73 29 29 0a 20 20 20 20 20 (cdr ls)).
13000 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13010 20 20 20 20 20 20 20 20 20 6e 20 66 6c 61 67 73 n flags
13020 20 6e 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 next).
13030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13040 20 28 65 72 72 6f 72 20 22 6e 6f 6e 2d 70 72 6f (error "non-pro
13050 63 65 64 75 72 65 20 69 6e 20 6f 70 20 70 6f 73 cedure in op pos
13060 69 74 69 6f 6e 22 20 28 63 61 61 72 20 6c 73 29 ition" (caar ls)
13070 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
13080 20 20 20 20 20 28 65 6c 73 65 20 23 66 29 29 29 (else #f)))
13090 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 65 )))). (e
130a0 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 23 66 lse. #f
130b0 29 29 29 29 29 0a 0a 3b 3b 20 57 65 20 64 6f 6e )))))..;; We don
130c0 27 74 20 72 65 61 6c 6c 79 20 77 61 6e 74 20 74 't really want t
130d0 6f 20 75 73 65 20 74 68 69 73 2c 20 77 65 20 75 o use this, we u
130e0 73 65 20 74 68 65 20 63 6c 6f 73 75 72 65 20 63 se the closure c
130f0 6f 6d 70 69 6c 61 74 69 6f 6e 0a 3b 3b 20 62 65 ompilation.;; be
13100 6c 6f 77 20 69 6e 73 74 65 61 64 2c 20 62 75 74 low instead, but
13110 20 74 68 69 73 20 69 73 20 69 6e 63 6c 75 64 65 this is include
13120 64 20 66 6f 72 20 72 65 66 65 72 65 6e 63 65 20 d for reference
13130 61 6e 64 20 74 65 73 74 69 6e 67 20 74 68 65 0a and testing the.
13140 3b 3b 20 73 72 65 2d 3e 6e 66 61 20 63 6f 6e 76 ;; sre->nfa conv
13150 65 72 73 69 6f 6e 2e 0a 0a 3b 3b 20 28 64 65 66 ersion...;; (def
13160 69 6e 65 20 28 6e 66 61 2d 6d 61 74 63 68 20 6e ine (nfa-match n
13170 66 61 20 73 74 72 29 0a 3b 3b 20 20 20 28 6c 65 fa str).;; (le
13180 74 20 6c 70 20 28 28 6c 73 20 28 73 74 72 69 6e t lp ((ls (strin
13190 67 2d 3e 6c 69 73 74 20 73 74 72 29 29 20 28 73 g->list str)) (s
131a0 74 61 74 65 20 28 63 61 72 20 6e 66 61 29 29 20 tate (car nfa))
131b0 28 65 70 73 69 6c 6f 6e 73 20 27 28 29 29 29 0a (epsilons '())).
131c0 3b 3b 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c ;; (if (null
131d0 3f 20 6c 73 29 0a 3b 3b 20 20 20 20 20 20 20 20 ? ls).;;
131e0 20 28 7a 65 72 6f 3f 20 28 63 61 72 20 73 74 61 (zero? (car sta
131f0 74 65 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 te)).;;
13200 28 61 6e 79 20 28 6c 61 6d 62 64 61 20 28 6d 29 (any (lambda (m)
13210 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
13220 20 20 20 28 69 66 20 28 65 71 3f 20 27 65 70 73 (if (eq? 'eps
13230 69 6c 6f 6e 20 28 63 61 72 20 6d 29 29 0a 3b 3b ilon (car m)).;;
13240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13250 20 20 20 20 28 61 6e 64 20 28 6e 6f 74 20 28 6d (and (not (m
13260 65 6d 76 20 28 63 64 72 20 6d 29 20 65 70 73 69 emv (cdr m) epsi
13270 6c 6f 6e 73 29 29 0a 3b 3b 20 20 20 20 20 20 20 lons)).;;
13280 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13290 20 20 28 6c 70 20 6c 73 20 28 61 73 73 76 20 28 (lp ls (assv (
132a0 63 64 72 20 6d 29 20 6e 66 61 29 20 28 63 6f 6e cdr m) nfa) (con
132b0 73 20 28 63 64 72 20 6d 29 20 65 70 73 69 6c 6f s (cdr m) epsilo
132c0 6e 73 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 ns))).;;
132d0 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
132e0 20 28 6f 72 20 28 65 71 76 3f 20 28 63 61 72 20 (or (eqv? (car
132f0 6d 29 20 28 63 61 72 20 6c 73 29 29 0a 3b 3b 20 m) (car ls)).;;
13300 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13310 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
13320 20 28 70 61 69 72 3f 20 28 63 61 72 20 6d 29 29 (pair? (car m))
13330 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
13340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13350 20 20 20 20 20 28 63 68 61 72 3c 3d 3f 20 28 63 (char<=? (c
13360 61 61 72 20 6d 29 20 28 63 61 72 20 6c 73 29 29 aar m) (car ls))
13370 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
13380 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13390 20 20 20 20 20 28 63 68 61 72 3c 3d 3f 20 28 63 (char<=? (c
133a0 61 72 20 6c 73 29 20 28 63 64 61 72 20 6d 29 29 ar ls) (cdar m))
133b0 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 )).;;
133c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
133d0 70 20 28 63 64 72 20 6c 73 29 20 28 61 73 73 76 p (cdr ls) (assv
133e0 20 28 63 64 72 20 6d 29 20 6e 66 61 29 20 27 28 (cdr m) nfa) '(
133f0 29 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 20 ))))).;;
13400 20 20 20 20 20 20 28 63 64 72 20 73 74 61 74 65 (cdr state
13410 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b )))))..;;;;;;;;;
13420 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
13430 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
13440 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
13450 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a ;;;;;;;;;;;;;;;.
13460 3b 3b 20 4e 46 41 2d 3e 44 46 41 20 63 6f 6d 70 ;; NFA->DFA comp
13470 69 6c 61 74 69 6f 6e 0a 3b 3b 0a 3b 3b 20 44 75 ilation.;;.;; Du
13480 72 69 6e 67 20 70 72 6f 63 65 73 73 69 6e 67 2c ring processing,
13490 20 74 68 65 20 44 46 41 20 69 73 20 61 20 6c 69 the DFA is a li
134a0 73 74 20 6f 66 20 74 68 65 20 66 6f 72 6d 3a 0a st of the form:.
134b0 3b 3b 0a 3b 3b 20 20 20 28 28 4e 46 41 2d 73 74 ;;.;; ((NFA-st
134c0 61 74 65 73 20 2e 2e 2e 29 20 61 63 63 65 70 74 ates ...) accept
134d0 69 6e 67 2d 73 74 61 74 65 3f 20 74 72 61 6e 73 ing-state? trans
134e0 69 74 69 6f 6e 73 20 2e 2e 2e 29 0a 3b 3b 0a 3b itions ...).;;.;
134f0 3b 20 77 68 65 72 65 20 74 68 65 20 74 72 61 6e ; where the tran
13500 73 69 74 69 6f 6e 73 20 61 72 65 20 61 73 20 69 sitions are as i
13510 6e 20 74 68 65 20 4e 46 41 2c 20 65 78 63 65 70 n the NFA, excep
13520 74 20 74 68 65 72 65 20 61 72 65 20 6e 6f 0a 3b t there are no.;
13530 3b 20 65 70 73 69 6c 6f 6e 73 2c 20 64 75 70 6c ; epsilons, dupl
13540 69 63 61 74 65 20 63 68 61 72 61 63 74 65 72 73 icate characters
13550 20 6f 72 20 6f 76 65 72 6c 61 70 70 69 6e 67 20 or overlapping
13560 63 68 61 72 2d 73 65 74 20 72 61 6e 67 65 73 2c char-set ranges,
13570 20 61 6e 64 0a 3b 3b 20 74 68 65 20 73 74 61 74 and.;; the stat
13580 65 73 20 6d 6f 76 65 64 20 74 6f 20 61 72 65 20 es moved to are
13590 63 6c 6f 73 75 72 65 73 20 28 73 65 74 73 20 6f closures (sets o
135a0 66 20 4e 46 41 20 73 74 61 74 65 73 29 2e 20 20 f NFA states).
135b0 4d 75 6c 74 69 70 6c 65 0a 3b 3b 20 44 46 41 20 Multiple.;; DFA
135c0 73 74 61 74 65 73 20 6d 61 79 20 62 65 20 61 63 states may be ac
135d0 63 65 70 74 69 6e 67 20 73 74 61 74 65 73 2e 0a cepting states..
135e0 0a 28 64 65 66 69 6e 65 20 28 6e 66 61 2d 3e 64 .(define (nfa->d
135f0 66 61 20 6e 66 61 20 2e 20 6f 29 0a 20 20 28 6c fa nfa . o). (l
13600 65 74 20 28 28 6d 61 78 2d 73 74 61 74 65 73 20 et ((max-states
13610 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 28 (and (pair? o) (
13620 63 61 72 20 6f 29 29 29 29 0a 20 20 20 20 28 6c car o)))). (l
13630 65 74 20 6c 70 20 28 28 6c 73 20 28 6c 69 73 74 et lp ((ls (list
13640 20 28 6e 66 61 2d 63 6c 6f 73 75 72 65 20 6e 66 (nfa-closure nf
13650 61 20 28 6c 69 73 74 20 28 63 61 61 72 20 6e 66 a (list (caar nf
13660 61 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 a))))).
13670 20 20 20 20 28 69 20 30 29 0a 20 20 20 20 20 20 (i 0).
13680 20 20 20 20 20 20 20 28 72 65 73 20 27 28 29 29 (res '())
13690 29 0a 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 ). (cond.
136a0 20 20 20 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 ((null? ls)
136b0 0a 20 20 20 20 20 20 20 20 28 64 66 61 2d 72 65 . (dfa-re
136c0 6e 75 6d 62 65 72 20 28 72 65 76 65 72 73 65 20 number (reverse
136d0 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 28 28 res))). ((
136e0 61 73 73 6f 63 20 28 63 61 72 20 6c 73 29 20 72 assoc (car ls) r
136f0 65 73 29 0a 20 20 20 20 20 20 20 20 28 6c 70 20 es). (lp
13700 28 63 64 72 20 6c 73 29 20 69 20 72 65 73 29 29 (cdr ls) i res))
13710 0a 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 . (else.
13720 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 73 74 (let* ((st
13730 61 74 65 73 20 28 63 61 72 20 6c 73 29 29 0a 20 ates (car ls)).
13740 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 (t
13750 72 61 6e 73 20 28 6e 66 61 2d 73 74 61 74 65 2d rans (nfa-state-
13760 74 72 61 6e 73 69 74 69 6f 6e 73 20 6e 66 61 20 transitions nfa
13770 73 74 61 74 65 73 29 29 0a 20 20 20 20 20 20 20 states)).
13780 20 20 20 20 20 20 20 20 28 61 63 63 65 70 74 3f (accept?
13790 20 28 61 6e 64 20 28 6d 65 6d 76 20 30 20 73 74 (and (memv 0 st
137a0 61 74 65 73 29 20 23 74 29 29 29 0a 20 20 20 20 ates) #t))).
137b0 20 20 20 20 20 20 28 61 6e 64 20 28 6f 72 20 28 (and (or (
137c0 6e 6f 74 20 6d 61 78 2d 73 74 61 74 65 73 29 20 not max-states)
137d0 28 3c 20 28 2b 20 69 20 31 29 20 6d 61 78 2d 73 (< (+ i 1) max-s
137e0 74 61 74 65 73 29 29 0a 20 20 20 20 20 20 20 20 tates)).
137f0 20 20 20 20 20 20 20 28 6c 70 20 28 61 70 70 65 (lp (appe
13800 6e 64 20 28 6d 61 70 20 63 64 72 20 74 72 61 6e nd (map cdr tran
13810 73 29 20 28 63 64 72 20 6c 73 29 29 0a 20 20 20 s) (cdr ls)).
13820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
13830 28 2b 20 69 20 31 29 0a 20 20 20 20 20 20 20 20 (+ i 1).
13840 20 20 20 20 20 20 20 20 20 20 20 60 28 28 2c 73 `((,s
13850 74 61 74 65 73 20 2c 61 63 63 65 70 74 3f 20 2c tates ,accept? ,
13860 40 74 72 61 6e 73 29 20 2c 40 72 65 73 29 29 29 @trans) ,@res)))
13870 29 29 29 29 29 29 0a 0a 3b 3b 20 57 68 65 6e 20 ))))))..;; When
13880 74 68 65 20 63 6f 6e 76 65 72 73 69 6f 6e 20 69 the conversion i
13890 73 20 63 6f 6d 70 6c 65 74 65 20 77 65 20 72 65 s complete we re
138a0 6e 75 6d 62 65 72 20 74 68 65 20 44 46 41 20 73 number the DFA s
138b0 65 74 73 2d 6f 66 2d 73 74 61 74 65 73 0a 3b 3b ets-of-states.;;
138c0 20 69 6e 20 6f 72 64 65 72 20 61 6e 64 20 63 6f in order and co
138d0 6e 76 65 72 74 20 74 68 65 20 72 65 73 75 6c 74 nvert the result
138e0 20 74 6f 20 61 20 76 65 63 74 6f 72 20 66 6f 72 to a vector for
138f0 20 66 61 73 74 20 6c 6f 6f 6b 75 70 2e 0a 28 64 fast lookup..(d
13900 65 66 69 6e 65 20 28 64 66 61 2d 72 65 6e 75 6d efine (dfa-renum
13910 62 65 72 20 64 66 61 29 0a 20 20 28 6c 65 74 20 ber dfa). (let
13920 28 28 73 74 61 74 65 73 20 28 6d 61 70 20 63 6f ((states (map co
13930 6e 73 20 28 6d 61 70 20 63 61 72 20 64 66 61 29 ns (map car dfa)
13940 20 28 7a 65 72 6f 2d 74 6f 20 28 6c 65 6e 67 74 (zero-to (lengt
13950 68 20 64 66 61 29 29 29 29 29 0a 20 20 20 20 28 h dfa))))). (
13960 64 65 66 69 6e 65 20 28 72 65 6e 75 6d 62 65 72 define (renumber
13970 20 73 74 61 74 65 29 0a 20 20 20 20 20 20 28 63 state). (c
13980 64 72 20 28 61 73 73 6f 63 20 73 74 61 74 65 20 dr (assoc state
13990 73 74 61 74 65 73 29 29 29 0a 20 20 20 20 28 6c states))). (l
139a0 69 73 74 2d 3e 76 65 63 74 6f 72 0a 20 20 20 20 ist->vector.
139b0 20 28 6d 61 70 0a 20 20 20 20 20 20 28 6c 61 6d (map. (lam
139c0 62 64 61 20 28 6e 6f 64 65 29 0a 20 20 20 20 20 bda (node).
139d0 20 20 20 28 63 6f 6e 73 20 28 63 61 64 72 20 6e (cons (cadr n
139e0 6f 64 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 ode).
139f0 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 (map (lambda
13a00 28 78 29 20 28 63 6f 6e 73 20 28 63 61 72 20 78 (x) (cons (car x
13a10 29 20 28 72 65 6e 75 6d 62 65 72 20 28 63 64 72 ) (renumber (cdr
13a20 20 78 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 x)))).
13a30 20 20 20 20 20 20 20 20 20 20 28 63 64 64 72 20 (cddr
13a40 6e 6f 64 65 29 29 29 29 20 0a 20 20 20 20 20 20 node)))) .
13a50 64 66 61 29 29 29 29 0a 0a 3b 3b 20 45 78 74 72 dfa))))..;; Extr
13a60 61 63 74 20 61 6c 6c 20 64 69 73 74 69 6e 63 74 act all distinct
13a70 20 63 68 61 72 61 63 74 65 72 73 20 6f 72 20 72 characters or r
13a80 61 6e 67 65 73 20 61 6e 64 20 74 68 65 20 70 6f anges and the po
13a90 74 65 6e 74 69 61 6c 20 73 74 61 74 65 73 0a 3b tential states.;
13aa0 3b 20 74 68 65 79 20 63 61 6e 20 74 72 61 6e 73 ; they can trans
13ab0 69 74 69 6f 6e 20 74 6f 20 66 72 6f 6d 20 61 20 ition to from a
13ac0 67 69 76 65 6e 20 73 65 74 20 6f 66 20 73 74 61 given set of sta
13ad0 74 65 73 2e 20 20 41 6e 79 20 72 61 6e 67 65 73 tes. Any ranges
13ae0 20 74 68 61 74 0a 3b 3b 20 77 6f 75 6c 64 20 6f that.;; would o
13af0 76 65 72 6c 61 70 20 77 69 74 68 20 64 69 73 74 verlap with dist
13b00 69 6e 63 74 20 63 68 61 72 61 63 74 65 72 73 20 inct characters
13b10 61 72 65 20 73 70 6c 69 74 20 61 63 63 6f 72 64 are split accord
13b20 69 6e 67 6c 79 2e 0a 28 64 65 66 69 6e 65 20 28 ingly..(define (
13b30 6e 66 61 2d 73 74 61 74 65 2d 74 72 61 6e 73 69 nfa-state-transi
13b40 74 69 6f 6e 73 20 6e 66 61 20 73 74 61 74 65 73 tions nfa states
13b50 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 74 72 ). (let lp ((tr
13b60 61 6e 73 20 27 28 29 29 20 20 20 3b 3b 20 6c 69 ans '()) ;; li
13b70 73 74 20 6f 66 20 28 63 68 61 72 20 2e 20 73 74 st of (char . st
13b80 61 74 65 29 20 6f 72 20 28 28 63 68 61 72 20 2e ate) or ((char .
13b90 20 63 68 61 72 29 20 2e 20 73 74 61 74 65 29 0a char) . state).
13ba0 20 20 20 20 20 20 20 20 20 20 20 28 6c 73 20 73 (ls s
13bb0 74 61 74 65 73 29 20 20 20 3b 3b 20 6c 69 73 74 tates) ;; list
13bc0 20 6f 66 20 69 6e 74 65 67 65 72 73 20 28 72 65 of integers (re
13bd0 6d 61 69 6e 69 6e 67 20 73 74 61 74 65 20 6e 75 maining state nu
13be0 6d 62 65 72 73 29 0a 20 20 20 20 20 20 20 20 20 mbers).
13bf0 20 20 28 72 65 73 20 27 28 29 29 29 20 20 20 20 (res '()))
13c00 3b 3b 20 28 63 68 61 72 20 73 74 61 74 65 20 2e ;; (char state .
13c10 2e 2e 29 20 6f 72 20 28 28 63 68 61 72 20 2e 20 ..) or ((char .
13c20 63 68 61 72 29 20 73 74 61 74 65 20 2e 2e 2e 29 char) state ...)
13c30 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 . (cond.
13c40 28 28 6e 75 6c 6c 3f 20 74 72 61 6e 73 29 0a 20 ((null? trans).
13c50 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 (if (null?
13c60 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 28 6d ls). (m
13c70 61 70 20 28 6c 61 6d 62 64 61 20 28 78 29 20 28 ap (lambda (x) (
13c80 63 6f 6e 73 20 28 63 61 72 20 78 29 20 28 6e 66 cons (car x) (nf
13c90 61 2d 63 6c 6f 73 75 72 65 20 6e 66 61 20 28 63 a-closure nfa (c
13ca0 64 72 20 78 29 29 29 29 0a 20 20 20 20 20 20 20 dr x)))).
13cb0 20 20 20 20 20 20 20 20 72 65 73 29 0a 20 20 20 res).
13cc0 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 6f (let ((no
13cd0 64 65 20 28 61 73 73 76 20 28 63 61 72 20 6c 73 de (assv (car ls
13ce0 29 20 6e 66 61 29 29 29 0a 20 20 20 20 20 20 20 ) nfa))).
13cf0 20 20 20 20 20 28 6c 70 20 28 69 66 20 6e 6f 64 (lp (if nod
13d00 65 20 28 63 64 72 20 6e 6f 64 65 29 20 27 28 29 e (cdr node) '()
13d10 29 20 28 63 64 72 20 6c 73 29 20 72 65 73 29 29 ) (cdr ls) res))
13d20 29 29 0a 20 20 20 20 20 28 28 65 71 3f 20 27 65 )). ((eq? 'e
13d30 70 73 69 6c 6f 6e 20 28 63 61 61 72 20 74 72 61 psilon (caar tra
13d40 6e 73 29 29 0a 20 20 20 20 20 20 28 6c 70 20 28 ns)). (lp (
13d50 63 64 72 20 74 72 61 6e 73 29 20 6c 73 20 72 65 cdr trans) ls re
13d60 73 29 29 0a 20 20 20 20 20 28 65 6c 73 65 0a 20 s)). (else.
13d70 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 74 72 (lp (cdr tr
13d80 61 6e 73 29 20 6c 73 20 28 6e 66 61 2d 6a 6f 69 ans) ls (nfa-joi
13d90 6e 2d 74 72 61 6e 73 69 74 69 6f 6e 73 21 20 72 n-transitions! r
13da0 65 73 20 28 63 61 72 20 74 72 61 6e 73 29 29 29 es (car trans)))
13db0 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 6e ))))..(define (n
13dc0 66 61 2d 6a 6f 69 6e 2d 74 72 61 6e 73 69 74 69 fa-join-transiti
13dd0 6f 6e 73 21 20 65 78 69 73 74 69 6e 67 20 6e 65 ons! existing ne
13de0 77 29 0a 20 20 28 64 65 66 69 6e 65 20 28 6a 6f w). (define (jo
13df0 69 6e 20 6c 73 20 65 6c 74 20 73 74 61 74 65 29 in ls elt state)
13e00 0a 20 20 20 20 28 69 66 20 28 6e 6f 74 20 65 6c . (if (not el
13e10 74 29 0a 20 20 20 20 20 20 20 20 6c 73 0a 20 20 t). ls.
13e20 20 20 20 20 20 20 28 6e 66 61 2d 6a 6f 69 6e 2d (nfa-join-
13e30 74 72 61 6e 73 69 74 69 6f 6e 73 21 20 6c 73 20 transitions! ls
13e40 28 63 6f 6e 73 20 65 6c 74 20 73 74 61 74 65 29 (cons elt state)
13e50 29 29 29 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 ))). (cond. (
13e60 28 63 68 61 72 3f 20 28 63 61 72 20 6e 65 77 29 (char? (car new)
13e70 29 0a 20 20 20 20 28 6c 65 74 20 28 28 63 68 20 ). (let ((ch
13e80 28 63 61 72 20 6e 65 77 29 29 29 0a 20 20 20 20 (car new))).
13e90 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 20 65 (let lp ((ls e
13ea0 78 69 73 74 69 6e 67 29 20 28 72 65 73 20 27 28 xisting) (res '(
13eb0 29 29 29 0a 20 20 20 20 20 20 20 20 28 63 6f 6e ))). (con
13ec0 64 0a 20 20 20 20 20 20 20 20 20 28 28 6e 75 6c d. ((nul
13ed0 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 l? ls).
13ee0 20 3b 3b 20 64 6f 6e 65 2c 20 6a 75 73 74 20 63 ;; done, just c
13ef0 6f 6e 73 20 74 68 69 73 20 6f 6e 20 74 6f 20 74 ons this on to t
13f00 68 65 20 6f 72 69 67 69 6e 61 6c 20 6c 69 73 74 he original list
13f10 0a 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 . (cons
13f20 20 28 6c 69 73 74 20 63 68 20 28 63 64 72 20 6e (list ch (cdr n
13f30 65 77 29 29 20 65 78 69 73 74 69 6e 67 29 29 0a ew)) existing)).
13f40 20 20 20 20 20 20 20 20 20 28 28 65 71 76 3f 20 ((eqv?
13f50 63 68 20 28 63 61 61 72 20 6c 73 29 29 0a 20 20 ch (caar ls)).
13f60 20 20 20 20 20 20 20 20 3b 3b 20 61 64 64 20 61 ;; add a
13f70 20 6e 65 77 20 73 74 61 74 65 20 74 6f 20 61 6e new state to an
13f80 20 65 78 69 73 74 69 6e 67 20 63 68 61 72 0a 20 existing char.
13f90 20 20 20 20 20 20 20 20 20 28 73 65 74 2d 63 64 (set-cd
13fa0 72 21 20 28 63 61 72 20 6c 73 29 20 28 69 6e 73 r! (car ls) (ins
13fb0 65 72 74 2d 73 6f 72 74 65 64 20 28 63 64 72 20 ert-sorted (cdr
13fc0 6e 65 77 29 20 28 63 64 61 72 20 6c 73 29 29 29 new) (cdar ls)))
13fd0 0a 20 20 20 20 20 20 20 20 20 20 65 78 69 73 74 . exist
13fe0 69 6e 67 29 0a 20 20 20 20 20 20 20 20 20 28 28 ing). ((
13ff0 61 6e 64 20 28 70 61 69 72 3f 20 28 63 61 61 72 and (pair? (caar
14000 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls)).
14010 20 20 20 20 20 28 63 68 61 72 3c 3d 3f 20 28 63 (char<=? (c
14020 61 61 61 72 20 6c 73 29 20 63 68 29 0a 20 20 20 aaar ls) ch).
14030 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 61 (cha
14040 72 3c 3d 3f 20 63 68 20 28 63 64 61 61 72 20 6c r<=? ch (cdaar l
14050 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b s))). ;
14060 3b 20 73 70 6c 69 74 20 61 20 72 61 6e 67 65 0a ; split a range.
14070 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 (apply
14080 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d . (lam
14090 62 64 61 20 28 6c 65 66 74 20 72 69 67 68 74 29 bda (left right)
140a0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 . (c
140b0 6f 6e 73 20 28 63 6f 6e 73 20 63 68 20 28 69 6e ons (cons ch (in
140c0 73 65 72 74 2d 73 6f 72 74 65 64 20 28 63 64 72 sert-sorted (cdr
140d0 20 6e 65 77 29 20 28 63 64 61 72 20 6c 73 29 29 new) (cdar ls))
140e0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
140f0 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 69 66 (append (if
14100 20 6c 65 66 74 20 28 6c 69 73 74 20 28 63 6f 6e left (list (con
14110 73 20 6c 65 66 74 20 28 63 64 61 72 20 6c 73 29 s left (cdar ls)
14120 29 29 20 27 28 29 29 0a 20 20 20 20 20 20 20 20 )) '()).
14130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14140 20 20 20 28 69 66 20 72 69 67 68 74 20 28 6c 69 (if right (li
14150 73 74 20 28 63 6f 6e 73 20 72 69 67 68 74 20 28 st (cons right (
14160 63 64 61 72 20 6c 73 29 29 29 20 27 28 29 29 0a cdar ls))) '()).
14170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14180 20 20 20 20 20 20 20 20 20 20 20 72 65 73 0a 20 res.
14190 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
141a0 20 20 20 20 20 20 20 20 20 20 28 63 64 72 20 6c (cdr l
141b0 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 s)))).
141c0 20 28 73 70 6c 69 74 2d 63 68 61 72 2d 72 61 6e (split-char-ran
141d0 67 65 20 28 63 61 61 72 20 6c 73 29 20 28 63 61 ge (caar ls) (ca
141e0 72 20 6e 65 77 29 29 29 29 0a 20 20 20 20 20 20 r new)))).
141f0 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
14200 20 20 20 3b 3b 20 6b 65 65 70 20 6c 6f 6f 6b 69 ;; keep looki
14210 6e 67 0a 20 20 20 20 20 20 20 20 20 20 28 6c 70 ng. (lp
14220 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 20 (cdr ls) (cons
14230 28 63 61 72 20 6c 73 29 20 72 65 73 29 29 29 29 (car ls) res))))
14240 29 29 29 0a 20 20 20 28 65 6c 73 65 0a 20 20 20 ))). (else.
14250 20 28 6c 65 74 20 28 28 6c 6f 20 28 63 61 61 72 (let ((lo (caar
14260 20 6e 65 77 29 29 0a 20 20 20 20 20 20 20 20 20 new)).
14270 20 28 68 69 20 28 63 64 61 72 20 6e 65 77 29 29 (hi (cdar new))
14280 29 0a 20 20 20 20 20 20 28 6c 65 74 20 6c 70 20 ). (let lp
14290 28 28 6c 73 20 65 78 69 73 74 69 6e 67 29 20 28 ((ls existing) (
142a0 72 65 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 res '())).
142b0 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
142c0 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 ((null? ls).
142d0 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 6c 69 (cons (li
142e0 73 74 20 28 63 61 72 20 6e 65 77 29 20 28 63 64 st (car new) (cd
142f0 72 20 6e 65 77 29 29 20 65 78 69 73 74 69 6e 67 r new)) existing
14300 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 61 6e )). ((an
14310 64 20 28 63 68 61 72 3f 20 28 63 61 61 72 20 6c d (char? (caar l
14320 73 29 29 20 28 63 68 61 72 3c 3d 3f 20 6c 6f 20 s)) (char<=? lo
14330 28 63 61 61 72 20 6c 73 29 29 20 28 63 68 61 72 (caar ls)) (char
14340 3c 3d 3f 20 28 63 61 61 72 20 6c 73 29 20 68 69 <=? (caar ls) hi
14350 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b 3b 20 )). ;;
14360 72 61 6e 67 65 20 65 6e 63 6c 6f 73 69 6e 67 20 range enclosing
14370 61 20 63 68 61 72 61 63 74 65 72 0a 20 20 20 20 a character.
14380 20 20 20 20 20 20 28 61 70 70 6c 79 0a 20 20 20 (apply.
14390 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
143a0 28 6c 65 66 74 20 72 69 67 68 74 29 0a 20 20 20 (left right).
143b0 20 20 20 20 20 20 20 20 20 20 28 73 65 74 2d 63 (set-c
143c0 64 72 21 20 28 63 61 72 20 6c 73 29 20 28 69 6e dr! (car ls) (in
143d0 73 65 72 74 2d 73 6f 72 74 65 64 20 28 63 64 72 sert-sorted (cdr
143e0 20 6e 65 77 29 20 28 63 64 61 72 20 6c 73 29 29 new) (cdar ls))
143f0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
14400 6a 6f 69 6e 20 28 6a 6f 69 6e 20 65 78 69 73 74 join (join exist
14410 69 6e 67 20 6c 65 66 74 20 28 63 64 72 20 6e 65 ing left (cdr ne
14420 77 29 29 20 72 69 67 68 74 20 28 63 64 72 20 6e w)) right (cdr n
14430 65 77 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ew))).
14440 20 28 73 70 6c 69 74 2d 63 68 61 72 2d 72 61 6e (split-char-ran
14450 67 65 20 28 63 61 72 20 6e 65 77 29 20 28 63 61 ge (car new) (ca
14460 61 72 20 6c 73 29 29 29 29 0a 20 20 20 20 20 20 ar ls)))).
14470 20 20 20 28 28 61 6e 64 20 28 70 61 69 72 3f 20 ((and (pair?
14480 28 63 61 61 72 20 6c 73 29 29 0a 20 20 20 20 20 (caar ls)).
14490 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 61 (or (a
144a0 6e 64 20 28 63 68 61 72 3c 3d 3f 20 28 63 61 61 nd (char<=? (caa
144b0 61 72 20 6c 73 29 20 68 69 29 20 28 63 68 61 72 ar ls) hi) (char
144c0 3c 3d 3f 20 6c 6f 20 28 63 64 61 61 72 20 6c 73 <=? lo (cdaar ls
144d0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
144e0 20 20 20 20 20 20 20 28 61 6e 64 20 28 63 68 61 (and (cha
144f0 72 3c 3d 3f 20 68 69 20 28 63 61 61 61 72 20 6c r<=? hi (caaar l
14500 73 29 29 20 28 63 68 61 72 3c 3d 3f 20 28 63 64 s)) (char<=? (cd
14510 61 61 72 20 6c 73 29 20 6c 6f 29 29 29 29 0a 20 aar ls) lo)))).
14520 20 20 20 20 20 20 20 20 20 3b 3b 20 6f 76 65 72 ;; over
14530 6c 61 70 70 69 6e 67 20 72 61 6e 67 65 73 0a 20 lapping ranges.
14540 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 0a (apply.
14550 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
14560 64 61 20 28 6c 65 66 74 31 20 6c 65 66 74 32 20 da (left1 left2
14570 73 61 6d 65 20 72 69 67 68 74 31 20 72 69 67 68 same right1 righ
14580 74 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t2).
14590 20 28 6c 65 74 20 28 28 6f 6c 64 2d 73 74 61 74 (let ((old-stat
145a0 65 73 20 28 63 64 61 72 20 6c 73 29 29 29 0a 20 es (cdar ls))).
145b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
145c0 65 74 2d 63 61 72 21 20 28 63 61 72 20 6c 73 29 et-car! (car ls)
145d0 20 73 61 6d 65 29 0a 20 20 20 20 20 20 20 20 20 same).
145e0 20 20 20 20 20 20 28 73 65 74 2d 63 64 72 21 20 (set-cdr!
145f0 28 63 61 72 20 6c 73 29 20 28 69 6e 73 65 72 74 (car ls) (insert
14600 2d 73 6f 72 74 65 64 20 28 63 64 72 20 6e 65 77 -sorted (cdr new
14610 29 20 6f 6c 64 2d 73 74 61 74 65 73 29 29 0a 20 ) old-states)).
14620 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
14630 65 74 2a 20 28 28 72 65 73 20 28 69 66 20 72 69 et* ((res (if ri
14640 67 68 74 31 0a 20 20 20 20 20 20 20 20 20 20 20 ght1.
14650 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14660 20 20 20 20 28 63 6f 6e 73 20 28 63 6f 6e 73 20 (cons (cons
14670 72 69 67 68 74 31 20 6f 6c 64 2d 73 74 61 74 65 right1 old-state
14680 73 29 20 65 78 69 73 74 69 6e 67 29 0a 20 20 20 s) existing).
14690 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
146a0 20 20 20 20 20 20 20 20 20 20 20 20 65 78 69 73 exis
146b0 74 69 6e 67 29 29 0a 20 20 20 20 20 20 20 20 20 ting)).
146c0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 (re
146d0 73 20 28 69 66 20 72 69 67 68 74 32 20 28 63 6f s (if right2 (co
146e0 6e 73 20 28 63 6f 6e 73 20 72 69 67 68 74 32 20 ns (cons right2
146f0 6f 6c 64 2d 73 74 61 74 65 73 29 20 72 65 73 29 old-states) res)
14700 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 res))).
14710 20 20 20 20 20 20 20 20 20 28 6a 6f 69 6e 20 28 (join (
14720 6a 6f 69 6e 20 72 65 73 20 6c 65 66 74 31 20 28 join res left1 (
14730 63 64 72 20 6e 65 77 29 29 20 6c 65 66 74 32 20 cdr new)) left2
14740 28 63 64 72 20 6e 65 77 29 29 29 29 29 0a 20 20 (cdr new))))).
14750 20 20 20 20 20 20 20 20 20 28 69 6e 74 65 72 73 (inters
14760 65 63 74 2d 63 68 61 72 2d 72 61 6e 67 65 73 20 ect-char-ranges
14770 28 63 61 72 20 6e 65 77 29 20 28 63 61 61 72 20 (car new) (caar
14780 6c 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 ls)))).
14790 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else.
147a0 28 6c 70 20 28 63 64 72 20 6c 73 29 20 28 63 6f (lp (cdr ls) (co
147b0 6e 73 20 28 63 61 72 20 6c 73 29 20 72 65 73 29 ns (car ls) res)
147c0 29 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e ))))))))..(defin
147d0 65 20 28 63 68 61 72 2d 72 61 6e 67 65 20 63 31 e (char-range c1
147e0 20 63 32 29 0a 20 20 28 69 66 20 28 65 71 76 3f c2). (if (eqv?
147f0 20 63 31 20 63 32 29 20 63 31 20 28 63 6f 6e 73 c1 c2) c1 (cons
14800 20 63 31 20 63 32 29 29 29 0a 0a 3b 3b 20 61 73 c1 c2)))..;; as
14810 73 75 6d 65 73 20 63 68 20 69 73 20 69 6e 63 6c sumes ch is incl
14820 75 64 65 64 20 69 6e 20 74 68 65 20 72 61 6e 67 uded in the rang
14830 65 0a 28 64 65 66 69 6e 65 20 28 73 70 6c 69 74 e.(define (split
14840 2d 63 68 61 72 2d 72 61 6e 67 65 20 72 61 6e 67 -char-range rang
14850 65 20 63 68 29 0a 20 20 28 6c 69 73 74 0a 20 20 e ch). (list.
14860 20 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 76 3f (and (not (eqv?
14870 20 63 68 20 28 63 61 72 20 72 61 6e 67 65 29 29 ch (car range))
14880 29 0a 20 20 20 20 20 20 20 20 28 63 68 61 72 2d ). (char-
14890 72 61 6e 67 65 20 28 63 61 72 20 72 61 6e 67 65 range (car range
148a0 29 20 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 ) (integer->char
148b0 20 28 2d 20 28 63 68 61 72 2d 3e 69 6e 74 65 67 (- (char->integ
148c0 65 72 20 63 68 29 20 31 29 29 29 29 0a 20 20 20 er ch) 1)))).
148d0 28 61 6e 64 20 28 6e 6f 74 20 28 65 71 76 3f 20 (and (not (eqv?
148e0 63 68 20 28 63 64 72 20 72 61 6e 67 65 29 29 29 ch (cdr range)))
148f0 0a 20 20 20 20 20 20 20 20 28 63 68 61 72 2d 72 . (char-r
14900 61 6e 67 65 20 28 69 6e 74 65 67 65 72 2d 3e 63 ange (integer->c
14910 68 61 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e har (+ (char->in
14920 74 65 67 65 72 20 63 68 29 20 31 29 29 20 28 63 teger ch) 1)) (c
14930 64 72 20 72 61 6e 67 65 29 29 29 29 29 0a 0a 3b dr range)))))..;
14940 3b 20 72 65 74 75 72 6e 73 20 28 70 6f 73 73 69 ; returns (possi
14950 62 6c 79 20 23 66 29 20 63 68 61 72 20 72 61 6e bly #f) char ran
14960 67 65 73 3a 0a 3b 3b 20 20 20 20 61 2d 6f 6e 6c ges:.;; a-onl
14970 79 2d 31 20 20 61 2d 6f 6e 6c 79 2d 32 20 20 61 y-1 a-only-2 a
14980 2d 61 6e 64 2d 62 20 20 62 2d 6f 6e 6c 79 2d 31 -and-b b-only-1
14990 20 20 62 2d 6f 6e 6c 79 2d 32 0a 28 64 65 66 69 b-only-2.(defi
149a0 6e 65 20 28 69 6e 74 65 72 73 65 63 74 2d 63 68 ne (intersect-ch
149b0 61 72 2d 72 61 6e 67 65 73 20 61 20 62 29 0a 20 ar-ranges a b).
149c0 20 28 69 66 20 28 63 68 61 72 3e 3f 20 28 63 61 (if (char>? (ca
149d0 72 20 61 29 20 28 63 61 72 20 62 29 29 0a 20 20 r a) (car b)).
149e0 20 20 20 20 28 72 65 76 65 72 73 65 20 28 69 6e (reverse (in
149f0 74 65 72 73 65 63 74 2d 63 68 61 72 2d 72 61 6e tersect-char-ran
14a00 67 65 73 20 62 20 61 29 29 0a 20 20 20 20 20 20 ges b a)).
14a10 28 6c 65 74 20 28 28 61 2d 6c 6f 20 28 63 61 72 (let ((a-lo (car
14a20 20 61 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 a)).
14a30 20 28 61 2d 68 69 20 28 63 64 72 20 61 29 29 0a (a-hi (cdr a)).
14a40 20 20 20 20 20 20 20 20 20 20 20 20 28 62 2d 6c (b-l
14a50 6f 20 28 63 61 72 20 62 29 29 0a 20 20 20 20 20 o (car b)).
14a60 20 20 20 20 20 20 20 28 62 2d 68 69 20 28 63 64 (b-hi (cd
14a70 72 20 62 29 29 29 0a 20 20 20 20 20 20 20 20 28 r b))). (
14a80 6c 69 73 74 0a 20 20 20 20 20 20 20 20 20 28 61 list. (a
14a90 6e 64 20 28 63 68 61 72 3c 3f 20 61 2d 6c 6f 20 nd (char<? a-lo
14aa0 62 2d 6c 6f 29 0a 20 20 20 20 20 20 20 20 20 20 b-lo).
14ab0 20 20 20 20 28 63 68 61 72 2d 72 61 6e 67 65 20 (char-range
14ac0 61 2d 6c 6f 20 28 69 6e 74 65 67 65 72 2d 3e 63 a-lo (integer->c
14ad0 68 61 72 20 28 2d 20 28 63 68 61 72 2d 3e 69 6e har (- (char->in
14ae0 74 65 67 65 72 20 62 2d 6c 6f 29 20 31 29 29 29 teger b-lo) 1)))
14af0 29 0a 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 ). (and
14b00 28 63 68 61 72 3e 3f 20 61 2d 68 69 20 62 2d 68 (char>? a-hi b-h
14b10 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
14b20 20 28 63 68 61 72 2d 72 61 6e 67 65 20 28 69 6e (char-range (in
14b30 74 65 67 65 72 2d 3e 63 68 61 72 20 28 2b 20 28 teger->char (+ (
14b40 63 68 61 72 2d 3e 69 6e 74 65 67 65 72 20 62 2d char->integer b-
14b50 68 69 29 20 31 29 29 20 61 2d 68 69 29 29 0a 20 hi) 1)) a-hi)).
14b60 20 20 20 20 20 20 20 20 28 63 68 61 72 2d 72 61 (char-ra
14b70 6e 67 65 20 62 2d 6c 6f 20 28 69 66 20 28 63 68 nge b-lo (if (ch
14b80 61 72 3c 3f 20 62 2d 68 69 20 61 2d 68 69 29 20 ar<? b-hi a-hi)
14b90 62 2d 68 69 20 61 2d 68 69 29 29 0a 20 20 20 20 b-hi a-hi)).
14ba0 20 20 20 20 20 23 66 0a 20 20 20 20 20 20 20 20 #f.
14bb0 20 28 61 6e 64 20 28 63 68 61 72 3e 3f 20 62 2d (and (char>? b-
14bc0 68 69 20 61 2d 68 69 29 0a 20 20 20 20 20 20 20 hi a-hi).
14bd0 20 20 20 20 20 20 20 28 63 68 61 72 2d 72 61 6e (char-ran
14be0 67 65 20 28 69 6e 74 65 67 65 72 2d 3e 63 68 61 ge (integer->cha
14bf0 72 20 28 2b 20 28 63 68 61 72 2d 3e 69 6e 74 65 r (+ (char->inte
14c00 67 65 72 20 61 2d 68 69 29 20 31 29 29 20 62 2d ger a-hi) 1)) b-
14c10 68 69 29 29 29 29 29 29 0a 0a 3b 3b 20 54 68 65 hi))))))..;; The
14c20 20 60 63 6c 6f 73 75 72 65 27 20 6f 66 20 61 20 `closure' of a
14c30 6c 69 73 74 20 6f 66 20 4e 46 41 20 73 74 61 74 list of NFA stat
14c40 65 73 20 2d 20 61 6c 6c 20 73 74 61 74 65 73 20 es - all states
14c50 74 68 61 74 20 63 61 6e 20 62 65 0a 3b 3b 20 72 that can be.;; r
14c60 65 61 63 68 65 64 20 66 72 6f 6d 20 61 6e 79 20 eached from any
14c70 6f 66 20 74 68 65 6d 20 75 73 69 6e 67 20 61 6e of them using an
14c80 79 20 6e 75 6d 62 65 72 20 6f 66 20 65 70 73 69 y number of epsi
14c90 6c 6f 6e 20 74 72 61 6e 73 69 74 69 6f 6e 73 2e lon transitions.
14ca0 0a 28 64 65 66 69 6e 65 20 28 6e 66 61 2d 63 6c .(define (nfa-cl
14cb0 6f 73 75 72 65 20 6e 66 61 20 73 74 61 74 65 73 osure nfa states
14cc0 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 6c 73 ). (let lp ((ls
14cd0 20 73 74 61 74 65 73 29 0a 20 20 20 20 20 20 20 states).
14ce0 20 20 20 20 28 72 65 73 20 27 28 29 29 29 0a 20 (res '())).
14cf0 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 (cond. ((
14d00 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 null? ls).
14d10 72 65 73 29 0a 20 20 20 20 20 28 28 6d 65 6d 76 res). ((memv
14d20 20 28 63 61 72 20 6c 73 29 20 72 65 73 29 0a 20 (car ls) res).
14d30 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 (lp (cdr ls
14d40 29 20 72 65 73 29 29 0a 20 20 20 20 20 28 65 6c ) res)). (el
14d50 73 65 0a 20 20 20 20 20 20 28 6c 70 20 28 61 70 se. (lp (ap
14d60 70 65 6e 64 20 28 6d 61 70 20 63 64 72 0a 20 20 pend (map cdr.
14d70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14d80 20 20 20 20 20 28 66 69 6c 74 65 72 20 28 6c 61 (filter (la
14d90 6d 62 64 61 20 28 74 72 61 6e 73 29 20 28 65 71 mbda (trans) (eq
14da0 3f 20 27 65 70 73 69 6c 6f 6e 20 28 63 61 72 20 ? 'epsilon (car
14db0 74 72 61 6e 73 29 29 29 0a 20 20 20 20 20 20 20 trans))).
14dc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14dd0 20 20 20 20 20 20 20 20 28 63 64 72 20 28 61 73 (cdr (as
14de0 73 76 20 28 63 61 72 20 6c 73 29 20 6e 66 61 29 sv (car ls) nfa)
14df0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
14e00 20 20 20 20 20 20 28 63 64 72 20 6c 73 29 29 0a (cdr ls)).
14e10 20 20 20 20 20 20 20 20 20 20 28 69 6e 73 65 72 (inser
14e20 74 2d 73 6f 72 74 65 64 20 28 63 61 72 20 6c 73 t-sorted (car ls
14e30 29 20 72 65 73 29 29 29 29 29 29 0a 0a 3b 3b 20 ) res))))))..;;
14e40 69 6e 73 65 72 74 20 61 6e 20 69 6e 74 65 67 65 insert an intege
14e50 72 20 75 6e 69 71 75 65 6c 79 20 69 6e 74 6f 20 r uniquely into
14e60 61 20 73 6f 72 74 65 64 20 6c 69 73 74 0a 28 64 a sorted list.(d
14e70 65 66 69 6e 65 20 28 69 6e 73 65 72 74 2d 73 6f efine (insert-so
14e80 72 74 65 64 20 6e 20 6c 73 29 0a 20 20 28 63 6f rted n ls). (co
14e90 6e 64 0a 20 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 nd. ((null? ls
14ea0 29 0a 20 20 20 20 28 63 6f 6e 73 20 6e 20 27 28 ). (cons n '(
14eb0 29 29 29 0a 20 20 20 28 28 3c 3d 20 6e 20 28 63 ))). ((<= n (c
14ec0 61 72 20 6c 73 29 29 0a 20 20 20 20 28 69 66 20 ar ls)). (if
14ed0 28 3d 20 6e 20 28 63 61 72 20 6c 73 29 29 0a 20 (= n (car ls)).
14ee0 20 20 20 20 20 20 20 6c 73 0a 20 20 20 20 20 20 ls.
14ef0 20 20 28 63 6f 6e 73 20 6e 20 6c 73 29 29 29 0a (cons n ls))).
14f00 20 20 20 28 65 6c 73 65 0a 20 20 20 20 28 63 6f (else. (co
14f10 6e 73 20 28 63 61 72 20 6c 73 29 20 28 69 6e 73 ns (car ls) (ins
14f20 65 72 74 2d 73 6f 72 74 65 64 20 6e 20 28 63 64 ert-sorted n (cd
14f30 72 20 6c 73 29 29 29 29 29 29 0a 0a 3b 3b 3b 3b r ls))))))..;;;;
14f40 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14f50 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14f60 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14f70 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
14f80 3b 3b 3b 3b 0a 3b 3b 20 44 46 41 73 20 64 6f 6e ;;;;.;; DFAs don
14f90 27 74 20 67 69 76 65 20 75 73 20 6d 61 74 63 68 't give us match
14fa0 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2c 20 73 6f information, so
14fb0 20 6f 6e 63 65 20 77 65 20 6d 61 74 63 68 20 61 once we match a
14fc0 6e 64 0a 3b 3b 20 64 65 74 65 72 6d 69 6e 65 20 nd.;; determine
14fd0 74 68 65 20 73 74 61 72 74 20 61 6e 64 20 65 6e the start and en
14fe0 64 2c 20 77 65 20 6e 65 65 64 20 74 6f 20 72 65 d, we need to re
14ff0 63 75 72 73 69 76 65 6c 79 20 62 72 65 61 6b 20 cursively break
15000 74 68 65 0a 3b 3b 20 70 72 6f 62 6c 65 6d 20 69 the.;; problem i
15010 6e 74 6f 20 73 6d 61 6c 6c 65 72 20 44 46 41 73 nto smaller DFAs
15020 20 74 6f 20 67 65 74 20 65 61 63 68 20 73 75 62 to get each sub
15030 6d 61 74 63 68 2e 0a 3b 3b 0a 3b 3b 20 53 65 65 match..;;.;; See
15040 20 68 74 74 70 3a 2f 2f 63 6f 6d 70 69 6c 65 72 http://compiler
15050 73 2e 69 65 63 63 2e 63 6f 6d 2f 63 6f 6d 70 61 s.iecc.com/compa
15060 72 63 68 2f 61 72 74 69 63 6c 65 2f 30 37 2d 31 rch/article/07-1
15070 30 2d 30 32 36 0a 0a 28 64 65 66 69 6e 65 20 28 0-026..(define (
15080 73 72 65 2d 6d 61 74 63 68 2d 65 78 74 72 61 63 sre-match-extrac
15090 74 6f 72 20 73 72 65 20 6e 75 6d 2d 73 75 62 6d tor sre num-subm
150a0 61 74 63 68 65 73 29 0a 20 20 28 6c 65 74 2a 20 atches). (let*
150b0 28 28 74 6d 70 20 28 2b 20 6e 75 6d 2d 73 75 62 ((tmp (+ num-sub
150c0 6d 61 74 63 68 65 73 20 31 29 29 0a 20 20 20 20 matches 1)).
150d0 20 20 20 20 20 28 74 6d 70 2d 65 6e 64 2d 73 72 (tmp-end-sr
150e0 63 2d 6f 66 66 73 65 74 20 28 2b 20 35 20 28 2a c-offset (+ 5 (*
150f0 20 74 6d 70 20 34 29 29 29 0a 20 20 20 20 20 20 tmp 4))).
15100 20 20 20 28 74 6d 70 2d 65 6e 64 2d 69 6e 64 65 (tmp-end-inde
15110 78 2d 6f 66 66 73 65 74 20 28 2b 20 36 20 28 2a x-offset (+ 6 (*
15120 20 74 6d 70 20 34 29 29 29 29 0a 20 20 20 20 28 tmp 4)))). (
15130 6c 65 74 20 6c 70 20 28 28 73 72 65 20 73 72 65 let lp ((sre sre
15140 29 20 28 6e 20 31 29 20 28 73 75 62 6d 61 74 63 ) (n 1) (submatc
15150 68 2d 64 65 70 73 3f 20 23 66 29 29 0a 20 20 20 h-deps? #f)).
15160 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
15170 28 28 6e 6f 74 20 28 73 72 65 2d 68 61 73 2d 73 ((not (sre-has-s
15180 75 62 6d 61 74 63 68 65 73 3f 20 73 72 65 29 29 ubmatches? sre))
15190 0a 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f . (if (no
151a0 74 20 73 75 62 6d 61 74 63 68 2d 64 65 70 73 3f t submatch-deps?
151b0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c ). (l
151c0 61 6d 62 64 61 20 28 63 6e 6b 20 73 74 61 72 74 ambda (cnk start
151d0 20 69 20 65 6e 64 20 6a 20 6d 61 74 63 68 65 73 i end j matches
151e0 29 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 ) #t).
151f0 20 20 28 6c 65 74 20 28 28 64 66 61 20 28 6e 66 (let ((dfa (nf
15200 61 2d 3e 64 66 61 20 28 73 72 65 2d 3e 6e 66 61 a->dfa (sre->nfa
15210 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 sre)))).
15220 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
15230 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 20 cnk start i end
15240 6a 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 j matches).
15250 20 20 20 20 20 20 20 20 20 20 20 28 64 66 61 2d (dfa-
15260 6d 61 74 63 68 2f 6c 6f 6e 67 65 73 74 20 64 66 match/longest df
15270 61 20 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e a cnk start i en
15280 64 20 6a 20 6d 61 74 63 68 65 73 20 74 6d 70 29 d j matches tmp)
15290 29 29 29 29 0a 20 20 20 20 20 20 20 28 28 70 61 )))). ((pa
152a0 69 72 3f 20 73 72 65 29 0a 20 20 20 20 20 20 20 ir? sre).
152b0 20 28 63 61 73 65 20 28 63 61 72 20 73 72 65 29 (case (car sre)
152c0 0a 20 20 20 20 20 20 20 20 20 20 28 28 3a 20 73 . ((: s
152d0 65 71 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 eq). (
152e0 6c 65 74 2a 20 28 28 72 69 67 68 74 20 28 73 72 let* ((right (sr
152f0 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 64 72 e-sequence (cddr
15300 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 sre))).
15310 20 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 (match
15320 2d 6c 65 66 74 20 28 6c 70 20 28 63 61 64 72 20 -left (lp (cadr
15330 73 72 65 29 20 6e 20 23 74 29 29 0a 20 20 20 20 sre) n #t)).
15340 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
15350 61 74 63 68 2d 72 69 67 68 74 0a 20 20 20 20 20 atch-right.
15360 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
15370 70 20 72 69 67 68 74 20 28 2b 20 6e 20 28 73 72 p right (+ n (sr
15380 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 68 e-count-submatch
15390 65 73 20 28 63 61 64 72 20 73 72 65 29 29 29 20 es (cadr sre)))
153a0 23 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 #t))).
153b0 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 (lambda (cnk
153c0 73 74 61 72 74 20 69 20 65 6e 64 20 6a 20 6d 61 start i end j ma
153d0 74 63 68 65 73 29 0a 20 20 20 20 20 20 20 20 20 tches).
153e0 20 20 20 20 20 20 28 6c 65 74 20 6c 70 31 20 28 (let lp1 (
153f0 28 65 6e 64 32 20 65 6e 64 29 20 28 6a 32 20 6a (end2 end) (j2 j
15400 29 20 28 62 65 73 74 2d 73 72 63 20 23 66 29 20 ) (best-src #f)
15410 28 62 65 73 74 2d 69 6e 64 65 78 20 23 66 29 29 (best-index #f))
15420 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15430 20 20 28 6c 65 74 20 28 28 6c 69 6d 69 74 20 28 (let ((limit (
15440 69 66 20 28 65 71 3f 20 73 74 61 72 74 20 65 6e if (eq? start en
15450 64 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 d2).
15460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15470 20 20 20 20 20 20 69 0a 20 20 20 20 20 20 20 20 i.
15480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15490 20 20 20 20 20 20 20 20 20 20 28 28 63 68 75 6e ((chun
154a0 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e ker-get-start cn
154b0 6b 29 20 65 6e 64 32 29 29 29 29 0a 20 20 20 20 k) end2)))).
154c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
154d0 6c 65 74 20 6c 70 32 20 28 28 6b 20 6a 32 29 20 let lp2 ((k j2)
154e0 28 62 65 73 74 2d 73 72 63 20 62 65 73 74 2d 73 (best-src best-s
154f0 72 63 29 20 28 62 65 73 74 2d 69 6e 64 65 78 20 rc) (best-index
15500 62 65 73 74 2d 69 6e 64 65 78 29 29 0a 20 20 20 best-index)).
15510 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15520 20 20 28 69 66 20 28 3c 20 6b 20 6c 69 6d 69 74 (if (< k limit
15530 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15540 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 (cond
15550 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15560 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 ((not
15570 20 28 65 71 3f 20 73 74 61 72 74 20 65 6e 64 32 (eq? start end2
15580 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
15590 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
155a0 65 74 20 28 28 70 72 65 76 20 28 63 68 75 6e 6b et ((prev (chunk
155b0 65 72 2d 70 72 65 76 2d 63 68 75 6e 6b 20 63 6e er-prev-chunk cn
155c0 6b 20 73 74 61 72 74 20 65 6e 64 32 29 29 29 0a k start end2))).
155d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
155e0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
155f0 31 20 70 72 65 76 0a 20 20 20 20 20 20 20 20 20 1 prev.
15600 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15610 20 20 20 20 20 20 20 20 20 28 28 63 68 75 6e 6b ((chunk
15620 65 72 2d 67 65 74 2d 65 6e 64 20 63 6e 6b 29 20 er-get-end cnk)
15630 70 72 65 76 29 0a 20 20 20 20 20 20 20 20 20 20 prev).
15640 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15650 20 20 20 20 20 20 20 20 62 65 73 74 2d 73 72 63 best-src
15660 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15670 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15680 20 20 20 62 65 73 74 2d 69 6e 64 65 78 29 29 29 best-index)))
15690 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
156a0 20 20 20 20 20 20 20 20 20 20 20 28 62 65 73 74 (best
156b0 2d 73 72 63 0a 20 20 20 20 20 20 20 20 20 20 20 -src.
156c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
156d0 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 61 74 (vector-set! mat
156e0 63 68 65 73 20 74 6d 70 2d 65 6e 64 2d 73 72 63 ches tmp-end-src
156f0 2d 6f 66 66 73 65 74 20 62 65 73 74 2d 73 72 63 -offset best-src
15700 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15710 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 (ve
15720 63 74 6f 72 2d 73 65 74 21 20 6d 61 74 63 68 65 ctor-set! matche
15730 73 20 74 6d 70 2d 65 6e 64 2d 69 6e 64 65 78 2d s tmp-end-index-
15740 6f 66 66 73 65 74 20 62 65 73 74 2d 69 6e 64 65 offset best-inde
15750 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 x).
15760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 74 #t
15770 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15780 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
15790 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
157a0 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 #f)
157b0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
157c0 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
157d0 61 6e 64 20 28 6d 61 74 63 68 2d 6c 65 66 74 20 and (match-left
157e0 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 32 cnk start i end2
157f0 20 6b 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 k matches).
15800 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
15820 71 3f 20 65 6e 64 32 20 28 76 65 63 74 6f 72 2d q? end2 (vector-
15830 72 65 66 20 6d 61 74 63 68 65 73 0a 20 20 20 20 ref matches.
15840 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15850 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15870 20 20 20 20 74 6d 70 2d 65 6e 64 2d 73 72 63 2d tmp-end-src-
15880 6f 66 66 73 65 74 29 29 0a 20 20 20 20 20 20 20 offset)).
15890 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
158a0 20 20 20 20 20 20 20 20 20 20 20 28 65 71 76 3f (eqv?
158b0 20 6b 20 28 76 65 63 74 6f 72 2d 72 65 66 20 6d k (vector-ref m
158c0 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 20 atches.
158d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
158e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
158f0 20 20 20 20 20 20 20 20 20 20 20 20 20 74 6d 70 tmp
15900 2d 65 6e 64 2d 69 6e 64 65 78 2d 6f 66 66 73 65 -end-index-offse
15910 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 t)).
15920 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15930 20 20 20 20 20 20 28 6d 61 74 63 68 2d 72 69 67 (match-rig
15940 68 74 20 63 6e 6b 20 65 6e 64 32 20 6b 20 65 6e ht cnk end2 k en
15950 64 20 6a 20 6d 61 74 63 68 65 73 29 29 0a 20 20 d j matches)).
15960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15970 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
15980 28 28 72 69 67 68 74 2d 73 72 63 0a 20 20 20 20 ((right-src.
15990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
159a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
159b0 28 76 65 63 74 6f 72 2d 72 65 66 20 6d 61 74 63 (vector-ref matc
159c0 68 65 73 20 74 6d 70 2d 65 6e 64 2d 73 72 63 2d hes tmp-end-src-
159d0 6f 66 66 73 65 74 29 29 0a 20 20 20 20 20 20 20 offset)).
159e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
159f0 20 20 20 20 20 20 20 20 20 20 20 20 28 72 69 67 (rig
15a00 68 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ht.
15a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15a20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 (vector-r
15a30 65 66 20 6d 61 74 63 68 65 73 20 74 6d 70 2d 65 ef matches tmp-e
15a40 6e 64 2d 69 6e 64 65 78 2d 6f 66 66 73 65 74 29 nd-index-offset)
15a50 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
15a60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15a70 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 (cond.
15a80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15a90 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 65 ((and (e
15aa0 71 3f 20 65 6e 64 20 72 69 67 68 74 2d 73 72 63 q? end right-src
15ab0 29 20 28 65 71 76 3f 20 6a 20 72 69 67 68 74 29 ) (eqv? j right)
15ac0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
15ad0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15ae0 20 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 (vector-set!
15af0 6d 61 74 63 68 65 73 20 74 6d 70 2d 65 6e 64 2d matches tmp-end-
15b00 73 72 63 2d 6f 66 66 73 65 74 20 65 6e 64 29 0a src-offset end).
15b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15b20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15b30 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6d 61 (vector-set! ma
15b40 74 63 68 65 73 20 74 6d 70 2d 65 6e 64 2d 69 6e tches tmp-end-in
15b50 64 65 78 2d 6f 66 66 73 65 74 20 6a 29 0a 20 20 dex-offset j).
15b60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15b70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
15b80 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 t).
15b90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15ba0 20 20 20 28 28 6f 72 20 28 6e 6f 74 20 62 65 73 ((or (not bes
15bb0 74 2d 73 72 63 29 0a 20 20 20 20 20 20 20 20 20 t-src).
15bc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15bd0 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
15be0 28 65 71 3f 20 62 65 73 74 2d 73 72 63 20 72 69 (eq? best-src ri
15bf0 67 68 74 2d 73 72 63 29 0a 20 20 20 20 20 20 20 ght-src).
15c00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c20 20 20 28 3e 20 72 69 67 68 74 20 62 65 73 74 2d (> right best-
15c30 69 6e 64 65 78 29 0a 20 20 20 20 20 20 20 20 20 index).
15c40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c60 28 63 68 75 6e 6b 2d 62 65 66 6f 72 65 3f 20 63 (chunk-before? c
15c70 6e 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 nk.
15c80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15c90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15ca0 20 20 20 20 20 20 20 20 20 20 20 62 65 73 74 2d best-
15cb0 73 72 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 src.
15cc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15cd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15ce0 20 20 20 20 20 20 20 20 20 20 20 20 72 69 67 68 righ
15cf0 74 2d 73 72 63 29 29 29 0a 20 20 20 20 20 20 20 t-src))).
15d00 20 20 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 28 6c 70 32 20 28 (lp2 (
15d20 2d 20 6b 20 31 29 20 72 69 67 68 74 2d 73 72 63 - k 1) right-src
15d30 20 72 69 67 68 74 29 29 0a 20 20 20 20 20 20 20 right)).
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 28 65 6c 73 65 0a 20 (else.
15d60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15d80 28 6c 70 32 20 28 2d 20 6b 20 31 29 20 62 65 73 (lp2 (- k 1) bes
15d90 74 2d 73 72 63 20 62 65 73 74 2d 69 6e 64 65 78 t-src best-index
15da0 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
15db0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15dc0 20 20 28 6c 70 32 20 28 2d 20 6b 20 31 29 20 62 (lp2 (- k 1) b
15dd0 65 73 74 2d 73 72 63 20 62 65 73 74 2d 69 6e 64 est-src best-ind
15de0 65 78 29 29 29 29 29 29 29 29 29 0a 20 20 20 20 ex))))))))).
15df0 20 20 20 20 20 20 28 28 6f 72 29 0a 20 20 20 20 ((or).
15e00 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 28 72 (let* ((r
15e10 65 73 74 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 est (sre-alterna
15e20 74 65 20 28 63 64 64 72 20 73 72 65 29 29 29 0a te (cddr sre))).
15e30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15e40 20 20 28 6d 61 74 63 68 2d 66 69 72 73 74 0a 20 (match-first.
15e50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15e60 20 20 28 6c 70 20 28 63 61 64 72 20 73 72 65 29 (lp (cadr sre)
15e70 20 6e 20 23 74 29 29 0a 20 20 20 20 20 20 20 20 n #t)).
15e80 20 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 (match
15e90 2d 72 65 73 74 0a 20 20 20 20 20 20 20 20 20 20 -rest.
15ea0 20 20 20 20 20 20 20 20 20 28 6c 70 20 72 65 73 (lp res
15eb0 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
15ec0 20 20 20 20 20 20 20 20 20 28 2b 20 6e 20 28 73 (+ n (s
15ed0 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 re-count-submatc
15ee0 68 65 73 20 28 63 61 64 72 20 73 72 65 29 29 29 hes (cadr sre)))
15ef0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
15f00 20 20 20 20 20 20 20 20 73 75 62 6d 61 74 63 68 submatch
15f10 2d 64 65 70 73 3f 29 29 29 0a 20 20 20 20 20 20 -deps?))).
15f20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
15f30 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 20 cnk start i end
15f40 6a 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 j matches).
15f50 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 61 (or (a
15f60 6e 64 20 28 6d 61 74 63 68 2d 66 69 72 73 74 20 nd (match-first
15f70 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 20 cnk start i end
15f80 6a 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 j matches).
15f90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
15fa0 20 20 20 28 65 71 3f 20 65 6e 64 20 28 76 65 63 (eq? end (vec
15fb0 74 6f 72 2d 72 65 66 20 6d 61 74 63 68 65 73 20 tor-ref matches
15fc0 74 6d 70 2d 65 6e 64 2d 73 72 63 2d 6f 66 66 73 tmp-end-src-offs
15fd0 65 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 et)).
15fe0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 71 (eq
15ff0 76 3f 20 6a 20 28 76 65 63 74 6f 72 2d 72 65 66 v? j (vector-ref
16000 20 6d 61 74 63 68 65 73 20 74 6d 70 2d 65 6e 64 matches tmp-end
16010 2d 69 6e 64 65 78 2d 6f 66 66 73 65 74 29 29 29 -index-offset)))
16020 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16030 20 20 20 20 28 6d 61 74 63 68 2d 72 65 73 74 20 (match-rest
16040 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 20 cnk start i end
16050 6a 20 6d 61 74 63 68 65 73 29 29 29 29 29 0a 20 j matches))))).
16060 20 20 20 20 20 20 20 20 20 28 28 2a 20 2b 29 0a ((* +).
16070 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 72 (letr
16080 65 63 20 28 28 6d 61 74 63 68 2d 6f 6e 63 65 0a ec ((match-once.
16090 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
160a0 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d 73 65 (lp (sre-se
160b0 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 quence (cdr sre)
160c0 29 20 6e 20 23 74 29 29 0a 20 20 20 20 20 20 20 ) n #t)).
160d0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 (ma
160e0 74 63 68 2d 61 6c 6c 0a 20 20 20 20 20 20 20 20 tch-all.
160f0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
16100 6d 62 64 61 20 28 63 6e 6b 20 73 74 61 72 74 20 mbda (cnk start
16110 69 20 65 6e 64 20 6a 20 6d 61 74 63 68 65 73 29 i end j matches)
16120 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16130 20 20 20 20 20 20 20 20 28 69 66 20 28 6d 61 74 (if (mat
16140 63 68 2d 6f 6e 63 65 20 63 6e 6b 20 73 74 61 72 ch-once cnk star
16150 74 20 69 20 65 6e 64 20 6a 20 6d 61 74 63 68 65 t i end j matche
16160 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
16170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
16180 65 74 20 28 28 73 72 63 20 28 76 65 63 74 6f 72 et ((src (vector
16190 2d 72 65 66 20 6d 61 74 63 68 65 73 20 74 6d 70 -ref matches tmp
161a0 2d 65 6e 64 2d 73 72 63 2d 6f 66 66 73 65 74 29 -end-src-offset)
161b0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
161c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
161d0 20 20 20 28 6b 20 28 76 65 63 74 6f 72 2d 72 65 (k (vector-re
161e0 66 20 6d 61 74 63 68 65 73 20 74 6d 70 2d 65 6e f matches tmp-en
161f0 64 2d 69 6e 64 65 78 2d 6f 66 66 73 65 74 29 29 d-index-offset))
16200 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
16210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
16220 69 66 20 28 61 6e 64 20 73 72 63 20 28 6f 72 20 if (and src (or
16230 28 6e 6f 74 20 28 65 71 3f 20 73 74 61 72 74 20 (not (eq? start
16240 73 72 63 29 29 20 28 3c 20 69 20 6b 29 29 29 0a src)) (< i k))).
16250 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16260 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16270 20 28 6d 61 74 63 68 2d 61 6c 6c 20 63 6e 6b 20 (match-all cnk
16280 73 72 63 20 6b 20 65 6e 64 20 6a 20 6d 61 74 63 src k end j matc
16290 68 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 hes).
162a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
162b0 20 20 20 20 20 20 23 74 29 29 0a 20 20 20 20 20 #t)).
162c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
162d0 20 20 20 20 20 20 28 62 65 67 69 6e 0a 20 20 20 (begin.
162e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
162f0 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
16300 72 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 74 r-set! matches t
16310 6d 70 2d 65 6e 64 2d 73 72 63 2d 6f 66 66 73 65 mp-end-src-offse
16320 74 20 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 t start).
16330 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16340 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
16350 74 21 20 6d 61 74 63 68 65 73 20 74 6d 70 2d 65 t! matches tmp-e
16360 6e 64 2d 69 6e 64 65 78 2d 6f 66 66 73 65 74 20 nd-index-offset
16370 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i).
16380 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16390 23 74 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 #t))))).
163a0 20 20 20 20 20 28 69 66 20 28 65 71 3f 20 27 2a (if (eq? '*
163b0 20 28 63 61 72 20 73 72 65 29 29 0a 20 20 20 20 (car sre)).
163c0 20 20 20 20 20 20 20 20 20 20 20 20 20 6d 61 74 mat
163d0 63 68 2d 61 6c 6c 0a 20 20 20 20 20 20 20 20 20 ch-all.
163e0 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
163f0 28 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 (cnk start i end
16400 20 6a 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 j matches).
16410 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
16420 61 6e 64 20 28 6d 61 74 63 68 2d 6f 6e 63 65 20 and (match-once
16430 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 20 cnk start i end
16440 6a 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 j matches).
16450 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16460 20 20 20 28 6c 65 74 20 28 28 73 72 63 20 28 76 (let ((src (v
16470 65 63 74 6f 72 2d 72 65 66 20 6d 61 74 63 68 65 ector-ref matche
16480 73 20 74 6d 70 2d 65 6e 64 2d 73 72 63 2d 6f 66 s tmp-end-src-of
16490 66 73 65 74 29 29 0a 20 20 20 20 20 20 20 20 20 fset)).
164a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
164b0 20 20 20 20 20 28 6b 20 28 76 65 63 74 6f 72 2d (k (vector-
164c0 72 65 66 20 6d 61 74 63 68 65 73 20 74 6d 70 2d ref matches tmp-
164d0 65 6e 64 2d 69 6e 64 65 78 2d 6f 66 66 73 65 74 end-index-offset
164e0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
164f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d (m
16500 61 74 63 68 2d 61 6c 6c 20 63 6e 6b 20 73 72 63 atch-all cnk src
16510 20 6b 20 65 6e 64 20 6a 20 6d 61 74 63 68 65 73 k end j matches
16520 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 ))))))).
16530 20 20 28 28 3f 29 0a 20 20 20 20 20 20 20 20 20 ((?).
16540 20 20 28 6c 65 74 20 28 28 6d 61 74 63 68 2d 6f (let ((match-o
16550 6e 63 65 20 28 6c 70 20 28 73 72 65 2d 73 65 71 nce (lp (sre-seq
16560 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 29 uence (cdr sre))
16570 20 6e 20 23 74 29 29 29 0a 20 20 20 20 20 20 20 n #t))).
16580 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 (lambda (c
16590 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 20 6a nk start i end j
165a0 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 20 matches).
165b0 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d (match-
165c0 6f 6e 63 65 20 63 6e 6b 20 73 74 61 72 74 20 69 once cnk start i
165d0 20 65 6e 64 20 6a 20 6d 61 74 63 68 65 73 29 0a end j matches).
165e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
165f0 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 t))). (
16600 28 24 20 73 75 62 6d 61 74 63 68 29 0a 20 20 20 ($ submatch).
16610 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6d (let ((m
16620 61 74 63 68 2d 6f 6e 65 0a 20 20 20 20 20 20 20 atch-one.
16630 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 (lp (
16640 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
16650 72 20 73 72 65 29 29 20 28 2b 20 6e 20 31 29 20 r sre)) (+ n 1)
16660 23 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 #t)).
16670 20 20 20 20 20 20 28 73 74 61 72 74 2d 73 72 63 (start-src
16680 2d 6f 66 66 73 65 74 20 28 2b 20 33 20 28 2a 20 -offset (+ 3 (*
16690 6e 20 34 29 29 29 0a 20 20 20 20 20 20 20 20 20 n 4))).
166a0 20 20 20 20 20 20 20 20 28 73 74 61 72 74 2d 69 (start-i
166b0 6e 64 65 78 2d 6f 66 66 73 65 74 20 28 2b 20 34 ndex-offset (+ 4
166c0 20 28 2a 20 6e 20 34 29 29 29 0a 20 20 20 20 20 (* n 4))).
166d0 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 (end
166e0 2d 73 72 63 2d 6f 66 66 73 65 74 20 28 2b 20 35 -src-offset (+ 5
166f0 20 28 2a 20 6e 20 34 29 29 29 0a 20 20 20 20 20 (* n 4))).
16700 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6e 64 (end
16710 2d 69 6e 64 65 78 2d 6f 66 66 73 65 74 20 28 2b -index-offset (+
16720 20 36 20 28 2a 20 6e 20 34 29 29 29 29 0a 20 20 6 (* n 4)))).
16730 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
16740 64 61 20 28 63 6e 6b 20 73 74 61 72 74 20 69 20 da (cnk start i
16750 65 6e 64 20 6a 20 6d 61 74 63 68 65 73 29 0a 20 end j matches).
16760 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
16770 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ond.
16780 20 20 20 20 28 28 6d 61 74 63 68 2d 6f 6e 65 20 ((match-one
16790 63 6e 6b 20 73 74 61 72 74 20 69 20 65 6e 64 20 cnk start i end
167a0 6a 20 6d 61 74 63 68 65 73 29 0a 20 20 20 20 20 j matches).
167b0 20 20 20 20 20 20 20 20 20 20 20 20 28 76 65 63 (vec
167c0 74 6f 72 2d 73 65 74 21 20 6d 61 74 63 68 65 73 tor-set! matches
167d0 20 73 74 61 72 74 2d 73 72 63 2d 6f 66 66 73 65 start-src-offse
167e0 74 20 73 74 61 72 74 29 0a 20 20 20 20 20 20 20 t start).
167f0 20 20 20 20 20 20 20 20 20 20 28 76 65 63 74 6f (vecto
16800 72 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 73 r-set! matches s
16810 74 61 72 74 2d 69 6e 64 65 78 2d 6f 66 66 73 65 tart-index-offse
16820 74 20 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 t i).
16830 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 73 65 (vector-se
16840 74 21 20 6d 61 74 63 68 65 73 20 65 6e 64 2d 73 t! matches end-s
16850 72 63 2d 6f 66 66 73 65 74 0a 20 20 20 20 20 20 rc-offset.
16860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16870 20 20 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d (vector-
16880 72 65 66 20 6d 61 74 63 68 65 73 20 74 6d 70 2d ref matches tmp-
16890 65 6e 64 2d 73 72 63 2d 6f 66 66 73 65 74 29 29 end-src-offset))
168a0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
168b0 20 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 6d (vector-set! m
168c0 61 74 63 68 65 73 20 65 6e 64 2d 69 6e 64 65 78 atches end-index
168d0 2d 6f 66 66 73 65 74 0a 20 20 20 20 20 20 20 20 -offset.
168e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
168f0 20 20 20 20 20 20 28 76 65 63 74 6f 72 2d 72 65 (vector-re
16900 66 20 6d 61 74 63 68 65 73 20 74 6d 70 2d 65 6e f matches tmp-en
16910 64 2d 69 6e 64 65 78 2d 6f 66 66 73 65 74 29 29 d-index-offset))
16920 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16930 20 20 23 74 29 0a 20 20 20 20 20 20 20 20 20 20 #t).
16940 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
16950 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 29 #f)
16960 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 )))). (
16970 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
16980 28 65 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 (error "unknown
16990 72 65 67 65 78 70 20 6f 70 65 72 61 74 6f 72 22 regexp operator"
169a0 20 28 63 61 72 20 73 72 65 29 29 29 29 29 0a 20 (car sre))))).
169b0 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
169c0 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e 6b 6e (error "unkn
169d0 6f 77 6e 20 72 65 67 65 78 70 22 20 73 72 65 29 own regexp" sre)
169e0 29 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b )))))..;;;;;;;;;
169f0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
16a00 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
16a10 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
16a20 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a ;;;;;;;;;;;;;;;.
16a30 3b 3b 20 63 6c 6f 73 75 72 65 20 63 6f 6d 70 69 ;; closure compi
16a40 6c 61 74 69 6f 6e 20 2d 20 77 65 20 75 73 65 20 lation - we use
16a50 74 68 69 73 20 66 6f 72 20 6e 6f 6e 2d 72 65 67 this for non-reg
16a60 75 6c 61 72 20 65 78 70 72 65 73 73 69 6f 6e 73 ular expressions
16a70 0a 3b 3b 20 69 6e 73 74 65 61 64 20 6f 66 20 61 .;; instead of a
16a80 6e 20 69 6e 74 65 72 70 72 65 74 65 64 20 4e 46 n interpreted NF
16a90 41 20 6d 61 74 63 68 65 72 0a 0a 28 64 65 66 69 A matcher..(defi
16aa0 6e 65 20 28 73 72 65 2d 3e 70 72 6f 63 65 64 75 ne (sre->procedu
16ab0 72 65 20 73 72 65 20 2e 20 6f 29 0a 20 20 28 64 re sre . o). (d
16ac0 65 66 69 6e 65 20 6e 61 6d 65 73 0a 20 20 20 20 efine names.
16ad0 28 69 66 20 28 61 6e 64 20 28 70 61 69 72 3f 20 (if (and (pair?
16ae0 6f 29 20 28 70 61 69 72 3f 20 28 63 64 72 20 6f o) (pair? (cdr o
16af0 29 29 29 20 28 63 61 64 72 20 6f 29 20 28 73 72 ))) (cadr o) (sr
16b00 65 2d 6e 61 6d 65 73 20 73 72 65 20 31 20 27 28 e-names sre 1 '(
16b10 29 29 29 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 )))). (let lp (
16b20 28 73 72 65 20 73 72 65 29 0a 20 20 20 20 20 20 (sre sre).
16b30 20 20 20 20 20 28 6e 20 31 29 0a 20 20 20 20 20 (n 1).
16b40 20 20 20 20 20 20 28 66 6c 61 67 73 20 28 69 66 (flags (if
16b50 20 28 70 61 69 72 3f 20 6f 29 20 28 63 61 72 20 (pair? o) (car
16b60 6f 29 20 7e 6e 6f 6e 65 29 29 0a 20 20 20 20 20 o) ~none)).
16b70 20 20 20 20 20 20 28 6e 65 78 74 20 28 6c 61 6d (next (lam
16b80 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 bda (cnk init sr
16b90 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 c str i end matc
16ba0 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 hes fail).
16bb0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 72 (ir
16bc0 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 regex-match-star
16bd0 74 2d 73 6f 75 72 63 65 2d 73 65 74 21 20 6d 61 t-source-set! ma
16be0 74 63 68 65 73 20 30 20 69 6e 69 74 29 0a 20 20 tches 0 init).
16bf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16c00 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
16c10 73 74 61 72 74 2d 69 6e 64 65 78 2d 73 65 74 21 start-index-set!
16c20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16c30 20 20 20 20 20 6d 61 74 63 68 65 73 20 30 20 28 matches 0 (
16c40 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 (chunker-get-sta
16c50 72 74 20 63 6e 6b 29 20 69 6e 69 74 29 29 0a 20 rt cnk) init)).
16c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16c70 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (irregex-match
16c80 2d 65 6e 64 2d 73 6f 75 72 63 65 2d 73 65 74 21 -end-source-set!
16c90 20 6d 61 74 63 68 65 73 20 30 20 73 72 63 29 0a matches 0 src).
16ca0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16cb0 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
16cc0 68 2d 65 6e 64 2d 69 6e 64 65 78 2d 73 65 74 21 h-end-index-set!
16cd0 20 6d 61 74 63 68 65 73 20 30 20 69 29 0a 20 20 matches 0 i).
16ce0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16cf0 20 6d 61 74 63 68 65 73 29 29 29 0a 20 20 20 20 matches))).
16d00 3b 3b 20 58 58 58 58 20 74 68 69 73 20 73 68 6f ;; XXXX this sho
16d10 75 6c 64 20 62 65 20 69 6e 6c 69 6e 65 64 0a 20 uld be inlined.
16d20 20 20 20 28 64 65 66 69 6e 65 20 28 72 65 63 20 (define (rec
16d30 73 72 65 29 20 28 6c 70 20 73 72 65 20 6e 20 66 sre) (lp sre n f
16d40 6c 61 67 73 20 6e 65 78 74 29 29 0a 20 20 20 20 lags next)).
16d50 28 63 6f 6e 64 0a 20 20 20 20 20 28 28 70 61 69 (cond. ((pai
16d60 72 3f 20 73 72 65 29 0a 20 20 20 20 20 20 28 69 r? sre). (i
16d70 66 20 28 73 74 72 69 6e 67 3f 20 28 63 61 72 20 f (string? (car
16d80 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 sre)).
16d90 28 73 72 65 2d 63 73 65 74 2d 3e 70 72 6f 63 65 (sre-cset->proce
16da0 64 75 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 dure.
16db0 28 73 72 65 2d 3e 63 73 65 74 20 28 63 61 72 20 (sre->cset (car
16dc0 73 72 65 29 20 28 66 6c 61 67 2d 73 65 74 3f 20 sre) (flag-set?
16dd0 66 6c 61 67 73 20 7e 63 61 73 65 2d 69 6e 73 65 flags ~case-inse
16de0 6e 73 69 74 69 76 65 3f 29 29 0a 20 20 20 20 20 nsitive?)).
16df0 20 20 20 20 20 20 6e 65 78 74 29 0a 20 20 20 20 next).
16e00 20 20 20 20 20 20 28 63 61 73 65 20 28 63 61 72 (case (car
16e10 20 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 sre).
16e20 20 20 28 28 7e 20 2d 20 26 20 2f 29 0a 20 20 20 ((~ - & /).
16e30 20 20 20 20 20 20 20 20 20 20 28 73 72 65 2d 63 (sre-c
16e40 73 65 74 2d 3e 70 72 6f 63 65 64 75 72 65 0a 20 set->procedure.
16e50 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 (sr
16e60 65 2d 3e 63 73 65 74 20 73 72 65 20 28 66 6c 61 e->cset sre (fla
16e70 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 7e 63 61 g-set? flags ~ca
16e80 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 se-insensitive?)
16e90 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
16ea0 6e 65 78 74 29 29 0a 20 20 20 20 20 20 20 20 20 next)).
16eb0 20 20 20 28 28 6f 72 29 0a 20 20 20 20 20 20 20 ((or).
16ec0 20 20 20 20 20 20 28 63 61 73 65 20 28 6c 65 6e (case (len
16ed0 67 74 68 20 28 63 64 72 20 73 72 65 29 29 0a 20 gth (cdr sre)).
16ee0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
16ef0 30 29 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 0) (lambda (cnk
16f00 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 init src str i e
16f10 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 nd matches fail)
16f20 20 28 66 61 69 6c 29 29 29 0a 20 20 20 20 20 20 (fail))).
16f30 20 20 20 20 20 20 20 20 20 28 28 31 29 20 28 72 ((1) (r
16f40 65 63 20 28 63 61 64 72 20 73 72 65 29 29 29 0a ec (cadr sre))).
16f50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
16f60 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
16f70 20 20 20 20 20 28 6c 65 74 2a 20 28 28 66 69 72 (let* ((fir
16f80 73 74 20 28 72 65 63 20 28 63 61 64 72 20 73 72 st (rec (cadr sr
16f90 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 e))).
16fa0 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 73 (res
16fb0 74 20 28 6c 70 20 28 73 72 65 2d 61 6c 74 65 72 t (lp (sre-alter
16fc0 6e 61 74 65 20 28 63 64 64 72 20 73 72 65 29 29 nate (cddr sre))
16fd0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
16fe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16ff0 20 20 28 2b 20 6e 20 28 73 72 65 2d 63 6f 75 6e (+ n (sre-coun
17000 74 2d 73 75 62 6d 61 74 63 68 65 73 20 28 63 61 t-submatches (ca
17010 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 20 20 dr sre))).
17020 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17030 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 flags
17040 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
17050 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17060 20 20 6e 65 78 74 29 29 29 0a 20 20 20 20 20 20 next))).
17070 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
17080 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 bda (cnk init sr
17090 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 c str i end matc
170a0 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 hes fail).
170b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
170c0 69 72 73 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 irst cnk init sr
170d0 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 c str i end matc
170e0 68 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 hes.
170f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
17100 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 lambda ().
17110 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17120 20 20 20 20 20 20 20 28 72 65 73 74 20 63 6e 6b (rest cnk
17130 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
17140 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
17150 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 )))))))).
17160 20 20 20 20 20 28 28 77 2f 63 61 73 65 29 0a 20 ((w/case).
17170 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 (lp
17180 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 (sre-sequence (c
17190 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 dr sre)).
171a0 20 20 20 20 20 20 20 20 20 20 6e 0a 20 20 20 20 n.
171b0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 6c (fl
171c0 61 67 2d 63 6c 65 61 72 20 66 6c 61 67 73 20 7e ag-clear flags ~
171d0 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 case-insensitive
171e0 3f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ?).
171f0 20 20 20 20 6e 65 78 74 29 29 0a 20 20 20 20 20 next)).
17200 20 20 20 20 20 20 20 28 28 77 2f 6e 6f 63 61 73 ((w/nocas
17210 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 e).
17220 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 (lp (sre-sequenc
17230 65 20 28 63 64 72 20 73 72 65 29 29 0a 20 20 20 e (cdr sre)).
17240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 0a n.
17250 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17260 20 28 66 6c 61 67 2d 6a 6f 69 6e 20 66 6c 61 67 (flag-join flag
17270 73 20 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 s ~case-insensit
17280 69 76 65 3f 29 0a 20 20 20 20 20 20 20 20 20 20 ive?).
17290 20 20 20 20 20 20 20 6e 65 78 74 29 29 0a 20 20 next)).
172a0 20 20 20 20 20 20 20 20 20 20 28 28 77 2f 75 74 ((w/ut
172b0 66 38 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 f8).
172c0 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e (lp (sre-sequen
172d0 63 65 20 28 63 64 72 20 73 72 65 29 29 20 6e 20 ce (cdr sre)) n
172e0 28 66 6c 61 67 2d 6a 6f 69 6e 20 66 6c 61 67 73 (flag-join flags
172f0 20 7e 75 74 66 38 3f 29 20 6e 65 78 74 29 29 0a ~utf8?) next)).
17300 20 20 20 20 20 20 20 20 20 20 20 20 28 28 77 2f ((w/
17310 6e 6f 75 74 66 38 29 0a 20 20 20 20 20 20 20 20 noutf8).
17320 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d 73 65 (lp (sre-se
17330 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 quence (cdr sre)
17340 29 20 6e 20 28 66 6c 61 67 2d 63 6c 65 61 72 20 ) n (flag-clear
17350 66 6c 61 67 73 20 7e 75 74 66 38 3f 29 20 6e 65 flags ~utf8?) ne
17360 78 74 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 xt)).
17370 20 28 28 73 65 71 20 3a 29 0a 20 20 20 20 20 20 ((seq :).
17380 20 20 20 20 20 20 20 28 63 61 73 65 20 28 6c 65 (case (le
17390 6e 67 74 68 20 28 63 64 72 20 73 72 65 29 29 0a ngth (cdr sre)).
173a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
173b0 28 30 29 20 6e 65 78 74 29 0a 20 20 20 20 20 20 (0) next).
173c0 20 20 20 20 20 20 20 20 20 28 28 31 29 20 28 72 ((1) (r
173d0 65 63 20 28 63 61 64 72 20 73 72 65 29 29 29 0a ec (cadr sre))).
173e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
173f0 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else.
17400 20 20 20 20 20 28 6c 65 74 20 28 28 72 65 73 74 (let ((rest
17410 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e (lp (sre-sequen
17420 63 65 20 28 63 64 64 72 20 73 72 65 29 29 0a 20 ce (cddr sre)).
17430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17440 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
17450 2b 20 6e 20 28 73 72 65 2d 63 6f 75 6e 74 2d 73 + n (sre-count-s
17460 75 62 6d 61 74 63 68 65 73 20 28 63 61 64 72 20 ubmatches (cadr
17470 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 sre))).
17480 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17490 20 20 20 20 20 20 20 66 6c 61 67 73 0a 20 20 20 flags.
174a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
174b0 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 nex
174c0 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
174d0 20 20 20 20 20 20 20 28 6c 70 20 28 63 61 64 72 (lp (cadr
174e0 20 73 72 65 29 20 6e 20 66 6c 61 67 73 20 72 65 sre) n flags re
174f0 73 74 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 st))))).
17500 20 20 20 20 28 28 3f 29 0a 20 20 20 20 20 20 20 ((?).
17510 20 20 20 20 20 20 28 6c 65 74 20 28 28 62 6f 64 (let ((bod
17520 79 20 28 72 65 63 20 28 73 72 65 2d 73 65 71 75 y (rec (sre-sequ
17530 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 29 29 ence (cdr sre)))
17540 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
17550 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 (lambda (cnk i
17560 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
17570 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a d matches fail).
17580 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17590 20 28 62 6f 64 79 20 63 6e 6b 20 69 6e 69 74 20 (body cnk init
175a0 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
175b0 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 20 20 tches.
175c0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
175d0 6d 62 64 61 20 28 29 20 28 6e 65 78 74 20 63 6e mbda () (next cn
175e0 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
175f0 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 end matches fai
17600 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 l)))))).
17610 20 20 20 20 28 28 3f 3f 29 0a 20 20 20 20 20 20 ((??).
17620 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 62 6f (let ((bo
17630 64 79 20 28 72 65 63 20 28 73 72 65 2d 73 65 71 dy (rec (sre-seq
17640 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 29 uence (cdr sre))
17650 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
17660 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 (lambda (cnk
17670 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 init src str i e
17680 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 nd matches fail)
17690 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
176a0 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 (next cnk init
176b0 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
176c0 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 20 atches.
176d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
176e0 61 6d 62 64 61 20 28 29 20 28 62 6f 64 79 20 63 ambda () (body c
176f0 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
17700 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
17710 69 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 il)))))).
17720 20 20 20 20 20 28 28 2a 29 0a 20 20 20 20 20 20 ((*).
17730 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
17740 20 20 20 20 20 20 20 20 20 20 20 28 28 73 72 65 ((sre
17750 2d 65 6d 70 74 79 3f 20 28 73 72 65 2d 73 65 71 -empty? (sre-seq
17760 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 29 uence (cdr sre))
17770 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
17780 20 28 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 64 (error "invalid
17790 20 73 72 65 3a 20 65 6d 70 74 79 20 2a 22 20 73 sre: empty *" s
177a0 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 re)).
177b0 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
177c0 20 20 20 20 20 20 20 20 28 6c 65 74 72 65 63 0a (letrec.
177d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
177e0 20 20 20 28 28 62 6f 64 79 0a 20 20 20 20 20 20 ((body.
177f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
17800 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 lp (sre-sequence
17810 20 28 63 64 72 20 73 72 65 29 29 0a 20 20 20 20 (cdr sre)).
17820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17830 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 20 20 n.
17840 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17850 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 flags.
17860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
17870 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
17880 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
17890 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 atches fail).
178a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
178b0 20 20 20 20 20 20 20 20 28 62 6f 64 79 20 63 6e (body cn
178c0 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
178d0 20 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 20 20 end matches.
178e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
178f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
17900 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 ambda ().
17910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17920 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 (nex
17930 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 t cnk init src s
17940 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
17950 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
17960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17970 20 20 20 20 20 20 20 20 20 20 29 29 29 29 29 29 ))))))
17980 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
17990 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 (lambda (cnk i
179a0 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
179b0 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a d matches fail).
179c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
179d0 20 20 20 28 62 6f 64 79 20 63 6e 6b 20 69 6e 69 (body cnk ini
179e0 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
179f0 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 matches.
17a00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17a10 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda ().
17a20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17a30 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e 6b (next cnk
17a40 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
17a50 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
17a60 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 )))))))).
17a70 20 20 20 20 20 28 28 2a 3f 29 0a 20 20 20 20 20 ((*?).
17a80 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
17a90 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 72 ((sr
17aa0 65 2d 65 6d 70 74 79 3f 20 28 73 72 65 2d 73 65 e-empty? (sre-se
17ab0 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 29 quence (cdr sre)
17ac0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
17ad0 20 20 28 65 72 72 6f 72 20 22 69 6e 76 61 6c 69 (error "invali
17ae0 64 20 73 72 65 3a 20 65 6d 70 74 79 20 2a 3f 22 d sre: empty *?"
17af0 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
17b00 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
17b10 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 72 65 (letre
17b20 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 c.
17b30 20 20 20 20 20 28 28 62 6f 64 79 0a 20 20 20 20 ((body.
17b40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17b50 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e (lp (sre-sequen
17b60 63 65 20 28 63 64 72 20 73 72 65 29 29 0a 20 20 ce (cdr sre)).
17b70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17b80 20 20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 n.
17b90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17ba0 20 20 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 flags.
17bb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17bc0 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e (lambda (cnk in
17bd0 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
17be0 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 matches fail).
17bf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c00 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
17c10 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
17c20 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 0a 20 i end matches.
17c30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c50 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 20 (lambda ().
17c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17c70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
17c80 6f 64 79 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 ody cnk init src
17c90 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
17ca0 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
17cb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17cc0 20 20 20 20 20 20 20 20 20 20 20 20 29 29 29 29 ))))
17cd0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
17ce0 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b (lambda (cnk
17cf0 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 init src str i
17d00 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c end matches fail
17d10 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
17d20 20 20 20 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 (next cnk i
17d30 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
17d40 64 20 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 d matches.
17d50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17d60 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 (lambda ().
17d70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17d80 20 20 20 20 20 20 20 20 20 28 62 6f 64 79 20 63 (body c
17d90 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
17da0 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
17db0 69 6c 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 il)))))))).
17dc0 20 20 20 20 20 20 20 28 28 2b 29 0a 20 20 20 20 ((+).
17dd0 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 73 72 (lp (sr
17de0 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 72 20 e-sequence (cdr
17df0 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 sre)).
17e00 20 20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 n.
17e10 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 0a flags.
17e20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17e30 20 28 72 65 63 20 28 6c 69 73 74 20 27 2a 20 28 (rec (list '* (
17e40 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 sre-sequence (cd
17e50 72 20 73 72 65 29 29 29 29 29 29 0a 20 20 20 20 r sre)))))).
17e60 20 20 20 20 20 20 20 20 28 28 3d 29 0a 20 20 20 ((=).
17e70 20 20 20 20 20 20 20 20 20 20 28 72 65 63 20 60 (rec `
17e80 28 2a 2a 20 2c 28 63 61 64 72 20 73 72 65 29 20 (** ,(cadr sre)
17e90 2c 28 63 61 64 72 20 73 72 65 29 20 2c 40 28 63 ,(cadr sre) ,@(c
17ea0 64 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 20 ddr sre)))).
17eb0 20 20 20 20 20 20 20 20 28 28 3e 3d 29 0a 20 20 ((>=).
17ec0 20 20 20 20 20 20 20 20 20 20 20 28 72 65 63 20 (rec
17ed0 60 28 2a 2a 20 2c 28 63 61 64 72 20 73 72 65 29 `(** ,(cadr sre)
17ee0 20 23 66 20 2c 40 28 63 64 64 72 20 73 72 65 29 #f ,@(cddr sre)
17ef0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
17f00 28 28 2a 2a 20 2a 2a 3f 29 0a 20 20 20 20 20 20 ((** **?).
17f10 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond.
17f20 20 20 20 20 20 20 20 20 20 20 20 28 28 6f 72 20 ((or
17f30 28 61 6e 64 20 28 6e 75 6d 62 65 72 3f 20 28 63 (and (number? (c
17f40 61 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 adr sre)).
17f50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17f60 20 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 64 (number? (cadd
17f70 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
17f80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
17f90 28 3e 20 28 63 61 64 72 20 73 72 65 29 20 28 63 (> (cadr sre) (c
17fa0 61 64 64 72 20 73 72 65 29 29 29 0a 20 20 20 20 addr sre))).
17fb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
17fc0 61 6e 64 20 28 6e 6f 74 20 28 63 61 64 72 20 73 and (not (cadr s
17fd0 72 65 29 29 20 28 63 61 64 64 72 20 73 72 65 29 re)) (caddr sre)
17fe0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
17ff0 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 (lambda (cnk i
18000 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
18010 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 20 d matches fail)
18020 28 66 61 69 6c 29 29 29 0a 20 20 20 20 20 20 20 (fail))).
18030 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 (else.
18040 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
18050 2a 20 28 28 66 72 6f 6d 20 28 63 61 64 72 20 73 * ((from (cadr s
18060 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 re)).
18070 20 20 20 20 20 20 20 20 20 20 20 28 74 6f 20 28 (to (
18080 63 61 64 64 72 20 73 72 65 29 29 0a 20 20 20 20 caddr sre)).
18090 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
180a0 20 20 28 3f 20 28 69 66 20 28 65 71 3f 20 27 2a (? (if (eq? '*
180b0 2a 20 28 63 61 72 20 73 72 65 29 29 20 27 3f 20 * (car sre)) '?
180c0 27 3f 3f 29 29 0a 20 20 20 20 20 20 20 20 20 20 '??)).
180d0 20 20 20 20 20 20 20 20 20 20 20 20 28 2a 20 28 (* (
180e0 69 66 20 28 65 71 3f 20 27 2a 2a 20 28 63 61 72 if (eq? '** (car
180f0 20 73 72 65 29 29 20 27 2a 20 27 2a 3f 29 29 0a sre)) '* '*?)).
18100 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18110 20 20 20 20 20 20 28 73 72 65 20 28 73 72 65 2d (sre (sre-
18120 73 65 71 75 65 6e 63 65 20 28 63 64 64 64 72 20 sequence (cdddr
18130 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 sre))).
18140 20 20 20 20 20 20 20 20 20 20 20 20 20 28 78 2d (x-
18150 73 72 65 20 28 73 72 65 2d 73 74 72 69 70 2d 73 sre (sre-strip-s
18160 75 62 6d 61 74 63 68 65 73 20 73 72 65 29 29 0a ubmatches sre)).
18170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18180 20 20 20 20 20 20 28 6e 65 78 74 20 28 69 66 20 (next (if
18190 74 6f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 to.
181a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
181b0 20 20 20 28 69 66 20 28 3d 20 66 72 6f 6d 20 74 (if (= from t
181c0 6f 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 o).
181d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
181e0 20 20 20 20 20 20 20 6e 65 78 74 0a 20 20 20 20 next.
181f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18210 28 66 6f 6c 64 20 28 6c 61 6d 62 64 61 20 28 78 (fold (lambda (x
18220 20 6e 65 78 74 29 0a 20 20 20 20 20 20 20 20 20 next).
18230 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18250 20 20 20 28 6c 70 20 60 28 2c 3f 20 2c 73 72 65 (lp `(,? ,sre
18260 29 20 6e 20 66 6c 61 67 73 20 6e 65 78 74 29 29 ) n flags next))
18270 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
18280 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18290 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 0a next.
182a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
182b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
182c0 20 20 20 20 20 20 20 20 20 20 28 7a 65 72 6f 2d (zero-
182d0 74 6f 20 28 2d 20 74 6f 20 66 72 6f 6d 29 29 29 to (- to from)))
182e0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
182f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18300 20 20 28 72 65 63 20 60 28 2c 2a 20 2c 73 72 65 (rec `(,* ,sre
18310 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
18320 20 20 20 20 20 20 20 28 69 66 20 28 7a 65 72 6f (if (zero
18330 3f 20 66 72 6f 6d 29 0a 20 20 20 20 20 20 20 20 ? from).
18340 20 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 nex
18350 74 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 t.
18360 20 20 20 20 20 20 20 28 6c 70 20 60 28 73 65 71 (lp `(seq
18370 20 2c 40 28 6d 61 70 20 28 6c 61 6d 62 64 61 20 ,@(map (lambda
18380 28 78 29 20 78 2d 73 72 65 29 20 28 7a 65 72 6f (x) x-sre) (zero
18390 2d 74 6f 20 28 2d 20 66 72 6f 6d 20 31 29 29 29 -to (- from 1)))
183a0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
183b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
183c0 2c 73 72 65 29 0a 20 20 20 20 20 20 20 20 20 20 ,sre).
183d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e n
183e0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
183f0 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 73 0a flags.
18400 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18410 20 20 20 20 20 20 20 20 20 6e 65 78 74 29 29 29 next)))
18420 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
18430 28 28 77 6f 72 64 29 0a 20 20 20 20 20 20 20 20 ((word).
18440 20 20 20 20 20 28 72 65 63 20 60 28 73 65 71 20 (rec `(seq
18450 62 6f 77 20 2c 40 28 63 64 72 20 73 72 65 29 20 bow ,@(cdr sre)
18460 65 6f 77 29 29 29 0a 20 20 20 20 20 20 20 20 20 eow))).
18470 20 20 20 28 28 77 6f 72 64 2b 29 0a 20 20 20 20 ((word+).
18480 20 20 20 20 20 20 20 20 20 28 72 65 63 20 60 28 (rec `(
18490 73 65 71 20 62 6f 77 20 28 2b 20 28 26 20 28 6f seq bow (+ (& (o
184a0 72 20 61 6c 70 68 61 6e 75 6d 65 72 69 63 20 22 r alphanumeric "
184b0 5f 22 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 _").
184c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
184d0 20 20 20 20 20 20 28 6f 72 20 2c 40 28 63 64 72 (or ,@(cdr
184e0 20 73 72 65 29 29 29 29 20 65 6f 77 29 29 29 0a sre)))) eow))).
184f0 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 6f ((po
18500 73 69 78 2d 73 74 72 69 6e 67 29 0a 20 20 20 20 six-string).
18510 20 20 20 20 20 20 20 20 20 28 72 65 63 20 28 73 (rec (s
18520 74 72 69 6e 67 2d 3e 73 72 65 20 28 63 61 64 72 tring->sre (cadr
18530 20 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 sre)))).
18540 20 20 20 20 20 28 28 6c 6f 6f 6b 2d 61 68 65 61 ((look-ahea
18550 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 d).
18560 28 6c 65 74 20 28 28 63 68 65 63 6b 0a 20 20 20 (let ((check.
18570 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18580 20 28 6c 70 20 28 73 72 65 2d 73 65 71 75 65 6e (lp (sre-sequen
18590 63 65 20 28 63 64 72 20 73 72 65 29 29 0a 20 20 ce (cdr sre)).
185a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
185b0 20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 20 n.
185c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
185d0 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 flags.
185e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
185f0 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 ambda (cnk init
18600 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
18610 74 63 68 65 73 20 66 61 69 6c 29 20 69 29 29 29 tches fail) i)))
18620 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
18630 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e (lambda (cnk in
18640 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
18650 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 matches fail).
18660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18670 28 69 66 20 28 63 68 65 63 6b 20 63 6e 6b 20 69 (if (check cnk i
18680 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
18690 64 20 6d 61 74 63 68 65 73 20 28 6c 61 6d 62 64 d matches (lambd
186a0 61 20 28 29 20 23 66 29 29 0a 20 20 20 20 20 20 a () #f)).
186b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
186c0 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 next cnk init sr
186d0 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 c str i end matc
186e0 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 hes fail).
186f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
18700 66 61 69 6c 29 29 29 29 29 0a 20 20 20 20 20 20 fail))))).
18710 20 20 20 20 20 20 28 28 6e 65 67 2d 6c 6f 6f 6b ((neg-look
18720 2d 61 68 65 61 64 29 0a 20 20 20 20 20 20 20 20 -ahead).
18730 20 20 20 20 20 28 6c 65 74 20 28 28 63 68 65 63 (let ((chec
18740 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 k.
18750 20 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d 73 (lp (sre-s
18760 65 71 75 65 6e 63 65 20 28 63 64 72 20 73 72 65 equence (cdr sre
18770 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
18780 20 20 20 20 20 20 20 20 20 20 20 6e 0a 20 20 20 n.
18790 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
187a0 20 20 20 20 20 66 6c 61 67 73 0a 20 20 20 20 20 flags.
187b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
187c0 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 (lambda (cnk
187d0 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 init src str i e
187e0 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 nd matches fail)
187f0 20 69 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 i)))).
18800 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 (lambda (c
18810 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
18820 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
18830 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 il).
18840 20 20 20 20 20 28 69 66 20 28 63 68 65 63 6b 20 (if (check
18850 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
18860 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 28 i end matches (
18870 6c 61 6d 62 64 61 20 28 29 20 23 66 29 29 0a 20 lambda () #f)).
18880 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18890 20 20 20 20 28 66 61 69 6c 29 0a 20 20 20 20 20 (fail).
188a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
188b0 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 (next cnk init s
188c0 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
188d0 63 68 65 73 20 66 61 69 6c 29 29 29 29 29 0a 20 ches fail))))).
188e0 20 20 20 20 20 20 20 20 20 20 20 28 28 6c 6f 6f ((loo
188f0 6b 2d 62 65 68 69 6e 64 20 6e 65 67 2d 6c 6f 6f k-behind neg-loo
18900 6b 2d 62 65 68 69 6e 64 29 0a 20 20 20 20 20 20 k-behind).
18910 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 68 (let ((ch
18920 65 63 6b 0a 20 20 20 20 20 20 20 20 20 20 20 20 eck.
18930 20 20 20 20 20 20 20 20 28 6c 70 20 28 73 72 65 (lp (sre
18940 2d 73 65 71 75 65 6e 63 65 0a 20 20 20 20 20 20 -sequence.
18950 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18960 20 20 20 28 63 6f 6e 73 20 27 28 2a 20 61 6e 79 (cons '(* any
18970 29 20 28 61 70 70 65 6e 64 20 28 63 64 72 20 73 ) (append (cdr s
18980 72 65 29 20 27 28 65 6f 73 29 29 29 29 0a 20 20 re) '(eos)))).
18990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
189a0 20 20 20 20 20 20 6e 0a 20 20 20 20 20 20 20 20 n.
189b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
189c0 66 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 flags.
189d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
189e0 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 ambda (cnk init
189f0 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 src str i end ma
18a00 74 63 68 65 73 20 66 61 69 6c 29 20 69 29 29 29 tches fail) i)))
18a10 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
18a20 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e (lambda (cnk in
18a30 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
18a40 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 matches fail).
18a50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18a60 28 6c 65 74 2a 20 28 28 70 72 65 76 20 28 28 63 (let* ((prev ((c
18a70 68 75 6e 6b 65 72 2d 67 65 74 2d 73 75 62 73 74 hunker-get-subst
18a80 72 69 6e 67 20 63 6e 6b 29 0a 20 20 20 20 20 20 ring cnk).
18a90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18aa0 20 20 20 20 20 20 20 20 20 69 6e 69 74 0a 20 20 init.
18ab0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18ac0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 63 ((c
18ad0 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 hunker-get-start
18ae0 20 63 6e 6b 29 20 69 6e 69 74 29 0a 20 20 20 20 cnk) init).
18af0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18b00 20 20 20 20 20 20 20 20 20 20 20 73 72 63 0a 20 src.
18b10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18b20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 29 i)
18b30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
18b40 20 20 20 20 20 20 20 20 20 20 28 6c 65 6e 20 28 (len (
18b50 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 70 72 string-length pr
18b60 65 76 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ev)).
18b70 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 72 (sr
18b80 63 32 20 28 6c 69 73 74 20 70 72 65 76 20 30 20 c2 (list prev 0
18b90 6c 65 6e 29 29 29 0a 20 20 20 20 20 20 20 20 20 len))).
18ba0 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 28 (if ((
18bb0 69 66 20 28 65 71 3f 20 28 63 61 72 20 73 72 65 if (eq? (car sre
18bc0 29 20 27 6c 6f 6f 6b 2d 62 65 68 69 6e 64 29 20 ) 'look-behind)
18bd0 28 6c 61 6d 62 64 61 20 28 78 29 20 78 29 20 6e (lambda (x) x) n
18be0 6f 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ot).
18bf0 20 20 20 20 20 20 20 20 20 20 20 20 28 63 68 65 (che
18c00 63 6b 20 63 6e 6b 20 73 72 63 32 20 73 72 63 32 ck cnk src2 src2
18c10 20 70 72 65 76 20 30 20 6c 65 6e 20 6d 61 74 63 prev 0 len matc
18c20 68 65 73 20 28 6c 61 6d 62 64 61 20 28 29 20 23 hes (lambda () #
18c30 66 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 f))).
18c40 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 (nex
18c50 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 t cnk init src s
18c60 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
18c70 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
18c80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
18c90 61 69 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 ail)))))).
18ca0 20 20 20 20 20 20 28 28 61 74 6f 6d 69 63 29 0a ((atomic).
18cb0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
18cc0 74 20 28 28 6f 6e 63 65 0a 20 20 20 20 20 20 20 t ((once.
18cd0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
18ce0 20 28 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 (sre-sequence (
18cf0 63 64 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 cdr sre)).
18d00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18d10 20 20 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 n.
18d20 20 20 20 20 20 20 20 20 20 20 20 20 66 6c 61 67 flag
18d30 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
18d40 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
18d50 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 a (cnk init src
18d60 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
18d70 73 20 66 61 69 6c 29 20 69 29 29 29 29 0a 20 20 s fail) i)))).
18d80 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
18d90 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 mbda (cnk init s
18da0 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
18db0 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
18dc0 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
18dd0 20 28 28 6a 20 28 6f 6e 63 65 20 63 6e 6b 20 69 ((j (once cnk i
18de0 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
18df0 64 20 6d 61 74 63 68 65 73 20 28 6c 61 6d 62 64 d matches (lambd
18e00 61 20 28 29 20 23 66 29 29 29 29 0a 20 20 20 20 a () #f)))).
18e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
18e20 69 66 20 6a 0a 20 20 20 20 20 20 20 20 20 20 20 if j.
18e30 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 (nex
18e40 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 t cnk init src s
18e50 74 72 20 6a 20 65 6e 64 20 6d 61 74 63 68 65 73 tr j end matches
18e60 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
18e70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
18e80 61 69 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 ail)))))).
18e90 20 20 20 20 20 20 28 28 69 66 29 0a 20 20 20 20 ((if).
18ea0 20 20 20 20 20 20 20 20 20 28 6c 65 74 2a 20 28 (let* (
18eb0 28 74 65 73 74 2d 73 75 62 6d 61 74 63 68 65 73 (test-submatches
18ec0 20 28 73 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d (sre-count-subm
18ed0 61 74 63 68 65 73 20 28 63 61 64 72 20 73 72 65 atches (cadr sre
18ee0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
18ef0 20 20 20 20 20 20 20 20 28 70 61 73 73 20 28 6c (pass (l
18f00 70 20 28 63 61 64 64 72 20 73 72 65 29 20 66 6c p (caddr sre) fl
18f10 61 67 73 20 28 2b 20 6e 20 74 65 73 74 2d 73 75 ags (+ n test-su
18f20 62 6d 61 74 63 68 65 73 29 20 6e 65 78 74 29 29 bmatches) next))
18f30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
18f40 20 20 20 20 20 28 66 61 69 6c 20 28 69 66 20 28 (fail (if (
18f50 70 61 69 72 3f 20 28 63 64 64 64 72 20 73 72 65 pair? (cdddr sre
18f60 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
18f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18f80 20 28 6c 70 20 28 63 61 64 64 64 72 20 73 72 65 (lp (cadddr sre
18f90 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
18fa0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18fb0 20 20 20 20 28 2b 20 6e 20 74 65 73 74 2d 73 75 (+ n test-su
18fc0 62 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 bmatches.
18fd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
18fe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
18ff0 72 65 2d 63 6f 75 6e 74 2d 73 75 62 6d 61 74 63 re-count-submatc
19000 68 65 73 20 28 63 61 64 64 72 20 73 72 65 29 29 hes (caddr sre))
19010 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
19020 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19030 20 20 20 20 66 6c 61 67 73 0a 20 20 20 20 20 20 flags.
19040 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19050 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 78 74 next
19060 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
19070 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19080 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 (lambda (cnk ini
19090 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
190a0 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 matches fail).
190b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
190c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
190d0 61 69 6c 29 29 29 29 29 0a 20 20 20 20 20 20 20 ail))))).
190e0 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 (cond.
190f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
19100 6f 72 20 28 6e 75 6d 62 65 72 3f 20 28 63 61 64 or (number? (cad
19110 72 20 73 72 65 29 29 20 28 73 79 6d 62 6f 6c 3f r sre)) (symbol?
19120 20 28 63 61 64 72 20 73 72 65 29 29 29 0a 20 20 (cadr sre))).
19130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19140 6c 65 74 20 28 28 69 6e 64 65 78 0a 20 20 20 20 let ((index.
19150 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19160 20 20 20 20 28 69 66 20 28 73 79 6d 62 6f 6c 3f (if (symbol?
19170 20 28 63 61 64 72 20 73 72 65 29 29 0a 20 20 20 (cadr sre)).
19180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19190 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
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 28 61 73 ((as
191c0 73 71 20 28 63 61 64 72 20 73 72 65 29 20 6e 61 sq (cadr sre) na
191d0 6d 65 73 29 20 3d 3e 20 63 64 72 29 0a 20 20 20 mes) => cdr).
191e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
191f0 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
19200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19210 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
19220 72 72 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 6e 61 rror "unknown na
19230 6d 65 64 20 62 61 63 6b 72 65 66 20 69 6e 20 53 med backref in S
19240 52 45 20 49 46 22 20 73 72 65 29 29 29 0a 20 20 RE IF" sre))).
19250 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19260 20 20 20 20 20 20 20 20 20 20 28 63 61 64 72 20 (cadr
19270 73 72 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 sre)))).
19280 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
19290 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 da (cnk init src
192a0 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
192b0 65 73 20 66 61 69 6c 32 29 0a 20 20 20 20 20 20 es fail2).
192c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
192d0 69 66 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 if (irregex-matc
192e0 68 2d 65 6e 64 2d 73 6f 75 72 63 65 20 6d 61 74 h-end-source mat
192f0 63 68 65 73 20 69 6e 64 65 78 29 0a 20 20 20 20 ches index).
19300 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19310 20 20 20 20 20 28 70 61 73 73 20 63 6e 6b 20 69 (pass cnk i
19320 6e 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e nit src str i en
19330 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 32 29 d matches fail2)
19340 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19350 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 20 (fail
19360 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
19370 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 i end matches f
19380 61 69 6c 32 29 29 29 29 29 0a 20 20 20 20 20 20 ail2))))).
19390 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a (else.
193a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
193b0 20 28 6c 65 74 20 28 28 74 65 73 74 20 28 6c 70 (let ((test (lp
193c0 20 28 63 61 64 72 20 73 72 65 29 20 6e 20 66 6c (cadr sre) n fl
193d0 61 67 73 20 70 61 73 73 29 29 29 0a 20 20 20 20 ags pass))).
193e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
193f0 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
19400 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
19410 61 74 63 68 65 73 20 66 61 69 6c 32 29 0a 20 20 atches fail2).
19420 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19430 20 20 20 28 74 65 73 74 20 63 6e 6b 20 69 6e 69 (test cnk ini
19440 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
19450 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 matches.
19460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19470 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20 28 66 (lambda () (f
19480 61 69 6c 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 ail cnk init src
19490 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
194a0 65 73 20 66 61 69 6c 32 29 29 29 0a 20 20 20 20 es fail2))).
194b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
194c0 20 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 )))))).
194d0 20 20 20 20 28 28 62 61 63 6b 72 65 66 20 62 61 ((backref ba
194e0 63 6b 72 65 66 2d 63 69 29 0a 20 20 20 20 20 20 ckref-ci).
194f0 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 20 (let ((n
19500 28 63 6f 6e 64 20 28 28 6e 75 6d 62 65 72 3f 20 (cond ((number?
19510 28 63 61 64 72 20 73 72 65 29 29 20 28 63 61 64 (cadr sre)) (cad
19520 72 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 r sre)).
19530 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19540 20 20 20 20 28 28 61 73 73 71 20 28 63 61 64 72 ((assq (cadr
19550 20 73 72 65 29 20 6e 61 6d 65 73 29 20 3d 3e 20 sre) names) =>
19560 63 64 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 cdr).
19570 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19580 20 28 65 6c 73 65 20 28 65 72 72 6f 72 20 22 75 (else (error "u
19590 6e 6b 6e 6f 77 6e 20 62 61 63 6b 72 65 66 65 72 nknown backrefer
195a0 65 6e 63 65 22 20 28 63 61 64 72 20 73 72 65 29 ence" (cadr sre)
195b0 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
195c0 20 20 20 20 20 20 20 20 28 63 6f 6d 70 61 72 65 (compare
195d0 20 28 69 66 20 28 6f 72 20 28 65 71 3f 20 28 63 (if (or (eq? (c
195e0 61 72 20 73 72 65 29 20 27 62 61 63 6b 72 65 66 ar sre) 'backref
195f0 2d 63 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 -ci).
19600 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19610 20 20 20 20 20 20 20 20 20 28 66 6c 61 67 2d 73 (flag-s
19620 65 74 3f 20 66 6c 61 67 73 20 7e 63 61 73 65 2d et? flags ~case-
19630 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 29 0a 20 insensitive?)).
19640 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19650 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73 s
19660 74 72 69 6e 67 2d 63 69 3d 3f 0a 20 20 20 20 20 tring-ci=?.
19670 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19680 20 20 20 20 20 20 20 20 20 20 20 73 74 72 69 6e strin
19690 67 3d 3f 29 29 29 0a 20 20 20 20 20 20 20 20 20 g=?))).
196a0 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 (lambda (c
196b0 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
196c0 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
196d0 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 il).
196e0 20 20 20 20 20 28 6c 65 74 20 28 28 73 20 28 69 (let ((s (i
196f0 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 75 62 rregex-match-sub
19700 73 74 72 69 6e 67 20 6d 61 74 63 68 65 73 20 6e string matches n
19710 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
19720 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
19730 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
19740 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 (fail)
19750 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19760 20 20 20 20 20 20 20 20 3b 3b 20 58 58 58 58 20 ;; XXXX
19770 63 72 65 61 74 65 20 61 6e 20 61 62 73 74 72 61 create an abstra
19780 63 74 20 73 75 62 63 68 75 6e 6b 2d 63 6f 6d 70 ct subchunk-comp
19790 61 72 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 are.
197a0 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
197b0 6c 70 20 28 28 73 72 63 20 73 72 63 29 0a 20 20 lp ((src src).
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 20 28 73 (s
197e0 74 72 20 73 74 72 29 0a 20 20 20 20 20 20 20 20 tr str).
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 28 69 20 69 29 0a 20 20 (i i).
19810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
19830 6e 64 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 nd end).
19840 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19850 20 20 20 20 20 20 20 20 28 6a 20 30 29 0a 20 20 (j 0).
19860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19870 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
19880 65 6e 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 en (string-lengt
19890 68 20 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 h s))).
198a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
198b0 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 (cond.
198c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
198d0 28 28 3c 3d 20 6c 65 6e 20 28 2d 20 65 6e 64 20 ((<= len (- end
198e0 69 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 i)).
198f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19900 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond.
19910 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19920 20 28 28 63 6f 6d 70 61 72 65 20 28 73 75 62 73 ((compare (subs
19930 74 72 69 6e 67 20 73 20 6a 20 28 73 74 72 69 6e tring s j (strin
19940 67 2d 6c 65 6e 67 74 68 20 73 29 29 0a 20 20 20 g-length s)).
19950 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19960 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19970 20 20 20 28 73 75 62 73 74 72 69 6e 67 20 73 74 (substring st
19980 72 20 69 20 28 2b 20 69 20 6c 65 6e 29 29 29 0a r i (+ i len))).
19990 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
199a0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
199b0 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 xt cnk init src
199c0 73 74 72 20 28 2b 20 69 20 6c 65 6e 29 20 65 6e str (+ i len) en
199d0 64 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 29 d matches fail))
199e0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
199f0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c (el
19a00 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
19a10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a20 28 66 61 69 6c 29 29 29 29 0a 20 20 20 20 20 20 (fail)))).
19a30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a40 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 (else.
19a50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a60 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond.
19a70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19a80 20 20 20 20 20 20 20 28 28 63 6f 6d 70 61 72 65 ((compare
19a90 20 28 73 75 62 73 74 72 69 6e 67 20 73 20 6a 20 (substring s j
19aa0 28 2b 20 6a 20 28 2d 20 65 6e 64 20 69 29 29 29 (+ j (- end i)))
19ab0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
19ac0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ad0 20 20 20 20 20 20 20 28 73 75 62 73 74 72 69 6e (substrin
19ae0 67 20 73 74 72 20 69 20 65 6e 64 29 29 0a 20 20 g str i end)).
19af0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b00 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
19b10 28 28 73 72 63 32 20 28 28 63 68 75 6e 6b 65 72 ((src2 ((chunker
19b20 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 73 -get-next cnk) s
19b30 72 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 rc))).
19b40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b50 20 20 20 20 20 28 69 66 20 73 72 63 32 0a 20 20 (if src2.
19b60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19b80 20 28 6c 70 20 73 72 63 32 0a 20 20 20 20 20 20 (lp src2.
19b90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ba0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19bb0 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 ((chunker-get-s
19bc0 74 72 20 63 6e 6b 29 20 73 72 63 32 29 0a 20 20 tr cnk) src2).
19bd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19be0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19bf0 20 20 20 20 20 28 28 63 68 75 6e 6b 65 72 2d 67 ((chunker-g
19c00 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 et-start cnk) sr
19c10 63 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 c2).
19c20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c30 20 20 20 20 20 20 20 20 20 20 20 28 28 63 68 75 ((chu
19c40 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 6e 6b nker-get-end cnk
19c50 29 20 73 72 63 32 29 0a 20 20 20 20 20 20 20 20 ) src2).
19c60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19c70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19c80 2b 20 6a 20 28 2d 20 65 6e 64 20 69 29 29 0a 20 + j (- end i)).
19c90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ca0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19cb0 20 20 20 20 20 20 28 2d 20 6c 65 6e 20 28 2d 20 (- len (-
19cc0 65 6e 64 20 69 29 29 29 0a 20 20 20 20 20 20 20 end i))).
19cd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ce0 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 (fai
19cf0 6c 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 l)))).
19d00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d10 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
19d20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19d30 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 29 29 (fail))))))
19d40 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
19d50 20 20 28 28 64 73 6d 29 0a 20 20 20 20 20 20 20 ((dsm).
19d60 20 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d 73 (lp (sre-s
19d70 65 71 75 65 6e 63 65 20 28 63 64 64 64 72 20 73 equence (cdddr s
19d80 72 65 29 29 20 28 2b 20 6e 20 28 63 61 64 72 20 re)) (+ n (cadr
19d90 73 72 65 29 29 20 66 6c 61 67 73 20 6e 65 78 74 sre)) flags next
19da0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
19db0 28 24 20 73 75 62 6d 61 74 63 68 29 0a 20 20 20 ($ submatch).
19dc0 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
19dd0 28 62 6f 64 79 0a 20 20 20 20 20 20 20 20 20 20 (body.
19de0 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 73 (lp (s
19df0 72 65 2d 73 65 71 75 65 6e 63 65 20 28 63 64 72 re-sequence (cdr
19e00 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
19e10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
19e20 2b 20 6e 20 31 29 0a 20 20 20 20 20 20 20 20 20 + n 1).
19e30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66 f
19e40 6c 61 67 73 0a 20 20 20 20 20 20 20 20 20 20 20 lags.
19e50 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 (la
19e60 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 mbda (cnk init s
19e70 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 rc str i end mat
19e80 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
19e90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ea0 20 20 20 20 20 28 6c 65 74 20 28 28 6f 6c 64 2d (let ((old-
19eb0 73 6f 75 72 63 65 0a 20 20 20 20 20 20 20 20 20 source.
19ec0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19ed0 20 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 (irregex
19ee0 2d 6d 61 74 63 68 2d 65 6e 64 2d 73 6f 75 72 63 -match-end-sourc
19ef0 65 20 6d 61 74 63 68 65 73 20 6e 29 29 0a 20 20 e matches n)).
19f00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6f (o
19f20 6c 64 2d 69 6e 64 65 78 0a 20 20 20 20 20 20 20 ld-index.
19f30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f40 20 20 20 20 20 20 20 20 20 20 28 69 72 72 65 67 (irreg
19f50 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 ex-match-end-ind
19f60 65 78 20 6d 61 74 63 68 65 73 20 6e 29 29 29 0a ex matches n))).
19f70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f80 20 20 20 20 20 20 20 20 20 20 20 20 28 69 72 72 (irr
19f90 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 73 egex-match-end-s
19fa0 6f 75 72 63 65 2d 73 65 74 21 20 6d 61 74 63 68 ource-set! match
19fb0 65 73 20 6e 20 73 72 63 29 0a 20 20 20 20 20 20 es n src).
19fc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19fd0 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d (irregex-m
19fe0 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 78 2d 73 atch-end-index-s
19ff0 65 74 21 20 6d 61 74 63 68 65 73 20 6e 20 69 29 et! matches n i)
1a000 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1a010 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
1a020 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 xt cnk init src
1a030 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
1a040 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
1a050 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a060 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 (lambda ().
1a070 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a080 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a090 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
1a0a0 68 2d 65 6e 64 2d 73 6f 75 72 63 65 2d 73 65 74 h-end-source-set
1a0b0 21 0a 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 20 20 20 20 20
1a0d0 20 20 20 20 20 20 20 6d 61 74 63 68 65 73 20 6e matches n
1a0e0 20 6f 6c 64 2d 73 6f 75 72 63 65 29 0a 20 20 20 old-source).
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 20 20 20 20 20 20 20 20 20
1a110 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
1a120 65 6e 64 2d 69 6e 64 65 78 2d 73 65 74 21 0a 20 end-index-set!.
1a130 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a140 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a150 20 20 20 20 6d 61 74 63 68 65 73 20 6e 20 6f 6c matches n ol
1a160 64 2d 69 6e 64 65 78 29 0a 20 20 20 20 20 20 20 d-index).
1a170 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a180 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 (fa
1a190 69 6c 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 il)))))))).
1a1a0 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
1a1b0 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 a (cnk init src
1a1c0 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
1a1d0 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
1a1e0 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
1a1f0 6f 6c 64 2d 73 6f 75 72 63 65 20 28 69 72 72 65 old-source (irre
1a200 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 74 2d gex-match-start-
1a210 73 6f 75 72 63 65 20 6d 61 74 63 68 65 73 20 6e source matches n
1a220 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1a230 20 20 20 20 20 20 20 20 20 20 28 6f 6c 64 2d 69 (old-i
1a240 6e 64 65 78 20 28 69 72 72 65 67 65 78 2d 6d 61 ndex (irregex-ma
1a250 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 20 tch-start-index
1a260 6d 61 74 63 68 65 73 20 6e 29 29 29 0a 20 20 20 matches n))).
1a270 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a280 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 (irregex-match-s
1a290 74 61 72 74 2d 73 6f 75 72 63 65 2d 73 65 74 21 tart-source-set!
1a2a0 20 6d 61 74 63 68 65 73 20 6e 20 73 72 63 29 0a matches n src).
1a2b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a2c0 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 (irregex-matc
1a2d0 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 2d 73 65 h-start-index-se
1a2e0 74 21 20 6d 61 74 63 68 65 73 20 6e 20 69 29 0a t! matches n i).
1a2f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a300 20 20 20 28 62 6f 64 79 20 63 6e 6b 20 69 6e 69 (body cnk ini
1a310 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
1a320 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 20 20 matches.
1a330 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a340 20 28 6c 61 6d 62 64 61 20 28 29 0a 20 20 20 20 (lambda ().
1a350 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a360 20 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d (irregex-
1a370 6d 61 74 63 68 2d 73 74 61 72 74 2d 73 6f 75 72 match-start-sour
1a380 63 65 2d 73 65 74 21 0a 20 20 20 20 20 20 20 20 ce-set!.
1a390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a3a0 20 20 20 20 6d 61 74 63 68 65 73 20 6e 20 6f 6c matches n ol
1a3b0 64 2d 73 6f 75 72 63 65 29 0a 20 20 20 20 20 20 d-source).
1a3c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a3d0 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d 61 (irregex-ma
1a3e0 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 2d tch-start-index-
1a3f0 73 65 74 21 0a 20 20 20 20 20 20 20 20 20 20 20 set!.
1a400 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a410 20 6d 61 74 63 68 65 73 20 6e 20 6f 6c 64 2d 69 matches n old-i
1a420 6e 64 65 78 29 0a 20 20 20 20 20 20 20 20 20 20 ndex).
1a430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a440 20 28 66 61 69 6c 29 29 29 29 29 29 29 0a 20 20 (fail))))))).
1a450 20 20 20 20 20 20 20 20 20 20 28 28 3d 3e 20 73 ((=> s
1a460 75 62 6d 61 74 63 68 2d 6e 61 6d 65 64 29 0a 20 ubmatch-named).
1a470 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 63 (rec
1a480 20 60 28 73 75 62 6d 61 74 63 68 20 2c 40 28 63 `(submatch ,@(c
1a490 64 64 72 20 73 72 65 29 29 29 29 0a 20 20 20 20 ddr sre)))).
1a4a0 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else.
1a4b0 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro
1a4c0 72 20 22 75 6e 6b 6e 6f 77 6e 20 72 65 67 65 78 r "unknown regex
1a4d0 70 20 6f 70 65 72 61 74 6f 72 22 20 73 72 65 29 p operator" sre)
1a4e0 29 29 29 29 0a 20 20 20 20 20 28 28 73 79 6d 62 )))). ((symb
1a4f0 6f 6c 3f 20 73 72 65 29 0a 20 20 20 20 20 20 28 ol? sre). (
1a500 63 61 73 65 20 73 72 65 0a 20 20 20 20 20 20 20 case sre.
1a510 20 28 28 61 6e 79 29 0a 20 20 20 20 20 20 20 20 ((any).
1a520 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e (lambda (cnk in
1a530 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
1a540 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 matches fail).
1a550 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3c (if (<
1a560 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 i end).
1a570 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e 6b (next cnk
1a580 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 28 2b init src str (+
1a590 20 69 20 31 29 20 65 6e 64 20 6d 61 74 63 68 65 i 1) end matche
1a5a0 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
1a5b0 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 72 (let ((sr
1a5c0 63 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 c2 ((chunker-get
1a5d0 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 29 29 -next cnk) src))
1a5e0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1a5f0 20 20 20 28 69 66 20 73 72 63 32 0a 20 20 20 20 (if src2.
1a600 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a610 20 28 6c 65 74 20 28 28 73 74 72 32 20 28 28 63 (let ((str2 ((c
1a620 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 20 63 hunker-get-str c
1a630 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 nk) src2)).
1a640 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a650 20 20 20 20 20 20 28 69 32 20 28 28 63 68 75 6e (i2 ((chun
1a660 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e ker-get-start cn
1a670 6b 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 20 k) src2)).
1a680 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a690 20 20 20 20 20 28 65 6e 64 32 20 28 28 63 68 75 (end2 ((chu
1a6a0 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 6e 6b nker-get-end cnk
1a6b0 29 20 73 72 63 32 29 29 29 0a 20 20 20 20 20 20 ) src2))).
1a6c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a6d0 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 (next cnk init
1a6e0 73 72 63 32 20 73 74 72 32 20 28 2b 20 69 32 20 src2 str2 (+ i2
1a6f0 31 29 20 65 6e 64 32 20 6d 61 74 63 68 65 73 20 1) end2 matches
1a700 66 61 69 6c 29 29 0a 20 20 20 20 20 20 20 20 20 fail)).
1a710 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 (fai
1a720 6c 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 l)))))).
1a730 28 28 6e 6f 6e 6c 29 0a 20 20 20 20 20 20 20 20 ((nonl).
1a740 20 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e (lambda (cnk in
1a750 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
1a760 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 matches fail).
1a770 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3c (if (<
1a780 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 i end).
1a790 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 (if (not
1a7a0 28 65 71 76 3f 20 23 5c 6e 65 77 6c 69 6e 65 20 (eqv? #\newline
1a7b0 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str
1a7c0 69 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 i))).
1a7d0 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e (next cn
1a7e0 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 28 k init src str (
1a7f0 2b 20 69 20 31 29 20 65 6e 64 20 6d 61 74 63 68 + i 1) end match
1a800 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
1a810 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 (fai
1a820 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 l)).
1a830 20 20 20 28 6c 65 74 20 28 28 73 72 63 32 20 28 (let ((src2 (
1a840 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 (chunker-get-nex
1a850 74 20 63 6e 6b 29 20 73 72 63 29 29 29 0a 20 20 t cnk) src))).
1a860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1a870 69 66 20 73 72 63 32 0a 20 20 20 20 20 20 20 20 if src2.
1a880 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
1a890 74 20 28 28 73 74 72 32 20 28 28 63 68 75 6e 6b t ((str2 ((chunk
1a8a0 65 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 er-get-str cnk)
1a8b0 73 72 63 32 29 29 0a 20 20 20 20 20 20 20 20 20 src2)).
1a8c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a8d0 20 20 28 69 32 20 28 28 63 68 75 6e 6b 65 72 2d (i2 ((chunker-
1a8e0 67 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 get-start cnk) s
1a8f0 72 63 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 rc2)).
1a900 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a910 20 28 65 6e 64 32 20 28 28 63 68 75 6e 6b 65 72 (end2 ((chunker
1a920 2d 67 65 74 2d 65 6e 64 20 63 6e 6b 29 20 73 72 -get-end cnk) sr
1a930 63 32 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 c2))).
1a940 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
1a950 20 28 6e 6f 74 20 28 65 71 76 3f 20 23 5c 6e 65 (not (eqv? #\ne
1a960 77 6c 69 6e 65 20 28 73 74 72 69 6e 67 2d 72 65 wline (string-re
1a970 66 20 73 74 72 32 20 69 32 29 29 29 0a 20 20 20 f str2 i2))).
1a980 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a990 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e (next cn
1a9a0 6b 20 69 6e 69 74 20 73 72 63 32 20 73 74 72 32 k init src2 str2
1a9b0 20 28 2b 20 69 32 20 31 29 20 65 6e 64 32 20 6d (+ i2 1) end2 m
1a9c0 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 atches fail).
1a9d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a9e0 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 (fail)))
1a9f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1aa00 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 29 (fail)))))
1aa10 29 0a 20 20 20 20 20 20 20 20 28 28 62 6f 73 29 ). ((bos)
1aa20 0a 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 . (lambd
1aa30 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 a (cnk init src
1aa40 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
1aa50 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
1aa60 20 20 20 28 69 66 20 28 61 6e 64 20 28 65 71 3f (if (and (eq?
1aa70 20 73 72 63 20 69 6e 69 74 29 20 28 65 71 76 3f src init) (eqv?
1aa80 20 69 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 i ((chunker-get
1aa90 2d 73 74 61 72 74 20 63 6e 6b 29 20 69 6e 69 74 -start cnk) init
1aaa0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
1aab0 20 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 (next cnk ini
1aac0 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
1aad0 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 matches fail).
1aae0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 (fa
1aaf0 69 6c 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 il)))). (
1ab00 28 62 6f 6c 29 0a 20 20 20 20 20 20 20 20 20 28 (bol). (
1ab10 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
1ab20 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
1ab30 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 atches fail).
1ab40 20 20 20 20 20 20 20 20 28 69 66 20 28 6f 72 20 (if (or
1ab50 28 61 6e 64 20 28 65 71 3f 20 73 72 63 20 69 6e (and (eq? src in
1ab60 69 74 29 20 28 65 71 76 3f 20 69 20 28 28 63 68 it) (eqv? i ((ch
1ab70 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 unker-get-start
1ab80 63 6e 6b 29 20 69 6e 69 74 29 29 29 0a 20 20 20 cnk) init))).
1ab90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aba0 28 61 6e 64 20 28 3e 20 69 20 28 28 63 68 75 6e (and (> i ((chun
1abb0 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e ker-get-start cn
1abc0 6b 29 20 73 72 63 29 29 0a 20 20 20 20 20 20 20 k) src)).
1abd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1abe0 20 28 65 71 76 3f 20 23 5c 6e 65 77 6c 69 6e 65 (eqv? #\newline
1abf0 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
1ac00 20 28 2d 20 69 20 31 29 29 29 29 29 0a 20 20 20 (- i 1))))).
1ac10 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 (nex
1ac20 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 t cnk init src s
1ac30 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
1ac40 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
1ac50 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 0a (fail)))).
1ac60 20 20 20 20 20 20 20 20 28 28 62 6f 77 29 0a 20 ((bow).
1ac70 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
1ac80 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 (cnk init src st
1ac90 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 r i end matches
1aca0 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
1acb0 20 28 69 66 20 28 61 6e 64 20 28 6f 72 20 28 69 (if (and (or (i
1acc0 66 20 28 3e 20 69 20 28 28 63 68 75 6e 6b 65 72 f (> i ((chunker
1acd0 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 -get-start cnk)
1ace0 73 72 63 29 29 0a 20 20 20 20 20 20 20 20 20 20 src)).
1acf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ad00 20 20 28 6e 6f 74 20 28 63 68 61 72 2d 61 6c 70 (not (char-alp
1ad10 68 61 6e 75 6d 65 72 69 63 3f 20 28 73 74 72 69 hanumeric? (stri
1ad20 6e 67 2d 72 65 66 20 73 74 72 20 28 2d 20 69 20 ng-ref str (- i
1ad30 31 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 1)))).
1ad40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ad50 20 20 28 6c 65 74 20 28 28 63 68 20 28 63 68 75 (let ((ch (chu
1ad60 6e 6b 65 72 2d 70 72 65 76 2d 63 68 61 72 20 63 nker-prev-char c
1ad70 6e 6b 20 73 72 63 20 65 6e 64 29 29 29 0a 20 20 nk src end))).
1ad80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ad90 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
1ada0 20 63 68 20 28 6e 6f 74 20 28 63 68 61 72 2d 61 ch (not (char-a
1adb0 6c 70 68 61 6e 75 6d 65 72 69 63 3f 20 63 68 29 lphanumeric? ch)
1adc0 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
1add0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e (an
1ade0 64 20 28 65 71 3f 20 73 72 63 20 69 6e 69 74 29 d (eq? src init)
1adf0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1ae00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
1ae10 71 76 3f 20 69 20 28 28 63 68 75 6e 6b 65 72 2d qv? i ((chunker-
1ae20 67 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 69 get-start cnk) i
1ae30 6e 69 74 29 29 29 29 0a 20 20 20 20 20 20 20 20 nit)))).
1ae40 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
1ae50 28 3c 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 (< i end).
1ae60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ae70 20 20 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d (char-alphanum
1ae80 65 72 69 63 3f 20 28 73 74 72 69 6e 67 2d 72 65 eric? (string-re
1ae90 66 20 73 74 72 20 69 29 29 0a 20 20 20 20 20 20 f str i)).
1aea0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aeb0 20 20 28 6c 65 74 20 28 28 6e 65 78 74 20 28 28 (let ((next ((
1aec0 63 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 chunker-get-next
1aed0 20 63 6e 6b 29 20 73 72 63 29 29 29 0a 20 20 20 cnk) src))).
1aee0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1aef0 20 20 20 20 20 20 20 28 61 6e 64 20 6e 65 78 74 (and next
1af00 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1af10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af20 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d 65 72 (char-alphanumer
1af30 69 63 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 ic?.
1af40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1af50 20 20 20 20 28 73 74 72 69 6e 67 2d 72 65 66 20 (string-ref
1af60 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 ((chunker-get-st
1af70 72 20 63 6e 6b 29 20 6e 65 78 74 29 0a 20 20 20 r cnk) next).
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 20 20 20 20 20 20 20
1afa0 20 20 20 20 20 20 20 20 20 28 28 63 68 75 6e 6b ((chunk
1afb0 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b er-get-start cnk
1afc0 29 20 6e 65 78 74 29 29 29 29 29 29 29 0a 20 20 ) next))))))).
1afd0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
1afe0 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 xt cnk init src
1aff0 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
1b000 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
1b010 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 (fail))))
1b020 0a 20 20 20 20 20 20 20 20 28 28 65 6f 73 29 0a . ((eos).
1b030 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
1b040 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 (cnk init src s
1b050 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
1b060 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
1b070 20 20 28 69 66 20 28 61 6e 64 20 28 3e 3d 20 69 (if (and (>= i
1b080 20 65 6e 64 29 20 28 6e 6f 74 20 28 28 63 68 75 end) (not ((chu
1b090 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 74 20 63 6e nker-get-next cn
1b0a0 6b 29 20 73 72 63 29 29 29 0a 20 20 20 20 20 20 k) src))).
1b0b0 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 (next c
1b0c0 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
1b0d0 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
1b0e0 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 il).
1b0f0 20 20 20 28 66 61 69 6c 29 29 29 29 0a 20 20 20 (fail)))).
1b100 20 20 20 20 20 28 28 65 6f 6c 29 0a 20 20 20 20 ((eol).
1b110 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 6e (lambda (cn
1b120 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 69 k init src str i
1b130 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 69 end matches fai
1b140 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 69 l). (i
1b150 66 20 28 69 66 20 28 3c 20 69 20 65 6e 64 29 0a f (if (< i end).
1b160 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b170 20 20 20 28 65 71 76 3f 20 23 5c 6e 65 77 6c 69 (eqv? #\newli
1b180 6e 65 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 ne (string-ref s
1b190 74 72 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 tr i)).
1b1a0 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
1b1b0 28 73 72 63 32 20 28 28 63 68 75 6e 6b 65 72 2d (src2 ((chunker-
1b1c0 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 get-next cnk) sr
1b1d0 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 c))).
1b1e0 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n
1b1f0 6f 74 20 73 72 63 32 29 0a 20 20 20 20 20 20 20 ot src2).
1b200 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b210 20 20 23 74 0a 20 20 20 20 20 20 20 20 20 20 20 #t.
1b220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 (e
1b230 71 76 3f 20 23 5c 6e 65 77 6c 69 6e 65 0a 20 20 qv? #\newline.
1b240 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b250 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
1b260 72 69 6e 67 2d 72 65 66 20 28 28 63 68 75 6e 6b ring-ref ((chunk
1b270 65 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b 29 20 er-get-str cnk)
1b280 73 72 63 32 29 0a 20 20 20 20 20 20 20 20 20 20 src2).
1b290 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b2a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b2b0 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 ((chunker-get-s
1b2c0 74 61 72 74 20 63 6e 6b 29 20 73 72 63 32 29 29 tart cnk) src2))
1b2d0 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
1b2e0 20 20 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e (next cnk in
1b2f0 69 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 it src str i end
1b300 20 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 matches fail).
1b310 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
1b320 61 69 6c 29 29 29 29 0a 20 20 20 20 20 20 20 20 ail)))).
1b330 28 28 65 6f 77 29 0a 20 20 20 20 20 20 20 20 20 ((eow).
1b340 28 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 (lambda (cnk ini
1b350 74 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 t src str i end
1b360 6d 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 matches fail).
1b370 20 20 20 20 20 20 20 20 20 28 69 66 20 28 61 6e (if (an
1b380 64 20 28 69 66 20 28 3c 20 69 20 65 6e 64 29 0a d (if (< i end).
1b390 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b3a0 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 63 68 (not (ch
1b3b0 61 72 2d 61 6c 70 68 61 6e 75 6d 65 72 69 63 3f ar-alphanumeric?
1b3c0 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
1b3d0 20 69 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 i))).
1b3e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1b3f0 65 74 20 28 28 63 68 20 28 63 68 75 6e 6b 65 72 et ((ch (chunker
1b400 2d 6e 65 78 74 2d 63 68 61 72 20 63 6e 6b 20 73 -next-char cnk s
1b410 72 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 rc))).
1b420 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b430 28 6f 72 20 28 6e 6f 74 20 63 68 29 20 28 6e 6f (or (not ch) (no
1b440 74 20 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d t (char-alphanum
1b450 65 72 69 63 3f 20 63 68 29 29 29 29 29 0a 20 20 eric? ch))))).
1b460 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b470 20 20 28 69 66 20 28 3e 20 69 20 28 28 63 68 75 (if (> i ((chu
1b480 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 nker-get-start c
1b490 6e 6b 29 20 73 72 63 29 29 0a 20 20 20 20 20 20 nk) src)).
1b4a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b4b0 20 20 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d (char-alphanum
1b4c0 65 72 69 63 3f 20 28 73 74 72 69 6e 67 2d 72 65 eric? (string-re
1b4d0 66 20 73 74 72 20 28 2d 20 69 20 31 29 29 29 0a f str (- i 1))).
1b4e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b4f0 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 70 (let ((p
1b500 72 65 76 20 28 63 68 75 6e 6b 65 72 2d 70 72 65 rev (chunker-pre
1b510 76 2d 63 68 61 72 20 63 6e 6b 20 69 6e 69 74 20 v-char cnk init
1b520 73 72 63 29 29 29 0a 20 20 20 20 20 20 20 20 20 src))).
1b530 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b540 20 28 6f 72 20 28 6e 6f 74 20 70 72 65 76 29 20 (or (not prev)
1b550 28 63 68 61 72 2d 61 6c 70 68 61 6e 75 6d 65 72 (char-alphanumer
1b560 69 63 3f 20 70 72 65 76 29 29 29 29 29 0a 20 20 ic? prev))))).
1b570 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6e 65 (ne
1b580 78 74 20 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 xt cnk init src
1b590 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 str i end matche
1b5a0 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 s fail).
1b5b0 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 (fail))))
1b5c0 0a 20 20 20 20 20 20 20 20 28 28 6e 77 62 29 20 . ((nwb)
1b5d0 20 3b 3b 20 6e 6f 6e 2d 77 6f 72 64 2d 62 6f 75 ;; non-word-bou
1b5e0 6e 64 61 72 79 0a 20 20 20 20 20 20 20 20 20 28 ndary. (
1b5f0 6c 61 6d 62 64 61 20 28 63 6e 6b 20 69 6e 69 74 lambda (cnk init
1b600 20 73 72 63 20 73 74 72 20 69 20 65 6e 64 20 6d src str i end m
1b610 61 74 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 atches fail).
1b620 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 (let ((c
1b630 31 20 28 69 66 20 28 3c 20 69 20 65 6e 64 29 0a 1 (if (< i end).
1b640 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b650 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
1b660 2d 72 65 66 20 73 74 72 20 69 29 0a 20 20 20 20 -ref str i).
1b670 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b680 20 20 20 20 20 28 63 68 75 6e 6b 65 72 2d 6e 65 (chunker-ne
1b690 78 74 2d 63 68 61 72 20 63 6e 6b 20 73 72 63 29 xt-char cnk src)
1b6a0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1b6b0 20 20 20 20 28 63 32 20 28 69 66 20 28 3e 20 69 (c2 (if (> i
1b6c0 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 ((chunker-get-s
1b6d0 74 61 72 74 20 63 6e 6b 29 20 73 72 63 29 29 0a tart cnk) src)).
1b6e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b6f0 20 20 20 20 20 20 20 20 20 28 73 74 72 69 6e 67 (string
1b700 2d 72 65 66 20 73 74 72 20 28 2d 20 69 20 31 29 -ref str (- i 1)
1b710 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1b720 20 20 20 20 20 20 20 20 20 20 20 28 63 68 75 6e (chun
1b730 6b 65 72 2d 70 72 65 76 2d 63 68 61 72 20 63 6e ker-prev-char cn
1b740 6b 20 69 6e 69 74 20 73 72 63 29 29 29 29 0a 20 k init src)))).
1b750 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
1b760 28 61 6e 64 20 63 31 20 63 32 0a 20 20 20 20 20 (and c1 c2.
1b770 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b780 20 28 69 66 20 28 63 68 61 72 2d 61 6c 70 68 61 (if (char-alpha
1b790 6e 75 6d 65 72 69 63 3f 20 63 31 29 0a 20 20 20 numeric? c1).
1b7a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b7b0 20 20 20 20 20 20 20 28 63 68 61 72 2d 61 6c 70 (char-alp
1b7c0 68 61 6e 75 6d 65 72 69 63 3f 20 63 32 29 0a 20 hanumeric? c2).
1b7d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b7e0 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 63 (not (c
1b7f0 68 61 72 2d 61 6c 70 68 61 6e 75 6d 65 72 69 63 har-alphanumeric
1b800 3f 20 63 32 29 29 29 29 0a 20 20 20 20 20 20 20 ? c2)))).
1b810 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
1b820 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
1b830 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 i end matches f
1b840 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
1b850 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 29 (fail)))))
1b860 0a 20 20 20 20 20 20 20 20 28 28 65 70 73 69 6c . ((epsil
1b870 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 6e 65 78 on). nex
1b880 74 29 0a 20 20 20 20 20 20 20 20 28 65 6c 73 65 t). (else
1b890 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 . (let (
1b8a0 28 63 65 6c 6c 20 28 61 73 73 71 20 73 72 65 20 (cell (assq sre
1b8b0 73 72 65 2d 6e 61 6d 65 64 2d 64 65 66 69 6e 69 sre-named-defini
1b8c0 74 69 6f 6e 73 29 29 29 0a 20 20 20 20 20 20 20 tions))).
1b8d0 20 20 20 20 28 69 66 20 63 65 6c 6c 0a 20 20 20 (if cell.
1b8e0 20 20 20 20 20 20 20 20 20 20 20 20 28 72 65 63 (rec
1b8f0 20 28 63 64 72 20 63 65 6c 6c 29 29 0a 20 20 20 (cdr cell)).
1b900 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err
1b910 6f 72 20 22 75 6e 6b 6e 6f 77 6e 20 72 65 67 65 or "unknown rege
1b920 78 70 22 20 73 72 65 29 29 29 29 29 29 0a 20 20 xp" sre)))))).
1b930 20 20 20 28 28 63 68 61 72 3f 20 73 72 65 29 0a ((char? sre).
1b940 20 20 20 20 20 20 28 69 66 20 28 66 6c 61 67 2d (if (flag-
1b950 73 65 74 3f 20 66 6c 61 67 73 20 7e 63 61 73 65 set? flags ~case
1b960 2d 69 6e 73 65 6e 73 69 74 69 76 65 3f 29 0a 20 -insensitive?).
1b970 20 20 20 20 20 20 20 20 20 3b 3b 20 63 61 73 65 ;; case
1b980 2d 69 6e 73 65 6e 73 69 74 69 76 65 0a 20 20 20 -insensitive.
1b990 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 (lambda (
1b9a0 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
1b9b0 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 i end matches f
1b9c0 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
1b9d0 20 28 69 66 20 28 3e 3d 20 69 20 65 6e 64 29 0a (if (>= i end).
1b9e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b9f0 28 6c 65 74 20 6c 70 20 28 28 73 72 63 32 20 28 (let lp ((src2 (
1ba00 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 6e 65 78 (chunker-get-nex
1ba10 74 20 63 6e 6b 29 20 73 72 63 29 29 29 0a 20 20 t cnk) src))).
1ba20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ba30 28 69 66 20 73 72 63 32 0a 20 20 20 20 20 20 20 (if src2.
1ba40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1ba50 6c 65 74 20 28 28 73 74 72 32 20 28 28 63 68 75 let ((str2 ((chu
1ba60 6e 6b 65 72 2d 67 65 74 2d 73 74 72 20 63 6e 6b nker-get-str cnk
1ba70 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 20 20 ) src2)).
1ba80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ba90 20 20 20 20 20 28 69 32 20 28 28 63 68 75 6e 6b (i2 ((chunk
1baa0 65 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b er-get-start cnk
1bab0 29 20 73 72 63 32 29 29 0a 20 20 20 20 20 20 20 ) src2)).
1bac0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bad0 20 20 20 20 20 28 65 6e 64 32 20 28 28 63 68 75 (end2 ((chu
1bae0 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 20 63 6e 6b nker-get-end cnk
1baf0 29 20 73 72 63 32 29 29 29 0a 20 20 20 20 20 20 ) src2))).
1bb00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bb10 20 20 28 69 66 20 28 3e 3d 20 69 32 20 65 6e 64 (if (>= i2 end
1bb20 32 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2).
1bb30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1bb40 6c 70 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 lp ((chunker-get
1bb50 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 32 29 -next cnk) src2)
1bb60 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1bb70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1bb80 66 20 28 63 68 61 72 2d 63 69 3d 3f 20 73 72 65 f (char-ci=? sre
1bb90 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 (string-ref str
1bba0 32 20 69 32 29 29 0a 20 20 20 20 20 20 20 20 20 2 i2)).
1bbb0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bbc0 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e 6b (next cnk
1bbd0 20 69 6e 69 74 20 73 72 63 32 20 73 74 72 32 20 init src2 str2
1bbe0 28 2b 20 69 32 20 31 29 20 65 6e 64 32 0a 20 20 (+ i2 1) end2.
1bbf0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc10 20 20 20 20 6d 61 74 63 68 65 73 20 66 61 69 6c matches fail
1bc20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1bc30 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc40 20 20 28 66 61 69 6c 29 29 29 29 0a 20 20 20 20 (fail)))).
1bc50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc60 20 20 28 66 61 69 6c 29 29 29 0a 20 20 20 20 20 (fail))).
1bc70 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
1bc80 63 68 61 72 2d 63 69 3d 3f 20 73 72 65 20 28 73 char-ci=? sre (s
1bc90 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 tring-ref str i)
1bca0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1bcb0 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e 6b 20 (next cnk
1bcc0 69 6e 69 74 20 73 72 63 20 73 74 72 20 28 2b 20 init src str (+
1bcd0 69 20 31 29 20 65 6e 64 20 6d 61 74 63 68 65 73 i 1) end matches
1bce0 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 fail).
1bcf0 20 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c (fail
1bd00 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 3b )))). ;
1bd10 3b 20 63 61 73 65 2d 73 65 6e 73 69 74 69 76 65 ; case-sensitive
1bd20 0a 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 . (lamb
1bd30 64 61 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 da (cnk init src
1bd40 20 73 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 str i end match
1bd50 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 20 20 es fail).
1bd60 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 20 65 (if (>= i e
1bd70 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nd).
1bd80 20 20 20 20 28 6c 65 74 20 6c 70 20 28 28 73 72 (let lp ((sr
1bd90 63 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 c2 ((chunker-get
1bda0 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 29 29 -next cnk) src))
1bdb0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1bdc0 20 20 20 20 28 69 66 20 73 72 63 32 0a 20 20 20 (if src2.
1bdd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bde0 20 20 20 28 6c 65 74 20 28 28 73 74 72 32 20 28 (let ((str2 (
1bdf0 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 (chunker-get-str
1be00 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 cnk) src2)).
1be10 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1be20 20 20 20 20 20 20 20 20 20 28 69 32 20 28 28 63 (i2 ((c
1be30 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 61 72 74 hunker-get-start
1be40 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 cnk) src2)).
1be50 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1be60 20 20 20 20 20 20 20 20 20 28 65 6e 64 32 20 28 (end2 (
1be70 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 (chunker-get-end
1be80 20 63 6e 6b 29 20 73 72 63 32 29 29 29 0a 20 20 cnk) src2))).
1be90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bea0 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 32 (if (>= i2
1beb0 20 65 6e 64 32 29 0a 20 20 20 20 20 20 20 20 20 end2).
1bec0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bed0 20 20 20 28 6c 70 20 28 28 63 68 75 6e 6b 65 72 (lp ((chunker
1bee0 2d 67 65 74 2d 6e 65 78 74 20 63 6e 6b 29 20 73 -get-next cnk) s
1bef0 72 63 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 rc2)).
1bf00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf10 20 20 28 69 66 20 28 63 68 61 72 3d 3f 20 73 72 (if (char=? sr
1bf20 65 20 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 e (string-ref st
1bf30 72 32 20 69 32 29 29 0a 20 20 20 20 20 20 20 20 r2 i2)).
1bf40 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf50 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 63 6e (next cn
1bf60 6b 20 69 6e 69 74 20 73 72 63 32 20 73 74 72 32 k init src2 str2
1bf70 20 28 2b 20 69 32 20 31 29 20 65 6e 64 32 0a 20 (+ i2 1) end2.
1bf80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bfa0 20 20 20 20 20 6d 61 74 63 68 65 73 20 66 61 69 matches fai
1bfb0 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 l).
1bfc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bfd0 20 20 20 28 66 61 69 6c 29 29 29 29 0a 20 20 20 (fail)))).
1bfe0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bff0 20 20 20 28 66 61 69 6c 29 29 29 0a 20 20 20 20 (fail))).
1c000 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
1c010 28 63 68 61 72 3d 3f 20 73 72 65 20 28 73 74 72 (char=? sre (str
1c020 69 6e 67 2d 72 65 66 20 73 74 72 20 69 29 29 0a ing-ref str i)).
1c030 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c040 20 20 20 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e (next cnk in
1c050 69 74 20 73 72 63 20 73 74 72 20 28 2b 20 69 20 it src str (+ i
1c060 31 29 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 1) end matches f
1c070 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 20 ail).
1c080 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 (fail))
1c090 29 29 0a 20 20 20 20 20 20 20 20 20 20 29 29 0a )). )).
1c0a0 20 20 20 20 20 28 28 73 74 72 69 6e 67 3f 20 73 ((string? s
1c0b0 72 65 29 0a 20 20 20 20 20 20 28 72 65 63 20 28 re). (rec (
1c0c0 73 72 65 2d 73 65 71 75 65 6e 63 65 20 28 73 74 sre-sequence (st
1c0d0 72 69 6e 67 2d 3e 6c 69 73 74 20 73 72 65 29 29 ring->list sre))
1c0e0 29 0a 3b 3b 20 20 20 20 20 20 20 28 69 66 20 28 ).;; (if (
1c0f0 66 6c 61 67 2d 73 65 74 3f 20 66 6c 61 67 73 20 flag-set? flags
1c100 7e 63 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 ~case-insensitiv
1c110 65 3f 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 e?).;;
1c120 20 28 72 65 63 20 28 73 72 65 2d 73 65 71 75 65 (rec (sre-seque
1c130 6e 63 65 20 28 73 74 72 69 6e 67 2d 3e 6c 69 73 nce (string->lis
1c140 74 20 73 72 65 29 29 29 0a 3b 3b 20 20 20 20 20 t sre))).;;
1c150 20 20 20 20 20 20 28 6c 65 74 20 28 28 6c 65 6e (let ((len
1c160 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
1c170 73 72 65 29 29 29 0a 3b 3b 20 20 20 20 20 20 20 sre))).;;
1c180 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 63 (lambda (c
1c190 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 20 nk init src str
1c1a0 69 20 65 6e 64 20 6d 61 74 63 68 65 73 20 66 61 i end matches fa
1c1b0 69 6c 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 il).;;
1c1c0 20 20 20 20 20 28 69 66 20 28 61 6e 64 20 28 3c (if (and (<
1c1d0 3d 20 28 2b 20 69 20 6c 65 6e 29 20 65 6e 64 29 = (+ i len) end)
1c1e0 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 .;;
1c1f0 20 20 20 20 20 20 20 20 20 20 20 28 25 73 75 62 (%sub
1c200 73 74 72 69 6e 67 3d 3f 20 73 72 65 20 73 74 72 string=? sre str
1c210 20 30 20 69 20 6c 65 6e 29 29 0a 3b 3b 20 20 20 0 i len)).;;
1c220 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c230 28 6e 65 78 74 20 73 74 72 20 28 2b 20 69 20 6c (next str (+ i l
1c240 65 6e 29 20 6d 61 74 63 68 65 73 20 66 61 69 6c en) matches fail
1c250 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 ).;;
1c260 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 (fail))))
1c270 29 0a 20 20 20 20 20 20 29 0a 20 20 20 20 20 28 ). ). (
1c280 65 6c 73 65 0a 20 20 20 20 20 20 28 65 72 72 6f else. (erro
1c290 72 20 22 75 6e 6b 6e 6f 77 6e 20 72 65 67 65 78 r "unknown regex
1c2a0 70 22 20 73 72 65 29 29 29 29 29 0a 0a 3b 3b 3b p" sre)))))..;;;
1c2b0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1c2c0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1c2d0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1c2e0 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1c2f0 3b 3b 3b 3b 3b 0a 3b 3b 20 53 69 6d 70 6c 65 20 ;;;;;.;; Simple
1c300 63 68 61 72 61 63 74 65 72 20 73 65 74 73 20 61 character sets a
1c310 73 20 6c 69 73 74 73 20 6f 66 20 72 61 6e 67 65 s lists of range
1c320 73 2c 20 61 73 20 75 73 65 64 20 69 6e 20 74 68 s, as used in th
1c330 65 20 4e 46 41 2f 44 46 41 0a 3b 3b 20 63 6f 6d e NFA/DFA.;; com
1c340 70 69 6c 61 74 69 6f 6e 2e 20 20 54 68 69 73 20 pilation. This
1c350 69 73 20 6e 6f 74 20 65 73 70 65 63 69 61 6c 6c is not especiall
1c360 79 20 65 66 66 69 63 69 65 6e 74 2c 20 62 75 74 y efficient, but
1c370 20 69 73 20 70 6f 72 74 61 62 6c 65 20 61 6e 64 is portable and
1c380 0a 3b 3b 20 73 63 61 6c 61 62 6c 65 20 66 6f 72 .;; scalable for
1c390 20 61 6e 79 20 72 61 6e 67 65 20 6f 66 20 63 68 any range of ch
1c3a0 61 72 61 63 74 65 72 20 73 65 74 73 2e 0a 0a 28 aracter sets...(
1c3b0 64 65 66 69 6e 65 20 28 73 72 65 2d 63 73 65 74 define (sre-cset
1c3c0 2d 3e 70 72 6f 63 65 64 75 72 65 20 63 73 65 74 ->procedure cset
1c3d0 20 6e 65 78 74 29 0a 20 20 28 6c 61 6d 62 64 61 next). (lambda
1c3e0 20 28 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 (cnk init src s
1c3f0 74 72 20 69 20 65 6e 64 20 6d 61 74 63 68 65 73 tr i end matches
1c400 20 66 61 69 6c 29 0a 20 20 20 20 28 69 66 20 28 fail). (if (
1c410 3c 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 20 < i end).
1c420 20 28 69 66 20 28 63 73 65 74 2d 63 6f 6e 74 61 (if (cset-conta
1c430 69 6e 73 3f 20 63 73 65 74 20 28 73 74 72 69 6e ins? cset (strin
1c440 67 2d 72 65 66 20 73 74 72 20 69 29 29 0a 20 20 g-ref str i)).
1c450 20 20 20 20 20 20 20 20 20 20 28 6e 65 78 74 20 (next
1c460 63 6e 6b 20 69 6e 69 74 20 73 72 63 20 73 74 72 cnk init src str
1c470 20 28 2b 20 69 20 31 29 20 65 6e 64 20 6d 61 74 (+ i 1) end mat
1c480 63 68 65 73 20 66 61 69 6c 29 0a 20 20 20 20 20 ches fail).
1c490 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 0a 20 (fail)).
1c4a0 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 72 (let ((sr
1c4b0 63 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 65 74 c2 ((chunker-get
1c4c0 2d 6e 65 78 74 20 63 6e 6b 29 20 73 72 63 29 29 -next cnk) src))
1c4d0 29 0a 20 20 20 20 20 20 20 20 20 20 28 69 66 20 ). (if
1c4e0 73 72 63 32 0a 20 20 20 20 20 20 20 20 20 20 20 src2.
1c4f0 20 20 20 28 6c 65 74 20 28 28 73 74 72 32 20 28 (let ((str2 (
1c500 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 73 74 72 (chunker-get-str
1c510 20 63 6e 6b 29 20 73 72 63 32 29 29 0a 20 20 20 cnk) src2)).
1c520 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c530 20 28 69 32 20 28 28 63 68 75 6e 6b 65 72 2d 67 (i2 ((chunker-g
1c540 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 20 73 72 et-start cnk) sr
1c550 63 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 c2)).
1c560 20 20 20 20 20 20 20 20 20 28 65 6e 64 32 20 28 (end2 (
1c570 28 63 68 75 6e 6b 65 72 2d 67 65 74 2d 65 6e 64 (chunker-get-end
1c580 20 63 6e 6b 29 20 73 72 63 32 29 29 29 0a 20 20 cnk) src2))).
1c590 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1c5a0 66 20 28 63 73 65 74 2d 63 6f 6e 74 61 69 6e 73 f (cset-contains
1c5b0 3f 20 63 73 65 74 20 28 73 74 72 69 6e 67 2d 72 ? cset (string-r
1c5c0 65 66 20 73 74 72 32 20 69 32 29 29 0a 20 20 20 ef str2 i2)).
1c5d0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c5e0 20 28 6e 65 78 74 20 63 6e 6b 20 69 6e 69 74 20 (next cnk init
1c5f0 73 72 63 32 20 73 74 72 32 20 28 2b 20 69 32 20 src2 str2 (+ i2
1c600 31 29 20 65 6e 64 32 20 6d 61 74 63 68 65 73 20 1) end2 matches
1c610 66 61 69 6c 29 0a 20 20 20 20 20 20 20 20 20 20 fail).
1c620 20 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 (fail)
1c630 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1c640 20 28 66 61 69 6c 29 29 29 29 29 29 0a 0a 28 64 (fail))))))..(d
1c650 65 66 69 6e 65 20 28 70 6c 69 73 74 2d 3e 61 6c efine (plist->al
1c660 69 73 74 20 6c 73 29 0a 20 20 28 6c 65 74 20 6c ist ls). (let l
1c670 70 20 28 28 6c 73 20 6c 73 29 20 28 72 65 73 20 p ((ls ls) (res
1c680 27 28 29 29 29 0a 20 20 20 20 28 69 66 20 28 6e '())). (if (n
1c690 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 ull? ls).
1c6a0 20 28 72 65 76 65 72 73 65 20 72 65 73 29 0a 20 (reverse res).
1c6b0 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 64 72 (lp (cddr
1c6c0 20 6c 73 29 20 28 63 6f 6e 73 20 28 63 6f 6e 73 ls) (cons (cons
1c6d0 20 28 63 61 72 20 6c 73 29 20 28 63 61 64 72 20 (car ls) (cadr
1c6e0 6c 73 29 29 20 72 65 73 29 29 29 29 29 0a 0a 28 ls)) res)))))..(
1c6f0 64 65 66 69 6e 65 20 28 61 6c 69 73 74 2d 3e 70 define (alist->p
1c700 6c 69 73 74 20 6c 73 29 0a 20 20 28 6c 65 74 20 list ls). (let
1c710 6c 70 20 28 28 6c 73 20 6c 73 29 20 28 72 65 73 lp ((ls ls) (res
1c720 20 27 28 29 29 29 0a 20 20 20 20 28 69 66 20 28 '())). (if (
1c730 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 null? ls).
1c740 20 20 28 72 65 76 65 72 73 65 20 72 65 73 29 0a (reverse res).
1c750 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 72 (lp (cdr
1c760 20 6c 73 29 20 28 63 6f 6e 73 20 28 63 64 61 72 ls) (cons (cdar
1c770 20 6c 73 29 20 28 63 6f 6e 73 20 28 63 61 61 72 ls) (cons (caar
1c780 20 6c 73 29 20 72 65 73 29 29 29 29 29 29 0a 0a ls) res))))))..
1c790 28 64 65 66 69 6e 65 20 28 73 72 65 2d 3e 63 73 (define (sre->cs
1c7a0 65 74 20 73 72 65 20 2e 20 6f 29 0a 20 20 28 6c et sre . o). (l
1c7b0 65 74 20 6c 70 20 28 28 73 72 65 20 73 72 65 29 et lp ((sre sre)
1c7c0 20 28 63 69 3f 20 28 61 6e 64 20 28 70 61 69 72 (ci? (and (pair
1c7d0 3f 20 6f 29 20 28 63 61 72 20 6f 29 29 29 29 0a ? o) (car o)))).
1c7e0 20 20 20 20 28 64 65 66 69 6e 65 20 28 72 65 63 (define (rec
1c7f0 20 73 72 65 29 20 28 6c 70 20 73 72 65 20 63 69 sre) (lp sre ci
1c800 3f 29 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 ?)). (cond.
1c810 20 20 20 28 28 70 61 69 72 3f 20 73 72 65 29 0a ((pair? sre).
1c820 20 20 20 20 20 20 28 69 66 20 28 73 74 72 69 6e (if (strin
1c830 67 3f 20 28 63 61 72 20 73 72 65 29 29 0a 20 20 g? (car sre)).
1c840 20 20 20 20 20 20 20 20 28 69 66 20 63 69 3f 0a (if ci?.
1c850 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
1c860 73 65 74 2d 63 61 73 65 2d 69 6e 73 65 6e 73 69 set-case-insensi
1c870 74 69 76 65 20 28 73 74 72 69 6e 67 2d 3e 6c 69 tive (string->li
1c880 73 74 20 28 63 61 72 20 73 72 65 29 29 29 0a 20 st (car sre))).
1c890 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 74 (st
1c8a0 72 69 6e 67 2d 3e 6c 69 73 74 20 28 63 61 72 20 ring->list (car
1c8b0 73 72 65 29 29 29 0a 20 20 20 20 20 20 20 20 20 sre))).
1c8c0 20 28 63 61 73 65 20 28 63 61 72 20 73 72 65 29 (case (car sre)
1c8d0 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 7e . ((~
1c8e0 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
1c8f0 63 73 65 74 2d 63 6f 6d 70 6c 65 6d 65 6e 74 0a cset-complement.
1c900 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 (f
1c910 6f 6c 64 20 63 73 65 74 2d 75 6e 69 6f 6e 20 28 old cset-union (
1c920 72 65 63 20 28 63 61 64 72 20 73 72 65 29 29 20 rec (cadr sre))
1c930 28 6d 61 70 20 72 65 63 20 28 63 64 64 72 20 73 (map rec (cddr s
1c940 72 65 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 re))))).
1c950 20 20 20 20 28 28 26 29 0a 20 20 20 20 20 20 20 ((&).
1c960 20 20 20 20 20 20 28 66 6f 6c 64 20 63 73 65 74 (fold cset
1c970 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 28 72 -intersection (r
1c980 65 63 20 28 63 61 64 72 20 73 72 65 29 29 20 28 ec (cadr sre)) (
1c990 6d 61 70 20 72 65 63 20 28 63 64 64 72 20 73 72 map rec (cddr sr
1c9a0 65 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 e)))).
1c9b0 20 20 28 28 2d 29 0a 20 20 20 20 20 20 20 20 20 ((-).
1c9c0 20 20 20 20 28 66 6f 6c 64 20 28 6c 61 6d 62 64 (fold (lambd
1c9d0 61 20 28 78 20 72 65 73 29 20 28 63 73 65 74 2d a (x res) (cset-
1c9e0 64 69 66 66 65 72 65 6e 63 65 20 72 65 73 20 78 difference res x
1c9f0 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1ca00 20 20 20 20 20 20 28 72 65 63 20 28 63 61 64 72 (rec (cadr
1ca10 20 73 72 65 29 29 0a 20 20 20 20 20 20 20 20 20 sre)).
1ca20 20 20 20 20 20 20 20 20 20 20 28 6d 61 70 20 72 (map r
1ca30 65 63 20 28 63 64 64 72 20 73 72 65 29 29 29 29 ec (cddr sre))))
1ca40 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 2f . ((/
1ca50 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
1ca60 6c 65 74 20 28 28 72 65 73 20 28 70 6c 69 73 74 let ((res (plist
1ca70 2d 3e 61 6c 69 73 74 20 28 73 72 65 2d 66 6c 61 ->alist (sre-fla
1ca80 74 74 65 6e 2d 72 61 6e 67 65 73 20 28 63 64 72 tten-ranges (cdr
1ca90 20 73 72 65 29 29 29 29 29 0a 20 20 20 20 20 20 sre))))).
1caa0 20 20 20 20 20 20 20 20 20 28 69 66 20 63 69 3f (if ci?
1cab0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1cac0 20 20 20 20 28 63 73 65 74 2d 63 61 73 65 2d 69 (cset-case-i
1cad0 6e 73 65 6e 73 69 74 69 76 65 20 72 65 73 29 0a nsensitive res).
1cae0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1caf0 20 20 20 72 65 73 29 29 29 0a 20 20 20 20 20 20 res))).
1cb00 20 20 20 20 20 20 28 28 6f 72 29 0a 20 20 20 20 ((or).
1cb10 20 20 20 20 20 20 20 20 20 28 66 6f 6c 64 20 63 (fold c
1cb20 73 65 74 2d 75 6e 69 6f 6e 20 28 72 65 63 20 28 set-union (rec (
1cb30 63 61 64 72 20 73 72 65 29 29 20 28 6d 61 70 20 cadr sre)) (map
1cb40 72 65 63 20 28 63 64 64 72 20 73 72 65 29 29 29 rec (cddr sre)))
1cb50 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ). ((
1cb60 77 2f 63 61 73 65 29 0a 20 20 20 20 20 20 20 20 w/case).
1cb70 20 20 20 20 20 28 6c 70 20 28 73 72 65 2d 61 6c (lp (sre-al
1cb80 74 65 72 6e 61 74 65 20 28 63 64 72 20 73 72 65 ternate (cdr sre
1cb90 29 29 20 23 66 29 29 0a 20 20 20 20 20 20 20 20 )) #f)).
1cba0 20 20 20 20 28 28 77 2f 6e 6f 63 61 73 65 29 0a ((w/nocase).
1cbb0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 70 (lp
1cbc0 20 28 73 72 65 2d 61 6c 74 65 72 6e 61 74 65 20 (sre-alternate
1cbd0 28 63 64 72 20 73 72 65 29 29 20 23 74 29 29 0a (cdr sre)) #t)).
1cbe0 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
1cbf0 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 e. (
1cc00 65 72 72 6f 72 20 22 6e 6f 74 20 61 20 76 61 6c error "not a val
1cc10 69 64 20 73 72 65 20 63 68 61 72 2d 73 65 74 20 id sre char-set
1cc20 6f 70 65 72 61 74 6f 72 22 20 73 72 65 29 29 29 operator" sre)))
1cc30 29 29 0a 20 20 20 20 20 28 28 63 68 61 72 3f 20 )). ((char?
1cc40 73 72 65 29 20 28 72 65 63 20 28 6c 69 73 74 20 sre) (rec (list
1cc50 28 73 74 72 69 6e 67 20 73 72 65 29 29 29 29 0a (string sre)))).
1cc60 20 20 20 20 20 28 28 73 74 72 69 6e 67 3f 20 73 ((string? s
1cc70 72 65 29 20 28 72 65 63 20 28 6c 69 73 74 20 73 re) (rec (list s
1cc80 72 65 29 29 29 0a 20 20 20 20 20 28 65 6c 73 65 re))). (else
1cc90 0a 20 20 20 20 20 20 28 6c 65 74 20 28 28 63 65 . (let ((ce
1cca0 6c 6c 20 28 61 73 73 71 20 73 72 65 20 73 72 65 ll (assq sre sre
1ccb0 2d 6e 61 6d 65 64 2d 64 65 66 69 6e 69 74 69 6f -named-definitio
1ccc0 6e 73 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 ns))). (i
1ccd0 66 20 63 65 6c 6c 0a 20 20 20 20 20 20 20 20 20 f cell.
1cce0 20 20 20 28 72 65 63 20 28 63 64 72 20 63 65 6c (rec (cdr cel
1ccf0 6c 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 l)).
1cd00 28 65 72 72 6f 72 20 22 6e 6f 74 20 61 20 76 61 (error "not a va
1cd10 6c 69 64 20 73 72 65 20 63 68 61 72 2d 73 65 74 lid sre char-set
1cd20 22 20 73 72 65 29 29 29 29 29 29 29 0a 0a 3b 3b " sre)))))))..;;
1cd30 3b 3b 20 61 6e 6f 74 68 65 72 20 64 65 62 75 67 ;; another debug
1cd40 67 69 6e 67 20 75 74 69 6c 69 74 79 0a 3b 3b 20 ging utility.;;
1cd50 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d 3e 73 (define (cset->s
1cd60 72 65 20 63 73 65 74 29 0a 3b 3b 20 20 20 28 6c re cset).;; (l
1cd70 65 74 20 6c 70 20 28 28 6c 73 20 63 73 65 74 29 et lp ((ls cset)
1cd80 20 28 63 68 61 72 73 20 27 28 29 29 20 28 72 61 (chars '()) (ra
1cd90 6e 67 65 73 20 27 28 29 29 29 0a 3b 3b 20 20 20 nges '())).;;
1cda0 20 20 28 63 6f 6e 64 0a 3b 3b 20 20 20 20 20 20 (cond.;;
1cdb0 28 28 6e 75 6c 6c 3f 20 6c 73 29 0a 3b 3b 20 20 ((null? ls).;;
1cdc0 20 20 20 20 20 28 73 72 65 2d 61 6c 74 65 72 6e (sre-altern
1cdd0 61 74 65 0a 3b 3b 20 20 20 20 20 20 20 20 28 61 ate.;; (a
1cde0 70 70 65 6e 64 0a 3b 3b 20 20 20 20 20 20 20 20 ppend.;;
1cdf0 20 28 69 66 20 28 70 61 69 72 3f 20 63 68 61 72 (if (pair? char
1ce00 73 29 20 28 6c 69 73 74 20 28 6c 69 73 74 20 28 s) (list (list (
1ce10 6c 69 73 74 2d 3e 73 74 72 69 6e 67 20 63 68 61 list->string cha
1ce20 72 73 29 29 29 20 27 28 29 29 0a 3b 3b 20 20 20 rs))) '()).;;
1ce30 20 20 20 20 20 20 28 69 66 20 28 70 61 69 72 3f (if (pair?
1ce40 20 72 61 6e 67 65 73 29 20 28 6c 69 73 74 20 28 ranges) (list (
1ce50 63 6f 6e 73 20 27 2f 20 28 61 6c 69 73 74 2d 3e cons '/ (alist->
1ce60 70 6c 69 73 74 20 72 61 6e 67 65 73 29 29 29 20 plist ranges)))
1ce70 27 28 29 29 29 29 29 0a 3b 3b 20 20 20 20 20 20 '())))).;;
1ce80 28 28 63 68 61 72 3f 20 28 63 61 72 20 6c 73 29 ((char? (car ls)
1ce90 29 20 28 6c 70 20 28 63 64 72 20 6c 73 29 20 28 ) (lp (cdr ls) (
1cea0 63 6f 6e 73 20 28 63 61 72 20 6c 73 29 20 63 68 cons (car ls) ch
1ceb0 61 72 73 29 20 72 61 6e 67 65 73 29 29 0a 3b 3b ars) ranges)).;;
1cec0 20 20 20 20 20 20 28 65 6c 73 65 20 28 6c 70 20 (else (lp
1ced0 28 63 64 72 20 6c 73 29 20 63 68 61 72 73 20 28 (cdr ls) chars (
1cee0 63 6f 6e 73 20 28 63 61 72 20 6c 73 29 20 72 61 cons (car ls) ra
1cef0 6e 67 65 73 29 29 29 29 29 29 0a 0a 28 64 65 66 nges))))))..(def
1cf00 69 6e 65 20 28 63 73 65 74 2d 63 6f 6e 74 61 69 ine (cset-contai
1cf10 6e 73 3f 20 63 73 65 74 20 63 68 29 0a 20 20 28 ns? cset ch). (
1cf20 66 69 6e 64 20 28 6c 61 6d 62 64 61 20 28 78 29 find (lambda (x)
1cf30 0a 20 20 20 20 20 20 20 20 20 20 28 6f 72 20 28 . (or (
1cf40 65 71 76 3f 20 78 20 63 68 29 0a 20 20 20 20 20 eqv? x ch).
1cf50 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 70 (and (p
1cf60 61 69 72 3f 20 78 29 20 28 63 68 61 72 3c 3d 3f air? x) (char<=?
1cf70 20 28 63 61 72 20 78 29 20 63 68 29 20 28 63 68 (car x) ch) (ch
1cf80 61 72 3c 3d 3f 20 63 68 20 28 63 64 72 20 78 29 ar<=? ch (cdr x)
1cf90 29 29 29 29 0a 20 20 20 20 20 20 20 20 63 73 65 )))). cse
1cfa0 74 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 73 t))..(define (cs
1cfb0 65 74 2d 72 61 6e 67 65 20 78 29 0a 20 20 28 69 et-range x). (i
1cfc0 66 20 28 63 68 61 72 3f 20 78 29 20 28 63 6f 6e f (char? x) (con
1cfd0 73 20 78 20 78 29 20 78 29 29 0a 0a 28 64 65 66 s x x) x))..(def
1cfe0 69 6e 65 20 28 63 68 61 72 2d 72 61 6e 67 65 73 ine (char-ranges
1cff0 2d 6f 76 65 72 6c 61 70 3f 20 61 20 62 29 0a 20 -overlap? a b).
1d000 20 28 69 66 20 28 70 61 69 72 3f 20 61 29 0a 20 (if (pair? a).
1d010 20 20 20 20 20 28 69 66 20 28 70 61 69 72 3f 20 (if (pair?
1d020 62 29 0a 20 20 20 20 20 20 20 20 20 20 28 6f 72 b). (or
1d030 20 28 61 6e 64 20 28 63 68 61 72 3c 3d 3f 20 28 (and (char<=? (
1d040 63 61 72 20 61 29 20 28 63 64 72 20 62 29 29 20 car a) (cdr b))
1d050 28 63 68 61 72 3c 3d 3f 20 28 63 61 72 20 62 29 (char<=? (car b)
1d060 20 28 63 64 72 20 61 29 29 29 0a 20 20 20 20 20 (cdr a))).
1d070 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 28 63 (and (c
1d080 68 61 72 3c 3d 3f 20 28 63 64 72 20 62 29 20 28 har<=? (cdr b) (
1d090 63 61 72 20 61 29 29 20 28 63 68 61 72 3c 3d 3f car a)) (char<=?
1d0a0 20 28 63 64 72 20 61 29 20 28 63 61 72 20 62 29 (cdr a) (car b)
1d0b0 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 61 ))). (a
1d0c0 6e 64 20 28 63 68 61 72 3c 3d 3f 20 28 63 61 72 nd (char<=? (car
1d0d0 20 61 29 20 62 29 20 28 63 68 61 72 3c 3d 3f 20 a) b) (char<=?
1d0e0 62 20 28 63 64 72 20 61 29 29 29 29 0a 20 20 20 b (cdr a)))).
1d0f0 20 20 20 28 69 66 20 28 70 61 69 72 3f 20 62 29 (if (pair? b)
1d100 0a 20 20 20 20 20 20 20 20 20 20 28 63 68 61 72 . (char
1d110 2d 72 61 6e 67 65 73 2d 6f 76 65 72 6c 61 70 3f -ranges-overlap?
1d120 20 62 20 61 29 0a 20 20 20 20 20 20 20 20 20 20 b a).
1d130 28 65 71 76 3f 20 61 20 62 29 29 29 29 0a 0a 28 (eqv? a b))))..(
1d140 64 65 66 69 6e 65 20 28 63 68 61 72 2d 72 61 6e define (char-ran
1d150 67 65 73 2d 75 6e 69 6f 6e 20 61 20 62 29 0a 20 ges-union a b).
1d160 20 28 63 6f 6e 73 20 28 69 66 20 28 63 68 61 72 (cons (if (char
1d170 3c 3d 3f 20 28 63 61 72 20 61 29 20 28 63 61 72 <=? (car a) (car
1d180 20 62 29 29 20 28 63 61 72 20 61 29 20 28 63 61 b)) (car a) (ca
1d190 72 20 62 29 29 0a 20 20 20 20 20 20 20 20 28 69 r b)). (i
1d1a0 66 20 28 63 68 61 72 3e 3d 3f 20 28 63 64 72 20 f (char>=? (cdr
1d1b0 61 29 20 28 63 64 72 20 62 29 29 20 28 63 64 72 a) (cdr b)) (cdr
1d1c0 20 61 29 20 28 63 64 72 20 62 29 29 29 29 0a 0a a) (cdr b))))..
1d1d0 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d 75 6e (define (cset-un
1d1e0 69 6f 6e 20 61 20 62 29 0a 20 20 28 63 6f 6e 64 ion a b). (cond
1d1f0 20 28 28 6e 75 6c 6c 3f 20 62 29 20 61 29 0a 20 ((null? b) a).
1d200 20 20 20 20 20 20 20 28 28 66 69 6e 64 2d 74 61 ((find-ta
1d210 69 6c 20 28 6c 61 6d 62 64 61 20 28 78 29 20 28 il (lambda (x) (
1d220 63 68 61 72 2d 72 61 6e 67 65 73 2d 6f 76 65 72 char-ranges-over
1d230 6c 61 70 3f 20 78 20 28 63 61 72 20 62 29 29 29 lap? x (car b)))
1d240 20 61 29 0a 20 20 20 20 20 20 20 20 20 3d 3e 20 a). =>
1d250 28 6c 61 6d 62 64 61 20 28 6c 73 29 0a 20 20 20 (lambda (ls).
1d260 20 20 20 20 20 20 20 20 20 20 20 28 63 73 65 74 (cset
1d270 2d 75 6e 69 6f 6e 0a 20 20 20 20 20 20 20 20 20 -union.
1d280 20 20 20 20 20 20 28 63 73 65 74 2d 75 6e 69 6f (cset-unio
1d290 6e 20 28 61 70 70 65 6e 64 20 28 74 61 6b 65 2d n (append (take-
1d2a0 75 70 2d 74 6f 20 61 20 6c 73 29 20 28 63 64 72 up-to a ls) (cdr
1d2b0 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 ls)).
1d2c0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d2d0 20 28 6c 69 73 74 20 28 63 68 61 72 2d 72 61 6e (list (char-ran
1d2e0 67 65 73 2d 75 6e 69 6f 6e 20 28 63 73 65 74 2d ges-union (cset-
1d2f0 72 61 6e 67 65 20 28 63 61 72 20 6c 73 29 29 0a range (car ls)).
1d300 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d310 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d320 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d330 20 20 20 20 28 63 73 65 74 2d 72 61 6e 67 65 20 (cset-range
1d340 28 63 61 72 20 62 29 29 29 29 29 0a 20 20 20 20 (car b))))).
1d350 20 20 20 20 20 20 20 20 20 20 20 28 63 64 72 20 (cdr
1d360 62 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 65 b)))). (e
1d370 6c 73 65 20 28 63 73 65 74 2d 75 6e 69 6f 6e 20 lse (cset-union
1d380 28 63 6f 6e 73 20 28 63 61 72 20 62 29 20 61 29 (cons (car b) a)
1d390 20 28 63 64 72 20 62 29 29 29 29 29 0a 0a 28 64 (cdr b)))))..(d
1d3a0 65 66 69 6e 65 20 28 63 73 65 74 2d 64 69 66 66 efine (cset-diff
1d3b0 65 72 65 6e 63 65 20 61 20 62 29 0a 20 20 28 63 erence a b). (c
1d3c0 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 62 29 20 61 ond ((null? b) a
1d3d0 29 0a 20 20 20 20 20 20 20 20 28 28 6e 6f 74 20 ). ((not
1d3e0 28 63 61 72 20 62 29 29 20 28 63 73 65 74 2d 64 (car b)) (cset-d
1d3f0 69 66 66 65 72 65 6e 63 65 20 61 20 28 63 64 72 ifference a (cdr
1d400 20 62 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 b))). ((
1d410 66 69 6e 64 2d 74 61 69 6c 20 28 6c 61 6d 62 64 find-tail (lambd
1d420 61 20 28 78 29 20 28 63 68 61 72 2d 72 61 6e 67 a (x) (char-rang
1d430 65 73 2d 6f 76 65 72 6c 61 70 3f 20 78 20 28 63 es-overlap? x (c
1d440 61 72 20 62 29 29 29 20 61 29 0a 20 20 20 20 20 ar b))) a).
1d450 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 28 => (lambda (
1d460 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
1d470 20 20 28 61 70 70 6c 79 0a 20 20 20 20 20 20 20 (apply.
1d480 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 (lambda
1d490 28 6c 65 66 74 31 20 6c 65 66 74 32 20 73 61 6d (left1 left2 sam
1d4a0 65 20 72 69 67 68 74 31 20 72 69 67 68 74 32 29 e right1 right2)
1d4b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d4c0 20 20 28 6c 65 74 2a 20 28 28 61 20 28 61 70 70 (let* ((a (app
1d4d0 65 6e 64 20 28 74 61 6b 65 2d 75 70 2d 74 6f 20 end (take-up-to
1d4e0 61 20 6c 73 29 20 28 63 64 72 20 6c 73 29 29 29 a ls) (cdr ls)))
1d4f0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d500 20 20 20 20 20 20 20 20 20 28 61 20 28 69 66 20 (a (if
1d510 6c 65 66 74 31 20 28 63 6f 6e 73 20 6c 65 66 74 left1 (cons left
1d520 31 20 61 29 20 61 29 29 0a 20 20 20 20 20 20 20 1 a) a)).
1d530 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d540 20 28 61 20 28 69 66 20 6c 65 66 74 32 20 28 63 (a (if left2 (c
1d550 6f 6e 73 20 6c 65 66 74 32 20 61 29 20 61 29 29 ons left2 a) a))
1d560 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1d570 20 20 20 20 20 20 20 20 20 28 62 20 28 69 66 20 (b (if
1d580 72 69 67 68 74 31 20 28 63 73 65 74 2d 75 6e 69 right1 (cset-uni
1d590 6f 6e 20 62 20 28 6c 69 73 74 20 72 69 67 68 74 on b (list right
1d5a0 31 29 29 20 62 29 29 0a 20 20 20 20 20 20 20 20 1)) b)).
1d5b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d5c0 28 62 20 28 69 66 20 72 69 67 68 74 32 20 28 63 (b (if right2 (c
1d5d0 73 65 74 2d 75 6e 69 6f 6e 20 62 20 28 6c 69 73 set-union b (lis
1d5e0 74 20 72 69 67 68 74 32 29 29 20 62 29 29 29 0a t right2)) b))).
1d5f0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d600 20 20 20 28 63 73 65 74 2d 64 69 66 66 65 72 65 (cset-differe
1d610 6e 63 65 20 61 20 62 29 29 29 0a 20 20 20 20 20 nce a b))).
1d620 20 20 20 20 20 20 20 20 20 20 28 69 6e 74 65 72 (inter
1d630 73 65 63 74 2d 63 68 61 72 2d 72 61 6e 67 65 73 sect-char-ranges
1d640 20 28 63 73 65 74 2d 72 61 6e 67 65 20 28 63 61 (cset-range (ca
1d650 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 r ls)).
1d660 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d670 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 73 (cs
1d680 65 74 2d 72 61 6e 67 65 20 28 63 61 72 20 62 29 et-range (car b)
1d690 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 65 ))))). (e
1d6a0 6c 73 65 20 28 63 73 65 74 2d 64 69 66 66 65 72 lse (cset-differ
1d6b0 65 6e 63 65 20 61 20 28 63 64 72 20 62 29 29 29 ence a (cdr b)))
1d6c0 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 73 65 ))..(define (cse
1d6d0 74 2d 69 6e 74 65 72 73 65 63 74 69 6f 6e 20 61 t-intersection a
1d6e0 20 62 29 0a 20 20 28 6c 65 74 20 69 6e 74 65 72 b). (let inter
1d6f0 73 65 63 74 20 28 28 61 20 61 29 20 28 62 20 62 sect ((a a) (b b
1d700 29 20 28 72 65 73 20 27 28 29 29 29 0a 20 20 20 ) (res '())).
1d710 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c 3f 20 62 (cond ((null? b
1d720 29 20 72 65 73 29 0a 20 20 20 20 20 20 20 20 20 ) res).
1d730 20 28 28 66 69 6e 64 2d 74 61 69 6c 20 28 6c 61 ((find-tail (la
1d740 6d 62 64 61 20 28 78 29 20 28 63 68 61 72 2d 72 mbda (x) (char-r
1d750 61 6e 67 65 73 2d 6f 76 65 72 6c 61 70 3f 20 78 anges-overlap? x
1d760 20 28 63 61 72 20 62 29 29 29 20 61 29 0a 20 20 (car b))) a).
1d770 20 20 20 20 20 20 20 20 20 3d 3e 20 28 6c 61 6d => (lam
1d780 62 64 61 20 28 6c 73 29 0a 20 20 20 20 20 20 20 bda (ls).
1d790 20 20 20 20 20 20 20 20 20 28 61 70 70 6c 79 0a (apply.
1d7a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d7b0 20 28 6c 61 6d 62 64 61 20 28 6c 65 66 74 31 20 (lambda (left1
1d7c0 6c 65 66 74 32 20 73 61 6d 65 20 72 69 67 68 74 left2 same right
1d7d0 31 20 72 69 67 68 74 32 29 0a 20 20 20 20 20 20 1 right2).
1d7e0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
1d7f0 74 2a 20 28 28 61 20 28 61 70 70 65 6e 64 20 28 t* ((a (append (
1d800 74 61 6b 65 2d 75 70 2d 74 6f 20 61 20 6c 73 29 take-up-to a ls)
1d810 20 28 63 64 72 20 6c 73 29 29 29 0a 20 20 20 20 (cdr ls))).
1d820 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d830 20 20 20 20 20 20 28 61 20 28 69 66 20 6c 65 66 (a (if lef
1d840 74 31 20 28 63 6f 6e 73 20 6c 65 66 74 31 20 61 t1 (cons left1 a
1d850 29 20 61 29 29 0a 20 20 20 20 20 20 20 20 20 20 ) a)).
1d860 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d870 28 61 20 28 69 66 20 6c 65 66 74 32 20 28 63 6f (a (if left2 (co
1d880 6e 73 20 6c 65 66 74 32 20 61 29 20 61 29 29 0a ns left2 a) a)).
1d890 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d8a0 20 20 20 20 20 20 20 20 20 20 28 62 20 28 69 66 (b (if
1d8b0 20 72 69 67 68 74 31 20 28 63 73 65 74 2d 75 6e right1 (cset-un
1d8c0 69 6f 6e 20 62 20 28 6c 69 73 74 20 72 69 67 68 ion b (list righ
1d8d0 74 31 29 29 20 62 29 29 0a 20 20 20 20 20 20 20 t1)) b)).
1d8e0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d8f0 20 20 20 28 62 20 28 69 66 20 72 69 67 68 74 32 (b (if right2
1d900 20 28 63 73 65 74 2d 75 6e 69 6f 6e 20 62 20 28 (cset-union b (
1d910 6c 69 73 74 20 72 69 67 68 74 32 29 29 20 62 29 list right2)) b)
1d920 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1d930 20 20 20 20 20 20 20 20 28 69 6e 74 65 72 73 65 (interse
1d940 63 74 20 61 20 62 20 28 63 73 65 74 2d 75 6e 69 ct a b (cset-uni
1d950 6f 6e 20 72 65 73 20 28 6c 69 73 74 20 73 61 6d on res (list sam
1d960 65 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 e))))).
1d970 20 20 20 20 20 20 20 20 28 69 6e 74 65 72 73 65 (interse
1d980 63 74 2d 63 68 61 72 2d 72 61 6e 67 65 73 20 28 ct-char-ranges (
1d990 63 73 65 74 2d 72 61 6e 67 65 20 28 63 61 72 20 cset-range (car
1d9a0 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls)).
1d9b0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d9c0 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 73 (cs
1d9d0 65 74 2d 72 61 6e 67 65 20 28 63 61 72 20 62 29 et-range (car b)
1d9e0 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
1d9f0 28 65 6c 73 65 20 28 69 6e 74 65 72 73 65 63 74 (else (intersect
1da00 20 61 20 28 63 64 72 20 62 29 20 72 65 73 29 29 a (cdr b) res))
1da10 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 63 73 )))..(define (cs
1da20 65 74 2d 63 6f 6d 70 6c 65 6d 65 6e 74 20 61 29 et-complement a)
1da30 0a 20 20 28 63 73 65 74 2d 64 69 66 66 65 72 65 . (cset-differe
1da40 6e 63 65 20 28 73 72 65 2d 3e 63 73 65 74 20 2a nce (sre->cset *
1da50 61 6c 6c 2d 63 68 61 72 73 2a 29 20 61 29 29 0a all-chars*) a)).
1da60 0a 28 64 65 66 69 6e 65 20 28 63 73 65 74 2d 63 .(define (cset-c
1da70 61 73 65 2d 69 6e 73 65 6e 73 69 74 69 76 65 20 ase-insensitive
1da80 61 29 0a 20 20 28 6c 65 74 20 6c 70 20 28 28 6c a). (let lp ((l
1da90 73 20 61 29 20 28 72 65 73 20 27 28 29 29 29 0a s a) (res '())).
1daa0 20 20 20 20 28 63 6f 6e 64 20 28 28 6e 75 6c 6c (cond ((null
1dab0 3f 20 6c 73 29 20 28 72 65 76 65 72 73 65 20 72 ? ls) (reverse r
1dac0 65 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 es)). (
1dad0 28 61 6e 64 20 28 63 68 61 72 3f 20 28 63 61 72 (and (char? (car
1dae0 20 6c 73 29 29 20 28 63 68 61 72 2d 61 6c 70 68 ls)) (char-alph
1daf0 61 62 65 74 69 63 3f 20 28 63 61 72 20 6c 73 29 abetic? (car ls)
1db00 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6c )). (l
1db10 65 74 20 28 28 63 32 20 28 63 68 61 72 2d 61 6c et ((c2 (char-al
1db20 74 63 61 73 65 20 28 63 61 72 20 6c 73 29 29 29 tcase (car ls)))
1db30 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1db40 20 20 28 72 65 73 20 28 63 6f 6e 73 20 28 63 61 (res (cons (ca
1db50 72 20 6c 73 29 20 72 65 73 29 29 29 0a 20 20 20 r ls) res))).
1db60 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 (lp (c
1db70 64 72 20 6c 73 29 20 28 69 66 20 28 63 73 65 74 dr ls) (if (cset
1db80 2d 63 6f 6e 74 61 69 6e 73 3f 20 72 65 73 20 63 -contains? res c
1db90 32 29 20 72 65 73 20 28 63 6f 6e 73 20 63 32 20 2) res (cons c2
1dba0 72 65 73 29 29 29 29 29 0a 20 20 20 20 20 20 20 res))))).
1dbb0 20 20 20 28 28 61 6e 64 20 28 70 61 69 72 3f 20 ((and (pair?
1dbc0 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 (car ls)).
1dbd0 20 20 20 20 20 20 20 20 20 20 28 63 68 61 72 2d (char-
1dbe0 61 6c 70 68 61 62 65 74 69 63 3f 20 28 63 61 61 alphabetic? (caa
1dbf0 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 20 20 r ls)).
1dc00 20 20 20 20 20 20 20 28 63 68 61 72 2d 61 6c 70 (char-alp
1dc10 68 61 62 65 74 69 63 3f 20 28 63 64 61 72 20 6c habetic? (cdar l
1dc20 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
1dc30 28 6c 70 20 28 63 64 72 20 6c 73 29 0a 20 20 20 (lp (cdr ls).
1dc40 20 20 20 20 20 20 20 20 20 20 20 20 28 63 73 65 (cse
1dc50 74 2d 75 6e 69 6f 6e 20 28 63 73 65 74 2d 75 6e t-union (cset-un
1dc60 69 6f 6e 20 72 65 73 20 28 6c 69 73 74 20 28 63 ion res (list (c
1dc70 61 72 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 ar ls))).
1dc80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dc90 20 20 20 20 28 6c 69 73 74 20 28 63 6f 6e 73 20 (list (cons
1dca0 28 63 68 61 72 2d 61 6c 74 63 61 73 65 20 28 63 (char-altcase (c
1dcb0 61 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 20 aar ls)).
1dcc0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dcd0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1dce0 28 63 68 61 72 2d 61 6c 74 63 61 73 65 20 28 63 (char-altcase (c
1dcf0 64 61 72 20 6c 73 29 29 29 29 29 29 29 0a 20 20 dar ls))))))).
1dd00 20 20 20 20 20 20 20 20 28 65 6c 73 65 20 28 6c (else (l
1dd10 70 20 28 63 64 72 20 6c 73 29 20 28 63 73 65 74 p (cdr ls) (cset
1dd20 2d 75 6e 69 6f 6e 20 72 65 73 20 28 6c 69 73 74 -union res (list
1dd30 20 28 63 61 72 20 6c 73 29 29 29 29 29 29 29 29 (car ls))))))))
1dd40 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ..;;;;;;;;;;;;;;
1dd50 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1dd60 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1dd70 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
1dd80 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 6d 61 ;;;;;;;;;;.;; ma
1dd90 74 63 68 20 61 6e 64 20 72 65 70 6c 61 63 65 20 tch and replace
1dda0 75 74 69 6c 69 74 69 65 73 20 28 63 75 72 72 65 utilities (curre
1ddb0 6e 74 6c 79 20 73 74 72 69 6e 67 73 20 6f 6e 6c ntly strings onl
1ddc0 79 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 y)..(define (irr
1ddd0 65 67 65 78 2d 66 6f 6c 64 20 69 72 78 20 6b 6f egex-fold irx ko
1dde0 6e 73 20 6b 6e 69 6c 20 73 74 72 20 2e 20 6f 29 ns knil str . o)
1ddf0 0a 20 20 28 6c 65 74 2a 20 28 28 69 72 78 20 28 . (let* ((irx (
1de00 69 72 72 65 67 65 78 20 69 72 78 29 29 0a 20 20 irregex irx)).
1de10 20 20 20 20 20 20 20 28 6d 61 74 63 68 65 73 20 (matches
1de20 28 69 72 72 65 67 65 78 2d 6e 65 77 2d 6d 61 74 (irregex-new-mat
1de30 63 68 65 73 20 69 72 78 29 29 0a 20 20 20 20 20 ches irx)).
1de40 20 20 20 20 28 66 69 6e 69 73 68 20 28 6f 72 20 (finish (or
1de50 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 28 (and (pair? o) (
1de60 63 61 72 20 6f 29 29 20 28 6c 61 6d 62 64 61 20 car o)) (lambda
1de70 28 69 20 61 63 63 29 20 61 63 63 29 29 29 0a 20 (i acc) acc))).
1de80 20 20 20 20 20 20 20 20 28 73 74 61 72 74 20 28 (start (
1de90 69 66 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f if (and (pair? o
1dea0 29 20 28 70 61 69 72 3f 20 28 63 64 72 20 6f 29 ) (pair? (cdr o)
1deb0 29 29 20 28 63 61 64 72 20 6f 29 20 30 29 29 0a )) (cadr o) 0)).
1dec0 20 20 20 20 20 20 20 20 20 28 65 6e 64 20 28 69 (end (i
1ded0 66 20 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 f (and (pair? o)
1dee0 20 28 70 61 69 72 3f 20 28 63 64 72 20 6f 29 29 (pair? (cdr o))
1def0 20 28 70 61 69 72 3f 20 28 63 64 64 72 20 6f 29 (pair? (cddr o)
1df00 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
1df10 20 20 20 20 20 28 63 61 64 64 72 20 6f 29 0a 20 (caddr o).
1df20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1df30 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 (string-length
1df40 73 74 72 29 29 29 29 0a 20 20 20 20 28 69 72 72 str)))). (irr
1df50 65 67 65 78 2d 6d 61 74 63 68 2d 63 68 75 6e 6b egex-match-chunk
1df60 65 72 2d 73 65 74 21 20 6d 61 74 63 68 65 73 20 er-set! matches
1df70 69 72 72 65 67 65 78 2d 62 61 73 69 63 2d 73 74 irregex-basic-st
1df80 72 69 6e 67 2d 63 68 75 6e 6b 65 72 29 0a 20 20 ring-chunker).
1df90 20 20 28 6c 65 74 20 6c 70 20 28 28 69 20 73 74 (let lp ((i st
1dfa0 61 72 74 29 20 28 61 63 63 20 6b 6e 69 6c 29 29 art) (acc knil))
1dfb0 0a 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 . (if (>= i
1dfc0 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 20 20 end).
1dfd0 28 66 69 6e 69 73 68 20 69 20 61 63 63 29 0a 20 (finish i acc).
1dfe0 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
1dff0 6d 20 28 69 72 72 65 67 65 78 2d 73 65 61 72 63 m (irregex-searc
1e000 68 2f 6d 61 74 63 68 65 73 0a 20 20 20 20 20 20 h/matches.
1e010 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 72 ir
1e020 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 x.
1e030 20 20 20 20 20 20 69 72 72 65 67 65 78 2d 62 61 irregex-ba
1e040 73 69 63 2d 73 74 72 69 6e 67 2d 63 68 75 6e 6b sic-string-chunk
1e050 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 er.
1e060 20 20 20 20 20 20 20 28 6c 69 73 74 20 73 74 72 (list str
1e070 20 69 20 65 6e 64 29 0a 20 20 20 20 20 20 20 20 i end).
1e080 20 20 20 20 20 20 20 20 20 20 20 20 69 0a 20 20 i.
1e090 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e0a0 20 20 6d 61 74 63 68 65 73 29 29 29 0a 20 20 20 matches))).
1e0b0 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f (if (no
1e0c0 74 20 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 t m).
1e0d0 20 20 20 20 20 28 66 69 6e 69 73 68 20 69 20 61 (finish i a
1e0e0 63 63 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 cc).
1e0f0 20 20 20 20 28 6c 65 74 2a 20 28 28 65 6e 64 20 (let* ((end
1e100 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 (irregex-match-e
1e110 6e 64 2d 69 6e 64 65 78 20 6d 20 30 29 29 0a 20 nd-index m 0)).
1e120 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e130 20 20 20 20 20 20 28 61 63 63 20 28 6b 6f 6e 73 (acc (kons
1e140 20 69 20 6d 20 61 63 63 29 29 29 0a 20 20 20 20 i m acc))).
1e150 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
1e160 72 72 65 67 65 78 2d 72 65 73 65 74 2d 6d 61 74 rregex-reset-mat
1e170 63 68 65 73 21 20 6d 61 74 63 68 65 73 29 0a 20 ches! matches).
1e180 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e190 20 28 6c 70 20 65 6e 64 20 61 63 63 29 29 29 29 (lp end acc))))
1e1a0 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 ))))..(define (i
1e1b0 72 72 65 67 65 78 2d 66 6f 6c 64 2f 63 68 75 6e rregex-fold/chun
1e1c0 6b 65 64 20 69 72 78 20 6b 6f 6e 73 20 6b 6e 69 ked irx kons kni
1e1d0 6c 20 63 6e 6b 20 73 74 61 72 74 20 2e 20 6f 29 l cnk start . o)
1e1e0 0a 20 20 28 6c 65 74 2a 20 28 28 69 72 78 20 28 . (let* ((irx (
1e1f0 69 72 72 65 67 65 78 20 69 72 78 29 29 0a 20 20 irregex irx)).
1e200 20 20 20 20 20 20 20 28 6d 61 74 63 68 65 73 20 (matches
1e210 28 69 72 72 65 67 65 78 2d 6e 65 77 2d 6d 61 74 (irregex-new-mat
1e220 63 68 65 73 20 69 72 78 29 29 0a 20 20 20 20 20 ches irx)).
1e230 20 20 20 20 28 66 69 6e 69 73 68 20 28 6f 72 20 (finish (or
1e240 28 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 28 (and (pair? o) (
1e250 63 61 72 20 6f 29 29 20 28 6c 61 6d 62 64 61 20 car o)) (lambda
1e260 28 69 20 61 63 63 29 20 61 63 63 29 29 29 0a 20 (i acc) acc))).
1e270 20 20 20 20 20 20 20 20 28 69 20 28 69 66 20 28 (i (if (
1e280 61 6e 64 20 28 70 61 69 72 3f 20 6f 29 20 28 70 and (pair? o) (p
1e290 61 69 72 3f 20 28 63 64 72 20 6f 29 29 29 0a 20 air? (cdr o))).
1e2a0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1e2b0 63 61 64 72 20 6f 29 0a 20 20 20 20 20 20 20 20 cadr o).
1e2c0 20 20 20 20 20 20 20 20 28 28 63 68 75 6e 6b 65 ((chunke
1e2d0 72 2d 67 65 74 2d 73 74 61 72 74 20 63 6e 6b 29 r-get-start cnk)
1e2e0 20 73 74 61 72 74 29 29 29 29 0a 20 20 20 20 28 start)))). (
1e2f0 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 63 68 irregex-match-ch
1e300 75 6e 6b 65 72 2d 73 65 74 21 20 6d 61 74 63 68 unker-set! match
1e310 65 73 20 63 6e 6b 29 0a 20 20 20 20 28 6c 65 74 es cnk). (let
1e320 20 6c 70 20 28 28 73 74 61 72 74 20 73 74 61 72 lp ((start star
1e330 74 29 20 28 69 20 69 29 20 28 61 63 63 20 6b 6e t) (i i) (acc kn
1e340 69 6c 29 29 0a 20 20 20 20 20 20 28 69 66 20 28 il)). (if (
1e350 6e 6f 74 20 73 74 61 72 74 29 0a 20 20 20 20 20 not start).
1e360 20 20 20 20 20 28 66 69 6e 69 73 68 20 73 74 61 (finish sta
1e370 72 74 20 69 20 61 63 63 29 0a 20 20 20 20 20 20 rt i acc).
1e380 20 20 20 20 28 6c 65 74 20 28 28 6d 20 28 69 72 (let ((m (ir
1e390 72 65 67 65 78 2d 73 65 61 72 63 68 2f 6d 61 74 regex-search/mat
1e3a0 63 68 65 73 20 69 72 78 20 63 6e 6b 20 73 74 61 ches irx cnk sta
1e3b0 72 74 20 69 20 6d 61 74 63 68 65 73 29 29 29 0a rt i matches))).
1e3c0 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
1e3d0 28 6e 6f 74 20 6d 29 0a 20 20 20 20 20 20 20 20 (not m).
1e3e0 20 20 20 20 20 20 20 20 28 66 69 6e 69 73 68 20 (finish
1e3f0 73 74 61 72 74 20 69 20 61 63 63 29 0a 20 20 20 start i acc).
1e400 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le
1e410 74 2a 20 28 28 61 63 63 20 28 6b 6f 6e 73 20 73 t* ((acc (kons s
1e420 74 61 72 74 20 69 20 6d 20 61 63 63 29 29 0a 20 tart i m acc)).
1e430 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e440 20 20 20 20 20 20 28 65 6e 64 2d 73 72 63 20 28 (end-src (
1e450 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 65 6e irregex-match-en
1e460 64 2d 73 6f 75 72 63 65 20 6d 20 30 29 29 0a 20 d-source m 0)).
1e470 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e480 20 20 20 20 20 20 28 65 6e 64 2d 69 6e 64 65 78 (end-index
1e490 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 2d (irregex-match-
1e4a0 65 6e 64 2d 69 6e 64 65 78 20 6d 20 30 29 29 29 end-index m 0)))
1e4b0 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1e4c0 20 20 20 28 69 72 72 65 67 65 78 2d 72 65 73 65 (irregex-rese
1e4d0 74 2d 6d 61 74 63 68 65 73 21 20 6d 61 74 63 68 t-matches! match
1e4e0 65 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 es).
1e4f0 20 20 20 20 20 20 28 6c 70 20 65 6e 64 2d 73 72 (lp end-sr
1e500 63 20 65 6e 64 2d 69 6e 64 65 78 20 61 63 63 29 c end-index acc)
1e510 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 )))))))..(define
1e520 20 28 69 72 72 65 67 65 78 2d 72 65 70 6c 61 63 (irregex-replac
1e530 65 20 69 72 78 20 73 74 72 20 2e 20 6f 29 0a 20 e irx str . o).
1e540 20 28 6c 65 74 20 28 28 6d 20 28 69 72 72 65 67 (let ((m (irreg
1e550 65 78 2d 73 65 61 72 63 68 20 69 72 78 20 73 74 ex-search irx st
1e560 72 29 29 29 0a 20 20 20 20 28 61 6e 64 0a 20 20 r))). (and.
1e570 20 20 20 6d 0a 20 20 20 20 20 28 73 74 72 69 6e m. (strin
1e580 67 2d 63 61 74 2d 72 65 76 65 72 73 65 0a 20 20 g-cat-reverse.
1e590 20 20 20 20 28 63 6f 6e 73 20 28 73 75 62 73 74 (cons (subst
1e5a0 72 69 6e 67 20 73 74 72 20 28 69 72 72 65 67 65 ring str (irrege
1e5b0 78 2d 6d 61 74 63 68 2d 65 6e 64 2d 69 6e 64 65 x-match-end-inde
1e5c0 78 20 6d 20 30 29 20 28 73 74 72 69 6e 67 2d 6c x m 0) (string-l
1e5d0 65 6e 67 74 68 20 73 74 72 29 29 0a 20 20 20 20 ength str)).
1e5e0 20 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 (append
1e5f0 28 69 72 72 65 67 65 78 2d 61 70 70 6c 79 2d 6d (irregex-apply-m
1e600 61 74 63 68 20 6d 20 6f 29 0a 20 20 20 20 20 20 atch m o).
1e610 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
1e620 69 73 74 20 28 73 75 62 73 74 72 69 6e 67 20 73 ist (substring s
1e630 74 72 20 30 20 28 69 72 72 65 67 65 78 2d 6d 61 tr 0 (irregex-ma
1e640 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 20 tch-start-index
1e650 6d 20 30 29 29 29 0a 20 20 20 20 20 20 20 20 20 m 0))).
1e660 20 20 20 20 20 20 20 20 20 20 20 29 29 29 29 29 )))))
1e670 29 0a 0a 28 64 65 66 69 6e 65 20 28 69 72 72 65 )..(define (irre
1e680 67 65 78 2d 72 65 70 6c 61 63 65 2f 61 6c 6c 20 gex-replace/all
1e690 69 72 78 20 73 74 72 20 2e 20 6f 29 0a 20 20 28 irx str . o). (
1e6a0 69 72 72 65 67 65 78 2d 66 6f 6c 64 0a 20 20 20 irregex-fold.
1e6b0 69 72 78 0a 20 20 20 28 6c 61 6d 62 64 61 20 28 irx. (lambda (
1e6c0 69 20 6d 20 61 63 63 29 0a 20 20 20 20 20 28 6c i m acc). (l
1e6d0 65 74 20 28 28 6d 2d 73 74 61 72 74 20 28 69 72 et ((m-start (ir
1e6e0 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 72 regex-match-star
1e6f0 74 2d 69 6e 64 65 78 20 6d 20 30 29 29 29 0a 20 t-index m 0))).
1e700 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 28 69 (append (i
1e710 72 72 65 67 65 78 2d 61 70 70 6c 79 2d 6d 61 74 rregex-apply-mat
1e720 63 68 20 6d 20 6f 29 0a 20 20 20 20 20 20 20 20 ch m o).
1e730 20 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 69 (if (>= i
1e740 20 6d 2d 73 74 61 72 74 29 0a 20 20 20 20 20 20 m-start).
1e750 20 20 20 20 20 20 20 20 20 20 20 20 20 61 63 63 acc
1e760 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1e770 20 20 20 20 28 63 6f 6e 73 20 28 73 75 62 73 74 (cons (subst
1e780 72 69 6e 67 20 73 74 72 20 69 20 6d 2d 73 74 61 ring str i m-sta
1e790 72 74 29 20 61 63 63 29 29 29 29 29 0a 20 20 20 rt) acc))))).
1e7a0 27 28 29 0a 20 20 20 73 74 72 0a 20 20 20 28 6c '(). str. (l
1e7b0 61 6d 62 64 61 20 28 69 20 61 63 63 29 0a 20 20 ambda (i acc).
1e7c0 20 20 20 28 6c 65 74 20 28 28 65 6e 64 20 28 73 (let ((end (s
1e7d0 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 72 tring-length str
1e7e0 29 29 29 0a 20 20 20 20 20 20 20 28 73 74 72 69 ))). (stri
1e7f0 6e 67 2d 63 61 74 2d 72 65 76 65 72 73 65 20 28 ng-cat-reverse (
1e800 69 66 20 28 3e 3d 20 69 20 65 6e 64 29 0a 20 20 if (>= i end).
1e810 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e820 20 20 20 20 20 20 20 20 20 20 20 20 20 61 63 63 acc
1e830 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1e840 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e850 28 63 6f 6e 73 20 28 73 75 62 73 74 72 69 6e 67 (cons (substring
1e860 20 73 74 72 20 69 20 65 6e 64 29 20 61 63 63 29 str i end) acc)
1e870 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 ))))))..(define
1e880 28 69 72 72 65 67 65 78 2d 61 70 70 6c 79 2d 6d (irregex-apply-m
1e890 61 74 63 68 20 6d 20 6c 73 29 0a 20 20 28 6c 65 atch m ls). (le
1e8a0 74 20 6c 70 20 28 28 6c 73 20 6c 73 29 20 28 72 t lp ((ls ls) (r
1e8b0 65 73 20 27 28 29 29 29 0a 20 20 20 20 28 69 66 es '())). (if
1e8c0 20 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 (null? ls).
1e8d0 20 20 20 20 72 65 73 0a 20 20 20 20 20 20 20 20 res.
1e8e0 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 28 (cond. (
1e8f0 28 69 6e 74 65 67 65 72 3f 20 28 63 61 72 20 6c (integer? (car l
1e900 73 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c s)). (l
1e910 70 20 28 63 64 72 20 6c 73 29 0a 20 20 20 20 20 p (cdr ls).
1e920 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 (cons (
1e930 6f 72 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 or (irregex-matc
1e940 68 2d 73 75 62 73 74 72 69 6e 67 20 6d 20 28 63 h-substring m (c
1e950 61 72 20 6c 73 29 29 20 22 22 29 20 72 65 73 29 ar ls)) "") res)
1e960 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 70 72 )). ((pr
1e970 6f 63 65 64 75 72 65 3f 20 28 63 61 72 20 6c 73 ocedure? (car ls
1e980 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 70 )). (lp
1e990 20 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 20 (cdr ls) (cons
1e9a0 28 28 63 61 72 20 6c 73 29 20 6d 29 20 72 65 73 ((car ls) m) res
1e9b0 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 28 73 ))). ((s
1e9c0 79 6d 62 6f 6c 3f 20 28 63 61 72 20 6c 73 29 29 ymbol? (car ls))
1e9d0 0a 20 20 20 20 20 20 20 20 20 20 28 63 61 73 65 . (case
1e9e0 20 28 63 61 72 20 6c 73 29 0a 20 20 20 20 20 20 (car ls).
1e9f0 20 20 20 20 20 20 28 28 70 72 65 29 0a 20 20 20 ((pre).
1ea00 20 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 (lp (c
1ea10 64 72 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 dr ls).
1ea20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 73 (cons (s
1ea30 75 62 73 74 72 69 6e 67 20 28 63 61 72 20 28 69 ubstring (car (i
1ea40 72 72 65 67 65 78 2d 6d 61 74 63 68 2d 73 74 61 rregex-match-sta
1ea50 72 74 2d 73 6f 75 72 63 65 20 6d 20 30 29 29 0a rt-source m 0)).
1ea60 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ea70 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ea80 20 20 30 0a 20 20 20 20 20 20 20 20 20 20 20 20 0.
1ea90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eaa0 20 20 20 20 20 20 28 69 72 72 65 67 65 78 2d 6d (irregex-m
1eab0 61 74 63 68 2d 73 74 61 72 74 2d 69 6e 64 65 78 atch-start-index
1eac0 20 6d 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 m 0)).
1ead0 20 20 20 20 20 20 20 20 20 20 20 20 20 20 72 65 re
1eae0 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
1eaf0 20 28 28 70 6f 73 74 29 0a 20 20 20 20 20 20 20 ((post).
1eb00 20 20 20 20 20 20 28 6c 65 74 20 28 28 73 74 72 (let ((str
1eb10 20 28 63 61 72 20 28 69 72 72 65 67 65 78 2d 6d (car (irregex-m
1eb20 61 74 63 68 2d 73 74 61 72 74 2d 73 6f 75 72 63 atch-start-sourc
1eb30 65 20 6d 20 30 29 29 29 29 0a 20 20 20 20 20 20 e m 0)))).
1eb40 20 20 20 20 20 20 20 20 20 28 6c 70 20 28 63 64 (lp (cd
1eb50 72 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 r ls).
1eb60 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 28 (cons (
1eb70 73 75 62 73 74 72 69 6e 67 20 73 74 72 0a 20 20 substring str.
1eb80 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eb90 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1eba0 20 20 28 69 72 72 65 67 65 78 2d 6d 61 74 63 68 (irregex-match
1ebb0 2d 65 6e 64 2d 69 6e 64 65 78 20 6d 20 30 29 0a -end-index m 0).
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 20 20 20
1ebe0 20 20 20 20 28 73 74 72 69 6e 67 2d 6c 65 6e 67 (string-leng
1ebf0 74 68 20 73 74 72 29 29 0a 20 20 20 20 20 20 20 th str)).
1ec00 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ec10 20 20 72 65 73 29 29 29 29 0a 20 20 20 20 20 20 res)))).
1ec20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else.
1ec30 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 (cond.
1ec40 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 ((a
1ec50 73 73 71 20 28 63 61 72 20 6c 73 29 20 28 69 72 ssq (car ls) (ir
1ec60 72 65 67 65 78 2d 6d 61 74 63 68 2d 6e 61 6d 65 regex-match-name
1ec70 73 20 6d 29 29 0a 20 20 20 20 20 20 20 20 20 20 s m)).
1ec80 20 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 => (lambda
1ec90 28 78 29 20 28 6c 70 20 28 63 6f 6e 73 20 28 63 (x) (lp (cons (c
1eca0 64 72 20 78 29 20 28 63 64 72 20 6c 73 29 29 20 dr x) (cdr ls))
1ecb0 72 65 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 res))).
1ecc0 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
1ecd0 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 (error
1ece0 20 22 75 6e 6b 6e 6f 77 6e 20 6d 61 74 63 68 20 "unknown match
1ecf0 72 65 70 6c 61 63 65 6d 65 6e 74 22 20 28 63 61 replacement" (ca
1ed00 72 20 6c 73 29 29 29 29 29 29 29 0a 20 20 20 20 r ls))))))).
1ed10 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else.
1ed20 20 20 20 20 20 28 6c 70 20 28 63 64 72 20 6c 73 (lp (cdr ls
1ed30 29 20 28 63 6f 6e 73 20 28 63 61 72 20 6c 73 29 ) (cons (car ls)
1ed40 20 72 65 73 29 29 29 29 29 29 29 0a res))))))).