Artifact 49d6d8243534ff0f26dd7ed384c77f55e9f02ae2:

• File foof/match.scm — part of check-in [112a40d018] at 2016-09-01 08:27:10 on branch trunk — various improvements, added lmdb , added license notices (user: ovenpasta@pizzahack.eu size: 21746)

0000: 3b 3b 3b 3b 20 6d 61 74 63 68 2e 73 63 6d 20 2d  ;;;; match.scm -
0010: 2d 20 70 6f 72 74 61 62 6c 65 20 68 79 67 69 65  - portable hygie
0020: 6e 69 63 20 70 61 74 74 65 72 6e 20 6d 61 74 63  nic pattern matc
0030: 68 65 72 0a 3b 3b 0a 3b 3b 20 54 68 69 73 20 63  her.;;.;; This c
0040: 6f 64 65 20 69 73 20 77 72 69 74 74 65 6e 20 62  ode is written b
0050: 79 20 41 6c 65 78 20 53 68 69 6e 6e 20 61 6e 64  y Alex Shinn and
0060: 20 70 6c 61 63 65 64 20 69 6e 20 74 68 65 0a 3b   placed in the.;
0070: 3b 20 50 75 62 6c 69 63 20 44 6f 6d 61 69 6e 2e  ; Public Domain.
0080: 20 20 41 6c 6c 20 77 61 72 72 61 6e 74 69 65 73    All warranties
0090: 20 61 72 65 20 64 69 73 63 6c 61 69 6d 65 64 2e   are disclaimed.
00a0: 0a 0a 3b 3b 20 54 68 69 73 20 69 73 20 61 20 66  ..;; This is a f
00b0: 75 6c 6c 20 73 75 70 65 72 73 65 74 20 6f 66 20  ull superset of 
00c0: 74 68 65 20 70 6f 70 75 6c 61 72 20 4d 41 54 43  the popular MATC
00d0: 48 20 70 61 63 6b 61 67 65 20 62 79 20 41 6e 64  H package by And
00e0: 72 65 77 0a 3b 3b 20 57 72 69 67 68 74 2c 20 77  rew.;; Wright, w
00f0: 72 69 74 74 65 6e 20 69 6e 20 66 75 6c 6c 79 20  ritten in fully 
0100: 70 6f 72 74 61 62 6c 65 20 53 59 4e 54 41 58 2d  portable SYNTAX-
0110: 52 55 4c 45 53 20 28 52 35 52 53 20 6f 6e 6c 79  RULES (R5RS only
0120: 2c 20 62 72 65 61 6b 73 0a 3b 3b 20 69 6e 20 52  , breaks.;; in R
0130: 36 52 53 20 53 59 4e 54 41 58 2d 52 55 4c 45 53  6RS SYNTAX-RULES
0140: 29 2c 20 61 6e 64 20 74 68 75 73 20 70 72 65 73  ), and thus pres
0150: 65 72 76 69 6e 67 20 68 79 67 69 65 6e 65 2e 0a  erving hygiene..
0160: 0a 3b 3b 20 54 68 69 73 20 69 73 20 61 20 73 69  .;; This is a si
0170: 6d 70 6c 65 20 67 65 6e 65 72 61 74 69 76 65 20  mple generative 
0180: 70 61 74 74 65 72 6e 20 6d 61 74 63 68 65 72 20  pattern matcher 
0190: 2d 20 65 61 63 68 20 70 61 74 74 65 72 6e 20 69  - each pattern i
01a0: 73 0a 3b 3b 20 65 78 70 61 6e 64 65 64 20 69 6e  s.;; expanded in
01b0: 74 6f 20 74 68 65 20 72 65 71 75 69 72 65 64 20  to the required 
01c0: 74 65 73 74 73 2c 20 63 61 6c 6c 69 6e 67 20 61  tests, calling a
01d0: 20 66 61 69 6c 75 72 65 20 63 6f 6e 74 69 6e 75   failure continu
01e0: 61 74 69 6f 6e 20 69 66 0a 3b 3b 20 74 68 65 20  ation if.;; the 
01f0: 74 65 73 74 73 20 66 61 69 6c 2e 20 20 54 68 69  tests fail.  Thi
0200: 73 20 6d 61 6b 65 73 20 74 68 65 20 6c 6f 67 69  s makes the logi
0210: 63 20 65 61 73 79 20 74 6f 20 66 6f 6c 6c 6f 77  c easy to follow
0220: 20 61 6e 64 20 65 78 74 65 6e 64 2c 0a 3b 3b 20   and extend,.;; 
0230: 62 75 74 20 70 72 6f 64 75 63 65 73 20 73 75 62  but produces sub
0240: 2d 6f 70 74 69 6d 61 6c 20 63 6f 64 65 20 69 6e  -optimal code in
0250: 20 63 61 73 65 73 20 77 68 65 72 65 20 79 6f 75   cases where you
0260: 20 68 61 76 65 20 6d 61 6e 79 20 73 69 6d 69 6c   have many simil
0270: 61 72 0a 3b 3b 20 63 6c 61 75 73 65 73 20 64 75  ar.;; clauses du
0280: 65 20 74 6f 20 72 65 70 65 61 74 69 6e 67 20 74  e to repeating t
0290: 68 65 20 73 61 6d 65 20 74 65 73 74 73 2e 20 20  he same tests.  
02a0: 4e 6f 6e 65 74 68 65 6c 65 73 73 20 61 20 73 6d  Nonetheless a sm
02b0: 61 72 74 0a 3b 3b 20 63 6f 6d 70 69 6c 65 72 20  art.;; compiler 
02c0: 73 68 6f 75 6c 64 20 62 65 20 61 62 6c 65 20 74  should be able t
02d0: 6f 20 72 65 6d 6f 76 65 20 74 68 65 20 72 65 64  o remove the red
02e0: 75 6e 64 61 6e 74 20 74 65 73 74 73 2e 20 20 46  undant tests.  F
02f0: 6f 72 0a 3b 3b 20 4d 41 54 43 48 2d 4c 45 54 20  or.;; MATCH-LET 
0300: 61 6e 64 20 44 45 53 54 52 55 43 54 55 52 49 4e  and DESTRUCTURIN
0310: 47 2d 42 49 4e 44 20 74 79 70 65 20 75 73 65 73  G-BIND type uses
0320: 20 74 68 65 72 65 20 69 73 20 6e 6f 20 70 65 72   there is no per
0330: 66 6f 72 6d 61 6e 63 65 0a 3b 3b 20 68 69 74 2e  formance.;; hit.
0340: 0a 0a 3b 3b 20 54 68 65 20 6f 72 69 67 69 6e 61  ..;; The origina
0350: 6c 20 76 65 72 73 69 6f 6e 20 77 61 73 20 77 72  l version was wr
0360: 69 74 74 65 6e 20 6f 6e 20 32 30 30 36 2f 31 31  itten on 2006/11
0370: 2f 32 39 20 61 6e 64 20 64 65 73 63 72 69 62 65  /29 and describe
0380: 64 20 69 6e 20 74 68 65 0a 3b 3b 20 66 6f 6c 6c  d in the.;; foll
0390: 6f 77 69 6e 67 20 55 73 65 6e 65 74 20 70 6f 73  owing Usenet pos
03a0: 74 3a 0a 3b 3b 20 20 20 68 74 74 70 3a 2f 2f 67  t:.;;   http://g
03b0: 72 6f 75 70 73 2e 67 6f 6f 67 6c 65 2e 63 6f 6d  roups.google.com
03c0: 2f 67 72 6f 75 70 2f 63 6f 6d 70 2e 6c 61 6e 67  /group/comp.lang
03d0: 2e 73 63 68 65 6d 65 2f 6d 73 67 2f 30 39 34 31  .scheme/msg/0941
03e0: 32 33 34 64 65 37 31 31 32 66 66 64 0a 3b 3b 20  234de7112ffd.;; 
03f0: 61 6e 64 20 69 73 20 73 74 69 6c 6c 20 61 76 61  and is still ava
0400: 69 6c 61 62 6c 65 20 61 74 0a 3b 3b 20 20 20 68  ilable at.;;   h
0410: 74 74 70 3a 2f 2f 73 79 6e 74 68 63 6f 64 65 2e  ttp://synthcode.
0420: 63 6f 6d 2f 73 63 68 65 6d 65 2f 6d 61 74 63 68  com/scheme/match
0430: 2d 73 69 6d 70 6c 65 2e 73 63 6d 0a 3b 3b 20 41  -simple.scm.;; A
0440: 20 76 61 72 69 61 6e 74 20 6f 66 20 74 68 69 73   variant of this
0450: 20 66 69 6c 65 20 77 68 69 63 68 20 75 73 65 73   file which uses
0460: 20 43 4f 4e 44 2d 45 58 50 41 4e 44 20 69 6e 20   COND-EXPAND in 
0470: 61 20 66 65 77 20 70 6c 61 63 65 73 20 63 61 6e  a few places can
0480: 0a 3b 3b 20 62 65 20 66 6f 75 6e 64 20 61 74 0a  .;; be found at.
0490: 3b 3b 20 20 20 68 74 74 70 3a 2f 2f 73 79 6e 74  ;;   http://synt
04a0: 68 63 6f 64 65 2e 63 6f 6d 2f 73 63 68 65 6d 65  hcode.com/scheme
04b0: 2f 6d 61 74 63 68 2d 63 6f 6e 64 2d 65 78 70 61  /match-cond-expa
04c0: 6e 64 2e 73 63 6d 0a 3b 3b 0a 3b 3b 20 32 30 30  nd.scm.;;.;; 200
04d0: 38 2f 30 33 2f 32 30 20 2d 20 66 69 78 69 6e 67  8/03/20 - fixing
04e0: 20 62 75 67 20 77 68 65 72 65 20 28 61 20 2e 2e   bug where (a ..
04f0: 2e 29 20 6d 61 74 63 68 65 64 20 6e 6f 6e 2d 6c  .) matched non-l
0500: 69 73 74 73 0a 3b 3b 20 32 30 30 38 2f 30 33 2f  ists.;; 2008/03/
0510: 31 35 20 2d 20 72 65 6d 6f 76 69 6e 67 20 72 65  15 - removing re
0520: 64 75 6e 64 61 6e 74 20 63 68 65 63 6b 20 69 6e  dundant check in
0530: 20 76 65 63 74 6f 72 20 70 61 74 74 65 72 6e 73   vector patterns
0540: 0a 3b 3b 20 32 30 30 38 2f 30 33 2f 30 36 20 2d  .;; 2008/03/06 -
0550: 20 79 6f 75 20 63 61 6e 20 75 73 65 20 60 2e 2e   you can use `..
0560: 2e 27 20 70 6f 72 74 61 62 6c 79 20 6e 6f 77 20  .' portably now 
0570: 28 74 68 61 6e 6b 73 20 74 6f 20 54 61 79 6c 6f  (thanks to Taylo
0580: 72 20 43 61 6d 70 62 65 6c 6c 29 0a 3b 3b 20 32  r Campbell).;; 2
0590: 30 30 37 2f 30 39 2f 30 34 20 2d 20 66 69 78 69  007/09/04 - fixi
05a0: 6e 67 20 71 75 61 73 69 71 75 6f 74 65 20 70 61  ng quasiquote pa
05b0: 74 74 65 72 6e 73 0a 3b 3b 20 32 30 30 37 2f 30  tterns.;; 2007/0
05c0: 37 2f 32 31 20 2d 20 61 6c 6c 6f 77 69 6e 67 20  7/21 - allowing 
05d0: 65 6c 6c 69 70 73 65 20 70 61 74 74 65 72 6e 73  ellipse patterns
05e0: 20 69 6e 20 6e 6f 6e 2d 66 69 6e 61 6c 20 6c 69   in non-final li
05f0: 73 74 20 70 6f 73 69 74 69 6f 6e 73 0a 3b 3b 20  st positions.;; 
0600: 32 30 30 37 2f 30 34 2f 31 30 20 2d 20 66 69 78  2007/04/10 - fix
0610: 69 6e 67 20 70 6f 74 65 6e 74 69 61 6c 20 68 79  ing potential hy
0620: 67 69 65 6e 65 20 69 73 73 75 65 20 69 6e 20 6d  giene issue in m
0630: 61 74 63 68 2d 63 68 65 63 6b 2d 65 6c 6c 69 70  atch-check-ellip
0640: 73 65 0a 3b 3b 20 20 20 20 20 20 20 20 20 20 20  se.;;           
0650: 20 20 20 28 74 68 61 6e 6b 73 20 74 6f 20 54 61     (thanks to Ta
0660: 79 6c 6f 72 20 43 61 6d 70 62 65 6c 6c 29 0a 3b  ylor Campbell).;
0670: 3b 20 32 30 30 37 2f 30 34 2f 30 38 20 2d 20 63  ; 2007/04/08 - c
0680: 6c 65 61 6e 20 75 70 2c 20 63 6f 6d 6d 65 6e 74  lean up, comment
0690: 69 6e 67 0a 3b 3b 20 32 30 30 36 2f 31 32 2f 32  ing.;; 2006/12/2
06a0: 34 20 2d 20 62 75 67 66 69 78 65 73 0a 3b 3b 20  4 - bugfixes.;; 
06b0: 32 30 30 36 2f 31 32 2f 30 31 20 2d 20 6e 6f 6e  2006/12/01 - non
06c0: 2d 6c 69 6e 65 61 72 20 70 61 74 74 65 72 6e 73  -linear patterns
06d0: 2c 20 73 68 61 72 65 64 20 76 61 72 69 61 62 6c  , shared variabl
06e0: 65 73 20 69 6e 20 4f 52 2c 20 67 65 74 21 2f 73  es in OR, get!/s
06f0: 65 74 21 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  et!..;;;;;;;;;;;
0700: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
0710: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
0720: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
0730: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b  ;;;;;;;;;;;;;.;;
0740: 20 66 6f 72 63 65 20 63 6f 6d 70 69 6c 65 2d 74   force compile-t
0750: 69 6d 65 20 73 79 6e 74 61 78 20 65 72 72 6f 72  ime syntax error
0760: 73 20 77 69 74 68 20 75 73 65 66 75 6c 20 6d 65  s with useful me
0770: 73 73 61 67 65 73 0a 0a 28 64 65 66 69 6e 65 2d  ssages..(define-
0780: 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 73 79 6e  syntax match-syn
0790: 74 61 78 2d 65 72 72 6f 72 0a 20 20 28 73 79 6e  tax-error.  (syn
07a0: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20  tax-rules ().   
07b0: 20 28 28 5f 29 0a 20 20 20 20 20 28 6d 61 74 63   ((_).     (matc
07c0: 68 2d 73 79 6e 74 61 78 2d 65 72 72 6f 72 20 22  h-syntax-error "
07d0: 69 6e 76 61 6c 69 64 20 6d 61 74 63 68 2d 73 79  invalid match-sy
07e0: 6e 74 61 78 2d 65 72 72 6f 72 20 75 73 61 67 65  ntax-error usage
07f0: 22 29 29 29 29 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b  "))))..;;;;;;;;;
0800: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
0810: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
0820: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
0830: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a  ;;;;;;;;;;;;;;;.
0840: 0a 3b 3b 20 54 68 65 20 62 61 73 69 63 20 69 6e  .;; The basic in
0850: 74 65 72 66 61 63 65 2e 20 20 4d 41 54 43 48 20  terface.  MATCH 
0860: 6a 75 73 74 20 70 65 72 66 6f 72 6d 73 20 73 6f  just performs so
0870: 6d 65 20 62 61 73 69 63 20 73 79 6e 74 61 78 0a  me basic syntax.
0880: 3b 3b 20 76 61 6c 69 64 61 74 69 6f 6e 2c 20 62  ;; validation, b
0890: 69 6e 64 73 20 74 68 65 20 6d 61 74 63 68 20 65  inds the match e
08a0: 78 70 72 65 73 73 69 6f 6e 20 74 6f 20 61 20 74  xpression to a t
08b0: 65 6d 70 6f 72 61 72 79 20 76 61 72 69 61 62 6c  emporary variabl
08c0: 65 20 60 76 27 2c 0a 3b 3b 20 61 6e 64 20 70 61  e `v',.;; and pa
08d0: 73 73 65 73 20 69 74 20 6f 6e 20 74 6f 20 4d 41  sses it on to MA
08e0: 54 43 48 2d 4e 45 58 54 2e 20 20 49 74 27 73 20  TCH-NEXT.  It's 
08f0: 61 20 63 6f 6e 73 74 61 6e 74 20 74 68 72 6f 75  a constant throu
0900: 67 68 6f 75 74 20 74 68 65 0a 3b 3b 20 63 6f 64  ghout the.;; cod
0910: 65 20 62 65 6c 6f 77 20 74 68 61 74 20 74 68 65  e below that the
0920: 20 62 69 6e 64 69 6e 67 20 60 76 27 20 69 73 20   binding `v' is 
0930: 61 20 64 69 72 65 63 74 20 76 61 72 69 61 62 6c  a direct variabl
0940: 65 20 72 65 66 65 72 65 6e 63 65 2c 20 6e 6f 74  e reference, not
0950: 0a 3b 3b 20 61 6e 20 65 78 70 72 65 73 73 69 6f  .;; an expressio
0960: 6e 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74  n...(define-synt
0970: 61 78 20 6d 61 74 63 68 0a 20 20 28 73 79 6e 74  ax match.  (synt
0980: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20  ax-rules ().    
0990: 28 28 6d 61 74 63 68 29 0a 20 20 20 20 20 28 6d  ((match).     (m
09a0: 61 74 63 68 2d 73 79 6e 74 61 78 2d 65 72 72 6f  atch-syntax-erro
09b0: 72 20 22 6d 69 73 73 69 6e 67 20 6d 61 74 63 68  r "missing match
09c0: 20 65 78 70 72 65 73 73 69 6f 6e 22 29 29 0a 20   expression")). 
09d0: 20 20 20 28 28 6d 61 74 63 68 20 61 74 6f 6d 29     ((match atom)
09e0: 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 73 79 6e  .     (match-syn
09f0: 74 61 78 2d 65 72 72 6f 72 20 22 6d 69 73 73 69  tax-error "missi
0a00: 6e 67 20 6d 61 74 63 68 20 63 6c 61 75 73 65 22  ng match clause"
0a10: 29 29 0a 20 20 20 20 28 28 6d 61 74 63 68 20 28  )).    ((match (
0a20: 61 70 70 20 2e 2e 2e 29 20 28 70 61 74 20 2e 20  app ...) (pat . 
0a30: 62 6f 64 79 29 20 2e 2e 2e 29 0a 20 20 20 20 20  body) ...).     
0a40: 28 6c 65 74 20 28 28 76 20 28 61 70 70 20 2e 2e  (let ((v (app ..
0a50: 2e 29 29 29 0a 20 20 20 20 20 20 20 28 6d 61 74  .))).       (mat
0a60: 63 68 2d 6e 65 78 74 20 76 20 28 61 70 70 20 2e  ch-next v (app .
0a70: 2e 2e 29 20 28 73 65 74 21 20 28 61 70 70 20 2e  ..) (set! (app .
0a80: 2e 2e 29 29 20 28 70 61 74 20 2e 20 62 6f 64 79  ..)) (pat . body
0a90: 29 20 2e 2e 2e 29 29 29 0a 20 20 20 20 28 28 6d  ) ...))).    ((m
0aa0: 61 74 63 68 20 23 28 76 65 63 20 2e 2e 2e 29 20  atch #(vec ...) 
0ab0: 28 70 61 74 20 2e 20 62 6f 64 79 29 20 2e 2e 2e  (pat . body) ...
0ac0: 29 0a 20 20 20 20 20 28 6c 65 74 20 28 28 76 20  ).     (let ((v 
0ad0: 23 28 76 65 63 20 2e 2e 2e 29 29 29 0a 20 20 20  #(vec ...))).   
0ae0: 20 20 20 20 28 6d 61 74 63 68 2d 6e 65 78 74 20      (match-next 
0af0: 76 20 76 20 28 73 65 74 21 20 76 29 20 28 70 61  v v (set! v) (pa
0b00: 74 20 2e 20 62 6f 64 79 29 20 2e 2e 2e 29 29 29  t . body) ...)))
0b10: 0a 20 20 20 20 28 28 6d 61 74 63 68 20 61 74 6f  .    ((match ato
0b20: 6d 20 28 70 61 74 20 2e 20 62 6f 64 79 29 20 2e  m (pat . body) .
0b30: 2e 2e 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d  ..).     (match-
0b40: 6e 65 78 74 20 61 74 6f 6d 20 61 74 6f 6d 20 28  next atom atom (
0b50: 73 65 74 21 20 61 74 6f 6d 29 20 28 70 61 74 20  set! atom) (pat 
0b60: 2e 20 62 6f 64 79 29 20 2e 2e 2e 29 29 0a 20 20  . body) ...)).  
0b70: 20 20 29 29 0a 0a 3b 3b 20 4d 41 54 43 48 2d 4e    ))..;; MATCH-N
0b80: 45 58 54 20 70 61 73 73 65 73 20 65 61 63 68 20  EXT passes each 
0b90: 63 6c 61 75 73 65 20 74 6f 20 4d 41 54 43 48 2d  clause to MATCH-
0ba0: 4f 4e 45 20 69 6e 20 74 75 72 6e 20 77 69 74 68  ONE in turn with
0bb0: 20 69 74 73 20 66 61 69 6c 75 72 65 0a 3b 3b 20   its failure.;; 
0bc0: 74 68 75 6e 6b 2c 20 77 68 69 63 68 20 69 73 20  thunk, which is 
0bd0: 65 78 70 61 6e 64 65 64 20 62 79 20 72 65 63 75  expanded by recu
0be0: 72 73 69 6e 67 20 4d 41 54 43 48 2d 4e 45 58 54  rsing MATCH-NEXT
0bf0: 20 6f 6e 20 74 68 65 20 72 65 6d 61 69 6e 69 6e   on the remainin
0c00: 67 0a 3b 3b 20 63 6c 61 75 73 65 73 2e 20 20 60  g.;; clauses.  `
0c10: 67 27 20 61 6e 64 20 60 73 27 20 61 72 65 20 74  g' and `s' are t
0c20: 68 65 20 67 65 74 21 20 61 6e 64 20 73 65 74 21  he get! and set!
0c30: 20 65 78 70 72 65 73 73 69 6f 6e 73 0a 3b 3b 20   expressions.;; 
0c40: 72 65 73 70 65 63 74 69 76 65 6c 79 2e 0a 0a 28  respectively...(
0c50: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61  define-syntax ma
0c60: 74 63 68 2d 6e 65 78 74 0a 20 20 28 73 79 6e 74  tch-next.  (synt
0c70: 61 78 2d 72 75 6c 65 73 20 28 3d 3e 29 0a 20 20  ax-rules (=>).  
0c80: 20 20 3b 3b 20 6e 6f 20 6d 6f 72 65 20 63 6c 61    ;; no more cla
0c90: 75 73 65 73 2c 20 74 68 65 20 6d 61 74 63 68 20  uses, the match 
0ca0: 66 61 69 6c 65 64 0a 20 20 20 20 28 28 6d 61 74  failed.    ((mat
0cb0: 63 68 2d 6e 65 78 74 20 76 20 67 20 73 29 0a 20  ch-next v g s). 
0cc0: 20 20 20 20 28 65 72 72 6f 72 20 27 6d 61 74 63      (error 'matc
0cd0: 68 20 22 6e 6f 20 6d 61 74 63 68 69 6e 67 20 70  h "no matching p
0ce0: 61 74 74 65 72 6e 22 29 29 0a 20 20 20 20 3b 3b  attern")).    ;;
0cf0: 20 6e 61 6d 65 64 20 66 61 69 6c 75 72 65 20 63   named failure c
0d00: 6f 6e 74 69 6e 75 61 74 69 6f 6e 0a 20 20 20 20  ontinuation.    
0d10: 28 28 6d 61 74 63 68 2d 6e 65 78 74 20 76 20 67  ((match-next v g
0d20: 20 73 20 28 70 61 74 20 28 3d 3e 20 66 61 69 6c   s (pat (=> fail
0d30: 75 72 65 29 20 2e 20 62 6f 64 79 29 20 2e 20 72  ure) . body) . r
0d40: 65 73 74 29 0a 20 20 20 20 20 28 6c 65 74 20 28  est).     (let (
0d50: 28 66 61 69 6c 75 72 65 20 28 6c 61 6d 62 64 61  (failure (lambda
0d60: 20 28 29 20 28 6d 61 74 63 68 2d 6e 65 78 74 20   () (match-next 
0d70: 76 20 67 20 73 20 2e 20 72 65 73 74 29 29 29 29  v g s . rest))))
0d80: 0a 20 20 20 20 20 20 20 3b 3b 20 6d 61 74 63 68  .       ;; match
0d90: 2d 6f 6e 65 20 61 6e 61 6c 79 7a 65 73 20 74 68  -one analyzes th
0da0: 65 20 70 61 74 74 65 72 6e 20 66 6f 72 20 75 73  e pattern for us
0db0: 0a 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 6f  .       (match-o
0dc0: 6e 65 20 76 20 70 61 74 20 67 20 73 20 28 6d 61  ne v pat g s (ma
0dd0: 74 63 68 2d 64 72 6f 70 2d 69 64 73 20 28 62 65  tch-drop-ids (be
0de0: 67 69 6e 20 2e 20 62 6f 64 79 29 29 20 28 66 61  gin . body)) (fa
0df0: 69 6c 75 72 65 29 20 28 29 29 29 29 0a 20 20 20  ilure) ()))).   
0e00: 20 3b 3b 20 61 6e 6f 6e 79 6d 6f 75 73 20 66 61   ;; anonymous fa
0e10: 69 6c 75 72 65 20 63 6f 6e 74 69 6e 75 61 74 69  ilure continuati
0e20: 6f 6e 2c 20 67 69 76 65 20 69 74 20 61 20 64 75  on, give it a du
0e30: 6d 6d 79 20 6e 61 6d 65 0a 20 20 20 20 28 28 6d  mmy name.    ((m
0e40: 61 74 63 68 2d 6e 65 78 74 20 76 20 67 20 73 20  atch-next v g s 
0e50: 28 70 61 74 20 2e 20 62 6f 64 79 29 20 2e 20 72  (pat . body) . r
0e60: 65 73 74 29 0a 20 20 20 20 20 28 6d 61 74 63 68  est).     (match
0e70: 2d 6e 65 78 74 20 76 20 67 20 73 20 28 70 61 74  -next v g s (pat
0e80: 20 28 3d 3e 20 66 61 69 6c 75 72 65 29 20 2e 20   (=> failure) . 
0e90: 62 6f 64 79 29 20 2e 20 72 65 73 74 29 29 29 29  body) . rest))))
0ea0: 0a 0a 3b 3b 20 4d 41 54 43 48 2d 4f 4e 45 20 66  ..;; MATCH-ONE f
0eb0: 69 72 73 74 20 63 68 65 63 6b 73 20 66 6f 72 20  irst checks for 
0ec0: 65 6c 6c 69 70 73 65 20 70 61 74 74 65 72 6e 73  ellipse patterns
0ed0: 2c 20 6f 74 68 65 72 77 69 73 65 20 70 61 73 73  , otherwise pass
0ee0: 65 73 20 6f 6e 20 74 6f 0a 3b 3b 20 4d 41 54 43  es on to.;; MATC
0ef0: 48 2d 54 57 4f 2e 0a 0a 28 64 65 66 69 6e 65 2d  H-TWO...(define-
0f00: 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 6f 6e 65  syntax match-one
0f10: 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73  .  (syntax-rules
0f20: 20 28 29 0a 20 20 20 20 3b 3b 20 49 66 20 69 74   ().    ;; If it
0f30: 27 73 20 61 20 6c 69 73 74 20 6f 66 20 74 77 6f  's a list of two
0f40: 20 76 61 6c 75 65 73 2c 20 63 68 65 63 6b 20 74   values, check t
0f50: 6f 20 73 65 65 20 69 66 20 74 68 65 20 73 65 63  o see if the sec
0f60: 6f 6e 64 20 6f 6e 65 20 69 73 0a 20 20 20 20 3b  ond one is.    ;
0f70: 3b 20 61 6e 20 65 6c 6c 69 70 73 65 20 61 6e 64  ; an ellipse and
0f80: 20 68 61 6e 64 6c 65 20 61 63 63 6f 72 64 69 6e   handle accordin
0f90: 67 6c 79 2c 20 6f 74 68 65 72 77 69 73 65 20 67  gly, otherwise g
0fa0: 6f 20 74 6f 20 4d 41 54 43 48 2d 54 57 4f 2e 0a  o to MATCH-TWO..
0fb0: 20 20 20 20 28 28 6d 61 74 63 68 2d 6f 6e 65 20      ((match-one 
0fc0: 76 20 28 70 20 71 20 2e 20 72 29 20 67 20 73 20  v (p q . r) g s 
0fd0: 73 6b 20 66 6b 20 69 29 0a 20 20 20 20 20 28 6d  sk fk i).     (m
0fe0: 61 74 63 68 2d 63 68 65 63 6b 2d 65 6c 6c 69 70  atch-check-ellip
0ff0: 73 65 0a 20 20 20 20 20 20 71 0a 20 20 20 20 20  se.      q.     
1000: 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d   (match-extract-
1010: 76 61 72 73 20 70 20 28 6d 61 74 63 68 2d 67 65  vars p (match-ge
1020: 6e 2d 65 6c 6c 69 70 73 65 73 20 76 20 70 20 72  n-ellipses v p r
1030: 20 67 20 73 20 73 6b 20 66 6b 20 69 29 20 69 20   g s sk fk i) i 
1040: 28 29 29 0a 20 20 20 20 20 20 28 6d 61 74 63 68  ()).      (match
1050: 2d 74 77 6f 20 76 20 28 70 20 71 20 2e 20 72 29  -two v (p q . r)
1060: 20 67 20 73 20 73 6b 20 66 6b 20 69 29 29 29 0a   g s sk fk i))).
1070: 20 20 20 20 3b 3b 20 4f 74 68 65 72 77 69 73 65      ;; Otherwise
1080: 2c 20 67 6f 20 64 69 72 65 63 74 6c 79 20 74 6f  , go directly to
1090: 20 4d 41 54 43 48 2d 54 57 4f 2e 0a 20 20 20 20   MATCH-TWO..    
10a0: 28 28 6d 61 74 63 68 2d 6f 6e 65 20 2e 20 78 29  ((match-one . x)
10b0: 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 74 77 6f  .     (match-two
10c0: 20 2e 20 78 29 29 29 29 0a 0a 3b 3b 20 54 68 69   . x))))..;; Thi
10d0: 73 20 69 73 20 74 68 65 20 67 75 74 73 20 6f 66  s is the guts of
10e0: 20 74 68 65 20 70 61 74 74 65 72 6e 20 6d 61 74   the pattern mat
10f0: 63 68 65 72 2e 20 20 57 65 20 61 72 65 20 70 61  cher.  We are pa
1100: 73 73 65 64 20 61 20 6c 6f 74 20 6f 66 0a 3b 3b  ssed a lot of.;;
1110: 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 20 69 6e 20   information in 
1120: 74 68 65 20 66 6f 72 6d 3a 0a 3b 3b 0a 3b 3b 20  the form:.;;.;; 
1130: 20 20 28 6d 61 74 63 68 2d 74 77 6f 20 76 61 72    (match-two var
1140: 20 70 61 74 74 65 72 6e 20 67 65 74 74 65 72 20   pattern getter 
1150: 73 65 74 74 65 72 20 73 75 63 63 65 73 73 2d 6b  setter success-k
1160: 20 66 61 69 6c 2d 6b 20 28 69 64 73 20 2e 2e 2e   fail-k (ids ...
1170: 29 29 0a 3b 3b 0a 3b 3b 20 75 73 75 61 6c 6c 79  )).;;.;; usually
1180: 20 61 62 62 72 65 76 69 61 74 65 64 0a 3b 3b 0a   abbreviated.;;.
1190: 3b 3b 20 20 20 28 6d 61 74 63 68 2d 74 77 6f 20  ;;   (match-two 
11a0: 76 20 70 20 67 20 73 20 73 6b 20 66 6b 20 69 29  v p g s sk fk i)
11b0: 0a 3b 3b 0a 3b 3b 20 77 68 65 72 65 20 56 41 52  .;;.;; where VAR
11c0: 20 69 73 20 74 68 65 20 73 79 6d 62 6f 6c 20 6e   is the symbol n
11d0: 61 6d 65 20 6f 66 20 74 68 65 20 63 75 72 72 65  ame of the curre
11e0: 6e 74 20 76 61 72 69 61 62 6c 65 20 77 65 20 61  nt variable we a
11f0: 72 65 0a 3b 3b 20 6d 61 74 63 68 69 6e 67 2c 20  re.;; matching, 
1200: 50 41 54 54 45 52 4e 20 69 73 20 74 68 65 20 63  PATTERN is the c
1210: 75 72 72 65 6e 74 20 70 61 74 74 65 72 6e 2c 20  urrent pattern, 
1220: 67 65 74 74 65 72 20 61 6e 64 20 73 65 74 74 65  getter and sette
1230: 72 20 61 72 65 20 74 68 65 0a 3b 3b 20 63 6f 72  r are the.;; cor
1240: 72 65 73 70 6f 6e 64 69 6e 67 20 61 63 63 65 73  responding acces
1250: 73 6f 72 73 20 28 65 2e 67 2e 20 43 41 52 20 61  sors (e.g. CAR a
1260: 6e 64 20 53 45 54 2d 43 41 52 21 20 6f 66 20 74  nd SET-CAR! of t
1270: 68 65 20 70 61 69 72 20 68 6f 6c 64 69 6e 67 0a  he pair holding.
1280: 3b 3b 20 56 41 52 29 2c 20 53 55 43 43 45 53 53  ;; VAR), SUCCESS
1290: 2d 4b 20 69 73 20 74 68 65 20 73 75 63 63 65 73  -K is the succes
12a0: 73 20 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 2c 20  s continuation, 
12b0: 46 41 49 4c 2d 4b 20 69 73 20 74 68 65 20 66 61  FAIL-K is the fa
12c0: 69 6c 75 72 65 0a 3b 3b 20 63 6f 6e 74 69 6e 75  ilure.;; continu
12d0: 61 74 69 6f 6e 20 28 77 68 69 63 68 20 69 73 20  ation (which is 
12e0: 6a 75 73 74 20 61 20 74 68 75 6e 6b 20 63 61 6c  just a thunk cal
12f0: 6c 20 61 6e 64 20 69 73 20 74 68 75 73 20 73 61  l and is thus sa
1300: 66 65 20 74 6f 20 65 78 70 61 6e 64 0a 3b 3b 20  fe to expand.;; 
1310: 6d 75 6c 74 69 70 6c 65 20 74 69 6d 65 73 29 20  multiple times) 
1320: 61 6e 64 20 49 44 53 20 61 72 65 20 74 68 65 20  and IDS are the 
1330: 6c 69 73 74 20 6f 66 20 69 64 65 6e 74 69 66 69  list of identifi
1340: 65 72 73 20 62 6f 75 6e 64 20 69 6e 20 74 68 65  ers bound in the
1350: 0a 3b 3b 20 70 61 74 74 65 72 6e 20 73 6f 20 66  .;; pattern so f
1360: 61 72 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e  ar...(define-syn
1370: 74 61 78 20 6d 61 74 63 68 2d 74 77 6f 0a 20 20  tax match-two.  
1380: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 5f  (syntax-rules (_
1390: 20 5f 5f 5f 20 71 75 6f 74 65 20 71 75 61 73 69   ___ quote quasi
13a0: 71 75 6f 74 65 20 3f 20 24 20 3d 20 61 6e 64 20  quote ? $ = and 
13b0: 6f 72 20 6e 6f 74 20 73 65 74 21 20 67 65 74 21  or not set! get!
13c0: 29 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74 77  ).    ((match-tw
13d0: 6f 20 76 20 28 29 20 67 20 73 20 28 73 6b 20 2e  o v () g s (sk .
13e0: 2e 2e 29 20 66 6b 20 69 29 0a 20 20 20 20 20 28  ..) fk i).     (
13f0: 69 66 20 28 6e 75 6c 6c 3f 20 76 29 20 28 73 6b  if (null? v) (sk
1400: 20 2e 2e 2e 20 69 29 20 66 6b 29 29 0a 20 20 20   ... i) fk)).   
1410: 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20 28   ((match-two v (
1420: 71 75 6f 74 65 20 70 29 20 67 20 73 20 28 73 6b  quote p) g s (sk
1430: 20 2e 2e 2e 29 20 66 6b 20 69 29 0a 20 20 20 20   ...) fk i).    
1440: 20 28 69 66 20 28 65 71 75 61 6c 3f 20 76 20 27   (if (equal? v '
1450: 70 29 20 28 73 6b 20 2e 2e 2e 20 69 29 20 66 6b  p) (sk ... i) fk
1460: 29 29 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74  )).    ((match-t
1470: 77 6f 20 76 20 28 71 75 61 73 69 71 75 6f 74 65  wo v (quasiquote
1480: 20 70 29 20 67 20 73 20 73 6b 20 66 6b 20 69 29   p) g s sk fk i)
1490: 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 71 75 61  .     (match-qua
14a0: 73 69 71 75 6f 74 65 20 76 20 70 20 67 20 73 20  siquote v p g s 
14b0: 73 6b 20 66 6b 20 69 29 29 0a 20 20 20 20 28 28  sk fk i)).    ((
14c0: 6d 61 74 63 68 2d 74 77 6f 20 76 20 28 61 6e 64  match-two v (and
14d0: 29 20 67 20 73 20 28 73 6b 20 2e 2e 2e 29 20 66  ) g s (sk ...) f
14e0: 6b 20 69 29 20 28 73 6b 20 2e 2e 2e 20 69 29 29  k i) (sk ... i))
14f0: 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74 77 6f  .    ((match-two
1500: 20 76 20 28 61 6e 64 20 70 20 71 20 2e 2e 2e 29   v (and p q ...)
1510: 20 67 20 73 20 73 6b 20 66 6b 20 69 29 0a 20 20   g s sk fk i).  
1520: 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65 20 76 20     (match-one v 
1530: 70 20 67 20 73 20 28 6d 61 74 63 68 2d 6f 6e 65  p g s (match-one
1540: 20 76 20 28 61 6e 64 20 71 20 2e 2e 2e 29 20 67   v (and q ...) g
1550: 20 73 20 73 6b 20 66 6b 29 20 66 6b 20 69 29 29   s sk fk) fk i))
1560: 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74 77 6f  .    ((match-two
1570: 20 76 20 28 6f 72 29 20 67 20 73 20 73 6b 20 66   v (or) g s sk f
1580: 6b 20 69 29 20 66 6b 29 0a 20 20 20 20 28 28 6d  k i) fk).    ((m
1590: 61 74 63 68 2d 74 77 6f 20 76 20 28 6f 72 20 70  atch-two v (or p
15a0: 29 20 67 20 73 20 73 6b 20 66 6b 20 69 29 0a 20  ) g s sk fk i). 
15b0: 20 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65 20 76      (match-one v
15c0: 20 70 20 67 20 73 20 73 6b 20 66 6b 20 69 29 29   p g s sk fk i))
15d0: 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74 77 6f  .    ((match-two
15e0: 20 76 20 28 6f 72 20 70 20 2e 2e 2e 29 20 67 20   v (or p ...) g 
15f0: 73 20 73 6b 20 66 6b 20 69 29 0a 20 20 20 20 20  s sk fk i).     
1600: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76  (match-extract-v
1610: 61 72 73 20 28 6f 72 20 70 20 2e 2e 2e 29 0a 20  ars (or p ...). 
1620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1630: 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 67          (match-g
1640: 65 6e 2d 6f 72 20 76 20 28 70 20 2e 2e 2e 29 20  en-or v (p ...) 
1650: 67 20 73 20 73 6b 20 66 6b 20 69 29 0a 20 20 20  g s sk fk i).   
1660: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1670: 20 20 20 20 20 20 69 0a 20 20 20 20 20 20 20 20        i.        
1680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1690: 20 28 29 29 29 0a 20 20 20 20 28 28 6d 61 74 63   ())).    ((matc
16a0: 68 2d 74 77 6f 20 76 20 28 6e 6f 74 20 70 29 20  h-two v (not p) 
16b0: 67 20 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20  g s (sk ...) fk 
16c0: 69 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 6f  i).     (match-o
16d0: 6e 65 20 76 20 70 20 67 20 73 20 28 6d 61 74 63  ne v p g s (matc
16e0: 68 2d 64 72 6f 70 2d 69 64 73 20 66 6b 29 20 28  h-drop-ids fk) (
16f0: 73 6b 20 2e 2e 2e 20 69 29 20 69 29 29 0a 20 20  sk ... i) i)).  
1700: 20 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20    ((match-two v 
1710: 28 67 65 74 21 20 67 65 74 74 65 72 29 20 67 20  (get! getter) g 
1720: 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 69 29  s (sk ...) fk i)
1730: 0a 20 20 20 20 20 28 6c 65 74 20 28 28 67 65 74  .     (let ((get
1740: 74 65 72 20 28 6c 61 6d 62 64 61 20 28 29 20 67  ter (lambda () g
1750: 29 29 29 20 28 73 6b 20 2e 2e 2e 20 69 29 29 29  ))) (sk ... i)))
1760: 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74 77 6f  .    ((match-two
1770: 20 76 20 28 73 65 74 21 20 73 65 74 74 65 72 29   v (set! setter)
1780: 20 67 20 28 73 20 2e 2e 2e 29 20 28 73 6b 20 2e   g (s ...) (sk .
1790: 2e 2e 29 20 66 6b 20 69 29 0a 20 20 20 20 20 28  ..) fk i).     (
17a0: 6c 65 74 20 28 28 73 65 74 74 65 72 20 28 6c 61  let ((setter (la
17b0: 6d 62 64 61 20 28 78 29 20 28 73 20 2e 2e 2e 20  mbda (x) (s ... 
17c0: 78 29 29 29 29 20 28 73 6b 20 2e 2e 2e 20 69 29  x)))) (sk ... i)
17d0: 29 29 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74  )).    ((match-t
17e0: 77 6f 20 76 20 28 3f 20 70 72 65 64 20 70 20 2e  wo v (? pred p .
17f0: 2e 2e 29 20 67 20 73 20 73 6b 20 66 6b 20 69 29  ..) g s sk fk i)
1800: 0a 20 20 20 20 20 28 69 66 20 28 70 72 65 64 20  .     (if (pred 
1810: 76 29 20 28 6d 61 74 63 68 2d 6f 6e 65 20 76 20  v) (match-one v 
1820: 28 61 6e 64 20 70 20 2e 2e 2e 29 20 67 20 73 20  (and p ...) g s 
1830: 73 6b 20 66 6b 20 69 29 20 66 6b 29 29 0a 20 20  sk fk i) fk)).  
1840: 20 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20    ((match-two v 
1850: 28 3d 20 70 72 6f 63 20 70 29 20 67 20 73 20 73  (= proc p) g s s
1860: 6b 20 66 6b 20 69 29 0a 20 20 20 20 20 28 6c 65  k fk i).     (le
1870: 74 20 28 28 77 20 28 70 72 6f 63 20 76 29 29 29  t ((w (proc v)))
1880: 0a 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 6f  .       (match-o
1890: 6e 65 20 77 20 70 20 67 20 73 20 73 6b 20 66 6b  ne w p g s sk fk
18a0: 20 69 29 29 29 0a 20 20 20 20 28 28 6d 61 74 63   i))).    ((matc
18b0: 68 2d 74 77 6f 20 76 20 28 70 20 5f 5f 5f 20 2e  h-two v (p ___ .
18c0: 20 72 29 20 67 20 73 20 73 6b 20 66 6b 20 69 29   r) g s sk fk i)
18d0: 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 65 78 74  .     (match-ext
18e0: 72 61 63 74 2d 76 61 72 73 20 70 20 28 6d 61 74  ract-vars p (mat
18f0: 63 68 2d 67 65 6e 2d 65 6c 6c 69 70 73 65 73 20  ch-gen-ellipses 
1900: 76 20 70 20 72 20 67 20 73 20 73 6b 20 66 6b 20  v p r g s sk fk 
1910: 69 29 20 69 20 28 29 29 29 0a 20 20 20 20 28 28  i) i ())).    ((
1920: 6d 61 74 63 68 2d 74 77 6f 20 76 20 28 70 29 20  match-two v (p) 
1930: 67 20 73 20 73 6b 20 66 6b 20 69 29 0a 20 20 20  g s sk fk i).   
1940: 20 20 28 69 66 20 28 61 6e 64 20 28 70 61 69 72    (if (and (pair
1950: 3f 20 76 29 20 28 6e 75 6c 6c 3f 20 28 63 64 72  ? v) (null? (cdr
1960: 20 76 29 29 29 0a 20 20 20 20 20 20 20 28 6c 65   v))).       (le
1970: 74 20 28 28 77 20 28 63 61 72 20 76 29 29 29 0a  t ((w (car v))).
1980: 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d           (match-
1990: 6f 6e 65 20 77 20 70 20 28 63 61 72 20 76 29 20  one w p (car v) 
19a0: 28 73 65 74 2d 63 61 72 21 20 76 29 20 73 6b 20  (set-car! v) sk 
19b0: 66 6b 20 69 29 29 0a 20 20 20 20 20 20 20 66 6b  fk i)).       fk
19c0: 29 29 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 74  )).    ((match-t
19d0: 77 6f 20 76 20 28 70 20 2e 20 71 29 20 67 20 73  wo v (p . q) g s
19e0: 20 73 6b 20 66 6b 20 69 29 0a 20 20 20 20 20 28   sk fk i).     (
19f0: 69 66 20 28 70 61 69 72 3f 20 76 29 0a 20 20 20  if (pair? v).   
1a00: 20 20 20 20 28 6c 65 74 20 28 28 77 20 28 63 61      (let ((w (ca
1a10: 72 20 76 29 29 20 28 78 20 28 63 64 72 20 76 29  r v)) (x (cdr v)
1a20: 29 29 0a 20 20 20 20 20 20 20 20 20 28 6d 61 74  )).         (mat
1a30: 63 68 2d 6f 6e 65 20 77 20 70 20 28 63 61 72 20  ch-one w p (car 
1a40: 76 29 20 28 73 65 74 2d 63 61 72 21 20 76 29 0a  v) (set-car! v).
1a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1a60: 20 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65 20 78      (match-one x
1a70: 20 71 20 28 63 64 72 20 76 29 20 28 73 65 74 2d   q (cdr v) (set-
1a80: 63 64 72 21 20 76 29 20 73 6b 20 66 6b 29 0a 20  cdr! v) sk fk). 
1a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1aa0: 20 20 20 66 6b 0a 20 20 20 20 20 20 20 20 20 20     fk.          
1ab0: 20 20 20 20 20 20 20 20 20 20 69 29 29 0a 20 20            i)).  
1ac0: 20 20 20 20 20 66 6b 29 29 0a 20 20 20 20 28 28       fk)).    ((
1ad0: 6d 61 74 63 68 2d 74 77 6f 20 76 20 23 28 70 20  match-two v #(p 
1ae0: 2e 2e 2e 29 20 67 20 73 20 73 6b 20 66 6b 20 69  ...) g s sk fk i
1af0: 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 76 65  ).     (match-ve
1b00: 63 74 6f 72 20 76 20 30 20 28 29 20 28 70 20 2e  ctor v 0 () (p .
1b10: 2e 2e 29 20 73 6b 20 66 6b 20 69 29 29 0a 20 20  ..) sk fk i)).  
1b20: 20 20 28 28 6d 61 74 63 68 2d 74 77 6f 20 76 20    ((match-two v 
1b30: 5f 20 67 20 73 20 28 73 6b 20 2e 2e 2e 29 20 66  _ g s (sk ...) f
1b40: 6b 20 69 29 20 28 73 6b 20 2e 2e 2e 20 69 29 29  k i) (sk ... i))
1b50: 0a 20 20 20 20 3b 3b 20 4e 6f 74 20 61 20 70 61  .    ;; Not a pa
1b60: 69 72 20 6f 72 20 76 65 63 74 6f 72 20 6f 72 20  ir or vector or 
1b70: 73 70 65 63 69 61 6c 20 6c 69 74 65 72 61 6c 2c  special literal,
1b80: 20 74 65 73 74 20 74 6f 20 73 65 65 20 69 66 20   test to see if 
1b90: 69 74 27 73 20 61 0a 20 20 20 20 3b 3b 20 6e 65  it's a.    ;; ne
1ba0: 77 20 73 79 6d 62 6f 6c 2c 20 69 6e 20 77 68 69  w symbol, in whi
1bb0: 63 68 20 63 61 73 65 20 77 65 20 6a 75 73 74 20  ch case we just 
1bc0: 62 69 6e 64 20 69 74 2c 20 6f 72 20 69 66 20 69  bind it, or if i
1bd0: 74 27 73 20 61 6e 0a 20 20 20 20 3b 3b 20 61 6c  t's an.    ;; al
1be0: 72 65 61 64 79 20 62 6f 75 6e 64 20 73 79 6d 62  ready bound symb
1bf0: 6f 6c 20 6f 72 20 73 6f 6d 65 20 6f 74 68 65 72  ol or some other
1c00: 20 6c 69 74 65 72 61 6c 2c 20 69 6e 20 77 68 69   literal, in whi
1c10: 63 68 20 63 61 73 65 20 77 65 0a 20 20 20 20 3b  ch case we.    ;
1c20: 3b 20 63 6f 6d 70 61 72 65 20 69 74 20 77 69 74  ; compare it wit
1c30: 68 20 45 51 55 41 4c 3f 2e 0a 20 20 20 20 28 28  h EQUAL?..    ((
1c40: 6d 61 74 63 68 2d 74 77 6f 20 76 20 78 20 67 20  match-two v x g 
1c50: 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20 28 69  s (sk ...) fk (i
1c60: 64 20 2e 2e 2e 29 29 0a 20 20 20 20 20 28 6c 65  d ...)).     (le
1c70: 74 2d 73 79 6e 74 61 78 0a 20 20 20 20 20 20 20  t-syntax.       
1c80: 20 20 28 28 6e 65 77 2d 73 79 6d 3f 0a 20 20 20    ((new-sym?.   
1c90: 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d          (syntax-
1ca0: 72 75 6c 65 73 20 28 69 64 20 2e 2e 2e 29 0a 20  rules (id ...). 
1cb0: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 65              ((ne
1cc0: 77 2d 73 79 6d 3f 20 78 20 73 6b 32 20 66 6b 32  w-sym? x sk2 fk2
1cd0: 29 20 73 6b 32 29 0a 20 20 20 20 20 20 20 20 20  ) sk2).         
1ce0: 20 20 20 20 28 28 6e 65 77 2d 73 79 6d 3f 20 79      ((new-sym? y
1cf0: 20 73 6b 32 20 66 6b 32 29 20 66 6b 32 29 29 29   sk2 fk2) fk2)))
1d00: 29 0a 20 20 20 20 20 20 20 28 6e 65 77 2d 73 79  ).       (new-sy
1d10: 6d 3f 20 72 61 6e 64 6f 6d 2d 73 79 6d 2d 74 6f  m? random-sym-to
1d20: 2d 6d 61 74 63 68 0a 20 20 20 20 20 20 20 20 20  -match.         
1d30: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 78          (let ((x
1d40: 20 76 29 29 20 28 73 6b 20 2e 2e 2e 20 28 69 64   v)) (sk ... (id
1d50: 20 2e 2e 2e 20 78 29 29 29 0a 20 20 20 20 20 20   ... x))).      
1d60: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28             (if (
1d70: 65 71 75 61 6c 3f 20 76 20 78 29 20 28 73 6b 20  equal? v x) (sk 
1d80: 2e 2e 2e 20 28 69 64 20 2e 2e 2e 29 29 20 66 6b  ... (id ...)) fk
1d90: 29 29 29 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20  )))).    ))..;; 
1da0: 51 55 41 53 49 51 55 4f 54 45 20 70 61 74 74 65  QUASIQUOTE patte
1db0: 72 6e 73 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e  rns..(define-syn
1dc0: 74 61 78 20 6d 61 74 63 68 2d 71 75 61 73 69 71  tax match-quasiq
1dd0: 75 6f 74 65 0a 20 20 28 73 79 6e 74 61 78 2d 72  uote.  (syntax-r
1de0: 75 6c 65 73 20 28 75 6e 71 75 6f 74 65 20 75 6e  ules (unquote un
1df0: 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e 67 20 71  quote-splicing q
1e00: 75 61 73 69 71 75 6f 74 65 29 0a 20 20 20 20 28  uasiquote).    (
1e10: 28 5f 20 76 20 28 75 6e 71 75 6f 74 65 20 70 29  (_ v (unquote p)
1e20: 20 67 20 73 20 73 6b 20 66 6b 20 69 29 0a 20 20   g s sk fk i).  
1e30: 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65 20 76 20     (match-one v 
1e40: 70 20 67 20 73 20 73 6b 20 66 6b 20 69 29 29 0a  p g s sk fk i)).
1e50: 20 20 20 20 28 28 5f 20 76 20 28 28 75 6e 71 75      ((_ v ((unqu
1e60: 6f 74 65 2d 73 70 6c 69 63 69 6e 67 20 70 29 20  ote-splicing p) 
1e70: 2e 20 72 65 73 74 29 20 67 20 73 20 73 6b 20 66  . rest) g s sk f
1e80: 6b 20 69 29 0a 20 20 20 20 20 28 69 66 20 28 70  k i).     (if (p
1e90: 61 69 72 3f 20 76 29 0a 20 20 20 20 20 20 20 28  air? v).       (
1ea0: 6d 61 74 63 68 2d 6f 6e 65 20 76 0a 20 20 20 20  match-one v.    
1eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 70                (p
1ec0: 20 2e 20 74 6d 70 29 0a 20 20 20 20 20 20 20 20   . tmp).        
1ed0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 68            (match
1ee0: 2d 71 75 61 73 69 71 75 6f 74 65 20 74 6d 70 20  -quasiquote tmp 
1ef0: 72 65 73 74 20 67 20 73 20 73 6b 20 66 6b 29 0a  rest g s sk fk).
1f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
1f10: 20 20 66 6b 0a 20 20 20 20 20 20 20 20 20 20 20    fk.           
1f20: 20 20 20 20 20 20 20 69 29 0a 20 20 20 20 20 20         i).      
1f30: 20 66 6b 29 29 0a 20 20 20 20 28 28 5f 20 76 20   fk)).    ((_ v 
1f40: 28 71 75 61 73 69 71 75 6f 74 65 20 70 29 20 67  (quasiquote p) g
1f50: 20 73 20 73 6b 20 66 6b 20 69 20 2e 20 64 65 70   s sk fk i . dep
1f60: 74 68 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d  th).     (match-
1f70: 71 75 61 73 69 71 75 6f 74 65 20 76 20 70 20 67  quasiquote v p g
1f80: 20 73 20 73 6b 20 66 6b 20 69 20 23 66 20 2e 20   s sk fk i #f . 
1f90: 64 65 70 74 68 29 29 0a 20 20 20 20 28 28 5f 20  depth)).    ((_ 
1fa0: 76 20 28 75 6e 71 75 6f 74 65 20 70 29 20 67 20  v (unquote p) g 
1fb0: 73 20 73 6b 20 66 6b 20 69 20 78 20 2e 20 64 65  s sk fk i x . de
1fc0: 70 74 68 29 0a 20 20 20 20 20 28 6d 61 74 63 68  pth).     (match
1fd0: 2d 71 75 61 73 69 71 75 6f 74 65 20 76 20 70 20  -quasiquote v p 
1fe0: 67 20 73 20 73 6b 20 66 6b 20 69 20 2e 20 64 65  g s sk fk i . de
1ff0: 70 74 68 29 29 0a 20 20 20 20 28 28 5f 20 76 20  pth)).    ((_ v 
2000: 28 75 6e 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e  (unquote-splicin
2010: 67 20 70 29 20 67 20 73 20 73 6b 20 66 6b 20 69  g p) g s sk fk i
2020: 20 78 20 2e 20 64 65 70 74 68 29 0a 20 20 20 20   x . depth).    
2030: 20 28 6d 61 74 63 68 2d 71 75 61 73 69 71 75 6f   (match-quasiquo
2040: 74 65 20 76 20 70 20 67 20 73 20 73 6b 20 66 6b  te v p g s sk fk
2050: 20 69 20 2e 20 64 65 70 74 68 29 29 0a 20 20 20   i . depth)).   
2060: 20 28 28 5f 20 76 20 28 70 20 2e 20 71 29 20 67   ((_ v (p . q) g
2070: 20 73 20 73 6b 20 66 6b 20 69 20 2e 20 64 65 70   s sk fk i . dep
2080: 74 68 29 0a 20 20 20 20 20 28 69 66 20 28 70 61  th).     (if (pa
2090: 69 72 3f 20 76 29 0a 20 20 20 20 20 20 20 28 6c  ir? v).       (l
20a0: 65 74 20 28 28 77 20 28 63 61 72 20 76 29 29 20  et ((w (car v)) 
20b0: 28 78 20 28 63 64 72 20 76 29 29 29 0a 20 20 20  (x (cdr v))).   
20c0: 20 20 20 20 20 20 28 6d 61 74 63 68 2d 71 75 61        (match-qua
20d0: 73 69 71 75 6f 74 65 0a 20 20 20 20 20 20 20 20  siquote.        
20e0: 20 20 77 20 70 20 67 20 73 0a 20 20 20 20 20 20    w p g s.      
20f0: 20 20 20 20 28 6d 61 74 63 68 2d 71 75 61 73 69      (match-quasi
2100: 71 75 6f 74 65 2d 73 74 65 70 20 78 20 71 20 67  quote-step x q g
2110: 20 73 20 73 6b 20 66 6b 20 64 65 70 74 68 29 0a   s sk fk depth).
2120: 20 20 20 20 20 20 20 20 20 20 66 6b 20 69 20 2e            fk i .
2130: 20 64 65 70 74 68 29 29 0a 20 20 20 20 20 20 20   depth)).       
2140: 66 6b 29 29 0a 20 20 20 20 28 28 5f 20 76 20 23  fk)).    ((_ v #
2150: 28 65 6c 74 20 2e 2e 2e 29 20 67 20 73 20 73 6b  (elt ...) g s sk
2160: 20 66 6b 20 69 20 2e 20 64 65 70 74 68 29 0a 20   fk i . depth). 
2170: 20 20 20 20 28 69 66 20 28 76 65 63 74 6f 72 3f      (if (vector?
2180: 20 76 29 0a 20 20 20 20 20 20 20 28 6c 65 74 20   v).       (let 
2190: 28 28 6c 73 20 28 76 65 63 74 6f 72 2d 3e 6c 69  ((ls (vector->li
21a0: 73 74 20 76 29 29 29 0a 20 20 20 20 20 20 20 20  st v))).        
21b0: 20 28 6d 61 74 63 68 2d 71 75 61 73 69 71 75 6f   (match-quasiquo
21c0: 74 65 20 6c 73 20 28 65 6c 74 20 2e 2e 2e 29 20  te ls (elt ...) 
21d0: 67 20 73 20 73 6b 20 66 6b 20 69 20 2e 20 64 65  g s sk fk i . de
21e0: 70 74 68 29 29 0a 20 20 20 20 20 20 20 66 6b 29  pth)).       fk)
21f0: 29 0a 20 20 20 20 28 28 5f 20 76 20 78 20 67 20  ).    ((_ v x g 
2200: 73 20 73 6b 20 66 6b 20 69 20 2e 20 64 65 70 74  s sk fk i . dept
2210: 68 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 6f  h).     (match-o
2220: 6e 65 20 76 20 27 78 20 67 20 73 20 73 6b 20 66  ne v 'x g s sk f
2230: 6b 20 69 29 29 29 29 0a 0a 28 64 65 66 69 6e 65  k i))))..(define
2240: 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 71 75  -syntax match-qu
2250: 61 73 69 71 75 6f 74 65 2d 73 74 65 70 0a 20 20  asiquote-step.  
2260: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29  (syntax-rules ()
2270: 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 71 75 61  .    ((match-qua
2280: 73 69 71 75 6f 74 65 2d 73 74 65 70 20 78 20 71  siquote-step x q
2290: 20 67 20 73 20 73 6b 20 66 6b 20 64 65 70 74 68   g s sk fk depth
22a0: 20 69 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d   i).     (match-
22b0: 71 75 61 73 69 71 75 6f 74 65 20 78 20 71 20 67  quasiquote x q g
22c0: 20 73 20 73 6b 20 66 6b 20 69 20 2e 20 64 65 70   s sk fk i . dep
22d0: 74 68 29 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 3b  th)).    ))..;;;
22e0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
22f0: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
2300: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
2310: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
2320: 3b 3b 3b 3b 3b 0a 3b 3b 20 55 74 69 6c 69 74 69  ;;;;;.;; Utiliti
2330: 65 73 0a 0a 3b 3b 20 41 20 43 50 53 20 75 74 69  es..;; A CPS uti
2340: 6c 69 74 79 20 74 68 61 74 20 74 61 6b 65 73 20  lity that takes 
2350: 74 77 6f 20 76 61 6c 75 65 73 20 61 6e 64 20 6a  two values and j
2360: 75 73 74 20 65 78 70 61 6e 64 73 20 69 6e 74 6f  ust expands into
2370: 20 74 68 65 0a 3b 3b 20 66 69 72 73 74 2e 0a 28   the.;; first..(
2380: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61  define-syntax ma
2390: 74 63 68 2d 64 72 6f 70 2d 69 64 73 0a 20 20 28  tch-drop-ids.  (
23a0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a  syntax-rules ().
23b0: 20 20 20 20 28 28 5f 20 65 78 70 72 20 69 64 73      ((_ expr ids
23c0: 20 2e 2e 2e 29 20 65 78 70 72 29 29 29 0a 0a 3b   ...) expr)))..;
23d0: 3b 20 47 65 6e 65 72 61 74 69 6e 67 20 4f 52 20  ; Generating OR 
23e0: 63 6c 61 75 73 65 73 20 6a 75 73 74 20 69 6e 76  clauses just inv
23f0: 6f 6c 76 65 73 20 62 69 6e 64 69 6e 67 20 74 68  olves binding th
2400: 65 20 73 75 63 63 65 73 73 0a 3b 3b 20 63 6f 6e  e success.;; con
2410: 74 69 6e 75 61 74 69 6f 6e 20 69 6e 74 6f 20 61  tinuation into a
2420: 20 74 68 75 6e 6b 20 77 68 69 63 68 20 74 61 6b   thunk which tak
2430: 65 73 20 74 68 65 20 69 64 65 6e 74 69 66 69 65  es the identifie
2440: 72 73 20 63 6f 6d 6d 6f 6e 20 74 6f 0a 3b 3b 20  rs common to.;; 
2450: 65 61 63 68 20 4f 52 20 63 6c 61 75 73 65 2c 20  each OR clause, 
2460: 61 6e 64 20 74 72 79 69 6e 67 20 65 61 63 68 20  and trying each 
2470: 63 6c 61 75 73 65 2c 20 63 61 6c 6c 69 6e 67 20  clause, calling 
2480: 74 68 65 20 74 68 75 6e 6b 20 61 73 20 73 6f 6f  the thunk as soo
2490: 6e 0a 3b 3b 20 61 73 20 77 65 20 73 75 63 63 65  n.;; as we succe
24a0: 65 64 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e  ed...(define-syn
24b0: 74 61 78 20 6d 61 74 63 68 2d 67 65 6e 2d 6f 72  tax match-gen-or
24c0: 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73  .  (syntax-rules
24d0: 20 28 29 0a 20 20 20 20 28 28 5f 20 76 20 70 20   ().    ((_ v p 
24e0: 67 20 73 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20  g s (sk ...) fk 
24f0: 28 69 20 2e 2e 2e 29 20 28 28 69 64 20 69 64 2d  (i ...) ((id id-
2500: 6c 73 29 20 2e 2e 2e 29 29 0a 20 20 20 20 20 28  ls) ...)).     (
2510: 6c 65 74 20 28 28 73 6b 32 20 28 6c 61 6d 62 64  let ((sk2 (lambd
2520: 61 20 28 69 64 20 2e 2e 2e 29 20 28 73 6b 20 2e  a (id ...) (sk .
2530: 2e 2e 20 28 69 20 2e 2e 2e 20 69 64 20 2e 2e 2e  .. (i ... id ...
2540: 29 29 29 29 29 0a 20 20 20 20 20 20 20 28 6d 61  ))))).       (ma
2550: 74 63 68 2d 67 65 6e 2d 6f 72 2d 73 74 65 70 0a  tch-gen-or-step.
2560: 20 20 20 20 20 20 20 20 76 20 70 20 67 20 73 20          v p g s 
2570: 28 6d 61 74 63 68 2d 64 72 6f 70 2d 69 64 73 20  (match-drop-ids 
2580: 28 73 6b 32 20 69 64 20 2e 2e 2e 29 29 20 66 6b  (sk2 id ...)) fk
2590: 20 28 69 20 2e 2e 2e 29 29 29 29 29 29 0a 0a 28   (i ...))))))..(
25a0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61  define-syntax ma
25b0: 74 63 68 2d 67 65 6e 2d 6f 72 2d 73 74 65 70 0a  tch-gen-or-step.
25c0: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20    (syntax-rules 
25d0: 28 29 0a 20 20 20 20 28 28 5f 20 76 20 28 29 20  ().    ((_ v () 
25e0: 67 20 73 20 73 6b 20 66 6b 20 69 29 0a 20 20 20  g s sk fk i).   
25f0: 20 20 3b 3b 20 6e 6f 20 4f 52 20 63 6c 61 75 73    ;; no OR claus
2600: 65 73 2c 20 63 61 6c 6c 20 74 68 65 20 66 61 69  es, call the fai
2610: 6c 75 72 65 20 63 6f 6e 74 69 6e 75 61 74 69 6f  lure continuatio
2620: 6e 0a 20 20 20 20 20 66 6b 29 0a 20 20 20 20 28  n.     fk).    (
2630: 28 5f 20 76 20 28 70 29 20 67 20 73 20 73 6b 20  (_ v (p) g s sk 
2640: 66 6b 20 69 29 0a 20 20 20 20 20 3b 3b 20 6c 61  fk i).     ;; la
2650: 73 74 20 28 6f 72 20 6f 6e 6c 79 29 20 4f 52 20  st (or only) OR 
2660: 63 6c 61 75 73 65 2c 20 6a 75 73 74 20 65 78 70  clause, just exp
2670: 61 6e 64 20 6e 6f 72 6d 61 6c 6c 79 0a 20 20 20  and normally.   
2680: 20 20 28 6d 61 74 63 68 2d 6f 6e 65 20 76 20 70    (match-one v p
2690: 20 67 20 73 20 73 6b 20 66 6b 20 69 29 29 0a 20   g s sk fk i)). 
26a0: 20 20 20 28 28 5f 20 76 20 28 70 20 2e 20 71 29     ((_ v (p . q)
26b0: 20 67 20 73 20 73 6b 20 66 6b 20 69 29 0a 20 20   g s sk fk i).  
26c0: 20 20 20 3b 3b 20 6d 61 74 63 68 20 6f 6e 65 20     ;; match one 
26d0: 61 6e 64 20 74 72 79 20 74 68 65 20 72 65 6d 61  and try the rema
26e0: 69 6e 69 6e 67 20 6f 6e 20 66 61 69 6c 75 72 65  ining on failure
26f0: 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65  .     (match-one
2700: 20 76 20 70 20 67 20 73 20 73 6b 20 28 6d 61 74   v p g s sk (mat
2710: 63 68 2d 67 65 6e 2d 6f 72 2d 73 74 65 70 20 76  ch-gen-or-step v
2720: 20 71 20 67 20 73 20 73 6b 20 66 6b 20 69 29 20   q g s sk fk i) 
2730: 69 29 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 57  i)).    ))..;; W
2740: 65 20 6d 61 74 63 68 20 61 20 70 61 74 74 65 72  e match a patter
2750: 6e 20 28 70 20 2e 2e 2e 29 20 62 79 20 6d 61 74  n (p ...) by mat
2760: 63 68 69 6e 67 20 74 68 65 20 70 61 74 74 65 72  ching the patter
2770: 6e 20 70 20 69 6e 20 61 20 6c 6f 6f 70 20 6f 6e  n p in a loop on
2780: 0a 3b 3b 20 65 61 63 68 20 65 6c 65 6d 65 6e 74  .;; each element
2790: 20 6f 66 20 74 68 65 20 76 61 72 69 61 62 6c 65   of the variable
27a0: 2c 20 61 63 63 75 6d 75 6c 61 74 69 6e 67 20 74  , accumulating t
27b0: 68 65 20 62 6f 75 6e 64 20 69 64 73 20 69 6e 74  he bound ids int
27c0: 6f 20 6c 69 73 74 73 2e 0a 0a 3b 3b 20 4c 6f 6f  o lists...;; Loo
27d0: 6b 20 61 74 20 74 68 65 20 62 6f 64 79 20 2d 20  k at the body - 
27e0: 69 74 27 73 20 6a 75 73 74 20 61 20 6e 61 6d 65  it's just a name
27f0: 64 20 6c 65 74 20 6c 6f 6f 70 2c 20 6d 61 74 63  d let loop, matc
2800: 68 69 6e 67 20 65 61 63 68 0a 3b 3b 20 65 6c 65  hing each.;; ele
2810: 6d 65 6e 74 20 69 6e 20 74 75 72 6e 20 74 6f 20  ment in turn to 
2820: 74 68 65 20 73 61 6d 65 20 70 61 74 74 65 72 6e  the same pattern
2830: 2e 20 20 54 68 69 73 20 69 6c 6c 75 73 74 72 61  .  This illustra
2840: 74 65 73 20 74 68 65 0a 3b 3b 20 73 69 6d 70 6c  tes the.;; simpl
2850: 69 63 69 74 79 20 6f 66 20 74 68 69 73 20 67 65  icity of this ge
2860: 6e 65 72 61 74 69 76 65 2d 73 74 79 6c 65 20 70  nerative-style p
2870: 61 74 74 65 72 6e 20 6d 61 74 63 68 69 6e 67 2e  attern matching.
2880: 20 20 49 74 20 77 6f 75 6c 64 20 62 65 0a 3b 3b    It would be.;;
2890: 20 6a 75 73 74 20 61 73 20 65 61 73 79 20 74 6f   just as easy to
28a0: 20 69 6d 70 6c 65 6d 65 6e 74 20 61 20 74 72 65   implement a tre
28b0: 65 20 73 65 61 72 63 68 69 6e 67 20 70 61 74 74  e searching patt
28c0: 65 72 6e 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 79  ern...(define-sy
28d0: 6e 74 61 78 20 6d 61 74 63 68 2d 67 65 6e 2d 65  ntax match-gen-e
28e0: 6c 6c 69 70 73 65 73 0a 20 20 28 73 79 6e 74 61  llipses.  (synta
28f0: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28  x-rules ().    (
2900: 28 5f 20 76 20 70 20 28 29 20 67 20 73 20 28 73  (_ v p () g s (s
2910: 6b 20 2e 2e 2e 29 20 66 6b 20 69 20 28 28 69 64  k ...) fk i ((id
2920: 20 69 64 2d 6c 73 29 20 2e 2e 2e 29 29 0a 20 20   id-ls) ...)).  
2930: 20 20 20 28 6d 61 74 63 68 2d 63 68 65 63 6b 2d     (match-check-
2940: 69 64 65 6e 74 69 66 69 65 72 20 70 0a 20 20 20  identifier p.   
2950: 20 20 20 20 3b 3b 20 73 69 6d 70 6c 65 73 74 20      ;; simplest 
2960: 63 61 73 65 20 65 71 75 69 76 61 6c 65 6e 74 20  case equivalent 
2970: 74 6f 20 28 20 2e 20 70 29 2c 20 6a 75 73 74 20  to ( . p), just 
2980: 62 69 6e 64 20 74 68 65 20 6c 69 73 74 0a 20 20  bind the list.  
2990: 20 20 20 20 20 28 6c 65 74 20 28 28 70 20 76 29       (let ((p v)
29a0: 29 0a 20 20 20 20 20 20 20 20 20 28 69 66 20 28  ).         (if (
29b0: 6c 69 73 74 3f 20 70 29 0a 20 20 20 20 20 20 20  list? p).       
29c0: 20 20 20 20 20 20 28 73 6b 20 2e 2e 2e 20 69 29        (sk ... i)
29d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 66 6b  .             fk
29e0: 29 29 0a 20 20 20 20 20 20 20 3b 3b 20 73 69 6d  )).       ;; sim
29f0: 70 6c 65 20 63 61 73 65 2c 20 6d 61 74 63 68 20  ple case, match 
2a00: 61 6c 6c 20 65 6c 65 6d 65 6e 74 73 20 6f 66 20  all elements of 
2a10: 74 68 65 20 6c 69 73 74 0a 20 20 20 20 20 20 20  the list.       
2a20: 28 6c 65 74 20 6c 6f 6f 70 20 28 28 6c 73 20 76  (let loop ((ls v
2a30: 29 20 28 69 64 2d 6c 73 20 27 28 29 29 20 2e 2e  ) (id-ls '()) ..
2a40: 2e 29 0a 20 20 20 20 20 20 20 20 20 28 63 6f 6e  .).         (con
2a50: 64 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 6e  d.           ((n
2a60: 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 20  ull? ls).       
2a70: 20 20 20 20 20 28 6c 65 74 20 28 28 69 64 20 28       (let ((id (
2a80: 72 65 76 65 72 73 65 20 69 64 2d 6c 73 29 29 20  reverse id-ls)) 
2a90: 2e 2e 2e 29 20 28 73 6b 20 2e 2e 2e 20 69 29 29  ...) (sk ... i))
2aa0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 70  ).           ((p
2ab0: 61 69 72 3f 20 6c 73 29 0a 20 20 20 20 20 20 20  air? ls).       
2ac0: 20 20 20 20 20 28 6c 65 74 20 28 28 77 20 28 63       (let ((w (c
2ad0: 61 72 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20  ar ls))).       
2ae0: 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 6f 6e         (match-on
2af0: 65 20 77 20 70 20 28 63 61 72 20 6c 73 29 20 28  e w p (car ls) (
2b00: 73 65 74 2d 63 61 72 21 20 6c 73 29 0a 20 20 20  set-car! ls).   
2b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2b20: 20 20 20 20 20 20 28 6d 61 74 63 68 2d 64 72 6f        (match-dro
2b30: 70 2d 69 64 73 20 28 6c 6f 6f 70 20 28 63 64 72  p-ids (loop (cdr
2b40: 20 6c 73 29 20 28 63 6f 6e 73 20 69 64 20 69 64   ls) (cons id id
2b50: 2d 6c 73 29 20 2e 2e 2e 29 29 0a 20 20 20 20 20  -ls) ...)).     
2b60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2b70: 20 20 20 20 66 6b 20 69 29 29 29 0a 20 20 20 20      fk i))).    
2b80: 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20         (else.   
2b90: 20 20 20 20 20 20 20 20 20 66 6b 29 29 29 29 29           fk)))))
2ba0: 0a 20 20 20 20 28 28 5f 20 76 20 70 20 28 72 20  .    ((_ v p (r 
2bb0: 2e 2e 2e 29 20 67 20 73 20 28 73 6b 20 2e 2e 2e  ...) g s (sk ...
2bc0: 29 20 66 6b 20 69 20 28 28 69 64 20 69 64 2d 6c  ) fk i ((id id-l
2bd0: 73 29 20 2e 2e 2e 29 29 0a 20 20 20 20 20 3b 3b  s) ...)).     ;;
2be0: 20 67 65 6e 65 72 61 6c 20 63 61 73 65 2c 20 74   general case, t
2bf0: 72 61 69 6c 69 6e 67 20 70 61 74 74 65 72 6e 73  railing patterns
2c00: 20 74 6f 20 6d 61 74 63 68 0a 20 20 20 20 20 28   to match.     (
2c10: 6d 61 74 63 68 2d 76 65 72 69 66 79 2d 6e 6f 2d  match-verify-no-
2c20: 65 6c 6c 69 70 73 65 73 0a 20 20 20 20 20 20 28  ellipses.      (
2c30: 72 20 2e 2e 2e 29 0a 20 20 20 20 20 20 28 6c 65  r ...).      (le
2c40: 74 2a 20 28 28 74 61 69 6c 2d 6c 65 6e 20 28 6c  t* ((tail-len (l
2c50: 65 6e 67 74 68 20 27 28 72 20 2e 2e 2e 29 29 29  ength '(r ...)))
2c60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c  .             (l
2c70: 73 20 76 29 0a 20 20 20 20 20 20 20 20 20 20 20  s v).           
2c80: 20 20 28 6c 65 6e 20 28 6c 65 6e 67 74 68 20 6c    (len (length l
2c90: 73 29 29 29 0a 20 20 20 20 20 20 20 20 28 69 66  s))).        (if
2ca0: 20 28 3c 20 6c 65 6e 20 74 61 69 6c 2d 6c 65 6e   (< len tail-len
2cb0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 66 6b  ).            fk
2cc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65  .            (le
2cd0: 74 20 6c 6f 6f 70 20 28 28 6c 73 20 6c 73 29 20  t loop ((ls ls) 
2ce0: 28 6e 20 6c 65 6e 29 20 28 69 64 2d 6c 73 20 27  (n len) (id-ls '
2cf0: 28 29 29 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20  ()) ...).       
2d00: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20         (cond.   
2d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 3d               ((=
2d20: 20 6e 20 74 61 69 6c 2d 6c 65 6e 29 0a 20 20 20   n tail-len).   
2d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c                (l
2d40: 65 74 20 28 28 69 64 20 28 72 65 76 65 72 73 65  et ((id (reverse
2d50: 20 69 64 2d 6c 73 29 29 20 2e 2e 2e 29 0a 20 20   id-ls)) ...).  
2d60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2d70: 20 28 6d 61 74 63 68 2d 6f 6e 65 20 6c 73 20 28   (match-one ls (
2d80: 72 20 2e 2e 2e 29 20 23 66 20 23 66 20 28 73 6b  r ...) #f #f (sk
2d90: 20 2e 2e 2e 20 69 29 20 66 6b 20 69 29 29 29 0a   ... i) fk i))).
2da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2db0: 28 28 70 61 69 72 3f 20 6c 73 29 0a 20 20 20 20  ((pair? ls).    
2dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65               (le
2dd0: 74 20 28 28 77 20 28 63 61 72 20 6c 73 29 29 29  t ((w (car ls)))
2de0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
2df0: 20 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65 20 77      (match-one w
2e00: 20 70 20 28 63 61 72 20 6c 73 29 20 28 73 65 74   p (car ls) (set
2e10: 2d 63 61 72 21 20 6c 73 29 0a 20 20 20 20 20 20  -car! ls).      
2e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e30: 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 64          (match-d
2e40: 72 6f 70 2d 69 64 73 0a 20 20 20 20 20 20 20 20  rop-ids.        
2e50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2e60: 20 20 20 20 20 20 20 28 6c 6f 6f 70 20 28 63 64         (loop (cd
2e70: 72 20 6c 73 29 20 28 2d 20 6e 20 31 29 20 28 63  r ls) (- n 1) (c
2e80: 6f 6e 73 20 69 64 20 69 64 2d 6c 73 29 20 2e 2e  ons id id-ls) ..
2e90: 2e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20  .)).            
2ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2eb0: 20 20 66 6b 0a 20 20 20 20 20 20 20 20 20 20 20    fk.           
2ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
2ed0: 20 20 20 69 29 29 29 0a 20 20 20 20 20 20 20 20     i))).        
2ee0: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20          (else.  
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 66                 f
2f00: 6b 29 29 29 29 29 29 29 0a 20 20 20 20 29 29 0a  k))))))).    )).
2f10: 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20  .(define-syntax 
2f20: 6d 61 74 63 68 2d 76 65 72 69 66 79 2d 6e 6f 2d  match-verify-no-
2f30: 65 6c 6c 69 70 73 65 73 0a 20 20 28 73 79 6e 74  ellipses.  (synt
2f40: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20  ax-rules ().    
2f50: 28 28 5f 20 28 78 20 2e 20 79 29 20 73 6b 29 0a  ((_ (x . y) sk).
2f60: 20 20 20 20 20 28 6d 61 74 63 68 2d 63 68 65 63       (match-chec
2f70: 6b 2d 65 6c 6c 69 70 73 65 0a 20 20 20 20 20 20  k-ellipse.      
2f80: 78 0a 20 20 20 20 20 20 28 6d 61 74 63 68 2d 73  x.      (match-s
2f90: 79 6e 74 61 78 2d 65 72 72 6f 72 0a 20 20 20 20  yntax-error.    
2fa0: 20 20 20 22 6d 75 6c 74 69 70 6c 65 20 65 6c 6c     "multiple ell
2fb0: 69 70 73 65 20 70 61 74 74 65 72 6e 73 20 6e 6f  ipse patterns no
2fc0: 74 20 61 6c 6c 6f 77 65 64 20 61 74 20 73 61 6d  t allowed at sam
2fd0: 65 20 6c 65 76 65 6c 22 29 0a 20 20 20 20 20 20  e level").      
2fe0: 28 6d 61 74 63 68 2d 76 65 72 69 66 79 2d 6e 6f  (match-verify-no
2ff0: 2d 65 6c 6c 69 70 73 65 73 20 79 20 73 6b 29 29  -ellipses y sk))
3000: 29 0a 20 20 20 20 28 28 5f 20 78 20 73 6b 29 20  ).    ((_ x sk) 
3010: 73 6b 29 0a 20 20 20 20 29 29 0a 0a 3b 3b 20 56  sk).    ))..;; V
3020: 65 63 74 6f 72 20 70 61 74 74 65 72 6e 73 20 61  ector patterns a
3030: 72 65 20 6a 75 73 74 20 6d 6f 72 65 20 6f 66 20  re just more of 
3040: 74 68 65 20 73 61 6d 65 2c 20 77 69 74 68 20 74  the same, with t
3050: 68 65 20 73 6c 69 67 68 74 0a 3b 3b 20 65 78 63  he slight.;; exc
3060: 65 70 74 69 6f 6e 20 74 68 61 74 20 77 65 20 70  eption that we p
3070: 61 73 73 20 61 72 6f 75 6e 64 20 74 68 65 20 63  ass around the c
3080: 75 72 72 65 6e 74 20 76 65 63 74 6f 72 20 69 6e  urrent vector in
3090: 64 65 78 20 62 65 69 6e 67 0a 3b 3b 20 6d 61 74  dex being.;; mat
30a0: 63 68 65 64 2e 0a 0a 28 64 65 66 69 6e 65 2d 73  ched...(define-s
30b0: 79 6e 74 61 78 20 6d 61 74 63 68 2d 76 65 63 74  yntax match-vect
30c0: 6f 72 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c  or.  (syntax-rul
30d0: 65 73 20 28 5f 5f 5f 29 0a 20 20 20 20 28 28 5f  es (___).    ((_
30e0: 20 76 20 6e 20 70 61 74 73 20 28 70 20 71 29 20   v n pats (p q) 
30f0: 73 6b 20 66 6b 20 69 29 0a 20 20 20 20 20 28 6d  sk fk i).     (m
3100: 61 74 63 68 2d 63 68 65 63 6b 2d 65 6c 6c 69 70  atch-check-ellip
3110: 73 65 20 71 0a 20 20 20 20 20 20 20 20 20 20 20  se q.           
3120: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
3130: 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d 65 6c 6c  match-vector-ell
3140: 69 70 73 65 73 20 76 20 6e 20 70 61 74 73 20 70  ipses v n pats p
3150: 20 73 6b 20 66 6b 20 69 29 0a 20 20 20 20 20 20   sk fk i).      
3160: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3170: 20 20 20 20 28 6d 61 74 63 68 2d 76 65 63 74 6f      (match-vecto
3180: 72 2d 74 77 6f 20 76 20 6e 20 70 61 74 73 20 28  r-two v n pats (
3190: 70 20 71 29 20 73 6b 20 66 6b 20 69 29 29 29 0a  p q) sk fk i))).
31a0: 20 20 20 20 28 28 5f 20 76 20 6e 20 70 61 74 73      ((_ v n pats
31b0: 20 28 70 20 5f 5f 5f 29 20 73 6b 20 66 6b 20 69   (p ___) sk fk i
31c0: 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 76 65  ).     (match-ve
31d0: 63 74 6f 72 2d 65 6c 6c 69 70 73 65 73 20 76 20  ctor-ellipses v 
31e0: 6e 20 70 61 74 73 20 70 20 73 6b 20 66 6b 20 69  n pats p sk fk i
31f0: 29 29 0a 20 20 20 20 28 28 5f 20 2e 20 78 29 0a  )).    ((_ . x).
3200: 20 20 20 20 20 28 6d 61 74 63 68 2d 76 65 63 74       (match-vect
3210: 6f 72 2d 74 77 6f 20 2e 20 78 29 29 29 29 0a 0a  or-two . x))))..
3220: 3b 3b 20 43 68 65 63 6b 20 74 68 65 20 65 78 61  ;; Check the exa
3230: 63 74 20 76 65 63 74 6f 72 20 6c 65 6e 67 74 68  ct vector length
3240: 2c 20 74 68 65 6e 20 63 68 65 63 6b 20 65 61 63  , then check eac
3250: 68 20 65 6c 65 6d 65 6e 74 20 69 6e 20 74 75 72  h element in tur
3260: 6e 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74  n...(define-synt
3270: 61 78 20 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d  ax match-vector-
3280: 74 77 6f 0a 20 20 28 73 79 6e 74 61 78 2d 72 75  two.  (syntax-ru
3290: 6c 65 73 20 28 29 0a 20 20 20 20 28 28 5f 20 76  les ().    ((_ v
32a0: 20 6e 20 28 28 70 61 74 20 69 6e 64 65 78 29 20   n ((pat index) 
32b0: 2e 2e 2e 29 20 28 29 20 73 6b 20 66 6b 20 69 29  ...) () sk fk i)
32c0: 0a 20 20 20 20 20 28 69 66 20 28 76 65 63 74 6f  .     (if (vecto
32d0: 72 3f 20 76 29 0a 20 20 20 20 20 20 20 28 6c 65  r? v).       (le
32e0: 74 20 28 28 6c 65 6e 20 28 76 65 63 74 6f 72 2d  t ((len (vector-
32f0: 6c 65 6e 67 74 68 20 76 29 29 29 0a 20 20 20 20  length v))).    
3300: 20 20 20 20 20 28 69 66 20 28 3d 20 6c 65 6e 20       (if (= len 
3310: 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 6d  n).           (m
3320: 61 74 63 68 2d 76 65 63 74 6f 72 2d 73 74 65 70  atch-vector-step
3330: 20 76 20 28 28 70 61 74 20 69 6e 64 65 78 29 20   v ((pat index) 
3340: 2e 2e 2e 29 20 73 6b 20 66 6b 20 69 29 0a 20 20  ...) sk fk i).  
3350: 20 20 20 20 20 20 20 20 20 66 6b 29 29 0a 20 20           fk)).  
3360: 20 20 20 20 20 66 6b 29 29 0a 20 20 20 20 28 28       fk)).    ((
3370: 5f 20 76 20 6e 20 28 70 61 74 73 20 2e 2e 2e 29  _ v n (pats ...)
3380: 20 28 70 20 2e 20 71 29 20 73 6b 20 66 6b 20 69   (p . q) sk fk i
3390: 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 76 65  ).     (match-ve
33a0: 63 74 6f 72 20 76 20 28 2b 20 6e 20 31 29 20 28  ctor v (+ n 1) (
33b0: 70 61 74 73 20 2e 2e 2e 20 28 70 20 6e 29 29 20  pats ... (p n)) 
33c0: 71 20 73 6b 20 66 6b 20 69 29 29 0a 20 20 20 20  q sk fk i)).    
33d0: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74  ))..(define-synt
33e0: 61 78 20 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d  ax match-vector-
33f0: 73 74 65 70 0a 20 20 28 73 79 6e 74 61 78 2d 72  step.  (syntax-r
3400: 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 5f 20  ules ().    ((_ 
3410: 76 20 28 29 20 28 73 6b 20 2e 2e 2e 29 20 66 6b  v () (sk ...) fk
3420: 20 69 29 20 28 73 6b 20 2e 2e 2e 20 69 29 29 0a   i) (sk ... i)).
3430: 20 20 20 20 28 28 5f 20 76 20 28 28 70 61 74 20      ((_ v ((pat 
3440: 69 6e 64 65 78 29 20 2e 20 72 65 73 74 29 20 73  index) . rest) s
3450: 6b 20 66 6b 20 69 29 0a 20 20 20 20 20 28 6c 65  k fk i).     (le
3460: 74 20 28 28 77 20 28 76 65 63 74 6f 72 2d 72 65  t ((w (vector-re
3470: 66 20 76 20 69 6e 64 65 78 29 29 29 0a 20 20 20  f v index))).   
3480: 20 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65 20 77      (match-one w
3490: 20 70 61 74 20 28 76 65 63 74 6f 72 2d 72 65 66   pat (vector-ref
34a0: 20 76 20 69 6e 64 65 78 29 20 28 76 65 63 74 6f   v index) (vecto
34b0: 72 2d 73 65 74 21 20 76 20 69 6e 64 65 78 29 0a  r-set! v index).
34c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
34d0: 20 20 28 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d    (match-vector-
34e0: 73 74 65 70 20 76 20 72 65 73 74 20 73 6b 20 66  step v rest sk f
34f0: 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  k).             
3500: 20 20 20 20 20 66 6b 20 69 29 29 29 29 29 0a 0a       fk i)))))..
3510: 3b 3b 20 57 69 74 68 20 61 20 76 65 63 74 6f 72  ;; With a vector
3520: 20 65 6c 6c 69 70 73 65 20 70 61 74 74 65 72 6e   ellipse pattern
3530: 20 77 65 20 66 69 72 73 74 20 63 68 65 63 6b 20   we first check 
3540: 74 6f 20 73 65 65 20 69 66 20 74 68 65 20 76 65  to see if the ve
3550: 63 74 6f 72 0a 3b 3b 20 6c 65 6e 67 74 68 20 69  ctor.;; length i
3560: 73 20 61 74 20 6c 65 61 73 74 20 74 68 65 20 72  s at least the r
3570: 65 71 75 69 72 65 64 20 6c 65 6e 67 74 68 2e 0a  equired length..
3580: 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20  .(define-syntax 
3590: 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d 65 6c 6c  match-vector-ell
35a0: 69 70 73 65 73 0a 20 20 28 73 79 6e 74 61 78 2d  ipses.  (syntax-
35b0: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 5f  rules ().    ((_
35c0: 20 76 20 6e 20 28 28 70 61 74 20 69 6e 64 65 78   v n ((pat index
35d0: 29 20 2e 2e 2e 29 20 70 20 73 6b 20 66 6b 20 69  ) ...) p sk fk i
35e0: 29 0a 20 20 20 20 20 28 69 66 20 28 76 65 63 74  ).     (if (vect
35f0: 6f 72 3f 20 76 29 0a 20 20 20 20 20 20 20 28 6c  or? v).       (l
3600: 65 74 20 28 28 6c 65 6e 20 28 76 65 63 74 6f 72  et ((len (vector
3610: 2d 6c 65 6e 67 74 68 20 76 29 29 29 0a 20 20 20  -length v))).   
3620: 20 20 20 20 20 20 28 69 66 20 28 3e 3d 20 6c 65        (if (>= le
3630: 6e 20 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20  n n).           
3640: 28 6d 61 74 63 68 2d 76 65 63 74 6f 72 2d 73 74  (match-vector-st
3650: 65 70 20 76 20 28 28 70 61 74 20 69 6e 64 65 78  ep v ((pat index
3660: 29 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20  ) ...).         
3670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
3680: 20 20 20 20 20 28 6d 61 74 63 68 2d 76 65 63 74       (match-vect
3690: 6f 72 2d 74 61 69 6c 20 76 20 70 20 6e 20 6c 65  or-tail v p n le
36a0: 6e 20 73 6b 20 66 6b 29 0a 20 20 20 20 20 20 20  n sk fk).       
36b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
36c0: 20 20 20 20 20 20 20 66 6b 20 69 29 0a 20 20 20         fk i).   
36d0: 20 20 20 20 20 20 20 20 66 6b 29 29 0a 20 20 20          fk)).   
36e0: 20 20 20 20 66 6b 29 29 29 29 0a 0a 28 64 65 66      fk))))..(def
36f0: 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68  ine-syntax match
3700: 2d 76 65 63 74 6f 72 2d 74 61 69 6c 0a 20 20 28  -vector-tail.  (
3710: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a  syntax-rules ().
3720: 20 20 20 20 28 28 5f 20 76 20 70 20 6e 20 6c 65      ((_ v p n le
3730: 6e 20 73 6b 20 66 6b 20 69 29 0a 20 20 20 20 20  n sk fk i).     
3740: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76  (match-extract-v
3750: 61 72 73 20 70 20 28 6d 61 74 63 68 2d 76 65 63  ars p (match-vec
3760: 74 6f 72 2d 74 61 69 6c 2d 74 77 6f 20 76 20 70  tor-tail-two v p
3770: 20 6e 20 6c 65 6e 20 73 6b 20 66 6b 20 69 29 20   n len sk fk i) 
3780: 69 20 28 29 29 29 29 29 0a 0a 28 64 65 66 69 6e  i ()))))..(defin
3790: 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d 76  e-syntax match-v
37a0: 65 63 74 6f 72 2d 74 61 69 6c 2d 74 77 6f 0a 20  ector-tail-two. 
37b0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28   (syntax-rules (
37c0: 29 0a 20 20 20 20 28 28 5f 20 76 20 70 20 6e 20  ).    ((_ v p n 
37d0: 6c 65 6e 20 28 73 6b 20 2e 2e 2e 29 20 66 6b 20  len (sk ...) fk 
37e0: 69 20 28 28 69 64 20 69 64 2d 6c 73 29 20 2e 2e  i ((id id-ls) ..
37f0: 2e 29 29 0a 20 20 20 20 20 28 6c 65 74 20 6c 6f  .)).     (let lo
3800: 6f 70 20 28 28 6a 20 6e 29 20 28 69 64 2d 6c 73  op ((j n) (id-ls
3810: 20 27 28 29 29 20 2e 2e 2e 29 0a 20 20 20 20 20   '()) ...).     
3820: 20 20 28 69 66 20 28 3e 3d 20 6a 20 6c 65 6e 29    (if (>= j len)
3830: 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28  .         (let (
3840: 28 69 64 20 28 72 65 76 65 72 73 65 20 69 64 2d  (id (reverse id-
3850: 6c 73 29 29 20 2e 2e 2e 29 20 28 73 6b 20 2e 2e  ls)) ...) (sk ..
3860: 2e 20 69 29 29 0a 20 20 20 20 20 20 20 20 20 28  . i)).         (
3870: 6c 65 74 20 28 28 77 20 28 76 65 63 74 6f 72 2d  let ((w (vector-
3880: 72 65 66 20 76 20 6a 29 29 29 0a 20 20 20 20 20  ref v j))).     
3890: 20 20 20 20 20 20 28 6d 61 74 63 68 2d 6f 6e 65        (match-one
38a0: 20 77 20 70 20 28 76 65 63 74 6f 72 2d 72 65 66   w p (vector-ref
38b0: 20 76 20 6a 29 20 28 76 65 74 6f 72 2d 73 65 74   v j) (vetor-set
38c0: 21 20 76 20 6a 29 0a 20 20 20 20 20 20 20 20 20  ! v j).         
38d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61               (ma
38e0: 74 63 68 2d 64 72 6f 70 2d 69 64 73 20 28 6c 6f  tch-drop-ids (lo
38f0: 6f 70 20 28 2b 20 6a 20 31 29 20 28 63 6f 6e 73  op (+ j 1) (cons
3900: 20 69 64 20 69 64 2d 6c 73 29 20 2e 2e 2e 29 29   id id-ls) ...))
3910: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
3920: 20 20 20 20 20 20 20 66 6b 20 69 29 29 29 29 29         fk i)))))
3930: 29 29 0a 0a 3b 3b 20 45 78 74 72 61 63 74 20 61  ))..;; Extract a
3940: 6c 6c 20 69 64 65 6e 74 69 66 69 65 72 73 20 69  ll identifiers i
3950: 6e 20 61 20 70 61 74 74 65 72 6e 2e 20 20 41 20  n a pattern.  A 
3960: 6c 69 74 74 6c 65 20 6d 6f 72 65 20 63 6f 6d 70  little more comp
3970: 6c 69 63 61 74 65 64 0a 3b 3b 20 74 68 61 6e 20  licated.;; than 
3980: 6a 75 73 74 20 6c 6f 6f 6b 69 6e 67 20 66 6f 72  just looking for
3990: 20 73 79 6d 62 6f 6c 73 2c 20 77 65 20 6e 65 65   symbols, we nee
39a0: 64 20 74 6f 20 69 67 6e 6f 72 65 20 73 70 65 63  d to ignore spec
39b0: 69 61 6c 20 6b 65 79 77 6f 72 64 73 0a 3b 3b 20  ial keywords.;; 
39c0: 61 6e 64 20 6e 6f 74 20 70 61 74 74 65 72 6e 20  and not pattern 
39d0: 66 6f 72 6d 73 20 28 73 75 63 68 20 61 73 20 74  forms (such as t
39e0: 68 65 20 70 72 65 64 69 63 61 74 65 20 65 78 70  he predicate exp
39f0: 72 65 73 73 69 6f 6e 20 69 6e 20 3f 0a 3b 3b 20  ression in ?.;; 
3a00: 70 61 74 74 65 72 6e 73 29 2e 0a 3b 3b 0a 3b 3b  patterns)..;;.;;
3a10: 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d   (match-extract-
3a20: 76 61 72 73 20 70 61 74 74 65 72 6e 20 63 6f 6e  vars pattern con
3a30: 74 69 6e 75 61 74 69 6f 6e 20 28 69 64 73 20 2e  tinuation (ids .
3a40: 2e 2e 29 20 28 6e 65 77 2d 76 61 72 73 20 2e 2e  ..) (new-vars ..
3a50: 2e 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e  .))..(define-syn
3a60: 74 61 78 20 6d 61 74 63 68 2d 65 78 74 72 61 63  tax match-extrac
3a70: 74 2d 76 61 72 73 0a 20 20 28 73 79 6e 74 61 78  t-vars.  (syntax
3a80: 2d 72 75 6c 65 73 20 28 5f 20 5f 5f 5f 20 3f 20  -rules (_ ___ ? 
3a90: 24 20 3d 20 71 75 6f 74 65 20 71 75 61 73 69 71  $ = quote quasiq
3aa0: 75 6f 74 65 20 61 6e 64 20 6f 72 20 6e 6f 74 20  uote and or not 
3ab0: 67 65 74 21 20 73 65 74 21 29 0a 20 20 20 20 28  get! set!).    (
3ac0: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76  (match-extract-v
3ad0: 61 72 73 20 28 3f 20 70 72 65 64 20 2e 20 70 29  ars (? pred . p)
3ae0: 20 6b 20 69 20 76 29 0a 20 20 20 20 20 28 6d 61   k i v).     (ma
3af0: 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73  tch-extract-vars
3b00: 20 70 20 6b 20 69 20 76 29 29 0a 20 20 20 20 28   p k i v)).    (
3b10: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76  (match-extract-v
3b20: 61 72 73 20 28 24 20 72 65 63 20 2e 20 70 29 20  ars ($ rec . p) 
3b30: 6b 20 69 20 76 29 0a 20 20 20 20 20 28 6d 61 74  k i v).     (mat
3b40: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20  ch-extract-vars 
3b50: 70 20 6b 20 69 20 76 29 29 0a 20 20 20 20 28 28  p k i v)).    ((
3b60: 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61  match-extract-va
3b70: 72 73 20 28 3d 20 70 72 6f 63 20 70 29 20 6b 20  rs (= proc p) k 
3b80: 69 20 76 29 0a 20 20 20 20 20 28 6d 61 74 63 68  i v).     (match
3b90: 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 70 20  -extract-vars p 
3ba0: 6b 20 69 20 76 29 29 0a 20 20 20 20 28 28 6d 61  k i v)).    ((ma
3bb0: 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73  tch-extract-vars
3bc0: 20 28 71 75 6f 74 65 20 78 29 20 28 6b 20 2e 2e   (quote x) (k ..
3bd0: 2e 29 20 69 20 76 29 0a 20 20 20 20 20 28 6b 20  .) i v).     (k 
3be0: 2e 2e 2e 20 76 29 29 0a 20 20 20 20 28 28 6d 61  ... v)).    ((ma
3bf0: 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73  tch-extract-vars
3c00: 20 28 71 75 61 73 69 71 75 6f 74 65 20 78 29 20   (quasiquote x) 
3c10: 6b 20 69 20 76 29 0a 20 20 20 20 20 28 6d 61 74  k i v).     (mat
3c20: 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69  ch-extract-quasi
3c30: 71 75 6f 74 65 2d 76 61 72 73 20 78 20 6b 20 69  quote-vars x k i
3c40: 20 76 20 28 23 74 29 29 29 0a 20 20 20 20 28 28   v (#t))).    ((
3c50: 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61  match-extract-va
3c60: 72 73 20 28 61 6e 64 20 2e 20 70 29 20 6b 20 69  rs (and . p) k i
3c70: 20 76 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d   v).     (match-
3c80: 65 78 74 72 61 63 74 2d 76 61 72 73 20 70 20 6b  extract-vars p k
3c90: 20 69 20 76 29 29 0a 20 20 20 20 28 28 6d 61 74   i v)).    ((mat
3ca0: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20  ch-extract-vars 
3cb0: 28 6f 72 20 2e 20 70 29 20 6b 20 69 20 76 29 0a  (or . p) k i v).
3cc0: 20 20 20 20 20 28 6d 61 74 63 68 2d 65 78 74 72       (match-extr
3cd0: 61 63 74 2d 76 61 72 73 20 70 20 6b 20 69 20 76  act-vars p k i v
3ce0: 29 29 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 65  )).    ((match-e
3cf0: 78 74 72 61 63 74 2d 76 61 72 73 20 28 6e 6f 74  xtract-vars (not
3d00: 20 2e 20 70 29 20 6b 20 69 20 76 29 0a 20 20 20   . p) k i v).   
3d10: 20 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74    (match-extract
3d20: 2d 76 61 72 73 20 70 20 6b 20 69 20 76 29 29 0a  -vars p k i v)).
3d30: 20 20 20 20 3b 3b 20 41 20 6e 6f 6e 2d 6b 65 79      ;; A non-key
3d40: 77 6f 72 64 20 70 61 69 72 2c 20 65 78 70 61 6e  word pair, expan
3d50: 64 20 74 68 65 20 43 41 52 20 77 69 74 68 20 61  d the CAR with a
3d60: 20 63 6f 6e 74 69 6e 75 61 74 69 6f 6e 20 74 6f   continuation to
3d70: 0a 20 20 20 20 3b 3b 20 65 78 70 61 6e 64 20 74  .    ;; expand t
3d80: 68 65 20 43 44 52 2e 0a 20 20 20 20 28 28 6d 61  he CDR..    ((ma
3d90: 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73  tch-extract-vars
3da0: 20 28 70 20 71 20 2e 20 72 29 20 6b 20 69 20 76   (p q . r) k i v
3db0: 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 63 68  ).     (match-ch
3dc0: 65 63 6b 2d 65 6c 6c 69 70 73 65 0a 20 20 20 20  eck-ellipse.    
3dd0: 20 20 71 0a 20 20 20 20 20 20 28 6d 61 74 63 68    q.      (match
3de0: 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 28 70  -extract-vars (p
3df0: 20 2e 20 72 29 20 6b 20 69 20 76 29 0a 20 20 20   . r) k i v).   
3e00: 20 20 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63     (match-extrac
3e10: 74 2d 76 61 72 73 20 70 20 28 6d 61 74 63 68 2d  t-vars p (match-
3e20: 65 78 74 72 61 63 74 2d 76 61 72 73 2d 73 74 65  extract-vars-ste
3e30: 70 20 28 71 20 2e 20 72 29 20 6b 20 69 20 76 29  p (q . r) k i v)
3e40: 20 69 20 28 29 29 29 29 0a 20 20 20 20 28 28 6d   i ()))).    ((m
3e50: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72  atch-extract-var
3e60: 73 20 28 70 20 2e 20 71 29 20 6b 20 69 20 76 29  s (p . q) k i v)
3e70: 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 65 78 74  .     (match-ext
3e80: 72 61 63 74 2d 76 61 72 73 20 70 20 28 6d 61 74  ract-vars p (mat
3e90: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 2d  ch-extract-vars-
3ea0: 73 74 65 70 20 71 20 6b 20 69 20 76 29 20 69 20  step q k i v) i 
3eb0: 28 29 29 29 0a 20 20 20 20 28 28 6d 61 74 63 68  ())).    ((match
3ec0: 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20 23 28  -extract-vars #(
3ed0: 70 20 2e 2e 2e 29 20 6b 20 69 20 76 29 0a 20 20  p ...) k i v).  
3ee0: 20 20 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63     (match-extrac
3ef0: 74 2d 76 61 72 73 20 28 70 20 2e 2e 2e 29 20 6b  t-vars (p ...) k
3f00: 20 69 20 76 29 29 0a 20 20 20 20 28 28 6d 61 74   i v)).    ((mat
3f10: 63 68 2d 65 78 74 72 61 63 74 2d 76 61 72 73 20  ch-extract-vars 
3f20: 5f 20 28 6b 20 2e 2e 2e 29 20 69 20 76 29 20 20  _ (k ...) i v)  
3f30: 20 20 28 6b 20 2e 2e 2e 20 76 29 29 0a 20 20 20    (k ... v)).   
3f40: 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74   ((match-extract
3f50: 2d 76 61 72 73 20 5f 5f 5f 20 28 6b 20 2e 2e 2e  -vars ___ (k ...
3f60: 29 20 69 20 76 29 20 20 28 6b 20 2e 2e 2e 20 76  ) i v)  (k ... v
3f70: 29 29 0a 20 20 20 20 3b 3b 20 54 68 69 73 20 69  )).    ;; This i
3f80: 73 20 74 68 65 20 6d 61 69 6e 20 70 61 72 74 2c  s the main part,
3f90: 20 74 68 65 20 6f 6e 6c 79 20 70 6c 61 63 65 20   the only place 
3fa0: 77 68 65 72 65 20 77 65 20 6d 69 67 68 74 20 61  where we might a
3fb0: 64 64 20 61 20 6e 65 77 0a 20 20 20 20 3b 3b 20  dd a new.    ;; 
3fc0: 76 61 72 20 69 66 20 69 74 27 73 20 61 6e 20 75  var if it's an u
3fd0: 6e 62 6f 75 6e 64 20 73 79 6d 62 6f 6c 2e 0a 20  nbound symbol.. 
3fe0: 20 20 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61     ((match-extra
3ff0: 63 74 2d 76 61 72 73 20 70 20 28 6b 20 2e 2e 2e  ct-vars p (k ...
4000: 29 20 28 69 20 2e 2e 2e 29 20 76 29 0a 20 20 20  ) (i ...) v).   
4010: 20 20 28 6c 65 74 2d 73 79 6e 74 61 78 0a 20 20    (let-syntax.  
4020: 20 20 20 20 20 20 20 28 28 6e 65 77 2d 73 79 6d         ((new-sym
4030: 3f 0a 20 20 20 20 20 20 20 20 20 20 20 28 73 79  ?.           (sy
4040: 6e 74 61 78 2d 72 75 6c 65 73 20 28 69 20 2e 2e  ntax-rules (i ..
4050: 2e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  .).             
4060: 28 28 6e 65 77 2d 73 79 6d 3f 20 70 20 73 6b 20  ((new-sym? p sk 
4070: 66 6b 29 20 73 6b 29 0a 20 20 20 20 20 20 20 20  fk) sk).        
4080: 20 20 20 20 20 28 28 6e 65 77 2d 73 79 6d 3f 20       ((new-sym? 
4090: 78 20 73 6b 20 66 6b 29 20 66 6b 29 29 29 29 0a  x sk fk) fk)))).
40a0: 20 20 20 20 20 20 20 28 6e 65 77 2d 73 79 6d 3f         (new-sym?
40b0: 20 72 61 6e 64 6f 6d 2d 73 79 6d 2d 74 6f 2d 6d   random-sym-to-m
40c0: 61 74 63 68 0a 20 20 20 20 20 20 20 20 20 20 20  atch.           
40d0: 20 20 20 20 20 20 28 6b 20 2e 2e 2e 20 28 28 70        (k ... ((p
40e0: 20 70 2d 6c 73 29 20 2e 20 76 29 29 0a 20 20 20   p-ls) . v)).   
40f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6b                (k
4100: 20 2e 2e 2e 20 76 29 29 29 29 0a 20 20 20 20 29   ... v)))).    )
4110: 29 0a 0a 3b 3b 20 53 74 65 70 70 65 72 20 75 73  )..;; Stepper us
4120: 65 64 20 69 6e 20 74 68 65 20 61 62 6f 76 65 20  ed in the above 
4130: 73 6f 20 69 74 20 63 61 6e 20 65 78 70 61 6e 64  so it can expand
4140: 20 74 68 65 20 43 41 52 20 61 6e 64 20 43 44 52   the CAR and CDR
4150: 0a 3b 3b 20 73 65 70 61 72 61 74 65 6c 79 2e 0a  .;; separately..
4160: 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20  .(define-syntax 
4170: 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 76 61  match-extract-va
4180: 72 73 2d 73 74 65 70 0a 20 20 28 73 79 6e 74 61  rs-step.  (synta
4190: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28  x-rules ().    (
41a0: 28 5f 20 70 20 6b 20 69 20 76 20 28 28 76 32 20  (_ p k i v ((v2 
41b0: 76 32 2d 6c 73 29 20 2e 2e 2e 29 29 0a 20 20 20  v2-ls) ...)).   
41c0: 20 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74    (match-extract
41d0: 2d 76 61 72 73 20 70 20 6b 20 28 76 32 20 2e 2e  -vars p k (v2 ..
41e0: 2e 20 2e 20 69 29 20 28 28 76 32 20 76 32 2d 6c  . . i) ((v2 v2-l
41f0: 73 29 20 2e 2e 2e 20 2e 20 76 29 29 29 0a 20 20  s) ... . v))).  
4200: 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79    ))..(define-sy
4210: 6e 74 61 78 20 6d 61 74 63 68 2d 65 78 74 72 61  ntax match-extra
4220: 63 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61  ct-quasiquote-va
4230: 72 73 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c  rs.  (syntax-rul
4240: 65 73 20 28 71 75 61 73 69 71 75 6f 74 65 20 75  es (quasiquote u
4250: 6e 71 75 6f 74 65 20 75 6e 71 75 6f 74 65 2d 73  nquote unquote-s
4260: 70 6c 69 63 69 6e 67 29 0a 20 20 20 20 28 28 6d  plicing).    ((m
4270: 61 74 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61  atch-extract-qua
4280: 73 69 71 75 6f 74 65 2d 76 61 72 73 20 28 71 75  siquote-vars (qu
4290: 61 73 69 71 75 6f 74 65 20 78 29 20 6b 20 69 20  asiquote x) k i 
42a0: 76 20 64 29 0a 20 20 20 20 20 28 6d 61 74 63 68  v d).     (match
42b0: 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69 71 75  -extract-quasiqu
42c0: 6f 74 65 2d 76 61 72 73 20 78 20 6b 20 69 20 76  ote-vars x k i v
42d0: 20 28 23 74 20 2e 20 64 29 29 29 0a 20 20 20 20   (#t . d))).    
42e0: 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d  ((match-extract-
42f0: 71 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 20  quasiquote-vars 
4300: 28 75 6e 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e  (unquote-splicin
4310: 67 20 78 29 20 6b 20 69 20 76 20 64 29 0a 20 20  g x) k i v d).  
4320: 20 20 20 28 6d 61 74 63 68 2d 65 78 74 72 61 63     (match-extrac
4330: 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61 72  t-quasiquote-var
4340: 73 20 28 75 6e 71 75 6f 74 65 20 78 29 20 6b 20  s (unquote x) k 
4350: 69 20 76 20 64 29 29 0a 20 20 20 20 28 28 6d 61  i v d)).    ((ma
4360: 74 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73  tch-extract-quas
4370: 69 71 75 6f 74 65 2d 76 61 72 73 20 28 75 6e 71  iquote-vars (unq
4380: 75 6f 74 65 20 78 29 20 6b 20 69 20 76 20 28 23  uote x) k i v (#
4390: 74 29 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d  t)).     (match-
43a0: 65 78 74 72 61 63 74 2d 76 61 72 73 20 78 20 6b  extract-vars x k
43b0: 20 69 20 76 29 29 0a 20 20 20 20 28 28 6d 61 74   i v)).    ((mat
43c0: 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69  ch-extract-quasi
43d0: 71 75 6f 74 65 2d 76 61 72 73 20 28 75 6e 71 75  quote-vars (unqu
43e0: 6f 74 65 20 78 29 20 6b 20 69 20 76 20 28 23 74  ote x) k i v (#t
43f0: 20 2e 20 64 29 29 0a 20 20 20 20 20 28 6d 61 74   . d)).     (mat
4400: 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69  ch-extract-quasi
4410: 71 75 6f 74 65 2d 76 61 72 73 20 78 20 6b 20 69  quote-vars x k i
4420: 20 76 20 64 29 29 0a 20 20 20 20 28 28 6d 61 74   v d)).    ((mat
4430: 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73 69  ch-extract-quasi
4440: 71 75 6f 74 65 2d 76 61 72 73 20 28 78 20 2e 20  quote-vars (x . 
4450: 79 29 20 6b 20 69 20 76 20 28 23 74 20 2e 20 64  y) k i v (#t . d
4460: 29 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d 65  )).     (match-e
4470: 78 74 72 61 63 74 2d 71 75 61 73 69 71 75 6f 74  xtract-quasiquot
4480: 65 2d 76 61 72 73 0a 20 20 20 20 20 20 78 0a 20  e-vars.      x. 
4490: 20 20 20 20 20 28 6d 61 74 63 68 2d 65 78 74 72       (match-extr
44a0: 61 63 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76  act-quasiquote-v
44b0: 61 72 73 2d 73 74 65 70 20 79 20 6b 20 69 20 76  ars-step y k i v
44c0: 20 64 29 20 69 20 28 29 29 29 0a 20 20 20 20 28   d) i ())).    (
44d0: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 71  (match-extract-q
44e0: 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 20 23  uasiquote-vars #
44f0: 28 78 20 2e 2e 2e 29 20 6b 20 69 20 76 20 28 23  (x ...) k i v (#
4500: 74 20 2e 20 64 29 29 0a 20 20 20 20 20 28 6d 61  t . d)).     (ma
4510: 74 63 68 2d 65 78 74 72 61 63 74 2d 71 75 61 73  tch-extract-quas
4520: 69 71 75 6f 74 65 2d 76 61 72 73 20 28 78 20 2e  iquote-vars (x .
4530: 2e 2e 29 20 6b 20 69 20 76 20 64 29 29 0a 20 20  ..) k i v d)).  
4540: 20 20 28 28 6d 61 74 63 68 2d 65 78 74 72 61 63    ((match-extrac
4550: 74 2d 71 75 61 73 69 71 75 6f 74 65 2d 76 61 72  t-quasiquote-var
4560: 73 20 78 20 28 6b 20 2e 2e 2e 29 20 69 20 76 20  s x (k ...) i v 
4570: 28 23 74 20 2e 20 64 29 29 0a 20 20 20 20 20 28  (#t . d)).     (
4580: 6b 20 2e 2e 2e 20 76 29 29 0a 20 20 20 20 29 29  k ... v)).    ))
4590: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78  ..(define-syntax
45a0: 20 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 71   match-extract-q
45b0: 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 2d 73  uasiquote-vars-s
45c0: 74 65 70 0a 20 20 28 73 79 6e 74 61 78 2d 72 75  tep.  (syntax-ru
45d0: 6c 65 73 20 28 29 0a 20 20 20 20 28 28 5f 20 78  les ().    ((_ x
45e0: 20 6b 20 69 20 76 20 64 20 28 28 76 32 20 76 32   k i v d ((v2 v2
45f0: 2d 6c 73 29 20 2e 2e 2e 29 29 0a 20 20 20 20 20  -ls) ...)).     
4600: 28 6d 61 74 63 68 2d 65 78 74 72 61 63 74 2d 71  (match-extract-q
4610: 75 61 73 69 71 75 6f 74 65 2d 76 61 72 73 20 78  uasiquote-vars x
4620: 20 6b 20 28 76 32 20 2e 2e 2e 20 2e 20 69 29 20   k (v2 ... . i) 
4630: 28 28 76 32 20 76 32 2d 6c 73 29 20 2e 2e 2e 20  ((v2 v2-ls) ... 
4640: 2e 20 76 29 20 64 29 29 0a 20 20 20 20 29 29 0a  . v) d)).    )).
4650: 0a 0a 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ..;;;;;;;;;;;;;;
4660: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
4670: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
4680: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
4690: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 47 69  ;;;;;;;;;;.;; Gi
46a0: 6d 6d 65 20 73 6f 6d 65 20 73 75 67 61 72 20 62  mme some sugar b
46b0: 61 62 79 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 79  aby...(define-sy
46c0: 6e 74 61 78 20 6d 61 74 63 68 2d 6c 61 6d 62 64  ntax match-lambd
46d0: 61 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65  a.  (syntax-rule
46e0: 73 20 28 29 0a 20 20 20 20 28 28 5f 20 63 6c 61  s ().    ((_ cla
46f0: 75 73 65 20 2e 2e 2e 29 20 28 6c 61 6d 62 64 61  use ...) (lambda
4700: 20 28 65 78 70 72 29 20 28 6d 61 74 63 68 20 65   (expr) (match e
4710: 78 70 72 20 63 6c 61 75 73 65 20 2e 2e 2e 29 29  xpr clause ...))
4720: 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e  )))..(define-syn
4730: 74 61 78 20 6d 61 74 63 68 2d 6c 61 6d 62 64 61  tax match-lambda
4740: 2a 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65  *.  (syntax-rule
4750: 73 20 28 29 0a 20 20 20 20 28 28 5f 20 63 6c 61  s ().    ((_ cla
4760: 75 73 65 20 2e 2e 2e 29 20 28 6c 61 6d 62 64 61  use ...) (lambda
4770: 20 65 78 70 72 20 28 6d 61 74 63 68 20 65 78 70   expr (match exp
4780: 72 20 63 6c 61 75 73 65 20 2e 2e 2e 29 29 29 29  r clause ...))))
4790: 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61  )..(define-synta
47a0: 78 20 6d 61 74 63 68 2d 6c 65 74 0a 20 20 28 73  x match-let.  (s
47b0: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20  yntax-rules (). 
47c0: 20 20 20 28 28 5f 20 28 76 61 72 73 20 2e 2e 2e     ((_ (vars ...
47d0: 29 20 2e 20 62 6f 64 79 29 0a 20 20 20 20 20 28  ) . body).     (
47e0: 6d 61 74 63 68 2d 6c 65 74 2f 68 65 6c 70 65 72  match-let/helper
47f0: 20 6c 65 74 20 28 29 20 28 29 20 28 76 61 72 73   let () () (vars
4800: 20 2e 2e 2e 29 20 2e 20 62 6f 64 79 29 29 0a 20   ...) . body)). 
4810: 20 20 20 28 28 5f 20 6c 6f 6f 70 20 2e 20 72 65     ((_ loop . re
4820: 73 74 29 0a 20 20 20 20 20 28 6d 61 74 63 68 2d  st).     (match-
4830: 6e 61 6d 65 64 2d 6c 65 74 20 6c 6f 6f 70 20 28  named-let loop (
4840: 29 20 2e 20 72 65 73 74 29 29 29 29 0a 0a 28 64  ) . rest))))..(d
4850: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74  efine-syntax mat
4860: 63 68 2d 6c 65 74 72 65 63 0a 20 20 28 73 79 6e  ch-letrec.  (syn
4870: 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20  tax-rules ().   
4880: 20 28 28 5f 20 76 61 72 73 20 2e 20 62 6f 64 79   ((_ vars . body
4890: 29 20 28 6d 61 74 63 68 2d 6c 65 74 2f 68 65 6c  ) (match-let/hel
48a0: 70 65 72 20 6c 65 74 72 65 63 20 28 29 20 28 29  per letrec () ()
48b0: 20 76 61 72 73 20 2e 20 62 6f 64 79 29 29 29 29   vars . body))))
48c0: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78  ..(define-syntax
48d0: 20 6d 61 74 63 68 2d 6c 65 74 2f 68 65 6c 70 65   match-let/helpe
48e0: 72 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65  r.  (syntax-rule
48f0: 73 20 28 29 0a 20 20 20 20 28 28 5f 20 6c 65 74  s ().    ((_ let
4900: 20 28 28 76 61 72 20 65 78 70 72 29 20 2e 2e 2e   ((var expr) ...
4910: 29 20 28 29 20 28 29 20 2e 20 62 6f 64 79 29 0a  ) () () . body).
4920: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 20       (let ((var 
4930: 65 78 70 72 29 20 2e 2e 2e 29 20 2e 20 62 6f 64  expr) ...) . bod
4940: 79 29 29 0a 20 20 20 20 28 28 5f 20 6c 65 74 20  y)).    ((_ let 
4950: 28 28 76 61 72 20 65 78 70 72 29 20 2e 2e 2e 29  ((var expr) ...)
4960: 20 28 28 70 61 74 20 74 6d 70 29 20 2e 2e 2e 29   ((pat tmp) ...)
4970: 20 28 29 20 2e 20 62 6f 64 79 29 0a 20 20 20 20   () . body).    
4980: 20 28 6c 65 74 20 28 28 76 61 72 20 65 78 70 72   (let ((var expr
4990: 29 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 28 6d  ) ...).       (m
49a0: 61 74 63 68 2d 6c 65 74 2a 20 28 28 70 61 74 20  atch-let* ((pat 
49b0: 74 6d 70 29 20 2e 2e 2e 29 0a 20 20 20 20 20 20  tmp) ...).      
49c0: 20 20 20 2e 20 62 6f 64 79 29 29 29 0a 20 20 20     . body))).   
49d0: 20 28 28 5f 20 6c 65 74 20 28 76 20 2e 2e 2e 29   ((_ let (v ...)
49e0: 20 28 70 20 2e 2e 2e 29 20 28 28 28 61 20 2e 20   (p ...) (((a . 
49f0: 62 29 20 65 78 70 72 29 20 2e 20 72 65 73 74 29  b) expr) . rest)
4a00: 20 2e 20 62 6f 64 79 29 0a 20 20 20 20 20 28 6d   . body).     (m
4a10: 61 74 63 68 2d 6c 65 74 2f 68 65 6c 70 65 72 0a  atch-let/helper.
4a20: 20 20 20 20 20 20 6c 65 74 20 28 76 20 2e 2e 2e        let (v ...
4a30: 20 28 74 6d 70 20 65 78 70 72 29 29 20 28 70 20   (tmp expr)) (p 
4a40: 2e 2e 2e 20 28 28 61 20 2e 20 62 29 20 74 6d 70  ... ((a . b) tmp
4a50: 29 29 20 72 65 73 74 20 2e 20 62 6f 64 79 29 29  )) rest . body))
4a60: 0a 20 20 20 20 28 28 5f 20 6c 65 74 20 28 76 20  .    ((_ let (v 
4a70: 2e 2e 2e 29 20 28 70 20 2e 2e 2e 29 20 28 28 23  ...) (p ...) ((#
4a80: 28 61 20 2e 2e 2e 29 20 65 78 70 72 29 20 2e 20  (a ...) expr) . 
4a90: 72 65 73 74 29 20 2e 20 62 6f 64 79 29 0a 20 20  rest) . body).  
4aa0: 20 20 20 28 6d 61 74 63 68 2d 6c 65 74 2f 68 65     (match-let/he
4ab0: 6c 70 65 72 0a 20 20 20 20 20 20 6c 65 74 20 28  lper.      let (
4ac0: 76 20 2e 2e 2e 20 28 74 6d 70 20 65 78 70 72 29  v ... (tmp expr)
4ad0: 29 20 28 70 20 2e 2e 2e 20 28 23 28 61 20 2e 2e  ) (p ... (#(a ..
4ae0: 2e 29 20 74 6d 70 29 29 20 72 65 73 74 20 2e 20  .) tmp)) rest . 
4af0: 62 6f 64 79 29 29 0a 20 20 20 20 28 28 5f 20 6c  body)).    ((_ l
4b00: 65 74 20 28 76 20 2e 2e 2e 29 20 28 70 20 2e 2e  et (v ...) (p ..
4b10: 2e 29 20 28 28 61 20 65 78 70 72 29 20 2e 20 72  .) ((a expr) . r
4b20: 65 73 74 29 20 2e 20 62 6f 64 79 29 0a 20 20 20  est) . body).   
4b30: 20 20 28 6d 61 74 63 68 2d 6c 65 74 2f 68 65 6c    (match-let/hel
4b40: 70 65 72 20 6c 65 74 20 28 76 20 2e 2e 2e 20 28  per let (v ... (
4b50: 61 20 65 78 70 72 29 29 20 28 70 20 2e 2e 2e 29  a expr)) (p ...)
4b60: 20 72 65 73 74 20 2e 20 62 6f 64 79 29 29 0a 20   rest . body)). 
4b70: 20 20 20 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73     ))..(define-s
4b80: 79 6e 74 61 78 20 6d 61 74 63 68 2d 6e 61 6d 65  yntax match-name
4b90: 64 2d 6c 65 74 0a 20 20 28 73 79 6e 74 61 78 2d  d-let.  (syntax-
4ba0: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 5f  rules ().    ((_
4bb0: 20 6c 6f 6f 70 20 28 28 70 61 74 20 65 78 70 72   loop ((pat expr
4bc0: 20 76 61 72 29 20 2e 2e 2e 29 20 28 29 20 2e 20   var) ...) () . 
4bd0: 62 6f 64 79 29 0a 20 20 20 20 20 28 6c 65 74 20  body).     (let 
4be0: 6c 6f 6f 70 20 28 28 76 61 72 20 65 78 70 72 29  loop ((var expr)
4bf0: 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 28 6d 61   ...).       (ma
4c00: 74 63 68 2d 6c 65 74 20 28 28 70 61 74 20 76 61  tch-let ((pat va
4c10: 72 29 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20  r) ...).        
4c20: 20 2e 20 62 6f 64 79 29 29 29 0a 20 20 20 20 28   . body))).    (
4c30: 28 5f 20 6c 6f 6f 70 20 28 76 20 2e 2e 2e 29 20  (_ loop (v ...) 
4c40: 28 28 70 61 74 20 65 78 70 72 29 20 2e 20 72 65  ((pat expr) . re
4c50: 73 74 29 20 2e 20 62 6f 64 79 29 0a 20 20 20 20  st) . body).    
4c60: 20 28 6d 61 74 63 68 2d 6e 61 6d 65 64 2d 6c 65   (match-named-le
4c70: 74 20 6c 6f 6f 70 20 28 76 20 2e 2e 2e 20 28 70  t loop (v ... (p
4c80: 61 74 20 65 78 70 72 20 74 6d 70 29 29 20 72 65  at expr tmp)) re
4c90: 73 74 20 2e 20 62 6f 64 79 29 29 29 29 0a 0a 28  st . body))))..(
4ca0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61  define-syntax ma
4cb0: 74 63 68 2d 6c 65 74 2a 0a 20 20 28 73 79 6e 74  tch-let*.  (synt
4cc0: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20  ax-rules ().    
4cd0: 28 28 5f 20 28 29 20 2e 20 62 6f 64 79 29 0a 20  ((_ () . body). 
4ce0: 20 20 20 20 28 62 65 67 69 6e 20 2e 20 62 6f 64      (begin . bod
4cf0: 79 29 29 0a 20 20 20 20 28 28 5f 20 28 28 70 61  y)).    ((_ ((pa
4d00: 74 20 65 78 70 72 29 20 2e 20 72 65 73 74 29 20  t expr) . rest) 
4d10: 2e 20 62 6f 64 79 29 0a 20 20 20 20 20 28 6d 61  . body).     (ma
4d20: 74 63 68 20 65 78 70 72 20 28 70 61 74 20 28 6d  tch expr (pat (m
4d30: 61 74 63 68 2d 6c 65 74 2a 20 72 65 73 74 20 2e  atch-let* rest .
4d40: 20 62 6f 64 79 29 29 29 29 29 29 0a 0a 0a 3b 3b   body))))))...;;
4d50: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
4d60: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
4d70: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
4d80: 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b 3b  ;;;;;;;;;;;;;;;;
4d90: 3b 3b 3b 3b 3b 3b 0a 3b 3b 20 4f 74 68 65 72 77  ;;;;;;.;; Otherw
4da0: 69 73 65 20 43 4f 4e 44 2d 45 58 50 41 4e 44 65  ise COND-EXPANDe
4db0: 64 20 62 69 74 73 2e 0a 0a 3b 3b 20 54 68 69 73  d bits...;; This
4dc0: 20 2a 73 68 6f 75 6c 64 2a 20 77 6f 72 6b 2c 20   *should* work, 
4dd0: 62 75 74 20 64 6f 65 73 6e 27 74 20 3a 28 0a 3b  but doesn't :(.;
4de0: 3b 20 20 20 28 64 65 66 69 6e 65 2d 73 79 6e 74  ;   (define-synt
4df0: 61 78 20 6d 61 74 63 68 2d 63 68 65 63 6b 2d 65  ax match-check-e
4e00: 6c 6c 69 70 73 65 0a 3b 3b 20 20 20 20 20 28 73  llipse.;;     (s
4e10: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 2e 2e 2e  yntax-rules (...
4e20: 29 0a 3b 3b 20 20 20 20 20 20 20 28 28 5f 20 2e  ).;;       ((_ .
4e30: 2e 2e 20 73 6b 20 66 6b 29 20 73 6b 29 0a 3b 3b  .. sk fk) sk).;;
4e40: 20 20 20 20 20 20 20 28 28 5f 20 78 20 73 6b 20         ((_ x sk 
4e50: 66 6b 29 20 66 6b 29 29 29 0a 0a 3b 3b 20 54 68  fk) fk)))..;; Th
4e60: 69 73 20 69 73 20 61 20 6c 69 74 74 6c 65 20 6d  is is a little m
4e70: 6f 72 65 20 63 6f 6d 70 6c 69 63 61 74 65 64 2c  ore complicated,
4e80: 20 61 6e 64 20 69 6e 74 72 6f 64 75 63 65 73 20   and introduces 
4e90: 61 20 6e 65 77 20 6c 65 74 2d 73 79 6e 74 61 78  a new let-syntax
4ea0: 2c 0a 3b 3b 20 62 75 74 20 73 68 6f 75 6c 64 20  ,.;; but should 
4eb0: 77 6f 72 6b 20 70 6f 72 74 61 62 6c 79 20 69 6e  work portably in
4ec0: 20 61 6e 79 20 52 5b 35 36 5d 52 53 20 53 63 68   any R[56]RS Sch
4ed0: 65 6d 65 2e 20 20 54 61 79 6c 6f 72 20 43 61 6d  eme.  Taylor Cam
4ee0: 70 62 65 6c 6c 0a 3b 3b 20 6f 72 69 67 69 6e 61  pbell.;; origina
4ef0: 6c 6c 79 20 63 61 6d 65 20 75 70 20 77 69 74 68  lly came up with
4f00: 20 74 68 65 20 69 64 65 61 2e 0a 28 64 65 66 69   the idea..(defi
4f10: 6e 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 2d  ne-syntax match-
4f20: 63 68 65 63 6b 2d 65 6c 6c 69 70 73 65 0a 20 20  check-ellipse.  
4f30: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29  (syntax-rules ()
4f40: 0a 20 20 20 20 3b 3b 20 74 68 65 73 65 20 74 77  .    ;; these tw
4f50: 6f 20 61 72 65 6e 27 74 20 6e 65 63 65 73 73 61  o aren't necessa
4f60: 72 79 20 62 75 74 20 70 72 6f 76 69 64 65 20 66  ry but provide f
4f70: 61 73 74 2d 63 61 73 65 20 66 61 69 6c 75 72 65  ast-case failure
4f80: 73 0a 20 20 20 20 28 28 6d 61 74 63 68 2d 63 68  s.    ((match-ch
4f90: 65 63 6b 2d 65 6c 6c 69 70 73 65 20 28 61 20 2e  eck-ellipse (a .
4fa0: 20 62 29 20 73 75 63 63 65 73 73 2d 6b 20 66 61   b) success-k fa
4fb0: 69 6c 75 72 65 2d 6b 29 20 66 61 69 6c 75 72 65  ilure-k) failure
4fc0: 2d 6b 29 0a 20 20 20 20 28 28 6d 61 74 63 68 2d  -k).    ((match-
4fd0: 63 68 65 63 6b 2d 65 6c 6c 69 70 73 65 20 23 28  check-ellipse #(
4fe0: 61 20 2e 2e 2e 29 20 73 75 63 63 65 73 73 2d 6b  a ...) success-k
4ff0: 20 66 61 69 6c 75 72 65 2d 6b 29 20 66 61 69 6c   failure-k) fail
5000: 75 72 65 2d 6b 29 0a 20 20 20 20 3b 3b 20 6d 61  ure-k).    ;; ma
5010: 74 63 68 69 6e 67 20 61 6e 20 61 74 6f 6d 0a 20  tching an atom. 
5020: 20 20 20 28 28 6d 61 74 63 68 2d 63 68 65 63 6b     ((match-check
5030: 2d 65 6c 6c 69 70 73 65 20 69 64 20 73 75 63 63  -ellipse id succ
5040: 65 73 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29  ess-k failure-k)
5050: 0a 20 20 20 20 20 28 6c 65 74 2d 73 79 6e 74 61  .     (let-synta
5060: 78 20 28 28 65 6c 6c 69 70 73 65 3f 20 28 73 79  x ((ellipse? (sy
5070: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20  ntax-rules ().  
5080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5090: 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b 20 69              ;; i
50a0: 66 66 20 60 69 64 27 20 69 73 20 60 2e 2e 2e 27  ff `id' is `...'
50b0: 20 68 65 72 65 20 74 68 65 6e 20 74 68 69 73 20   here then this 
50c0: 77 69 6c 6c 0a 20 20 20 20 20 20 20 20 20 20 20  will.           
50d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
50e0: 20 20 20 3b 3b 20 6d 61 74 63 68 20 61 20 6c 69     ;; match a li
50f0: 73 74 20 6f 66 20 61 6e 79 20 6c 65 6e 67 74 68  st of any length
5100: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20  .               
5110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28                 (
5120: 28 65 6c 6c 69 70 73 65 3f 20 28 66 6f 6f 20 69  (ellipse? (foo i
5130: 64 29 20 73 6b 20 66 6b 29 20 73 6b 29 0a 20 20  d) sk fk) sk).  
5140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20                  
5150: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 65 6c              ((el
5160: 6c 69 70 73 65 3f 20 6f 74 68 65 72 20 73 6b 20  lipse? other sk 
5170: 66 6b 29 20 66 6b 29 29 29 29 0a 20 20 20 20 20  fk) fk)))).     
5180: 20 20 3b 3b 20 74 68 69 73 20 6c 69 73 74 20 6f    ;; this list o
5190: 66 20 74 68 72 65 65 20 65 6c 65 6d 65 6e 74 73  f three elements
51a0: 20 77 69 6c 6c 20 6f 6e 6c 79 20 6d 61 6e 79 20   will only many 
51b0: 74 68 65 20 28 66 6f 6f 20 69 64 29 20 6c 69 73  the (foo id) lis
51c0: 74 0a 20 20 20 20 20 20 20 3b 3b 20 61 62 6f 76  t.       ;; abov
51d0: 65 20 69 66 20 60 69 64 27 20 69 73 20 60 2e 2e  e if `id' is `..
51e0: 2e 27 0a 20 20 20 20 20 20 20 28 65 6c 6c 69 70  .'.       (ellip
51f0: 73 65 3f 20 28 61 20 62 20 63 29 20 73 75 63 63  se? (a b c) succ
5200: 65 73 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29  ess-k failure-k)
5210: 29 29 29 29 0a 0a 0a 3b 3b 20 54 68 69 73 20 69  ))))...;; This i
5220: 73 20 70 6f 72 74 61 62 6c 65 20 62 75 74 20 63  s portable but c
5230: 61 6e 20 62 65 20 6d 6f 72 65 20 65 66 66 69 63  an be more effic
5240: 69 65 6e 74 20 77 69 74 68 20 6e 6f 6e 2d 70 6f  ient with non-po
5250: 72 74 61 62 6c 65 0a 3b 3b 20 65 78 74 65 6e 73  rtable.;; extens
5260: 69 6f 6e 73 2e 20 20 54 68 69 73 20 74 72 69 63  ions.  This tric
5270: 6b 20 77 61 73 20 6f 72 69 67 69 6e 61 6c 6c 79  k was originally
5280: 20 64 69 73 63 6f 76 65 72 65 64 20 62 79 20 4f   discovered by O
5290: 6c 65 67 20 4b 69 73 65 6c 79 6f 76 2e 0a 0a 28  leg Kiselyov...(
52a0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61  define-syntax ma
52b0: 74 63 68 2d 63 68 65 63 6b 2d 69 64 65 6e 74 69  tch-check-identi
52c0: 66 69 65 72 0a 20 20 28 73 79 6e 74 61 78 2d 72  fier.  (syntax-r
52d0: 75 6c 65 73 20 28 29 0a 20 20 20 20 3b 3b 20 66  ules ().    ;; f
52e0: 61 73 74 2d 63 61 73 65 20 66 61 69 6c 75 72 65  ast-case failure
52f0: 73 2c 20 6c 69 73 74 73 20 61 6e 64 20 76 65 63  s, lists and vec
5300: 74 6f 72 73 20 61 72 65 20 6e 6f 74 20 69 64 65  tors are not ide
5310: 6e 74 69 66 69 65 72 73 0a 20 20 20 20 28 28 5f  ntifiers.    ((_
5320: 20 28 78 20 2e 20 79 29 20 73 75 63 63 65 73 73   (x . y) success
5330: 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 20 66 61  -k failure-k) fa
5340: 69 6c 75 72 65 2d 6b 29 0a 20 20 20 20 28 28 5f  ilure-k).    ((_
5350: 20 23 28 78 20 2e 2e 2e 29 20 73 75 63 63 65 73   #(x ...) succes
5360: 73 2d 6b 20 66 61 69 6c 75 72 65 2d 6b 29 20 66  s-k failure-k) f
5370: 61 69 6c 75 72 65 2d 6b 29 0a 20 20 20 20 3b 3b  ailure-k).    ;;
5380: 20 78 20 69 73 20 61 6e 20 61 74 6f 6d 0a 20 20   x is an atom.  
5390: 20 20 28 28 5f 20 78 20 73 75 63 63 65 73 73 2d    ((_ x success-
53a0: 6b 20 66 61 69 6c 75 72 65 2d 6b 29 0a 20 20 20  k failure-k).   
53b0: 20 20 28 6c 65 74 2d 73 79 6e 74 61 78 0a 20 20    (let-syntax.  
53c0: 20 20 20 20 20 20 20 28 28 73 79 6d 3f 0a 20 20         ((sym?.  
53d0: 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78           (syntax
53e0: 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 20 20  -rules ().      
53f0: 20 20 20 20 20 20 20 3b 3b 20 69 66 20 74 68 65         ;; if the
5400: 20 73 79 6d 62 6f 6c 20 60 61 62 72 61 63 61 64   symbol `abracad
5410: 61 62 72 61 27 20 6d 61 74 63 68 65 73 20 78 2c  abra' matches x,
5420: 20 74 68 65 6e 20 78 20 69 73 20 61 0a 20 20 20   then x is a.   
5430: 20 20 20 20 20 20 20 20 20 20 3b 3b 20 73 79 6d            ;; sym
5440: 62 6f 6c 0a 20 20 20 20 20 20 20 20 20 20 20 20  bol.            
5450: 20 28 28 73 79 6d 3f 20 78 20 73 6b 20 66 6b 29   ((sym? x sk fk)
5460: 20 73 6b 29 0a 20 20 20 20 20 20 20 20 20 20 20   sk).           
5470: 20 20 3b 3b 20 6f 74 68 65 72 77 69 73 65 20 78    ;; otherwise x
5480: 20 69 73 20 61 20 6e 6f 6e 2d 73 79 6d 62 6f 6c   is a non-symbol
5490: 20 64 61 74 75 6d 0a 20 20 20 20 20 20 20 20 20   datum.         
54a0: 20 20 20 20 28 28 73 79 6d 3f 20 79 20 73 6b 20      ((sym? y sk 
54b0: 66 6b 29 20 66 6b 29 29 29 29 0a 20 20 20 20 20  fk) fk)))).     
54c0: 20 20 28 73 79 6d 3f 20 61 62 72 61 63 61 64 61    (sym? abracada
54d0: 62 72 61 20 73 75 63 63 65 73 73 2d 6b 20 66 61  bra success-k fa
54e0: 69 6c 75 72 65 2d 6b 29 29 29 0a 20 20 20 20 29  ilure-k))).    )
54f0: 29 0a                                            ).