0000: 3b 3b 3b 20 43 68 65 7a 2d 53 63 68 65 6d 65 20 ;;; Chez-Scheme
0010: 57 72 61 70 70 65 72 73 20 66 6f 72 20 41 6c 65 Wrappers for Ale
0020: 78 20 53 68 69 6e 6e 27 73 20 4d 61 74 63 68 20 x Shinn's Match
0030: 28 57 72 69 67 68 74 20 43 6f 6d 70 61 74 69 62 (Wright Compatib
0040: 6c 65 29 0a 3b 3b 3b 20 0a 3b 3b 3b 20 43 6f 70 le).;;; .;;; Cop
0050: 79 72 69 67 68 74 20 28 63 29 20 32 30 31 36 20 yright (c) 2016
0060: 46 65 64 65 72 69 63 6f 20 42 65 66 66 61 20 3c Federico Beffa <
0070: 62 65 66 66 61 40 66 62 65 6e 67 69 6e 65 65 72 beffa@fbengineer
0080: 69 6e 67 2e 63 68 3e 0a 3b 3b 3b 20 0a 3b 3b 3b ing.ch>.;;; .;;;
0090: 20 50 65 72 6d 69 73 73 69 6f 6e 20 74 6f 20 75 Permission to u
00a0: 73 65 2c 20 63 6f 70 79 2c 20 6d 6f 64 69 66 79 se, copy, modify
00b0: 2c 20 61 6e 64 20 64 69 73 74 72 69 62 75 74 65 , and distribute
00c0: 20 74 68 69 73 20 73 6f 66 74 77 61 72 65 20 66 this software f
00d0: 6f 72 0a 3b 3b 3b 20 61 6e 79 20 70 75 72 70 6f or.;;; any purpo
00e0: 73 65 20 77 69 74 68 20 6f 72 20 77 69 74 68 6f se with or witho
00f0: 75 74 20 66 65 65 20 69 73 20 68 65 72 65 62 79 ut fee is hereby
0100: 20 67 72 61 6e 74 65 64 2c 20 70 72 6f 76 69 64 granted, provid
0110: 65 64 20 74 68 61 74 20 74 68 65 0a 3b 3b 3b 20 ed that the.;;;
0120: 61 62 6f 76 65 20 63 6f 70 79 72 69 67 68 74 20 above copyright
0130: 6e 6f 74 69 63 65 20 61 6e 64 20 74 68 69 73 20 notice and this
0140: 70 65 72 6d 69 73 73 69 6f 6e 20 6e 6f 74 69 63 permission notic
0150: 65 20 61 70 70 65 61 72 20 69 6e 20 61 6c 6c 0a e appear in all.
0160: 3b 3b 3b 20 63 6f 70 69 65 73 2e 0a 3b 3b 3b 20 ;;; copies..;;;
0170: 0a 3b 3b 3b 20 54 48 45 20 53 4f 46 54 57 41 52 .;;; THE SOFTWAR
0180: 45 20 49 53 20 50 52 4f 56 49 44 45 44 20 22 41 E IS PROVIDED "A
0190: 53 20 49 53 22 20 41 4e 44 20 54 48 45 20 41 55 S IS" AND THE AU
01a0: 54 48 4f 52 20 44 49 53 43 4c 41 49 4d 53 20 41 THOR DISCLAIMS A
01b0: 4c 4c 0a 3b 3b 3b 20 57 41 52 52 41 4e 54 49 45 LL.;;; WARRANTIE
01c0: 53 20 57 49 54 48 20 52 45 47 41 52 44 20 54 4f S WITH REGARD TO
01d0: 20 54 48 49 53 20 53 4f 46 54 57 41 52 45 20 49 THIS SOFTWARE I
01e0: 4e 43 4c 55 44 49 4e 47 20 41 4c 4c 20 49 4d 50 NCLUDING ALL IMP
01f0: 4c 49 45 44 0a 3b 3b 3b 20 57 41 52 52 41 4e 54 LIED.;;; WARRANT
0200: 49 45 53 20 4f 46 20 4d 45 52 43 48 41 4e 54 41 IES OF MERCHANTA
0210: 42 49 4c 49 54 59 20 41 4e 44 20 46 49 54 4e 45 BILITY AND FITNE
0220: 53 53 2e 20 49 4e 20 4e 4f 20 45 56 45 4e 54 20 SS. IN NO EVENT
0230: 53 48 41 4c 4c 20 54 48 45 0a 3b 3b 3b 20 41 55 SHALL THE.;;; AU
0240: 54 48 4f 52 20 42 45 20 4c 49 41 42 4c 45 20 46 THOR BE LIABLE F
0250: 4f 52 20 41 4e 59 20 53 50 45 43 49 41 4c 2c 20 OR ANY SPECIAL,
0260: 44 49 52 45 43 54 2c 20 49 4e 44 49 52 45 43 54 DIRECT, INDIRECT
0270: 2c 20 4f 52 20 43 4f 4e 53 45 51 55 45 4e 54 49 , OR CONSEQUENTI
0280: 41 4c 0a 3b 3b 3b 20 44 41 4d 41 47 45 53 20 4f AL.;;; DAMAGES O
0290: 52 20 41 4e 59 20 44 41 4d 41 47 45 53 20 57 48 R ANY DAMAGES WH
02a0: 41 54 53 4f 45 56 45 52 20 52 45 53 55 4c 54 49 ATSOEVER RESULTI
02b0: 4e 47 20 46 52 4f 4d 20 4c 4f 53 53 20 4f 46 20 NG FROM LOSS OF
02c0: 55 53 45 2c 20 44 41 54 41 0a 3b 3b 3b 20 4f 52 USE, DATA.;;; OR
02d0: 20 50 52 4f 46 49 54 53 2c 20 57 48 45 54 48 45 PROFITS, WHETHE
02e0: 52 20 49 4e 20 41 4e 20 41 43 54 49 4f 4e 20 4f R IN AN ACTION O
02f0: 46 20 43 4f 4e 54 52 41 43 54 2c 20 4e 45 47 4c F CONTRACT, NEGL
0300: 49 47 45 4e 43 45 20 4f 52 20 4f 54 48 45 52 0a IGENCE OR OTHER.
0310: 3b 3b 3b 20 54 4f 52 54 49 4f 55 53 20 41 43 54 ;;; TORTIOUS ACT
0320: 49 4f 4e 2c 20 41 52 49 53 49 4e 47 20 4f 55 54 ION, ARISING OUT
0330: 20 4f 46 20 4f 52 20 49 4e 20 43 4f 4e 4e 45 43 OF OR IN CONNEC
0340: 54 49 4f 4e 20 57 49 54 48 20 54 48 45 20 55 53 TION WITH THE US
0350: 45 20 4f 52 0a 3b 3b 3b 20 50 45 52 46 4f 52 4d E OR.;;; PERFORM
0360: 41 4e 43 45 20 4f 46 20 54 48 49 53 20 53 4f 46 ANCE OF THIS SOF
0370: 54 57 41 52 45 2e 0a 0a 3b 3b 20 54 68 65 20 72 TWARE...;; The r
0380: 65 61 64 65 72 20 69 6e 20 23 21 72 36 72 73 20 eader in #!r6rs
0390: 6d 6f 64 65 20 64 6f 65 73 6e 27 74 20 61 6c 6c mode doesn't all
03a0: 6f 77 20 74 68 65 20 27 2e 2e 31 27 20 69 64 65 ow the '..1' ide
03b0: 6e 74 69 66 69 65 72 2e 0a 23 21 63 68 65 7a 73 ntifier..#!chezs
03c0: 63 68 65 6d 65 0a 28 6c 69 62 72 61 72 79 20 28 cheme.(library (
03d0: 6d 61 74 63 68 61 62 6c 65 29 0a 09 20 28 65 78 matchable).. (ex
03e0: 70 6f 72 74 20 0a 09 20 20 6d 61 74 63 68 0a 09 port .. match..
03f0: 20 20 6d 61 74 63 68 2d 6c 61 6d 62 64 61 20 0a match-lambda .
0400: 09 20 20 6d 61 74 63 68 2d 6c 61 6d 62 64 61 2a . match-lambda*
0410: 20 0a 09 20 20 6d 61 74 63 68 2d 6c 65 74 20 0a .. match-let .
0420: 09 20 20 6d 61 74 63 68 2d 6c 65 74 2a 20 0a 09 . match-let* ..
0430: 20 20 6d 61 74 63 68 2d 6c 65 74 72 65 63 0a 09 match-letrec..
0440: 20 20 6d 61 74 63 68 2d 6e 61 6d 65 64 2d 6c 65 match-named-le
0450: 74 0a 09 20 20 3a 5f 20 5f 5f 5f 20 2e 2e 31 20 t.. :_ ___ ..1
0460: 2a 2a 2a 20 3f 20 24 20 73 74 72 75 63 74 20 40 *** ? $ struct @
0470: 20 6f 62 6a 65 63 74 29 0a 09 20 0a 09 20 23 3b object).. .. #;
0480: 28 69 6d 70 6f 72 74 20 0a 09 20 28 72 6e 72 73 (import .. (rnrs
0490: 20 62 61 73 65 29 0a 09 20 28 72 6e 72 73 20 6c base).. (rnrs l
04a0: 69 73 74 73 29 0a 09 20 28 72 6e 72 73 20 6d 75 ists).. (rnrs mu
04b0: 74 61 62 6c 65 2d 70 61 69 72 73 29 0a 09 20 28 table-pairs).. (
04c0: 72 6e 72 73 20 72 65 63 6f 72 64 73 20 73 79 6e rnrs records syn
04d0: 74 61 63 74 69 63 29 0a 09 20 28 72 6e 72 73 20 tactic).. (rnrs
04e0: 72 65 63 6f 72 64 73 20 70 72 6f 63 65 64 75 72 records procedur
04f0: 61 6c 29 0a 09 20 28 72 6e 72 73 20 72 65 63 6f al).. (rnrs reco
0500: 72 64 73 20 69 6e 73 70 65 63 74 69 6f 6e 29 0a rds inspection).
0510: 09 20 28 72 6e 72 73 20 73 79 6e 74 61 78 2d 63 . (rnrs syntax-c
0520: 61 73 65 29 0a 09 20 28 6f 6e 6c 79 20 28 63 68 ase).. (only (ch
0530: 65 7a 73 63 68 65 6d 65 29 20 69 6f 74 61 20 69 ezscheme) iota i
0540: 6e 63 6c 75 64 65 29 0a 09 20 3b 3b 20 61 76 6f nclude).. ;; avo
0550: 69 64 20 64 65 70 65 6e 64 65 6e 63 65 20 6f 6e id dependence on
0560: 20 63 68 65 7a 2d 73 72 66 69 20 28 61 70 61 72 chez-srfi (apar
0570: 74 20 66 6f 72 20 74 65 73 74 73 29 0a 09 20 3b t for tests).. ;
0580: 3b 20 28 73 72 66 69 20 70 72 69 76 61 74 65 20 ; (srfi private
0590: 61 75 78 2d 6b 65 79 77 6f 72 64 73 29 0a 09 20 aux-keywords)..
05a0: 3b 3b 20 28 73 72 66 69 20 70 72 69 76 61 74 65 ;; (srfi private
05b0: 20 69 6e 63 6c 75 64 65 29 0a 09 20 29 0a 09 20 include).. )..
05c0: 28 69 6d 70 6f 72 74 20 28 63 68 65 7a 73 63 68 (import (chezsch
05d0: 65 6d 65 29 29 0a 0a 09 20 3b 3b 20 57 65 20 64 eme))... ;; We d
05e0: 65 63 6c 61 72 65 20 65 6e 64 20 65 78 70 6f 72 eclare end expor
05f0: 74 20 74 68 65 20 73 79 6d 62 6f 6c 73 20 75 73 t the symbols us
0600: 65 64 20 61 73 20 61 75 78 69 6c 69 61 72 79 20 ed as auxiliary
0610: 69 64 65 6e 74 69 66 69 65 72 73 0a 09 20 3b 3b identifiers.. ;;
0620: 20 69 6e 20 27 73 79 6e 74 61 78 2d 72 75 6c 65 in 'syntax-rule
0630: 73 27 20 74 6f 20 6d 61 6b 65 20 74 68 65 6d 20 s' to make them
0640: 77 6f 72 6b 20 69 6e 20 43 68 65 7a 20 53 63 68 work in Chez Sch
0650: 65 6d 65 27 73 20 69 6e 74 65 72 61 63 74 69 76 eme's interactiv
0660: 65 0a 09 20 3b 3b 20 65 6e 76 69 72 6f 6e 6d 65 e.. ;; environme
0670: 6e 74 2e 20 28 46 42 45 29 0a 0a 09 20 3b 3b 20 nt. (FBE)... ;;
0680: 41 6c 73 6f 20 77 65 20 72 65 70 6c 61 63 65 64 Also we replaced
0690: 20 27 5f 27 20 77 69 74 68 20 27 3a 5f 27 20 61 '_' with ':_' a
06a0: 73 20 74 68 65 20 73 70 65 63 69 61 6c 20 69 64 s the special id
06b0: 65 6e 74 69 66 69 65 72 20 6d 61 74 63 68 69 6e entifier matchin
06c0: 67 0a 09 20 3b 3b 20 61 6e 79 74 68 69 6e 67 20 g.. ;; anything
06d0: 61 6e 64 20 6e 6f 74 20 62 69 6e 64 69 6e 67 2e and not binding.
06e0: 20 20 54 68 69 73 20 69 73 20 62 65 63 61 75 73 This is becaus
06f0: 65 20 52 36 52 53 20 66 6f 72 62 69 64 73 20 69 e R6RS forbids i
0700: 74 73 20 75 73 65 0a 09 20 3b 3b 20 61 73 20 61 ts use.. ;; as a
0710: 6e 20 61 75 78 69 6c 69 61 72 79 20 6c 69 74 65 n auxiliary lite
0720: 72 61 6c 20 69 6e 20 61 20 73 79 6e 74 61 78 2d ral in a syntax-
0730: 72 75 6c 65 73 20 66 6f 72 6d 2e 0a 09 20 28 64 rules form... (d
0740: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 64 65 66 efine-syntax def
0750: 69 6e 65 2d 61 75 78 69 6c 69 61 72 79 2d 6b 65 ine-auxiliary-ke
0760: 79 77 6f 72 64 0a 09 20 28 73 79 6e 74 61 78 2d yword.. (syntax-
0770: 72 75 6c 65 73 20 28 29 0a 09 20 5b 28 5f 20 6e rules ().. [(_ n
0780: 61 6d 65 29 0a 09 20 28 64 65 66 69 6e 65 2d 73 ame).. (define-s
0790: 79 6e 74 61 78 20 6e 61 6d 65 20 0a 20 20 20 20 yntax name .
07a0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 (lambda (x)
07b0: 0a 09 20 28 73 79 6e 74 61 78 2d 76 69 6f 6c 61 .. (syntax-viola
07c0: 74 69 6f 6e 20 23 66 20 22 6d 69 73 70 6c 61 63 tion #f "misplac
07d0: 65 64 20 75 73 65 20 6f 66 20 61 75 78 69 6c 69 ed use of auxili
07e0: 61 72 79 20 6b 65 79 77 6f 72 64 22 20 78 29 29 ary keyword" x))
07f0: 29 5d 29 29 0a 0a 09 20 28 64 65 66 69 6e 65 2d )]))... (define-
0800: 73 79 6e 74 61 78 20 64 65 66 69 6e 65 2d 61 75 syntax define-au
0810: 78 69 6c 69 61 72 79 2d 6b 65 79 77 6f 72 64 73 xiliary-keywords
0820: 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 .. (syntax-rules
0830: 20 28 29 0a 09 20 5b 28 5f 20 6e 61 6d 65 2a 20 ().. [(_ name*
0840: 2e 2e 2e 29 0a 09 20 28 62 65 67 69 6e 20 28 64 ...).. (begin (d
0850: 65 66 69 6e 65 2d 61 75 78 69 6c 69 61 72 79 2d efine-auxiliary-
0860: 6b 65 79 77 6f 72 64 20 6e 61 6d 65 2a 29 20 2e keyword name*) .
0870: 2e 2e 29 5d 29 29 0a 0a 09 20 28 64 65 66 69 6e ..)]))... (defin
0880: 65 2d 61 75 78 69 6c 69 61 72 79 2d 6b 65 79 77 e-auxiliary-keyw
0890: 6f 72 64 73 20 3a 5f 20 5f 5f 5f 20 2e 2e 31 20 ords :_ ___ ..1
08a0: 2a 2a 2a 20 3f 20 24 20 73 74 72 75 63 74 20 40 *** ? $ struct @
08b0: 20 6f 62 6a 65 63 74 29 0a 0a 09 20 28 64 65 66 object)... (def
08c0: 69 6e 65 2d 73 79 6e 74 61 78 20 69 73 2d 61 3f ine-syntax is-a?
08d0: 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 .. (syntax-rules
08e0: 20 28 29 0a 09 20 28 28 5f 20 72 65 63 20 72 74 ().. ((_ rec rt
08f0: 6e 29 0a 09 20 28 61 6e 64 20 28 72 65 63 6f 72 n).. (and (recor
0900: 64 3f 20 72 65 63 29 0a 09 20 28 65 71 3f 20 28 d? rec).. (eq? (
0910: 72 65 63 6f 72 64 2d 74 79 70 65 2d 6e 61 6d 65 record-type-name
0920: 20 28 72 65 63 6f 72 64 2d 72 74 64 20 72 65 63 (record-rtd rec
0930: 29 29 20 28 71 75 6f 74 65 20 72 74 6e 29 29 29 )) (quote rtn)))
0940: 29 29 29 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 )))... (define-s
0950: 79 6e 74 61 78 20 73 6c 6f 74 2d 72 65 66 0a 09 yntax slot-ref..
0960: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
0970: 29 0a 09 20 28 28 5f 20 72 74 6e 20 72 65 63 20 ).. ((_ rtn rec
0980: 6e 29 0a 09 20 28 69 66 20 28 6e 75 6d 62 65 72 n).. (if (number
0990: 3f 20 6e 29 0a 09 20 28 28 72 65 63 6f 72 64 2d ? n).. ((record-
09a0: 61 63 63 65 73 73 6f 72 20 28 72 65 63 6f 72 64 accessor (record
09b0: 2d 72 74 64 20 72 65 63 29 20 6e 29 20 72 65 63 -rtd rec) n) rec
09c0: 29 0a 09 20 3b 3b 20 49 66 20 69 74 27 73 20 6e ).. ;; If it's n
09d0: 6f 74 20 61 20 6e 75 6d 62 65 72 2c 20 74 68 65 ot a number, the
09e0: 6e 20 69 74 20 73 68 6f 75 6c 64 20 62 65 20 61 n it should be a
09f0: 20 73 79 6d 62 6f 6c 20 77 69 74 68 0a 09 20 3b symbol with.. ;
0a00: 3b 20 74 68 65 20 6e 61 6d 65 20 6f 66 20 61 20 ; the name of a
0a10: 66 69 65 6c 64 2e 0a 09 20 28 6c 65 74 2a 20 28 field... (let* (
0a20: 28 72 74 64 20 28 72 65 63 6f 72 64 2d 72 74 64 (rtd (record-rtd
0a30: 20 72 65 63 29 29 0a 09 20 28 66 69 65 6c 64 73 rec)).. (fields
0a40: 20 28 72 65 63 6f 72 64 2d 74 79 70 65 2d 66 69 (record-type-fi
0a50: 65 6c 64 2d 6e 61 6d 65 73 20 72 74 64 29 29 0a eld-names rtd)).
0a60: 09 20 28 66 69 65 6c 64 73 2d 69 64 78 73 20 28 . (fields-idxs (
0a70: 6d 61 70 20 28 6c 61 6d 62 64 61 20 28 66 20 69 map (lambda (f i
0a80: 29 20 28 63 6f 6e 73 20 66 20 69 29 29 0a 09 20 ) (cons f i))..
0a90: 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 66 69 (vector->list fi
0aa0: 65 6c 64 73 29 0a 09 20 28 69 6f 74 61 20 28 76 elds).. (iota (v
0ab0: 65 63 74 6f 72 2d 6c 65 6e 67 74 68 20 66 69 65 ector-length fie
0ac0: 6c 64 73 29 29 29 29 0a 09 20 28 69 64 78 20 28 lds)))).. (idx (
0ad0: 63 64 72 20 28 61 73 73 76 20 6e 20 66 69 65 6c cdr (assv n fiel
0ae0: 64 73 2d 69 64 78 73 29 29 29 29 0a 09 20 28 28 ds-idxs)))).. ((
0af0: 72 65 63 6f 72 64 2d 61 63 63 65 73 73 6f 72 20 record-accessor
0b00: 72 74 64 20 69 64 78 29 20 72 65 63 29 29 29 29 rtd idx) rec))))
0b10: 29 29 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 ))... (define-sy
0b20: 6e 74 61 78 20 73 6c 6f 74 2d 73 65 74 21 0a 09 ntax slot-set!..
0b30: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
0b40: 29 0a 09 20 28 28 5f 20 72 74 6e 20 72 65 63 20 ).. ((_ rtn rec
0b50: 6e 29 0a 09 20 28 69 66 20 28 6e 75 6d 62 65 72 n).. (if (number
0b60: 3f 20 6e 29 0a 09 20 28 28 72 65 63 6f 72 64 2d ? n).. ((record-
0b70: 6d 75 74 61 74 6f 72 20 28 72 65 63 6f 72 64 2d mutator (record-
0b80: 72 74 64 20 72 65 63 29 20 6e 29 20 72 65 63 29 rtd rec) n) rec)
0b90: 0a 09 20 3b 3b 20 49 66 20 69 74 27 73 20 6e 6f .. ;; If it's no
0ba0: 74 20 61 20 6e 75 6d 62 65 72 2c 20 74 68 65 6e t a number, then
0bb0: 20 69 74 20 73 68 6f 75 6c 64 20 62 65 20 61 20 it should be a
0bc0: 73 79 6d 62 6f 6c 20 77 69 74 68 0a 09 20 3b 3b symbol with.. ;;
0bd0: 20 74 68 65 20 6e 61 6d 65 20 6f 66 20 61 20 66 the name of a f
0be0: 69 65 6c 64 2e 0a 09 20 28 6c 65 74 2a 20 28 28 ield... (let* ((
0bf0: 72 74 64 20 28 72 65 63 6f 72 64 2d 72 74 64 20 rtd (record-rtd
0c00: 72 65 63 29 29 0a 09 20 28 66 69 65 6c 64 73 20 rec)).. (fields
0c10: 28 72 65 63 6f 72 64 2d 74 79 70 65 2d 66 69 65 (record-type-fie
0c20: 6c 64 2d 6e 61 6d 65 73 20 72 74 64 29 29 0a 09 ld-names rtd))..
0c30: 20 28 66 69 65 6c 64 73 2d 69 64 78 73 20 28 6d (fields-idxs (m
0c40: 61 70 20 28 6c 61 6d 62 64 61 20 28 66 20 69 29 ap (lambda (f i)
0c50: 20 28 63 6f 6e 73 20 66 20 69 29 29 0a 09 20 28 (cons f i)).. (
0c60: 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 66 69 65 vector->list fie
0c70: 6c 64 73 29 0a 09 20 28 69 6f 74 61 20 28 76 65 lds).. (iota (ve
0c80: 63 74 6f 72 2d 6c 65 6e 67 74 68 20 66 69 65 6c ctor-length fiel
0c90: 64 73 29 29 29 29 0a 09 20 28 69 64 78 20 28 63 ds)))).. (idx (c
0ca0: 64 72 20 28 61 73 73 76 20 6e 20 66 69 65 6c 64 dr (assv n field
0cb0: 73 2d 69 64 78 73 29 29 29 29 0a 09 20 28 28 72 s-idxs)))).. ((r
0cc0: 65 63 6f 72 64 2d 6d 75 74 61 74 6f 72 20 72 74 ecord-mutator rt
0cd0: 64 20 69 64 78 29 20 72 65 63 29 29 29 29 29 29 d idx) rec))))))
0ce0: 0a 09 20 0a 3b 3b 3b 3b 20 6d 61 74 63 68 2e 73 .. .;;;; match.s
0cf0: 63 6d 20 2d 2d 20 70 6f 72 74 61 62 6c 65 20 68 cm -- portable h
0d00: 79 67 69 65 6e 69 63 20 70 61 74 74 65 72 6e 20 ygienic pattern
0d10: 6d 61 74 63 68 65 72 20 2d 2a 2d 20 63 6f 64 69 matcher -*- codi
0d20: 6e 67 3a 20 75 74 66 2d 38 20 2d 2a 2d 0a 09 20 ng: utf-8 -*-..
0d30: 3b 3b 0a 09 20 3b 3b 20 54 68 69 73 20 63 6f 64 ;;.. ;; This cod
0d40: 65 20 69 73 20 77 72 69 74 74 65 6e 20 62 79 20 e is written by
0d50: 41 6c 65 78 20 53 68 69 6e 6e 20 61 6e 64 20 70 Alex Shinn and p
0d60: 6c 61 63 65 64 20 69 6e 20 74 68 65 0a 09 20 3b laced in the.. ;
0d70: 3b 20 50 75 62 6c 69 63 20 44 6f 6d 61 69 6e 2e ; Public Domain.
0d80: 20 20 41 6c 6c 20 77 61 72 72 61 6e 74 69 65 73 All warranties
0d90: 20 61 72 65 20 64 69 73 63 6c 61 69 6d 65 64 2e are disclaimed.
0da0: 0a 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 ... ;;> \example
0db0: 2d 69 6d 70 6f 72 74 5b 28 73 72 66 69 20 39 29 -import[(srfi 9)
0dc0: 5d 0a 0a 09 20 3b 3b 3e 20 41 20 70 6f 72 74 61 ]... ;;> A porta
0dd0: 62 6c 65 20 68 79 67 69 65 6e 69 63 20 70 61 74 ble hygienic pat
0de0: 74 65 72 6e 20 6d 61 74 63 68 65 72 2e 0a 0a 09 tern matcher....
0df0: 20 3b 3b 3e 20 54 68 69 73 20 69 73 20 61 20 66 ;;> This is a f
0e00: 75 6c 6c 20 73 75 70 65 72 73 65 74 20 6f 66 20 ull superset of
0e10: 74 68 65 20 70 6f 70 75 6c 61 72 20 5c 68 79 70 the popular \hyp
0e20: 65 72 6c 69 6e 6b 5b 0a 09 20 3b 3b 3e 20 22 68 erlink[.. ;;> "h
0e30: 74 74 70 3a 2f 2f 77 77 77 2e 63 73 2e 69 6e 64 ttp://www.cs.ind
0e40: 69 61 6e 61 2e 65 64 75 2f 73 63 68 65 6d 65 2d iana.edu/scheme-
0e50: 72 65 70 6f 73 69 74 6f 72 79 2f 63 6f 64 65 2e repository/code.
0e60: 6d 61 74 63 68 2e 68 74 6d 6c 22 5d 7b 6d 61 74 match.html"]{mat
0e70: 63 68 7d 0a 09 20 3b 3b 3e 20 70 61 63 6b 61 67 ch}.. ;;> packag
0e80: 65 20 62 79 20 41 6e 64 72 65 77 20 57 72 69 67 e by Andrew Wrig
0e90: 68 74 2c 20 77 72 69 74 74 65 6e 20 69 6e 20 66 ht, written in f
0ea0: 75 6c 6c 79 20 70 6f 72 74 61 62 6c 65 20 5c 73 ully portable \s
0eb0: 63 68 65 6d 65 7b 73 79 6e 74 61 78 2d 72 75 6c cheme{syntax-rul
0ec0: 65 73 7d 0a 09 20 3b 3b 3e 20 61 6e 64 20 74 68 es}.. ;;> and th
0ed0: 75 73 20 70 72 65 73 65 72 76 69 6e 67 20 68 79 us preserving hy
0ee0: 67 69 65 6e 65 2e 0a 0a 09 20 3b 3b 3e 20 54 68 giene.... ;;> Th
0ef0: 65 20 6d 6f 73 74 20 6e 6f 74 61 62 6c 65 20 65 e most notable e
0f00: 78 74 65 6e 73 69 6f 6e 73 20 61 72 65 20 74 68 xtensions are th
0f10: 65 20 61 62 69 6c 69 74 79 20 74 6f 20 75 73 65 e ability to use
0f20: 20 5c 65 6d 70 68 7b 6e 6f 6e 2d 6c 69 6e 65 61 \emph{non-linea
0f30: 72 7d 0a 09 20 3b 3b 3e 20 70 61 74 74 65 72 6e r}.. ;;> pattern
0f40: 73 20 2d 20 70 61 74 74 65 72 6e 73 20 69 6e 20 s - patterns in
0f50: 77 68 69 63 68 20 74 68 65 20 73 61 6d 65 20 69 which the same i
0f60: 64 65 6e 74 69 66 69 65 72 20 6f 63 63 75 72 73 dentifier occurs
0f70: 20 6d 75 6c 74 69 70 6c 65 0a 09 20 3b 3b 3e 20 multiple.. ;;>
0f80: 74 69 6d 65 73 2c 20 74 61 69 6c 20 70 61 74 74 times, tail patt
0f90: 65 72 6e 73 20 61 66 74 65 72 20 65 6c 6c 69 70 erns after ellip
0fa0: 73 69 73 2c 20 61 6e 64 20 74 68 65 20 65 78 70 sis, and the exp
0fb0: 65 72 69 6d 65 6e 74 61 6c 20 74 72 65 65 20 70 erimental tree p
0fc0: 61 74 74 65 72 6e 73 2e 0a 0a 09 20 3b 3b 3e 20 atterns.... ;;>
0fd0: 5c 73 65 63 74 69 6f 6e 7b 50 61 74 74 65 72 6e \section{Pattern
0fe0: 73 7d 0a 0a 09 20 3b 3b 3e 20 50 61 74 74 65 72 s}... ;;> Patter
0ff0: 6e 73 20 61 72 65 20 77 72 69 74 74 65 6e 20 74 ns are written t
1000: 6f 20 6c 6f 6f 6b 20 6c 69 6b 65 20 74 68 65 20 o look like the
1010: 70 72 69 6e 74 65 64 20 72 65 70 72 65 73 65 6e printed represen
1020: 74 61 74 69 6f 6e 20 6f 66 0a 09 20 3b 3b 3e 20 tation of.. ;;>
1030: 74 68 65 20 6f 62 6a 65 63 74 73 20 74 68 65 79 the objects they
1040: 20 6d 61 74 63 68 2e 20 20 54 68 65 20 62 61 73 match. The bas
1050: 69 63 20 75 73 61 67 65 20 69 73 0a 0a 09 20 3b ic usage is... ;
1060: 3b 3e 20 5c 73 63 68 65 6d 65 7b 28 6d 61 74 63 ;> \scheme{(matc
1070: 68 20 65 78 70 72 20 28 70 61 74 20 62 6f 64 79 h expr (pat body
1080: 20 2e 2e 2e 29 20 2e 2e 2e 29 7d 0a 0a 09 20 3b ...) ...)}... ;
1090: 3b 3e 20 77 68 65 72 65 20 74 68 65 20 72 65 73 ;> where the res
10a0: 75 6c 74 20 6f 66 20 5c 76 61 72 7b 65 78 70 72 ult of \var{expr
10b0: 7d 20 69 73 20 6d 61 74 63 68 65 64 20 61 67 61 } is matched aga
10c0: 69 6e 73 74 20 65 61 63 68 20 70 61 74 74 65 72 inst each patter
10d0: 6e 20 69 6e 0a 09 20 3b 3b 3e 20 74 75 72 6e 2c n in.. ;;> turn,
10e0: 20 61 6e 64 20 74 68 65 20 63 6f 72 72 65 73 70 and the corresp
10f0: 6f 6e 64 69 6e 67 20 62 6f 64 79 20 69 73 20 65 onding body is e
1100: 76 61 6c 75 61 74 65 64 20 66 6f 72 20 74 68 65 valuated for the
1110: 20 66 69 72 73 74 20 74 6f 0a 09 20 3b 3b 3e 20 first to.. ;;>
1120: 73 75 63 63 65 65 64 2e 20 20 54 68 75 73 2c 20 succeed. Thus,
1130: 61 20 6c 69 73 74 20 6f 66 20 74 68 72 65 65 20 a list of three
1140: 65 6c 65 6d 65 6e 74 73 20 6d 61 74 63 68 65 73 elements matches
1150: 20 61 20 6c 69 73 74 20 6f 66 20 74 68 72 65 65 a list of three
1160: 0a 09 20 3b 3b 3e 20 65 6c 65 6d 65 6e 74 73 2e .. ;;> elements.
1170: 0a 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 ... ;;> \example
1180: 7b 28 6c 65 74 20 28 28 6c 73 20 28 6c 69 73 74 {(let ((ls (list
1190: 20 31 20 32 20 33 29 29 29 20 28 6d 61 74 63 68 1 2 3))) (match
11a0: 20 6c 73 20 28 28 31 20 32 20 33 29 20 23 74 29 ls ((1 2 3) #t)
11b0: 29 29 7d 0a 0a 09 20 3b 3b 3e 20 49 66 20 6e 6f ))}... ;;> If no
11c0: 20 70 61 74 74 65 72 6e 73 20 6d 61 74 63 68 20 patterns match
11d0: 61 6e 20 65 72 72 6f 72 20 69 73 20 73 69 67 6e an error is sign
11e0: 61 6c 6c 65 64 2e 0a 0a 09 20 3b 3b 3e 20 49 64 alled.... ;;> Id
11f0: 65 6e 74 69 66 69 65 72 73 20 77 69 6c 6c 20 6d entifiers will m
1200: 61 74 63 68 20 61 6e 79 74 68 69 6e 67 2c 20 61 atch anything, a
1210: 6e 64 20 6d 61 6b 65 20 74 68 65 20 63 6f 72 72 nd make the corr
1220: 65 73 70 6f 6e 64 69 6e 67 0a 09 20 3b 3b 3e 20 esponding.. ;;>
1230: 62 69 6e 64 69 6e 67 20 61 76 61 69 6c 61 62 6c binding availabl
1240: 65 20 69 6e 20 74 68 65 20 62 6f 64 79 2e 0a 0a e in the body...
1250: 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 . ;;> \example{(
1260: 6d 61 74 63 68 20 28 6c 69 73 74 20 31 20 32 20 match (list 1 2
1270: 33 29 20 28 28 61 20 62 20 63 29 20 62 29 29 7d 3) ((a b c) b))}
1280: 0a 0a 09 20 3b 3b 3e 20 49 66 20 74 68 65 20 73 ... ;;> If the s
1290: 61 6d 65 20 69 64 65 6e 74 69 66 69 65 72 20 6f ame identifier o
12a0: 63 63 75 72 73 20 6d 75 6c 74 69 70 6c 65 20 74 ccurs multiple t
12b0: 69 6d 65 73 2c 20 74 68 65 20 66 69 72 73 74 20 imes, the first
12c0: 69 6e 73 74 61 6e 63 65 0a 09 20 3b 3b 3e 20 77 instance.. ;;> w
12d0: 69 6c 6c 20 6d 61 74 63 68 20 61 6e 79 74 68 69 ill match anythi
12e0: 6e 67 2c 20 62 75 74 20 73 75 62 73 65 71 75 65 ng, but subseque
12f0: 6e 74 20 69 6e 73 74 61 6e 63 65 73 20 6d 75 73 nt instances mus
1300: 74 20 6d 61 74 63 68 20 61 20 76 61 6c 75 65 0a t match a value.
1310: 09 20 3b 3b 3e 20 77 68 69 63 68 20 69 73 20 5c . ;;> which is \
1320: 73 63 68 65 6d 65 7b 65 71 75 61 6c 3f 7d 20 74 scheme{equal?} t
1330: 6f 20 74 68 65 20 66 69 72 73 74 2e 0a 0a 09 20 o the first....
1340: 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 ;;> \example{(ma
1350: 74 63 68 20 28 6c 69 73 74 20 31 20 32 20 31 29 tch (list 1 2 1)
1360: 20 28 28 61 20 61 20 62 29 20 31 29 20 28 28 61 ((a a b) 1) ((a
1370: 20 62 20 61 29 20 32 29 29 7d 0a 0a 09 20 3b 3b b a) 2))}... ;;
1380: 3e 20 54 68 65 20 73 70 65 63 69 61 6c 20 69 64 > The special id
1390: 65 6e 74 69 66 69 65 72 20 5c 73 63 68 65 6d 65 entifier \scheme
13a0: 7b 5f 7d 20 6d 61 74 63 68 65 73 20 61 6e 79 74 {_} matches anyt
13b0: 68 69 6e 67 2c 20 6e 6f 20 6d 61 74 74 65 72 20 hing, no matter
13c0: 68 6f 77 0a 09 20 3b 3b 3e 20 6d 61 6e 79 20 74 how.. ;;> many t
13d0: 69 6d 65 73 20 69 74 20 69 73 20 75 73 65 64 2c imes it is used,
13e0: 20 61 6e 64 20 64 6f 65 73 20 6e 6f 74 20 62 69 and does not bi
13f0: 6e 64 20 74 68 65 20 72 65 73 75 6c 74 20 69 6e nd the result in
1400: 20 74 68 65 20 62 6f 64 79 2e 0a 0a 09 20 3b 3b the body.... ;;
1410: 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 74 63 > \example{(matc
1420: 68 20 28 6c 69 73 74 20 31 20 32 20 31 29 20 28 h (list 1 2 1) (
1430: 28 5f 20 5f 20 62 29 20 31 29 20 28 28 61 20 62 (_ _ b) 1) ((a b
1440: 20 61 29 20 32 29 29 7d 0a 0a 09 20 3b 3b 3e 20 a) 2))}... ;;>
1450: 54 6f 20 6d 61 74 63 68 20 61 20 6c 69 74 65 72 To match a liter
1460: 61 6c 20 69 64 65 6e 74 69 66 69 65 72 20 28 6f al identifier (o
1470: 72 20 6c 69 73 74 20 6f 72 20 61 6e 79 20 6f 74 r list or any ot
1480: 68 65 72 20 6c 69 74 65 72 61 6c 29 2c 20 75 73 her literal), us
1490: 65 0a 09 20 3b 3b 3e 20 5c 73 63 68 65 6d 65 7b e.. ;;> \scheme{
14a0: 71 75 6f 74 65 7d 2e 0a 0a 09 20 3b 3b 3e 20 5c quote}.... ;;> \
14b0: 65 78 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 27 example{(match '
14c0: 61 20 28 27 62 20 31 29 20 28 27 61 20 32 29 29 a ('b 1) ('a 2))
14d0: 7d 0a 0a 09 20 3b 3b 3e 20 41 6e 61 6c 6f 67 6f }... ;;> Analogo
14e0: 75 73 20 74 6f 20 69 74 73 20 6e 6f 72 6d 61 6c us to its normal
14f0: 20 75 73 61 67 65 20 69 6e 20 73 63 68 65 6d 65 usage in scheme
1500: 2c 20 5c 73 63 68 65 6d 65 7b 71 75 61 73 69 71 , \scheme{quasiq
1510: 75 6f 74 65 7d 20 63 61 6e 0a 09 20 3b 3b 3e 20 uote} can.. ;;>
1520: 62 65 20 75 73 65 64 20 74 6f 20 71 75 6f 74 65 be used to quote
1530: 20 61 20 6d 6f 73 74 6c 79 20 6c 69 74 65 72 61 a mostly litera
1540: 6c 6c 79 20 6d 61 74 63 68 69 6e 67 20 6f 62 6a lly matching obj
1550: 65 63 74 20 77 69 74 68 20 73 65 6c 65 63 74 65 ect with selecte
1560: 64 0a 09 20 3b 3b 3e 20 70 61 72 74 73 20 75 6e d.. ;;> parts un
1570: 71 75 6f 74 65 64 2e 0a 0a 09 20 3b 3b 3e 20 5c quoted.... ;;> \
1580: 65 78 61 6d 70 6c 65 7c 7b 28 6d 61 74 63 68 20 example|{(match
1590: 28 6c 69 73 74 20 31 20 32 20 33 29 20 28 60 28 (list 1 2 3) (`(
15a0: 31 20 2c 62 20 2c 63 29 20 28 6c 69 73 74 20 62 1 ,b ,c) (list b
15b0: 20 63 29 29 29 7d 7c 0a 0a 09 20 3b 3b 3e 20 4f c)))}|... ;;> O
15c0: 66 74 65 6e 20 79 6f 75 20 77 61 6e 74 20 74 6f ften you want to
15d0: 20 6d 61 74 63 68 20 61 6e 79 20 6e 75 6d 62 65 match any numbe
15e0: 72 20 6f 66 20 61 20 72 65 70 65 61 74 65 64 20 r of a repeated
15f0: 70 61 74 74 65 72 6e 2e 20 20 49 6e 73 69 64 65 pattern. Inside
1600: 0a 09 20 3b 3b 3e 20 61 20 6c 69 73 74 20 70 61 .. ;;> a list pa
1610: 74 74 65 72 6e 20 79 6f 75 20 63 61 6e 20 61 70 ttern you can ap
1620: 70 65 6e 64 20 5c 73 63 68 65 6d 65 7b 2e 2e 2e pend \scheme{...
1630: 7d 20 61 66 74 65 72 20 61 6e 20 65 6c 65 6d 65 } after an eleme
1640: 6e 74 20 74 6f 0a 09 20 3b 3b 3e 20 6d 61 74 63 nt to.. ;;> matc
1650: 68 20 7a 65 72 6f 20 6f 72 20 6d 6f 72 65 20 6f h zero or more o
1660: 66 20 74 68 61 74 20 70 61 74 74 65 72 6e 20 28 f that pattern (
1670: 6c 69 6b 65 20 61 20 72 65 67 65 78 70 20 4b 6c like a regexp Kl
1680: 65 65 6e 65 20 73 74 61 72 29 2e 0a 0a 09 20 3b eene star).... ;
1690: 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 74 ;> \example{(mat
16a0: 63 68 20 28 6c 69 73 74 20 31 20 32 29 20 28 28 ch (list 1 2) ((
16b0: 31 20 32 20 33 20 2e 2e 2e 29 20 23 74 29 29 7d 1 2 3 ...) #t))}
16c0: 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b .. ;;> \example{
16d0: 28 6d 61 74 63 68 20 28 6c 69 73 74 20 31 20 32 (match (list 1 2
16e0: 20 33 29 20 28 28 31 20 32 20 33 20 2e 2e 2e 29 3) ((1 2 3 ...)
16f0: 20 23 74 29 29 7d 0a 09 20 3b 3b 3e 20 5c 65 78 #t))}.. ;;> \ex
1700: 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 28 6c 69 ample{(match (li
1710: 73 74 20 31 20 32 20 33 20 33 20 33 29 20 28 28 st 1 2 3 3 3) ((
1720: 31 20 32 20 33 20 2e 2e 2e 29 20 23 74 29 29 7d 1 2 3 ...) #t))}
1730: 0a 0a 09 20 3b 3b 3e 20 50 61 74 74 65 72 6e 20 ... ;;> Pattern
1740: 76 61 72 69 61 62 6c 65 73 20 6d 61 74 63 68 65 variables matche
1750: 64 20 69 6e 73 69 64 65 20 74 68 65 20 72 65 70 d inside the rep
1760: 65 61 74 65 64 20 70 61 74 74 65 72 6e 20 61 72 eated pattern ar
1770: 65 20 62 6f 75 6e 64 20 74 6f 0a 09 20 3b 3b 3e e bound to.. ;;>
1780: 20 61 20 6c 69 73 74 20 6f 66 20 65 61 63 68 20 a list of each
1790: 6d 61 74 63 68 69 6e 67 20 69 6e 73 74 61 6e 63 matching instanc
17a0: 65 20 69 6e 20 74 68 65 20 62 6f 64 79 2e 0a 0a e in the body...
17b0: 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 . ;;> \example{(
17c0: 6d 61 74 63 68 20 28 6c 69 73 74 20 31 20 32 29 match (list 1 2)
17d0: 20 28 28 61 20 62 20 63 20 2e 2e 2e 29 20 63 29 ((a b c ...) c)
17e0: 29 7d 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c )}.. ;;> \exampl
17f0: 65 7b 28 6d 61 74 63 68 20 28 6c 69 73 74 20 31 e{(match (list 1
1800: 20 32 20 33 29 20 28 28 61 20 62 20 63 20 2e 2e 2 3) ((a b c ..
1810: 2e 29 20 63 29 29 7d 0a 09 20 3b 3b 3e 20 5c 65 .) c))}.. ;;> \e
1820: 78 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 28 6c xample{(match (l
1830: 69 73 74 20 31 20 32 20 33 20 34 20 35 29 20 28 ist 1 2 3 4 5) (
1840: 28 61 20 62 20 63 20 2e 2e 2e 29 20 63 29 29 7d (a b c ...) c))}
1850: 0a 0a 09 20 3b 3b 3e 20 4d 6f 72 65 20 74 68 61 ... ;;> More tha
1860: 6e 20 6f 6e 65 20 5c 73 63 68 65 6d 65 7b 2e 2e n one \scheme{..
1870: 2e 7d 20 6d 61 79 20 6e 6f 74 20 62 65 20 75 73 .} may not be us
1880: 65 64 20 69 6e 20 74 68 65 20 73 61 6d 65 20 6c ed in the same l
1890: 69 73 74 2c 20 73 69 6e 63 65 0a 09 20 3b 3b 3e ist, since.. ;;>
18a0: 20 74 68 69 73 20 77 6f 75 6c 64 20 72 65 71 75 this would requ
18b0: 69 72 65 20 65 78 70 6f 6e 65 6e 74 69 61 6c 20 ire exponential
18c0: 62 61 63 6b 74 72 61 63 6b 69 6e 67 20 69 6e 20 backtracking in
18d0: 74 68 65 20 67 65 6e 65 72 61 6c 20 63 61 73 65 the general case
18e0: 2e 0a 09 20 3b 3b 3e 20 48 6f 77 65 76 65 72 2c ... ;;> However,
18f0: 20 5c 73 63 68 65 6d 65 7b 2e 2e 2e 7d 20 6e 65 \scheme{...} ne
1900: 65 64 20 6e 6f 74 20 62 65 20 74 68 65 20 66 69 ed not be the fi
1910: 6e 61 6c 20 65 6c 65 6d 65 6e 74 20 69 6e 20 74 nal element in t
1920: 68 65 20 6c 69 73 74 2c 0a 09 20 3b 3b 3e 20 61 he list,.. ;;> a
1930: 6e 64 20 6d 61 79 20 62 65 20 73 75 63 63 65 65 nd may be succee
1940: 64 65 64 20 62 79 20 61 20 66 69 78 65 64 20 6e ded by a fixed n
1950: 75 6d 62 65 72 20 6f 66 20 70 61 74 74 65 72 6e umber of pattern
1960: 73 2e 0a 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 s.... ;;> \examp
1970: 6c 65 7b 28 6d 61 74 63 68 20 28 6c 69 73 74 20 le{(match (list
1980: 31 20 32 20 33 20 34 29 20 28 28 61 20 62 20 63 1 2 3 4) ((a b c
1990: 20 2e 2e 2e 20 64 20 65 29 20 63 29 29 7d 0a 09 ... d e) c))}..
19a0: 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d ;;> \example{(m
19b0: 61 74 63 68 20 28 6c 69 73 74 20 31 20 32 20 33 atch (list 1 2 3
19c0: 20 34 20 35 29 20 28 28 61 20 62 20 63 20 2e 2e 4 5) ((a b c ..
19d0: 2e 20 64 20 65 29 20 63 29 29 7d 0a 09 20 3b 3b . d e) c))}.. ;;
19e0: 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 74 63 > \example{(matc
19f0: 68 20 28 6c 69 73 74 20 31 20 32 20 33 20 34 20 h (list 1 2 3 4
1a00: 35 20 36 20 37 29 20 28 28 61 20 62 20 63 20 2e 5 6 7) ((a b c .
1a10: 2e 2e 20 64 20 65 29 20 63 29 29 7d 0a 0a 09 20 .. d e) c))}...
1a20: 3b 3b 3e 20 5c 73 63 68 65 6d 65 7b 5f 5f 5f 7d ;;> \scheme{___}
1a30: 20 69 73 20 70 72 6f 76 69 64 65 64 20 61 73 20 is provided as
1a40: 61 6e 20 61 6c 69 61 73 20 66 6f 72 20 5c 73 63 an alias for \sc
1a50: 68 65 6d 65 7b 2e 2e 2e 7d 20 77 68 65 6e 20 69 heme{...} when i
1a60: 74 20 69 73 0a 09 20 3b 3b 3e 20 69 6e 63 6f 6e t is.. ;;> incon
1a70: 76 65 6e 69 65 6e 74 20 74 6f 20 75 73 65 20 74 venient to use t
1a80: 68 65 20 65 6c 6c 69 70 73 69 73 20 28 61 73 20 he ellipsis (as
1a90: 69 6e 20 61 20 73 79 6e 74 61 78 2d 72 75 6c 65 in a syntax-rule
1aa0: 73 20 74 65 6d 70 6c 61 74 65 29 2e 0a 0a 09 20 s template)....
1ab0: 3b 3b 3e 20 54 68 65 20 5c 73 63 68 65 6d 65 7b ;;> The \scheme{
1ac0: 2e 2e 31 7d 20 73 79 6e 74 61 78 20 69 73 20 65 ..1} syntax is e
1ad0: 78 61 63 74 6c 79 20 6c 69 6b 65 20 74 68 65 20 xactly like the
1ae0: 5c 73 63 68 65 6d 65 7b 2e 2e 2e 7d 20 65 78 63 \scheme{...} exc
1af0: 65 70 74 0a 09 20 3b 3b 3e 20 74 68 61 74 20 69 ept.. ;;> that i
1b00: 74 20 6d 61 74 63 68 65 73 20 6f 6e 65 20 6f 72 t matches one or
1b10: 20 6d 6f 72 65 20 72 65 70 65 74 69 74 69 6f 6e more repetition
1b20: 73 20 28 6c 69 6b 65 20 61 20 72 65 67 65 78 70 s (like a regexp
1b30: 20 22 2b 22 29 2e 0a 0a 09 20 3b 3b 3e 20 5c 65 "+").... ;;> \e
1b40: 78 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 28 6c xample{(match (l
1b50: 69 73 74 20 31 20 32 29 20 28 28 61 20 62 20 63 ist 1 2) ((a b c
1b60: 20 2e 2e 31 29 20 63 29 29 7d 0a 09 20 3b 3b 3e ..1) c))}.. ;;>
1b70: 20 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 74 63 68 \example{(match
1b80: 20 28 6c 69 73 74 20 31 20 32 20 33 29 20 28 28 (list 1 2 3) ((
1b90: 61 20 62 20 63 20 2e 2e 31 29 20 63 29 29 7d 0a a b c ..1) c))}.
1ba0: 0a 09 20 3b 3b 3e 20 54 68 65 20 62 6f 6f 6c 65 .. ;;> The boole
1bb0: 61 6e 20 6f 70 65 72 61 74 6f 72 73 20 5c 73 63 an operators \sc
1bc0: 68 65 6d 65 7b 61 6e 64 7d 2c 20 5c 73 63 68 65 heme{and}, \sche
1bd0: 6d 65 7b 6f 72 7d 20 61 6e 64 20 5c 73 63 68 65 me{or} and \sche
1be0: 6d 65 7b 6e 6f 74 7d 0a 09 20 3b 3b 3e 20 63 61 me{not}.. ;;> ca
1bf0: 6e 20 62 65 20 75 73 65 64 20 74 6f 20 67 72 6f n be used to gro
1c00: 75 70 20 61 6e 64 20 6e 65 67 61 74 65 20 70 61 up and negate pa
1c10: 74 74 65 72 6e 73 20 61 6e 61 6c 6f 67 6f 75 73 tterns analogous
1c20: 6c 79 20 74 6f 20 74 68 65 69 72 0a 09 20 3b 3b ly to their.. ;;
1c30: 3e 20 53 63 68 65 6d 65 20 63 6f 75 6e 74 65 72 > Scheme counter
1c40: 70 61 72 74 73 2e 0a 0a 09 20 3b 3b 3e 20 54 68 parts.... ;;> Th
1c50: 65 20 5c 73 63 68 65 6d 65 7b 61 6e 64 7d 20 6f e \scheme{and} o
1c60: 70 65 72 61 74 6f 72 20 65 6e 73 75 72 65 73 20 perator ensures
1c70: 74 68 61 74 20 61 6c 6c 20 73 75 62 70 61 74 74 that all subpatt
1c80: 65 72 6e 73 20 6d 61 74 63 68 2e 0a 09 20 3b 3b erns match... ;;
1c90: 3e 20 54 68 69 73 20 6f 70 65 72 61 74 6f 72 20 > This operator
1ca0: 69 73 20 6f 66 74 65 6e 20 75 73 65 64 20 77 69 is often used wi
1cb0: 74 68 20 74 68 65 20 69 64 69 6f 6d 20 5c 73 63 th the idiom \sc
1cc0: 68 65 6d 65 7b 28 61 6e 64 20 78 20 70 61 74 29 heme{(and x pat)
1cd0: 7d 20 74 6f 0a 09 20 3b 3b 3e 20 62 69 6e 64 20 } to.. ;;> bind
1ce0: 5c 76 61 72 7b 78 7d 20 74 6f 20 74 68 65 20 65 \var{x} to the e
1cf0: 6e 74 69 72 65 20 76 61 6c 75 65 20 74 68 61 74 ntire value that
1d00: 20 6d 61 74 63 68 65 73 20 5c 76 61 72 7b 70 61 matches \var{pa
1d10: 74 7d 0a 09 20 3b 3b 3e 20 28 63 2e 66 2e 20 22 t}.. ;;> (c.f. "
1d20: 61 73 2d 70 61 74 74 65 72 6e 73 22 20 69 6e 20 as-patterns" in
1d30: 4d 4c 20 6f 72 20 48 61 73 6b 65 6c 6c 29 2e 20 ML or Haskell).
1d40: 20 41 6e 6f 74 68 65 72 20 63 6f 6d 6d 6f 6e 20 Another common
1d50: 75 73 65 20 69 73 20 69 6e 0a 09 20 3b 3b 3e 20 use is in.. ;;>
1d60: 63 6f 6e 6a 75 6e 63 74 69 6f 6e 20 77 69 74 68 conjunction with
1d70: 20 5c 73 63 68 65 6d 65 7b 6e 6f 74 7d 20 70 61 \scheme{not} pa
1d80: 74 74 65 72 6e 73 20 74 6f 20 6d 61 74 63 68 20 tterns to match
1d90: 61 20 67 65 6e 65 72 61 6c 20 63 61 73 65 0a 09 a general case..
1da0: 20 3b 3b 3e 20 77 69 74 68 20 63 65 72 74 61 69 ;;> with certai
1db0: 6e 20 65 78 63 65 70 74 69 6f 6e 73 2e 0a 0a 09 n exceptions....
1dc0: 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d ;;> \example{(m
1dd0: 61 74 63 68 20 31 20 28 28 61 6e 64 29 20 23 74 atch 1 ((and) #t
1de0: 29 29 7d 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 ))}.. ;;> \examp
1df0: 6c 65 7b 28 6d 61 74 63 68 20 31 20 28 28 61 6e le{(match 1 ((an
1e00: 64 20 78 29 20 78 29 29 7d 0a 09 20 3b 3b 3e 20 d x) x))}.. ;;>
1e10: 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 \example{(match
1e20: 31 20 28 28 61 6e 64 20 78 20 31 29 20 78 29 29 1 ((and x 1) x))
1e30: 7d 0a 0a 09 20 3b 3b 3e 20 54 68 65 20 5c 73 63 }... ;;> The \sc
1e40: 68 65 6d 65 7b 6f 72 7d 20 6f 70 65 72 61 74 6f heme{or} operato
1e50: 72 20 65 6e 73 75 72 65 73 20 74 68 61 74 20 61 r ensures that a
1e60: 74 20 6c 65 61 73 74 20 6f 6e 65 20 73 75 62 70 t least one subp
1e70: 61 74 74 65 72 6e 0a 09 20 3b 3b 3e 20 6d 61 74 attern.. ;;> mat
1e80: 63 68 65 73 2e 20 20 49 66 20 74 68 65 20 73 61 ches. If the sa
1e90: 6d 65 20 69 64 65 6e 74 69 66 69 65 72 20 6f 63 me identifier oc
1ea0: 63 75 72 73 20 69 6e 20 64 69 66 66 65 72 65 6e curs in differen
1eb0: 74 20 73 75 62 70 61 74 74 65 72 6e 73 2c 0a 09 t subpatterns,..
1ec0: 20 3b 3b 3e 20 69 74 20 69 73 20 6d 61 74 63 68 ;;> it is match
1ed0: 65 64 20 69 6e 64 65 70 65 6e 64 65 6e 74 6c 79 ed independently
1ee0: 2e 20 20 41 6c 6c 20 69 64 65 6e 74 69 66 69 65 . All identifie
1ef0: 72 73 20 66 72 6f 6d 20 61 6c 6c 20 73 75 62 70 rs from all subp
1f00: 61 74 74 65 72 6e 73 0a 09 20 3b 3b 3e 20 61 72 atterns.. ;;> ar
1f10: 65 20 62 6f 75 6e 64 20 69 66 20 74 68 65 20 5c e bound if the \
1f20: 73 63 68 65 6d 65 7b 6f 72 7d 20 6f 70 65 72 61 scheme{or} opera
1f30: 74 6f 72 20 6d 61 74 63 68 65 73 2c 20 62 75 74 tor matches, but
1f40: 20 74 68 65 20 62 69 6e 64 69 6e 67 20 69 73 0a the binding is.
1f50: 09 20 3b 3b 3e 20 6f 6e 6c 79 20 64 65 66 69 6e . ;;> only defin
1f60: 65 64 20 66 6f 72 20 69 64 65 6e 74 69 66 69 65 ed for identifie
1f70: 72 73 20 66 72 6f 6d 20 74 68 65 20 73 75 62 70 rs from the subp
1f80: 61 74 74 65 72 6e 20 77 68 69 63 68 20 6d 61 74 attern which mat
1f90: 63 68 65 64 2e 0a 0a 09 20 3b 3b 3e 20 5c 65 78 ched.... ;;> \ex
1fa0: 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 31 20 28 ample{(match 1 (
1fb0: 28 6f 72 29 20 23 74 29 20 28 65 6c 73 65 20 23 (or) #t) (else #
1fc0: 66 29 29 7d 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d f))}.. ;;> \exam
1fd0: 70 6c 65 7b 28 6d 61 74 63 68 20 31 20 28 28 6f ple{(match 1 ((o
1fe0: 72 20 78 29 20 78 29 29 7d 0a 09 20 3b 3b 3e 20 r x) x))}.. ;;>
1ff0: 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 \example{(match
2000: 31 20 28 28 6f 72 20 78 20 32 29 20 78 29 29 7d 1 ((or x 2) x))}
2010: 0a 0a 09 20 3b 3b 3e 20 54 68 65 20 5c 73 63 68 ... ;;> The \sch
2020: 65 6d 65 7b 6e 6f 74 7d 20 6f 70 65 72 61 74 6f eme{not} operato
2030: 72 20 73 75 63 63 65 65 64 73 20 69 66 20 74 68 r succeeds if th
2040: 65 20 67 69 76 65 6e 20 70 61 74 74 65 72 6e 20 e given pattern
2050: 64 6f 65 73 6e 27 74 0a 09 20 3b 3b 3e 20 6d 61 doesn't.. ;;> ma
2060: 74 63 68 2e 20 20 4e 6f 6e 65 20 6f 66 20 74 68 tch. None of th
2070: 65 20 69 64 65 6e 74 69 66 69 65 72 73 20 75 73 e identifiers us
2080: 65 64 20 61 72 65 20 61 76 61 69 6c 61 62 6c 65 ed are available
2090: 20 69 6e 20 74 68 65 20 62 6f 64 79 2e 0a 0a 09 in the body....
20a0: 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d ;;> \example{(m
20b0: 61 74 63 68 20 31 20 28 28 6e 6f 74 20 32 29 20 atch 1 ((not 2)
20c0: 23 74 29 29 7d 0a 0a 09 20 3b 3b 3e 20 54 68 65 #t))}... ;;> The
20d0: 20 6d 6f 72 65 20 67 65 6e 65 72 61 6c 20 6f 70 more general op
20e0: 65 72 61 74 6f 72 20 5c 73 63 68 65 6d 65 7b 3f erator \scheme{?
20f0: 7d 20 63 61 6e 20 62 65 20 75 73 65 64 20 74 6f } can be used to
2100: 20 70 72 6f 76 69 64 65 20 61 0a 09 20 3b 3b 3e provide a.. ;;>
2110: 20 70 72 65 64 69 63 61 74 65 2e 20 20 54 68 65 predicate. The
2120: 20 75 73 61 67 65 20 69 73 20 5c 73 63 68 65 6d usage is \schem
2130: 65 7b 28 3f 20 70 72 65 64 69 63 61 74 65 20 70 e{(? predicate p
2140: 61 74 20 2e 2e 2e 29 7d 20 77 68 65 72 65 0a 09 at ...)} where..
2150: 20 3b 3b 3e 20 5c 76 61 72 7b 70 72 65 64 69 63 ;;> \var{predic
2160: 61 74 65 7d 20 69 73 20 61 20 53 63 68 65 6d 65 ate} is a Scheme
2170: 20 65 78 70 72 65 73 73 69 6f 6e 20 65 76 61 6c expression eval
2180: 75 61 74 69 6e 67 20 74 6f 20 61 20 70 72 65 64 uating to a pred
2190: 69 63 61 74 65 0a 09 20 3b 3b 3e 20 63 61 6c 6c icate.. ;;> call
21a0: 65 64 20 6f 6e 20 74 68 65 20 76 61 6c 75 65 20 ed on the value
21b0: 74 6f 20 6d 61 74 63 68 2c 20 61 6e 64 20 61 6e to match, and an
21c0: 79 20 6f 70 74 69 6f 6e 61 6c 20 70 61 74 74 65 y optional patte
21d0: 72 6e 73 20 61 66 74 65 72 20 74 68 65 0a 09 20 rns after the..
21e0: 3b 3b 3e 20 70 72 65 64 69 63 61 74 65 20 61 72 ;;> predicate ar
21f0: 65 20 74 68 65 6e 20 6d 61 74 63 68 65 64 20 61 e then matched a
2200: 73 20 69 6e 20 61 6e 20 5c 73 63 68 65 6d 65 7b s in an \scheme{
2210: 61 6e 64 7d 20 70 61 74 74 65 72 6e 2e 0a 0a 09 and} pattern....
2220: 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6d ;;> \example{(m
2230: 61 74 63 68 20 31 20 28 28 3f 20 6f 64 64 3f 20 atch 1 ((? odd?
2240: 78 29 20 78 29 29 7d 0a 0a 09 20 3b 3b 3e 20 54 x) x))}... ;;> T
2250: 68 65 20 66 69 65 6c 64 20 6f 70 65 72 61 74 6f he field operato
2260: 72 20 5c 73 63 68 65 6d 65 7b 3d 7d 20 69 73 20 r \scheme{=} is
2270: 75 73 65 64 20 74 6f 20 65 78 74 72 61 63 74 20 used to extract
2280: 61 6e 20 61 72 62 69 74 72 61 72 79 0a 09 20 3b an arbitrary.. ;
2290: 3b 3e 20 66 69 65 6c 64 20 61 6e 64 20 6d 61 74 ;> field and mat
22a0: 63 68 20 61 67 61 69 6e 73 74 20 69 74 2e 20 20 ch against it.
22b0: 49 74 20 69 73 20 75 73 65 66 75 6c 20 66 6f 72 It is useful for
22c0: 20 6d 6f 72 65 20 63 6f 6d 70 6c 65 78 20 6f 72 more complex or
22d0: 0a 09 20 3b 3b 3e 20 63 6f 6e 64 69 74 69 6f 6e .. ;;> condition
22e0: 61 6c 20 64 65 73 74 72 75 63 74 75 72 69 6e 67 al destructuring
22f0: 20 74 68 61 74 20 63 61 6e 27 74 20 62 65 20 6d that can't be m
2300: 6f 72 65 20 64 69 72 65 63 74 6c 79 20 65 78 70 ore directly exp
2310: 72 65 73 73 65 64 20 69 6e 0a 09 20 3b 3b 3e 20 ressed in.. ;;>
2320: 74 68 65 20 70 61 74 74 65 72 6e 20 73 79 6e 74 the pattern synt
2330: 61 78 2e 20 20 54 68 65 20 75 73 61 67 65 20 69 ax. The usage i
2340: 73 20 5c 73 63 68 65 6d 65 7b 28 3d 20 66 69 65 s \scheme{(= fie
2350: 6c 64 20 70 61 74 29 7d 2c 20 77 68 65 72 65 0a ld pat)}, where.
2360: 09 20 3b 3b 3e 20 5c 76 61 72 7b 66 69 65 6c 64 . ;;> \var{field
2370: 7d 20 63 61 6e 20 62 65 20 61 6e 79 20 65 78 70 } can be any exp
2380: 72 65 73 73 69 6f 6e 2c 20 61 6e 64 20 73 68 6f ression, and sho
2390: 75 6c 64 20 72 65 73 75 6c 74 20 69 6e 20 61 0a uld result in a.
23a0: 09 20 3b 3b 3e 20 70 72 6f 63 65 64 75 72 65 20 . ;;> procedure
23b0: 6f 66 20 6f 6e 65 20 61 72 67 75 6d 65 6e 74 2c of one argument,
23c0: 20 77 68 69 63 68 20 69 73 20 61 70 70 6c 69 65 which is applie
23d0: 64 20 74 6f 20 74 68 65 20 76 61 6c 75 65 20 74 d to the value t
23e0: 6f 20 6d 61 74 63 68 0a 09 20 3b 3b 3e 20 74 6f o match.. ;;> to
23f0: 20 67 65 6e 65 72 61 74 65 20 61 20 6e 65 77 20 generate a new
2400: 76 61 6c 75 65 20 74 6f 20 6d 61 74 63 68 20 61 value to match a
2410: 67 61 69 6e 73 74 20 5c 76 61 72 7b 70 61 74 7d gainst \var{pat}
2420: 2e 0a 0a 09 20 3b 3b 3e 20 54 68 75 73 20 74 68 .... ;;> Thus th
2430: 65 20 70 61 74 74 65 72 6e 20 5c 73 63 68 65 6d e pattern \schem
2440: 65 7b 28 61 6e 64 20 28 3d 20 63 61 72 20 78 29 e{(and (= car x)
2450: 20 28 3d 20 63 64 72 20 79 29 29 7d 20 69 73 20 (= cdr y))} is
2460: 65 71 75 69 76 61 6c 65 6e 74 0a 09 20 3b 3b 3e equivalent.. ;;>
2470: 20 74 6f 20 5c 73 63 68 65 6d 65 7b 28 78 20 2e to \scheme{(x .
2480: 20 79 29 7d 2c 20 65 78 63 65 70 74 20 69 74 20 y)}, except it
2490: 77 69 6c 6c 20 72 65 73 75 6c 74 20 69 6e 20 61 will result in a
24a0: 6e 20 69 6d 6d 65 64 69 61 74 65 20 65 72 72 6f n immediate erro
24b0: 72 0a 09 20 3b 3b 3e 20 69 66 20 74 68 65 20 76 r.. ;;> if the v
24c0: 61 6c 75 65 20 69 73 6e 27 74 20 61 20 70 61 69 alue isn't a pai
24d0: 72 2e 0a 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 r.... ;;> \examp
24e0: 6c 65 7b 28 6d 61 74 63 68 20 27 28 31 20 2e 20 le{(match '(1 .
24f0: 32 29 20 28 28 3d 20 63 61 72 20 78 29 20 78 29 2) ((= car x) x)
2500: 29 7d 0a 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c )}.. ;;> \exampl
2510: 65 7b 28 6d 61 74 63 68 20 34 20 28 28 3d 20 73 e{(match 4 ((= s
2520: 71 75 61 72 65 20 78 29 20 78 29 29 7d 0a 0a 09 quare x) x))}...
2530: 20 3b 3b 3e 20 54 68 65 20 72 65 63 6f 72 64 20 ;;> The record
2540: 6f 70 65 72 61 74 6f 72 20 5c 73 63 68 65 6d 65 operator \scheme
2550: 7b 24 7d 20 69 73 20 75 73 65 64 20 61 73 20 61 {$} is used as a
2560: 20 63 6f 6e 63 69 73 65 20 77 61 79 20 74 6f 20 concise way to
2570: 6d 61 74 63 68 0a 09 20 3b 3b 3e 20 72 65 63 6f match.. ;;> reco
2580: 72 64 73 20 64 65 66 69 6e 65 64 20 62 79 20 53 rds defined by S
2590: 52 46 49 2d 39 20 28 6f 72 20 53 52 46 49 2d 39 RFI-9 (or SRFI-9
25a0: 39 29 2e 20 20 54 68 65 20 75 73 61 67 65 20 69 9). The usage i
25b0: 73 0a 09 20 3b 3b 3e 20 5c 73 63 68 65 6d 65 7b s.. ;;> \scheme{
25c0: 28 24 20 72 74 64 20 66 69 65 6c 64 20 2e 2e 2e ($ rtd field ...
25d0: 29 7d 2c 20 77 68 65 72 65 20 5c 76 61 72 7b 72 )}, where \var{r
25e0: 74 64 7d 20 73 68 6f 75 6c 64 20 62 65 20 74 68 td} should be th
25f0: 65 20 72 65 63 6f 72 64 0a 09 20 3b 3b 3e 20 74 e record.. ;;> t
2600: 79 70 65 20 64 65 73 63 72 69 70 74 6f 72 20 73 ype descriptor s
2610: 70 65 63 69 66 69 65 64 20 61 73 20 74 68 65 20 pecified as the
2620: 66 69 72 73 74 20 61 72 67 75 6d 65 6e 74 20 74 first argument t
2630: 6f 0a 09 20 3b 3b 3e 20 5c 73 63 68 65 6d 65 7b o.. ;;> \scheme{
2640: 64 65 66 69 6e 65 2d 72 65 63 6f 72 64 2d 74 79 define-record-ty
2650: 70 65 7d 2c 20 61 6e 64 20 65 61 63 68 20 5c 76 pe}, and each \v
2660: 61 72 7b 66 69 65 6c 64 7d 20 69 73 20 61 20 73 ar{field} is a s
2670: 75 62 70 61 74 74 65 72 6e 0a 09 20 3b 3b 3e 20 ubpattern.. ;;>
2680: 6d 61 74 63 68 65 64 20 61 67 61 69 6e 73 74 20 matched against
2690: 74 68 65 20 66 69 65 6c 64 73 20 6f 66 20 74 68 the fields of th
26a0: 65 20 72 65 63 6f 72 64 20 69 6e 20 6f 72 64 65 e record in orde
26b0: 72 2e 20 20 4e 6f 74 20 61 6c 6c 20 66 69 65 6c r. Not all fiel
26c0: 64 73 0a 09 20 3b 3b 3e 20 6d 75 73 74 20 62 65 ds.. ;;> must be
26d0: 20 70 72 65 73 65 6e 74 2e 0a 0a 09 20 3b 3b 3e present.... ;;>
26e0: 20 5c 65 78 61 6d 70 6c 65 7b 0a 09 20 3b 3b 3e \example{.. ;;>
26f0: 20 28 6c 65 74 20 28 29 0a 09 20 3b 3b 3e 20 20 (let ().. ;;>
2700: 20 28 64 65 66 69 6e 65 2d 72 65 63 6f 72 64 2d (define-record-
2710: 74 79 70 65 20 65 6d 70 6c 6f 79 65 65 0a 09 20 type employee..
2720: 3b 3b 3e 20 20 20 20 20 28 6d 61 6b 65 2d 65 6d ;;> (make-em
2730: 70 6c 6f 79 65 65 20 6e 61 6d 65 20 74 69 74 6c ployee name titl
2740: 65 29 0a 09 20 3b 3b 3e 20 20 20 20 20 65 6d 70 e).. ;;> emp
2750: 6c 6f 79 65 65 3f 0a 09 20 3b 3b 3e 20 20 20 20 loyee?.. ;;>
2760: 20 28 6e 61 6d 65 20 67 65 74 2d 6e 61 6d 65 29 (name get-name)
2770: 0a 09 20 3b 3b 3e 20 20 20 20 20 28 74 69 74 6c .. ;;> (titl
2780: 65 20 67 65 74 2d 74 69 74 6c 65 29 29 0a 09 20 e get-title))..
2790: 3b 3b 3e 20 20 20 28 6d 61 74 63 68 20 28 6d 61 ;;> (match (ma
27a0: 6b 65 2d 65 6d 70 6c 6f 79 65 65 20 22 42 6f 62 ke-employee "Bob
27b0: 22 20 22 44 6f 63 74 6f 72 22 29 0a 09 20 3b 3b " "Doctor").. ;;
27c0: 3e 20 20 20 20 20 28 28 24 20 65 6d 70 6c 6f 79 > (($ employ
27d0: 65 65 20 6e 20 74 29 20 28 6c 69 73 74 20 74 20 ee n t) (list t
27e0: 6e 29 29 29 29 0a 09 20 3b 3b 3e 20 7d 0a 0a 09 n)))).. ;;> }...
27f0: 20 3b 3b 3e 20 46 6f 72 20 72 65 63 6f 72 64 73 ;;> For records
2800: 20 77 69 74 68 20 6d 6f 72 65 20 66 69 65 6c 64 with more field
2810: 73 20 69 74 20 63 61 6e 20 62 65 20 68 65 6c 70 s it can be help
2820: 66 75 6c 20 74 6f 20 6d 61 74 63 68 20 74 68 65 ful to match the
2830: 6d 20 62 79 0a 09 20 3b 3b 3e 20 6e 61 6d 65 20 m by.. ;;> name
2840: 72 61 74 68 65 72 20 74 68 61 6e 20 70 6f 73 69 rather than posi
2850: 74 69 6f 6e 2e 20 20 46 6f 72 20 74 68 69 73 20 tion. For this
2860: 79 6f 75 20 63 61 6e 20 75 73 65 20 74 68 65 20 you can use the
2870: 5c 73 63 68 65 6d 65 7b 40 7d 0a 09 20 3b 3b 3e \scheme{@}.. ;;>
2880: 20 6f 70 65 72 61 74 6f 72 2c 20 6f 72 69 67 69 operator, origi
2890: 6e 61 6c 6c 79 20 61 20 47 61 75 63 68 65 20 65 nally a Gauche e
28a0: 78 74 65 6e 73 69 6f 6e 3a 0a 0a 09 20 3b 3b 3e xtension:... ;;>
28b0: 20 5c 65 78 61 6d 70 6c 65 7b 0a 09 20 3b 3b 3e \example{.. ;;>
28c0: 20 28 6c 65 74 20 28 29 0a 09 20 3b 3b 3e 20 20 (let ().. ;;>
28d0: 20 28 64 65 66 69 6e 65 2d 72 65 63 6f 72 64 2d (define-record-
28e0: 74 79 70 65 20 65 6d 70 6c 6f 79 65 65 0a 09 20 type employee..
28f0: 3b 3b 3e 20 20 20 20 20 28 6d 61 6b 65 2d 65 6d ;;> (make-em
2900: 70 6c 6f 79 65 65 20 6e 61 6d 65 20 74 69 74 6c ployee name titl
2910: 65 29 0a 09 20 3b 3b 3e 20 20 20 20 20 65 6d 70 e).. ;;> emp
2920: 6c 6f 79 65 65 3f 0a 09 20 3b 3b 3e 20 20 20 20 loyee?.. ;;>
2930: 20 28 6e 61 6d 65 20 67 65 74 2d 6e 61 6d 65 29 (name get-name)
2940: 0a 09 20 3b 3b 3e 20 20 20 20 20 28 74 69 74 6c .. ;;> (titl
2950: 65 20 67 65 74 2d 74 69 74 6c 65 29 29 0a 09 20 e get-title))..
2960: 3b 3b 3e 20 20 20 28 6d 61 74 63 68 20 28 6d 61 ;;> (match (ma
2970: 6b 65 2d 65 6d 70 6c 6f 79 65 65 20 22 42 6f 62 ke-employee "Bob
2980: 22 20 22 44 6f 63 74 6f 72 22 29 0a 09 20 3b 3b " "Doctor").. ;;
2990: 3e 20 20 20 20 20 28 28 40 20 65 6d 70 6c 6f 79 > ((@ employ
29a0: 65 65 20 28 74 69 74 6c 65 20 74 29 20 28 6e 61 ee (title t) (na
29b0: 6d 65 20 6e 29 29 20 28 6c 69 73 74 20 74 20 6e me n)) (list t n
29c0: 29 29 29 29 0a 09 20 3b 3b 3e 20 7d 0a 0a 09 20 )))).. ;;> }...
29d0: 3b 3b 3e 20 54 68 65 20 5c 73 63 68 65 6d 65 7b ;;> The \scheme{
29e0: 73 65 74 21 7d 20 61 6e 64 20 5c 73 63 68 65 6d set!} and \schem
29f0: 65 7b 67 65 74 21 7d 20 6f 70 65 72 61 74 6f 72 e{get!} operator
2a00: 73 20 61 72 65 20 75 73 65 64 20 74 6f 20 62 69 s are used to bi
2a10: 6e 64 20 61 6e 0a 09 20 3b 3b 3e 20 69 64 65 6e nd an.. ;;> iden
2a20: 74 69 66 69 65 72 20 74 6f 20 74 68 65 20 73 65 tifier to the se
2a30: 74 74 65 72 20 61 6e 64 20 67 65 74 74 65 72 20 tter and getter
2a40: 6f 66 20 61 20 66 69 65 6c 64 2c 20 72 65 73 70 of a field, resp
2a50: 65 63 74 69 76 65 6c 79 2e 20 20 54 68 65 0a 09 ectively. The..
2a60: 20 3b 3b 3e 20 73 65 74 74 65 72 20 69 73 20 61 ;;> setter is a
2a70: 20 70 72 6f 63 65 64 75 72 65 20 6f 66 20 6f 6e procedure of on
2a80: 65 20 61 72 67 75 6d 65 6e 74 2c 20 77 68 69 63 e argument, whic
2a90: 68 20 6d 75 74 61 74 65 73 20 74 68 65 20 66 69 h mutates the fi
2aa0: 65 6c 64 20 74 6f 0a 09 20 3b 3b 3e 20 74 68 61 eld to.. ;;> tha
2ab0: 74 20 61 72 67 75 6d 65 6e 74 2e 20 20 54 68 65 t argument. The
2ac0: 20 67 65 74 74 65 72 20 69 73 20 61 20 70 72 6f getter is a pro
2ad0: 63 65 64 75 72 65 20 6f 66 20 6e 6f 20 61 72 67 cedure of no arg
2ae0: 75 6d 65 6e 74 73 20 77 68 69 63 68 0a 09 20 3b uments which.. ;
2af0: 3b 3e 20 72 65 74 75 72 6e 73 20 74 68 65 20 63 ;> returns the c
2b00: 75 72 72 65 6e 74 20 76 61 6c 75 65 20 6f 66 20 urrent value of
2b10: 74 68 65 20 66 69 65 6c 64 2e 0a 0a 09 20 3b 3b the field.... ;;
2b20: 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 6c 65 74 20 > \example{(let
2b30: 28 28 78 20 28 63 6f 6e 73 20 31 20 32 29 29 29 ((x (cons 1 2)))
2b40: 20 28 6d 61 74 63 68 20 78 20 28 28 31 20 2e 20 (match x ((1 .
2b50: 28 73 65 74 21 20 73 29 29 20 28 73 20 33 29 20 (set! s)) (s 3)
2b60: 78 29 29 29 7d 0a 09 20 3b 3b 3e 20 5c 65 78 61 x)))}.. ;;> \exa
2b70: 6d 70 6c 65 7b 28 6d 61 74 63 68 20 27 28 31 20 mple{(match '(1
2b80: 2e 20 32 29 20 28 28 31 20 2e 20 28 67 65 74 21 . 2) ((1 . (get!
2b90: 20 67 29 29 20 28 67 29 29 29 7d 0a 0a 09 20 3b g)) (g)))}... ;
2ba0: 3b 3e 20 54 68 65 20 6e 65 77 20 6f 70 65 72 61 ;> The new opera
2bb0: 74 6f 72 20 5c 73 63 68 65 6d 65 7b 2a 2a 2a 7d tor \scheme{***}
2bc0: 20 63 61 6e 20 62 65 20 75 73 65 64 20 74 6f 20 can be used to
2bd0: 73 65 61 72 63 68 20 61 20 74 72 65 65 20 66 6f search a tree fo
2be0: 72 0a 09 20 3b 3b 3e 20 73 75 62 70 61 74 74 65 r.. ;;> subpatte
2bf0: 72 6e 73 2e 20 20 41 20 70 61 74 74 65 72 6e 20 rns. A pattern
2c00: 6f 66 20 74 68 65 20 66 6f 72 6d 20 5c 73 63 68 of the form \sch
2c10: 65 6d 65 7b 28 78 20 2a 2a 2a 20 79 29 7d 20 72 eme{(x *** y)} r
2c20: 65 70 72 65 73 65 6e 74 73 0a 09 20 3b 3b 3e 20 epresents.. ;;>
2c30: 74 68 65 20 73 75 62 70 61 74 74 65 72 6e 20 5c the subpattern \
2c40: 76 61 72 7b 79 7d 20 6c 6f 63 61 74 65 64 20 73 var{y} located s
2c50: 6f 6d 65 77 68 65 72 65 20 69 6e 20 61 20 74 72 omewhere in a tr
2c60: 65 65 20 77 68 65 72 65 20 74 68 65 20 70 61 74 ee where the pat
2c70: 68 0a 09 20 3b 3b 3e 20 66 72 6f 6d 20 74 68 65 h.. ;;> from the
2c80: 20 63 75 72 72 65 6e 74 20 6f 62 6a 65 63 74 20 current object
2c90: 74 6f 20 5c 76 61 72 7b 79 7d 20 63 61 6e 20 62 to \var{y} can b
2ca0: 65 20 73 65 65 6e 20 61 73 20 61 20 6c 69 73 74 e seen as a list
2cb0: 20 6f 66 20 74 68 65 0a 09 20 3b 3b 3e 20 66 6f of the.. ;;> fo
2cc0: 72 6d 20 5c 73 63 68 65 6d 65 7b 28 78 20 2e 2e rm \scheme{(x ..
2cd0: 2e 29 7d 2e 20 20 5c 76 61 72 7b 79 7d 20 63 61 .)}. \var{y} ca
2ce0: 6e 20 69 6d 6d 65 64 69 61 74 65 6c 79 20 6d 61 n immediately ma
2cf0: 74 63 68 20 74 68 65 20 63 75 72 72 65 6e 74 0a tch the current.
2d00: 09 20 3b 3b 3e 20 6f 62 6a 65 63 74 20 69 6e 20 . ;;> object in
2d10: 77 68 69 63 68 20 63 61 73 65 20 74 68 65 20 70 which case the p
2d20: 61 74 68 20 69 73 20 74 68 65 20 65 6d 70 74 79 ath is the empty
2d30: 20 6c 69 73 74 2e 20 20 49 6e 20 61 20 73 65 6e list. In a sen
2d40: 73 65 20 69 74 27 73 0a 09 20 3b 3b 3e 20 61 20 se it's.. ;;> a
2d50: 32 2d 64 69 6d 65 6e 73 69 6f 6e 61 6c 20 76 65 2-dimensional ve
2d60: 72 73 69 6f 6e 20 6f 66 20 74 68 65 20 5c 73 63 rsion of the \sc
2d70: 68 65 6d 65 7b 2e 2e 2e 7d 20 70 61 74 74 65 72 heme{...} patter
2d80: 6e 2e 0a 0a 09 20 3b 3b 3e 20 41 73 20 61 20 63 n.... ;;> As a c
2d90: 6f 6d 6d 6f 6e 20 63 61 73 65 20 74 68 65 20 70 ommon case the p
2da0: 61 74 74 65 72 6e 20 5c 73 63 68 65 6d 65 7b 28 attern \scheme{(
2db0: 5f 20 2a 2a 2a 20 79 29 7d 20 63 61 6e 20 62 65 _ *** y)} can be
2dc0: 20 75 73 65 64 20 74 6f 0a 09 20 3b 3b 3e 20 73 used to.. ;;> s
2dd0: 65 61 72 63 68 20 66 6f 72 20 5c 76 61 72 7b 79 earch for \var{y
2de0: 7d 20 61 6e 79 77 68 65 72 65 20 69 6e 20 61 20 } anywhere in a
2df0: 74 72 65 65 2c 20 72 65 67 61 72 64 6c 65 73 73 tree, regardless
2e00: 20 6f 66 20 74 68 65 20 70 61 74 68 0a 09 20 3b of the path.. ;
2e10: 3b 3e 20 75 73 65 64 2e 0a 0a 09 20 3b 3b 3e 20 ;> used.... ;;>
2e20: 5c 65 78 61 6d 70 6c 65 7b 28 6d 61 74 63 68 20 \example{(match
2e30: 27 28 61 20 28 61 20 28 61 20 62 29 29 29 20 28 '(a (a (a b))) (
2e40: 28 78 20 2a 2a 2a 20 27 62 29 20 78 29 29 7d 0a (x *** 'b) x))}.
2e50: 09 20 3b 3b 3e 20 5c 65 78 61 6d 70 6c 65 7b 28 . ;;> \example{(
2e60: 6d 61 74 63 68 20 27 28 61 20 28 62 29 20 28 63 match '(a (b) (c
2e70: 20 28 64 20 65 29 20 28 66 20 67 29 29 29 20 28 (d e) (f g))) (
2e80: 28 78 20 2a 2a 2a 20 27 67 29 20 78 29 29 7d 0a (x *** 'g) x))}.
2e90: 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b .;;;;;;;;;;;;;;;
2ea0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2eb0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2ec0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
2ed0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 09 20 3b 3b 20 4e ;;;;;;;;;.. ;; N
2ee0: 6f 74 65 73 0a 0a 09 20 3b 3b 20 54 68 65 20 69 otes... ;; The i
2ef0: 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 69 73 mplementation is
2f00: 20 61 20 73 69 6d 70 6c 65 20 67 65 6e 65 72 61 a simple genera
2f10: 74 69 76 65 20 70 61 74 74 65 72 6e 20 6d 61 74 tive pattern mat
2f20: 63 68 65 72 20 2d 20 65 61 63 68 0a 09 20 3b 3b cher - each.. ;;
2f30: 20 70 61 74 74 65 72 6e 20 69 73 20 65 78 70 61 pattern is expa
2f40: 6e 64 65 64 20 69 6e 74 6f 20 74 68 65 20 72 65 nded into the re
2f50: 71 75 69 72 65 64 20 74 65 73 74 73 2c 20 63 61 quired tests, ca
2f60: 6c 6c 69 6e 67 20 61 20 66 61 69 6c 75 72 65 0a lling a failure.
2f70: 09 20 3b 3b 20 63 6f 6e 74 69 6e 75 61 74 69 6f . ;; continuatio
2f80: 6e 20 69 66 20 74 68 65 20 74 65 73 74 73 20 66 n if the tests f
2f90: 61 69 6c 2e 20 20 54 68 69 73 20 6d 61 6b 65 73 ail. This makes
2fa0: 20 74 68 65 20 6c 6f 67 69 63 20 65 61 73 79 20 the logic easy
2fb0: 74 6f 0a 09 20 3b 3b 20 66 6f 6c 6c 6f 77 20 61 to.. ;; follow a
2fc0: 6e 64 20 65 78 74 65 6e 64 2c 20 62 75 74 20 70 nd extend, but p
2fd0: 72 6f 64 75 63 65 73 20 73 75 62 2d 6f 70 74 69 roduces sub-opti
2fe0: 6d 61 6c 20 63 6f 64 65 20 69 6e 20 63 61 73 65 mal code in case
2ff0: 73 20 77 68 65 72 65 20 79 6f 75 0a 09 20 3b 3b s where you.. ;;
3000: 20 68 61 76 65 20 6d 61 6e 79 20 73 69 6d 69 6c have many simil
3010: 61 72 20 63 6c 61 75 73 65 73 20 64 75 65 20 74 ar clauses due t
3020: 6f 20 72 65 70 65 61 74 69 6e 67 20 74 68 65 20 o repeating the
3030: 73 61 6d 65 20 74 65 73 74 73 2e 0a 09 20 3b 3b same tests... ;;
3040: 20 4e 6f 6e 65 74 68 65 6c 65 73 73 20 61 20 73 Nonetheless a s
3050: 6d 61 72 74 20 63 6f 6d 70 69 6c 65 72 20 73 68 mart compiler sh
3060: 6f 75 6c 64 20 62 65 20 61 62 6c 65 20 74 6f 20 ould be able to
3070: 72 65 6d 6f 76 65 20 74 68 65 20 72 65 64 75 6e remove the redun
3080: 64 61 6e 74 0a 09 20 3b 3b 20 74 65 73 74 73 2e dant.. ;; tests.
3090: 20 20 46 6f 72 20 4d 41 54 43 48 2d 4c 45 54 20 For MATCH-LET
30a0: 61 6e 64 20 44 45 53 54 52 55 43 54 55 52 49 4e and DESTRUCTURIN
30b0: 47 2d 42 49 4e 44 20 74 79 70 65 20 75 73 65 73 G-BIND type uses
30c0: 20 74 68 65 72 65 20 69 73 20 6e 6f 0a 09 20 3b there is no.. ;
30d0: 3b 20 70 65 72 66 6f 72 6d 61 6e 63 65 20 68 69 ; performance hi
30e0: 74 2e 0a 0a 09 20 3b 3b 20 54 68 65 20 6f 72 69 t.... ;; The ori
30f0: 67 69 6e 61 6c 20 76 65 72 73 69 6f 6e 20 77 61 ginal version wa
3100: 73 20 77 72 69 74 74 65 6e 20 6f 6e 20 32 30 30 s written on 200
3110: 36 2f 31 31 2f 32 39 20 61 6e 64 20 64 65 73 63 6/11/29 and desc
3120: 72 69 62 65 64 20 69 6e 20 74 68 65 0a 09 20 3b ribed in the.. ;
3130: 3b 20 66 6f 6c 6c 6f 77 69 6e 67 20 55 73 65 6e ; following Usen
3140: 65 74 20 70 6f 73 74 3a 0a 09 20 3b 3b 20 20 20 et post:.. ;;
3150: 68 74 74 70 3a 2f 2f 67 72 6f 75 70 73 2e 67 6f http://groups.go
3160: 6f 67 6c 65 2e 63 6f 6d 2f 67 72 6f 75 70 2f 63 ogle.com/group/c
3170: 6f 6d 70 2e 6c 61 6e 67 2e 73 63 68 65 6d 65 2f omp.lang.scheme/
3180: 6d 73 67 2f 30 39 34 31 32 33 34 64 65 37 31 31 msg/0941234de711
3190: 32 66 66 64 0a 09 20 3b 3b 20 61 6e 64 20 69 73 2ffd.. ;; and is
31a0: 20 73 74 69 6c 6c 20 61 76 61 69 6c 61 62 6c 65 still available
31b0: 20 61 74 0a 09 20 3b 3b 20 20 20 68 74 74 70 3a at.. ;; http:
31c0: 2f 2f 73 79 6e 74 68 63 6f 64 65 2e 63 6f 6d 2f //synthcode.com/
31d0: 73 63 68 65 6d 65 2f 6d 61 74 63 68 2d 73 69 6d scheme/match-sim
31e0: 70 6c 65 2e 73 63 6d 0a 09 20 3b 3b 20 49 74 27 ple.scm.. ;; It'
31f0: 73 20 6a 75 73 74 20 38 30 20 6c 69 6e 65 73 20 s just 80 lines
3200: 66 6f 72 20 74 68 65 20 63 6f 72 65 20 4d 41 54 for the core MAT
3210: 43 48 2c 20 61 6e 64 20 61 6e 20 65 78 74 72 61 CH, and an extra
3220: 20 34 30 20 6c 69 6e 65 73 20 66 6f 72 0a 09 20 40 lines for..
3230: 3b 3b 20 4d 41 54 43 48 2d 4c 45 54 2c 20 4d 41 ;; MATCH-LET, MA
3240: 54 43 48 2d 4c 41 4d 42 44 41 20 61 6e 64 20 6f TCH-LAMBDA and o
3250: 74 68 65 72 20 73 79 6e 74 61 63 74 69 63 20 73 ther syntactic s
3260: 75 67 61 72 2e 0a 09 20 3b 3b 0a 09 20 3b 3b 20 ugar... ;;.. ;;
3270: 41 20 76 61 72 69 61 6e 74 20 6f 66 20 74 68 69 A variant of thi
3280: 73 20 66 69 6c 65 20 77 68 69 63 68 20 75 73 65 s file which use
3290: 73 20 43 4f 4e 44 2d 45 58 50 41 4e 44 20 69 6e s COND-EXPAND in
32a0: 20 61 20 66 65 77 20 70 6c 61 63 65 73 20 66 6f a few places fo
32b0: 72 0a 09 20 3b 3b 20 70 65 72 66 6f 72 6d 61 6e r.. ;; performan
32c0: 63 65 20 63 61 6e 20 62 65 20 66 6f 75 6e 64 20 ce can be found
32d0: 61 74 0a 09 20 3b 3b 20 20 20 68 74 74 70 3a 2f at.. ;; http:/
32e0: 2f 73 79 6e 74 68 63 6f 64 65 2e 63 6f 6d 2f 73 /synthcode.com/s
32f0: 63 68 65 6d 65 2f 6d 61 74 63 68 2d 63 6f 6e 64 cheme/match-cond
3300: 2d 65 78 70 61 6e 64 2e 73 63 6d 0a 09 20 3b 3b -expand.scm.. ;;
3310: 0a 09 20 3b 3b 20 32 30 31 36 2f 30 33 2f 30 36 .. ;; 2016/03/06
3320: 20 2d 20 66 69 78 69 6e 67 20 6e 61 6d 65 64 20 - fixing named
3330: 6d 61 74 63 68 2d 6c 65 74 20 28 74 68 61 6e 6b match-let (thank
3340: 73 20 74 6f 20 53 74 65 66 61 6e 20 49 73 72 61 s to Stefan Isra
3350: 65 6c 73 73 6f 6e 20 54 61 6d 70 65 29 0a 09 20 elsson Tampe)..
3360: 3b 3b 20 32 30 31 35 2f 30 35 2f 30 39 20 2d 20 ;; 2015/05/09 -
3370: 66 69 78 69 6e 67 20 62 75 67 20 69 6e 20 76 61 fixing bug in va
3380: 72 20 65 78 74 72 61 63 74 69 6f 6e 20 6f 66 20 r extraction of
3390: 71 75 61 73 69 71 75 6f 74 65 20 70 61 74 74 65 quasiquote patte
33a0: 72 6e 73 0a 09 20 3b 3b 20 32 30 31 34 2f 31 31 rns.. ;; 2014/11
33b0: 2f 32 34 20 2d 20 61 64 64 69 6e 67 20 47 61 75 /24 - adding Gau
33c0: 63 68 65 27 73 20 60 40 27 20 70 61 74 74 65 72 che's `@' patter
33d0: 6e 20 66 6f 72 20 6e 61 6d 65 64 20 72 65 63 6f n for named reco
33e0: 72 64 20 66 69 65 6c 64 20 6d 61 74 63 68 69 6e rd field matchin
33f0: 67 0a 09 20 3b 3b 20 32 30 31 32 2f 31 32 2f 32 g.. ;; 2012/12/2
3400: 36 20 2d 20 77 72 61 70 70 69 6e 67 20 6d 61 74 6 - wrapping mat
3410: 63 68 2d 6c 65 74 26 63 6f 20 62 6f 64 79 20 69 ch-let&co body i
3420: 6e 20 6c 65 78 69 63 61 6c 20 63 6c 6f 73 75 72 n lexical closur
3430: 65 0a 09 20 3b 3b 20 32 30 31 32 2f 31 31 2f 32 e.. ;; 2012/11/2
3440: 38 20 2d 20 66 69 78 69 6e 67 20 74 79 70 6f 20 8 - fixing typo
3450: 73 2f 76 65 74 6f 72 2f 76 65 63 74 6f 72 20 69 s/vetor/vector i
3460: 6e 20 6c 61 72 67 65 6c 79 20 75 6e 75 73 65 64 n largely unused
3470: 20 73 65 74 21 20 63 6f 64 65 0a 09 20 3b 3b 20 set! code.. ;;
3480: 32 30 31 32 2f 30 35 2f 32 33 20 2d 20 66 69 78 2012/05/23 - fix
3490: 69 6e 67 20 63 6f 6d 62 69 6e 61 74 6f 72 69 61 ing combinatoria
34a0: 6c 20 65 78 70 6c 6f 73 69 6f 6e 20 6f 66 20 63 l explosion of c
34b0: 6f 64 65 20 69 6e 20 63 65 72 74 61 69 6e 20 6f ode in certain o
34c0: 72 20 70 61 74 74 65 72 6e 73 0a 09 20 3b 3b 20 r patterns.. ;;
34d0: 32 30 31 31 2f 30 39 2f 32 35 20 2d 20 66 69 78 2011/09/25 - fix
34e0: 69 6e 67 20 62 75 67 20 77 68 65 6e 20 64 69 72 ing bug when dir
34f0: 65 63 74 6c 79 20 6d 61 74 63 68 69 6e 67 20 61 ectly matching a
3500: 6e 20 69 64 65 6e 74 69 66 69 65 72 20 72 65 70 n identifier rep
3510: 65 61 74 65 64 20 69 6e 0a 09 20 3b 3b 20 20 20 eated in.. ;;
3520: 20 20 20 20 20 20 20 20 20 20 20 74 68 65 20 70 the p
3530: 61 74 74 65 72 6e 20 28 74 68 61 6e 6b 73 20 74 attern (thanks t
3540: 6f 20 53 74 65 66 61 6e 20 49 73 72 61 65 6c 73 o Stefan Israels
3550: 73 6f 6e 20 54 61 6d 70 65 29 0a 09 20 3b 3b 20 son Tampe).. ;;
3560: 32 30 31 31 2f 30 31 2f 32 37 20 2d 20 66 69 78 2011/01/27 - fix
3570: 69 6e 67 20 62 75 67 20 77 68 65 6e 20 6d 61 74 ing bug when mat
3580: 63 68 69 6e 67 20 74 61 69 6c 20 70 61 74 74 65 ching tail patte
3590: 72 6e 73 20 61 67 61 69 6e 73 74 20 69 6d 70 72 rns against impr
35a0: 6f 70 65 72 20 6c 69 73 74 73 0a 09 20 3b 3b 20 oper lists.. ;;
35b0: 32 30 31 30 2f 30 39 2f 32 36 20 2d 20 61 64 64 2010/09/26 - add
35c0: 69 6e 67 20 60 2e 2e 31 27 20 70 61 74 74 65 72 ing `..1' patter
35d0: 6e 73 20 28 74 68 61 6e 6b 73 20 74 6f 20 4c 75 ns (thanks to Lu
35e0: 64 6f 76 69 63 20 43 6f 75 72 74 c3 a8 73 29 0a dovic Court..s).
35f0: 09 20 3b 3b 20 32 30 31 30 2f 30 39 2f 30 37 20 . ;; 2010/09/07
3600: 2d 20 66 69 78 69 6e 67 20 69 64 65 6e 74 69 66 - fixing identif
3610: 69 65 72 20 65 78 74 72 61 63 74 69 6f 6e 20 69 ier extraction i
3620: 6e 20 73 6f 6d 65 20 60 2e 2e 2e 27 20 61 6e 64 n some `...' and
3630: 20 60 2a 2a 2a 27 20 70 61 74 74 65 72 6e 73 0a `***' patterns.
3640: 09 20 3b 3b 20 32 30 30 39 2f 31 31 2f 32 35 20 . ;; 2009/11/25
3650: 2d 20 61 64 64 69 6e 67 20 60 2a 2a 2a 27 20 74 - adding `***' t
3660: 72 65 65 20 73 65 61 72 63 68 20 70 61 74 74 65 ree search patte
3670: 72 6e 73 0a 09 20 3b 3b 20 32 30 30 38 2f 30 33 rns.. ;; 2008/03
3680: 2f 32 30 20 2d 20 66 69 78 69 6e 67 20 62 75 67 /20 - fixing bug
3690: 20 77 68 65 72 65 20 28 61 20 2e 2e 2e 29 20 6d where (a ...) m
36a0: 61 74 63 68 65 64 20 6e 6f 6e 2d 6c 69 73 74 73 atched non-lists
36b0: 0a 09 20 3b 3b 20 32 30 30 38 2f 30 33 2f 31 35 .. ;; 2008/03/15
36c0: 20 2d 20 72 65 6d 6f 76 69 6e 67 20 72 65 64 75 - removing redu
36d0: 6e 64 61 6e 74 20 63 68 65 63 6b 20 69 6e 20 76 ndant check in v
36e0: 65 63 74 6f 72 20 70 61 74 74 65 72 6e 73 0a 09 ector patterns..
36f0: 20 3b 3b 20 32 30 30 38 2f 30 33 2f 30 36 20 2d ;; 2008/03/06 -
3700: 20 79 6f 75 20 63 61 6e 20 75 73 65 20 60 2e 2e you can use `..
3710: 2e 27 20 70 6f 72 74 61 62 6c 79 20 6e 6f 77 20 .' portably now
3720: 28 74 68 61 6e 6b 73 20 74 6f 20 54 61 79 6c 6f (thanks to Taylo
3730: 72 20 43 61 6d 70 62 65 6c 6c 29 0a 09 20 3b 3b r Campbell).. ;;
3740: 20 32 30 30 37 2f 30 39 2f 30 34 20 2d 20 66 69 2007/09/04 - fi
3750: 78 69 6e 67 20 71 75 61 73 69 71 75 6f 74 65 20 xing quasiquote
3760: 70 61 74 74 65 72 6e 73 0a 09 20 3b 3b 20 32 30 patterns.. ;; 20
3770: 30 37 2f 30 37 2f 32 31 20 2d 20 61 6c 6c 6f 77 07/07/21 - allow
3780: 69 6e 67 20 65 6c 6c 69 70 73 69 73 20 70 61 74 ing ellipsis pat
3790: 74 65 72 6e 73 20 69 6e 20 6e 6f 6e 2d 66 69 6e terns in non-fin
37a0: 61 6c 20 6c 69 73 74 20 70 6f 73 69 74 69 6f 6e al list position
37b0: 73 0a 09 20 3b 3b 20 32 30 30 37 2f 30 34 2f 31 s.. ;; 2007/04/1
37c0: 30 20 2d 20 66 69 78 69 6e 67 20 70 6f 74 65 6e 0 - fixing poten
37d0: 74 69 61 6c 20 68 79 67 69 65 6e 65 20 69 73 73 tial hygiene iss
37e0: 75 65 20 69 6e 20 6d 61 74 63 68 2d 63 68 65 63 ue in match-chec
37f0: 6b 2d 65 6c 6c 69 70 73 69 73 0a 09 20 3b 3b 20 k-ellipsis.. ;;
3800: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 74 68 (th
3810: 61 6e 6b 73 20 74 6f 20 54 61 79 6c 6f 72 20 43 anks to Taylor C
3820: 61 6d 70 62 65 6c 6c 29 0a 09 20 3b 3b 20 32 30 ampbell).. ;; 20
3830: 30 37 2f 30 34 2f 30 38 20 2d 20 63 6c 65 61 6e 07/04/08 - clean
3840: 20 75 70 2c 20 63 6f 6d 6d 65 6e 74 69 6e 67 0a up, commenting.
3850: 09 20 3b 3b 20 32 30 30 36 2f 31 32 2f 32 34 20 . ;; 2006/12/24
3860: 2d 20 62 75 67 66 69 78 65 73 0a 09 20 3b 3b 20 - bugfixes.. ;;
3870: 32 30 30 36 2f 31 32 2f 30 31 20 2d 20 6e 6f 6e 2006/12/01 - non
3880: 2d 6c 69 6e 65 61 72 20 70 61 74 74 65 72 6e 73 -linear patterns
3890: 2c 20 73 68 61 72 65 64 20 76 61 72 69 61 62 6c , shared variabl
38a0: 65 73 20 69 6e 20 4f 52 2c 20 67 65 74 21 2f 73 es in OR, get!/s
38b0: 65 74 21 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b et!..;;;;;;;;;;;
38c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
38d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
38e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
38f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 09 20 ;;;;;;;;;;;;;..
3900: 3b 3b 20 66 6f 72 63 65 20 63 6f 6d 70 69 6c 65 ;; force compile
3910: 2d 74 69 6d 65 20 73 79 6e 74 61 78 20 65 72 72 -time syntax err
3920: 6f 72 73 20 77 69 74 68 20 75 73 65 66 75 6c 20 ors with useful
3930: 6d 65 73 73 61 67 65 73 0a 0a 09 20 28 64 65 66 messages... (def
3940: 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 ine-syntax match
3950: 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 0a 09 20 -syntax-error..
3960: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
3970: 0a 09 20 28 28 5f 29 20 28 6d 61 74 63 68 2d 73 .. ((_) (match-s
3980: 79 6e 74 61 78 2d 65 72 72 6f 72 20 22 69 6e 76 yntax-error "inv
3990: 61 6c 69 64 20 6d 61 74 63 68 2d 73 79 6e 74 61 alid match-synta
39a0: 78 2d 65 72 72 6f 72 20 75 73 61 67 65 22 29 29 x-error usage"))
39b0: 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ))..;;;;;;;;;;;;
39c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
39d0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
39e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
39f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 0a 09 20 ;;;;;;;;;;;;...
3a00: 3b 3b 3e 20 5c 73 65 63 74 69 6f 6e 7b 53 79 6e ;;> \section{Syn
3a10: 74 61 78 7d 0a 0a 09 20 3b 3b 3e 20 5c 6d 61 63 tax}... ;;> \mac
3a20: 72 6f 7b 28 6d 61 74 63 68 20 65 78 70 72 20 28 ro{(match expr (
3a30: 70 61 74 74 65 72 6e 20 2e 20 62 6f 64 79 29 20 pattern . body)
3a40: 2e 2e 2e 29 5c 62 72 7b 7d 0a 09 20 3b 3b 3e 20 ...)\br{}.. ;;>
3a50: 28 6d 61 74 63 68 20 65 78 70 72 20 28 70 61 74 (match expr (pat
3a60: 74 65 72 6e 20 28 3d 3e 20 66 61 69 6c 75 72 65 tern (=> failure
3a70: 29 20 2e 20 62 6f 64 79 29 20 2e 2e 2e 29 7d 0a ) . body) ...)}.
3a80: 0a 09 20 3b 3b 3e 20 54 68 65 20 72 65 73 75 6c .. ;;> The resul
3a90: 74 20 6f 66 20 5c 76 61 72 7b 65 78 70 72 7d 20 t of \var{expr}
3aa0: 69 73 20 6d 61 74 63 68 65 64 20 61 67 61 69 6e is matched again
3ab0: 73 74 20 65 61 63 68 20 5c 76 61 72 7b 70 61 74 st each \var{pat
3ac0: 74 65 72 6e 7d 20 69 6e 0a 09 20 3b 3b 3e 20 74 tern} in.. ;;> t
3ad0: 75 72 6e 2c 20 61 63 63 6f 72 64 69 6e 67 20 74 urn, according t
3ae0: 6f 20 74 68 65 20 70 61 74 74 65 72 6e 20 72 75 o the pattern ru
3af0: 6c 65 73 20 64 65 73 63 72 69 62 65 64 20 69 6e les described in
3b00: 20 74 68 65 20 70 72 65 76 69 6f 75 73 0a 09 20 the previous..
3b10: 3b 3b 3e 20 73 65 63 74 69 6f 6e 2c 20 75 6e 74 ;;> section, unt
3b20: 69 6c 20 74 68 65 20 74 68 65 20 66 69 72 73 74 il the the first
3b30: 20 5c 76 61 72 7b 70 61 74 74 65 72 6e 7d 20 6d \var{pattern} m
3b40: 61 74 63 68 65 73 2e 20 20 57 68 65 6e 20 61 20 atches. When a
3b50: 6d 61 74 63 68 20 69 73 0a 09 20 3b 3b 3e 20 66 match is.. ;;> f
3b60: 6f 75 6e 64 2c 20 74 68 65 20 63 6f 72 72 65 73 ound, the corres
3b70: 70 6f 6e 64 69 6e 67 20 5c 76 61 72 7b 62 6f 64 ponding \var{bod
3b80: 79 7d 73 20 61 72 65 20 65 76 61 6c 75 61 74 65 y}s are evaluate
3b90: 64 20 69 6e 20 6f 72 64 65 72 2c 0a 09 20 3b 3b d in order,.. ;;
3ba0: 3e 20 61 6e 64 20 74 68 65 20 72 65 73 75 6c 74 > and the result
3bb0: 20 6f 66 20 74 68 65 20 6c 61 73 74 20 65 78 70 of the last exp
3bc0: 72 65 73 73 69 6f 6e 20 69 73 20 72 65 74 75 72 ression is retur
3bd0: 6e 65 64 20 61 73 20 74 68 65 20 72 65 73 75 6c ned as the resul
3be0: 74 0a 09 20 3b 3b 3e 20 6f 66 20 74 68 65 20 65 t.. ;;> of the e
3bf0: 6e 74 69 72 65 20 5c 73 63 68 65 6d 65 7b 6d 61 ntire \scheme{ma
3c00: 74 63 68 7d 2e 20 20 49 66 20 61 20 5c 76 61 72 tch}. If a \var
3c10: 7b 66 61 69 6c 75 72 65 7d 20 69 73 20 70 72 6f {failure} is pro
3c20: 76 69 64 65 64 2c 0a 09 20 3b 3b 3e 20 74 68 65 vided,.. ;;> the
3c30: 6e 20 69 74 20 69 73 20 62 6f 75 6e 64 20 74 6f n it is bound to
3c40: 20 61 20 70 72 6f 63 65 64 75 72 65 20 6f 66 20 a procedure of
3c50: 6e 6f 20 61 72 67 75 6d 65 6e 74 73 20 77 68 69 no arguments whi
3c60: 63 68 20 63 6f 6e 74 69 6e 75 65 73 2c 0a 09 20 ch continues,..
3c70: 3b 3b 3e 20 70 72 6f 63 65 73 73 69 6e 67 20 61 ;;> processing a
3c80: 74 20 74 68 65 20 6e 65 78 74 20 5c 76 61 72 7b t the next \var{
3c90: 70 61 74 74 65 72 6e 7d 2e 20 20 49 66 20 6e 6f pattern}. If no
3ca0: 20 5c 76 61 72 7b 70 61 74 74 65 72 6e 7d 20 6d \var{pattern} m
3cb0: 61 74 63 68 65 73 2c 0a 09 20 3b 3b 3e 20 61 6e atches,.. ;;> an
3cc0: 20 65 72 72 6f 72 20 69 73 20 73 69 67 6e 61 6c error is signal
3cd0: 6c 65 64 2e 0a 0a 09 20 3b 3b 20 54 68 65 20 62 led.... ;; The b
3ce0: 61 73 69 63 20 69 6e 74 65 72 66 61 63 65 2e 20 asic interface.
3cf0: 20 4d 41 54 43 48 20 6a 75 73 74 20 70 65 72 66 MATCH just perf
3d00: 6f 72 6d 73 20 73 6f 6d 65 20 62 61 73 69 63 20 orms some basic
3d10: 73 79 6e 74 61 78 0a 09 20 3b 3b 20 76 61 6c 69 syntax.. ;; vali
3d20: 64 61 74 69 6f 6e 2c 20 62 69 6e 64 73 20 74 68 dation, binds th
3d30: 65 20 6d 61 74 63 68 20 65 78 70 72 65 73 73 69 e match expressi
3d40: 6f 6e 20 74 6f 20 61 20 74 65 6d 70 6f 72 61 72 on to a temporar
3d50: 79 20 76 61 72 69 61 62 6c 65 20 60 76 27 2c 0a y variable `v',.
3d60: 09 20 3b 3b 20 61 6e 64 20 70 61 73 73 65 73 20 . ;; and passes
3d70: 69 74 20 6f 6e 20 74 6f 20 4d 41 54 43 48 2d 4e it on to MATCH-N
3d80: 45 58 54 2e 20 20 49 74 27 73 20 61 20 63 6f 6e EXT. It's a con
3d90: 73 74 61 6e 74 20 74 68 72 6f 75 67 68 6f 75 74 stant throughout
3da0: 20 74 68 65 0a 09 20 3b 3b 20 63 6f 64 65 20 62 the.. ;; code b
3db0: 65 6c 6f 77 20 74 68 61 74 20 74 68 65 20 62 69 elow that the bi
3dc0: 6e 64 69 6e 67 20 60 76 27 20 69 73 20 61 20 64 nding `v' is a d
3dd0: 69 72 65 63 74 20 76 61 72 69 61 62 6c 65 20 72 irect variable r
3de0: 65 66 65 72 65 6e 63 65 2c 20 6e 6f 74 0a 09 20 eference, not..
3df0: 3b 3b 20 61 6e 20 65 78 70 72 65 73 73 69 6f 6e ;; an expression
3e00: 2e 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 6e .... (define-syn
3e10: 74 61 78 20 6d 61 74 63 68 0a 09 20 28 73 79 6e tax match.. (syn
3e20: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 09 20 28 tax-rules ().. (
3e30: 28 6d 61 74 63 68 29 0a 09 20 28 6d 61 74 63 68 (match).. (match
3e40: 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 20 22 6d -syntax-error "m
3e50: 69 73 73 69 6e 67 20 6d 61 74 63 68 20 65 78 70 issing match exp
3e60: 72 65 73 73 69 6f 6e 22 29 29 0a 09 20 28 28 6d ression")).. ((m
3e70: 61 74 63 68 20 61 74 6f 6d 29 0a 09 20 28 6d 61 atch atom).. (ma
3e80: 74 63 68 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 tch-syntax-error
3e90: 20 22 6e 6f 20 6d 61 74 63 68 20 63 6c 61 75 73 "no match claus
3ea0: 65 73 22 29 29 0a 09 20 28 28 6d 61 74 63 68 20 es")).. ((match
3eb0: 28 61 70 70 20 2e 2e 2e 29 20 28 70 61 74 20 2e (app ...) (pat .
3ec0: 20 62 6f 64 79 29 20 2e 2e 2e 29 0a 09 20 28 6c body) ...).. (l
3ed0: 65 74 20 28 28 76 20 28 61 70 70 20 2e 2e 2e 29 et ((v (app ...)
3ee0: 29 29 0a 09 20 28 6d 61 74 63 68 2d 6e 65 78 74 )).. (match-next
3ef0: 20 76 20 28 28 61 70 70 20 2e 2e 2e 29 20 28 73 v ((app ...) (s
3f00: 65 74 21 20 28 61 70 70 20 2e 2e 2e 29 29 29 20 et! (app ...)))
3f10: 28 70 61 74 20 2e 20 62 6f 64 79 29 20 2e 2e 2e (pat . body) ...
3f20: 29 29 29 0a 09 20 28 28 6d 61 74 63 68 20 23 28 ))).. ((match #(
3f30: 76 65 63 20 2e 2e 2e 29 20 28 70 61 74 20 2e 20 vec ...) (pat .
3f40: 62 6f 64 79 29 20 2e 2e 2e 29 0a 09 20 28 6c 65 body) ...).. (le
3f50: 74 20 28 28 76 20 23 28 76 65 63 20 2e 2e 2e 29 t ((v #(vec ...)
3f60: 29 29 0a 09 20 28 6d 61 74 63 68 2d 6e 65 78 74 )).. (match-next
3f70: 20 76 20 28 76 20 28 73 65 74 21 20 76 29 29 20 v (v (set! v))
3f80: 28 70 61 74 20 2e 20 62 6f 64 79 29 20 2e 2e 2e (pat . body) ...
3f90: 29 29 29 0a 09 20 28 28 6d 61 74 63 68 20 61 74 ))).. ((match at
3fa0: 6f 6d 20 28 70 61 74 20 2e 20 62 6f 64 79 29 20 om (pat . body)
3fb0: 2e 2e 2e 29 0a 09 20 28 6c 65 74 20 28 28 76 20 ...).. (let ((v
3fc0: 61 74 6f 6d 29 29 0a 09 20 28 6d 61 74 63 68 2d atom)).. (match-
3fd0: 6e 65 78 74 20 76 20 28 61 74 6f 6d 20 28 73 65 next v (atom (se
3fe0: 74 21 20 61 74 6f 6d 29 29 20 28 70 61 74 20 2e t! atom)) (pat .
3ff0: 20 62 6f 64 79 29 20 2e 2e 2e 29 29 29 0a 09 20 body) ...)))..
4000: 29 29 0a 0a 09 20 3b 3b 20 4d 41 54 43 48 2d 4e ))... ;; MATCH-N
4010: 45 58 54 20 70 61 73 73 65 73 20 65 61 63 68 20 EXT passes each
4020: 63 6c 61 75 73 65 20 74 6f 20 4d 41 54 43 48 2d clause to MATCH-
4030: 4f 4e 45 20 69 6e 20 74 75 72 6e 20 77 69 74 68 ONE in turn with
4040: 20 69 74 73 20 66 61 69 6c 75 72 65 0a 09 20 3b its failure.. ;
4050: 3b 20 74 68 75 6e 6b 2c 20 77 68 69 63 68 20 69 ; thunk, which i
4060: 73 20 65 78 70 61 6e 64 65 64 20 62 79 20 72 65 s expanded by re
4070: 63 75 72 73 69 6e 67 20 4d 41 54 43 48 2d 4e 45 cursing MATCH-NE
4080: 58 54 20 6f 6e 20 74 68 65 20 72 65 6d 61 69 6e XT on the remain
4090: 69 6e 67 0a 09 20 3b 3b 20 63 6c 61 75 73 65 73 ing.. ;; clauses
40a0: 2e 20 20 60 67 2b 73 27 20 69 73 20 61 20 6c 69 . `g+s' is a li
40b0: 73 74 20 6f 66 20 74 77 6f 20 65 6c 65 6d 65 6e st of two elemen
40c0: 74 73 2c 20 74 68 65 20 67 65 74 21 20 61 6e 64 ts, the get! and
40d0: 20 73 65 74 21 0a 09 20 3b 3b 20 65 78 70 72 65 set!.. ;; expre
40e0: 73 73 69 6f 6e 73 20 72 65 73 70 65 63 74 69 76 ssions respectiv
40f0: 65 6c 79 2e 0a 0a 09 20 28 64 65 66 69 6e 65 2d ely.... (define-
4100: 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 6e 65 78 syntax match-nex
4110: 74 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 t.. (syntax-rule
4120: 73 20 28 3d 3e 29 0a 09 20 3b 3b 20 6e 6f 20 6d s (=>).. ;; no m
4130: 6f 72 65 20 63 6c 61 75 73 65 73 2c 20 74 68 65 ore clauses, the
4140: 20 6d 61 74 63 68 20 66 61 69 6c 65 64 0a 09 20 match failed..
4150: 28 28 6d 61 74 63 68 2d 6e 65 78 74 20 76 20 67 ((match-next v g
4160: 2b 73 29 0a 09 20 28 65 72 72 6f 72 20 27 6d 61 +s).. (error 'ma
4170: 74 63 68 20 22 6e 6f 20 6d 61 74 63 68 69 6e 67 tch "no matching
4180: 20 70 61 74 74 65 72 6e 22 20 76 29 29 0a 09 20 pattern" v))..
4190: 3b 3b 20 6e 61 6d 65 64 20 66 61 69 6c 75 72 65 ;; named failure
41a0: 20 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 0a 09 20 continuation..
41b0: 28 28 6d 61 74 63 68 2d 6e 65 78 74 20 76 20 67 ((match-next v g
41c0: 2b 73 20 28 70 61 74 20 28 3d 3e 20 66 61 69 6c +s (pat (=> fail
41d0: 75 72 65 29 20 2e 20 62 6f 64 79 29 20 2e 20 72 ure) . body) . r
41e0: 65 73 74 29 0a 09 20 28 6c 65 74 20 28 28 66 61 est).. (let ((fa
41f0: 69 6c 75 72 65 20 28 6c 61 6d 62 64 61 20 28 29 ilure (lambda ()
4200: 20 28 6d 61 74 63 68 2d 6e 65 78 74 20 76 20 67 (match-next v g
4210: 2b 73 20 2e 20 72 65 73 74 29 29 29 29 0a 09 20 +s . rest))))..
4220: 3b 3b 20 6d 61 74 63 68 2d 6f 6e 65 20 61 6e 61 ;; match-one ana
4230: 6c 79 7a 65 73 20 74 68 65 20 70 61 74 74 65 72 lyzes the patter
4240: 6e 20 66 6f 72 20 75 73 0a 09 20 28 6d 61 74 63 n for us.. (matc
4250: 68 2d 6f 6e 65 20 76 20 70 61 74 20 67 2b 73 20 h-one v pat g+s
4260: 28 6d 61 74 63 68 2d 64 72 6f 70 2d 69 64 73 20 (match-drop-ids
4270: 28 62 65 67 69 6e 20 2e 20 62 6f 64 79 29 29 20 (begin . body))
4280: 28 66 61 69 6c 75 72 65 29 20 28 29 29 29 29 0a (failure) ()))).
4290: 09 20 3b 3b 20 61 6e 6f 6e 79 6d 6f 75 73 20 66 . ;; anonymous f
42a0: 61 69 6c 75 72 65 20 63 6f 6e 74 69 6e 75 61 74 ailure continuat
42b0: 69 6f 6e 2c 20 67 69 76 65 20 69 74 20 61 20 64 ion, give it a d
42c0: 75 6d 6d 79 20 6e 61 6d 65 0a 09 20 28 28 6d 61 ummy name.. ((ma
42d0: 74 63 68 2d 6e 65 78 74 20 76 20 67 2b 73 20 28 tch-next v g+s (
42e0: 70 61 74 20 2e 20 62 6f 64 79 29 20 2e 20 72 65 pat . body) . re
42f0: 73 74 29 0a 09 20 28 6d 61 74 63 68 2d 6e 65 78 st).. (match-nex
4300: 74 20 76 20 67 2b 73 20 28 70 61 74 20 28 3d 3e t v g+s (pat (=>
4310: 20 66 61 69 6c 75 72 65 29 20 2e 20 62 6f 64 79 failure) . body
4320: 29 20 2e 20 72 65 73 74 29 29 29 29 0a 0a 09 20 ) . rest))))...
4330: 3b 3b 20 4d 41 54 43 48 2d 4f 4e 45 20 66 69 72 ;; MATCH-ONE fir
4340: 73 74 20 63 68 65 63 6b 73 20 66 6f 72 20 65 6c st checks for el
4350: 6c 69 70 73 69 73 20 70 61 74 74 65 72 6e 73 2c lipsis patterns,
4360: 20 6f 74 68 65 72 77 69 73 65 20 70 61 73 73 65 otherwise passe
4370: 73 20 6f 6e 20 74 6f 0a 09 20 3b 3b 20 4d 41 54 s on to.. ;; MAT
4380: 43 48 2d 54 57 4f 2e 0a 0a 09 20 28 64 65 66 69 CH-TWO.... (defi
4390: 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d ne-syntax match-
43a0: 6f 6e 65 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 one.. (syntax-ru
43b0: 6c 65 73 20 28 29 0a 09 20 3b 3b 20 49 66 20 69 les ().. ;; If i
43c0: 74 27 73 20 61 20 6c 69 73 74 20 6f 66 20 74 77 t's a list of tw
43d0: 6f 20 6f 72 20 6d 6f 72 65 20 76 61 6c 75 65 73 o or more values
43e0: 2c 20 63 68 65 63 6b 20 74 6f 20 73 65 65 20 69 , check to see i
43f0: 66 20 74 68 65 0a 09 20 3b 3b 20 73 65 63 6f 6e f the.. ;; secon
4400: 64 20 6f 6e 65 20 69 73 20 61 6e 20 65 6c 6c 69 d one is an elli
4410: 70 73 69 73 20 61 6e 64 20 68 61 6e 64 6c 65 20 psis and handle
4420: 61 63 63 6f 72 64 69 6e 67 6c 79 2c 20 6f 74 68 accordingly, oth
4430: 65 72 77 69 73 65 20 67 6f 0a 09 20 3b 3b 20 74 erwise go.. ;; t
4440: 6f 20 4d 41 54 43 48 2d 54 57 4f 2e 0a 09 20 28 o MATCH-TWO... (
4450: 28 6d 61 74 63 68 2d 6f 6e 65 20 76 20 28 70 20 (match-one v (p
4460: 71 20 2e 20 72 29 20 67 2b 73 20 73 6b 20 66 6b q . r) g+s sk fk
4470: 20 69 29 0a 09 20 28 6d 61 74 63 68 2d 63 68 65 i).. (match-che
4480: 63 6b 2d 65 6c 6c 69 70 73 69 73 0a 09 20 71 0a ck-ellipsis.. q.
4490: 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 . (match-extract
44a0: 2d 76 61 72 73 20 70 20 28 6d 61 74 63 68 2d 67 -vars p (match-g
44b0: 65 6e 2d 65 6c 6c 69 70 73 69 73 20 76 20 70 20 en-ellipsis v p
44c0: 72 20 20 67 2b 73 20 73 6b 20 66 6b 20 69 29 20 r g+s sk fk i)
44d0: 69 20 28 29 29 0a 09 20 28 6d 61 74 63 68 2d 74 i ()).. (match-t
44e0: 77 6f 20 76 20 28 70 20 71 20 2e 20 72 29 20 67 wo v (p q . r) g
44f0: 2b 73 20 73 6b 20 66 6b 20 69 29 29 29 0a 09 20 +s sk fk i)))..
4500: 3b 3b 20 47 6f 20 64 69 72 65 63 74 6c 79 20 74 ;; Go directly t
4510: 6f 20 4d 41 54 43 48 2d 54 57 4f 2e 0a 09 20 28 o MATCH-TWO... (
4520: 28 6d 61 74 63 68 2d 6f 6e 65 20 2e 20 78 29 0a (match-one . x).
4530: 09 20 28 6d 61 74 63 68 2d 74 77 6f 20 2e 20 78 . (match-two . x
4540: 29 29 29 29 0a 0a 09 20 3b 3b 20 54 68 69 73 20 ))))... ;; This
4550: 69 73 20 74 68 65 20 67 75 74 73 20 6f 66 20 74 is the guts of t
4560: 68 65 20 70 61 74 74 65 72 6e 20 6d 61 74 63 68 he pattern match
4570: 65 72 2e 20 20 57 65 20 61 72 65 20 70 61 73 73 er. We are pass
4580: 65 64 20 61 20 6c 6f 74 20 6f 66 0a 09 20 3b 3b ed a lot of.. ;;
4590: 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 69 6e 20 information in
45a0: 74 68 65 20 66 6f 72 6d 3a 0a 09 20 3b 3b 0a 09 the form:.. ;;..
45b0: 20 3b 3b 20 20 20 28 6d 61 74 63 68 2d 74 77 6f ;; (match-two
45c0: 20 76 61 72 20 70 61 74 74 65 72 6e 20 67 65 74 var pattern get
45d0: 74 65 72 20 73 65 74 74 65 72 20 73 75 63 63 65 ter setter succe
45e0: 73 73 2d 6b 20 66 61 69 6c 2d 6b 20 28 69 64 73 ss-k fail-k (ids
45f0: 20 2e 2e 2e 29 29 0a 09 20 3b 3b 0a 09 20 3b 3b ...)).. ;;.. ;;
4600: 20 75 73 75 61 6c 6c 79 20 61 62 62 72 65 76 69 usually abbrevi
4610: 61 74 65 64 0a 09 20 3b 3b 0a 09 20 3b 3b 20 20 ated.. ;;.. ;;
4620: 20 28 6d 61 74 63 68 2d 74 77 6f 20 76 20 70 20 (match-two v p
4630: 67 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 3b g+s sk fk i).. ;
4640: 3b 0a 09 20 3b 3b 20 77 68 65 72 65 20 56 41 52 ;.. ;; where VAR
4650: 20 69 73 20 74 68 65 20 73 79 6d 62 6f 6c 20 6e is the symbol n
4660: 61 6d 65 20 6f 66 20 74 68 65 20 63 75 72 72 65 ame of the curre
4670: 6e 74 20 76 61 72 69 61 62 6c 65 20 77 65 20 61 nt variable we a
4680: 72 65 0a 09 20 3b 3b 20 6d 61 74 63 68 69 6e 67 re.. ;; matching
4690: 2c 20 50 41 54 54 45 52 4e 20 69 73 20 74 68 65 , PATTERN is the
46a0: 20 63 75 72 72 65 6e 74 20 70 61 74 74 65 72 6e current pattern
46b0: 2c 20 67 65 74 74 65 72 20 61 6e 64 20 73 65 74 , getter and set
46c0: 74 65 72 20 61 72 65 20 74 68 65 0a 09 20 3b 3b ter are the.. ;;
46d0: 20 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 61 corresponding a
46e0: 63 63 65 73 73 6f 72 73 20 28 65 2e 67 2e 20 43 ccessors (e.g. C
46f0: 41 52 20 61 6e 64 20 53 45 54 2d 43 41 52 21 20 AR and SET-CAR!
4700: 6f 66 20 74 68 65 20 70 61 69 72 20 68 6f 6c 64 of the pair hold
4710: 69 6e 67 0a 09 20 3b 3b 20 56 41 52 29 2c 20 53 ing.. ;; VAR), S
4720: 55 43 43 45 53 53 2d 4b 20 69 73 20 74 68 65 20 UCCESS-K is the
4730: 73 75 63 63 65 73 73 20 63 6f 6e 74 69 6e 75 61 success continua
4740: 74 69 6f 6e 2c 20 46 41 49 4c 2d 4b 20 69 73 20 tion, FAIL-K is
4750: 74 68 65 20 66 61 69 6c 75 72 65 0a 09 20 3b 3b the failure.. ;;
4760: 20 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 20 28 77 continuation (w
4770: 68 69 63 68 20 69 73 20 6a 75 73 74 20 61 20 74 hich is just a t
4780: 68 75 6e 6b 20 63 61 6c 6c 20 61 6e 64 20 69 73 hunk call and is
4790: 20 74 68 75 73 20 73 61 66 65 20 74 6f 20 65 78 thus safe to ex
47a0: 70 61 6e 64 0a 09 20 3b 3b 20 6d 75 6c 74 69 70 pand.. ;; multip
47b0: 6c 65 20 74 69 6d 65 73 29 20 61 6e 64 20 49 44 le times) and ID
47c0: 53 20 61 72 65 20 74 68 65 20 6c 69 73 74 20 6f S are the list o
47d0: 66 20 69 64 65 6e 74 69 66 69 65 72 73 20 62 6f f identifiers bo
47e0: 75 6e 64 20 69 6e 20 74 68 65 0a 09 20 3b 3b 20 und in the.. ;;
47f0: 70 61 74 74 65 72 6e 20 73 6f 20 66 61 72 2e 0a pattern so far..
4800: 0a 09 20 3b 3b 20 52 65 70 6c 61 63 65 20 27 5f .. ;; Replace '_
4810: 27 20 77 69 74 68 20 27 3a 5f 27 20 61 73 20 74 ' with ':_' as t
4820: 68 65 20 66 6f 72 6d 65 72 20 69 73 20 66 6f 72 he former is for
4830: 62 69 64 64 65 6e 20 61 73 20 61 6e 20 61 75 78 bidden as an aux
4840: 69 6c 69 61 72 69 79 0a 09 20 3b 3b 20 6b 65 79 iliariy.. ;; key
4850: 77 6f 72 64 20 69 6e 20 52 36 52 53 2e 20 28 46 word in R6RS. (F
4860: 42 45 29 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 BE).. (define-sy
4870: 6e 74 61 78 20 6d 61 74 63 68 2d 74 77 6f 0a 09 ntax match-two..
4880: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
4890: 3a 5f 20 5f 5f 5f 20 2e 2e 31 20 2a 2a 2a 20 71 :_ ___ ..1 *** q
48a0: 75 6f 74 65 20 71 75 61 73 69 71 75 6f 74 65 20 uote quasiquote
48b0: 3f 20 24 20 73 74 72 75 63 74 20 40 20 6f 62 6a ? $ struct @ obj
48c0: 65 63 74 20 3d 20 61 6e 64 20 6f 72 20 6e 6f 74 ect = and or not
48d0: 20 73 65 74 21 20 67 65 74 21 29 0a 09 20 28 28 set! get!).. ((
48e0: 6d 61 74 63 68 2d 74 77 6f 20 76 20 28 29 20 67 match-two v () g
48f0: 2b 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 +s (sk ...) fk i
4900: 29 0a 09 20 28 69 66 20 28 6e 75 6c 6c 3f 20 76 ).. (if (null? v
4910: 29 20 28 73 6b 20 2e 2e 2e 20 69 29 20 66 6b 29 ) (sk ... i) fk)
4920: 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 ).. ((match-two
4930: 76 20 28 71 75 6f 74 65 20 70 29 20 67 2b 73 20 v (quote p) g+s
4940: 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 29 0a 09 (sk ...) fk i)..
4950: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 76 20 27 (if (equal? v '
4960: 70 29 20 28 73 6b 20 2e 2e 2e 20 69 29 20 66 6b p) (sk ... i) fk
4970: 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 77 6f )).. ((match-two
4980: 20 76 20 28 71 75 61 73 69 71 75 6f 74 65 20 70 v (quasiquote p
4990: 29 20 2e 20 78 29 0a 09 20 28 6d 61 74 63 68 2d ) . x).. (match-
49a0: 71 75 61 73 69 71 75 6f 74 65 20 76 20 70 20 2e quasiquote v p .
49b0: 20 78 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 x)).. ((match-t
49c0: 77 6f 20 76 20 28 61 6e 64 29 20 67 2b 73 20 28 wo v (and) g+s (
49d0: 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 29 20 28 73 sk ...) fk i) (s
49e0: 6b 20 2e 2e 2e 20 69 29 29 0a 09 20 28 28 6d 61 k ... i)).. ((ma
49f0: 74 63 68 2d 74 77 6f 20 76 20 28 61 6e 64 20 70 tch-two v (and p
4a00: 20 71 20 2e 2e 2e 29 20 67 2b 73 20 73 6b 20 66 q ...) g+s sk f
4a10: 6b 20 69 29 0a 09 20 28 6d 61 74 63 68 2d 6f 6e k i).. (match-on
4a20: 65 20 76 20 70 20 67 2b 73 20 28 6d 61 74 63 68 e v p g+s (match
4a30: 2d 6f 6e 65 20 76 20 28 61 6e 64 20 71 20 2e 2e -one v (and q ..
4a40: 2e 29 20 67 2b 73 20 73 6b 20 66 6b 29 20 66 6b .) g+s sk fk) fk
4a50: 20 69 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 i)).. ((match-t
4a60: 77 6f 20 76 20 28 6f 72 29 20 67 2b 73 20 73 6b wo v (or) g+s sk
4a70: 20 66 6b 20 69 29 20 66 6b 29 0a 09 20 28 28 6d fk i) fk).. ((m
4a80: 61 74 63 68 2d 74 77 6f 20 76 20 28 6f 72 20 70 atch-two v (or p
4a90: 29 20 2e 20 78 29 0a 09 20 28 6d 61 74 63 68 2d ) . x).. (match-
4aa0: 6f 6e 65 20 76 20 70 20 2e 20 78 29 29 0a 09 20 one v p . x))..
4ab0: 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20 28 6f ((match-two v (o
4ac0: 72 20 70 20 2e 2e 2e 29 20 67 2b 73 20 73 6b 20 r p ...) g+s sk
4ad0: 66 6b 20 69 29 0a 09 20 28 6d 61 74 63 68 2d 65 fk i).. (match-e
4ae0: 78 74 72 61 63 74 2d 76 61 72 73 20 28 6f 72 20 xtract-vars (or
4af0: 70 20 2e 2e 2e 29 20 28 6d 61 74 63 68 2d 67 65 p ...) (match-ge
4b00: 6e 2d 6f 72 20 76 20 28 70 20 2e 2e 2e 29 20 67 n-or v (p ...) g
4b10: 2b 73 20 73 6b 20 66 6b 20 69 29 20 69 20 28 29 +s sk fk i) i ()
4b20: 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 77 6f )).. ((match-two
4b30: 20 76 20 28 6e 6f 74 20 70 29 20 67 2b 73 20 28 v (not p) g+s (
4b40: 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 29 0a 09 20 sk ...) fk i)..
4b50: 28 6d 61 74 63 68 2d 6f 6e 65 20 76 20 70 20 67 (match-one v p g
4b60: 2b 73 20 28 6d 61 74 63 68 2d 64 72 6f 70 2d 69 +s (match-drop-i
4b70: 64 73 20 66 6b 29 20 28 73 6b 20 2e 2e 2e 20 69 ds fk) (sk ... i
4b80: 29 20 69 29 29 0a 09 20 28 28 6d 61 74 63 68 2d ) i)).. ((match-
4b90: 74 77 6f 20 76 20 28 67 65 74 21 20 67 65 74 74 two v (get! gett
4ba0: 65 72 29 20 28 67 20 73 29 20 28 73 6b 20 2e 2e er) (g s) (sk ..
4bb0: 2e 29 20 66 6b 20 69 29 0a 09 20 28 6c 65 74 20 .) fk i).. (let
4bc0: 28 28 67 65 74 74 65 72 20 28 6c 61 6d 62 64 61 ((getter (lambda
4bd0: 20 28 29 20 67 29 29 29 20 28 73 6b 20 2e 2e 2e () g))) (sk ...
4be0: 20 69 29 29 29 0a 09 20 28 28 6d 61 74 63 68 2d i))).. ((match-
4bf0: 74 77 6f 20 76 20 28 73 65 74 21 20 73 65 74 74 two v (set! sett
4c00: 65 72 29 20 28 67 20 28 73 20 2e 2e 2e 29 29 20 er) (g (s ...))
4c10: 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 29 0a 09 (sk ...) fk i)..
4c20: 20 28 6c 65 74 20 28 28 73 65 74 74 65 72 20 28 (let ((setter (
4c30: 6c 61 6d 62 64 61 20 28 78 29 20 28 73 20 2e 2e lambda (x) (s ..
4c40: 2e 20 78 29 29 29 29 20 28 73 6b 20 2e 2e 2e 20 . x)))) (sk ...
4c50: 69 29 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 i))).. ((match-t
4c60: 77 6f 20 76 20 28 3f 20 70 72 65 64 20 2e 20 70 wo v (? pred . p
4c70: 29 20 67 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 ) g+s sk fk i)..
4c80: 20 28 69 66 20 28 70 72 65 64 20 76 29 20 28 6d (if (pred v) (m
4c90: 61 74 63 68 2d 6f 6e 65 20 76 20 28 61 6e 64 20 atch-one v (and
4ca0: 2e 20 70 29 20 67 2b 73 20 73 6b 20 66 6b 20 69 . p) g+s sk fk i
4cb0: 29 20 66 6b 29 29 0a 09 20 28 28 6d 61 74 63 68 ) fk)).. ((match
4cc0: 2d 74 77 6f 20 76 20 28 3d 20 70 72 6f 63 20 70 -two v (= proc p
4cd0: 29 20 2e 20 78 29 0a 09 20 28 6c 65 74 20 28 28 ) . x).. (let ((
4ce0: 77 20 28 70 72 6f 63 20 76 29 29 29 20 28 6d 61 w (proc v))) (ma
4cf0: 74 63 68 2d 6f 6e 65 20 77 20 70 20 2e 20 78 29 tch-one w p . x)
4d00: 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 77 6f )).. ((match-two
4d10: 20 76 20 28 70 20 5f 5f 5f 20 2e 20 72 29 20 67 v (p ___ . r) g
4d20: 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 6d +s sk fk i).. (m
4d30: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 atch-extract-var
4d40: 73 20 70 20 28 6d 61 74 63 68 2d 67 65 6e 2d 65 s p (match-gen-e
4d50: 6c 6c 69 70 73 69 73 20 76 20 70 20 72 20 67 2b llipsis v p r g+
4d60: 73 20 73 6b 20 66 6b 20 69 29 20 69 20 28 29 29 s sk fk i) i ())
4d70: 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 ).. ((match-two
4d80: 76 20 28 70 29 20 67 2b 73 20 73 6b 20 66 6b 20 v (p) g+s sk fk
4d90: 69 29 0a 09 20 28 69 66 20 28 61 6e 64 20 28 70 i).. (if (and (p
4da0: 61 69 72 3f 20 76 29 20 28 6e 75 6c 6c 3f 20 28 air? v) (null? (
4db0: 63 64 72 20 76 29 29 29 0a 20 20 20 20 20 20 20 cdr v))).
4dc0: 20 20 28 6c 65 74 20 28 28 77 20 28 63 61 72 20 (let ((w (car
4dd0: 76 29 29 29 0a 09 20 28 6d 61 74 63 68 2d 6f 6e v))).. (match-on
4de0: 65 20 77 20 70 20 28 28 63 61 72 20 76 29 20 28 e w p ((car v) (
4df0: 73 65 74 2d 63 61 72 21 20 76 29 29 20 73 6b 20 set-car! v)) sk
4e00: 66 6b 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 fk i)).
4e10: 66 6b 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 fk)).. ((match-t
4e20: 77 6f 20 76 20 28 70 20 2a 2a 2a 20 71 29 20 67 wo v (p *** q) g
4e30: 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 6d +s sk fk i).. (m
4e40: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 atch-extract-var
4e50: 73 20 70 20 28 6d 61 74 63 68 2d 67 65 6e 2d 73 s p (match-gen-s
4e60: 65 61 72 63 68 20 76 20 70 20 71 20 67 2b 73 20 earch v p q g+s
4e70: 73 6b 20 66 6b 20 69 29 20 69 20 28 29 29 29 0a sk fk i) i ())).
4e80: 09 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20 . ((match-two v
4e90: 28 70 20 2a 2a 2a 20 2e 20 71 29 20 67 2b 73 20 (p *** . q) g+s
4ea0: 73 6b 20 66 6b 20 69 29 0a 09 20 28 6d 61 74 63 sk fk i).. (matc
4eb0: 68 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 20 22 h-syntax-error "
4ec0: 69 6e 76 61 6c 69 64 20 75 73 65 20 6f 66 20 2a invalid use of *
4ed0: 2a 2a 22 20 28 70 20 2a 2a 2a 20 2e 20 71 29 29 **" (p *** . q))
4ee0: 29 0a 09 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 ).. ((match-two
4ef0: 76 20 28 70 20 2e 2e 31 29 20 67 2b 73 20 73 6b v (p ..1) g+s sk
4f00: 20 66 6b 20 69 29 0a 09 20 28 69 66 20 28 70 61 fk i).. (if (pa
4f10: 69 72 3f 20 76 29 0a 20 20 20 20 20 20 20 20 20 ir? v).
4f20: 28 6d 61 74 63 68 2d 6f 6e 65 20 76 20 28 70 20 (match-one v (p
4f30: 5f 5f 5f 29 20 67 2b 73 20 73 6b 20 66 6b 20 69 ___) g+s sk fk i
4f40: 29 0a 20 20 20 20 20 20 20 20 20 66 6b 29 29 0a ). fk)).
4f50: 09 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20 . ((match-two v
4f60: 28 24 20 72 65 63 20 70 20 2e 2e 2e 29 20 67 2b ($ rec p ...) g+
4f70: 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 69 66 s sk fk i).. (if
4f80: 20 28 69 73 2d 61 3f 20 76 20 72 65 63 29 0a 20 (is-a? v rec).
4f90: 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 72 (match-r
4fa0: 65 63 6f 72 64 2d 72 65 66 73 20 76 20 72 65 63 ecord-refs v rec
4fb0: 20 30 20 28 70 20 2e 2e 2e 29 20 67 2b 73 20 73 0 (p ...) g+s s
4fc0: 6b 20 66 6b 20 69 29 0a 20 20 20 20 20 20 20 20 k fk i).
4fd0: 20 66 6b 29 29 0a 09 20 28 28 6d 61 74 63 68 2d fk)).. ((match-
4fe0: 74 77 6f 20 76 20 28 73 74 72 75 63 74 20 72 65 two v (struct re
4ff0: 63 20 70 20 2e 2e 2e 29 20 67 2b 73 20 73 6b 20 c p ...) g+s sk
5000: 66 6b 20 69 29 0a 09 20 28 69 66 20 28 69 73 2d fk i).. (if (is-
5010: 61 3f 20 76 20 72 65 63 29 0a 20 20 20 20 20 20 a? v rec).
5020: 20 20 20 28 6d 61 74 63 68 2d 72 65 63 6f 72 64 (match-record
5030: 2d 72 65 66 73 20 76 20 72 65 63 20 30 20 28 70 -refs v rec 0 (p
5040: 20 2e 2e 2e 29 20 67 2b 73 20 73 6b 20 66 6b 20 ...) g+s sk fk
5050: 69 29 0a 20 20 20 20 20 20 20 20 20 66 6b 29 29 i). fk))
5060: 0a 09 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 .. ((match-two v
5070: 20 28 40 20 72 65 63 20 70 20 2e 2e 2e 29 20 67 (@ rec p ...) g
5080: 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 69 +s sk fk i).. (i
5090: 66 20 28 69 73 2d 61 3f 20 76 20 72 65 63 29 0a f (is-a? v rec).
50a0: 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d (match-
50b0: 72 65 63 6f 72 64 2d 6e 61 6d 65 64 2d 72 65 66 record-named-ref
50c0: 73 20 76 20 72 65 63 20 28 70 20 2e 2e 2e 29 20 s v rec (p ...)
50d0: 67 2b 73 20 73 6b 20 66 6b 20 69 29 0a 20 20 20 g+s sk fk i).
50e0: 20 20 20 20 20 20 66 6b 29 29 0a 09 20 28 28 6d fk)).. ((m
50f0: 61 74 63 68 2d 74 77 6f 20 76 20 28 6f 62 6a 65 atch-two v (obje
5100: 63 74 20 72 65 63 20 70 20 2e 2e 2e 29 20 67 2b ct rec p ...) g+
5110: 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 69 66 s sk fk i).. (if
5120: 20 28 69 73 2d 61 3f 20 76 20 72 65 63 29 0a 20 (is-a? v rec).
5130: 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 72 (match-r
5140: 65 63 6f 72 64 2d 6e 61 6d 65 64 2d 72 65 66 73 ecord-named-refs
5150: 20 76 20 72 65 63 20 28 70 20 2e 2e 2e 29 20 67 v rec (p ...) g
5160: 2b 73 20 73 6b 20 66 6b 20 69 29 0a 20 20 20 20 +s sk fk i).
5170: 20 20 20 20 20 66 6b 29 29 0a 09 20 28 28 6d 61 fk)).. ((ma
5180: 74 63 68 2d 74 77 6f 20 76 20 28 70 20 2e 20 71 tch-two v (p . q
5190: 29 20 67 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 ) g+s sk fk i)..
51a0: 20 28 69 66 20 28 70 61 69 72 3f 20 76 29 0a 20 (if (pair? v).
51b0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 77 (let ((w
51c0: 20 28 63 61 72 20 76 29 29 20 28 78 20 28 63 64 (car v)) (x (cd
51d0: 72 20 76 29 29 29 0a 09 20 28 6d 61 74 63 68 2d r v))).. (match-
51e0: 6f 6e 65 20 77 20 70 20 28 28 63 61 72 20 76 29 one w p ((car v)
51f0: 20 28 73 65 74 2d 63 61 72 21 20 76 29 29 0a 09 (set-car! v))..
5200: 20 28 6d 61 74 63 68 2d 6f 6e 65 20 78 20 71 20 (match-one x q
5210: 28 28 63 64 72 20 76 29 20 28 73 65 74 2d 63 64 ((cdr v) (set-cd
5220: 72 21 20 76 29 29 20 73 6b 20 66 6b 29 0a 09 20 r! v)) sk fk)..
5230: 66 6b 0a 09 20 69 29 29 0a 20 20 20 20 20 20 20 fk.. i)).
5240: 20 20 66 6b 29 29 0a 09 20 28 28 6d 61 74 63 68 fk)).. ((match
5250: 2d 74 77 6f 20 76 20 23 28 70 20 2e 2e 2e 29 20 -two v #(p ...)
5260: 67 2b 73 20 2e 20 78 29 0a 09 20 28 6d 61 74 63 g+s . x).. (matc
5270: 68 2d 76 65 63 74 6f 72 20 76 20 30 20 28 29 20 h-vector v 0 ()
5280: 28 70 20 2e 2e 2e 29 20 2e 20 78 29 29 0a 09 20 (p ...) . x))..
5290: 3b 3b 20 4e 65 78 74 20 6c 69 6e 65 3a 20 72 65 ;; Next line: re
52a0: 70 6c 61 63 65 20 27 5f 27 20 77 69 74 68 20 27 place '_' with '
52b0: 3a 5f 27 2e 20 28 46 42 45 29 0a 09 20 28 28 6d :_'. (FBE).. ((m
52c0: 61 74 63 68 2d 74 77 6f 20 76 20 3a 5f 20 67 2b atch-two v :_ g+
52d0: 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 29 s (sk ...) fk i)
52e0: 20 28 73 6b 20 2e 2e 2e 20 69 29 29 0a 09 20 3b (sk ... i)).. ;
52f0: 3b 20 4e 6f 74 20 61 20 70 61 69 72 20 6f 72 20 ; Not a pair or
5300: 76 65 63 74 6f 72 20 6f 72 20 73 70 65 63 69 61 vector or specia
5310: 6c 20 6c 69 74 65 72 61 6c 2c 20 74 65 73 74 20 l literal, test
5320: 74 6f 20 73 65 65 20 69 66 20 69 74 27 73 20 61 to see if it's a
5330: 0a 09 20 3b 3b 20 6e 65 77 20 73 79 6d 62 6f 6c .. ;; new symbol
5340: 2c 20 69 6e 20 77 68 69 63 68 20 63 61 73 65 20 , in which case
5350: 77 65 20 6a 75 73 74 20 62 69 6e 64 20 69 74 2c we just bind it,
5360: 20 6f 72 20 69 66 20 69 74 27 73 20 61 6e 0a 09 or if it's an..
5370: 20 3b 3b 20 61 6c 72 65 61 64 79 20 62 6f 75 6e ;; already boun
5380: 64 20 73 79 6d 62 6f 6c 20 6f 72 20 73 6f 6d 65 d symbol or some
5390: 20 6f 74 68 65 72 20 6c 69 74 65 72 61 6c 2c 20 other literal,
53a0: 69 6e 20 77 68 69 63 68 20 63 61 73 65 20 77 65 in which case we
53b0: 0a 09 20 3b 3b 20 63 6f 6d 70 61 72 65 20 69 74 .. ;; compare it
53c0: 20 77 69 74 68 20 45 51 55 41 4c 3f 2e 0a 09 20 with EQUAL?...
53d0: 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20 78 20 ((match-two v x
53e0: 67 2b 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 g+s (sk ...) fk
53f0: 28 69 64 20 2e 2e 2e 29 29 0a 09 20 28 6c 65 74 (id ...)).. (let
5400: 2d 73 79 6e 74 61 78 0a 20 20 20 20 20 20 20 20 -syntax.
5410: 20 28 28 6e 65 77 2d 73 79 6d 3f 0a 09 20 28 73 ((new-sym?.. (s
5420: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 69 64 20 yntax-rules (id
5430: 2e 2e 2e 29 0a 09 20 28 28 6e 65 77 2d 73 79 6d ...).. ((new-sym
5440: 3f 20 78 20 73 6b 32 20 66 6b 32 29 20 73 6b 32 ? x sk2 fk2) sk2
5450: 29 0a 09 20 28 28 6e 65 77 2d 73 79 6d 3f 20 79 ).. ((new-sym? y
5460: 20 73 6b 32 20 66 6b 32 29 20 66 6b 32 29 29 29 sk2 fk2) fk2)))
5470: 29 0a 09 20 28 6e 65 77 2d 73 79 6d 3f 20 72 61 ).. (new-sym? ra
5480: 6e 64 6f 6d 2d 73 79 6d 2d 74 6f 2d 6d 61 74 63 ndom-sym-to-matc
5490: 68 0a 09 20 28 6c 65 74 20 28 28 78 20 76 29 29 h.. (let ((x v))
54a0: 20 28 73 6b 20 2e 2e 2e 20 28 69 64 20 2e 2e 2e (sk ... (id ...
54b0: 20 78 29 29 29 0a 09 20 28 69 66 20 28 65 71 75 x))).. (if (equ
54c0: 61 6c 3f 20 76 20 78 29 20 28 73 6b 20 2e 2e 2e al? v x) (sk ...
54d0: 20 28 69 64 20 2e 2e 2e 29 29 20 66 6b 29 29 29 (id ...)) fk)))
54e0: 29 0a 09 20 29 29 0a 0a 09 20 3b 3b 20 51 55 41 ).. ))... ;; QUA
54f0: 53 49 51 55 4f 54 45 20 70 61 74 74 65 72 6e 73 SIQUOTE patterns
5500: 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 ... (define-synt
5510: 61 78 20 6d 61 74 63 68 2d 71 75 61 73 69 71 75 ax match-quasiqu
5520: 6f 74 65 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 ote.. (syntax-ru
5530: 6c 65 73 20 28 75 6e 71 75 6f 74 65 20 75 6e 71 les (unquote unq
5540: 75 6f 74 65 2d 73 70 6c 69 63 69 6e 67 20 71 75 uote-splicing qu
5550: 61 73 69 71 75 6f 74 65 29 0a 09 20 28 28 5f 20 asiquote).. ((_
5560: 76 20 28 75 6e 71 75 6f 74 65 20 70 29 20 67 2b v (unquote p) g+
5570: 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 6d 61 s sk fk i).. (ma
5580: 74 63 68 2d 6f 6e 65 20 76 20 70 20 67 2b 73 20 tch-one v p g+s
5590: 73 6b 20 66 6b 20 69 29 29 0a 09 20 28 28 5f 20 sk fk i)).. ((_
55a0: 76 20 28 28 75 6e 71 75 6f 74 65 2d 73 70 6c 69 v ((unquote-spli
55b0: 63 69 6e 67 20 70 29 20 2e 20 72 65 73 74 29 20 cing p) . rest)
55c0: 67 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 g+s sk fk i).. (
55d0: 69 66 20 28 70 61 69 72 3f 20 76 29 0a 09 20 28 if (pair? v).. (
55e0: 6d 61 74 63 68 2d 6f 6e 65 20 76 0a 09 20 28 70 match-one v.. (p
55f0: 20 2e 20 74 6d 70 29 0a 09 20 28 6d 61 74 63 68 . tmp).. (match
5600: 2d 71 75 61 73 69 71 75 6f 74 65 20 74 6d 70 20 -quasiquote tmp
5610: 72 65 73 74 20 67 2b 73 20 73 6b 20 66 6b 29 0a rest g+s sk fk).
5620: 09 20 66 6b 0a 09 20 69 29 0a 09 20 66 6b 29 29 . fk.. i).. fk))
5630: 0a 09 20 28 28 5f 20 76 20 28 71 75 61 73 69 71 .. ((_ v (quasiq
5640: 75 6f 74 65 20 70 29 20 67 2b 73 20 73 6b 20 66 uote p) g+s sk f
5650: 6b 20 69 20 2e 20 64 65 70 74 68 29 0a 09 20 28 k i . depth).. (
5660: 6d 61 74 63 68 2d 71 75 61 73 69 71 75 6f 74 65 match-quasiquote
5670: 20 76 20 70 20 67 2b 73 20 73 6b 20 66 6b 20 69 v p g+s sk fk i
5680: 20 23 66 20 2e 20 64 65 70 74 68 29 29 0a 09 20 #f . depth))..
5690: 28 28 5f 20 76 20 28 75 6e 71 75 6f 74 65 20 70 ((_ v (unquote p
56a0: 29 20 67 2b 73 20 73 6b 20 66 6b 20 69 20 78 20 ) g+s sk fk i x
56b0: 2e 20 64 65 70 74 68 29 0a 09 20 28 6d 61 74 63 . depth).. (matc
56c0: 68 2d 71 75 61 73 69 71 75 6f 74 65 20 76 20 70 h-quasiquote v p
56d0: 20 67 2b 73 20 73 6b 20 66 6b 20 69 20 2e 20 64 g+s sk fk i . d
56e0: 65 70 74 68 29 29 0a 09 20 28 28 5f 20 76 20 28 epth)).. ((_ v (
56f0: 75 6e 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e 67 unquote-splicing
5700: 20 70 29 20 67 2b 73 20 73 6b 20 66 6b 20 69 20 p) g+s sk fk i
5710: 78 20 2e 20 64 65 70 74 68 29 0a 09 20 28 6d 61 x . depth).. (ma
5720: 74 63 68 2d 71 75 61 73 69 71 75 6f 74 65 20 76 tch-quasiquote v
5730: 20 70 20 67 2b 73 20 73 6b 20 66 6b 20 69 20 2e p g+s sk fk i .
5740: 20 64 65 70 74 68 29 29 0a 09 20 28 28 5f 20 76 depth)).. ((_ v
5750: 20 28 70 20 2e 20 71 29 20 67 2b 73 20 73 6b 20 (p . q) g+s sk
5760: 66 6b 20 69 20 2e 20 64 65 70 74 68 29 0a 09 20 fk i . depth)..
5770: 28 69 66 20 28 70 61 69 72 3f 20 76 29 0a 09 20 (if (pair? v)..
5780: 28 6c 65 74 20 28 28 77 20 28 63 61 72 20 76 29 (let ((w (car v)
5790: 29 20 28 78 20 28 63 64 72 20 76 29 29 29 0a 20 ) (x (cdr v))).
57a0: 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 71 (match-q
57b0: 75 61 73 69 71 75 6f 74 65 0a 09 20 77 20 70 20 uasiquote.. w p
57c0: 67 2b 73 0a 09 20 28 6d 61 74 63 68 2d 71 75 61 g+s.. (match-qua
57d0: 73 69 71 75 6f 74 65 2d 73 74 65 70 20 78 20 71 siquote-step x q
57e0: 20 67 2b 73 20 73 6b 20 66 6b 20 64 65 70 74 68 g+s sk fk depth
57f0: 29 0a 09 20 66 6b 20 69 20 2e 20 64 65 70 74 68 ).. fk i . depth
5800: 29 29 0a 09 20 66 6b 29 29 0a 09 20 28 28 5f 20 )).. fk)).. ((_
5810: 76 20 23 28 65 6c 74 20 2e 2e 2e 29 20 67 2b 73 v #(elt ...) g+s
5820: 20 73 6b 20 66 6b 20 69 20 2e 20 64 65 70 74 68 sk fk i . depth
5830: 29 0a 09 20 28 69 66 20 28 76 65 63 74 6f 72 3f ).. (if (vector?
5840: 20 76 29 0a 09 20 28 6c 65 74 20 28 28 6c 73 20 v).. (let ((ls
5850: 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 20 76 29 (vector->list v)
5860: 29 29 0a 20 20 20 20 20 20 20 20 20 28 6d 61 74 )). (mat
5870: 63 68 2d 71 75 61 73 69 71 75 6f 74 65 20 6c 73 ch-quasiquote ls
5880: 20 28 65 6c 74 20 2e 2e 2e 29 20 67 2b 73 20 73 (elt ...) g+s s
5890: 6b 20 66 6b 20 69 20 2e 20 64 65 70 74 68 29 29 k fk i . depth))
58a0: 0a 09 20 66 6b 29 29 0a 09 20 28 28 5f 20 76 20 .. fk)).. ((_ v
58b0: 78 20 67 2b 73 20 73 6b 20 66 6b 20 69 20 2e 20 x g+s sk fk i .
58c0: 64 65 70 74 68 29 0a 09 20 28 6d 61 74 63 68 2d depth).. (match-
58d0: 6f 6e 65 20 76 20 27 78 20 67 2b 73 20 73 6b 20 one v 'x g+s sk
58e0: 66 6b 20 69 29 29 29 29 0a 0a 09 20 28 64 65 66 fk i))))... (def
58f0: 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 ine-syntax match
5900: 2d 71 75 61 73 69 71 75 6f 74 65 2d 73 74 65 70 -quasiquote-step
5910: 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 .. (syntax-rules
5920: 20 28 29 0a 09 20 28 28 6d 61 74 63 68 2d 71 75 ().. ((match-qu
5930: 61 73 69 71 75 6f 74 65 2d 73 74 65 70 20 78 20 asiquote-step x
5940: 71 20 67 2b 73 20 73 6b 20 66 6b 20 64 65 70 74 q g+s sk fk dept
5950: 68 20 69 29 0a 09 20 28 6d 61 74 63 68 2d 71 75 h i).. (match-qu
5960: 61 73 69 71 75 6f 74 65 20 78 20 71 20 67 2b 73 asiquote x q g+s
5970: 20 73 6b 20 66 6b 20 69 20 2e 20 64 65 70 74 68 sk fk i . depth
5980: 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ))))..;;;;;;;;;;
5990: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
59a0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
59b0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
59c0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 09 ;;;;;;;;;;;;;;..
59d0: 20 3b 3b 20 55 74 69 6c 69 74 69 65 73 0a 0a 09 ;; Utilities...
59e0: 20 3b 3b 20 54 61 6b 65 73 20 74 77 6f 20 76 61 ;; Takes two va
59f0: 6c 75 65 73 20 61 6e 64 20 6a 75 73 74 20 65 78 lues and just ex
5a00: 70 61 6e 64 73 20 69 6e 74 6f 20 74 68 65 20 66 pands into the f
5a10: 69 72 73 74 2e 0a 09 20 28 64 65 66 69 6e 65 2d irst... (define-
5a20: 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 64 72 6f syntax match-dro
5a30: 70 2d 69 64 73 0a 09 20 28 73 79 6e 74 61 78 2d p-ids.. (syntax-
5a40: 72 75 6c 65 73 20 28 29 0a 09 20 28 28 5f 20 65 rules ().. ((_ e
5a50: 78 70 72 20 69 64 73 20 2e 2e 2e 29 20 65 78 70 xpr ids ...) exp
5a60: 72 29 29 29 0a 0a 09 20 28 64 65 66 69 6e 65 2d r)))... (define-
5a70: 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 74 75 63 syntax match-tuc
5a80: 6b 2d 69 64 73 0a 09 20 28 73 79 6e 74 61 78 2d k-ids.. (syntax-
5a90: 72 75 6c 65 73 20 28 29 0a 09 20 28 28 5f 20 28 rules ().. ((_ (
5aa0: 6c 65 74 69 73 68 20 61 72 67 73 20 28 65 78 70 letish args (exp
5ab0: 72 20 2e 2e 2e 29 29 20 69 64 73 20 2e 2e 2e 29 r ...)) ids ...)
5ac0: 0a 09 20 28 6c 65 74 69 73 68 20 61 72 67 73 20 .. (letish args
5ad0: 28 65 78 70 72 20 2e 2e 2e 20 69 64 73 20 2e 2e (expr ... ids ..
5ae0: 2e 29 29 29 29 29 0a 0a 09 20 28 64 65 66 69 6e .)))))... (defin
5af0: 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 64 e-syntax match-d
5b00: 72 6f 70 2d 66 69 72 73 74 2d 61 72 67 0a 09 20 rop-first-arg..
5b10: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
5b20: 0a 09 20 28 28 5f 20 61 72 67 20 65 78 70 72 29 .. ((_ arg expr)
5b30: 20 65 78 70 72 29 29 29 0a 0a 09 20 3b 3b 20 54 expr)))... ;; T
5b40: 6f 20 65 78 70 61 6e 64 20 61 6e 20 4f 52 20 67 o expand an OR g
5b50: 72 6f 75 70 20 77 65 20 74 72 79 20 65 61 63 68 roup we try each
5b60: 20 63 6c 61 75 73 65 20 69 6e 20 73 75 63 63 65 clause in succe
5b70: 73 73 69 6f 6e 2c 20 70 61 73 73 69 6e 67 20 74 ssion, passing t
5b80: 68 65 0a 09 20 3b 3b 20 66 69 72 73 74 20 74 68 he.. ;; first th
5b90: 61 74 20 73 75 63 63 65 65 64 73 20 74 6f 20 74 at succeeds to t
5ba0: 68 65 20 73 75 63 63 65 73 73 20 63 6f 6e 74 69 he success conti
5bb0: 6e 75 61 74 69 6f 6e 2e 20 20 4f 6e 20 66 61 69 nuation. On fai
5bc0: 6c 75 72 65 20 66 6f 72 0a 09 20 3b 3b 20 61 6e lure for.. ;; an
5bd0: 79 20 63 6c 61 75 73 65 2c 20 77 65 20 6a 75 73 y clause, we jus
5be0: 74 20 74 72 79 20 74 68 65 20 6e 65 78 74 20 63 t try the next c
5bf0: 6c 61 75 73 65 2c 20 66 69 6e 61 6c 6c 79 20 72 lause, finally r
5c00: 65 73 6f 72 74 69 6e 67 20 74 6f 20 74 68 65 0a esorting to the.
5c10: 09 20 3b 3b 20 66 61 69 6c 75 72 65 20 63 6f 6e . ;; failure con
5c20: 74 69 6e 75 61 74 69 6f 6e 20 66 6b 20 69 66 20 tinuation fk if
5c30: 61 6c 6c 20 63 6c 61 75 73 65 73 20 66 61 69 6c all clauses fail
5c40: 2e 20 20 54 68 65 20 6f 6e 6c 79 20 74 72 69 63 . The only tric
5c50: 6b 20 69 73 0a 09 20 3b 3b 20 74 68 61 74 20 77 k is.. ;; that w
5c60: 65 20 77 61 6e 74 20 74 6f 20 75 6e 69 66 79 20 e want to unify
5c70: 74 68 65 20 69 64 65 6e 74 69 66 69 65 72 73 2c the identifiers,
5c80: 20 73 6f 20 74 68 61 74 20 74 68 65 20 73 75 63 so that the suc
5c90: 63 65 73 73 0a 09 20 3b 3b 20 63 6f 6e 74 69 6e cess.. ;; contin
5ca0: 75 61 74 69 6f 6e 20 63 61 6e 20 72 65 66 65 72 uation can refer
5cb0: 20 74 6f 20 61 20 76 61 72 69 61 62 6c 65 20 66 to a variable f
5cc0: 72 6f 6d 20 61 6e 79 20 6f 66 20 74 68 65 20 4f rom any of the O
5cd0: 52 20 63 6c 61 75 73 65 73 2e 0a 0a 09 20 28 64 R clauses.... (d
5ce0: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 efine-syntax mat
5cf0: 63 68 2d 67 65 6e 2d 6f 72 0a 09 20 28 73 79 6e ch-gen-or.. (syn
5d00: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 09 20 28 tax-rules ().. (
5d10: 28 5f 20 76 20 70 20 67 2b 73 20 28 73 6b 20 2e (_ v p g+s (sk .
5d20: 2e 2e 29 20 66 6b 20 28 69 20 2e 2e 2e 29 20 28 ..) fk (i ...) (
5d30: 28 69 64 20 69 64 2d 6c 73 29 20 2e 2e 2e 29 29 (id id-ls) ...))
5d40: 0a 09 20 28 6c 65 74 20 28 28 73 6b 32 20 28 6c .. (let ((sk2 (l
5d50: 61 6d 62 64 61 20 28 69 64 20 2e 2e 2e 29 20 28 ambda (id ...) (
5d60: 73 6b 20 2e 2e 2e 20 28 69 20 2e 2e 2e 20 69 64 sk ... (i ... id
5d70: 20 2e 2e 2e 29 29 29 29 29 0a 09 20 28 6d 61 74 ...))))).. (mat
5d80: 63 68 2d 67 65 6e 2d 6f 72 2d 73 74 65 70 20 76 ch-gen-or-step v
5d90: 20 70 20 67 2b 73 20 28 6d 61 74 63 68 2d 64 72 p g+s (match-dr
5da0: 6f 70 2d 69 64 73 20 28 73 6b 32 20 69 64 20 2e op-ids (sk2 id .
5db0: 2e 2e 29 29 20 66 6b 20 28 69 20 2e 2e 2e 29 29 ..)) fk (i ...))
5dc0: 29 29 29 29 0a 0a 09 20 28 64 65 66 69 6e 65 2d ))))... (define-
5dd0: 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 67 65 6e syntax match-gen
5de0: 2d 6f 72 2d 73 74 65 70 0a 09 20 28 73 79 6e 74 -or-step.. (synt
5df0: 61 78 2d 72 75 6c 65 73 20 28 29 0a 09 20 28 28 ax-rules ().. ((
5e00: 5f 20 76 20 28 29 20 67 2b 73 20 73 6b 20 66 6b _ v () g+s sk fk
5e10: 20 2e 20 78 29 0a 09 20 3b 3b 20 6e 6f 20 4f 52 . x).. ;; no OR
5e20: 20 63 6c 61 75 73 65 73 2c 20 63 61 6c 6c 20 74 clauses, call t
5e30: 68 65 20 66 61 69 6c 75 72 65 20 63 6f 6e 74 69 he failure conti
5e40: 6e 75 61 74 69 6f 6e 0a 09 20 66 6b 29 0a 09 20 nuation.. fk)..
5e50: 28 28 5f 20 76 20 28 70 29 20 2e 20 78 29 0a 09 ((_ v (p) . x)..
5e60: 20 3b 3b 20 6c 61 73 74 20 28 6f 72 20 6f 6e 6c ;; last (or onl
5e70: 79 29 20 4f 52 20 63 6c 61 75 73 65 2c 20 6a 75 y) OR clause, ju
5e80: 73 74 20 65 78 70 61 6e 64 20 6e 6f 72 6d 61 6c st expand normal
5e90: 6c 79 0a 09 20 28 6d 61 74 63 68 2d 6f 6e 65 20 ly.. (match-one
5ea0: 76 20 70 20 2e 20 78 29 29 0a 09 20 28 28 5f 20 v p . x)).. ((_
5eb0: 76 20 28 70 20 2e 20 71 29 20 67 2b 73 20 73 6b v (p . q) g+s sk
5ec0: 20 66 6b 20 69 29 0a 09 20 3b 3b 20 6d 61 74 63 fk i).. ;; matc
5ed0: 68 20 6f 6e 65 20 61 6e 64 20 74 72 79 20 74 68 h one and try th
5ee0: 65 20 72 65 6d 61 69 6e 69 6e 67 20 6f 6e 20 66 e remaining on f
5ef0: 61 69 6c 75 72 65 0a 09 20 28 6c 65 74 20 28 28 ailure.. (let ((
5f00: 66 6b 32 20 28 6c 61 6d 62 64 61 20 28 29 20 28 fk2 (lambda () (
5f10: 6d 61 74 63 68 2d 67 65 6e 2d 6f 72 2d 73 74 65 match-gen-or-ste
5f20: 70 20 76 20 71 20 67 2b 73 20 73 6b 20 66 6b 20 p v q g+s sk fk
5f30: 69 29 29 29 29 0a 09 20 28 6d 61 74 63 68 2d 6f i)))).. (match-o
5f40: 6e 65 20 76 20 70 20 67 2b 73 20 73 6b 20 28 66 ne v p g+s sk (f
5f50: 6b 32 29 20 69 29 29 29 0a 09 20 29 29 0a 0a 09 k2) i))).. ))...
5f60: 20 3b 3b 20 57 65 20 6d 61 74 63 68 20 61 20 70 ;; We match a p
5f70: 61 74 74 65 72 6e 20 28 70 20 2e 2e 2e 29 20 62 attern (p ...) b
5f80: 79 20 6d 61 74 63 68 69 6e 67 20 74 68 65 20 70 y matching the p
5f90: 61 74 74 65 72 6e 20 70 20 69 6e 20 61 20 6c 6f attern p in a lo
5fa0: 6f 70 20 6f 6e 0a 09 20 3b 3b 20 65 61 63 68 20 op on.. ;; each
5fb0: 65 6c 65 6d 65 6e 74 20 6f 66 20 74 68 65 20 76 element of the v
5fc0: 61 72 69 61 62 6c 65 2c 20 61 63 63 75 6d 75 6c ariable, accumul
5fd0: 61 74 69 6e 67 20 74 68 65 20 62 6f 75 6e 64 20 ating the bound
5fe0: 69 64 73 20 69 6e 74 6f 20 6c 69 73 74 73 2e 0a ids into lists..
5ff0: 0a 09 20 3b 3b 20 4c 6f 6f 6b 20 61 74 20 74 68 .. ;; Look at th
6000: 65 20 62 6f 64 79 20 6f 66 20 74 68 65 20 73 69 e body of the si
6010: 6d 70 6c 65 20 63 61 73 65 20 2d 20 69 74 27 73 mple case - it's
6020: 20 6a 75 73 74 20 61 20 6e 61 6d 65 64 20 6c 65 just a named le
6030: 74 20 6c 6f 6f 70 2c 0a 09 20 3b 3b 20 6d 61 74 t loop,.. ;; mat
6040: 63 68 69 6e 67 20 65 61 63 68 20 65 6c 65 6d 65 ching each eleme
6050: 6e 74 20 69 6e 20 74 75 72 6e 20 74 6f 20 74 68 nt in turn to th
6060: 65 20 73 61 6d 65 20 70 61 74 74 65 72 6e 2e 20 e same pattern.
6070: 20 54 68 65 20 6f 6e 6c 79 20 74 72 69 63 6b 0a The only trick.
6080: 09 20 3b 3b 20 69 73 20 74 68 61 74 20 77 65 20 . ;; is that we
6090: 77 61 6e 74 20 74 6f 20 6b 65 65 70 20 74 72 61 want to keep tra
60a0: 63 6b 20 6f 66 20 74 68 65 20 6c 69 73 74 73 20 ck of the lists
60b0: 6f 66 20 65 61 63 68 20 65 78 74 72 61 63 74 65 of each extracte
60c0: 64 20 69 64 2c 20 73 6f 0a 09 20 3b 3b 20 77 68 d id, so.. ;; wh
60d0: 65 6e 20 74 68 65 20 6c 6f 6f 70 20 72 65 63 75 en the loop recu
60e0: 72 73 65 73 20 77 65 20 63 6f 6e 73 20 74 68 65 rses we cons the
60f0: 20 69 64 73 20 6f 6e 74 6f 20 74 68 65 69 72 20 ids onto their
6100: 72 65 73 70 65 63 74 69 76 65 20 6c 69 73 74 0a respective list.
6110: 09 20 3b 3b 20 76 61 72 69 61 62 6c 65 73 2c 20 . ;; variables,
6120: 61 6e 64 20 6f 6e 20 73 75 63 63 65 73 73 20 77 and on success w
6130: 65 20 62 69 6e 64 20 74 68 65 20 69 64 73 20 28 e bind the ids (
6140: 77 68 61 74 20 74 68 65 20 75 73 65 72 20 69 6e what the user in
6150: 70 75 74 20 61 6e 64 0a 09 20 3b 3b 20 65 78 70 put and.. ;; exp
6160: 65 63 74 73 20 74 6f 20 73 65 65 20 69 6e 20 74 ects to see in t
6170: 68 65 20 73 75 63 63 65 73 73 20 62 6f 64 79 29 he success body)
6180: 20 74 6f 20 74 68 65 20 72 65 76 65 72 73 65 64 to the reversed
6190: 20 61 63 63 75 6d 75 6c 61 74 65 64 0a 09 20 3b accumulated.. ;
61a0: 3b 20 6c 69 73 74 20 49 44 73 2e 0a 0a 09 20 28 ; list IDs.... (
61b0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 define-syntax ma
61c0: 74 63 68 2d 67 65 6e 2d 65 6c 6c 69 70 73 69 73 tch-gen-ellipsis
61d0: 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 .. (syntax-rules
61e0: 20 28 29 0a 09 20 28 28 5f 20 76 20 70 20 28 29 ().. ((_ v p ()
61f0: 20 67 2b 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b g+s (sk ...) fk
6200: 20 69 20 28 28 69 64 20 69 64 2d 6c 73 29 20 2e i ((id id-ls) .
6210: 2e 2e 29 29 0a 09 20 28 6d 61 74 63 68 2d 63 68 ..)).. (match-ch
6220: 65 63 6b 2d 69 64 65 6e 74 69 66 69 65 72 20 70 eck-identifier p
6230: 0a 09 20 3b 3b 20 73 69 6d 70 6c 65 73 74 20 63 .. ;; simplest c
6240: 61 73 65 20 65 71 75 69 76 61 6c 65 6e 74 20 74 ase equivalent t
6250: 6f 20 28 70 20 2e 2e 2e 29 2c 20 6a 75 73 74 20 o (p ...), just
6260: 62 69 6e 64 20 74 68 65 20 6c 69 73 74 0a 09 20 bind the list..
6270: 28 6c 65 74 20 28 28 70 20 76 29 29 0a 20 20 20 (let ((p v)).
6280: 20 20 20 20 20 20 28 69 66 20 28 6c 69 73 74 3f (if (list?
6290: 20 70 29 0a 09 20 28 73 6b 20 2e 2e 2e 20 69 29 p).. (sk ... i)
62a0: 0a 09 20 66 6b 29 29 0a 09 20 3b 3b 20 73 69 6d .. fk)).. ;; sim
62b0: 70 6c 65 20 63 61 73 65 2c 20 6d 61 74 63 68 20 ple case, match
62c0: 61 6c 6c 20 65 6c 65 6d 65 6e 74 73 20 6f 66 20 all elements of
62d0: 74 68 65 20 6c 69 73 74 0a 09 20 28 6c 65 74 20 the list.. (let
62e0: 6c 6f 6f 70 20 28 28 6c 73 20 76 29 20 28 69 64 loop ((ls v) (id
62f0: 2d 6c 73 20 27 28 29 29 20 2e 2e 2e 29 0a 20 20 -ls '()) ...).
6300: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 09 20 28 (cond.. (
6310: 28 6e 75 6c 6c 3f 20 6c 73 29 0a 09 20 28 6c 65 (null? ls).. (le
6320: 74 20 28 28 69 64 20 28 72 65 76 65 72 73 65 20 t ((id (reverse
6330: 69 64 2d 6c 73 29 29 20 2e 2e 2e 29 20 28 73 6b id-ls)) ...) (sk
6340: 20 2e 2e 2e 20 69 29 29 29 0a 09 20 28 28 70 61 ... i))).. ((pa
6350: 69 72 3f 20 6c 73 29 0a 09 20 28 6c 65 74 20 28 ir? ls).. (let (
6360: 28 77 20 28 63 61 72 20 6c 73 29 29 29 0a 09 20 (w (car ls)))..
6370: 28 6d 61 74 63 68 2d 6f 6e 65 20 77 20 70 20 28 (match-one w p (
6380: 28 63 61 72 20 6c 73 29 20 28 73 65 74 2d 63 61 (car ls) (set-ca
6390: 72 21 20 6c 73 29 29 0a 09 20 28 6d 61 74 63 68 r! ls)).. (match
63a0: 2d 64 72 6f 70 2d 69 64 73 20 28 6c 6f 6f 70 20 -drop-ids (loop
63b0: 28 63 64 72 20 6c 73 29 20 28 63 6f 6e 73 20 69 (cdr ls) (cons i
63c0: 64 20 69 64 2d 6c 73 29 20 2e 2e 2e 29 29 0a 09 d id-ls) ...))..
63d0: 20 66 6b 20 69 29 29 29 0a 09 20 28 65 6c 73 65 fk i))).. (else
63e0: 0a 09 20 66 6b 29 29 29 29 29 0a 09 20 28 28 5f .. fk))))).. ((_
63f0: 20 76 20 70 20 72 20 67 2b 73 20 28 73 6b 20 2e v p r g+s (sk .
6400: 2e 2e 29 20 66 6b 20 69 20 28 28 69 64 20 69 64 ..) fk i ((id id
6410: 2d 6c 73 29 20 2e 2e 2e 29 29 0a 09 20 3b 3b 20 -ls) ...)).. ;;
6420: 67 65 6e 65 72 61 6c 20 63 61 73 65 2c 20 74 72 general case, tr
6430: 61 69 6c 69 6e 67 20 70 61 74 74 65 72 6e 73 20 ailing patterns
6440: 74 6f 20 6d 61 74 63 68 2c 20 6b 65 65 70 20 74 to match, keep t
6450: 72 61 63 6b 20 6f 66 20 74 68 65 0a 09 20 3b 3b rack of the.. ;;
6460: 20 72 65 6d 61 69 6e 69 6e 67 20 6c 69 73 74 20 remaining list
6470: 6c 65 6e 67 74 68 20 73 6f 20 77 65 20 64 6f 6e length so we don
6480: 27 74 20 6e 65 65 64 20 61 6e 79 20 62 61 63 6b 't need any back
6490: 74 72 61 63 6b 69 6e 67 0a 09 20 28 6d 61 74 63 tracking.. (matc
64a0: 68 2d 76 65 72 69 66 79 2d 6e 6f 2d 65 6c 6c 69 h-verify-no-elli
64b0: 70 73 69 73 0a 09 20 72 0a 09 20 28 6c 65 74 2a psis.. r.. (let*
64c0: 20 28 28 74 61 69 6c 2d 6c 65 6e 20 28 6c 65 6e ((tail-len (len
64d0: 67 74 68 20 27 72 29 29 0a 09 20 28 6c 73 20 76 gth 'r)).. (ls v
64e0: 29 0a 09 20 28 6c 65 6e 20 28 61 6e 64 20 28 6c ).. (len (and (l
64f0: 69 73 74 3f 20 6c 73 29 20 28 6c 65 6e 67 74 68 ist? ls) (length
6500: 20 6c 73 29 29 29 29 0a 09 20 28 69 66 20 28 6f ls)))).. (if (o
6510: 72 20 28 6e 6f 74 20 6c 65 6e 29 20 28 3c 20 6c r (not len) (< l
6520: 65 6e 20 74 61 69 6c 2d 6c 65 6e 29 29 0a 09 20 en tail-len))..
6530: 66 6b 0a 09 20 28 6c 65 74 20 6c 6f 6f 70 20 28 fk.. (let loop (
6540: 28 6c 73 20 6c 73 29 20 28 6e 20 6c 65 6e 29 20 (ls ls) (n len)
6550: 28 69 64 2d 6c 73 20 27 28 29 29 20 2e 2e 2e 29 (id-ls '()) ...)
6560: 0a 09 20 28 63 6f 6e 64 0a 09 20 28 28 3d 20 6e .. (cond.. ((= n
6570: 20 74 61 69 6c 2d 6c 65 6e 29 0a 09 20 28 6c 65 tail-len).. (le
6580: 74 20 28 28 69 64 20 28 72 65 76 65 72 73 65 20 t ((id (reverse
6590: 69 64 2d 6c 73 29 29 20 2e 2e 2e 29 0a 09 20 28 id-ls)) ...).. (
65a0: 6d 61 74 63 68 2d 6f 6e 65 20 6c 73 20 72 20 28 match-one ls r (
65b0: 23 66 20 23 66 29 20 28 73 6b 20 2e 2e 2e 29 20 #f #f) (sk ...)
65c0: 66 6b 20 69 29 29 29 0a 09 20 28 28 70 61 69 72 fk i))).. ((pair
65d0: 3f 20 6c 73 29 0a 09 20 28 6c 65 74 20 28 28 77 ? ls).. (let ((w
65e0: 20 28 63 61 72 20 6c 73 29 29 29 0a 09 20 28 6d (car ls))).. (m
65f0: 61 74 63 68 2d 6f 6e 65 20 77 20 70 20 28 28 63 atch-one w p ((c
6600: 61 72 20 6c 73 29 20 28 73 65 74 2d 63 61 72 21 ar ls) (set-car!
6610: 20 6c 73 29 29 0a 09 20 28 6d 61 74 63 68 2d 64 ls)).. (match-d
6620: 72 6f 70 2d 69 64 73 0a 09 20 28 6c 6f 6f 70 20 rop-ids.. (loop
6630: 28 63 64 72 20 6c 73 29 20 28 2d 20 6e 20 31 29 (cdr ls) (- n 1)
6640: 20 28 63 6f 6e 73 20 69 64 20 69 64 2d 6c 73 29 (cons id id-ls)
6650: 20 2e 2e 2e 29 29 0a 09 20 66 6b 0a 09 20 69 29 ...)).. fk.. i)
6660: 29 29 0a 09 20 28 65 6c 73 65 0a 09 20 66 6b 29 )).. (else.. fk)
6670: 29 29 29 29 29 29 29 29 0a 0a 09 20 3b 3b 20 54 ))))))))... ;; T
6680: 68 69 73 20 69 73 20 6a 75 73 74 20 61 20 73 61 his is just a sa
6690: 66 65 74 79 20 63 68 65 63 6b 2e 20 20 41 6c 74 fety check. Alt
66a0: 68 6f 75 67 68 20 75 6e 6c 69 6b 65 20 73 79 6e hough unlike syn
66b0: 74 61 78 2d 72 75 6c 65 73 20 77 65 20 61 6c 6c tax-rules we all
66c0: 6f 77 0a 09 20 3b 3b 20 74 72 61 69 6c 69 6e 67 ow.. ;; trailing
66d0: 20 70 61 74 74 65 72 6e 73 20 61 66 74 65 72 20 patterns after
66e0: 61 6e 20 65 6c 6c 69 70 73 69 73 2c 20 77 65 20 an ellipsis, we
66f0: 65 78 70 6c 69 63 69 74 6c 79 20 64 69 73 61 62 explicitly disab
6700: 6c 65 20 6d 75 6c 74 69 70 6c 65 0a 09 20 3b 3b le multiple.. ;;
6710: 20 65 6c 6c 69 70 73 69 73 20 61 74 20 74 68 65 ellipsis at the
6720: 20 73 61 6d 65 20 6c 65 76 65 6c 2e 20 20 54 68 same level. Th
6730: 69 73 20 69 73 20 62 65 63 61 75 73 65 20 69 6e is is because in
6740: 20 74 68 65 20 67 65 6e 65 72 61 6c 20 63 61 73 the general cas
6750: 65 0a 09 20 3b 3b 20 73 75 63 68 20 70 61 74 74 e.. ;; such patt
6760: 65 72 6e 73 20 61 72 65 20 65 78 70 6f 6e 65 6e erns are exponen
6770: 74 69 61 6c 20 69 6e 20 74 68 65 20 6e 75 6d 62 tial in the numb
6780: 65 72 20 6f 66 20 65 6c 6c 69 70 73 69 73 2c 20 er of ellipsis,
6790: 61 6e 64 20 77 65 0a 09 20 3b 3b 20 64 6f 6e 27 and we.. ;; don'
67a0: 74 20 77 61 6e 74 20 74 6f 20 6d 61 6b 65 20 69 t want to make i
67b0: 74 20 65 61 73 79 20 74 6f 20 63 6f 6e 73 74 72 t easy to constr
67c0: 75 63 74 20 76 65 72 79 20 65 78 70 65 6e 73 69 uct very expensi
67d0: 76 65 20 6f 70 65 72 61 74 69 6f 6e 73 0a 09 20 ve operations..
67e0: 3b 3b 20 77 69 74 68 20 73 69 6d 70 6c 65 20 6c ;; with simple l
67f0: 6f 6f 6b 69 6e 67 20 70 61 74 74 65 72 6e 73 2e ooking patterns.
6800: 20 20 46 6f 72 20 65 78 61 6d 70 6c 65 2c 20 69 For example, i
6810: 74 20 77 6f 75 6c 64 20 62 65 20 4f 28 6e 5e 32 t would be O(n^2
6820: 29 20 66 6f 72 0a 09 20 3b 3b 20 70 61 74 74 65 ) for.. ;; patte
6830: 72 6e 73 20 6c 69 6b 65 20 28 61 20 2e 2e 2e 20 rns like (a ...
6840: 62 20 2e 2e 2e 29 20 62 65 63 61 75 73 65 20 77 b ...) because w
6850: 65 20 6d 75 73 74 20 63 6f 6e 73 69 64 65 72 20 e must consider
6860: 65 76 65 72 79 20 74 72 61 69 6c 69 6e 67 0a 09 every trailing..
6870: 20 3b 3b 20 65 6c 65 6d 65 6e 74 20 66 6f 72 20 ;; element for
6880: 65 76 65 72 79 20 70 6f 73 73 69 62 6c 65 20 62 every possible b
6890: 72 65 61 6b 20 66 6f 72 20 74 68 65 20 6c 65 61 reak for the lea
68a0: 64 69 6e 67 20 22 61 20 2e 2e 2e 22 2e 0a 0a 09 ding "a ..."....
68b0: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 (define-syntax
68c0: 6d 61 74 63 68 2d 76 65 72 69 66 79 2d 6e 6f 2d match-verify-no-
68d0: 65 6c 6c 69 70 73 69 73 0a 09 20 28 73 79 6e 74 ellipsis.. (synt
68e0: 61 78 2d 72 75 6c 65 73 20 28 29 0a 09 20 28 28 ax-rules ().. ((
68f0: 5f 20 28 78 20 2e 20 79 29 20 73 6b 29 0a 09 20 _ (x . y) sk)..
6900: 28 6d 61 74 63 68 2d 63 68 65 63 6b 2d 65 6c 6c (match-check-ell
6910: 69 70 73 69 73 0a 09 20 78 0a 09 20 28 6d 61 74 ipsis.. x.. (mat
6920: 63 68 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 0a ch-syntax-error.
6930: 09 20 22 6d 75 6c 74 69 70 6c 65 20 65 6c 6c 69 . "multiple elli
6940: 70 73 69 73 20 70 61 74 74 65 72 6e 73 20 6e 6f psis patterns no
6950: 74 20 61 6c 6c 6f 77 65 64 20 61 74 20 73 61 6d t allowed at sam
6960: 65 20 6c 65 76 65 6c 22 29 0a 09 20 28 6d 61 74 e level").. (mat
6970: 63 68 2d 76 65 72 69 66 79 2d 6e 6f 2d 65 6c 6c ch-verify-no-ell
6980: 69 70 73 69 73 20 79 20 73 6b 29 29 29 0a 09 20 ipsis y sk)))..
6990: 28 28 5f 20 28 29 20 73 6b 29 0a 09 20 73 6b 29 ((_ () sk).. sk)
69a0: 0a 09 20 28 28 5f 20 78 20 73 6b 29 0a 09 20 28 .. ((_ x sk).. (
69b0: 6d 61 74 63 68 2d 73 79 6e 74 61 78 2d 65 72 72 match-syntax-err
69c0: 6f 72 20 22 64 6f 74 74 65 64 20 74 61 69 6c 20 or "dotted tail
69d0: 6e 6f 74 20 61 6c 6c 6f 77 65 64 20 61 66 74 65 not allowed afte
69e0: 72 20 65 6c 6c 69 70 73 69 73 22 20 78 29 29 29 r ellipsis" x)))
69f0: 29 0a 0a 09 20 3b 3b 20 54 6f 20 69 6d 70 6c 65 )... ;; To imple
6a00: 6d 65 6e 74 20 74 68 65 20 74 72 65 65 20 73 65 ment the tree se
6a10: 61 72 63 68 2c 20 77 65 20 75 73 65 20 74 77 6f arch, we use two
6a20: 20 72 65 63 75 72 73 69 76 65 20 70 72 6f 63 65 recursive proce
6a30: 64 75 72 65 73 2e 20 20 54 52 59 0a 09 20 3b 3b dures. TRY.. ;;
6a40: 20 61 74 74 65 6d 70 74 73 20 74 6f 20 6d 61 74 attempts to mat
6a50: 63 68 20 59 20 6f 6e 63 65 2c 20 61 6e 64 20 6f ch Y once, and o
6a60: 6e 20 73 75 63 63 65 73 73 20 69 74 20 63 61 6c n success it cal
6a70: 6c 73 20 74 68 65 20 6e 6f 72 6d 61 6c 20 53 4b ls the normal SK
6a80: 20 6f 6e 0a 09 20 3b 3b 20 74 68 65 20 61 63 63 on.. ;; the acc
6a90: 75 6d 75 6c 61 74 65 64 20 6c 69 73 74 20 69 64 umulated list id
6aa0: 73 20 61 73 20 69 6e 20 4d 41 54 43 48 2d 47 45 s as in MATCH-GE
6ab0: 4e 2d 45 4c 4c 49 50 53 49 53 2e 20 20 4f 6e 20 N-ELLIPSIS. On
6ac0: 66 61 69 6c 75 72 65 2c 20 77 65 0a 09 20 3b 3b failure, we.. ;;
6ad0: 20 63 61 6c 6c 20 4e 45 58 54 20 77 68 69 63 68 call NEXT which
6ae0: 20 66 69 72 73 74 20 63 68 65 63 6b 73 20 69 66 first checks if
6af0: 20 74 68 65 20 63 75 72 72 65 6e 74 20 76 61 6c the current val
6b00: 75 65 20 69 73 20 61 20 6c 69 73 74 0a 09 20 3b ue is a list.. ;
6b10: 3b 20 62 65 67 69 6e 6e 69 6e 67 20 77 69 74 68 ; beginning with
6b20: 20 58 2c 20 74 68 65 6e 20 63 61 6c 6c 73 20 54 X, then calls T
6b30: 52 59 20 6f 6e 20 65 61 63 68 20 72 65 6d 61 69 RY on each remai
6b40: 6e 69 6e 67 20 65 6c 65 6d 65 6e 74 20 6f 66 20 ning element of
6b50: 74 68 65 0a 09 20 3b 3b 20 6c 69 73 74 2e 20 20 the.. ;; list.
6b60: 53 69 6e 63 65 20 54 52 59 20 77 69 6c 6c 20 72 Since TRY will r
6b70: 65 63 75 72 73 69 76 65 6c 79 20 63 61 6c 6c 20 ecursively call
6b80: 4e 45 58 54 20 61 67 61 69 6e 20 6f 6e 20 66 61 NEXT again on fa
6b90: 69 6c 75 72 65 2c 20 74 68 69 73 0a 09 20 3b 3b ilure, this.. ;;
6ba0: 20 65 66 66 65 63 74 73 20 61 20 66 75 6c 6c 20 effects a full
6bb0: 64 65 70 74 68 2d 66 69 72 73 74 20 73 65 61 72 depth-first sear
6bc0: 63 68 2e 0a 09 20 3b 3b 0a 09 20 3b 3b 20 54 68 ch... ;;.. ;; Th
6bd0: 65 20 66 61 69 6c 75 72 65 20 63 6f 6e 74 69 6e e failure contin
6be0: 75 61 74 69 6f 6e 20 74 68 72 6f 75 67 68 6f 75 uation throughou
6bf0: 74 20 69 73 20 61 20 6a 75 6d 70 20 74 6f 20 74 t is a jump to t
6c00: 68 65 20 6e 65 78 74 20 73 74 65 70 20 69 6e 0a he next step in.
6c10: 09 20 3b 3b 20 74 68 65 20 74 72 65 65 20 73 65 . ;; the tree se
6c20: 61 72 63 68 2c 20 69 6e 69 74 69 61 6c 69 7a 65 arch, initialize
6c30: 64 20 77 69 74 68 20 74 68 65 20 6f 72 69 67 69 d with the origi
6c40: 6e 61 6c 20 66 61 69 6c 75 72 65 20 63 6f 6e 74 nal failure cont
6c50: 69 6e 75 61 74 69 6f 6e 0a 09 20 3b 3b 20 46 4b inuation.. ;; FK
6c60: 2e 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 6e .... (define-syn
6c70: 74 61 78 20 6d 61 74 63 68 2d 67 65 6e 2d 73 65 tax match-gen-se
6c80: 61 72 63 68 0a 09 20 28 73 79 6e 74 61 78 2d 72 arch.. (syntax-r
6c90: 75 6c 65 73 20 28 29 0a 09 20 28 28 6d 61 74 63 ules ().. ((matc
6ca0: 68 2d 67 65 6e 2d 73 65 61 72 63 68 20 76 20 70 h-gen-search v p
6cb0: 20 71 20 67 2b 73 20 73 6b 20 66 6b 20 69 20 28 q g+s sk fk i (
6cc0: 28 69 64 20 69 64 2d 6c 73 29 20 2e 2e 2e 29 29 (id id-ls) ...))
6cd0: 0a 09 20 28 6c 65 74 72 65 63 20 28 28 74 72 79 .. (letrec ((try
6ce0: 20 28 6c 61 6d 62 64 61 20 28 77 20 66 61 69 6c (lambda (w fail
6cf0: 20 69 64 2d 6c 73 20 2e 2e 2e 29 0a 09 20 28 6d id-ls ...).. (m
6d00: 61 74 63 68 2d 6f 6e 65 20 77 20 71 20 67 2b 73 atch-one w q g+s
6d10: 0a 09 20 28 6d 61 74 63 68 2d 74 75 63 6b 2d 69 .. (match-tuck-i
6d20: 64 73 0a 09 20 28 6c 65 74 20 28 28 69 64 20 28 ds.. (let ((id (
6d30: 72 65 76 65 72 73 65 20 69 64 2d 6c 73 29 29 20 reverse id-ls))
6d40: 2e 2e 2e 29 0a 09 20 73 6b 29 29 0a 09 20 28 6e ...).. sk)).. (n
6d50: 65 78 74 20 77 20 66 61 69 6c 20 69 64 2d 6c 73 ext w fail id-ls
6d60: 20 2e 2e 2e 29 20 69 29 29 29 0a 09 20 28 6e 65 ...) i))).. (ne
6d70: 78 74 20 28 6c 61 6d 62 64 61 20 28 77 20 66 61 xt (lambda (w fa
6d80: 69 6c 20 69 64 2d 6c 73 20 2e 2e 2e 29 0a 09 20 il id-ls ...)..
6d90: 28 69 66 20 28 6e 6f 74 20 28 70 61 69 72 3f 20 (if (not (pair?
6da0: 77 29 29 0a 09 20 28 66 61 69 6c 29 0a 09 20 28 w)).. (fail).. (
6db0: 6c 65 74 20 28 28 75 20 28 63 61 72 20 77 29 29 let ((u (car w))
6dc0: 29 0a 09 20 28 6d 61 74 63 68 2d 6f 6e 65 0a 09 ).. (match-one..
6dd0: 20 75 20 70 20 28 28 63 61 72 20 77 29 20 28 73 u p ((car w) (s
6de0: 65 74 2d 63 61 72 21 20 77 29 29 0a 09 20 28 6d et-car! w)).. (m
6df0: 61 74 63 68 2d 64 72 6f 70 2d 69 64 73 0a 09 20 atch-drop-ids..
6e00: 3b 3b 20 61 63 63 75 6d 75 6c 61 74 65 20 74 68 ;; accumulate th
6e10: 65 20 68 65 61 64 20 76 61 72 69 61 62 6c 65 73 e head variables
6e20: 20 66 72 6f 6d 0a 09 20 3b 3b 20 74 68 65 20 70 from.. ;; the p
6e30: 20 70 61 74 74 65 72 6e 2c 20 61 6e 64 20 6c 6f pattern, and lo
6e40: 6f 70 20 6f 76 65 72 20 74 68 65 20 74 61 69 6c op over the tail
6e50: 0a 09 20 28 6c 65 74 20 28 28 69 64 2d 6c 73 20 .. (let ((id-ls
6e60: 28 63 6f 6e 73 20 69 64 20 69 64 2d 6c 73 29 29 (cons id id-ls))
6e70: 20 2e 2e 2e 29 0a 09 20 28 6c 65 74 20 6c 70 20 ...).. (let lp
6e80: 28 28 6c 73 20 28 63 64 72 20 77 29 29 29 0a 09 ((ls (cdr w)))..
6e90: 20 28 69 66 20 28 70 61 69 72 3f 20 6c 73 29 0a (if (pair? ls).
6ea0: 09 20 28 74 72 79 20 28 63 61 72 20 6c 73 29 0a . (try (car ls).
6eb0: 09 20 28 6c 61 6d 62 64 61 20 28 29 20 28 6c 70 . (lambda () (lp
6ec0: 20 28 63 64 72 20 6c 73 29 29 29 0a 09 20 69 64 (cdr ls))).. id
6ed0: 2d 6c 73 20 2e 2e 2e 29 0a 09 20 28 66 61 69 6c -ls ...).. (fail
6ee0: 29 29 29 29 29 0a 09 20 28 66 61 69 6c 29 20 69 ))))).. (fail) i
6ef0: 29 29 29 29 29 29 0a 09 20 3b 3b 20 74 68 65 20 )))))).. ;; the
6f00: 69 6e 69 74 69 61 6c 20 69 64 2d 6c 73 20 62 69 initial id-ls bi
6f10: 6e 64 69 6e 67 20 68 65 72 65 20 69 73 20 61 20 nding here is a
6f20: 64 75 6d 6d 79 20 74 6f 20 67 65 74 20 74 68 65 dummy to get the
6f30: 20 72 69 67 68 74 0a 09 20 3b 3b 20 6e 75 6d 62 right.. ;; numb
6f40: 65 72 20 6f 66 20 27 28 29 73 0a 09 20 28 6c 65 er of '()s.. (le
6f50: 74 20 28 28 69 64 2d 6c 73 20 27 28 29 29 20 2e t ((id-ls '()) .
6f60: 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 28 74 72 ..). (tr
6f70: 79 20 76 20 28 6c 61 6d 62 64 61 20 28 29 20 66 y v (lambda () f
6f80: 6b 29 20 69 64 2d 6c 73 20 2e 2e 2e 29 29 29 29 k) id-ls ...))))
6f90: 29 29 0a 0a 09 20 3b 3b 20 56 65 63 74 6f 72 20 ))... ;; Vector
6fa0: 70 61 74 74 65 72 6e 73 20 61 72 65 20 6a 75 73 patterns are jus
6fb0: 74 20 6d 6f 72 65 20 6f 66 20 74 68 65 20 73 61 t more of the sa
6fc0: 6d 65 2c 20 77 69 74 68 20 74 68 65 20 73 6c 69 me, with the sli
6fd0: 67 68 74 0a 09 20 3b 3b 20 65 78 63 65 70 74 69 ght.. ;; excepti
6fe0: 6f 6e 20 74 68 61 74 20 77 65 20 70 61 73 73 20 on that we pass
6ff0: 61 72 6f 75 6e 64 20 74 68 65 20 63 75 72 72 65 around the curre
7000: 6e 74 20 76 65 63 74 6f 72 20 69 6e 64 65 78 20 nt vector index
7010: 62 65 69 6e 67 0a 09 20 3b 3b 20 6d 61 74 63 68 being.. ;; match
7020: 65 64 2e 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 ed.... (define-s
7030: 79 6e 74 61 78 20 6d 61 74 63 68 2d 76 65 63 74 yntax match-vect
7040: 6f 72 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c or.. (syntax-rul
7050: 65 73 20 28 5f 5f 5f 29 0a 09 20 28 28 5f 20 76 es (___).. ((_ v
7060: 20 6e 20 70 61 74 73 20 28 70 20 71 29 20 2e 20 n pats (p q) .
7070: 78 29 0a 09 20 28 6d 61 74 63 68 2d 63 68 65 63 x).. (match-chec
7080: 6b 2d 65 6c 6c 69 70 73 69 73 20 71 0a 09 20 28 k-ellipsis q.. (
7090: 6d 61 74 63 68 2d 67 65 6e 2d 76 65 63 74 6f 72 match-gen-vector
70a0: 2d 65 6c 6c 69 70 73 69 73 20 76 20 6e 20 70 61 -ellipsis v n pa
70b0: 74 73 20 70 20 2e 20 78 29 0a 09 20 28 6d 61 74 ts p . x).. (mat
70c0: 63 68 2d 76 65 63 74 6f 72 2d 74 77 6f 20 76 20 ch-vector-two v
70d0: 6e 20 70 61 74 73 20 28 70 20 71 29 20 2e 20 78 n pats (p q) . x
70e0: 29 29 29 0a 09 20 28 28 5f 20 76 20 6e 20 70 61 ))).. ((_ v n pa
70f0: 74 73 20 28 70 20 5f 5f 5f 29 20 73 6b 20 66 6b ts (p ___) sk fk
7100: 20 69 29 0a 09 20 28 6d 61 74 63 68 2d 67 65 6e i).. (match-gen
7110: 2d 76 65 63 74 6f 72 2d 65 6c 6c 69 70 73 69 73 -vector-ellipsis
7120: 20 76 20 6e 20 70 61 74 73 20 70 20 73 6b 20 66 v n pats p sk f
7130: 6b 20 69 29 29 0a 09 20 28 28 5f 20 2e 20 78 29 k i)).. ((_ . x)
7140: 0a 09 20 28 6d 61 74 63 68 2d 76 65 63 74 6f 72 .. (match-vector
7150: 2d 74 77 6f 20 2e 20 78 29 29 29 29 0a 0a 09 20 -two . x))))...
7160: 3b 3b 20 43 68 65 63 6b 20 74 68 65 20 65 78 61 ;; Check the exa
7170: 63 74 20 76 65 63 74 6f 72 20 6c 65 6e 67 74 68 ct vector length
7180: 2c 20 74 68 65 6e 20 63 68 65 63 6b 20 65 61 63 , then check eac
7190: 68 20 65 6c 65 6d 65 6e 74 20 69 6e 20 74 75 72 h element in tur
71a0: 6e 2e 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 n.... (define-sy
71b0: 6e 74 61 78 20 6d 61 74 63 68 2d 76 65 63 74 6f ntax match-vecto
71c0: 72 2d 74 77 6f 0a 09 20 28 73 79 6e 74 61 78 2d r-two.. (syntax-
71d0: 72 75 6c 65 73 20 28 29 0a 09 20 28 28 5f 20 76 rules ().. ((_ v
71e0: 20 6e 20 28 28 70 61 74 20 69 6e 64 65 78 29 20 n ((pat index)
71f0: 2e 2e 2e 29 20 28 29 20 73 6b 20 66 6b 20 69 29 ...) () sk fk i)
7200: 0a 09 20 28 69 66 20 28 76 65 63 74 6f 72 3f 20 .. (if (vector?
7210: 76 29 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 v). (let
7220: 20 28 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d 6c ((len (vector-l
7230: 65 6e 67 74 68 20 76 29 29 29 0a 09 20 28 69 66 ength v))).. (if
7240: 20 28 3d 20 6c 65 6e 20 6e 29 0a 09 20 28 6d 61 (= len n).. (ma
7250: 74 63 68 2d 76 65 63 74 6f 72 2d 73 74 65 70 20 tch-vector-step
7260: 76 20 28 28 70 61 74 20 69 6e 64 65 78 29 20 2e v ((pat index) .
7270: 2e 2e 29 20 73 6b 20 66 6b 20 69 29 0a 09 20 66 ..) sk fk i).. f
7280: 6b 29 29 0a 20 20 20 20 20 20 20 20 20 66 6b 29 k)). fk)
7290: 29 0a 09 20 28 28 5f 20 76 20 6e 20 28 70 61 74 ).. ((_ v n (pat
72a0: 73 20 2e 2e 2e 29 20 28 70 20 2e 20 71 29 20 2e s ...) (p . q) .
72b0: 20 78 29 0a 09 20 28 6d 61 74 63 68 2d 76 65 63 x).. (match-vec
72c0: 74 6f 72 20 76 20 28 2b 20 6e 20 31 29 20 28 70 tor v (+ n 1) (p
72d0: 61 74 73 20 2e 2e 2e 20 28 70 20 6e 29 29 20 71 ats ... (p n)) q
72e0: 20 2e 20 78 29 29 29 29 0a 0a 09 20 28 64 65 66 . x))))... (def
72f0: 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 ine-syntax match
7300: 2d 76 65 63 74 6f 72 2d 73 74 65 70 0a 09 20 28 -vector-step.. (
7310: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a syntax-rules ().
7320: 09 20 28 28 5f 20 76 20 28 29 20 28 73 6b 20 2e . ((_ v () (sk .
7330: 2e 2e 29 20 66 6b 20 69 29 20 28 73 6b 20 2e 2e ..) fk i) (sk ..
7340: 2e 20 69 29 29 0a 09 20 28 28 5f 20 76 20 28 28 . i)).. ((_ v ((
7350: 70 61 74 20 69 6e 64 65 78 29 20 2e 20 72 65 73 pat index) . res
7360: 74 29 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 6c t) sk fk i).. (l
7370: 65 74 20 28 28 77 20 28 76 65 63 74 6f 72 2d 72 et ((w (vector-r
7380: 65 66 20 76 20 69 6e 64 65 78 29 29 29 0a 09 20 ef v index)))..
7390: 28 6d 61 74 63 68 2d 6f 6e 65 20 77 20 70 61 74 (match-one w pat
73a0: 20 28 28 76 65 63 74 6f 72 2d 72 65 66 20 76 20 ((vector-ref v
73b0: 69 6e 64 65 78 29 20 28 76 65 63 74 6f 72 2d 73 index) (vector-s
73c0: 65 74 21 20 76 20 69 6e 64 65 78 29 29 0a 09 20 et! v index))..
73d0: 28 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d 73 74 (match-vector-st
73e0: 65 70 20 76 20 72 65 73 74 20 73 6b 20 66 6b 29 ep v rest sk fk)
73f0: 0a 09 20 66 6b 20 69 29 29 29 29 29 0a 0a 09 20 .. fk i)))))...
7400: 3b 3b 20 57 69 74 68 20 61 20 76 65 63 74 6f 72 ;; With a vector
7410: 20 65 6c 6c 69 70 73 69 73 20 70 61 74 74 65 72 ellipsis patter
7420: 6e 20 77 65 20 66 69 72 73 74 20 63 68 65 63 6b n we first check
7430: 20 74 6f 20 73 65 65 20 69 66 20 74 68 65 20 76 to see if the v
7440: 65 63 74 6f 72 0a 09 20 3b 3b 20 6c 65 6e 67 74 ector.. ;; lengt
7450: 68 20 69 73 20 61 74 20 6c 65 61 73 74 20 74 68 h is at least th
7460: 65 20 72 65 71 75 69 72 65 64 20 6c 65 6e 67 74 e required lengt
7470: 68 2e 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 h.... (define-sy
7480: 6e 74 61 78 20 6d 61 74 63 68 2d 67 65 6e 2d 76 ntax match-gen-v
7490: 65 63 74 6f 72 2d 65 6c 6c 69 70 73 69 73 0a 09 ector-ellipsis..
74a0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
74b0: 29 0a 09 20 28 28 5f 20 76 20 6e 20 28 28 70 61 ).. ((_ v n ((pa
74c0: 74 20 69 6e 64 65 78 29 20 2e 2e 2e 29 20 70 20 t index) ...) p
74d0: 73 6b 20 66 6b 20 69 29 0a 09 20 28 69 66 20 28 sk fk i).. (if (
74e0: 76 65 63 74 6f 72 3f 20 76 29 0a 09 20 28 6c 65 vector? v).. (le
74f0: 74 20 28 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d t ((len (vector-
7500: 6c 65 6e 67 74 68 20 76 29 29 29 0a 20 20 20 20 length v))).
7510: 20 20 20 20 20 28 69 66 20 28 3e 3d 20 6c 65 6e (if (>= len
7520: 20 6e 29 0a 09 20 28 6d 61 74 63 68 2d 76 65 63 n).. (match-vec
7530: 74 6f 72 2d 73 74 65 70 20 76 20 28 28 70 61 74 tor-step v ((pat
7540: 20 69 6e 64 65 78 29 20 2e 2e 2e 29 0a 09 20 28 index) ...).. (
7550: 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d 74 61 69 match-vector-tai
7560: 6c 20 76 20 70 20 6e 20 6c 65 6e 20 73 6b 20 66 l v p n len sk f
7570: 6b 29 0a 09 20 66 6b 20 69 29 0a 09 20 66 6b 29 k).. fk i).. fk)
7580: 29 0a 09 20 66 6b 29 29 29 29 0a 0a 09 20 28 64 ).. fk))))... (d
7590: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 efine-syntax mat
75a0: 63 68 2d 76 65 63 74 6f 72 2d 74 61 69 6c 0a 09 ch-vector-tail..
75b0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
75c0: 29 0a 09 20 28 28 5f 20 76 20 70 20 6e 20 6c 65 ).. ((_ v p n le
75d0: 6e 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 6d 61 n sk fk i).. (ma
75e0: 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 tch-extract-vars
75f0: 20 70 20 28 6d 61 74 63 68 2d 76 65 63 74 6f 72 p (match-vector
7600: 2d 74 61 69 6c 2d 74 77 6f 20 76 20 70 20 6e 20 -tail-two v p n
7610: 6c 65 6e 20 73 6b 20 66 6b 20 69 29 20 69 20 28 len sk fk i) i (
7620: 29 29 29 29 29 0a 0a 09 20 28 64 65 66 69 6e 65 )))))... (define
7630: 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 76 65 -syntax match-ve
7640: 63 74 6f 72 2d 74 61 69 6c 2d 74 77 6f 0a 09 20 ctor-tail-two..
7650: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
7660: 0a 09 20 28 28 5f 20 76 20 70 20 6e 20 6c 65 6e .. ((_ v p n len
7670: 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 20 28 (sk ...) fk i (
7680: 28 69 64 20 69 64 2d 6c 73 29 20 2e 2e 2e 29 29 (id id-ls) ...))
7690: 0a 09 20 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6a .. (let loop ((j
76a0: 20 6e 29 20 28 69 64 2d 6c 73 20 27 28 29 29 20 n) (id-ls '())
76b0: 2e 2e 2e 29 0a 09 20 28 69 66 20 28 3e 3d 20 6a ...).. (if (>= j
76c0: 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 28 len). (
76d0: 6c 65 74 20 28 28 69 64 20 28 72 65 76 65 72 73 let ((id (revers
76e0: 65 20 69 64 2d 6c 73 29 29 20 2e 2e 2e 29 20 28 e id-ls)) ...) (
76f0: 73 6b 20 2e 2e 2e 20 69 29 29 0a 20 20 20 20 20 sk ... i)).
7700: 20 20 20 20 28 6c 65 74 20 28 28 77 20 28 76 65 (let ((w (ve
7710: 63 74 6f 72 2d 72 65 66 20 76 20 6a 29 29 29 0a ctor-ref v j))).
7720: 09 20 28 6d 61 74 63 68 2d 6f 6e 65 20 77 20 70 . (match-one w p
7730: 20 28 28 76 65 63 74 6f 72 2d 72 65 66 20 76 20 ((vector-ref v
7740: 6a 29 20 28 76 65 63 74 6f 72 2d 73 65 74 21 20 j) (vector-set!
7750: 76 20 6a 29 29 0a 09 20 28 6d 61 74 63 68 2d 64 v j)).. (match-d
7760: 72 6f 70 2d 69 64 73 20 28 6c 6f 6f 70 20 28 2b rop-ids (loop (+
7770: 20 6a 20 31 29 20 28 63 6f 6e 73 20 69 64 20 69 j 1) (cons id i
7780: 64 2d 6c 73 29 20 2e 2e 2e 29 29 0a 09 20 66 6b d-ls) ...)).. fk
7790: 20 69 29 29 29 29 29 29 29 0a 0a 09 20 28 64 65 i)))))))... (de
77a0: 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 fine-syntax matc
77b0: 68 2d 72 65 63 6f 72 64 2d 72 65 66 73 0a 09 20 h-record-refs..
77c0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
77d0: 0a 09 20 28 28 5f 20 76 20 72 65 63 20 6e 20 28 .. ((_ v rec n (
77e0: 70 20 2e 20 71 29 20 67 2b 73 20 73 6b 20 66 6b p . q) g+s sk fk
77f0: 20 69 29 0a 09 20 28 6c 65 74 20 28 28 77 20 28 i).. (let ((w (
7800: 73 6c 6f 74 2d 72 65 66 20 72 65 63 20 76 20 6e slot-ref rec v n
7810: 29 29 29 0a 09 20 28 6d 61 74 63 68 2d 6f 6e 65 ))).. (match-one
7820: 20 77 20 70 20 28 28 73 6c 6f 74 2d 72 65 66 20 w p ((slot-ref
7830: 72 65 63 20 76 20 6e 29 20 28 73 6c 6f 74 2d 73 rec v n) (slot-s
7840: 65 74 21 20 72 65 63 20 76 20 6e 29 29 0a 09 20 et! rec v n))..
7850: 28 6d 61 74 63 68 2d 72 65 63 6f 72 64 2d 72 65 (match-record-re
7860: 66 73 20 76 20 72 65 63 20 28 2b 20 6e 20 31 29 fs v rec (+ n 1)
7870: 20 71 20 67 2b 73 20 73 6b 20 66 6b 29 20 66 6b q g+s sk fk) fk
7880: 20 69 29 29 29 0a 09 20 28 28 5f 20 76 20 72 65 i))).. ((_ v re
7890: 63 20 6e 20 28 29 20 67 2b 73 20 28 73 6b 20 2e c n () g+s (sk .
78a0: 2e 2e 29 20 66 6b 20 69 29 0a 09 20 28 73 6b 20 ..) fk i).. (sk
78b0: 2e 2e 2e 20 69 29 29 29 29 0a 0a 09 20 28 64 65 ... i))))... (de
78c0: 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 fine-syntax matc
78d0: 68 2d 72 65 63 6f 72 64 2d 6e 61 6d 65 64 2d 72 h-record-named-r
78e0: 65 66 73 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 efs.. (syntax-ru
78f0: 6c 65 73 20 28 29 0a 09 20 28 28 5f 20 76 20 72 les ().. ((_ v r
7900: 65 63 20 28 28 66 20 70 29 20 2e 20 71 29 20 67 ec ((f p) . q) g
7910: 2b 73 20 73 6b 20 66 6b 20 69 29 0a 09 20 28 6c +s sk fk i).. (l
7920: 65 74 20 28 28 77 20 28 73 6c 6f 74 2d 72 65 66 et ((w (slot-ref
7930: 20 72 65 63 20 76 20 27 66 29 29 29 0a 09 20 28 rec v 'f))).. (
7940: 6d 61 74 63 68 2d 6f 6e 65 20 77 20 70 20 28 28 match-one w p ((
7950: 73 6c 6f 74 2d 72 65 66 20 72 65 63 20 76 20 27 slot-ref rec v '
7960: 66 29 20 28 73 6c 6f 74 2d 73 65 74 21 20 72 65 f) (slot-set! re
7970: 63 20 76 20 27 66 29 29 0a 09 20 28 6d 61 74 63 c v 'f)).. (matc
7980: 68 2d 72 65 63 6f 72 64 2d 6e 61 6d 65 64 2d 72 h-record-named-r
7990: 65 66 73 20 76 20 72 65 63 20 71 20 67 2b 73 20 efs v rec q g+s
79a0: 73 6b 20 66 6b 29 20 66 6b 20 69 29 29 29 0a 09 sk fk) fk i)))..
79b0: 20 28 28 5f 20 76 20 72 65 63 20 28 29 20 67 2b ((_ v rec () g+
79c0: 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 29 s (sk ...) fk i)
79d0: 0a 09 20 28 73 6b 20 2e 2e 2e 20 69 29 29 29 29 .. (sk ... i))))
79e0: 0a 0a 09 20 3b 3b 20 45 78 74 72 61 63 74 20 61 ... ;; Extract a
79f0: 6c 6c 20 69 64 65 6e 74 69 66 69 65 72 73 20 69 ll identifiers i
7a00: 6e 20 61 20 70 61 74 74 65 72 6e 2e 20 20 41 20 n a pattern. A
7a10: 6c 69 74 74 6c 65 20 6d 6f 72 65 20 63 6f 6d 70 little more comp
7a20: 6c 69 63 61 74 65 64 0a 09 20 3b 3b 20 74 68 61 licated.. ;; tha
7a30: 6e 20 6a 75 73 74 20 6c 6f 6f 6b 69 6e 67 20 66 n just looking f
7a40: 6f 72 20 73 79 6d 62 6f 6c 73 2c 20 77 65 20 6e or symbols, we n
7a50: 65 65 64 20 74 6f 20 69 67 6e 6f 72 65 20 73 70 eed to ignore sp
7a60: 65 63 69 61 6c 20 6b 65 79 77 6f 72 64 73 0a 09 ecial keywords..
7a70: 20 3b 3b 20 61 6e 64 20 6e 6f 6e 2d 70 61 74 74 ;; and non-patt
7a80: 65 72 6e 20 66 6f 72 6d 73 20 28 73 75 63 68 20 ern forms (such
7a90: 61 73 20 74 68 65 20 70 72 65 64 69 63 61 74 65 as the predicate
7aa0: 20 65 78 70 72 65 73 73 69 6f 6e 20 69 6e 20 3f expression in ?
7ab0: 0a 09 20 3b 3b 20 70 61 74 74 65 72 6e 73 29 2c .. ;; patterns),
7ac0: 20 61 6e 64 20 61 6c 73 6f 20 69 67 6e 6f 72 65 and also ignore
7ad0: 20 70 72 65 76 69 6f 75 73 6c 79 20 62 6f 75 6e previously boun
7ae0: 64 20 69 64 65 6e 74 69 66 69 65 72 73 2e 0a 09 d identifiers...
7af0: 20 3b 3b 0a 09 20 3b 3b 20 43 61 6c 6c 73 20 74 ;;.. ;; Calls t
7b00: 68 65 20 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 20 he continuation
7b10: 77 69 74 68 20 61 6c 6c 20 6e 65 77 20 76 61 72 with all new var
7b20: 73 20 61 73 20 61 20 6c 69 73 74 20 6f 66 20 74 s as a list of t
7b30: 68 65 20 66 6f 72 6d 0a 09 20 3b 3b 20 28 28 6f he form.. ;; ((o
7b40: 72 69 67 2d 76 61 72 20 74 6d 70 2d 6e 61 6d 65 rig-var tmp-name
7b50: 29 20 2e 2e 2e 29 2c 20 77 68 65 72 65 20 74 6d ) ...), where tm
7b60: 70 2d 6e 61 6d 65 20 63 61 6e 20 62 65 20 75 73 p-name can be us
7b70: 65 64 20 74 6f 20 75 6e 69 71 75 65 6c 79 0a 09 ed to uniquely..
7b80: 20 3b 3b 20 70 61 69 72 20 77 69 74 68 20 74 68 ;; pair with th
7b90: 65 20 6f 72 69 67 69 6e 61 6c 20 76 61 72 69 61 e original varia
7ba0: 62 6c 65 20 28 65 2e 67 2e 20 69 74 27 73 20 75 ble (e.g. it's u
7bb0: 73 65 64 20 69 6e 20 74 68 65 20 65 6c 6c 69 70 sed in the ellip
7bc0: 73 69 73 0a 09 20 3b 3b 20 67 65 6e 65 72 61 74 sis.. ;; generat
7bd0: 69 6f 6e 20 66 6f 72 20 6c 69 73 74 20 76 61 72 ion for list var
7be0: 69 61 62 6c 65 73 29 2e 0a 09 20 3b 3b 0a 09 20 iables)... ;;..
7bf0: 3b 3b 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 ;; (match-extrac
7c00: 74 2d 76 61 72 73 20 70 61 74 74 65 72 6e 20 63 t-vars pattern c
7c10: 6f 6e 74 69 6e 75 61 74 69 6f 6e 20 28 69 64 73 ontinuation (ids
7c20: 20 2e 2e 2e 29 20 28 6e 65 77 2d 76 61 72 73 20 ...) (new-vars
7c30: 2e 2e 2e 29 29 0a 0a 09 20 3b 3b 20 52 65 70 6c ...))... ;; Repl
7c40: 61 63 65 20 27 5f 27 20 77 69 74 68 20 27 3a 5f ace '_' with ':_
7c50: 27 20 61 73 20 74 68 65 20 66 6f 72 6d 65 72 20 ' as the former
7c60: 69 73 20 66 6f 72 62 69 64 64 65 6e 20 61 73 20 is forbidden as
7c70: 61 6e 20 61 75 78 69 6c 69 61 72 69 79 0a 09 20 an auxiliariy..
7c80: 3b 3b 20 6b 65 79 77 6f 72 64 20 69 6e 20 52 36 ;; keyword in R6
7c90: 52 53 2e 20 28 46 42 45 29 0a 09 20 28 64 65 66 RS. (FBE).. (def
7ca0: 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 ine-syntax match
7cb0: 2d 65 78 74 72 61 63 74 2d 76 61 72 73 0a 09 20 -extract-vars..
7cc0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 3a (syntax-rules (:
7cd0: 5f 20 5f 5f 5f 20 2e 2e 31 20 2a 2a 2a 20 3f 20 _ ___ ..1 *** ?
7ce0: 24 20 73 74 72 75 63 74 20 40 20 6f 62 6a 65 63 $ struct @ objec
7cf0: 74 20 3d 20 71 75 6f 74 65 20 71 75 61 73 69 71 t = quote quasiq
7d00: 75 6f 74 65 20 61 6e 64 20 6f 72 20 6e 6f 74 20 uote and or not
7d10: 67 65 74 21 20 73 65 74 21 29 0a 09 20 28 28 6d get! set!).. ((m
7d20: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 atch-extract-var
7d30: 73 20 28 3f 20 70 72 65 64 20 2e 20 70 29 20 2e s (? pred . p) .
7d40: 20 78 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 x).. (match-ext
7d50: 72 61 63 74 2d 76 61 72 73 20 70 20 2e 20 78 29 ract-vars p . x)
7d60: 29 0a 09 20 28 28 6d 61 74 63 68 2d 65 78 74 72 ).. ((match-extr
7d70: 61 63 74 2d 76 61 72 73 20 28 24 20 72 65 63 20 act-vars ($ rec
7d80: 2e 20 70 29 20 2e 20 78 29 0a 09 20 28 6d 61 74 . p) . x).. (mat
7d90: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 ch-extract-vars
7da0: 70 20 2e 20 78 29 29 0a 09 20 28 28 6d 61 74 63 p . x)).. ((matc
7db0: 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 28 h-extract-vars (
7dc0: 73 74 72 75 63 74 20 72 65 63 20 2e 20 70 29 20 struct rec . p)
7dd0: 2e 20 78 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 . x).. (match-ex
7de0: 74 72 61 63 74 2d 76 61 72 73 20 70 20 2e 20 78 tract-vars p . x
7df0: 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 65 78 74 )).. ((match-ext
7e00: 72 61 63 74 2d 76 61 72 73 20 28 40 20 72 65 63 ract-vars (@ rec
7e10: 20 28 66 20 70 29 20 2e 2e 2e 29 20 2e 20 78 29 (f p) ...) . x)
7e20: 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 .. (match-extrac
7e30: 74 2d 76 61 72 73 20 28 70 20 2e 2e 2e 29 20 2e t-vars (p ...) .
7e40: 20 78 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 65 x)).. ((match-e
7e50: 78 74 72 61 63 74 2d 76 61 72 73 20 28 6f 62 6a xtract-vars (obj
7e60: 65 63 74 20 72 65 63 20 28 66 20 70 29 20 2e 2e ect rec (f p) ..
7e70: 2e 29 20 2e 20 78 29 0a 09 20 28 6d 61 74 63 68 .) . x).. (match
7e80: 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 28 70 -extract-vars (p
7e90: 20 2e 2e 2e 29 20 2e 20 78 29 29 0a 09 20 28 28 ...) . x)).. ((
7ea0: 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 match-extract-va
7eb0: 72 73 20 28 3d 20 70 72 6f 63 20 70 29 20 2e 20 rs (= proc p) .
7ec0: 78 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 72 x).. (match-extr
7ed0: 61 63 74 2d 76 61 72 73 20 70 20 2e 20 78 29 29 act-vars p . x))
7ee0: 0a 09 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 .. ((match-extra
7ef0: 63 74 2d 76 61 72 73 20 28 71 75 6f 74 65 20 78 ct-vars (quote x
7f00: 29 20 28 6b 20 2e 2e 2e 29 20 69 20 76 29 0a 09 ) (k ...) i v)..
7f10: 20 28 6b 20 2e 2e 2e 20 76 29 29 0a 09 20 28 28 (k ... v)).. ((
7f20: 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 match-extract-va
7f30: 72 73 20 28 71 75 61 73 69 71 75 6f 74 65 20 78 rs (quasiquote x
7f40: 29 20 6b 20 69 20 76 29 0a 09 20 28 6d 61 74 63 ) k i v).. (matc
7f50: 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69 71 h-extract-quasiq
7f60: 75 6f 74 65 2d 76 61 72 73 20 78 20 6b 20 69 20 uote-vars x k i
7f70: 76 20 28 23 74 29 29 29 0a 09 20 28 28 6d 61 74 v (#t))).. ((mat
7f80: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 ch-extract-vars
7f90: 28 61 6e 64 20 2e 20 70 29 20 2e 20 78 29 0a 09 (and . p) . x)..
7fa0: 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d (match-extract-
7fb0: 76 61 72 73 20 70 20 2e 20 78 29 29 0a 09 20 28 vars p . x)).. (
7fc0: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 (match-extract-v
7fd0: 61 72 73 20 28 6f 72 20 2e 20 70 29 20 2e 20 78 ars (or . p) . x
7fe0: 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 ).. (match-extra
7ff0: 63 74 2d 76 61 72 73 20 70 20 2e 20 78 29 29 0a ct-vars p . x)).
8000: 09 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63 . ((match-extrac
8010: 74 2d 76 61 72 73 20 28 6e 6f 74 20 2e 20 70 29 t-vars (not . p)
8020: 20 2e 20 78 29 0a 09 20 28 6d 61 74 63 68 2d 65 . x).. (match-e
8030: 78 74 72 61 63 74 2d 76 61 72 73 20 70 20 2e 20 xtract-vars p .
8040: 78 29 29 0a 09 20 3b 3b 20 41 20 6e 6f 6e 2d 6b x)).. ;; A non-k
8050: 65 79 77 6f 72 64 20 70 61 69 72 2c 20 65 78 70 eyword pair, exp
8060: 61 6e 64 20 74 68 65 20 43 41 52 20 77 69 74 68 and the CAR with
8070: 20 61 20 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 20 a continuation
8080: 74 6f 0a 09 20 3b 3b 20 65 78 70 61 6e 64 20 74 to.. ;; expand t
8090: 68 65 20 43 44 52 2e 0a 09 20 28 28 6d 61 74 63 he CDR... ((matc
80a0: 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 28 h-extract-vars (
80b0: 70 20 71 20 2e 20 72 29 20 6b 20 69 20 76 29 0a p q . r) k i v).
80c0: 09 20 28 6d 61 74 63 68 2d 63 68 65 63 6b 2d 65 . (match-check-e
80d0: 6c 6c 69 70 73 69 73 0a 09 20 71 0a 09 20 28 6d llipsis.. q.. (m
80e0: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 atch-extract-var
80f0: 73 20 28 70 20 2e 20 72 29 20 6b 20 69 20 76 29 s (p . r) k i v)
8100: 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 .. (match-extrac
8110: 74 2d 76 61 72 73 20 70 20 28 6d 61 74 63 68 2d t-vars p (match-
8120: 65 78 74 72 61 63 74 2d 76 61 72 73 2d 73 74 65 extract-vars-ste
8130: 70 20 28 71 20 2e 20 72 29 20 6b 20 69 20 76 29 p (q . r) k i v)
8140: 20 69 20 28 29 29 29 29 0a 09 20 28 28 6d 61 74 i ()))).. ((mat
8150: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 ch-extract-vars
8160: 28 70 20 2e 20 71 29 20 6b 20 69 20 76 29 0a 09 (p . q) k i v)..
8170: 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d (match-extract-
8180: 76 61 72 73 20 70 20 28 6d 61 74 63 68 2d 65 78 vars p (match-ex
8190: 74 72 61 63 74 2d 76 61 72 73 2d 73 74 65 70 20 tract-vars-step
81a0: 71 20 6b 20 69 20 76 29 20 69 20 28 29 29 29 0a q k i v) i ())).
81b0: 09 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63 . ((match-extrac
81c0: 74 2d 76 61 72 73 20 23 28 70 20 2e 2e 2e 29 20 t-vars #(p ...)
81d0: 2e 20 78 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 . x).. (match-ex
81e0: 74 72 61 63 74 2d 76 61 72 73 20 28 70 20 2e 2e tract-vars (p ..
81f0: 2e 29 20 2e 20 78 29 29 0a 09 20 3b 3b 20 4e 65 .) . x)).. ;; Ne
8200: 78 74 20 6c 69 6e 65 3a 20 72 65 70 6c 61 63 65 xt line: replace
8210: 20 27 5f 27 20 77 69 74 68 20 27 3a 5f 27 2e 20 '_' with ':_'.
8220: 28 46 42 45 29 0a 09 20 28 28 6d 61 74 63 68 2d (FBE).. ((match-
8230: 65 78 74 72 61 63 74 2d 76 61 72 73 20 3a 5f 20 extract-vars :_
8240: 28 6b 20 2e 2e 2e 29 20 69 20 76 29 20 20 20 20 (k ...) i v)
8250: 28 6b 20 2e 2e 2e 20 76 29 29 0a 09 20 28 28 6d (k ... v)).. ((m
8260: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 atch-extract-var
8270: 73 20 5f 5f 5f 20 28 6b 20 2e 2e 2e 29 20 69 20 s ___ (k ...) i
8280: 76 29 20 20 28 6b 20 2e 2e 2e 20 76 29 29 0a 09 v) (k ... v))..
8290: 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 ((match-extract
82a0: 2d 76 61 72 73 20 2a 2a 2a 20 28 6b 20 2e 2e 2e -vars *** (k ...
82b0: 29 20 69 20 76 29 20 20 28 6b 20 2e 2e 2e 20 76 ) i v) (k ... v
82c0: 29 29 0a 09 20 28 28 6d 61 74 63 68 2d 65 78 74 )).. ((match-ext
82d0: 72 61 63 74 2d 76 61 72 73 20 2e 2e 31 20 28 6b ract-vars ..1 (k
82e0: 20 2e 2e 2e 29 20 69 20 76 29 20 20 28 6b 20 2e ...) i v) (k .
82f0: 2e 2e 20 76 29 29 0a 09 20 3b 3b 20 54 68 69 73 .. v)).. ;; This
8300: 20 69 73 20 74 68 65 20 6d 61 69 6e 20 70 61 72 is the main par
8310: 74 2c 20 74 68 65 20 6f 6e 6c 79 20 70 6c 61 63 t, the only plac
8320: 65 20 77 68 65 72 65 20 77 65 20 6d 69 67 68 74 e where we might
8330: 20 61 64 64 20 61 20 6e 65 77 0a 09 20 3b 3b 20 add a new.. ;;
8340: 76 61 72 20 69 66 20 69 74 27 73 20 61 6e 20 75 var if it's an u
8350: 6e 62 6f 75 6e 64 20 73 79 6d 62 6f 6c 2e 0a 09 nbound symbol...
8360: 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 ((match-extract
8370: 2d 76 61 72 73 20 70 20 28 6b 20 2e 2e 2e 29 20 -vars p (k ...)
8380: 28 69 20 2e 2e 2e 29 20 76 29 0a 09 20 28 6c 65 (i ...) v).. (le
8390: 74 2d 73 79 6e 74 61 78 0a 20 20 20 20 20 20 20 t-syntax.
83a0: 20 20 28 28 6e 65 77 2d 73 79 6d 3f 0a 09 20 28 ((new-sym?.. (
83b0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 69 20 syntax-rules (i
83c0: 2e 2e 2e 29 0a 09 20 28 28 6e 65 77 2d 73 79 6d ...).. ((new-sym
83d0: 3f 20 70 20 73 6b 20 66 6b 29 20 73 6b 29 0a 09 ? p sk fk) sk)..
83e0: 20 28 28 6e 65 77 2d 73 79 6d 3f 20 61 6e 79 20 ((new-sym? any
83f0: 73 6b 20 66 6b 29 20 66 6b 29 29 29 29 0a 09 20 sk fk) fk))))..
8400: 28 6e 65 77 2d 73 79 6d 3f 20 72 61 6e 64 6f 6d (new-sym? random
8410: 2d 73 79 6d 2d 74 6f 2d 6d 61 74 63 68 0a 09 20 -sym-to-match..
8420: 28 6b 20 2e 2e 2e 20 28 28 70 20 70 2d 6c 73 29 (k ... ((p p-ls)
8430: 20 2e 20 76 29 29 0a 09 20 28 6b 20 2e 2e 2e 20 . v)).. (k ...
8440: 76 29 29 29 29 0a 09 20 29 29 0a 0a 09 20 3b 3b v)))).. ))... ;;
8450: 20 53 74 65 70 70 65 72 20 75 73 65 64 20 69 6e Stepper used in
8460: 20 74 68 65 20 61 62 6f 76 65 20 73 6f 20 69 74 the above so it
8470: 20 63 61 6e 20 65 78 70 61 6e 64 20 74 68 65 20 can expand the
8480: 43 41 52 20 61 6e 64 20 43 44 52 0a 09 20 3b 3b CAR and CDR.. ;;
8490: 20 73 65 70 61 72 61 74 65 6c 79 2e 0a 0a 09 20 separately....
84a0: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d (define-syntax m
84b0: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 atch-extract-var
84c0: 73 2d 73 74 65 70 0a 09 20 28 73 79 6e 74 61 78 s-step.. (syntax
84d0: 2d 72 75 6c 65 73 20 28 29 0a 09 20 28 28 5f 20 -rules ().. ((_
84e0: 70 20 6b 20 69 20 76 20 28 28 76 32 20 76 32 2d p k i v ((v2 v2-
84f0: 6c 73 29 20 2e 2e 2e 29 29 0a 09 20 28 6d 61 74 ls) ...)).. (mat
8500: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 ch-extract-vars
8510: 70 20 6b 20 28 76 32 20 2e 2e 2e 20 2e 20 69 29 p k (v2 ... . i)
8520: 20 28 28 76 32 20 76 32 2d 6c 73 29 20 2e 2e 2e ((v2 v2-ls) ...
8530: 20 2e 20 76 29 29 29 0a 09 20 29 29 0a 0a 09 20 . v))).. ))...
8540: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d (define-syntax m
8550: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 atch-extract-qua
8560: 73 69 71 75 6f 74 65 2d 76 61 72 73 0a 09 20 28 siquote-vars.. (
8570: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 71 75 syntax-rules (qu
8580: 61 73 69 71 75 6f 74 65 20 75 6e 71 75 6f 74 65 asiquote unquote
8590: 20 75 6e 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e unquote-splicin
85a0: 67 29 0a 09 20 28 28 6d 61 74 63 68 2d 65 78 74 g).. ((match-ext
85b0: 72 61 63 74 2d 71 75 61 73 69 71 75 6f 74 65 2d ract-quasiquote-
85c0: 76 61 72 73 20 28 71 75 61 73 69 71 75 6f 74 65 vars (quasiquote
85d0: 20 78 29 20 6b 20 69 20 76 20 64 29 0a 09 20 28 x) k i v d).. (
85e0: 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 71 75 match-extract-qu
85f0: 61 73 69 71 75 6f 74 65 2d 76 61 72 73 20 78 20 asiquote-vars x
8600: 6b 20 69 20 76 20 28 23 74 20 2e 20 64 29 29 29 k i v (#t . d)))
8610: 0a 09 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 .. ((match-extra
8620: 63 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61 ct-quasiquote-va
8630: 72 73 20 28 75 6e 71 75 6f 74 65 2d 73 70 6c 69 rs (unquote-spli
8640: 63 69 6e 67 20 78 29 20 6b 20 69 20 76 20 64 29 cing x) k i v d)
8650: 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 .. (match-extrac
8660: 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61 72 t-quasiquote-var
8670: 73 20 28 75 6e 71 75 6f 74 65 20 78 29 20 6b 20 s (unquote x) k
8680: 69 20 76 20 64 29 29 0a 09 20 28 28 6d 61 74 63 i v d)).. ((matc
8690: 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69 71 h-extract-quasiq
86a0: 75 6f 74 65 2d 76 61 72 73 20 28 75 6e 71 75 6f uote-vars (unquo
86b0: 74 65 20 78 29 20 6b 20 69 20 76 20 28 23 74 29 te x) k i v (#t)
86c0: 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 ).. (match-extra
86d0: 63 74 2d 76 61 72 73 20 78 20 6b 20 69 20 76 29 ct-vars x k i v)
86e0: 29 0a 09 20 28 28 6d 61 74 63 68 2d 65 78 74 72 ).. ((match-extr
86f0: 61 63 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 act-quasiquote-v
8700: 61 72 73 20 28 75 6e 71 75 6f 74 65 20 78 29 20 ars (unquote x)
8710: 6b 20 69 20 76 20 28 23 74 20 2e 20 64 29 29 0a k i v (#t . d)).
8720: 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 . (match-extract
8730: 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 -quasiquote-vars
8740: 20 78 20 6b 20 69 20 76 20 64 29 29 0a 09 20 28 x k i v d)).. (
8750: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 71 (match-extract-q
8760: 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 20 28 uasiquote-vars (
8770: 78 20 2e 20 79 29 20 6b 20 69 20 76 20 64 29 0a x . y) k i v d).
8780: 09 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 . (match-extract
8790: 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 -quasiquote-vars
87a0: 0a 09 20 78 0a 09 20 28 6d 61 74 63 68 2d 65 78 .. x.. (match-ex
87b0: 74 72 61 63 74 2d 71 75 61 73 69 71 75 6f 74 65 tract-quasiquote
87c0: 2d 76 61 72 73 2d 73 74 65 70 20 79 20 6b 20 69 -vars-step y k i
87d0: 20 76 20 64 29 20 69 20 28 29 20 64 29 29 0a 09 v d) i () d))..
87e0: 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 ((match-extract
87f0: 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 -quasiquote-vars
8800: 20 23 28 78 20 2e 2e 2e 29 20 6b 20 69 20 76 20 #(x ...) k i v
8810: 64 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 74 72 d).. (match-extr
8820: 61 63 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 act-quasiquote-v
8830: 61 72 73 20 28 78 20 2e 2e 2e 29 20 6b 20 69 20 ars (x ...) k i
8840: 76 20 64 29 29 0a 09 20 28 28 6d 61 74 63 68 2d v d)).. ((match-
8850: 65 78 74 72 61 63 74 2d 71 75 61 73 69 71 75 6f extract-quasiquo
8860: 74 65 2d 76 61 72 73 20 78 20 28 6b 20 2e 2e 2e te-vars x (k ...
8870: 29 20 69 20 76 20 64 29 0a 09 20 28 6b 20 2e 2e ) i v d).. (k ..
8880: 2e 20 76 29 29 0a 09 20 29 29 0a 0a 09 20 28 64 . v)).. ))... (d
8890: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 efine-syntax mat
88a0: 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69 ch-extract-quasi
88b0: 71 75 6f 74 65 2d 76 61 72 73 2d 73 74 65 70 0a quote-vars-step.
88c0: 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 . (syntax-rules
88d0: 28 29 0a 09 20 28 28 5f 20 78 20 6b 20 69 20 76 ().. ((_ x k i v
88e0: 20 64 20 28 28 76 32 20 76 32 2d 6c 73 29 20 2e d ((v2 v2-ls) .
88f0: 2e 2e 29 29 0a 09 20 28 6d 61 74 63 68 2d 65 78 ..)).. (match-ex
8900: 74 72 61 63 74 2d 71 75 61 73 69 71 75 6f 74 65 tract-quasiquote
8910: 2d 76 61 72 73 20 78 20 6b 20 28 76 32 20 2e 2e -vars x k (v2 ..
8920: 2e 20 2e 20 69 29 20 28 28 76 32 20 76 32 2d 6c . . i) ((v2 v2-l
8930: 73 29 20 2e 2e 2e 20 2e 20 76 29 20 64 29 29 0a s) ... . v) d)).
8940: 09 20 29 29 0a 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b . ))...;;;;;;;;;
8950: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
8960: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
8970: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
8980: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a ;;;;;;;;;;;;;;;.
8990: 09 20 3b 3b 20 47 69 6d 6d 65 20 73 6f 6d 65 20 . ;; Gimme some
89a0: 73 75 67 61 72 20 62 61 62 79 2e 0a 0a 09 20 3b sugar baby.... ;
89b0: 3b 3e 20 53 68 6f 72 74 63 75 74 20 66 6f 72 20 ;> Shortcut for
89c0: 5c 73 63 68 65 6d 65 7b 6c 61 6d 62 64 61 7d 20 \scheme{lambda}
89d0: 2b 20 5c 73 63 68 65 6d 65 7b 6d 61 74 63 68 7d + \scheme{match}
89e0: 2e 20 20 43 72 65 61 74 65 73 20 61 0a 09 20 3b . Creates a.. ;
89f0: 3b 3e 20 70 72 6f 63 65 64 75 72 65 20 6f 66 20 ;> procedure of
8a00: 6f 6e 65 20 61 72 67 75 6d 65 6e 74 2c 20 61 6e one argument, an
8a10: 64 20 6d 61 74 63 68 65 73 20 74 68 61 74 20 61 d matches that a
8a20: 72 67 75 6d 65 6e 74 20 61 67 61 69 6e 73 74 20 rgument against
8a30: 65 61 63 68 0a 09 20 3b 3b 3e 20 63 6c 61 75 73 each.. ;;> claus
8a40: 65 2e 0a 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 e.... (define-sy
8a50: 6e 74 61 78 20 6d 61 74 63 68 2d 6c 61 6d 62 64 ntax match-lambd
8a60: 61 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 a.. (syntax-rule
8a70: 73 20 28 29 0a 09 20 28 28 5f 20 28 70 61 74 74 s ().. ((_ (patt
8a80: 65 72 6e 20 2e 20 62 6f 64 79 29 20 2e 2e 2e 29 ern . body) ...)
8a90: 20 28 6c 61 6d 62 64 61 20 28 65 78 70 72 29 20 (lambda (expr)
8aa0: 28 6d 61 74 63 68 20 65 78 70 72 20 28 70 61 74 (match expr (pat
8ab0: 74 65 72 6e 20 2e 20 62 6f 64 79 29 20 2e 2e 2e tern . body) ...
8ac0: 29 29 29 29 29 0a 0a 09 20 3b 3b 3e 20 53 69 6d )))))... ;;> Sim
8ad0: 69 6c 61 72 20 74 6f 20 5c 73 63 68 65 6d 65 7b ilar to \scheme{
8ae0: 6d 61 74 63 68 2d 6c 61 6d 62 64 61 7d 2e 20 20 match-lambda}.
8af0: 43 72 65 61 74 65 73 20 61 20 70 72 6f 63 65 64 Creates a proced
8b00: 75 72 65 20 6f 66 20 61 6e 79 0a 09 20 3b 3b 3e ure of any.. ;;>
8b10: 20 6e 75 6d 62 65 72 20 6f 66 20 61 72 67 75 6d number of argum
8b20: 65 6e 74 73 2c 20 61 6e 64 20 6d 61 74 63 68 65 ents, and matche
8b30: 73 20 74 68 65 20 61 72 67 75 6d 65 6e 74 20 6c s the argument l
8b40: 69 73 74 20 61 67 61 69 6e 73 74 20 65 61 63 68 ist against each
8b50: 0a 09 20 3b 3b 3e 20 63 6c 61 75 73 65 2e 0a 0a .. ;;> clause...
8b60: 09 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 . (define-syntax
8b70: 20 6d 61 74 63 68 2d 6c 61 6d 62 64 61 2a 0a 09 match-lambda*..
8b80: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
8b90: 29 0a 09 20 28 28 5f 20 28 70 61 74 74 65 72 6e ).. ((_ (pattern
8ba0: 20 2e 20 62 6f 64 79 29 20 2e 2e 2e 29 20 28 6c . body) ...) (l
8bb0: 61 6d 62 64 61 20 65 78 70 72 20 28 6d 61 74 63 ambda expr (matc
8bc0: 68 20 65 78 70 72 20 28 70 61 74 74 65 72 6e 20 h expr (pattern
8bd0: 2e 20 62 6f 64 79 29 20 2e 2e 2e 29 29 29 29 29 . body) ...)))))
8be0: 0a 0a 09 20 3b 3b 3e 20 4d 61 74 63 68 65 73 20 ... ;;> Matches
8bf0: 65 61 63 68 20 76 61 72 20 74 6f 20 74 68 65 20 each var to the
8c00: 63 6f 72 72 65 73 70 6f 6e 64 69 6e 67 20 65 78 corresponding ex
8c10: 70 72 65 73 73 69 6f 6e 2c 20 61 6e 64 20 65 76 pression, and ev
8c20: 61 6c 75 61 74 65 73 0a 09 20 3b 3b 3e 20 74 68 aluates.. ;;> th
8c30: 65 20 62 6f 64 79 20 77 69 74 68 20 61 6c 6c 20 e body with all
8c40: 6d 61 74 63 68 20 76 61 72 69 61 62 6c 65 73 20 match variables
8c50: 69 6e 20 73 63 6f 70 65 2e 20 20 52 61 69 73 65 in scope. Raise
8c60: 73 20 61 6e 20 65 72 72 6f 72 20 69 66 0a 09 20 s an error if..
8c70: 3b 3b 3e 20 61 6e 79 20 6f 66 20 74 68 65 20 65 ;;> any of the e
8c80: 78 70 72 65 73 73 69 6f 6e 73 20 66 61 69 6c 20 xpressions fail
8c90: 74 6f 20 6d 61 74 63 68 2e 20 20 53 79 6e 74 61 to match. Synta
8ca0: 78 20 61 6e 61 6c 6f 67 6f 75 73 20 74 6f 20 6e x analogous to n
8cb0: 61 6d 65 64 0a 09 20 3b 3b 3e 20 6c 65 74 20 63 amed.. ;;> let c
8cc0: 61 6e 20 61 6c 73 6f 20 62 65 20 75 73 65 64 20 an also be used
8cd0: 66 6f 72 20 72 65 63 75 72 73 69 76 65 20 66 75 for recursive fu
8ce0: 6e 63 74 69 6f 6e 73 20 77 68 69 63 68 20 6d 61 nctions which ma
8cf0: 74 63 68 20 6f 6e 20 74 68 65 69 72 0a 09 20 3b tch on their.. ;
8d00: 3b 3e 20 61 72 67 75 6d 65 6e 74 73 20 61 73 20 ;> arguments as
8d10: 69 6e 20 5c 73 63 68 65 6d 65 7b 6d 61 74 63 68 in \scheme{match
8d20: 2d 6c 61 6d 62 64 61 2a 7d 2e 0a 0a 09 20 28 64 -lambda*}.... (d
8d30: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 efine-syntax mat
8d40: 63 68 2d 6c 65 74 0a 09 20 28 73 79 6e 74 61 78 ch-let.. (syntax
8d50: 2d 72 75 6c 65 73 20 28 29 0a 09 20 28 28 5f 20 -rules ().. ((_
8d60: 28 28 76 61 72 20 76 61 6c 75 65 29 20 2e 2e 2e ((var value) ...
8d70: 29 20 2e 20 62 6f 64 79 29 0a 09 20 28 6d 61 74 ) . body).. (mat
8d80: 63 68 2d 6c 65 74 2f 68 65 6c 70 65 72 20 6c 65 ch-let/helper le
8d90: 74 20 28 29 20 28 29 20 28 28 76 61 72 20 76 61 t () () ((var va
8da0: 6c 75 65 29 20 2e 2e 2e 29 20 2e 20 62 6f 64 79 lue) ...) . body
8db0: 29 29 0a 09 20 28 28 5f 20 6c 6f 6f 70 20 28 28 )).. ((_ loop ((
8dc0: 76 61 72 20 69 6e 69 74 29 20 2e 2e 2e 29 20 2e var init) ...) .
8dd0: 20 62 6f 64 79 29 0a 09 20 28 6d 61 74 63 68 2d body).. (match-
8de0: 6e 61 6d 65 64 2d 6c 65 74 20 6c 6f 6f 70 20 28 named-let loop (
8df0: 29 20 28 28 76 61 72 20 69 6e 69 74 29 20 2e 2e ) ((var init) ..
8e00: 2e 29 20 2e 20 62 6f 64 79 29 29 29 29 0a 0a 09 .) . body))))...
8e10: 20 3b 3b 3e 20 53 69 6d 69 6c 61 72 20 74 6f 20 ;;> Similar to
8e20: 5c 73 63 68 65 6d 65 7b 6d 61 74 63 68 2d 6c 65 \scheme{match-le
8e30: 74 7d 2c 20 62 75 74 20 61 6e 61 6c 6f 67 6f 75 t}, but analogou
8e40: 73 6c 79 20 74 6f 20 5c 73 63 68 65 6d 65 7b 6c sly to \scheme{l
8e50: 65 74 72 65 63 7d 0a 09 20 3b 3b 3e 20 6d 61 74 etrec}.. ;;> mat
8e60: 63 68 65 73 20 61 6e 64 20 62 69 6e 64 73 20 74 ches and binds t
8e70: 68 65 20 76 61 72 69 61 62 6c 65 73 20 77 69 74 he variables wit
8e80: 68 20 61 6c 6c 20 6d 61 74 63 68 20 76 61 72 69 h all match vari
8e90: 61 62 6c 65 73 20 69 6e 20 73 63 6f 70 65 2e 0a ables in scope..
8ea0: 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 .. (define-synta
8eb0: 78 20 6d 61 74 63 68 2d 6c 65 74 72 65 63 0a 09 x match-letrec..
8ec0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules (
8ed0: 29 0a 09 20 28 28 5f 20 28 28 76 61 72 20 76 61 ).. ((_ ((var va
8ee0: 6c 75 65 29 20 2e 2e 2e 29 20 2e 20 62 6f 64 79 lue) ...) . body
8ef0: 29 0a 09 20 28 6d 61 74 63 68 2d 6c 65 74 2f 68 ).. (match-let/h
8f00: 65 6c 70 65 72 20 6c 65 74 72 65 63 20 28 29 20 elper letrec ()
8f10: 28 29 20 28 28 76 61 72 20 76 61 6c 75 65 29 20 () ((var value)
8f20: 2e 2e 2e 29 20 2e 20 62 6f 64 79 29 29 29 29 0a ...) . body)))).
8f30: 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 .. (define-synta
8f40: 78 20 6d 61 74 63 68 2d 6c 65 74 2f 68 65 6c 70 x match-let/help
8f50: 65 72 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 6c er.. (syntax-rul
8f60: 65 73 20 28 29 0a 09 20 28 28 5f 20 6c 65 74 20 es ().. ((_ let
8f70: 28 28 76 61 72 20 65 78 70 72 29 20 2e 2e 2e 29 ((var expr) ...)
8f80: 20 28 29 20 28 29 20 2e 20 62 6f 64 79 29 0a 09 () () . body)..
8f90: 20 28 6c 65 74 20 28 28 76 61 72 20 65 78 70 72 (let ((var expr
8fa0: 29 20 2e 2e 2e 29 20 2e 20 62 6f 64 79 29 29 0a ) ...) . body)).
8fb0: 09 20 28 28 5f 20 6c 65 74 20 28 28 76 61 72 20 . ((_ let ((var
8fc0: 65 78 70 72 29 20 2e 2e 2e 29 20 28 28 70 61 74 expr) ...) ((pat
8fd0: 20 74 6d 70 29 20 2e 2e 2e 29 20 28 29 20 2e 20 tmp) ...) () .
8fe0: 62 6f 64 79 29 0a 09 20 28 6c 65 74 20 28 28 76 body).. (let ((v
8ff0: 61 72 20 65 78 70 72 29 20 2e 2e 2e 29 0a 09 20 ar expr) ...)..
9000: 28 6d 61 74 63 68 2d 6c 65 74 2a 20 28 28 70 61 (match-let* ((pa
9010: 74 20 74 6d 70 29 20 2e 2e 2e 29 0a 20 20 20 20 t tmp) ...).
9020: 20 20 20 20 20 2e 20 62 6f 64 79 29 29 29 0a 09 . body)))..
9030: 20 28 28 5f 20 6c 65 74 20 28 76 20 2e 2e 2e 29 ((_ let (v ...)
9040: 20 28 70 20 2e 2e 2e 29 20 28 28 28 61 20 2e 20 (p ...) (((a .
9050: 62 29 20 65 78 70 72 29 20 2e 20 72 65 73 74 29 b) expr) . rest)
9060: 20 2e 20 62 6f 64 79 29 0a 09 20 28 6d 61 74 63 . body).. (matc
9070: 68 2d 6c 65 74 2f 68 65 6c 70 65 72 0a 09 20 6c h-let/helper.. l
9080: 65 74 20 28 76 20 2e 2e 2e 20 28 74 6d 70 20 65 et (v ... (tmp e
9090: 78 70 72 29 29 20 28 70 20 2e 2e 2e 20 28 28 61 xpr)) (p ... ((a
90a0: 20 2e 20 62 29 20 74 6d 70 29 29 20 72 65 73 74 . b) tmp)) rest
90b0: 20 2e 20 62 6f 64 79 29 29 0a 09 20 28 28 5f 20 . body)).. ((_
90c0: 6c 65 74 20 28 76 20 2e 2e 2e 29 20 28 70 20 2e let (v ...) (p .
90d0: 2e 2e 29 20 28 28 23 28 61 20 2e 2e 2e 29 20 65 ..) ((#(a ...) e
90e0: 78 70 72 29 20 2e 20 72 65 73 74 29 20 2e 20 62 xpr) . rest) . b
90f0: 6f 64 79 29 0a 09 20 28 6d 61 74 63 68 2d 6c 65 ody).. (match-le
9100: 74 2f 68 65 6c 70 65 72 0a 09 20 6c 65 74 20 28 t/helper.. let (
9110: 76 20 2e 2e 2e 20 28 74 6d 70 20 65 78 70 72 29 v ... (tmp expr)
9120: 29 20 28 70 20 2e 2e 2e 20 28 23 28 61 20 2e 2e ) (p ... (#(a ..
9130: 2e 29 20 74 6d 70 29 29 20 72 65 73 74 20 2e 20 .) tmp)) rest .
9140: 62 6f 64 79 29 29 0a 09 20 28 28 5f 20 6c 65 74 body)).. ((_ let
9150: 20 28 76 20 2e 2e 2e 29 20 28 70 20 2e 2e 2e 29 (v ...) (p ...)
9160: 20 28 28 61 20 65 78 70 72 29 20 2e 20 72 65 73 ((a expr) . res
9170: 74 29 20 2e 20 62 6f 64 79 29 0a 09 20 28 6d 61 t) . body).. (ma
9180: 74 63 68 2d 6c 65 74 2f 68 65 6c 70 65 72 20 6c tch-let/helper l
9190: 65 74 20 28 76 20 2e 2e 2e 20 28 61 20 65 78 70 et (v ... (a exp
91a0: 72 29 29 20 28 70 20 2e 2e 2e 29 20 72 65 73 74 r)) (p ...) rest
91b0: 20 2e 20 62 6f 64 79 29 29 29 29 0a 0a 09 20 28 . body))))... (
91c0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 define-syntax ma
91d0: 74 63 68 2d 6e 61 6d 65 64 2d 6c 65 74 0a 09 20 tch-named-let..
91e0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
91f0: 0a 09 20 28 28 5f 20 6c 6f 6f 70 20 28 28 70 61 .. ((_ loop ((pa
9200: 74 20 65 78 70 72 20 76 61 72 29 20 2e 2e 2e 29 t expr var) ...)
9210: 20 28 29 20 2e 20 62 6f 64 79 29 0a 09 20 28 6c () . body).. (l
9220: 65 74 20 6c 6f 6f 70 20 28 28 76 61 72 20 65 78 et loop ((var ex
9230: 70 72 29 20 2e 2e 2e 29 0a 09 20 28 6d 61 74 63 pr) ...).. (matc
9240: 68 2d 6c 65 74 20 28 28 70 61 74 20 76 61 72 29 h-let ((pat var)
9250: 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 2e ...). .
9260: 20 62 6f 64 79 29 29 29 0a 09 20 28 28 5f 20 6c body))).. ((_ l
9270: 6f 6f 70 20 28 76 20 2e 2e 2e 29 20 28 28 70 61 oop (v ...) ((pa
9280: 74 20 65 78 70 72 29 20 2e 20 72 65 73 74 29 20 t expr) . rest)
9290: 2e 20 62 6f 64 79 29 0a 09 20 28 6d 61 74 63 68 . body).. (match
92a0: 2d 6e 61 6d 65 64 2d 6c 65 74 20 6c 6f 6f 70 20 -named-let loop
92b0: 28 76 20 2e 2e 2e 20 28 70 61 74 20 65 78 70 72 (v ... (pat expr
92c0: 20 74 6d 70 29 29 20 72 65 73 74 20 2e 20 62 6f tmp)) rest . bo
92d0: 64 79 29 29 29 29 0a 0a 09 20 3b 3b 3e 20 5c 6d dy))))... ;;> \m
92e0: 61 63 72 6f 7b 28 6d 61 74 63 68 2d 6c 65 74 2a acro{(match-let*
92f0: 20 28 28 76 61 72 20 76 61 6c 75 65 29 20 2e 2e ((var value) ..
9300: 2e 29 20 62 6f 64 79 20 2e 2e 2e 29 7d 0a 0a 09 .) body ...)}...
9310: 20 3b 3b 3e 20 53 69 6d 69 6c 61 72 20 74 6f 20 ;;> Similar to
9320: 5c 73 63 68 65 6d 65 7b 6d 61 74 63 68 2d 6c 65 \scheme{match-le
9330: 74 7d 2c 20 62 75 74 20 61 6e 61 6c 6f 67 6f 75 t}, but analogou
9340: 73 6c 79 20 74 6f 20 5c 73 63 68 65 6d 65 7b 6c sly to \scheme{l
9350: 65 74 2a 7d 0a 09 20 3b 3b 3e 20 6d 61 74 63 68 et*}.. ;;> match
9360: 65 73 20 61 6e 64 20 62 69 6e 64 73 20 74 68 65 es and binds the
9370: 20 76 61 72 69 61 62 6c 65 73 20 69 6e 20 73 65 variables in se
9380: 71 75 65 6e 63 65 2c 20 77 69 74 68 20 70 72 65 quence, with pre
9390: 63 65 64 69 6e 67 20 6d 61 74 63 68 0a 09 20 3b ceding match.. ;
93a0: 3b 3e 20 76 61 72 69 61 62 6c 65 73 20 69 6e 20 ;> variables in
93b0: 73 63 6f 70 65 2e 0a 0a 09 20 28 64 65 66 69 6e scope.... (defin
93c0: 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 6c e-syntax match-l
93d0: 65 74 2a 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 et*.. (syntax-ru
93e0: 6c 65 73 20 28 29 0a 09 20 28 28 5f 20 28 29 20 les ().. ((_ ()
93f0: 2e 20 62 6f 64 79 29 0a 09 20 28 6c 65 74 20 28 . body).. (let (
9400: 29 20 2e 20 62 6f 64 79 29 29 0a 09 20 28 28 5f ) . body)).. ((_
9410: 20 28 28 70 61 74 20 65 78 70 72 29 20 2e 20 72 ((pat expr) . r
9420: 65 73 74 29 20 2e 20 62 6f 64 79 29 0a 09 20 28 est) . body).. (
9430: 6d 61 74 63 68 20 65 78 70 72 20 28 70 61 74 20 match expr (pat
9440: 28 6d 61 74 63 68 2d 6c 65 74 2a 20 72 65 73 74 (match-let* rest
9450: 20 2e 20 62 6f 64 79 29 29 29 29 29 29 0a 0a 0a . body))))))...
9460: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
9470: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
9480: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
9490: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b ;;;;;;;;;;;;;;;;
94a0: 3b 3b 3b 3b 3b 3b 3b 3b 0a 09 20 3b 3b 20 4f 74 ;;;;;;;;.. ;; Ot
94b0: 68 65 72 77 69 73 65 20 43 4f 4e 44 2d 45 58 50 herwise COND-EXP
94c0: 41 4e 44 65 64 20 62 69 74 73 2e 0a 0a 09 20 3b ANDed bits.... ;
94d0: 3b 20 54 6f 20 61 76 6f 69 64 20 64 65 70 65 6e ; To avoid depen
94e0: 64 69 6e 67 20 6f 6e 20 73 72 66 69 2d 30 20 77 ding on srfi-0 w
94f0: 65 20 63 6f 6d 6d 65 6e 74 20 74 68 65 20 66 6f e comment the fo
9500: 6c 6c 6f 77 69 6e 67 20 66 6f 72 6d 20 61 6e 64 llowing form and
9510: 20 63 6f 70 79 0a 09 20 3b 3b 20 74 68 65 20 67 copy.. ;; the g
9520: 65 6e 65 72 69 63 20 76 65 72 73 69 6f 6e 20 62 eneric version b
9530: 65 6c 6f 77 20 69 74 2e 20 28 46 42 45 29 0a 0a elow it. (FBE)..
9540: 09 20 3b 3b 20 28 63 6f 6e 64 2d 65 78 70 61 6e . ;; (cond-expan
9550: 64 0a 09 20 3b 3b 20 20 28 63 68 69 62 69 0a 09 d.. ;; (chibi..
9560: 20 3b 3b 20 20 20 28 64 65 66 69 6e 65 2d 73 79 ;; (define-sy
9570: 6e 74 61 78 20 6d 61 74 63 68 2d 63 68 65 63 6b ntax match-check
9580: 2d 65 6c 6c 69 70 73 69 73 0a 09 20 3b 3b 20 20 -ellipsis.. ;;
9590: 20 20 20 28 65 72 2d 6d 61 63 72 6f 2d 74 72 61 (er-macro-tra
95a0: 6e 73 66 6f 72 6d 65 72 0a 09 20 3b 3b 20 20 20 nsformer.. ;;
95b0: 20 20 20 28 6c 61 6d 62 64 61 20 28 65 78 70 72 (lambda (expr
95c0: 20 72 65 6e 61 6d 65 20 63 6f 6d 70 61 72 65 29 rename compare)
95d0: 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 28 69 66 .. ;; (if
95e0: 20 28 63 6f 6d 70 61 72 65 20 27 2e 2e 2e 20 28 (compare '... (
95f0: 63 61 64 72 20 65 78 70 72 29 29 0a 09 20 3b 3b cadr expr)).. ;;
9600: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 61 72 (car
9610: 20 28 63 64 64 72 20 65 78 70 72 29 29 0a 09 20 (cddr expr))..
9620: 3b 3b 20 20 20 20 20 20 20 20 20 20 20 20 28 63 ;; (c
9630: 61 64 72 20 28 63 64 64 72 20 65 78 70 72 29 29 adr (cddr expr))
9640: 29 29 29 29 0a 09 20 3b 3b 20 20 20 28 64 65 66 )))).. ;; (def
9650: 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 ine-syntax match
9660: 2d 63 68 65 63 6b 2d 69 64 65 6e 74 69 66 69 65 -check-identifie
9670: 72 0a 09 20 3b 3b 20 20 20 20 20 28 65 72 2d 6d r.. ;; (er-m
9680: 61 63 72 6f 2d 74 72 61 6e 73 66 6f 72 6d 65 72 acro-transformer
9690: 0a 09 20 3b 3b 20 20 20 20 20 20 28 6c 61 6d 62 .. ;; (lamb
96a0: 64 61 20 28 65 78 70 72 20 72 65 6e 61 6d 65 20 da (expr rename
96b0: 63 6f 6d 70 61 72 65 29 0a 09 20 3b 3b 20 20 20 compare).. ;;
96c0: 20 20 20 20 20 28 69 66 20 28 69 64 65 6e 74 69 (if (identi
96d0: 66 69 65 72 3f 20 28 63 61 64 72 20 65 78 70 72 fier? (cadr expr
96e0: 29 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 )).. ;;
96f0: 20 20 20 28 63 61 72 20 28 63 64 64 72 20 65 78 (car (cddr ex
9700: 70 72 29 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 pr)).. ;;
9710: 20 20 20 20 20 28 63 61 64 72 20 28 63 64 64 72 (cadr (cddr
9720: 20 65 78 70 72 29 29 29 29 29 29 29 0a 0a 09 20 expr)))))))...
9730: 3b 3b 20 20 28 65 6c 73 65 0a 09 20 3b 3b 20 20 ;; (else.. ;;
9740: 20 3b 3b 20 50 6f 72 74 61 62 6c 65 20 76 65 72 ;; Portable ver
9750: 73 69 6f 6e 73 0a 09 20 3b 3b 20 20 20 3b 3b 0a sions.. ;; ;;.
9760: 09 20 3b 3b 20 20 20 3b 3b 20 54 68 69 73 20 2a . ;; ;; This *
9770: 73 68 6f 75 6c 64 2a 20 77 6f 72 6b 2c 20 62 75 should* work, bu
9780: 74 20 64 6f 65 73 6e 27 74 20 3a 28 0a 09 20 3b t doesn't :(.. ;
9790: 3b 20 20 20 3b 3b 20 20 20 28 64 65 66 69 6e 65 ; ;; (define
97a0: 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 63 68 -syntax match-ch
97b0: 65 63 6b 2d 65 6c 6c 69 70 73 69 73 0a 09 20 3b eck-ellipsis.. ;
97c0: 3b 20 20 20 3b 3b 20 20 20 20 20 28 73 79 6e 74 ; ;; (synt
97d0: 61 78 2d 72 75 6c 65 73 20 28 2e 2e 2e 29 0a 09 ax-rules (...)..
97e0: 20 3b 3b 20 20 20 3b 3b 20 20 20 20 20 20 20 28 ;; ;; (
97f0: 28 5f 20 2e 2e 2e 20 73 6b 20 66 6b 29 20 73 6b (_ ... sk fk) sk
9800: 29 0a 09 20 3b 3b 20 20 20 3b 3b 20 20 20 20 20 ).. ;; ;;
9810: 20 20 28 28 5f 20 78 20 73 6b 20 66 6b 29 20 66 ((_ x sk fk) f
9820: 6b 29 29 29 0a 09 20 3b 3b 20 20 20 3b 3b 0a 09 k))).. ;; ;;..
9830: 20 3b 3b 20 20 20 3b 3b 20 54 68 69 73 20 69 73 ;; ;; This is
9840: 20 61 20 6c 69 74 74 6c 65 20 6d 6f 72 65 20 63 a little more c
9850: 6f 6d 70 6c 69 63 61 74 65 64 2c 20 61 6e 64 20 omplicated, and
9860: 69 6e 74 72 6f 64 75 63 65 73 20 61 20 6e 65 77 introduces a new
9870: 20 6c 65 74 2d 73 79 6e 74 61 78 2c 0a 09 20 3b let-syntax,.. ;
9880: 3b 20 20 20 3b 3b 20 62 75 74 20 73 68 6f 75 6c ; ;; but shoul
9890: 64 20 77 6f 72 6b 20 70 6f 72 74 61 62 6c 79 20 d work portably
98a0: 69 6e 20 61 6e 79 20 52 5b 35 36 5d 52 53 20 53 in any R[56]RS S
98b0: 63 68 65 6d 65 2e 20 20 54 61 79 6c 6f 72 20 43 cheme. Taylor C
98c0: 61 6d 70 62 65 6c 6c 0a 09 20 3b 3b 20 20 20 3b ampbell.. ;; ;
98d0: 3b 20 6f 72 69 67 69 6e 61 6c 6c 79 20 63 61 6d ; originally cam
98e0: 65 20 75 70 20 77 69 74 68 20 74 68 65 20 69 64 e up with the id
98f0: 65 61 2e 0a 09 20 3b 3b 20 20 20 28 64 65 66 69 ea... ;; (defi
9900: 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d ne-syntax match-
9910: 63 68 65 63 6b 2d 65 6c 6c 69 70 73 69 73 0a 09 check-ellipsis..
9920: 20 3b 3b 20 20 20 20 20 28 73 79 6e 74 61 78 2d ;; (syntax-
9930: 72 75 6c 65 73 20 28 29 0a 09 20 3b 3b 20 20 20 rules ().. ;;
9940: 20 20 20 20 3b 3b 20 74 68 65 73 65 20 74 77 6f ;; these two
9950: 20 61 72 65 6e 27 74 20 6e 65 63 65 73 73 61 72 aren't necessar
9960: 79 20 62 75 74 20 70 72 6f 76 69 64 65 20 66 61 y but provide fa
9970: 73 74 2d 63 61 73 65 20 66 61 69 6c 75 72 65 73 st-case failures
9980: 0a 09 20 3b 3b 20 20 20 20 20 20 20 28 28 6d 61 .. ;; ((ma
9990: 74 63 68 2d 63 68 65 63 6b 2d 65 6c 6c 69 70 73 tch-check-ellips
99a0: 69 73 20 28 61 20 2e 20 62 29 20 73 75 63 63 65 is (a . b) succe
99b0: 73 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 20 ss-k failure-k)
99c0: 66 61 69 6c 75 72 65 2d 6b 29 0a 09 20 3b 3b 20 failure-k).. ;;
99d0: 20 20 20 20 20 20 28 28 6d 61 74 63 68 2d 63 68 ((match-ch
99e0: 65 63 6b 2d 65 6c 6c 69 70 73 69 73 20 23 28 61 eck-ellipsis #(a
99f0: 20 2e 2e 2e 29 20 73 75 63 63 65 73 73 2d 6b 20 ...) success-k
9a00: 66 61 69 6c 75 72 65 2d 6b 29 20 66 61 69 6c 75 failure-k) failu
9a10: 72 65 2d 6b 29 0a 09 20 3b 3b 20 20 20 20 20 20 re-k).. ;;
9a20: 20 3b 3b 20 6d 61 74 63 68 69 6e 67 20 61 6e 20 ;; matching an
9a30: 61 74 6f 6d 0a 09 20 3b 3b 20 20 20 20 20 20 20 atom.. ;;
9a40: 28 28 6d 61 74 63 68 2d 63 68 65 63 6b 2d 65 6c ((match-check-el
9a50: 6c 69 70 73 69 73 20 69 64 20 73 75 63 63 65 73 lipsis id succes
9a60: 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 0a 09 s-k failure-k)..
9a70: 20 3b 3b 20 20 20 20 20 20 20 20 28 6c 65 74 2d ;; (let-
9a80: 73 79 6e 74 61 78 20 28 28 65 6c 6c 69 70 73 69 syntax ((ellipsi
9a90: 73 3f 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 s? (syntax-rules
9aa0: 20 28 29 0a 09 20 3b 3b 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 20 20 20 20 20 20 20 20 20 3b 3b 20 69 66 66 ;; iff
9ad0: 20 60 69 64 27 20 69 73 20 60 2e 2e 2e 27 20 68 `id' is `...' h
9ae0: 65 72 65 20 74 68 65 6e 20 74 68 69 73 20 77 69 ere then this wi
9af0: 6c 6c 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 ll.. ;;
9b00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b10: 20 20 20 20 20 20 20 20 20 3b 3b 20 6d 61 74 63 ;; matc
9b20: 68 20 61 20 6c 69 73 74 20 6f 66 20 61 6e 79 20 h a list of any
9b30: 6c 65 6e 67 74 68 0a 09 20 3b 3b 20 20 20 20 20 length.. ;;
9b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 65 ((e
9b60: 6c 6c 69 70 73 69 73 3f 20 28 66 6f 6f 20 69 64 llipsis? (foo id
9b70: 29 20 73 6b 20 66 6b 29 20 73 6b 29 0a 09 20 3b ) sk fk) sk).. ;
9b80: 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ;
9b90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
9ba0: 20 20 20 28 28 65 6c 6c 69 70 73 69 73 3f 20 6f ((ellipsis? o
9bb0: 74 68 65 72 20 73 6b 20 66 6b 29 20 66 6b 29 29 ther sk fk) fk))
9bc0: 29 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 )).. ;;
9bd0: 20 3b 3b 20 74 68 69 73 20 6c 69 73 74 20 6f 66 ;; this list of
9be0: 20 74 68 72 65 65 20 65 6c 65 6d 65 6e 74 73 20 three elements
9bf0: 77 69 6c 6c 20 6f 6e 6c 79 20 6d 61 74 63 68 20 will only match
9c00: 74 68 65 20 28 66 6f 6f 20 69 64 29 20 6c 69 73 the (foo id) lis
9c10: 74 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 t.. ;;
9c20: 3b 3b 20 61 62 6f 76 65 20 69 66 20 60 69 64 27 ;; above if `id'
9c30: 20 69 73 20 60 2e 2e 2e 27 0a 09 20 3b 3b 20 20 is `...'.. ;;
9c40: 20 20 20 20 20 20 20 20 28 65 6c 6c 69 70 73 69 (ellipsi
9c50: 73 3f 20 28 61 20 62 20 63 29 20 73 75 63 63 65 s? (a b c) succe
9c60: 73 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 29 ss-k failure-k))
9c70: 29 29 29 0a 0a 09 20 3b 3b 20 20 20 3b 3b 20 54 )))... ;; ;; T
9c80: 68 69 73 20 69 73 20 70 6f 72 74 61 62 6c 65 20 his is portable
9c90: 62 75 74 20 63 61 6e 20 62 65 20 6d 6f 72 65 20 but can be more
9ca0: 65 66 66 69 63 69 65 6e 74 20 77 69 74 68 20 6e efficient with n
9cb0: 6f 6e 2d 70 6f 72 74 61 62 6c 65 0a 09 20 3b 3b on-portable.. ;;
9cc0: 20 20 20 3b 3b 20 65 78 74 65 6e 73 69 6f 6e 73 ;; extensions
9cd0: 2e 20 20 54 68 69 73 20 74 72 69 63 6b 20 77 61 . This trick wa
9ce0: 73 20 6f 72 69 67 69 6e 61 6c 6c 79 20 64 69 73 s originally dis
9cf0: 63 6f 76 65 72 65 64 20 62 79 20 4f 6c 65 67 20 covered by Oleg
9d00: 4b 69 73 65 6c 79 6f 76 2e 0a 09 20 3b 3b 20 20 Kiselyov... ;;
9d10: 20 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 (define-syntax
9d20: 6d 61 74 63 68 2d 63 68 65 63 6b 2d 69 64 65 6e match-check-iden
9d30: 74 69 66 69 65 72 0a 09 20 3b 3b 20 20 20 20 20 tifier.. ;;
9d40: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
9d50: 0a 09 20 3b 3b 20 20 20 20 20 20 20 3b 3b 20 66 .. ;; ;; f
9d60: 61 73 74 2d 63 61 73 65 20 66 61 69 6c 75 72 65 ast-case failure
9d70: 73 2c 20 6c 69 73 74 73 20 61 6e 64 20 76 65 63 s, lists and vec
9d80: 74 6f 72 73 20 61 72 65 20 6e 6f 74 20 69 64 65 tors are not ide
9d90: 6e 74 69 66 69 65 72 73 0a 09 20 3b 3b 20 20 20 ntifiers.. ;;
9da0: 20 20 20 20 28 28 5f 20 28 78 20 2e 20 79 29 20 ((_ (x . y)
9db0: 73 75 63 63 65 73 73 2d 6b 20 66 61 69 6c 75 72 success-k failur
9dc0: 65 2d 6b 29 20 66 61 69 6c 75 72 65 2d 6b 29 0a e-k) failure-k).
9dd0: 09 20 3b 3b 20 20 20 20 20 20 20 28 28 5f 20 23 . ;; ((_ #
9de0: 28 78 20 2e 2e 2e 29 20 73 75 63 63 65 73 73 2d (x ...) success-
9df0: 6b 20 66 61 69 6c 75 72 65 2d 6b 29 20 66 61 69 k failure-k) fai
9e00: 6c 75 72 65 2d 6b 29 0a 09 20 3b 3b 20 20 20 20 lure-k).. ;;
9e10: 20 20 20 3b 3b 20 78 20 69 73 20 61 6e 20 61 74 ;; x is an at
9e20: 6f 6d 0a 09 20 3b 3b 20 20 20 20 20 20 20 28 28 om.. ;; ((
9e30: 5f 20 78 20 73 75 63 63 65 73 73 2d 6b 20 66 61 _ x success-k fa
9e40: 69 6c 75 72 65 2d 6b 29 0a 09 20 3b 3b 20 20 20 ilure-k).. ;;
9e50: 20 20 20 20 20 28 6c 65 74 2d 73 79 6e 74 61 78 (let-syntax
9e60: 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 20 20 .. ;;
9e70: 20 28 28 73 79 6d 3f 0a 09 20 3b 3b 20 20 20 20 ((sym?.. ;;
9e80: 20 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 (synta
9e90: 78 2d 72 75 6c 65 73 20 28 29 0a 09 20 3b 3b 20 x-rules ().. ;;
9ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
9eb0: 3b 20 69 66 20 74 68 65 20 73 79 6d 62 6f 6c 20 ; if the symbol
9ec0: 60 61 62 72 61 63 61 64 61 62 72 61 27 20 6d 61 `abracadabra' ma
9ed0: 74 63 68 65 73 20 78 2c 20 74 68 65 6e 20 78 20 tches x, then x
9ee0: 69 73 20 61 0a 09 20 3b 3b 20 20 20 20 20 20 20 is a.. ;;
9ef0: 20 20 20 20 20 20 20 20 20 3b 3b 20 73 79 6d 62 ;; symb
9f00: 6f 6c 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 20 ol.. ;;
9f10: 20 20 20 20 20 20 20 28 28 73 79 6d 3f 20 78 20 ((sym? x
9f20: 73 6b 20 66 6b 29 20 73 6b 29 0a 09 20 3b 3b 20 sk fk) sk).. ;;
9f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b ;
9f40: 3b 20 6f 74 68 65 72 77 69 73 65 20 78 20 69 73 ; otherwise x is
9f50: 20 61 20 6e 6f 6e 2d 73 79 6d 62 6f 6c 20 64 61 a non-symbol da
9f60: 74 75 6d 0a 09 20 3b 3b 20 20 20 20 20 20 20 20 tum.. ;;
9f70: 20 20 20 20 20 20 20 20 28 28 73 79 6d 3f 20 79 ((sym? y
9f80: 20 73 6b 20 66 6b 29 20 66 6b 29 29 29 29 0a 09 sk fk) fk))))..
9f90: 20 3b 3b 20 20 20 20 20 20 20 20 20 20 28 73 79 ;; (sy
9fa0: 6d 3f 20 61 62 72 61 63 61 64 61 62 72 61 20 73 m? abracadabra s
9fb0: 75 63 63 65 73 73 2d 6b 20 66 61 69 6c 75 72 65 uccess-k failure
9fc0: 2d 6b 29 29 29 29 29 29 29 0a 0a 09 20 3b 3b 20 -k)))))))... ;;
9fd0: 50 6f 72 74 61 62 6c 65 20 76 65 72 73 69 6f 6e Portable version
9fe0: 73 0a 09 20 3b 3b 0a 09 20 3b 3b 20 54 68 69 73 s.. ;;.. ;; This
9ff0: 20 2a 73 68 6f 75 6c 64 2a 20 77 6f 72 6b 2c 20 *should* work,
a000: 62 75 74 20 64 6f 65 73 6e 27 74 20 3a 28 0a 09 but doesn't :(..
a010: 20 3b 3b 20 20 20 28 64 65 66 69 6e 65 2d 73 79 ;; (define-sy
a020: 6e 74 61 78 20 6d 61 74 63 68 2d 63 68 65 63 6b ntax match-check
a030: 2d 65 6c 6c 69 70 73 69 73 0a 09 20 3b 3b 20 20 -ellipsis.. ;;
a040: 20 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 (syntax-rules
a050: 20 28 2e 2e 2e 29 0a 09 20 3b 3b 20 20 20 20 20 (...).. ;;
a060: 20 20 28 28 5f 20 2e 2e 2e 20 73 6b 20 66 6b 29 ((_ ... sk fk)
a070: 20 73 6b 29 0a 09 20 3b 3b 20 20 20 20 20 20 20 sk).. ;;
a080: 28 28 5f 20 78 20 73 6b 20 66 6b 29 20 66 6b 29 ((_ x sk fk) fk)
a090: 29 29 0a 09 20 3b 3b 0a 09 20 3b 3b 20 54 68 69 )).. ;;.. ;; Thi
a0a0: 73 20 69 73 20 61 20 6c 69 74 74 6c 65 20 6d 6f s is a little mo
a0b0: 72 65 20 63 6f 6d 70 6c 69 63 61 74 65 64 2c 20 re complicated,
a0c0: 61 6e 64 20 69 6e 74 72 6f 64 75 63 65 73 20 61 and introduces a
a0d0: 20 6e 65 77 20 6c 65 74 2d 73 79 6e 74 61 78 2c new let-syntax,
a0e0: 0a 09 20 3b 3b 20 62 75 74 20 73 68 6f 75 6c 64 .. ;; but should
a0f0: 20 77 6f 72 6b 20 70 6f 72 74 61 62 6c 79 20 69 work portably i
a100: 6e 20 61 6e 79 20 52 5b 35 36 5d 52 53 20 53 63 n any R[56]RS Sc
a110: 68 65 6d 65 2e 20 20 54 61 79 6c 6f 72 20 43 61 heme. Taylor Ca
a120: 6d 70 62 65 6c 6c 0a 09 20 3b 3b 20 6f 72 69 67 mpbell.. ;; orig
a130: 69 6e 61 6c 6c 79 20 63 61 6d 65 20 75 70 20 77 inally came up w
a140: 69 74 68 20 74 68 65 20 69 64 65 61 2e 0a 09 20 ith the idea...
a150: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d (define-syntax m
a160: 61 74 63 68 2d 63 68 65 63 6b 2d 65 6c 6c 69 70 atch-check-ellip
a170: 73 69 73 0a 09 20 28 73 79 6e 74 61 78 2d 72 75 sis.. (syntax-ru
a180: 6c 65 73 20 28 29 0a 09 20 3b 3b 20 74 68 65 73 les ().. ;; thes
a190: 65 20 74 77 6f 20 61 72 65 6e 27 74 20 6e 65 63 e two aren't nec
a1a0: 65 73 73 61 72 79 20 62 75 74 20 70 72 6f 76 69 essary but provi
a1b0: 64 65 20 66 61 73 74 2d 63 61 73 65 20 66 61 69 de fast-case fai
a1c0: 6c 75 72 65 73 0a 09 20 28 28 6d 61 74 63 68 2d lures.. ((match-
a1d0: 63 68 65 63 6b 2d 65 6c 6c 69 70 73 69 73 20 28 check-ellipsis (
a1e0: 61 20 2e 20 62 29 20 73 75 63 63 65 73 73 2d 6b a . b) success-k
a1f0: 20 66 61 69 6c 75 72 65 2d 6b 29 20 66 61 69 6c failure-k) fail
a200: 75 72 65 2d 6b 29 0a 09 20 28 28 6d 61 74 63 68 ure-k).. ((match
a210: 2d 63 68 65 63 6b 2d 65 6c 6c 69 70 73 69 73 20 -check-ellipsis
a220: 23 28 61 20 2e 2e 2e 29 20 73 75 63 63 65 73 73 #(a ...) success
a230: 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 20 66 61 -k failure-k) fa
a240: 69 6c 75 72 65 2d 6b 29 0a 09 20 3b 3b 20 6d 61 ilure-k).. ;; ma
a250: 74 63 68 69 6e 67 20 61 6e 20 61 74 6f 6d 0a 09 tching an atom..
a260: 20 28 28 6d 61 74 63 68 2d 63 68 65 63 6b 2d 65 ((match-check-e
a270: 6c 6c 69 70 73 69 73 20 69 64 20 73 75 63 63 65 llipsis id succe
a280: 73 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 0a ss-k failure-k).
a290: 09 20 28 6c 65 74 2d 73 79 6e 74 61 78 20 28 28 . (let-syntax ((
a2a0: 65 6c 6c 69 70 73 69 73 3f 20 28 73 79 6e 74 61 ellipsis? (synta
a2b0: 78 2d 72 75 6c 65 73 20 28 29 0a 09 20 3b 3b 20 x-rules ().. ;;
a2c0: 69 66 66 20 60 69 64 27 20 69 73 20 60 2e 2e 2e iff `id' is `...
a2d0: 27 20 68 65 72 65 20 74 68 65 6e 20 74 68 69 73 ' here then this
a2e0: 20 77 69 6c 6c 0a 09 20 3b 3b 20 6d 61 74 63 68 will.. ;; match
a2f0: 20 61 20 6c 69 73 74 20 6f 66 20 61 6e 79 20 6c a list of any l
a300: 65 6e 67 74 68 0a 09 20 28 28 65 6c 6c 69 70 73 ength.. ((ellips
a310: 69 73 3f 20 28 66 6f 6f 20 69 64 29 20 73 6b 20 is? (foo id) sk
a320: 66 6b 29 20 73 6b 29 0a 09 20 28 28 65 6c 6c 69 fk) sk).. ((elli
a330: 70 73 69 73 3f 20 6f 74 68 65 72 20 73 6b 20 66 psis? other sk f
a340: 6b 29 20 66 6b 29 29 29 29 0a 09 20 3b 3b 20 74 k) fk)))).. ;; t
a350: 68 69 73 20 6c 69 73 74 20 6f 66 20 74 68 72 65 his list of thre
a360: 65 20 65 6c 65 6d 65 6e 74 73 20 77 69 6c 6c 20 e elements will
a370: 6f 6e 6c 79 20 6d 61 74 63 68 20 74 68 65 20 28 only match the (
a380: 66 6f 6f 20 69 64 29 20 6c 69 73 74 0a 09 20 3b foo id) list.. ;
a390: 3b 20 61 62 6f 76 65 20 69 66 20 60 69 64 27 20 ; above if `id'
a3a0: 69 73 20 60 2e 2e 2e 27 0a 09 20 28 65 6c 6c 69 is `...'.. (elli
a3b0: 70 73 69 73 3f 20 28 61 20 62 20 63 29 20 73 75 psis? (a b c) su
a3c0: 63 63 65 73 73 2d 6b 20 66 61 69 6c 75 72 65 2d ccess-k failure-
a3d0: 6b 29 29 29 29 29 0a 0a 09 20 3b 3b 20 54 68 69 k)))))... ;; Thi
a3e0: 73 20 69 73 20 70 6f 72 74 61 62 6c 65 20 62 75 s is portable bu
a3f0: 74 20 63 61 6e 20 62 65 20 6d 6f 72 65 20 65 66 t can be more ef
a400: 66 69 63 69 65 6e 74 20 77 69 74 68 20 6e 6f 6e ficient with non
a410: 2d 70 6f 72 74 61 62 6c 65 0a 09 20 3b 3b 20 65 -portable.. ;; e
a420: 78 74 65 6e 73 69 6f 6e 73 2e 20 20 54 68 69 73 xtensions. This
a430: 20 74 72 69 63 6b 20 77 61 73 20 6f 72 69 67 69 trick was origi
a440: 6e 61 6c 6c 79 20 64 69 73 63 6f 76 65 72 65 64 nally discovered
a450: 20 62 79 20 4f 6c 65 67 20 4b 69 73 65 6c 79 6f by Oleg Kiselyo
a460: 76 2e 0a 09 20 28 64 65 66 69 6e 65 2d 73 79 6e v... (define-syn
a470: 74 61 78 20 6d 61 74 63 68 2d 63 68 65 63 6b 2d tax match-check-
a480: 69 64 65 6e 74 69 66 69 65 72 0a 09 20 28 73 79 identifier.. (sy
a490: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 09 20 ntax-rules ()..
a4a0: 3b 3b 20 66 61 73 74 2d 63 61 73 65 20 66 61 69 ;; fast-case fai
a4b0: 6c 75 72 65 73 2c 20 6c 69 73 74 73 20 61 6e 64 lures, lists and
a4c0: 20 76 65 63 74 6f 72 73 20 61 72 65 20 6e 6f 74 vectors are not
a4d0: 20 69 64 65 6e 74 69 66 69 65 72 73 0a 09 20 28 identifiers.. (
a4e0: 28 5f 20 28 78 20 2e 20 79 29 20 73 75 63 63 65 (_ (x . y) succe
a4f0: 73 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 20 ss-k failure-k)
a500: 66 61 69 6c 75 72 65 2d 6b 29 0a 09 20 28 28 5f failure-k).. ((_
a510: 20 23 28 78 20 2e 2e 2e 29 20 73 75 63 63 65 73 #(x ...) succes
a520: 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 20 66 s-k failure-k) f
a530: 61 69 6c 75 72 65 2d 6b 29 0a 09 20 3b 3b 20 78 ailure-k).. ;; x
a540: 20 69 73 20 61 6e 20 61 74 6f 6d 0a 09 20 28 28 is an atom.. ((
a550: 5f 20 78 20 73 75 63 63 65 73 73 2d 6b 20 66 61 _ x success-k fa
a560: 69 6c 75 72 65 2d 6b 29 0a 09 20 28 6c 65 74 2d ilure-k).. (let-
a570: 73 79 6e 74 61 78 0a 20 20 20 20 20 20 20 20 20 syntax.
a580: 28 28 73 79 6d 3f 0a 09 20 28 73 79 6e 74 61 78 ((sym?.. (syntax
a590: 2d 72 75 6c 65 73 20 28 29 0a 09 20 3b 3b 20 69 -rules ().. ;; i
a5a0: 66 20 74 68 65 20 73 79 6d 62 6f 6c 20 60 61 62 f the symbol `ab
a5b0: 72 61 63 61 64 61 62 72 61 27 20 6d 61 74 63 68 racadabra' match
a5c0: 65 73 20 78 2c 20 74 68 65 6e 20 78 20 69 73 20 es x, then x is
a5d0: 61 0a 09 20 3b 3b 20 73 79 6d 62 6f 6c 0a 09 20 a.. ;; symbol..
a5e0: 28 28 73 79 6d 3f 20 78 20 73 6b 20 66 6b 29 20 ((sym? x sk fk)
a5f0: 73 6b 29 0a 09 20 3b 3b 20 6f 74 68 65 72 77 69 sk).. ;; otherwi
a600: 73 65 20 78 20 69 73 20 61 20 6e 6f 6e 2d 73 79 se x is a non-sy
a610: 6d 62 6f 6c 20 64 61 74 75 6d 0a 09 20 28 28 73 mbol datum.. ((s
a620: 79 6d 3f 20 79 20 73 6b 20 66 6b 29 20 66 6b 29 ym? y sk fk) fk)
a630: 29 29 29 0a 09 20 28 73 79 6d 3f 20 61 62 72 61 ))).. (sym? abra
a640: 63 61 64 61 62 72 61 20 73 75 63 63 65 73 73 2d cadabra success-
a650: 6b 20 66 61 69 6c 75 72 65 2d 6b 29 29 29 29 29 k failure-k)))))
a660: 0a 09 20 29 0a .. ).