0000: 3b 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 28 63 ;;; Copyright (c
0010: 29 20 32 30 30 30 2d 32 30 30 38 20 44 61 6e 20 ) 2000-2008 Dan
0020: 46 72 69 65 64 6d 61 6e 2c 20 45 72 69 6b 20 48 Friedman, Erik H
0030: 69 6c 73 64 61 6c 65 2c 20 61 6e 64 20 4b 65 6e ilsdale, and Ken
0040: 74 20 44 79 62 76 69 67 0a 3b 3b 3b 0a 3b 3b 3b t Dybvig.;;;.;;;
0050: 20 50 65 72 6d 69 73 73 69 6f 6e 20 69 73 20 68 Permission is h
0060: 65 72 65 62 79 20 67 72 61 6e 74 65 64 2c 20 66 ereby granted, f
0070: 72 65 65 20 6f 66 20 63 68 61 72 67 65 2c 20 74 ree of charge, t
0080: 6f 20 61 6e 79 20 70 65 72 73 6f 6e 0a 3b 3b 3b o any person.;;;
0090: 20 6f 62 74 61 69 6e 69 6e 67 20 61 20 63 6f 70 obtaining a cop
00a0: 79 20 6f 66 20 74 68 69 73 20 73 6f 66 74 77 61 y of this softwa
00b0: 72 65 20 61 6e 64 20 61 73 73 6f 63 69 61 74 65 re and associate
00c0: 64 20 64 6f 63 75 6d 65 6e 74 61 74 69 6f 6e 20 d documentation
00d0: 66 69 6c 65 73 0a 3b 3b 3b 20 28 74 68 65 20 22 files.;;; (the "
00e0: 53 6f 66 74 77 61 72 65 22 29 2c 20 74 6f 20 64 Software"), to d
00f0: 65 61 6c 20 69 6e 20 74 68 65 20 53 6f 66 74 77 eal in the Softw
0100: 61 72 65 20 77 69 74 68 6f 75 74 20 72 65 73 74 are without rest
0110: 72 69 63 74 69 6f 6e 2c 0a 3b 3b 3b 20 69 6e 63 riction,.;;; inc
0120: 6c 75 64 69 6e 67 20 77 69 74 68 6f 75 74 20 6c luding without l
0130: 69 6d 69 74 61 74 69 6f 6e 20 74 68 65 20 72 69 imitation the ri
0140: 67 68 74 73 20 74 6f 20 75 73 65 2c 20 63 6f 70 ghts to use, cop
0150: 79 2c 20 6d 6f 64 69 66 79 2c 20 6d 65 72 67 65 y, modify, merge
0160: 2c 0a 3b 3b 3b 20 70 75 62 6c 69 73 68 2c 20 64 ,.;;; publish, d
0170: 69 73 74 72 69 62 75 74 65 2c 20 73 75 62 6c 69 istribute, subli
0180: 63 65 6e 73 65 2c 20 61 6e 64 2f 6f 72 20 73 65 cense, and/or se
0190: 6c 6c 20 63 6f 70 69 65 73 20 6f 66 20 74 68 65 ll copies of the
01a0: 20 53 6f 66 74 77 61 72 65 2c 0a 3b 3b 3b 20 61 Software,.;;; a
01b0: 6e 64 20 74 6f 20 70 65 72 6d 69 74 20 70 65 72 nd to permit per
01c0: 73 6f 6e 73 20 74 6f 20 77 68 6f 6d 20 74 68 65 sons to whom the
01d0: 20 53 6f 66 74 77 61 72 65 20 69 73 20 66 75 72 Software is fur
01e0: 6e 69 73 68 65 64 20 74 6f 20 64 6f 20 73 6f 2c nished to do so,
01f0: 0a 3b 3b 3b 20 73 75 62 6a 65 63 74 20 74 6f 20 .;;; subject to
0200: 74 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 63 6f the following co
0210: 6e 64 69 74 69 6f 6e 73 3a 0a 3b 3b 3b 20 0a 3b nditions:.;;; .;
0220: 3b 3b 20 54 68 65 20 61 62 6f 76 65 20 63 6f 70 ;; The above cop
0230: 79 72 69 67 68 74 20 6e 6f 74 69 63 65 20 61 6e yright notice an
0240: 64 20 74 68 69 73 20 70 65 72 6d 69 73 73 69 6f d this permissio
0250: 6e 20 6e 6f 74 69 63 65 20 73 68 61 6c 6c 20 62 n notice shall b
0260: 65 0a 3b 3b 3b 20 69 6e 63 6c 75 64 65 64 20 69 e.;;; included i
0270: 6e 20 61 6c 6c 20 63 6f 70 69 65 73 20 6f 72 20 n all copies or
0280: 73 75 62 73 74 61 6e 74 69 61 6c 20 70 6f 72 74 substantial port
0290: 69 6f 6e 73 20 6f 66 20 74 68 65 20 53 6f 66 74 ions of the Soft
02a0: 77 61 72 65 2e 0a 3b 3b 3b 20 0a 3b 3b 3b 20 54 ware..;;; .;;; T
02b0: 48 45 20 53 4f 46 54 57 41 52 45 20 49 53 20 50 HE SOFTWARE IS P
02c0: 52 4f 56 49 44 45 44 20 22 41 53 20 49 53 22 2c ROVIDED "AS IS",
02d0: 20 57 49 54 48 4f 55 54 20 57 41 52 52 41 4e 54 WITHOUT WARRANT
02e0: 59 20 4f 46 20 41 4e 59 20 4b 49 4e 44 2c 0a 3b Y OF ANY KIND,.;
02f0: 3b 3b 20 45 58 50 52 45 53 53 20 4f 52 20 49 4d ;; EXPRESS OR IM
0300: 50 4c 49 45 44 2c 20 49 4e 43 4c 55 44 49 4e 47 PLIED, INCLUDING
0310: 20 42 55 54 20 4e 4f 54 20 4c 49 4d 49 54 45 44 BUT NOT LIMITED
0320: 20 54 4f 20 54 48 45 20 57 41 52 52 41 4e 54 49 TO THE WARRANTI
0330: 45 53 20 4f 46 0a 3b 3b 3b 20 4d 45 52 43 48 41 ES OF.;;; MERCHA
0340: 4e 54 41 42 49 4c 49 54 59 2c 20 46 49 54 4e 45 NTABILITY, FITNE
0350: 53 53 20 46 4f 52 20 41 20 50 41 52 54 49 43 55 SS FOR A PARTICU
0360: 4c 41 52 20 50 55 52 50 4f 53 45 20 41 4e 44 0a LAR PURPOSE AND.
0370: 3b 3b 3b 20 4e 4f 4e 49 4e 46 52 49 4e 47 45 4d ;;; NONINFRINGEM
0380: 45 4e 54 2e 20 20 49 4e 20 4e 4f 20 45 56 45 4e ENT. IN NO EVEN
0390: 54 20 53 48 41 4c 4c 20 54 48 45 20 41 55 54 48 T SHALL THE AUTH
03a0: 4f 52 53 20 4f 52 20 43 4f 50 59 52 49 47 48 54 ORS OR COPYRIGHT
03b0: 20 48 4f 4c 44 45 52 53 0a 3b 3b 3b 20 42 45 20 HOLDERS.;;; BE
03c0: 4c 49 41 42 4c 45 20 46 4f 52 20 41 4e 59 20 43 LIABLE FOR ANY C
03d0: 4c 41 49 4d 2c 20 44 41 4d 41 47 45 53 20 4f 52 LAIM, DAMAGES OR
03e0: 20 4f 54 48 45 52 20 4c 49 41 42 49 4c 49 54 59 OTHER LIABILITY
03f0: 2c 20 57 48 45 54 48 45 52 20 49 4e 20 41 4e 0a , WHETHER IN AN.
0400: 3b 3b 3b 20 41 43 54 49 4f 4e 20 4f 46 20 43 4f ;;; ACTION OF CO
0410: 4e 54 52 41 43 54 2c 20 54 4f 52 54 20 4f 52 20 NTRACT, TORT OR
0420: 4f 54 48 45 52 57 49 53 45 2c 20 41 52 49 53 49 OTHERWISE, ARISI
0430: 4e 47 20 46 52 4f 4d 2c 20 4f 55 54 20 4f 46 20 NG FROM, OUT OF
0440: 4f 52 20 49 4e 0a 3b 3b 3b 20 43 4f 4e 4e 45 43 OR IN.;;; CONNEC
0450: 54 49 4f 4e 20 57 49 54 48 20 54 48 45 20 53 4f TION WITH THE SO
0460: 46 54 57 41 52 45 20 4f 52 20 54 48 45 20 55 53 FTWARE OR THE US
0470: 45 20 4f 52 20 4f 54 48 45 52 20 44 45 41 4c 49 E OR OTHER DEALI
0480: 4e 47 53 20 49 4e 20 54 48 45 0a 3b 3b 3b 20 53 NGS IN THE.;;; S
0490: 4f 46 54 57 41 52 45 2e 0a 0a 3b 3b 3b 20 54 68 OFTWARE...;;; Th
04a0: 69 73 20 70 72 6f 67 72 61 6d 20 77 61 73 20 6f is program was o
04b0: 72 69 67 69 6e 61 6c 6c 79 20 64 65 73 69 67 6e riginally design
04c0: 65 64 20 61 6e 64 20 69 6d 70 6c 65 6d 65 6e 74 ed and implement
04d0: 65 64 20 62 79 20 44 61 6e 20 46 72 69 65 64 6d ed by Dan Friedm
04e0: 61 6e 2e 20 0a 3b 3b 3b 20 49 74 20 77 61 73 20 an. .;;; It was
04f0: 72 65 64 65 73 69 67 6e 65 64 20 61 6e 64 20 72 redesigned and r
0500: 65 69 6d 70 6c 65 6d 65 6e 74 65 64 20 62 79 20 eimplemented by
0510: 45 72 69 6b 20 48 69 6c 73 64 61 6c 65 2e 20 20 Erik Hilsdale.
0520: 41 64 64 69 74 69 6f 6e 61 6c 0a 3b 3b 3b 20 6d Additional.;;; m
0530: 6f 64 69 66 69 63 61 74 69 6f 6e 73 20 77 65 72 odifications wer
0540: 65 20 6d 61 64 65 20 62 79 20 4b 65 6e 74 20 44 e made by Kent D
0550: 79 62 76 69 67 2c 20 53 74 65 76 65 20 47 61 6e ybvig, Steve Gan
0560: 7a 2c 20 61 6e 64 20 41 7a 69 7a 20 47 68 75 6c z, and Aziz Ghul
0570: 6f 75 6d 2e 0a 3b 3b 3b 20 50 61 72 74 73 20 6f oum..;;; Parts o
0580: 66 20 74 68 65 20 69 6d 70 6c 65 6d 65 6e 74 61 f the implementa
0590: 74 69 6f 6e 20 77 65 72 65 20 61 64 61 70 74 65 tion were adapte
05a0: 64 20 66 72 6f 6d 20 74 68 65 20 70 6f 72 74 61 d from the porta
05b0: 62 6c 65 20 73 79 6e 74 61 78 2d 63 61 73 65 0a ble syntax-case.
05c0: 3b 3b 3b 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 ;;; implementati
05d0: 6f 6e 20 77 72 69 74 74 65 6e 20 62 79 20 4b 65 on written by Ke
05e0: 6e 74 20 44 79 62 76 69 67 2c 20 4f 73 63 61 72 nt Dybvig, Oscar
05f0: 20 57 61 64 64 65 6c 6c 2c 20 42 6f 62 20 48 69 Waddell, Bob Hi
0600: 65 62 2c 20 61 6e 64 0a 3b 3b 3b 20 43 61 72 6c eb, and.;;; Carl
0610: 20 42 72 75 67 67 65 6d 61 6e 20 61 6e 64 20 69 Bruggeman and i
0620: 73 20 75 73 65 64 20 62 79 20 70 65 72 6d 69 73 s used by permis
0630: 73 69 6f 6e 20 6f 66 20 43 61 64 65 6e 63 65 20 sion of Cadence
0640: 52 65 73 65 61 72 63 68 20 53 79 73 74 65 6d 73 Research Systems
0650: 2e 0a 0a 3b 3b 3b 20 41 20 63 68 61 6e 67 65 20 ...;;; A change
0660: 6c 6f 67 20 61 70 70 65 61 72 73 20 61 74 20 65 log appears at e
0670: 6e 64 20 6f 66 20 74 68 69 73 20 66 69 6c 65 2e nd of this file.
0680: 0a 0a 3b 3b 3b 20 41 20 62 72 69 65 66 20 64 65 ..;;; A brief de
0690: 73 63 72 69 70 74 69 6f 6e 20 6f 66 20 6d 61 74 scription of mat
06a0: 63 68 20 69 73 20 67 69 76 65 6e 20 61 74 3a 0a ch is given at:.
06b0: 0a 3b 3b 3b 20 20 20 68 74 74 70 3a 2f 2f 77 77 .;;; http://ww
06c0: 77 2e 63 73 2e 69 6e 64 69 61 6e 61 2e 65 64 75 w.cs.indiana.edu
06d0: 2f 63 68 65 7a 73 63 68 65 6d 65 2f 6d 61 74 63 /chezscheme/matc
06e0: 68 2f 0a 0a 3b 3b 3b 20 3d 3d 3d 3d 3d 3d 3d 3d h/..;;; ========
06f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0700: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0710: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================
0720: 3d 3d 3d 3d 0a 0a 3b 3b 20 45 78 70 20 20 20 20 ====..;; Exp
0730: 3a 3a 3d 20 28 6d 61 74 63 68 20 20 20 20 20 20 ::= (match
0740: 20 20 20 20 20 20 20 20 45 78 70 20 43 6c 61 75 Exp Clau
0750: 73 65 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 7c se).;; |
0760: 7c 20 28 74 72 61 63 65 2d 6d 61 74 63 68 20 20 | (trace-match
0770: 20 20 20 20 20 20 45 78 70 20 43 6c 61 75 73 65 Exp Clause
0780: 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 7c 7c 20 ).;; ||
0790: 28 6d 61 74 63 68 2b 20 20 20 20 20 20 20 28 49 (match+ (I
07a0: 64 2a 29 20 45 78 70 20 43 6c 61 75 73 65 2a 29 d*) Exp Clause*)
07b0: 0a 3b 3b 20 20 20 20 20 20 20 20 20 7c 7c 20 28 .;; || (
07c0: 74 72 61 63 65 2d 6d 61 74 63 68 2b 20 28 49 64 trace-match+ (Id
07d0: 2a 29 20 45 78 70 20 43 6c 61 75 73 65 2a 29 0a *) Exp Clause*).
07e0: 3b 3b 20 20 20 20 20 20 20 20 20 7c 7c 20 4f 74 ;; || Ot
07f0: 68 65 72 53 63 68 65 6d 65 45 78 70 0a 0a 3b 3b herSchemeExp..;;
0800: 20 43 6c 61 75 73 65 20 3a 3a 3d 20 28 50 61 74 Clause ::= (Pat
0810: 20 45 78 70 2b 29 20 7c 7c 20 28 50 61 74 20 28 Exp+) || (Pat (
0820: 67 75 61 72 64 20 45 78 70 2a 29 20 45 78 70 2b guard Exp*) Exp+
0830: 29 0a 0a 3b 3b 20 50 61 74 20 20 20 20 3a 3a 3d )..;; Pat ::=
0840: 20 28 50 61 74 20 2e 2e 2e 20 2e 20 50 61 74 29 (Pat ... . Pat)
0850: 0a 3b 3b 20 20 20 20 20 20 20 20 20 7c 7c 20 28 .;; || (
0860: 50 61 74 20 2e 20 50 61 74 29 0a 3b 3b 20 20 20 Pat . Pat).;;
0870: 20 20 20 20 20 20 7c 7c 20 28 29 0a 3b 3b 20 20 || ().;;
0880: 20 20 20 20 20 20 20 7c 7c 20 23 28 50 61 74 2a || #(Pat*
0890: 20 50 61 74 20 2e 2e 2e 20 50 61 74 2a 29 0a 3b Pat ... Pat*).;
08a0: 3b 20 20 20 20 20 20 20 20 20 7c 7c 20 23 28 50 ; || #(P
08b0: 61 74 2a 29 0a 3b 3b 20 20 20 20 20 20 20 20 20 at*).;;
08c0: 7c 7c 20 2c 49 64 0a 3b 3b 20 20 20 20 20 20 20 || ,Id.;;
08d0: 20 20 7c 7c 20 2c 5b 49 64 2a 5d 0a 3b 3b 20 20 || ,[Id*].;;
08e0: 20 20 20 20 20 20 20 7c 7c 20 2c 5b 43 61 74 61 || ,[Cata
08f0: 20 2d 3e 20 49 64 2a 5d 0a 3b 3b 20 20 20 20 20 -> Id*].;;
0900: 20 20 20 20 7c 7c 20 49 64 0a 0a 3b 3b 20 43 61 || Id..;; Ca
0910: 74 61 20 20 20 3a 3a 3d 20 45 78 70 0a 0a 3b 3b ta ::= Exp..;;
0920: 20 59 4f 55 27 52 45 20 4e 4f 54 20 41 4c 4c 4f YOU'RE NOT ALLO
0930: 57 45 44 20 54 4f 20 52 45 46 45 52 20 54 4f 20 WED TO REFER TO
0940: 43 41 54 41 20 56 41 52 53 20 49 4e 20 47 55 41 CATA VARS IN GUA
0950: 52 44 53 2e 20 28 72 65 61 73 6f 6e 61 62 6c 65 RDS. (reasonable
0960: 21 29 0a 0a 28 6d 6f 64 75 6c 65 20 28 28 6d 61 !)..(module ((ma
0970: 74 63 68 2b 20 6d 61 74 63 68 2d 68 65 6c 70 20 tch+ match-help
0980: 6d 61 74 63 68 2d 68 65 6c 70 31 20 63 6c 61 75 match-help1 clau
0990: 73 65 2d 62 6f 64 79 20 6c 65 74 2d 76 61 6c 75 se-body let-valu
09a0: 65 73 2a 2a 0a 20 20 20 20 20 20 20 20 20 20 20 es**.
09b0: 67 75 61 72 64 2d 62 6f 64 79 20 63 6f 6e 76 65 guard-body conve
09c0: 72 74 2d 70 61 74 20 6d 61 70 70 65 72 20 6d 79 rt-pat mapper my
09d0: 2d 62 61 63 6b 71 75 6f 74 65 20 65 78 74 65 6e -backquote exten
09e0: 64 2d 62 61 63 6b 71 75 6f 74 65 0a 20 20 20 20 d-backquote.
09f0: 20 20 20 20 20 20 20 73 65 78 70 2d 64 69 73 70 sexp-disp
0a00: 61 74 63 68 29 0a 20 20 20 20 20 20 20 20 20 28 atch). (
0a10: 74 72 61 63 65 2d 6d 61 74 63 68 2b 20 6d 61 74 trace-match+ mat
0a20: 63 68 2d 68 65 6c 70 20 6d 61 74 63 68 2d 68 65 ch-help match-he
0a30: 6c 70 31 20 63 6c 61 75 73 65 2d 62 6f 64 79 20 lp1 clause-body
0a40: 6c 65 74 2d 76 61 6c 75 65 73 2a 2a 0a 20 20 20 let-values**.
0a50: 20 20 20 20 20 20 20 20 67 75 61 72 64 2d 62 6f guard-bo
0a60: 64 79 20 63 6f 6e 76 65 72 74 2d 70 61 74 20 6d dy convert-pat m
0a70: 61 70 70 65 72 20 6d 79 2d 62 61 63 6b 71 75 6f apper my-backquo
0a80: 74 65 20 65 78 74 65 6e 64 2d 62 61 63 6b 71 75 te extend-backqu
0a90: 6f 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 73 ote. s
0aa0: 65 78 70 2d 64 69 73 70 61 74 63 68 29 0a 20 20 exp-dispatch).
0ab0: 20 20 20 20 20 20 20 28 6d 61 74 63 68 20 6d 61 (match ma
0ac0: 74 63 68 2d 68 65 6c 70 20 6d 61 74 63 68 2d 68 tch-help match-h
0ad0: 65 6c 70 31 20 63 6c 61 75 73 65 2d 62 6f 64 79 elp1 clause-body
0ae0: 20 6c 65 74 2d 76 61 6c 75 65 73 2a 2a 0a 20 20 let-values**.
0af0: 20 20 20 20 20 20 20 20 20 67 75 61 72 64 2d 62 guard-b
0b00: 6f 64 79 20 63 6f 6e 76 65 72 74 2d 70 61 74 20 ody convert-pat
0b10: 6d 61 70 70 65 72 20 6d 79 2d 62 61 63 6b 71 75 mapper my-backqu
0b20: 6f 74 65 20 65 78 74 65 6e 64 2d 62 61 63 6b 71 ote extend-backq
0b30: 75 6f 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 uote.
0b40: 73 65 78 70 2d 64 69 73 70 61 74 63 68 29 0a 20 sexp-dispatch).
0b50: 20 20 20 20 20 20 20 20 28 74 72 61 63 65 2d 6d (trace-m
0b60: 61 74 63 68 20 6d 61 74 63 68 2d 68 65 6c 70 20 atch match-help
0b70: 6d 61 74 63 68 2d 68 65 6c 70 31 20 63 6c 61 75 match-help1 clau
0b80: 73 65 2d 62 6f 64 79 20 6c 65 74 2d 76 61 6c 75 se-body let-valu
0b90: 65 73 2a 2a 0a 20 20 20 20 20 20 20 20 20 20 20 es**.
0ba0: 67 75 61 72 64 2d 62 6f 64 79 20 63 6f 6e 76 65 guard-body conve
0bb0: 72 74 2d 70 61 74 20 6d 61 70 70 65 72 20 6d 79 rt-pat mapper my
0bc0: 2d 62 61 63 6b 71 75 6f 74 65 20 65 78 74 65 6e -backquote exten
0bd0: 64 2d 62 61 63 6b 71 75 6f 74 65 0a 20 20 20 20 d-backquote.
0be0: 20 20 20 20 20 20 20 73 65 78 70 2d 64 69 73 70 sexp-disp
0bf0: 61 74 63 68 29 0a 20 20 20 20 20 20 20 20 20 28 atch). (
0c00: 77 69 74 68 2d 65 6c 6c 69 70 73 69 73 2d 61 77 with-ellipsis-aw
0c10: 61 72 65 2d 71 75 61 73 69 71 75 6f 74 65 20 6d are-quasiquote m
0c20: 79 2d 62 61 63 6b 71 75 6f 74 65 29 0a 20 20 20 y-backquote).
0c30: 20 20 20 20 20 20 6d 61 74 63 68 2d 65 71 75 61 match-equa
0c40: 6c 69 74 79 2d 74 65 73 74 29 0a 0a 28 69 6d 70 lity-test)..(imp
0c50: 6f 72 74 20 73 63 68 65 6d 65 29 0a 0a 28 64 65 ort scheme)..(de
0c60: 66 69 6e 65 20 6d 61 74 63 68 2d 65 71 75 61 6c fine match-equal
0c70: 69 74 79 2d 74 65 73 74 0a 20 20 28 6d 61 6b 65 ity-test. (make
0c80: 2d 70 61 72 61 6d 65 74 65 72 0a 20 20 20 20 65 -parameter. e
0c90: 71 75 61 6c 3f 0a 20 20 20 20 28 6c 61 6d 62 64 qual?. (lambd
0ca0: 61 20 28 78 29 0a 20 20 20 20 20 20 28 75 6e 6c a (x). (unl
0cb0: 65 73 73 20 28 70 72 6f 63 65 64 75 72 65 3f 20 ess (procedure?
0cc0: 78 29 0a 20 20 20 20 20 20 20 20 28 65 72 72 6f x). (erro
0cd0: 72 20 27 6d 61 74 63 68 2d 65 71 75 61 6c 69 74 r 'match-equalit
0ce0: 79 2d 74 65 73 74 20 22 7e 73 20 69 73 20 6e 6f y-test "~s is no
0cf0: 74 20 61 20 70 72 6f 63 65 64 75 72 65 22 20 78 t a procedure" x
0d00: 29 29 0a 20 20 20 20 20 20 78 29 29 29 0a 0a 28 )). x)))..(
0d10: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 define-syntax ma
0d20: 74 63 68 2b 0a 20 20 28 6c 61 6d 62 64 61 20 28 tch+. (lambda (
0d30: 78 29 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 63 x). (syntax-c
0d40: 61 73 65 20 78 20 28 29 0a 20 20 20 20 20 20 5b ase x (). [
0d50: 28 6b 20 28 54 68 72 65 61 64 65 64 49 64 20 2e (k (ThreadedId .
0d60: 2e 2e 29 20 45 78 70 20 43 6c 61 75 73 65 20 2e ..) Exp Clause .
0d70: 2e 2e 29 0a 20 20 20 20 20 20 20 23 27 28 6c 65 ..). #'(le
0d80: 74 20 66 20 28 28 54 68 72 65 61 64 65 64 49 64 t f ((ThreadedId
0d90: 20 54 68 72 65 61 64 65 64 49 64 29 20 2e 2e 2e ThreadedId) ...
0da0: 20 28 78 20 45 78 70 29 29 0a 20 20 20 20 20 20 (x Exp)).
0db0: 20 20 20 20 20 28 6d 61 74 63 68 2d 68 65 6c 70 (match-help
0dc0: 20 6b 20 66 20 78 20 28 54 68 72 65 61 64 65 64 k f x (Threaded
0dd0: 49 64 20 2e 2e 2e 29 20 43 6c 61 75 73 65 20 2e Id ...) Clause .
0de0: 2e 2e 29 29 5d 29 29 29 0a 0a 28 64 65 66 69 6e ..))])))..(defin
0df0: 65 2d 73 79 6e 74 61 78 20 6d 61 74 63 68 0a 20 e-syntax match.
0e00: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 (lambda (x).
0e10: 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 78 20 (syntax-case x
0e20: 28 29 0a 20 20 20 20 20 20 5b 28 6b 20 45 78 70 (). [(k Exp
0e30: 20 43 6c 61 75 73 65 20 2e 2e 2e 29 0a 20 20 20 Clause ...).
0e40: 20 20 20 20 23 27 28 6c 65 74 20 66 20 28 28 78 #'(let f ((x
0e50: 20 45 78 70 29 29 0a 20 20 20 20 20 20 20 20 20 Exp)).
0e60: 20 20 28 6d 61 74 63 68 2d 68 65 6c 70 20 6b 20 (match-help k
0e70: 66 20 78 20 28 29 20 43 6c 61 75 73 65 20 2e 2e f x () Clause ..
0e80: 2e 29 29 5d 29 29 29 0a 0a 28 64 65 66 69 6e 65 .))])))..(define
0e90: 2d 73 79 6e 74 61 78 20 74 72 61 63 65 2d 6d 61 -syntax trace-ma
0ea0: 74 63 68 2b 0a 20 20 28 6c 61 6d 62 64 61 20 28 tch+. (lambda (
0eb0: 78 29 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 63 x). (syntax-c
0ec0: 61 73 65 20 78 20 28 29 0a 20 20 20 20 20 20 5b ase x (). [
0ed0: 28 6b 20 28 54 68 72 65 61 64 65 64 49 64 20 2e (k (ThreadedId .
0ee0: 2e 2e 29 20 4e 61 6d 65 20 45 78 70 20 43 6c 61 ..) Name Exp Cla
0ef0: 75 73 65 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 use ...).
0f00: 23 27 28 6c 65 74 72 65 63 20 28 28 66 20 28 74 #'(letrec ((f (t
0f10: 72 61 63 65 2d 6c 61 6d 62 64 61 20 4e 61 6d 65 race-lambda Name
0f20: 20 28 54 68 72 65 61 64 65 64 49 64 20 2e 2e 2e (ThreadedId ...
0f30: 20 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 x).
0f40: 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 74 63 (matc
0f50: 68 2d 68 65 6c 70 20 6b 20 66 20 78 20 28 54 68 h-help k f x (Th
0f60: 72 65 61 64 65 64 49 64 20 2e 2e 2e 29 20 43 6c readedId ...) Cl
0f70: 61 75 73 65 20 2e 2e 2e 29 29 29 29 0a 20 20 20 ause ...)))).
0f80: 20 20 20 20 20 20 20 20 28 66 20 54 68 72 65 61 (f Threa
0f90: 64 65 64 49 64 20 2e 2e 2e 20 78 29 29 5d 29 29 dedId ... x))]))
0fa0: 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 )..(define-synta
0fb0: 78 20 74 72 61 63 65 2d 6d 61 74 63 68 0a 20 20 x trace-match.
0fc0: 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 (lambda (x).
0fd0: 28 73 79 6e 74 61 78 2d 63 61 73 65 20 78 20 28 (syntax-case x (
0fe0: 29 0a 20 20 20 20 20 20 5b 28 6b 20 4e 61 6d 65 ). [(k Name
0ff0: 20 45 78 70 20 43 6c 61 75 73 65 20 2e 2e 2e 29 Exp Clause ...)
1000: 0a 20 20 20 20 20 20 20 23 27 28 6c 65 74 72 65 . #'(letre
1010: 63 20 28 28 66 20 28 74 72 61 63 65 2d 6c 61 6d c ((f (trace-lam
1020: 62 64 61 20 4e 61 6d 65 20 28 78 29 0a 20 20 20 bda Name (x).
1030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1040: 20 20 20 20 28 6d 61 74 63 68 2d 68 65 6c 70 20 (match-help
1050: 6b 20 66 20 78 20 28 29 20 43 6c 61 75 73 65 20 k f x () Clause
1060: 2e 2e 2e 29 29 29 29 0a 20 20 20 20 20 20 20 20 ...)))).
1070: 20 20 20 28 66 20 45 78 70 29 29 5d 29 29 29 0a (f Exp))]))).
1080: 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d .;;; -----------
1090: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
10a0: 2d 2d 2d 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e ---..(define-syn
10b0: 74 61 78 20 6c 65 74 2d 76 61 6c 75 65 73 2a 2a tax let-values**
10c0: 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 . (syntax-rules
10d0: 20 28 29 0a 20 20 20 20 28 28 5f 20 28 29 20 42 (). ((_ () B
10e0: 30 20 42 20 2e 2e 2e 29 20 28 62 65 67 69 6e 20 0 B ...) (begin
10f0: 42 30 20 42 20 2e 2e 2e 29 29 0a 20 20 20 20 28 B0 B ...)). (
1100: 28 5f 20 28 28 46 6f 72 6d 61 6c 73 20 45 78 70 (_ ((Formals Exp
1110: 29 20 52 65 73 74 20 2e 2e 2e 29 20 42 30 20 42 ) Rest ...) B0 B
1120: 20 2e 2e 2e 29 0a 20 20 20 20 20 28 6c 65 74 2d ...). (let-
1130: 76 61 6c 75 65 73 2a 2a 20 28 52 65 73 74 20 2e values** (Rest .
1140: 2e 2e 29 20 0a 20 20 20 20 20 20 20 28 63 61 6c ..) . (cal
1150: 6c 2d 77 69 74 68 2d 76 61 6c 75 65 73 20 28 6c l-with-values (l
1160: 61 6d 62 64 61 20 28 29 20 45 78 70 29 0a 20 20 ambda () Exp).
1170: 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 46 (lambda F
1180: 6f 72 6d 61 6c 73 20 42 30 20 42 20 2e 2e 2e 29 ormals B0 B ...)
1190: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 )))))..(define-s
11a0: 79 6e 74 61 78 20 6d 61 74 63 68 2d 68 65 6c 70 yntax match-help
11b0: 0a 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 . (lambda (x).
11c0: 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 (syntax-case
11d0: 78 20 28 29 0a 20 20 20 20 20 20 28 28 5f 20 54 x (). ((_ T
11e0: 65 6d 70 6c 61 74 65 20 43 61 74 61 20 4f 62 6a emplate Cata Obj
11f0: 20 54 68 72 65 61 64 65 64 49 64 73 29 0a 20 20 ThreadedIds).
1200: 20 20 20 20 20 23 27 28 65 72 72 6f 72 20 27 6d #'(error 'm
1210: 61 74 63 68 20 22 55 6e 6d 61 74 63 68 65 64 20 atch "Unmatched
1220: 64 61 74 75 6d 3a 20 7e 73 22 20 4f 62 6a 29 29 datum: ~s" Obj))
1230: 0a 20 20 20 20 20 20 28 28 5f 20 54 65 6d 70 6c . ((_ Templ
1240: 61 74 65 20 43 61 74 61 20 4f 62 6a 20 54 68 72 ate Cata Obj Thr
1250: 65 61 64 65 64 49 64 73 20 28 50 61 74 20 42 30 eadedIds (Pat B0
1260: 20 42 20 2e 2e 2e 29 20 52 65 73 74 20 2e 2e 2e B ...) Rest ...
1270: 29 0a 20 20 20 20 20 20 20 23 27 28 63 6f 6e 76 ). #'(conv
1280: 65 72 74 2d 70 61 74 20 50 61 74 0a 20 20 20 20 ert-pat Pat.
1290: 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 68 65 (match-he
12a0: 6c 70 31 20 54 65 6d 70 6c 61 74 65 20 43 61 74 lp1 Template Cat
12b0: 61 20 4f 62 6a 20 54 68 72 65 61 64 65 64 49 64 a Obj ThreadedId
12c0: 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s .
12d0: 28 42 30 20 42 20 2e 2e 2e 29 0a 20 20 20 20 20 (B0 B ...).
12e0: 20 20 20 20 20 20 20 20 52 65 73 74 20 2e 2e 2e Rest ...
12f0: 29 29 29 0a 20 20 20 20 20 20 28 28 5f 20 54 65 ))). ((_ Te
1300: 6d 70 6c 61 74 65 20 43 61 74 61 20 4f 62 6a 20 mplate Cata Obj
1310: 54 68 72 65 61 64 65 64 49 64 73 20 63 6c 73 20 ThreadedIds cls
1320: 52 65 73 74 20 2e 2e 2e 29 0a 20 20 20 20 20 20 Rest ...).
1330: 20 28 73 79 6e 74 61 78 2d 65 72 72 6f 72 20 23 (syntax-error #
1340: 27 63 6c 73 20 22 69 6e 76 61 6c 69 64 20 6d 61 'cls "invalid ma
1350: 74 63 68 20 63 6c 61 75 73 65 22 29 29 29 29 29 tch clause")))))
1360: 0a 20 20 20 20 0a 0a 28 64 65 66 69 6e 65 2d 73 . ..(define-s
1370: 79 6e 74 61 78 20 6d 61 74 63 68 2d 68 65 6c 70 yntax match-help
1380: 31 0a 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 1. (lambda (x).
1390: 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 (syntax-case
13a0: 20 78 20 28 67 75 61 72 64 29 0a 20 20 20 20 20 x (guard).
13b0: 20 5b 28 5f 20 50 61 74 4c 69 74 20 56 61 72 73 [(_ PatLit Vars
13c0: 20 28 29 20 43 64 65 63 6c 73 20 54 65 6d 70 6c () Cdecls Templ
13d0: 61 74 65 20 43 61 74 61 20 4f 62 6a 20 54 68 72 ate Cata Obj Thr
13e0: 65 61 64 65 64 49 64 73 0a 20 20 20 20 20 20 20 eadedIds.
13f0: 20 20 28 28 67 75 61 72 64 29 20 42 30 20 42 20 ((guard) B0 B
1400: 2e 2e 2e 29 20 52 65 73 74 20 2e 2e 2e 29 0a 20 ...) Rest ...).
1410: 20 20 20 20 20 20 23 27 28 6c 65 74 20 28 28 6c #'(let ((l
1420: 73 2f 66 61 6c 73 65 20 28 73 65 78 70 2d 64 69 s/false (sexp-di
1430: 73 70 61 74 63 68 20 4f 62 6a 20 50 61 74 4c 69 spatch Obj PatLi
1440: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
1450: 28 69 66 20 6c 73 2f 66 61 6c 73 65 0a 20 20 20 (if ls/false.
1460: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
1470: 6c 79 20 28 6c 61 6d 62 64 61 20 56 61 72 73 0a ly (lambda Vars.
1480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1490: 20 20 20 20 20 20 20 20 28 63 6c 61 75 73 65 2d (clause-
14a0: 62 6f 64 79 20 43 61 74 61 20 43 64 65 63 6c 73 body Cata Cdecls
14b0: 20 54 68 72 65 61 64 65 64 49 64 73 0a 20 20 20 ThreadedIds.
14c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14d0: 20 20 20 20 20 20 20 28 65 78 74 65 6e 64 2d 62 (extend-b
14e0: 61 63 6b 71 75 6f 74 65 20 54 65 6d 70 6c 61 74 ackquote Templat
14f0: 65 20 42 30 20 42 20 2e 2e 2e 29 29 29 0a 20 20 e B0 B ...))).
1500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c l
1510: 73 2f 66 61 6c 73 65 29 0a 20 20 20 20 20 20 20 s/false).
1520: 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 68 (match-h
1530: 65 6c 70 20 54 65 6d 70 6c 61 74 65 20 43 61 74 elp Template Cat
1540: 61 20 4f 62 6a 20 54 68 72 65 61 64 65 64 49 64 a Obj ThreadedId
1550: 73 20 52 65 73 74 20 2e 2e 2e 29 29 29 5d 0a 20 s Rest ...)))].
1560: 20 20 20 20 20 5b 28 5f 20 50 61 74 4c 69 74 20 [(_ PatLit
1570: 56 61 72 73 20 28 50 47 20 2e 2e 2e 29 20 43 64 Vars (PG ...) Cd
1580: 65 63 6c 73 20 54 65 6d 70 6c 61 74 65 20 43 61 ecls Template Ca
1590: 74 61 20 4f 62 6a 20 54 68 72 65 61 64 65 64 49 ta Obj ThreadedI
15a0: 64 73 0a 20 20 20 20 20 20 20 20 20 28 28 67 75 ds. ((gu
15b0: 61 72 64 20 47 20 2e 2e 2e 29 20 42 30 20 42 20 ard G ...) B0 B
15c0: 2e 2e 2e 29 20 52 65 73 74 20 2e 2e 2e 29 0a 20 ...) Rest ...).
15d0: 20 20 20 20 20 20 23 27 28 6c 65 74 20 28 28 6c #'(let ((l
15e0: 73 2f 66 61 6c 73 65 20 28 73 65 78 70 2d 64 69 s/false (sexp-di
15f0: 73 70 61 74 63 68 20 4f 62 6a 20 50 61 74 4c 69 spatch Obj PatLi
1600: 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 t))).
1610: 28 69 66 20 28 61 6e 64 20 6c 73 2f 66 61 6c 73 (if (and ls/fals
1620: 65 20 28 61 70 70 6c 79 20 28 6c 61 6d 62 64 61 e (apply (lambda
1630: 20 56 61 72 73 0a 20 20 20 20 20 20 20 20 20 20 Vars.
1640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1650: 20 20 20 20 20 20 20 20 20 20 20 20 28 67 75 61 (gua
1660: 72 64 2d 62 6f 64 79 20 43 64 65 63 6c 73 0a 20 rd-body Cdecls.
1670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1690: 20 20 20 20 20 20 20 28 65 78 74 65 6e 64 2d 62 (extend-b
16a0: 61 63 6b 71 75 6f 74 65 20 54 65 6d 70 6c 61 74 ackquote Templat
16b0: 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 e.
16c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
16d0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 (and
16e0: 20 50 47 20 2e 2e 2e 20 47 20 2e 2e 2e 29 29 29 PG ... G ...)))
16f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
1700: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1710: 20 6c 73 2f 66 61 6c 73 65 29 29 0a 20 20 20 20 ls/false)).
1720: 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 6c (appl
1730: 79 20 28 6c 61 6d 62 64 61 20 56 61 72 73 0a 20 y (lambda Vars.
1740: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1750: 20 20 20 20 20 20 20 28 63 6c 61 75 73 65 2d 62 (clause-b
1760: 6f 64 79 20 43 61 74 61 20 43 64 65 63 6c 73 20 ody Cata Cdecls
1770: 54 68 72 65 61 64 65 64 49 64 73 0a 20 20 20 20 ThreadedIds.
1780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1790: 20 20 20 20 20 20 28 65 78 74 65 6e 64 2d 62 61 (extend-ba
17a0: 63 6b 71 75 6f 74 65 20 54 65 6d 70 6c 61 74 65 ckquote Template
17b0: 20 42 30 20 42 20 2e 2e 2e 29 29 29 0a 20 20 20 B0 B ...))).
17c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 73 ls
17d0: 2f 66 61 6c 73 65 29 0a 20 20 20 20 20 20 20 20 /false).
17e0: 20 20 20 20 20 20 20 28 6d 61 74 63 68 2d 68 65 (match-he
17f0: 6c 70 20 54 65 6d 70 6c 61 74 65 20 43 61 74 61 lp Template Cata
1800: 20 4f 62 6a 20 54 68 72 65 61 64 65 64 49 64 73 Obj ThreadedIds
1810: 20 52 65 73 74 20 2e 2e 2e 29 29 29 5d 0a 20 20 Rest ...)))].
1820: 20 20 20 20 5b 28 5f 20 50 61 74 4c 69 74 20 56 [(_ PatLit V
1830: 61 72 73 20 28 50 47 20 2e 2e 2e 29 20 43 64 65 ars (PG ...) Cde
1840: 63 6c 73 20 54 65 6d 70 6c 61 74 65 20 43 61 74 cls Template Cat
1850: 61 20 4f 62 6a 20 54 68 72 65 61 64 65 64 49 64 a Obj ThreadedId
1860: 73 0a 20 20 20 20 20 20 20 20 20 28 42 30 20 42 s. (B0 B
1870: 20 2e 2e 2e 29 20 52 65 73 74 20 2e 2e 2e 29 0a ...) Rest ...).
1880: 20 20 20 20 20 20 20 23 27 28 6d 61 74 63 68 2d #'(match-
1890: 68 65 6c 70 31 20 50 61 74 4c 69 74 20 56 61 72 help1 PatLit Var
18a0: 73 20 28 50 47 20 2e 2e 2e 29 20 43 64 65 63 6c s (PG ...) Cdecl
18b0: 73 20 54 65 6d 70 6c 61 74 65 20 43 61 74 61 20 s Template Cata
18c0: 4f 62 6a 20 54 68 72 65 61 64 65 64 49 64 73 0a Obj ThreadedIds.
18d0: 20 20 20 20 20 20 20 20 20 20 20 28 28 67 75 61 ((gua
18e0: 72 64 29 20 42 30 20 42 20 2e 2e 2e 29 20 52 65 rd) B0 B ...) Re
18f0: 73 74 20 2e 2e 2e 29 5d 29 29 29 0a 0a 28 64 65 st ...)])))..(de
1900: 66 69 6e 65 2d 73 79 6e 74 61 78 20 63 6c 61 75 fine-syntax clau
1910: 73 65 2d 62 6f 64 79 0a 20 20 28 6c 61 6d 62 64 se-body. (lambd
1920: 61 20 28 78 29 0a 20 20 20 20 28 64 65 66 69 6e a (x). (defin
1930: 65 20 62 75 69 6c 64 2d 6d 61 70 70 65 72 0a 20 e build-mapper.
1940: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 76 61 (lambda (va
1950: 72 73 20 64 65 70 74 68 20 63 61 74 61 20 74 49 rs depth cata tI
1960: 64 73 29 0a 20 20 20 20 20 20 20 20 28 69 66 20 ds). (if
1970: 28 7a 65 72 6f 3f 20 64 65 70 74 68 29 0a 20 20 (zero? depth).
1980: 20 20 20 20 20 20 20 20 20 20 63 61 74 61 0a 20 cata.
1990: 20 20 20 20 20 20 20 20 20 20 20 28 77 69 74 68 (with
19a0: 2d 73 79 6e 74 61 78 20 28 28 72 65 73 74 20 28 -syntax ((rest (
19b0: 62 75 69 6c 64 2d 6d 61 70 70 65 72 20 76 61 72 build-mapper var
19c0: 73 20 28 2d 20 64 65 70 74 68 20 31 29 20 63 61 s (- depth 1) ca
19d0: 74 61 20 74 49 64 73 29 29 0a 20 20 20 20 20 20 ta tIds)).
19e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
19f0: 20 20 20 20 28 76 61 72 73 20 76 61 72 73 29 0a (vars vars).
1a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1a10: 20 20 20 20 20 20 20 20 20 20 28 74 49 64 73 20 (tIds
1a20: 74 49 64 73 29 29 0a 20 20 20 20 20 20 20 20 20 tIds)).
1a30: 20 20 20 20 20 23 27 28 6d 61 70 70 65 72 20 72 #'(mapper r
1a40: 65 73 74 20 76 61 72 73 20 74 49 64 73 29 29 29 est vars tIds)))
1a50: 29 29 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 63 )). (syntax-c
1a60: 61 73 65 20 78 20 28 29 0a 20 20 20 20 20 20 28 ase x (). (
1a70: 28 5f 20 43 61 74 61 20 28 28 43 56 61 72 20 43 (_ Cata ((CVar C
1a80: 44 65 70 74 68 20 43 4d 79 43 61 74 61 20 43 46 Depth CMyCata CF
1a90: 6f 72 6d 61 6c 20 2e 2e 2e 29 20 2e 2e 2e 29 20 ormal ...) ...)
1aa0: 28 54 68 72 65 61 64 65 64 49 64 20 2e 2e 2e 29 (ThreadedId ...)
1ab0: 20 42 29 0a 20 20 20 20 20 20 20 28 77 69 74 68 B). (with
1ac0: 2d 73 79 6e 74 61 78 20 28 28 28 4d 61 70 70 65 -syntax (((Mappe
1ad0: 72 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 r ...).
1ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6d 61 (ma
1af0: 70 20 28 6c 61 6d 62 64 61 20 28 6d 79 63 61 74 p (lambda (mycat
1b00: 61 20 66 6f 72 6d 61 6c 73 20 64 65 70 74 68 29 a formals depth)
1b10: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1b20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 62 (b
1b30: 75 69 6c 64 2d 6d 61 70 70 65 72 20 66 6f 72 6d uild-mapper form
1b40: 61 6c 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 als.
1b50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b60: 20 20 20 28 73 79 6e 74 61 78 2d 3e 64 61 74 75 (syntax->datu
1b70: 6d 20 64 65 70 74 68 29 0a 20 20 20 20 20 20 20 m depth).
1b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1b90: 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d (syntax-
1ba0: 63 61 73 65 20 6d 79 63 61 74 61 20 28 29 0a 20 case mycata ().
1bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bd0: 5b 23 66 20 23 27 43 61 74 61 5d 0a 20 20 20 20 [#f #'Cata].
1be0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1bf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 65 78 [ex
1c00: 70 20 23 27 65 78 70 5d 29 0a 20 20 20 20 20 20 p #'exp]).
1c10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c20: 20 20 20 20 20 20 20 20 20 23 27 28 54 68 72 65 #'(Thre
1c30: 61 64 65 64 49 64 20 2e 2e 2e 29 29 29 0a 20 20 adedId ...))).
1c40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1c50: 20 20 20 20 20 20 23 27 28 43 4d 79 43 61 74 61 #'(CMyCata
1c60: 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 20 ...).
1c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 27 #'
1c80: 28 28 43 46 6f 72 6d 61 6c 20 2e 2e 2e 29 20 2e ((CFormal ...) .
1c90: 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ..).
1ca0: 20 20 20 20 20 20 20 20 20 20 20 20 23 27 28 43 #'(C
1cb0: 44 65 70 74 68 20 2e 2e 2e 29 29 29 29 0a 20 20 Depth ...)))).
1cc0: 20 20 20 20 20 20 20 23 27 28 6c 65 74 2d 76 61 #'(let-va
1cd0: 6c 75 65 73 2a 2a 20 28 28 5b 54 68 72 65 61 64 lues** (([Thread
1ce0: 65 64 49 64 20 2e 2e 2e 20 43 46 6f 72 6d 61 6c edId ... CFormal
1cf0: 20 2e 2e 2e 5d 0a 20 20 20 20 20 20 20 20 20 20 ...].
1d00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d10: 20 28 4d 61 70 70 65 72 20 54 68 72 65 61 64 65 (Mapper Threade
1d20: 64 49 64 20 2e 2e 2e 20 43 56 61 72 29 29 0a 20 dId ... CVar)).
1d30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1d40: 20 20 20 20 20 20 20 20 20 2e 2e 2e 29 0a 20 20 ...).
1d50: 20 20 20 20 20 20 20 20 20 20 20 42 29 29 29 29 B))))
1d60: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 ))..(define-synt
1d70: 61 78 20 67 75 61 72 64 2d 62 6f 64 79 0a 20 20 ax guard-body.
1d80: 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 (lambda (x).
1d90: 28 73 79 6e 74 61 78 2d 63 61 73 65 20 78 20 28 (syntax-case x (
1da0: 29 0a 20 20 20 20 20 20 28 28 5f 20 28 28 43 76 ). ((_ ((Cv
1db0: 61 72 20 43 64 65 70 74 68 20 4d 79 43 61 74 61 ar Cdepth MyCata
1dc0: 20 43 66 6f 72 6d 61 6c 20 2e 2e 2e 29 20 2e 2e Cformal ...) ..
1dd0: 2e 29 20 42 29 0a 20 20 20 20 20 20 20 28 77 69 .) B). (wi
1de0: 74 68 2d 73 79 6e 74 61 78 20 28 28 28 43 46 20 th-syntax (((CF
1df0: 2e 2e 2e 29 20 28 61 70 70 6c 79 20 61 70 70 65 ...) (apply appe
1e00: 6e 64 20 23 27 28 28 43 66 6f 72 6d 61 6c 20 2e nd #'((Cformal .
1e10: 2e 2e 29 20 2e 2e 2e 29 29 29 29 0a 20 20 20 20 ..) ...)))).
1e20: 20 20 20 20 20 23 27 28 6c 65 74 2d 73 79 6e 74 #'(let-synt
1e30: 61 78 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ax.
1e40: 20 20 28 28 43 46 0a 20 20 20 20 20 20 20 20 20 ((CF.
1e50: 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 61 (lambda
1e60: 20 28 78 29 0a 20 20 20 20 20 20 20 20 20 20 20 (x).
1e70: 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 (syntax
1e80: 2d 63 61 73 65 20 78 20 28 29 0a 20 20 20 20 20 -case x ().
1e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1ea0: 20 28 4e 61 6d 65 0a 20 20 20 20 20 20 20 20 20 (Name.
1eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
1ec0: 73 79 6e 74 61 78 2d 65 72 72 6f 72 20 23 27 4e syntax-error #'N
1ed0: 61 6d 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 ame.
1ee0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 22 67 "g
1ef0: 75 61 72 64 20 63 61 6e 6e 6f 74 20 72 65 66 65 uard cannot refe
1f00: 72 20 74 6f 20 72 65 74 75 72 6e 2d 76 61 6c 75 r to return-valu
1f10: 65 20 76 61 72 69 61 62 6c 65 22 29 29 29 29 29 e variable")))))
1f20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1f30: 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 20 ...).
1f40: 20 20 20 42 29 29 29 29 29 29 0a 0a 28 64 65 66 B))))))..(def
1f50: 69 6e 65 2d 73 79 6e 74 61 78 20 63 6f 6e 76 65 ine-syntax conve
1f60: 72 74 2d 70 61 74 0a 20 20 3b 3b 20 72 65 74 75 rt-pat. ;; retu
1f70: 72 6e 73 20 73 65 78 70 2d 70 61 74 20 78 20 76 rns sexp-pat x v
1f80: 61 72 73 20 78 20 67 75 61 72 64 73 20 78 20 63 ars x guards x c
1f90: 64 65 63 6c 73 0a 20 20 28 6c 65 74 20 28 29 0a decls. (let ().
1fa0: 20 20 20 20 28 64 65 66 69 6e 65 20 65 6c 6c 69 (define elli
1fb0: 70 73 69 73 3f 0a 20 20 20 20 20 20 28 6c 61 6d psis?. (lam
1fc0: 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 bda (x).
1fd0: 28 61 6e 64 20 28 69 64 65 6e 74 69 66 69 65 72 (and (identifier
1fe0: 3f 20 78 29 20 28 66 72 65 65 2d 69 64 65 6e 74 ? x) (free-ident
1ff0: 69 66 69 65 72 3d 3f 20 78 20 23 27 28 2e 2e 2e ifier=? x #'(...
2000: 20 2e 2e 2e 29 29 29 29 29 0a 20 20 20 20 28 64 ...))))). (d
2010: 65 66 69 6e 65 20 56 61 72 3f 0a 20 20 20 20 20 efine Var?.
2020: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 (lambda (x).
2030: 20 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 (syntax-cas
2040: 65 20 78 20 28 2d 3e 29 0a 20 20 20 20 20 20 20 e x (->).
2050: 20 20 20 5b 2d 3e 20 23 66 5d 0a 20 20 20 20 20 [-> #f].
2060: 20 20 20 20 20 5b 69 64 20 28 69 64 65 6e 74 69 [id (identi
2070: 66 69 65 72 3f 20 23 27 69 64 29 5d 29 29 29 0a fier? #'id)]))).
2080: 20 20 20 20 28 64 65 66 69 6e 65 20 66 56 61 72 (define fVar
2090: 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 . (lambda (
20a0: 76 61 72 20 76 61 72 73 20 67 75 61 72 64 73 29 var vars guards)
20b0: 0a 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f . (let lo
20c0: 6f 70 20 28 5b 6c 73 20 76 61 72 73 5d 29 0a 20 op ([ls vars]).
20d0: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 (if (nu
20e0: 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 20 20 20 ll? ls).
20f0: 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 28 63 (values (c
2100: 6f 6e 73 20 76 61 72 20 76 61 72 73 29 20 67 75 ons var vars) gu
2110: 61 72 64 73 29 0a 20 20 20 20 20 20 20 20 20 20 ards).
2120: 20 20 20 20 28 69 66 20 28 62 6f 75 6e 64 2d 69 (if (bound-i
2130: 64 65 6e 74 69 66 69 65 72 3d 3f 20 76 61 72 20 dentifier=? var
2140: 28 63 61 72 20 6c 73 29 29 0a 20 20 20 20 20 20 (car ls)).
2150: 20 20 20 20 20 20 20 20 20 20 20 20 28 77 69 74 (wit
2160: 68 2d 73 79 6e 74 61 78 20 28 5b 28 74 6d 70 29 h-syntax ([(tmp)
2170: 20 28 67 65 6e 65 72 61 74 65 2d 74 65 6d 70 6f (generate-tempo
2180: 72 61 72 69 65 73 20 28 6c 69 73 74 20 76 61 72 raries (list var
2190: 29 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))].
21a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
21b0: 20 20 20 20 5b 76 61 72 20 28 63 61 72 20 6c 73 [var (car ls
21c0: 29 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 )]).
21d0: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 (values
21e0: 28 63 6f 6e 73 20 23 27 74 6d 70 20 76 61 72 73 (cons #'tmp vars
21f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2200: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
2210: 6f 6e 73 20 23 27 28 28 6d 61 74 63 68 2d 65 71 ons #'((match-eq
2220: 75 61 6c 69 74 79 2d 74 65 73 74 29 20 74 6d 70 uality-test) tmp
2230: 20 76 61 72 29 20 67 75 61 72 64 73 29 29 29 0a var) guards))).
2240: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2250: 20 20 28 6c 6f 6f 70 20 28 63 64 72 20 6c 73 29 (loop (cdr ls)
2260: 29 29 29 29 29 29 0a 20 20 20 20 28 64 65 66 69 )))))). (defi
2270: 6e 65 20 28 66 20 73 79 6e 20 76 61 72 73 20 67 ne (f syn vars g
2280: 75 61 72 64 73 20 63 64 65 63 6c 73 20 64 65 70 uards cdecls dep
2290: 74 68 29 0a 20 20 20 20 20 20 28 73 79 6e 74 61 th). (synta
22a0: 78 2d 63 61 73 65 20 73 79 6e 20 28 75 6e 71 75 x-case syn (unqu
22b0: 6f 74 65 29 0a 20 20 20 20 20 20 20 20 28 28 75 ote). ((u
22c0: 6e 71 75 6f 74 65 20 2e 20 73 74 75 66 66 29 20 nquote . stuff)
22d0: 3b 20 73 65 70 61 72 61 74 65 20 66 6f 72 20 62 ; separate for b
22e0: 65 74 74 65 72 20 65 72 72 6f 72 20 64 65 74 65 etter error dete
22f0: 63 74 69 6f 6e 0a 20 20 20 20 20 20 20 20 20 28 ction. (
2300: 73 79 6e 74 61 78 2d 63 61 73 65 20 73 79 6e 20 syntax-case syn
2310: 28 75 6e 71 75 6f 74 65 20 2d 3e 29 0a 20 20 20 (unquote ->).
2320: 20 20 20 20 20 20 20 20 28 28 75 6e 71 75 6f 74 ((unquot
2330: 65 20 5b 4d 79 43 61 74 61 20 2d 3e 20 56 61 72 e [MyCata -> Var
2340: 20 2e 2e 2e 5d 29 0a 20 20 20 20 20 20 20 20 20 ...]).
2350: 20 20 20 28 61 6e 64 6d 61 70 20 56 61 72 3f 20 (andmap Var?
2360: 23 27 28 56 61 72 20 2e 2e 2e 29 29 0a 20 20 20 #'(Var ...)).
2370: 20 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 (with-s
2380: 79 6e 74 61 78 20 28 28 28 54 65 6d 70 29 20 28 yntax (((Temp) (
2390: 67 65 6e 65 72 61 74 65 2d 74 65 6d 70 6f 72 61 generate-tempora
23a0: 72 69 65 73 20 27 28 78 29 29 29 0a 20 20 20 20 ries '(x))).
23b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
23c0: 20 20 20 20 20 20 28 44 65 70 74 68 20 64 65 70 (Depth dep
23d0: 74 68 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 th)).
23e0: 20 20 20 28 76 61 6c 75 65 73 20 23 27 61 6e 79 (values #'any
23f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2400: 20 20 20 20 20 20 20 28 63 6f 6e 73 20 23 27 54 (cons #'T
2410: 65 6d 70 20 76 61 72 73 29 0a 20 20 20 20 20 20 emp vars).
2420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2430: 67 75 61 72 64 73 0a 20 20 20 20 20 20 20 20 20 guards.
2440: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
2450: 6e 73 20 23 27 5b 54 65 6d 70 20 44 65 70 74 68 ns #'[Temp Depth
2460: 20 4d 79 43 61 74 61 20 56 61 72 20 2e 2e 2e 5d MyCata Var ...]
2470: 20 63 64 65 63 6c 73 29 29 29 29 0a 20 20 20 20 cdecls)))).
2480: 20 20 20 20 20 20 20 28 28 75 6e 71 75 6f 74 65 ((unquote
2490: 20 5b 56 61 72 20 2e 2e 2e 5d 29 0a 20 20 20 20 [Var ...]).
24a0: 20 20 20 20 20 20 20 20 28 61 6e 64 6d 61 70 20 (andmap
24b0: 56 61 72 3f 20 23 27 28 56 61 72 20 2e 2e 2e 29 Var? #'(Var ...)
24c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 77 ). (w
24d0: 69 74 68 2d 73 79 6e 74 61 78 20 28 28 28 54 65 ith-syntax (((Te
24e0: 6d 70 29 20 28 67 65 6e 65 72 61 74 65 2d 74 65 mp) (generate-te
24f0: 6d 70 6f 72 61 72 69 65 73 20 27 28 78 29 29 29 mporaries '(x)))
2500: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2510: 20 20 20 20 20 20 20 20 20 20 20 28 44 65 70 74 (Dept
2520: 68 20 64 65 70 74 68 29 29 0a 20 20 20 20 20 20 h depth)).
2530: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 (values
2540: 23 27 61 6e 79 0a 20 20 20 20 20 20 20 20 20 20 #'any.
2550: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
2560: 73 20 23 27 54 65 6d 70 20 76 61 72 73 29 0a 20 s #'Temp vars).
2570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2580: 20 20 20 20 20 67 75 61 72 64 73 0a 20 20 20 20 guards.
2590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
25a0: 20 20 28 63 6f 6e 73 20 23 27 5b 54 65 6d 70 20 (cons #'[Temp
25b0: 44 65 70 74 68 20 23 66 20 56 61 72 20 2e 2e 2e Depth #f Var ...
25c0: 5d 20 63 64 65 63 6c 73 29 29 29 29 0a 20 20 20 ] cdecls)))).
25d0: 20 20 20 20 20 20 20 20 28 28 75 6e 71 75 6f 74 ((unquot
25e0: 65 20 56 61 72 29 0a 20 20 20 20 20 20 20 20 20 e Var).
25f0: 20 20 20 28 56 61 72 3f 20 23 27 56 61 72 29 0a (Var? #'Var).
2600: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
2610: 2d 73 79 6e 76 61 6c 75 65 73 2a 20 28 5b 28 76 -synvalues* ([(v
2620: 61 72 73 20 67 75 61 72 64 73 29 20 28 66 56 61 ars guards) (fVa
2630: 72 20 23 27 56 61 72 20 76 61 72 73 20 67 75 61 r #'Var vars gua
2640: 72 64 73 29 5d 29 0a 20 20 20 20 20 20 20 20 20 rds)]).
2650: 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 27 61 (values #'a
2660: 6e 79 20 23 27 76 61 72 73 20 23 27 67 75 61 72 ny #'vars #'guar
2670: 64 73 20 63 64 65 63 6c 73 29 29 29 29 29 0a 20 ds cdecls))))).
2680: 20 20 20 20 20 20 20 28 28 28 75 6e 71 75 6f 74 (((unquot
2690: 65 20 2e 20 73 74 75 66 66 29 20 44 6f 74 73 29 e . stuff) Dots)
26a0: 0a 20 20 20 20 20 20 20 20 20 28 65 6c 6c 69 70 . (ellip
26b0: 73 69 73 3f 20 23 27 44 6f 74 73 29 0a 20 20 20 sis? #'Dots).
26c0: 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61 (syntax-ca
26d0: 73 65 20 73 79 6e 20 28 75 6e 71 75 6f 74 65 20 se syn (unquote
26e0: 2d 3e 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ->). (
26f0: 28 28 75 6e 71 75 6f 74 65 20 5b 4d 79 43 61 74 ((unquote [MyCat
2700: 61 20 2d 3e 20 56 61 72 20 2e 2e 2e 5d 29 20 44 a -> Var ...]) D
2710: 6f 74 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ots).
2720: 20 28 61 6e 64 6d 61 70 20 56 61 72 3f 20 23 27 (andmap Var? #'
2730: 28 56 61 72 20 2e 2e 2e 29 29 0a 20 20 20 20 20 (Var ...)).
2740: 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 6e (with-syn
2750: 74 61 78 20 28 28 28 54 65 6d 70 29 20 28 67 65 tax (((Temp) (ge
2760: 6e 65 72 61 74 65 2d 74 65 6d 70 6f 72 61 72 69 nerate-temporari
2770: 65 73 20 27 28 78 29 29 29 0a 20 20 20 20 20 20 es '(x))).
2780: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2790: 20 20 20 20 28 44 65 70 74 68 2b 31 20 28 61 64 (Depth+1 (ad
27a0: 64 31 20 64 65 70 74 68 29 29 29 0a 20 20 20 20 d1 depth))).
27b0: 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 (value
27c0: 73 20 23 27 65 61 63 68 2d 61 6e 79 0a 20 20 20 s #'each-any.
27d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
27e0: 20 20 20 28 63 6f 6e 73 20 23 27 54 65 6d 70 20 (cons #'Temp
27f0: 76 61 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 vars).
2800: 20 20 20 20 20 20 20 20 20 20 20 20 67 75 61 72 guar
2810: 64 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ds.
2820: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 20 23 (cons #
2830: 27 5b 54 65 6d 70 20 44 65 70 74 68 2b 31 20 4d '[Temp Depth+1 M
2840: 79 43 61 74 61 20 56 61 72 20 2e 2e 2e 5d 20 63 yCata Var ...] c
2850: 64 65 63 6c 73 29 29 29 29 0a 20 20 20 20 20 20 decls)))).
2860: 20 20 20 20 20 28 28 28 75 6e 71 75 6f 74 65 20 (((unquote
2870: 5b 56 61 72 20 2e 2e 2e 5d 29 20 44 6f 74 73 29 [Var ...]) Dots)
2880: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 61 6e . (an
2890: 64 6d 61 70 20 56 61 72 3f 20 23 27 28 56 61 72 dmap Var? #'(Var
28a0: 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20 20 20 20 ...)).
28b0: 20 20 20 28 77 69 74 68 2d 73 79 6e 74 61 78 20 (with-syntax
28c0: 28 28 28 54 65 6d 70 29 20 28 67 65 6e 65 72 61 (((Temp) (genera
28d0: 74 65 2d 74 65 6d 70 6f 72 61 72 69 65 73 20 27 te-temporaries '
28e0: 28 78 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 (x))).
28f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2900: 28 44 65 70 74 68 2b 31 20 28 61 64 64 31 20 64 (Depth+1 (add1 d
2910: 65 70 74 68 29 29 29 0a 20 20 20 20 20 20 20 20 epth))).
2920: 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 27 (values #'
2930: 65 61 63 68 2d 61 6e 79 0a 20 20 20 20 20 20 20 each-any.
2940: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2950: 63 6f 6e 73 20 23 27 54 65 6d 70 20 76 61 72 73 cons #'Temp vars
2960: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
2970: 20 20 20 20 20 20 20 20 67 75 61 72 64 73 0a 20 guards.
2980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2990: 20 20 20 20 20 28 63 6f 6e 73 20 23 27 5b 54 65 (cons #'[Te
29a0: 6d 70 20 44 65 70 74 68 2b 31 20 23 66 20 56 61 mp Depth+1 #f Va
29b0: 72 20 2e 2e 2e 5d 20 63 64 65 63 6c 73 29 29 29 r ...] cdecls)))
29c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 28 28 ). (((
29d0: 75 6e 71 75 6f 74 65 20 56 61 72 29 20 44 6f 74 unquote Var) Dot
29e0: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 s). (
29f0: 56 61 72 3f 20 23 27 56 61 72 29 0a 20 20 20 20 Var? #'Var).
2a00: 20 20 20 20 20 20 20 20 28 6c 65 74 2d 73 79 6e (let-syn
2a10: 76 61 6c 75 65 73 2a 20 28 5b 28 76 61 72 73 20 values* ([(vars
2a20: 67 75 61 72 64 73 29 20 28 66 56 61 72 20 23 27 guards) (fVar #'
2a30: 56 61 72 20 76 61 72 73 20 67 75 61 72 64 73 29 Var vars guards)
2a40: 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ]).
2a50: 20 28 76 61 6c 75 65 73 20 23 27 65 61 63 68 2d (values #'each-
2a60: 61 6e 79 20 23 27 76 61 72 73 20 23 27 67 75 61 any #'vars #'gua
2a70: 72 64 73 20 63 64 65 63 6c 73 29 29 29 0a 20 20 rds cdecls))).
2a80: 20 20 20 20 20 20 20 20 20 28 28 65 78 70 72 20 ((expr
2a90: 44 6f 74 73 29 20 28 73 79 6e 74 61 78 2d 65 72 Dots) (syntax-er
2aa0: 72 6f 72 20 23 27 65 78 70 72 20 22 6d 61 74 63 ror #'expr "matc
2ab0: 68 2d 70 61 74 74 65 72 6e 20 75 6e 71 75 6f 74 h-pattern unquot
2ac0: 65 20 73 79 6e 74 61 78 22 29 29 29 29 0a 20 20 e syntax")))).
2ad0: 20 20 20 20 20 20 28 28 50 61 74 20 44 6f 74 73 ((Pat Dots
2ae0: 29 0a 20 20 20 20 20 20 20 20 20 28 65 6c 6c 69 ). (elli
2af0: 70 73 69 73 3f 20 23 27 44 6f 74 73 29 0a 20 20 psis? #'Dots).
2b00: 20 20 20 20 20 20 20 28 6c 65 74 2d 73 79 6e 76 (let-synv
2b10: 61 6c 75 65 73 2a 20 28 28 28 44 70 61 74 20 44 alues* (((Dpat D
2b20: 76 61 72 73 20 44 67 75 61 72 64 73 20 44 63 64 vars Dguards Dcd
2b30: 65 63 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 ecls).
2b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2b50: 20 28 66 20 23 27 50 61 74 20 76 61 72 73 20 67 (f #'Pat vars g
2b60: 75 61 72 64 73 20 63 64 65 63 6c 73 20 28 61 64 uards cdecls (ad
2b70: 64 31 20 64 65 70 74 68 29 29 29 29 0a 20 20 20 d1 depth)))).
2b80: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 (with-sy
2b90: 6e 74 61 78 20 28 28 53 69 7a 65 20 28 2d 20 28 ntax ((Size (- (
2ba0: 6c 65 6e 67 74 68 20 23 27 44 76 61 72 73 29 20 length #'Dvars)
2bb0: 28 6c 65 6e 67 74 68 20 76 61 72 73 29 29 29 29 (length vars))))
2bc0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 . (v
2bd0: 61 6c 75 65 73 20 23 27 23 28 65 61 63 68 20 44 alues #'#(each D
2be0: 70 61 74 20 53 69 7a 65 29 20 23 27 44 76 61 72 pat Size) #'Dvar
2bf0: 73 20 23 27 44 67 75 61 72 64 73 20 23 27 44 63 s #'Dguards #'Dc
2c00: 64 65 63 6c 73 29 29 29 29 0a 20 20 20 20 20 20 decls)))).
2c10: 20 20 28 28 50 61 74 20 44 6f 74 73 20 2e 20 52 ((Pat Dots . R
2c20: 65 73 74 29 0a 20 20 20 20 20 20 20 20 20 28 65 est). (e
2c30: 6c 6c 69 70 73 69 73 3f 20 23 27 44 6f 74 73 29 llipsis? #'Dots)
2c40: 0a 20 20 20 20 20 20 20 20 20 28 6c 65 74 2d 73 . (let-s
2c50: 79 6e 76 61 6c 75 65 73 2a 20 28 28 28 52 70 61 ynvalues* (((Rpa
2c60: 74 20 52 76 61 72 73 20 52 67 75 61 72 64 73 20 t Rvars Rguards
2c70: 52 63 64 65 63 6c 73 29 0a 20 20 20 20 20 20 20 Rcdecls).
2c80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2c90: 20 20 20 20 28 66 20 23 27 52 65 73 74 20 76 61 (f #'Rest va
2ca0: 72 73 20 67 75 61 72 64 73 20 63 64 65 63 6c 73 rs guards cdecls
2cb0: 20 64 65 70 74 68 29 29 0a 20 20 20 20 20 20 20 depth)).
2cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2cd0: 20 20 20 28 28 44 70 61 74 20 44 76 61 72 73 20 ((Dpat Dvars
2ce0: 44 67 75 61 72 64 73 20 44 63 64 65 63 6c 73 29 Dguards Dcdecls)
2cf0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2d00: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 20 23 (f #
2d10: 27 28 50 61 74 20 28 2e 2e 2e 20 2e 2e 2e 29 29 '(Pat (... ...))
2d20: 20 23 27 52 76 61 72 73 20 23 27 52 67 75 61 72 #'Rvars #'Rguar
2d30: 64 73 20 23 27 52 63 64 65 63 6c 73 0a 20 20 20 ds #'Rcdecls.
2d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2d50: 20 20 20 20 20 20 20 20 20 20 64 65 70 74 68 29 depth)
2d60: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 77 )). (w
2d70: 69 74 68 2d 73 79 6e 74 61 78 20 28 28 53 69 7a ith-syntax ((Siz
2d80: 65 20 28 2d 20 28 6c 65 6e 67 74 68 20 23 27 44 e (- (length #'D
2d90: 76 61 72 73 29 20 28 6c 65 6e 67 74 68 20 23 27 vars) (length #'
2da0: 52 76 61 72 73 29 29 29 0a 20 20 20 20 20 20 20 Rvars))).
2db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2dc0: 20 20 28 28 52 65 76 52 65 73 74 54 6c 20 2e 20 ((RevRestTl .
2dd0: 52 65 76 52 65 73 74 29 20 28 72 65 76 65 72 73 RevRest) (revers
2de0: 65 58 20 23 27 52 70 61 74 20 27 28 29 29 29 29 eX #'Rpat '())))
2df0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 . (v
2e00: 61 6c 75 65 73 20 23 27 23 28 74 61 69 6c 2d 65 alues #'#(tail-e
2e10: 61 63 68 20 44 70 61 74 20 53 69 7a 65 20 52 65 ach Dpat Size Re
2e20: 76 52 65 73 74 20 52 65 76 52 65 73 74 54 6c 29 vRest RevRestTl)
2e30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
2e40: 20 20 20 20 20 20 23 27 44 76 61 72 73 20 23 27 #'Dvars #'
2e50: 44 67 75 61 72 64 73 20 23 27 44 63 64 65 63 6c Dguards #'Dcdecl
2e60: 73 29 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 s)))). ((
2e70: 58 20 2e 20 59 29 0a 20 20 20 20 20 20 20 20 20 X . Y).
2e80: 28 6c 65 74 2d 73 79 6e 76 61 6c 75 65 73 2a 20 (let-synvalues*
2e90: 28 28 28 59 70 61 74 20 59 76 61 72 73 20 59 67 (((Ypat Yvars Yg
2ea0: 75 61 72 64 73 20 59 63 64 65 63 6c 73 29 0a 20 uards Ycdecls).
2eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2ec0: 20 20 20 20 20 20 20 20 20 20 28 66 20 23 27 59 (f #'Y
2ed0: 20 76 61 72 73 20 67 75 61 72 64 73 20 63 64 65 vars guards cde
2ee0: 63 6c 73 20 64 65 70 74 68 29 29 0a 20 20 20 20 cls depth)).
2ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
2f00: 20 20 20 20 20 20 28 28 58 70 61 74 20 58 76 61 ((Xpat Xva
2f10: 72 73 20 58 67 75 61 72 64 73 20 58 63 64 65 63 rs Xguards Xcdec
2f20: 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
2f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
2f40: 66 20 23 27 58 20 23 27 59 76 61 72 73 20 23 27 f #'X #'Yvars #'
2f50: 59 67 75 61 72 64 73 20 23 27 59 63 64 65 63 6c Yguards #'Ycdecl
2f60: 73 20 64 65 70 74 68 29 29 29 0a 20 20 20 20 20 s depth))).
2f70: 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 27 (values #'
2f80: 28 58 70 61 74 20 2e 20 59 70 61 74 29 20 23 27 (Xpat . Ypat) #'
2f90: 58 76 61 72 73 20 23 27 58 67 75 61 72 64 73 20 Xvars #'Xguards
2fa0: 23 27 58 63 64 65 63 6c 73 29 29 29 0a 20 20 20 #'Xcdecls))).
2fb0: 20 20 20 20 20 28 28 29 20 28 76 61 6c 75 65 73 (() (values
2fc0: 20 23 27 28 29 20 76 61 72 73 20 67 75 61 72 64 #'() vars guard
2fd0: 73 20 63 64 65 63 6c 73 29 29 0a 20 20 20 20 20 s cdecls)).
2fe0: 20 20 20 28 23 28 58 20 2e 2e 2e 29 0a 20 20 20 (#(X ...).
2ff0: 20 20 20 20 20 20 28 6c 65 74 2d 73 79 6e 76 61 (let-synva
3000: 6c 75 65 73 2a 20 28 28 28 50 61 74 20 56 61 72 lues* (((Pat Var
3010: 73 20 45 71 76 61 72 73 20 43 64 65 63 6c 73 29 s Eqvars Cdecls)
3020: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3030: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 20 23 (f #
3040: 27 28 58 20 2e 2e 2e 29 20 76 61 72 73 20 67 75 '(X ...) vars gu
3050: 61 72 64 73 20 63 64 65 63 6c 73 20 64 65 70 74 ards cdecls dept
3060: 68 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 h))).
3070: 28 76 61 6c 75 65 73 20 23 27 23 28 76 65 63 74 (values #'#(vect
3080: 6f 72 20 50 61 74 29 20 23 27 56 61 72 73 20 23 or Pat) #'Vars #
3090: 27 45 71 76 61 72 73 20 23 27 43 64 65 63 6c 73 'Eqvars #'Cdecls
30a0: 29 29 29 0a 20 20 20 20 20 20 20 20 28 54 68 69 ))). (Thi
30b0: 6e 67 20 28 76 61 6c 75 65 73 20 23 27 23 28 61 ng (values #'#(a
30c0: 74 6f 6d 20 54 68 69 6e 67 29 20 76 61 72 73 20 tom Thing) vars
30d0: 67 75 61 72 64 73 20 63 64 65 63 6c 73 29 29 29 guards cdecls)))
30e0: 29 0a 20 20 20 20 28 64 65 66 69 6e 65 20 72 65 ). (define re
30f0: 76 65 72 73 65 58 0a 20 20 20 20 20 20 28 6c 61 verseX. (la
3100: 6d 62 64 61 20 28 6c 73 20 61 63 63 29 0a 20 20 mbda (ls acc).
3110: 20 20 20 20 20 20 28 69 66 20 28 70 61 69 72 3f (if (pair?
3120: 20 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 ls).
3130: 20 28 72 65 76 65 72 73 65 58 20 28 63 64 72 20 (reverseX (cdr
3140: 6c 73 29 20 28 63 6f 6e 73 20 28 63 61 72 20 6c ls) (cons (car l
3150: 73 29 20 61 63 63 29 29 0a 20 20 20 20 20 20 20 s) acc)).
3160: 20 20 20 20 20 28 63 6f 6e 73 20 6c 73 20 61 63 (cons ls ac
3170: 63 29 29 29 29 0a 20 20 20 20 28 64 65 66 69 6e c)))). (defin
3180: 65 2d 73 79 6e 74 61 78 20 6c 65 74 2d 73 79 6e e-syntax let-syn
3190: 76 61 6c 75 65 73 2a 0a 20 20 20 20 20 20 28 73 values*. (s
31a0: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 yntax-rules ().
31b0: 20 20 20 20 20 20 20 28 28 5f 20 28 29 20 42 30 ((_ () B0
31c0: 20 42 20 2e 2e 2e 29 20 28 62 65 67 69 6e 20 42 B ...) (begin B
31d0: 30 20 42 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20 0 B ...)).
31e0: 20 20 28 28 5f 20 28 28 28 46 6f 72 6d 61 6c 20 ((_ (((Formal
31f0: 2e 2e 2e 29 20 45 78 70 29 20 44 65 63 6c 20 2e ...) Exp) Decl .
3200: 2e 2e 29 20 42 30 20 42 20 2e 2e 2e 29 0a 20 20 ..) B0 B ...).
3210: 20 20 20 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 (call-wit
3220: 68 2d 76 61 6c 75 65 73 20 28 6c 61 6d 62 64 61 h-values (lambda
3230: 20 28 29 20 45 78 70 29 0a 20 20 20 20 20 20 20 () Exp).
3240: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 46 6f 72 (lambda (For
3250: 6d 61 6c 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 mal ...).
3260: 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 6e 74 (with-synt
3270: 61 78 20 28 28 46 6f 72 6d 61 6c 20 46 6f 72 6d ax ((Formal Form
3280: 61 6c 29 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 al) ...).
3290: 20 20 20 20 20 20 20 20 28 6c 65 74 2d 73 79 6e (let-syn
32a0: 76 61 6c 75 65 73 2a 20 28 44 65 63 6c 20 2e 2e values* (Decl ..
32b0: 2e 29 20 42 30 20 42 20 2e 2e 2e 29 29 29 29 29 .) B0 B ...)))))
32c0: 29 29 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28 )). (lambda (
32d0: 73 79 6e 29 20 0a 20 20 20 20 20 20 28 73 79 6e syn) . (syn
32e0: 74 61 78 2d 63 61 73 65 20 73 79 6e 20 28 29 0a tax-case syn ().
32f0: 20 20 20 20 20 20 20 20 28 28 5f 20 73 79 6e 20 ((_ syn
3300: 28 6b 68 20 2e 20 6b 74 29 29 0a 20 20 20 20 20 (kh . kt)).
3310: 20 20 20 20 28 6c 65 74 2d 73 79 6e 76 61 6c 75 (let-synvalu
3320: 65 73 2a 20 28 28 28 50 61 74 20 56 61 72 73 20 es* (((Pat Vars
3330: 47 75 61 72 64 73 20 43 64 65 63 6c 73 29 20 28 Guards Cdecls) (
3340: 66 20 23 27 73 79 6e 20 27 28 29 20 27 28 29 20 f #'syn '() '()
3350: 27 28 29 20 30 29 29 29 0a 20 20 20 20 20 20 20 '() 0))).
3360: 20 20 20 20 23 27 28 6b 68 20 27 50 61 74 20 56 #'(kh 'Pat V
3370: 61 72 73 20 47 75 61 72 64 73 20 43 64 65 63 6c ars Guards Cdecl
3380: 73 20 2e 20 6b 74 29 29 29 29 29 29 29 0a 0a 28 s . kt)))))))..(
3390: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 61 define-syntax ma
33a0: 70 70 65 72 0a 20 20 28 6c 61 6d 62 64 61 20 28 pper. (lambda (
33b0: 78 29 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 63 x). (syntax-c
33c0: 61 73 65 20 78 20 28 29 0a 20 20 20 20 20 20 28 ase x (). (
33d0: 28 5f 20 46 20 28 52 65 74 49 64 20 2e 2e 2e 29 (_ F (RetId ...)
33e0: 20 28 54 68 72 65 61 64 49 64 20 2e 2e 2e 29 29 (ThreadId ...))
33f0: 0a 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 . (with-sy
3400: 6e 74 61 78 20 28 28 28 74 20 2e 2e 2e 29 20 28 ntax (((t ...) (
3410: 67 65 6e 65 72 61 74 65 2d 74 65 6d 70 6f 72 61 generate-tempora
3420: 72 69 65 73 20 23 27 28 52 65 74 49 64 20 2e 2e ries #'(RetId ..
3430: 2e 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 .))).
3440: 20 20 20 20 20 20 20 20 20 20 28 28 74 73 20 2e ((ts .
3450: 2e 2e 29 20 28 67 65 6e 65 72 61 74 65 2d 74 65 ..) (generate-te
3460: 6d 70 6f 72 61 72 69 65 73 20 23 27 28 52 65 74 mporaries #'(Ret
3470: 49 64 20 2e 2e 2e 29 29 29 0a 20 20 20 20 20 20 Id ...))).
3480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
3490: 28 6e 75 6c 6c 20 2e 2e 2e 29 20 28 6d 61 70 20 (null ...) (map
34a0: 28 6c 61 6d 62 64 61 20 28 78 29 20 23 27 27 28 (lambda (x) #''(
34b0: 29 29 20 23 27 28 52 65 74 49 64 20 2e 2e 2e 29 )) #'(RetId ...)
34c0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 23 27 28 ))). #'(
34d0: 6c 65 74 20 28 28 66 75 6e 20 46 29 29 0a 20 20 let ((fun F)).
34e0: 20 20 20 20 20 20 20 20 20 20 20 28 72 65 63 20 (rec
34f0: 67 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 g.
3500: 20 28 6c 61 6d 62 64 61 20 28 54 68 72 65 61 64 (lambda (Thread
3510: 49 64 20 2e 2e 2e 20 6c 73 29 0a 20 20 20 20 20 Id ... ls).
3520: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
3530: 28 6e 75 6c 6c 3f 20 6c 73 29 0a 20 20 20 20 20 (null? ls).
3540: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3550: 28 76 61 6c 75 65 73 20 54 68 72 65 61 64 49 64 (values ThreadId
3560: 20 2e 2e 2e 20 6e 75 6c 6c 20 2e 2e 2e 29 0a 20 ... null ...).
3570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3580: 20 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d 76 (call-with-v
3590: 61 6c 75 65 73 0a 20 20 20 20 20 20 20 20 20 20 alues.
35a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
35b0: 6c 61 6d 62 64 61 20 28 29 20 28 67 20 54 68 72 lambda () (g Thr
35c0: 65 61 64 49 64 20 2e 2e 2e 20 28 63 64 72 20 6c eadId ... (cdr l
35d0: 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s))).
35e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam
35f0: 62 64 61 20 28 54 68 72 65 61 64 49 64 20 2e 2e bda (ThreadId ..
3600: 2e 20 74 73 20 2e 2e 2e 29 0a 20 20 20 20 20 20 . ts ...).
3610: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3620: 20 20 20 28 63 61 6c 6c 2d 77 69 74 68 2d 76 61 (call-with-va
3630: 6c 75 65 73 0a 20 20 20 20 20 20 20 20 20 20 20 lues.
3640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3650: 20 20 28 6c 61 6d 62 64 61 20 28 29 20 28 66 75 (lambda () (fu
3660: 6e 20 54 68 72 65 61 64 49 64 20 2e 2e 2e 20 28 n ThreadId ... (
3670: 63 61 72 20 6c 73 29 29 29 0a 20 20 20 20 20 20 car ls))).
3680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3690: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 54 68 (lambda (Th
36a0: 72 65 61 64 49 64 20 2e 2e 2e 20 74 20 2e 2e 2e readId ... t ...
36b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
36c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
36d0: 76 61 6c 75 65 73 20 54 68 72 65 61 64 49 64 20 values ThreadId
36e0: 2e 2e 2e 20 28 63 6f 6e 73 20 74 20 74 73 29 20 ... (cons t ts)
36f0: 2e 2e 2e 29 29 29 29 29 29 29 29 29 29 29 29 29 ...)))))))))))))
3700: 29 0a 0a 3b 3b 3b 20 2d 2d 2d 2d 2d 2d 2d 2d 2d )..;;; ---------
3710: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
3720: 2d 2d 2d 2d 2d 0a 0a 28 64 65 66 69 6e 65 2d 73 -----..(define-s
3730: 79 6e 74 61 78 20 6d 79 2d 62 61 63 6b 71 75 6f yntax my-backquo
3740: 74 65 0a 20 20 28 6c 61 6d 62 64 61 20 28 78 29 te. (lambda (x)
3750: 0a 20 20 20 20 28 64 65 66 69 6e 65 20 65 6c 6c . (define ell
3760: 69 70 73 69 73 3f 0a 20 20 20 20 20 20 28 6c 61 ipsis?. (la
3770: 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 mbda (x).
3780: 20 28 61 6e 64 20 28 69 64 65 6e 74 69 66 69 65 (and (identifie
3790: 72 3f 20 78 29 20 28 66 72 65 65 2d 69 64 65 6e r? x) (free-iden
37a0: 74 69 66 69 65 72 3d 3f 20 78 20 23 27 28 2e 2e tifier=? x #'(..
37b0: 2e 20 2e 2e 2e 29 29 29 29 29 0a 20 20 20 20 28 . ...))))). (
37c0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 77 69 define-syntax wi
37d0: 74 68 2d 76 61 6c 75 65 73 0a 20 20 20 20 20 20 th-values.
37e0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules ()
37f0: 0a 20 20 20 20 20 20 20 20 28 28 5f 20 50 20 43 . ((_ P C
3800: 29 20 28 63 61 6c 6c 2d 77 69 74 68 2d 76 61 6c ) (call-with-val
3810: 75 65 73 20 28 6c 61 6d 62 64 61 20 28 29 20 50 ues (lambda () P
3820: 29 20 43 29 29 29 29 0a 20 20 20 20 28 64 65 66 ) C)))). (def
3830: 69 6e 65 2d 73 79 6e 74 61 78 20 73 79 6e 74 61 ine-syntax synta
3840: 78 2d 6c 61 6d 62 64 61 0a 20 20 20 20 20 20 28 x-lambda. (
3850: 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 lambda (x).
3860: 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 (syntax-case
3870: 78 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 28 x (). (
3880: 28 5f 20 28 50 61 74 20 2e 2e 2e 29 20 42 6f 64 (_ (Pat ...) Bod
3890: 79 30 20 42 6f 64 79 20 2e 2e 2e 29 0a 20 20 20 y0 Body ...).
38a0: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 (with-sy
38b0: 6e 74 61 78 20 28 28 28 58 20 2e 2e 2e 29 20 28 ntax (((X ...) (
38c0: 67 65 6e 65 72 61 74 65 2d 74 65 6d 70 6f 72 61 generate-tempora
38d0: 72 69 65 73 20 23 27 28 50 61 74 20 2e 2e 2e 29 ries #'(Pat ...)
38e0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
38f0: 20 23 27 28 6c 61 6d 62 64 61 20 28 58 20 2e 2e #'(lambda (X ..
3900: 2e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 .).
3910: 20 20 20 20 28 77 69 74 68 2d 73 79 6e 74 61 78 (with-syntax
3920: 20 28 28 50 61 74 20 58 29 20 2e 2e 2e 29 0a 20 ((Pat X) ...).
3930: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3940: 20 20 42 6f 64 79 30 20 42 6f 64 79 20 2e 2e 2e Body0 Body ...
3950: 29 29 29 29 29 29 29 0a 20 20 20 20 28 64 65 66 ))))))). (def
3960: 69 6e 65 2d 73 79 6e 74 61 78 20 77 69 74 68 2d ine-syntax with-
3970: 74 65 6d 70 0a 20 20 20 20 20 20 28 73 79 6e 74 temp. (synt
3980: 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 ax-rules ().
3990: 20 20 20 20 28 28 5f 20 56 20 42 6f 64 79 30 20 ((_ V Body0
39a0: 42 6f 64 79 20 2e 2e 2e 29 0a 20 20 20 20 20 20 Body ...).
39b0: 20 20 20 28 77 69 74 68 2d 73 79 6e 74 61 78 20 (with-syntax
39c0: 28 28 28 56 29 20 28 67 65 6e 65 72 61 74 65 2d (((V) (generate-
39d0: 74 65 6d 70 6f 72 61 72 69 65 73 20 27 28 78 29 temporaries '(x)
39e0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 42 ))). B
39f0: 6f 64 79 30 20 42 6f 64 79 20 2e 2e 2e 29 29 29 ody0 Body ...)))
3a00: 29 0a 20 20 20 20 28 64 65 66 69 6e 65 2d 73 79 ). (define-sy
3a10: 6e 74 61 78 20 77 69 74 68 2d 74 65 6d 70 73 0a ntax with-temps.
3a20: 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 72 75 (syntax-ru
3a30: 6c 65 73 20 28 29 0a 20 20 20 20 20 20 20 20 28 les (). (
3a40: 28 5f 20 28 56 20 2e 2e 2e 29 20 28 45 78 70 20 (_ (V ...) (Exp
3a50: 2e 2e 2e 29 20 42 6f 64 79 30 20 42 6f 64 79 20 ...) Body0 Body
3a60: 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 28 77 ...). (w
3a70: 69 74 68 2d 73 79 6e 74 61 78 20 28 28 28 56 20 ith-syntax (((V
3a80: 2e 2e 2e 29 20 28 67 65 6e 65 72 61 74 65 2d 74 ...) (generate-t
3a90: 65 6d 70 6f 72 61 72 69 65 73 20 23 27 28 45 78 emporaries #'(Ex
3aa0: 70 20 2e 2e 2e 29 29 29 29 0a 20 20 20 20 20 20 p ...)))).
3ab0: 20 20 20 20 20 42 6f 64 79 30 20 42 6f 64 79 20 Body0 Body
3ac0: 2e 2e 2e 29 29 29 29 0a 20 20 20 20 28 64 65 66 ...)))). (def
3ad0: 69 6e 65 20 64 65 73 74 72 75 63 74 0a 20 20 20 ine destruct.
3ae0: 20 20 20 28 6c 61 6d 62 64 61 20 28 4f 72 69 67 (lambda (Orig
3af0: 20 78 20 64 65 70 74 68 29 0a 20 20 20 20 20 20 x depth).
3b00: 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 78 (syntax-case x
3b10: 20 28 71 75 61 73 69 71 75 6f 74 65 20 75 6e 71 (quasiquote unq
3b20: 75 6f 74 65 20 75 6e 71 75 6f 74 65 2d 73 70 6c uote unquote-spl
3b30: 69 63 69 6e 67 29 0a 20 20 20 20 20 20 20 20 20 icing).
3b40: 20 3b 3b 20 69 6e 6e 65 72 20 71 75 61 73 69 71 ;; inner quasiq
3b50: 75 6f 74 65 0a 20 20 20 20 20 20 20 20 20 20 28 uote. (
3b60: 28 45 78 70 20 64 6f 74 73 31 20 64 6f 74 73 32 (Exp dots1 dots2
3b70: 20 2e 20 52 65 73 74 29 0a 20 20 20 20 20 20 20 . Rest).
3b80: 20 20 20 20 28 61 6e 64 20 28 7a 65 72 6f 3f 20 (and (zero?
3b90: 64 65 70 74 68 29 20 28 65 6c 6c 69 70 73 69 73 depth) (ellipsis
3ba0: 3f 20 23 27 64 6f 74 73 31 29 20 28 65 6c 6c 69 ? #'dots1) (elli
3bb0: 70 73 69 73 3f 20 23 27 64 6f 74 73 32 29 29 0a psis? #'dots2)).
3bc0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let
3bd0: 66 20 28 5b 45 78 70 20 23 27 28 2e 2e 2e 20 28 f ([Exp #'(... (
3be0: 28 45 78 70 20 2e 2e 2e 29 20 2e 2e 2e 29 29 5d (Exp ...) ...))]
3bf0: 20 5b 52 65 73 74 20 23 27 52 65 73 74 5d 20 5b [Rest #'Rest] [
3c00: 6e 64 6f 74 73 20 32 5d 29 0a 20 20 20 20 20 20 ndots 2]).
3c10: 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 2d 63 (syntax-c
3c20: 61 73 65 20 52 65 73 74 20 28 29 0a 20 20 20 20 ase Rest ().
3c30: 20 20 20 20 20 20 20 20 20 20 20 5b 28 64 6f 74 [(dot
3c40: 73 20 2e 20 52 65 73 74 29 0a 20 20 20 20 20 20 s . Rest).
3c50: 20 20 20 20 20 20 20 20 20 20 28 65 6c 6c 69 70 (ellip
3c60: 73 69 73 3f 20 23 27 64 6f 74 73 29 0a 20 20 20 sis? #'dots).
3c70: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 77 69 (wi
3c80: 74 68 2d 73 79 6e 74 61 78 20 28 5b 45 78 70 20 th-syntax ([Exp
3c90: 45 78 70 5d 29 0a 20 20 20 20 20 20 20 20 20 20 Exp]).
3ca0: 20 20 20 20 20 20 20 20 28 66 20 23 27 28 2e 2e (f #'(..
3cb0: 2e 20 28 45 78 70 20 2e 2e 2e 29 29 20 23 27 52 . (Exp ...)) #'R
3cc0: 65 73 74 20 28 2b 20 6e 64 6f 74 73 20 31 29 29 est (+ ndots 1))
3cd0: 29 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )].
3ce0: 20 20 5b 52 65 73 74 0a 20 20 20 20 20 20 20 20 [Rest.
3cf0: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 76 61 (with-va
3d00: 6c 75 65 73 20 28 64 65 73 74 72 75 63 74 20 4f lues (destruct O
3d10: 72 69 67 20 45 78 70 20 64 65 70 74 68 29 0a 20 rig Exp depth).
3d20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3d30: 20 28 73 79 6e 74 61 78 2d 6c 61 6d 62 64 61 20 (syntax-lambda
3d40: 28 45 78 70 42 75 69 6c 64 65 72 20 28 45 78 70 (ExpBuilder (Exp
3d50: 56 61 72 20 2e 2e 2e 29 20 28 45 78 70 45 78 70 Var ...) (ExpExp
3d60: 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20 20 20 20 ...)).
3d70: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
3d80: 6e 75 6c 6c 3f 20 23 27 28 45 78 70 56 61 72 20 null? #'(ExpVar
3d90: 2e 2e 2e 29 29 0a 20 20 20 20 20 20 20 20 20 20 ...)).
3da0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
3db0: 79 6e 74 61 78 2d 65 72 72 6f 72 20 4f 72 69 67 yntax-error Orig
3dc0: 20 22 42 61 64 20 65 6c 6c 69 70 73 69 73 22 29 "Bad ellipsis")
3dd0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
3de0: 20 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 76 (with-v
3df0: 61 6c 75 65 73 20 28 64 65 73 74 72 75 63 74 20 alues (destruct
3e00: 4f 72 69 67 20 23 27 52 65 73 74 20 64 65 70 74 Orig #'Rest dept
3e10: 68 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 h).
3e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 79 (sy
3e30: 6e 74 61 78 2d 6c 61 6d 62 64 61 20 28 52 65 73 ntax-lambda (Res
3e40: 74 42 75 69 6c 64 65 72 20 52 65 73 74 56 61 72 tBuilder RestVar
3e50: 73 20 52 65 73 74 45 78 70 73 29 0a 20 20 20 20 s RestExps).
3e60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e70: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 0a (values.
3e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3e90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 60 #`
3ea0: 28 61 70 70 65 6e 64 0a 20 20 20 20 20 20 20 20 (append.
3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3ec0: 20 20 20 20 20 20 20 20 20 20 23 2c 28 6c 65 74 #,(let
3ed0: 20 66 20 28 5b 6e 64 6f 74 73 20 6e 64 6f 74 73 f ([ndots ndots
3ee0: 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ]).
3ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f00: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 3d 20 (if (=
3f10: 6e 64 6f 74 73 20 31 29 0a 20 20 20 20 20 20 20 ndots 1).
3f20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f40: 20 20 20 23 27 45 78 70 42 75 69 6c 64 65 72 0a #'ExpBuilder.
3f50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3f70: 20 20 20 20 20 20 20 20 20 20 23 60 28 61 70 70 #`(app
3f80: 6c 79 20 61 70 70 65 6e 64 20 23 2c 28 66 20 28 ly append #,(f (
3f90: 2d 20 6e 64 6f 74 73 20 31 29 29 29 29 29 0a 20 - ndots 1))))).
3fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fc0: 20 52 65 73 74 42 75 69 6c 64 65 72 29 0a 20 20 RestBuilder).
3fd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
3fe0: 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 70 (app
3ff0: 65 6e 64 20 23 27 28 45 78 70 56 61 72 20 2e 2e end #'(ExpVar ..
4000: 2e 29 20 23 27 52 65 73 74 56 61 72 73 29 0a 20 .) #'RestVars).
4010: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4020: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 70 (ap
4030: 70 65 6e 64 20 23 27 28 45 78 70 45 78 70 20 2e pend #'(ExpExp .
4040: 2e 2e 29 20 23 27 52 65 73 74 45 78 70 73 29 29 ..) #'RestExps))
4050: 29 29 29 29 29 5d 29 29 29 0a 20 20 20 20 20 20 )))))]))).
4060: 20 20 20 20 28 28 71 75 61 73 69 71 75 6f 74 65 ((quasiquote
4070: 20 45 78 70 29 0a 20 20 20 20 20 20 20 20 20 20 Exp).
4080: 20 28 77 69 74 68 2d 76 61 6c 75 65 73 20 28 64 (with-values (d
4090: 65 73 74 72 75 63 74 20 4f 72 69 67 20 23 27 45 estruct Orig #'E
40a0: 78 70 20 28 61 64 64 31 20 64 65 70 74 68 29 29 xp (add1 depth))
40b0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 . (s
40c0: 79 6e 74 61 78 2d 6c 61 6d 62 64 61 20 28 42 75 yntax-lambda (Bu
40d0: 69 6c 64 65 72 20 56 61 72 73 20 45 78 70 73 29 ilder Vars Exps)
40e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
40f0: 28 69 66 20 28 6e 75 6c 6c 3f 20 23 27 56 61 72 (if (null? #'Var
4100: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
4110: 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 27 (values #'
4120: 27 28 71 75 61 73 69 71 75 6f 74 65 20 45 78 70 '(quasiquote Exp
4130: 29 20 27 28 29 20 27 28 29 29 0a 20 20 20 20 20 ) '() '()).
4140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 76 (v
4150: 61 6c 75 65 73 20 23 27 28 6c 69 73 74 20 27 71 alues #'(list 'q
4160: 75 61 73 69 71 75 6f 74 65 20 42 75 69 6c 64 65 uasiquote Builde
4170: 72 29 20 23 27 56 61 72 73 20 23 27 45 78 70 73 r) #'Vars #'Exps
4180: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
4190: 3b 3b 20 75 6e 71 75 6f 74 65 0a 20 20 20 20 20 ;; unquote.
41a0: 20 20 20 20 20 28 28 75 6e 71 75 6f 74 65 20 45 ((unquote E
41b0: 78 70 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 xp). (
41c0: 7a 65 72 6f 3f 20 64 65 70 74 68 29 0a 20 20 20 zero? depth).
41d0: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 74 65 (with-te
41e0: 6d 70 20 58 0a 20 20 20 20 20 20 20 20 20 20 20 mp X.
41f0: 20 20 28 76 61 6c 75 65 73 20 23 27 58 20 28 6c (values #'X (l
4200: 69 73 74 20 23 27 58 29 20 28 6c 69 73 74 20 23 ist #'X) (list #
4210: 27 45 78 70 29 29 29 29 0a 20 20 20 20 20 20 20 'Exp)))).
4220: 20 20 20 28 28 75 6e 71 75 6f 74 65 20 45 78 70 ((unquote Exp
4230: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 77 69 ). (wi
4240: 74 68 2d 76 61 6c 75 65 73 20 28 64 65 73 74 72 th-values (destr
4250: 75 63 74 20 4f 72 69 67 20 23 27 45 78 70 20 28 uct Orig #'Exp (
4260: 73 75 62 31 20 64 65 70 74 68 29 29 0a 20 20 20 sub1 depth)).
4270: 20 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 (synta
4280: 78 2d 6c 61 6d 62 64 61 20 28 42 75 69 6c 64 65 x-lambda (Builde
4290: 72 20 56 61 72 73 20 45 78 70 73 29 0a 20 20 20 r Vars Exps).
42a0: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
42b0: 28 6e 75 6c 6c 3f 20 23 27 56 61 72 73 29 0a 20 (null? #'Vars).
42c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
42d0: 20 20 28 76 61 6c 75 65 73 20 23 27 27 28 75 6e (values #''(un
42e0: 71 75 6f 74 65 20 45 78 70 29 20 27 28 29 20 27 quote Exp) '() '
42f0: 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ()).
4300: 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 (values #
4310: 27 28 6c 69 73 74 20 27 75 6e 71 75 6f 74 65 20 '(list 'unquote
4320: 42 75 69 6c 64 65 72 29 20 23 27 56 61 72 73 20 Builder) #'Vars
4330: 23 27 45 78 70 73 29 29 29 29 29 0a 20 20 20 20 #'Exps))))).
4340: 20 20 20 20 20 20 3b 3b 20 73 70 6c 69 63 69 6e ;; splicin
4350: 67 0a 20 20 20 20 20 20 20 20 20 20 28 28 28 75 g. (((u
4360: 6e 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e 67 20 nquote-splicing
4370: 45 78 70 29 29 0a 20 20 20 20 20 20 20 20 20 20 Exp)).
4380: 20 28 7a 65 72 6f 3f 20 64 65 70 74 68 29 0a 20 (zero? depth).
4390: 20 20 20 20 20 20 20 20 20 20 28 77 69 74 68 2d (with-
43a0: 74 65 6d 70 20 58 0a 20 20 20 20 20 20 20 20 20 temp X.
43b0: 20 20 20 20 28 76 61 6c 75 65 73 20 23 27 58 20 (values #'X
43c0: 28 6c 69 73 74 20 23 27 58 29 20 28 6c 69 73 74 (list #'X) (list
43d0: 20 23 27 45 78 70 29 29 29 29 0a 20 20 20 20 20 #'Exp)))).
43e0: 20 20 20 20 20 28 28 28 75 6e 71 75 6f 74 65 2d (((unquote-
43f0: 73 70 6c 69 63 69 6e 67 20 45 78 70 20 2e 2e 2e splicing Exp ...
4400: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 7a )). (z
4410: 65 72 6f 3f 20 64 65 70 74 68 29 0a 20 20 20 20 ero? depth).
4420: 20 20 20 20 20 20 20 28 77 69 74 68 2d 74 65 6d (with-tem
4430: 70 73 20 28 58 20 2e 2e 2e 29 20 28 45 78 70 20 ps (X ...) (Exp
4440: 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 20 20 ...).
4450: 20 20 28 76 61 6c 75 65 73 20 23 27 28 61 70 70 (values #'(app
4460: 65 6e 64 20 58 20 2e 2e 2e 29 20 23 27 28 58 20 end X ...) #'(X
4470: 2e 2e 2e 29 20 23 27 28 45 78 70 20 2e 2e 2e 29 ...) #'(Exp ...)
4480: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 ))). ((
4490: 28 75 6e 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e (unquote-splicin
44a0: 67 20 45 78 70 20 2e 2e 2e 29 20 2e 20 52 65 73 g Exp ...) . Res
44b0: 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 7a t). (z
44c0: 65 72 6f 3f 20 64 65 70 74 68 29 0a 20 20 20 20 ero? depth).
44d0: 20 20 20 20 20 20 20 28 77 69 74 68 2d 76 61 6c (with-val
44e0: 75 65 73 20 28 64 65 73 74 72 75 63 74 20 4f 72 ues (destruct Or
44f0: 69 67 20 23 27 52 65 73 74 20 64 65 70 74 68 29 ig #'Rest depth)
4500: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 . (s
4510: 79 6e 74 61 78 2d 6c 61 6d 62 64 61 20 28 42 75 yntax-lambda (Bu
4520: 69 6c 64 65 72 20 56 61 72 73 20 45 78 70 73 29 ilder Vars Exps)
4530: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4540: 28 77 69 74 68 2d 74 65 6d 70 73 20 28 58 20 2e (with-temps (X .
4550: 2e 2e 29 20 28 45 78 70 20 2e 2e 2e 29 0a 20 20 ..) (Exp ...).
4560: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4570: 69 66 20 28 6e 75 6c 6c 3f 20 23 27 56 61 72 73 if (null? #'Vars
4580: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4590: 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 (values #
45a0: 27 28 61 70 70 65 6e 64 20 58 20 2e 2e 2e 20 27 '(append X ... '
45b0: 52 65 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 Rest).
45c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
45d0: 20 20 20 23 27 28 58 20 2e 2e 2e 29 20 23 27 28 #'(X ...) #'(
45e0: 45 78 70 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20 Exp ...)).
45f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4600: 76 61 6c 75 65 73 20 23 27 28 61 70 70 65 6e 64 values #'(append
4610: 20 58 20 2e 2e 2e 20 42 75 69 6c 64 65 72 29 0a X ... Builder).
4620: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4630: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 27 28 #'(
4640: 58 20 2e 2e 2e 20 2e 20 56 61 72 73 29 20 23 27 X ... . Vars) #'
4650: 28 45 78 70 20 2e 2e 2e 20 2e 20 45 78 70 73 29 (Exp ... . Exps)
4660: 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 )))))).
4670: 20 28 28 75 6e 71 75 6f 74 65 2d 73 70 6c 69 63 ((unquote-splic
4680: 69 6e 67 20 45 78 70 20 2e 2e 2e 29 0a 20 20 20 ing Exp ...).
4690: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 76 61 (with-va
46a0: 6c 75 65 73 20 28 64 65 73 74 72 75 63 74 20 4f lues (destruct O
46b0: 72 69 67 20 23 27 28 45 78 70 20 2e 2e 2e 29 20 rig #'(Exp ...)
46c0: 28 73 75 62 31 20 64 65 70 74 68 29 29 0a 20 20 (sub1 depth)).
46d0: 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 (synt
46e0: 61 78 2d 6c 61 6d 62 64 61 20 28 42 75 69 6c 64 ax-lambda (Build
46f0: 65 72 20 56 61 72 73 20 45 78 70 73 29 0a 20 20 er Vars Exps).
4700: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
4710: 20 28 6e 75 6c 6c 3f 20 23 27 56 61 72 73 29 0a (null? #'Vars).
4720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4730: 20 20 20 28 76 61 6c 75 65 73 20 23 27 27 28 75 (values #''(u
4740: 6e 71 75 6f 74 65 2d 73 70 6c 69 63 69 6e 67 20 nquote-splicing
4750: 45 78 70 20 2e 2e 2e 29 20 27 28 29 20 27 28 29 Exp ...) '() '()
4760: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4770: 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 27 28 (values #'(
4780: 63 6f 6e 73 20 27 75 6e 71 75 6f 74 65 2d 73 70 cons 'unquote-sp
4790: 6c 69 63 69 6e 67 20 42 75 69 6c 64 65 72 29 0a licing Builder).
47a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
47b0: 20 20 20 20 20 20 20 20 20 20 20 23 27 56 61 72 #'Var
47c0: 73 20 23 27 45 78 70 73 29 29 29 29 29 0a 20 20 s #'Exps))))).
47d0: 20 20 20 20 20 20 20 20 3b 3b 20 64 6f 74 73 0a ;; dots.
47e0: 20 20 20 20 20 20 20 20 20 20 28 28 28 75 6e 71 (((unq
47f0: 75 6f 74 65 20 45 78 70 29 20 44 6f 74 73 29 0a uote Exp) Dots).
4800: 20 20 20 20 20 20 20 20 20 20 20 28 61 6e 64 20 (and
4810: 28 7a 65 72 6f 3f 20 64 65 70 74 68 29 20 28 65 (zero? depth) (e
4820: 6c 6c 69 70 73 69 73 3f 20 23 27 44 6f 74 73 29 llipsis? #'Dots)
4830: 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 77 69 ). (wi
4840: 74 68 2d 74 65 6d 70 20 58 0a 20 20 20 20 20 20 th-temp X.
4850: 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 (values #
4860: 27 58 20 28 6c 69 73 74 20 23 27 58 29 20 28 6c 'X (list #'X) (l
4870: 69 73 74 20 23 27 45 78 70 29 29 29 29 0a 20 20 ist #'Exp)))).
4880: 20 20 20 20 20 20 20 20 28 28 28 75 6e 71 75 6f (((unquo
4890: 74 65 20 45 78 70 29 20 44 6f 74 73 20 2e 20 52 te Exp) Dots . R
48a0: 65 73 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 est).
48b0: 28 61 6e 64 20 28 7a 65 72 6f 3f 20 64 65 70 74 (and (zero? dept
48c0: 68 29 20 28 65 6c 6c 69 70 73 69 73 3f 20 23 27 h) (ellipsis? #'
48d0: 44 6f 74 73 29 29 0a 20 20 20 20 20 20 20 20 20 Dots)).
48e0: 20 20 28 77 69 74 68 2d 76 61 6c 75 65 73 20 28 (with-values (
48f0: 64 65 73 74 72 75 63 74 20 4f 72 69 67 20 23 27 destruct Orig #'
4900: 52 65 73 74 20 64 65 70 74 68 29 0a 20 20 20 20 Rest depth).
4910: 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 61 78 (syntax
4920: 2d 6c 61 6d 62 64 61 20 28 52 65 73 74 42 75 69 -lambda (RestBui
4930: 6c 64 65 72 20 52 65 73 74 56 61 72 73 20 52 65 lder RestVars Re
4940: 73 74 45 78 70 73 29 0a 20 20 20 20 20 20 20 20 stExps).
4950: 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 6e (with-syn
4960: 74 61 78 20 28 28 54 61 69 6c 45 78 70 0a 20 20 tax ((TailExp.
4970: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4980: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
4990: 20 28 6e 75 6c 6c 3f 20 23 27 52 65 73 74 56 61 (null? #'RestVa
49a0: 72 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 rs).
49b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49c0: 20 20 20 20 20 20 20 23 27 27 52 65 73 74 0a 20 #''Rest.
49d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
49f0: 20 20 23 27 52 65 73 74 42 75 69 6c 64 65 72 29 #'RestBuilder)
4a00: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
4a10: 20 20 20 20 28 77 69 74 68 2d 74 65 6d 70 20 58 (with-temp X
4a20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4a30: 20 20 20 20 28 76 61 6c 75 65 73 20 23 27 28 61 (values #'(a
4a40: 70 70 65 6e 64 20 58 20 54 61 69 6c 45 78 70 29 ppend X TailExp)
4a50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4a60: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con
4a70: 73 20 23 27 58 20 23 27 52 65 73 74 56 61 72 73 s #'X #'RestVars
4a80: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4a90: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f (co
4aa0: 6e 73 20 23 27 45 78 70 20 23 27 52 65 73 74 45 ns #'Exp #'RestE
4ab0: 78 70 73 29 29 29 29 29 29 29 0a 20 20 20 20 20 xps))))))).
4ac0: 20 20 20 20 20 28 28 45 78 70 20 44 6f 74 73 20 ((Exp Dots
4ad0: 2e 20 52 65 73 74 29 0a 20 20 20 20 20 20 20 20 . Rest).
4ae0: 20 20 20 28 61 6e 64 20 28 7a 65 72 6f 3f 20 64 (and (zero? d
4af0: 65 70 74 68 29 20 28 65 6c 6c 69 70 73 69 73 3f epth) (ellipsis?
4b00: 20 23 27 44 6f 74 73 29 29 0a 20 20 20 20 20 20 #'Dots)).
4b10: 20 20 20 20 20 28 77 69 74 68 2d 76 61 6c 75 65 (with-value
4b20: 73 20 28 64 65 73 74 72 75 63 74 20 4f 72 69 67 s (destruct Orig
4b30: 20 23 27 45 78 70 20 64 65 70 74 68 29 0a 20 20 #'Exp depth).
4b40: 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 (synt
4b50: 61 78 2d 6c 61 6d 62 64 61 20 28 45 78 70 42 75 ax-lambda (ExpBu
4b60: 69 6c 64 65 72 20 28 45 78 70 56 61 72 20 2e 2e ilder (ExpVar ..
4b70: 2e 29 20 28 45 78 70 45 78 70 20 2e 2e 2e 29 29 .) (ExpExp ...))
4b80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4b90: 28 69 66 20 28 6e 75 6c 6c 3f 20 23 27 28 45 78 (if (null? #'(Ex
4ba0: 70 56 61 72 20 2e 2e 2e 29 29 0a 20 20 20 20 20 pVar ...)).
4bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s
4bc0: 79 6e 74 61 78 2d 65 72 72 6f 72 20 4f 72 69 67 yntax-error Orig
4bd0: 20 22 42 61 64 20 65 6c 6c 69 70 73 69 73 22 29 "Bad ellipsis")
4be0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4bf0: 20 20 20 20 28 77 69 74 68 2d 76 61 6c 75 65 73 (with-values
4c00: 20 28 64 65 73 74 72 75 63 74 20 4f 72 69 67 20 (destruct Orig
4c10: 23 27 52 65 73 74 20 64 65 70 74 68 29 0a 20 20 #'Rest depth).
4c20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4c30: 20 20 20 28 73 79 6e 74 61 78 2d 6c 61 6d 62 64 (syntax-lambd
4c40: 61 20 28 52 65 73 74 42 75 69 6c 64 65 72 20 52 a (RestBuilder R
4c50: 65 73 74 56 61 72 73 20 52 65 73 74 45 78 70 73 estVars RestExps
4c60: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
4c70: 20 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 (with-s
4c80: 79 6e 74 61 78 20 28 28 54 61 69 6c 45 78 70 0a yntax ((TailExp.
4c90: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ca0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cb0: 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c 6c (if (null
4cc0: 3f 20 23 27 52 65 73 74 56 61 72 73 29 0a 20 20 ? #'RestVars).
4cd0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ce0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4cf0: 20 20 20 20 20 20 20 20 20 23 27 27 52 65 73 74 #''Rest
4d00: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
4d10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d20: 20 20 20 20 20 20 20 20 20 20 20 20 23 27 52 65 #'Re
4d30: 73 74 42 75 69 6c 64 65 72 29 29 0a 20 20 20 20 stBuilder)).
4d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d60: 20 28 4f 72 69 67 20 4f 72 69 67 29 29 0a 20 20 (Orig Orig)).
4d70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4d80: 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 (values #
4d90: 27 28 6c 65 74 20 66 20 28 28 45 78 70 56 61 72 '(let f ((ExpVar
4da0: 20 45 78 70 56 61 72 29 20 2e 2e 2e 29 0a 20 20 ExpVar) ...).
4db0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4dc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4dd0: 20 20 20 28 69 66 20 28 61 6e 64 20 28 70 61 69 (if (and (pai
4de0: 72 3f 20 45 78 70 56 61 72 29 20 2e 2e 2e 29 0a r? ExpVar) ...).
4df0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e10: 20 20 20 20 20 20 20 20 20 28 63 6f 6e 73 0a 20 (cons.
4e20: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e40: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
4e50: 28 45 78 70 56 61 72 20 28 63 61 72 20 45 78 70 (ExpVar (car Exp
4e60: 56 61 72 29 29 20 2e 2e 2e 29 0a 20 20 20 20 20 Var)) ...).
4e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4e90: 20 20 20 20 20 20 20 20 45 78 70 42 75 69 6c 64 ExpBuild
4ea0: 65 72 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 er).
4eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4ec0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
4ed0: 66 20 28 63 64 72 20 45 78 70 56 61 72 29 20 2e f (cdr ExpVar) .
4ee0: 2e 2e 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ..)).
4ef0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i
4f10: 66 20 28 61 6e 64 20 28 6e 75 6c 6c 3f 20 45 78 f (and (null? Ex
4f20: 70 56 61 72 29 20 2e 2e 2e 29 0a 20 20 20 20 20 pVar) ...).
4f30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f50: 20 20 20 20 20 20 20 20 54 61 69 6c 45 78 70 0a TailExp.
4f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4f80: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 (er
4f90: 72 6f 72 20 27 75 6e 71 75 6f 74 65 0a 20 20 20 ror 'unquote.
4fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
4fc0: 20 20 20 20 20 20 20 20 20 20 20 20 22 4d 69 73 "Mis
4fd0: 6d 61 74 63 68 65 64 20 6c 69 73 74 73 20 69 6e matched lists in
4fe0: 20 7e 73 22 0a 20 20 20 20 20 20 20 20 20 20 20 ~s".
4ff0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5000: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5010: 20 20 20 20 4f 72 69 67 29 29 29 29 0a 20 20 20 Orig)))).
5020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5030: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 61 (a
5040: 70 70 65 6e 64 20 23 27 28 45 78 70 56 61 72 20 ppend #'(ExpVar
5050: 2e 2e 2e 29 20 23 27 52 65 73 74 56 61 72 73 29 ...) #'RestVars)
5060: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5070: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5080: 20 20 28 61 70 70 65 6e 64 20 23 27 28 45 78 70 (append #'(Exp
5090: 45 78 70 20 2e 2e 2e 29 20 23 27 52 65 73 74 45 Exp ...) #'RestE
50a0: 78 70 73 29 29 29 29 29 29 29 29 29 0a 20 20 20 xps))))))))).
50b0: 20 20 20 20 20 20 20 3b 3b 20 56 65 63 74 6f 72 ;; Vector
50c0: 73 0a 20 20 20 20 20 20 20 20 20 20 28 23 28 58 s. (#(X
50d0: 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20 20 ...).
50e0: 20 28 77 69 74 68 2d 76 61 6c 75 65 73 20 28 64 (with-values (d
50f0: 65 73 74 72 75 63 74 20 4f 72 69 67 20 23 27 28 estruct Orig #'(
5100: 58 20 2e 2e 2e 29 20 64 65 70 74 68 29 0a 20 20 X ...) depth).
5110: 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 (synt
5120: 61 78 2d 6c 61 6d 62 64 61 20 28 4c 73 42 75 69 ax-lambda (LsBui
5130: 6c 64 65 72 20 4c 73 56 61 72 73 20 4c 73 45 78 lder LsVars LsEx
5140: 70 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ps).
5150: 20 20 20 28 76 61 6c 75 65 73 20 23 27 28 6c 69 (values #'(li
5160: 73 74 2d 3e 76 65 63 74 6f 72 20 4c 73 42 75 69 st->vector LsBui
5170: 6c 64 65 72 29 20 23 27 4c 73 56 61 72 73 20 23 lder) #'LsVars #
5180: 27 4c 73 45 78 70 73 29 29 29 29 0a 20 20 20 20 'LsExps)))).
5190: 20 20 20 20 20 20 3b 3b 20 72 61 6e 64 6f 6d 20 ;; random
51a0: 73 74 75 66 66 0a 20 20 20 20 20 20 20 20 20 20 stuff.
51b0: 28 28 48 64 20 2e 20 54 6c 29 0a 20 20 20 20 20 ((Hd . Tl).
51c0: 20 20 20 20 20 20 28 77 69 74 68 2d 76 61 6c 75 (with-valu
51d0: 65 73 20 28 64 65 73 74 72 75 63 74 20 4f 72 69 es (destruct Ori
51e0: 67 20 23 27 48 64 20 64 65 70 74 68 29 0a 20 20 g #'Hd depth).
51f0: 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6e 74 (synt
5200: 61 78 2d 6c 61 6d 62 64 61 20 28 48 64 42 75 69 ax-lambda (HdBui
5210: 6c 64 65 72 20 48 64 56 61 72 73 20 48 64 45 78 lder HdVars HdEx
5220: 70 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ps).
5230: 20 20 20 28 77 69 74 68 2d 76 61 6c 75 65 73 20 (with-values
5240: 28 64 65 73 74 72 75 63 74 20 4f 72 69 67 20 23 (destruct Orig #
5250: 27 54 6c 20 64 65 70 74 68 29 0a 20 20 20 20 20 'Tl depth).
5260: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 79 6e (syn
5270: 74 61 78 2d 6c 61 6d 62 64 61 20 28 54 6c 42 75 tax-lambda (TlBu
5280: 69 6c 64 65 72 20 54 6c 56 61 72 73 20 54 6c 45 ilder TlVars TlE
5290: 78 70 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 xps).
52a0: 20 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 (with-sy
52b0: 6e 74 61 78 20 28 28 48 64 20 28 69 66 20 28 6e ntax ((Hd (if (n
52c0: 75 6c 6c 3f 20 23 27 48 64 56 61 72 73 29 0a 20 ull? #'HdVars).
52d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
52f0: 20 20 20 20 20 20 20 20 23 27 27 48 64 0a 20 20 #''Hd.
5300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5320: 20 20 20 20 20 20 20 23 27 48 64 42 75 69 6c 64 #'HdBuild
5330: 65 72 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 er)).
5340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5350: 20 20 20 20 20 20 28 54 6c 20 28 69 66 20 28 6e (Tl (if (n
5360: 75 6c 6c 3f 20 23 27 54 6c 56 61 72 73 29 0a 20 ull? #'TlVars).
5370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5390: 20 20 20 20 20 20 20 20 23 27 27 54 6c 0a 20 20 #''Tl.
53a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
53c0: 20 20 20 20 20 20 20 23 27 54 6c 42 75 69 6c 64 #'TlBuild
53d0: 65 72 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 er))).
53e0: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
53f0: 65 73 20 23 27 28 63 6f 6e 73 20 48 64 20 54 6c es #'(cons Hd Tl
5400: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
5410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5420: 61 70 70 65 6e 64 20 23 27 48 64 56 61 72 73 20 append #'HdVars
5430: 23 27 54 6c 56 61 72 73 29 0a 20 20 20 20 20 20 #'TlVars).
5440: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5450: 20 20 20 20 20 20 20 28 61 70 70 65 6e 64 20 23 (append #
5460: 27 48 64 45 78 70 73 20 23 27 54 6c 45 78 70 73 'HdExps #'TlExps
5470: 29 29 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 )))))))).
5480: 20 20 20 28 4f 74 68 65 72 54 68 69 6e 67 0a 20 (OtherThing.
5490: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
54a0: 65 73 20 23 27 27 4f 74 68 65 72 54 68 69 6e 67 es #''OtherThing
54b0: 20 27 28 29 20 27 28 29 29 29 29 29 29 0a 20 20 '() '()))))).
54c0: 20 20 3b 3b 20 6d 61 63 72 6f 20 62 65 67 69 6e ;; macro begin
54d0: 73 0a 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61 s. (syntax-ca
54e0: 73 65 20 78 20 28 29 0a 20 20 20 20 20 20 28 28 se x (). ((
54f0: 5f 20 44 61 74 75 6d 29 0a 20 20 20 20 20 20 20 _ Datum).
5500: 28 77 69 74 68 2d 76 61 6c 75 65 73 20 28 64 65 (with-values (de
5510: 73 74 72 75 63 74 20 23 27 28 71 75 61 73 69 71 struct #'(quasiq
5520: 75 6f 74 65 20 44 61 74 75 6d 29 20 23 27 44 61 uote Datum) #'Da
5530: 74 75 6d 20 30 29 0a 20 20 20 20 20 20 20 20 20 tum 0).
5540: 28 73 79 6e 74 61 78 2d 6c 61 6d 62 64 61 20 28 (syntax-lambda (
5550: 42 75 69 6c 64 65 72 20 28 56 61 72 20 2e 2e 2e Builder (Var ...
5560: 29 20 28 45 78 70 20 2e 2e 2e 29 29 0a 20 20 20 ) (Exp ...)).
5570: 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 75 6c (if (nul
5580: 6c 3f 20 23 27 28 56 61 72 20 2e 2e 2e 29 29 0a l? #'(Var ...)).
5590: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 #
55a0: 27 27 44 61 74 75 6d 0a 20 20 20 20 20 20 20 20 ''Datum.
55b0: 20 20 20 20 20 20 20 23 27 28 6c 65 74 20 28 28 #'(let ((
55c0: 56 61 72 20 45 78 70 29 20 2e 2e 2e 29 0a 20 20 Var Exp) ...).
55d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
55e0: 20 42 75 69 6c 64 65 72 29 29 29 29 29 29 29 29 Builder))))))))
55f0: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax
5600: 20 65 78 74 65 6e 64 2d 62 61 63 6b 71 75 6f 74 extend-backquot
5610: 65 0a 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a e. (lambda (x).
5620: 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 (syntax-case
5630: 20 78 20 28 29 0a 20 20 20 20 20 20 5b 28 5f 20 x (). [(_
5640: 54 65 6d 70 6c 61 74 65 20 45 78 70 20 2e 2e 2e Template Exp ...
5650: 29 0a 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 ). (with-s
5660: 79 6e 74 61 78 20 28 5b 71 75 61 73 69 71 75 6f yntax ([quasiquo
5670: 74 65 20 28 64 61 74 75 6d 2d 3e 73 79 6e 74 61 te (datum->synta
5680: 78 20 23 27 54 65 6d 70 6c 61 74 65 20 27 71 75 x #'Template 'qu
5690: 61 73 69 71 75 6f 74 65 29 5d 29 0a 20 20 20 20 asiquote)]).
56a0: 20 20 20 20 20 23 27 28 6c 65 74 2d 73 79 6e 74 #'(let-synt
56b0: 61 78 20 28 5b 71 75 61 73 69 71 75 6f 74 65 0a ax ([quasiquote.
56c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
56d0: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
56e0: 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 20 20 a (x).
56f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5700: 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 78 (syntax-case x
5710: 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ().
5720: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5730: 20 20 28 28 5f 20 46 6f 6f 29 20 23 27 28 6d 79 ((_ Foo) #'(my
5740: 2d 62 61 63 6b 71 75 6f 74 65 20 46 6f 6f 29 29 -backquote Foo))
5750: 29 29 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 ))]).
5760: 20 20 45 78 70 20 2e 2e 2e 29 29 5d 29 29 29 0a Exp ...))]))).
5770: 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 .(define-syntax
5780: 77 69 74 68 2d 65 6c 6c 69 70 73 69 73 2d 61 77 with-ellipsis-aw
5790: 61 72 65 2d 71 75 61 73 69 71 75 6f 74 65 0a 20 are-quasiquote.
57a0: 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 (lambda (x).
57b0: 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 78 20 (syntax-case x
57c0: 28 29 0a 20 20 20 20 20 20 5b 28 6b 20 62 31 20 (). [(k b1
57d0: 62 32 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 28 b2 ...). (
57e0: 77 69 74 68 2d 69 6d 70 6c 69 63 69 74 20 28 6b with-implicit (k
57f0: 20 71 75 61 73 69 71 75 6f 74 65 29 0a 20 20 20 quasiquote).
5800: 20 20 20 20 20 20 23 27 28 6c 65 74 2d 73 79 6e #'(let-syn
5810: 74 61 78 20 28 5b 71 75 61 73 69 71 75 6f 74 65 tax ([quasiquote
5820: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5830: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb
5840: 64 61 20 28 78 29 0a 20 20 20 20 20 20 20 20 20 da (x).
5850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5860: 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 (syntax-case
5870: 78 20 28 29 0a 20 20 20 20 20 20 20 20 20 20 20 x ().
5880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5890: 20 20 20 28 28 5f 20 65 29 20 23 27 28 6d 79 2d ((_ e) #'(my-
58a0: 62 61 63 6b 71 75 6f 74 65 20 65 29 29 29 29 5d backquote e))))]
58b0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ). (
58c0: 6c 65 74 20 28 29 20 62 31 20 62 32 20 2e 2e 2e let () b1 b2 ...
58d0: 29 29 29 5d 29 29 29 0a 0a 3b 3b 3b 20 2d 2d 2d )))])))..;;; ---
58e0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d ----------------
58f0: 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 2d 0a 0a 28 64 65 -----------..(de
5900: 66 69 6e 65 2d 73 79 6e 74 61 78 20 77 69 74 68 fine-syntax with
5910: 2d 76 61 6c 75 65 73 0a 20 20 28 73 79 6e 74 61 -values. (synta
5920: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 x-rules (). (
5930: 28 5f 20 50 20 43 29 20 28 63 61 6c 6c 2d 77 69 (_ P C) (call-wi
5940: 74 68 2d 76 61 6c 75 65 73 20 28 6c 61 6d 62 64 th-values (lambd
5950: 61 20 28 29 20 50 29 20 43 29 29 29 29 0a 0a 28 a () P) C))))..(
5960: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6c 65 define-syntax le
5970: 74 63 63 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 tcc. (syntax-ru
5980: 6c 65 73 20 28 29 0a 20 20 20 20 28 28 5f 20 56 les (). ((_ V
5990: 20 42 30 20 42 20 2e 2e 2e 29 20 28 63 61 6c 6c B0 B ...) (call
59a0: 2f 63 63 20 28 6c 61 6d 62 64 61 20 28 56 29 20 /cc (lambda (V)
59b0: 42 30 20 42 20 2e 2e 2e 29 29 29 29 29 0a 0a 28 B0 B ...)))))..(
59c0: 64 65 66 69 6e 65 20 63 6c 61 73 73 69 66 79 2d define classify-
59d0: 6c 69 73 74 0a 20 20 28 6c 61 6d 62 64 61 20 28 list. (lambda (
59e0: 6c 73 29 0a 20 20 20 20 28 63 6f 6e 64 0a 20 20 ls). (cond.
59f0: 20 20 20 20 28 28 6e 75 6c 6c 3f 20 6c 73 29 20 ((null? ls)
5a00: 27 70 72 6f 70 65 72 29 0a 20 20 20 20 20 20 28 'proper). (
5a10: 28 6e 6f 74 20 28 70 61 69 72 3f 20 6c 73 29 29 (not (pair? ls))
5a20: 20 27 69 6d 70 72 6f 70 65 72 29 0a 20 20 20 20 'improper).
5a30: 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 (else.
5a40: 28 6c 65 74 20 66 20 28 28 74 6f 72 74 6f 69 73 (let f ((tortois
5a50: 65 20 6c 73 29 20 28 68 61 72 65 20 28 63 64 72 e ls) (hare (cdr
5a60: 20 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 20 ls))).
5a70: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond.
5a80: 20 20 20 28 28 65 71 3f 20 74 6f 72 74 6f 69 73 ((eq? tortois
5a90: 65 20 68 61 72 65 29 20 27 69 6e 66 69 6e 69 74 e hare) 'infinit
5aa0: 65 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 e). (
5ab0: 28 6e 75 6c 6c 3f 20 68 61 72 65 29 20 27 70 72 (null? hare) 'pr
5ac0: 6f 70 65 72 29 0a 20 20 20 20 20 20 20 20 20 20 oper).
5ad0: 20 20 28 28 6e 6f 74 20 28 70 61 69 72 3f 20 68 ((not (pair? h
5ae0: 61 72 65 29 29 20 27 69 6d 70 72 6f 70 65 72 29 are)) 'improper)
5af0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c . (el
5b00: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
5b10: 20 28 6c 65 74 20 28 28 68 61 72 65 20 28 63 64 (let ((hare (cd
5b20: 72 20 68 61 72 65 29 29 29 0a 20 20 20 20 20 20 r hare))).
5b30: 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e 64 0a (cond.
5b40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5b50: 20 20 28 28 6e 75 6c 6c 3f 20 68 61 72 65 29 20 ((null? hare)
5b60: 27 70 72 6f 70 65 72 29 0a 20 20 20 20 20 20 20 'proper).
5b70: 20 20 20 20 20 20 20 20 20 20 20 28 28 6e 6f 74 ((not
5b80: 20 28 70 61 69 72 3f 20 68 61 72 65 29 29 20 27 (pair? hare)) '
5b90: 69 6d 70 72 6f 70 65 72 29 0a 20 20 20 20 20 20 improper).
5ba0: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c 73 (els
5bb0: 65 20 28 66 20 28 63 64 72 20 6c 73 29 20 28 63 e (f (cdr ls) (c
5bc0: 64 72 20 68 61 72 65 29 29 29 29 29 29 29 29 29 dr hare)))))))))
5bd0: 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 69 6c 69 )))..(define ili
5be0: 73 74 2d 63 6f 70 79 2d 66 6c 61 74 0a 20 20 28 st-copy-flat. (
5bf0: 6c 61 6d 62 64 61 20 28 69 6c 73 29 0a 20 20 20 lambda (ils).
5c00: 20 28 6c 65 74 20 66 20 28 28 74 6f 72 74 6f 69 (let f ((tortoi
5c10: 73 65 20 69 6c 73 29 20 28 68 61 72 65 20 28 63 se ils) (hare (c
5c20: 64 72 20 69 6c 73 29 29 29 0a 20 20 20 20 20 20 dr ils))).
5c30: 28 69 66 20 28 65 71 3f 20 74 6f 72 74 6f 69 73 (if (eq? tortois
5c40: 65 20 68 61 72 65 29 0a 20 20 20 20 20 20 20 20 e hare).
5c50: 20 20 28 6c 69 73 74 20 28 63 61 72 20 74 6f 72 (list (car tor
5c60: 74 6f 69 73 65 29 29 0a 20 20 20 20 20 20 20 20 toise)).
5c70: 20 20 28 63 6f 6e 73 20 28 63 61 72 20 74 6f 72 (cons (car tor
5c80: 74 6f 69 73 65 29 20 28 66 20 28 63 64 72 20 74 toise) (f (cdr t
5c90: 6f 72 74 6f 69 73 65 29 20 28 63 64 64 72 20 68 ortoise) (cddr h
5ca0: 61 72 65 29 29 29 29 29 29 29 0a 0a 28 64 65 66 are)))))))..(def
5cb0: 69 6e 65 20 73 65 78 70 2d 64 69 73 70 61 74 63 ine sexp-dispatc
5cc0: 68 0a 20 20 28 6c 61 6d 62 64 61 20 28 6f 62 6a h. (lambda (obj
5cd0: 20 70 61 74 29 3b 3b 20 23 66 20 6f 72 20 6c 69 pat);; #f or li
5ce0: 73 74 20 6f 66 20 76 61 72 73 0a 20 20 20 20 28 st of vars. (
5cf0: 6c 65 74 63 63 20 65 73 63 61 70 65 0a 20 20 20 letcc escape.
5d00: 20 20 20 28 6c 65 74 20 28 28 66 61 69 6c 20 28 (let ((fail (
5d10: 6c 61 6d 62 64 61 20 28 29 20 28 65 73 63 61 70 lambda () (escap
5d20: 65 20 23 66 29 29 29 29 0a 20 20 20 20 20 20 20 e #f)))).
5d30: 20 28 6c 65 74 20 66 20 28 28 70 61 74 20 70 61 (let f ((pat pa
5d40: 74 29 20 28 6f 62 6a 20 6f 62 6a 29 20 28 76 61 t) (obj obj) (va
5d50: 6c 73 20 27 28 29 29 29 0a 20 20 20 20 20 20 20 ls '())).
5d60: 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 (cond.
5d70: 20 20 20 20 20 28 28 65 71 3f 20 70 61 74 20 27 ((eq? pat '
5d80: 61 6e 79 29 0a 20 20 20 20 20 20 20 20 20 20 20 any).
5d90: 20 20 28 63 6f 6e 73 20 6f 62 6a 20 76 61 6c 73 (cons obj vals
5da0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). (
5db0: 28 65 71 3f 20 70 61 74 20 27 65 61 63 68 2d 61 (eq? pat 'each-a
5dc0: 6e 79 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ny).
5dd0: 20 3b 3b 20 68 61 6e 64 6c 65 20 69 6e 66 69 6e ;; handle infin
5de0: 69 74 69 65 73 0a 20 20 20 20 20 20 20 20 20 20 ities.
5df0: 20 20 20 28 63 61 73 65 20 28 63 6c 61 73 73 69 (case (classi
5e00: 66 79 2d 6c 69 73 74 20 6f 62 6a 29 0a 20 20 20 fy-list obj).
5e10: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 70 72 ((pr
5e20: 6f 70 65 72 20 69 6e 66 69 6e 69 74 65 29 20 28 oper infinite) (
5e30: 63 6f 6e 73 20 6f 62 6a 20 76 61 6c 73 29 29 0a cons obj vals)).
5e40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
5e50: 28 69 6d 70 72 6f 70 65 72 29 20 28 66 61 69 6c (improper) (fail
5e60: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
5e70: 20 28 28 70 61 69 72 3f 20 70 61 74 29 0a 20 20 ((pair? pat).
5e80: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if (
5e90: 70 61 69 72 3f 20 6f 62 6a 29 0a 20 20 20 20 20 pair? obj).
5ea0: 20 20 20 20 20 20 20 20 20 20 20 20 28 66 20 28 (f (
5eb0: 63 61 72 20 70 61 74 29 20 28 63 61 72 20 6f 62 car pat) (car ob
5ec0: 6a 29 20 28 66 20 28 63 64 72 20 70 61 74 29 20 j) (f (cdr pat)
5ed0: 28 63 64 72 20 6f 62 6a 29 20 76 61 6c 73 29 29 (cdr obj) vals))
5ee0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5ef0: 20 20 28 66 61 69 6c 29 29 29 0a 20 20 20 20 20 (fail))).
5f00: 20 20 20 20 20 20 20 28 28 76 65 63 74 6f 72 3f ((vector?
5f10: 20 70 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 pat).
5f20: 20 20 20 28 63 61 73 65 20 28 76 65 63 74 6f 72 (case (vector
5f30: 2d 72 65 66 20 70 61 74 20 30 29 0a 20 20 20 20 -ref pat 0).
5f40: 20 20 20 20 20 20 20 20 20 20 20 28 28 61 74 6f ((ato
5f50: 6d 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 m).
5f60: 20 20 20 28 6c 65 74 20 28 28 61 20 28 76 65 63 (let ((a (vec
5f70: 74 6f 72 2d 72 65 66 20 70 61 74 20 31 29 29 29 tor-ref pat 1)))
5f80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
5f90: 20 20 20 28 69 66 20 28 65 71 76 3f 20 6f 62 6a (if (eqv? obj
5fa0: 20 61 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 a).
5fb0: 20 20 20 20 20 20 20 20 20 20 76 61 6c 73 0a 20 vals.
5fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
5fd0: 20 20 20 20 20 28 66 61 69 6c 29 29 29 29 0a 20 (fail)))).
5fe0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
5ff0: 76 65 63 74 6f 72 29 0a 20 20 20 20 20 20 20 20 vector).
6000: 20 20 20 20 20 20 20 20 28 69 66 20 28 76 65 63 (if (vec
6010: 74 6f 72 3f 20 6f 62 6a 29 0a 20 20 20 20 20 20 tor? obj).
6020: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
6030: 65 74 20 28 28 76 65 63 2d 70 61 74 20 28 76 65 et ((vec-pat (ve
6040: 63 74 6f 72 2d 72 65 66 20 70 61 74 20 31 29 29 ctor-ref pat 1))
6050: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6060: 20 20 20 20 20 20 20 20 28 66 20 76 65 63 2d 70 (f vec-p
6070: 61 74 20 28 76 65 63 74 6f 72 2d 3e 6c 69 73 74 at (vector->list
6080: 20 6f 62 6a 29 20 76 61 6c 73 29 29 0a 20 20 20 obj) vals)).
6090: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
60a0: 20 28 66 61 69 6c 29 29 29 0a 20 20 20 20 20 20 (fail))).
60b0: 20 20 20 20 20 20 20 20 20 28 28 65 61 63 68 29 ((each)
60c0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
60d0: 20 3b 3b 20 69 66 20 69 6e 66 69 6e 69 74 65 2c ;; if infinite,
60e0: 20 63 6f 70 79 20 74 68 65 20 6c 69 73 74 20 61 copy the list a
60f0: 73 20 66 6c 61 74 2c 20 74 68 65 6e 20 64 6f 20 s flat, then do
6100: 74 68 65 20 6d 61 74 63 68 69 6e 67 2c 0a 20 20 the matching,.
6110: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3b 3b ;;
6120: 20 74 68 65 6e 20 64 6f 20 73 6f 6d 65 20 73 65 then do some se
6130: 74 2d 63 64 72 73 2e 20 0a 20 20 20 20 20 20 20 t-cdrs. .
6140: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 (let ((
6150: 65 61 63 68 2d 70 61 74 20 28 76 65 63 74 6f 72 each-pat (vector
6160: 2d 72 65 66 20 70 61 74 20 31 29 29 0a 20 20 20 -ref pat 1)).
6170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6180: 20 20 20 28 65 61 63 68 2d 73 69 7a 65 20 28 76 (each-size (v
6190: 65 63 74 6f 72 2d 72 65 66 20 70 61 74 20 32 29 ector-ref pat 2)
61a0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
61b0: 20 20 20 20 20 28 63 61 73 65 20 28 63 6c 61 73 (case (clas
61c0: 73 69 66 79 2d 6c 69 73 74 20 6f 62 6a 29 0a 20 sify-list obj).
61d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
61e0: 20 20 20 28 28 69 6d 70 72 6f 70 65 72 29 20 28 ((improper) (
61f0: 66 61 69 6c 29 29 0a 20 20 20 20 20 20 20 20 20 fail)).
6200: 20 20 20 20 20 20 20 20 20 20 20 28 28 69 6e 66 ((inf
6210: 69 6e 69 74 65 29 0a 20 20 20 20 20 20 20 20 20 inite).
6220: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 (let
6230: 20 28 28 65 61 63 68 2d 76 61 6c 73 20 28 66 20 ((each-vals (f
6240: 70 61 74 20 28 69 6c 69 73 74 2d 63 6f 70 79 2d pat (ilist-copy-
6250: 66 6c 61 74 20 6f 62 6a 29 20 27 28 29 29 29 29 flat obj) '())))
6260: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6270: 20 20 20 20 20 20 20 20 28 66 6f 72 2d 65 61 63 (for-eac
6280: 68 20 28 6c 61 6d 62 64 61 20 28 78 29 20 28 73 h (lambda (x) (s
6290: 65 74 2d 63 64 72 21 20 28 6c 61 73 74 2d 70 61 et-cdr! (last-pa
62a0: 69 72 20 78 29 20 78 29 29 0a 20 20 20 20 20 20 ir x) x)).
62b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62c0: 20 20 20 65 61 63 68 2d 76 61 6c 73 29 0a 20 20 each-vals).
62d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
62e0: 20 20 20 20 20 28 61 70 70 65 6e 64 20 65 61 63 (append eac
62f0: 68 2d 76 61 6c 73 20 76 61 6c 73 29 29 29 0a 20 h-vals vals))).
6300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6310: 20 20 20 28 28 70 72 6f 70 65 72 29 0a 20 20 20 ((proper).
6320: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6330: 20 20 28 61 70 70 65 6e 64 0a 20 20 20 20 20 20 (append.
6340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6350: 20 28 6c 65 74 20 67 20 28 28 6f 62 6a 20 6f 62 (let g ((obj ob
6360: 6a 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 j)).
6370: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if
6380: 20 28 6e 75 6c 6c 3f 20 6f 62 6a 29 0a 20 20 20 (null? obj).
6390: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63a0: 20 20 20 20 20 20 20 20 20 20 28 6d 61 6b 65 2d (make-
63b0: 6c 69 73 74 20 65 61 63 68 2d 73 69 7a 65 20 27 list each-size '
63c0: 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ()).
63d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
63e0: 20 28 6c 65 74 20 28 28 68 64 2d 76 61 6c 73 20 (let ((hd-vals
63f0: 28 66 20 65 61 63 68 2d 70 61 74 20 28 63 61 72 (f each-pat (car
6400: 20 6f 62 6a 29 20 27 28 29 29 29 0a 20 20 20 20 obj) '())).
6410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6430: 74 6c 2d 76 61 6c 73 20 28 67 20 28 63 64 72 20 tl-vals (g (cdr
6440: 6f 62 6a 29 29 29 29 0a 20 20 20 20 20 20 20 20 obj)))).
6450: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6460: 20 20 20 20 20 20 20 28 6d 61 70 20 63 6f 6e 73 (map cons
6470: 20 68 64 2d 76 61 6c 73 20 74 6c 2d 76 61 6c 73 hd-vals tl-vals
6480: 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 )))).
6490: 20 20 20 20 20 20 20 20 20 20 20 20 76 61 6c 73 vals
64a0: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 ))))).
64b0: 20 20 20 20 20 28 28 74 61 69 6c 2d 65 61 63 68 ((tail-each
64c0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
64d0: 20 20 28 6c 65 74 20 28 28 65 61 63 68 2d 70 61 (let ((each-pa
64e0: 74 20 28 76 65 63 74 6f 72 2d 72 65 66 20 70 61 t (vector-ref pa
64f0: 74 20 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 t 1)).
6500: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 61 63 (eac
6510: 68 2d 73 69 7a 65 20 28 76 65 63 74 6f 72 2d 72 h-size (vector-r
6520: 65 66 20 70 61 74 20 32 29 29 0a 20 20 20 20 20 ef pat 2)).
6530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6540: 20 28 72 65 76 74 61 69 6c 2d 70 61 74 20 28 76 (revtail-pat (v
6550: 65 63 74 6f 72 2d 72 65 66 20 70 61 74 20 33 29 ector-ref pat 3)
6560: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
6570: 20 20 20 20 20 20 20 20 28 72 65 76 74 61 69 6c (revtail
6580: 2d 74 61 69 6c 2d 70 61 74 20 28 76 65 63 74 6f -tail-pat (vecto
6590: 72 2d 72 65 66 20 70 61 74 20 34 29 29 29 0a 20 r-ref pat 4))).
65a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
65b0: 20 28 77 68 65 6e 20 28 65 71 3f 20 28 63 6c 61 (when (eq? (cla
65c0: 73 73 69 66 79 2d 6c 69 73 74 20 6f 62 6a 29 20 ssify-list obj)
65d0: 27 69 6e 66 69 6e 69 74 65 29 20 28 66 61 69 6c 'infinite) (fail
65e0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )).
65f0: 20 20 20 20 20 28 77 69 74 68 2d 76 61 6c 75 65 (with-value
6600: 73 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 s.
6610: 20 20 20 20 20 20 20 20 28 6c 65 74 20 67 20 28 (let g (
6620: 28 6f 62 6a 20 6f 62 6a 29 29 0a 20 20 20 20 20 (obj obj)).
6630: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6640: 20 20 20 3b 3b 20 69 6e 2d 74 61 69 6c 3f 2c 20 ;; in-tail?,
6650: 76 61 6c 73 2c 20 72 65 76 74 61 69 6c 2d 6c 65 vals, revtail-le
6660: 66 74 2f 6c 73 0a 20 20 20 20 20 20 20 20 20 20 ft/ls.
6670: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 63 (c
6680: 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 ond.
6690: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 ((
66a0: 70 61 69 72 3f 20 6f 62 6a 29 0a 20 20 20 20 20 pair? obj).
66b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
66c0: 20 20 20 20 20 20 28 77 69 74 68 2d 76 61 6c 75 (with-valu
66d0: 65 73 20 28 67 20 28 63 64 72 20 6f 62 6a 29 29 es (g (cdr obj))
66e0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
66f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c (l
6700: 61 6d 62 64 61 20 28 69 6e 2d 74 61 69 6c 3f 20 ambda (in-tail?
6710: 76 61 6c 73 20 74 61 69 6c 2d 6c 65 66 74 2f 6c vals tail-left/l
6720: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s).
6730: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6740: 20 20 28 69 66 20 69 6e 2d 74 61 69 6c 3f 0a 20 (if in-tail?.
6750: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6760: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6770: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 74 61 69 (if (null? tai
6780: 6c 2d 6c 65 66 74 2f 6c 73 29 0a 20 20 20 20 20 l-left/ls).
6790: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67b0: 20 20 28 76 61 6c 75 65 73 20 23 66 20 76 61 6c (values #f val
67c0: 73 20 28 6c 69 73 74 20 28 63 61 72 20 6f 62 6a s (list (car obj
67d0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))).
67e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
67f0: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
6800: 65 73 20 23 74 20 28 66 20 28 63 61 72 20 74 61 es #t (f (car ta
6810: 69 6c 2d 6c 65 66 74 2f 6c 73 29 0a 20 20 20 20 il-left/ls).
6820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6830: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6850: 28 63 61 72 20 6f 62 6a 29 0a 20 20 20 20 20 20 (car obj).
6860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6870: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6880: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 76 61 va
6890: 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ls).
68a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68c0: 20 20 20 28 63 64 72 20 74 61 69 6c 2d 6c 65 66 (cdr tail-lef
68d0: 74 2f 6c 73 29 29 29 0a 20 20 20 20 20 20 20 20 t/ls))).
68e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
68f0: 20 20 20 20 20 20 20 20 20 20 20 28 76 61 6c 75 (valu
6900: 65 73 20 23 66 20 76 61 6c 73 0a 20 20 20 20 20 es #f vals.
6910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6920: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6930: 20 20 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 (cons (car
6940: 20 6f 62 6a 29 20 74 61 69 6c 2d 6c 65 66 74 2f obj) tail-left/
6950: 6c 73 29 29 29 29 29 29 0a 20 20 20 20 20 20 20 ls)))))).
6960: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6970: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20 (else.
6980: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6990: 20 20 20 20 20 28 76 61 6c 75 65 73 20 23 74 0a (values #t.
69a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
69c0: 20 20 20 20 28 66 20 72 65 76 74 61 69 6c 2d 74 (f revtail-t
69d0: 61 69 6c 2d 70 61 74 20 6f 62 6a 20 76 61 6c 73 ail-pat obj vals
69e0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ).
69f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a00: 20 20 20 20 20 20 72 65 76 74 61 69 6c 2d 70 61 revtail-pa
6a10: 74 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 t)))).
6a20: 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 64 (lambd
6a30: 61 20 28 69 6e 2d 74 61 69 6c 3f 20 76 61 6c 73 a (in-tail? vals
6a40: 20 74 61 69 6c 2d 6c 65 66 74 2f 6c 73 29 0a 20 tail-left/ls).
6a50: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6a60: 20 20 20 20 20 28 69 66 20 69 6e 2d 74 61 69 6c (if in-tail
6a70: 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ?.
6a80: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if
6a90: 28 6e 75 6c 6c 3f 20 74 61 69 6c 2d 6c 65 66 74 (null? tail-left
6aa0: 2f 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 /ls).
6ab0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6ac0: 20 20 20 28 61 70 70 65 6e 64 20 28 6d 61 6b 65 (append (make
6ad0: 2d 6c 69 73 74 20 65 61 63 68 2d 73 69 7a 65 20 -list each-size
6ae0: 27 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 '()).
6af0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b00: 20 20 20 20 20 76 61 6c 73 29 0a 20 20 20 20 20 vals).
6b10: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
6b20: 20 20 20 20 20 20 20 20 20 28 66 61 69 6c 29 29 (fail))
6b30: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
6b40: 20 20 20 20 20 20 20 20 20 20 20 28 66 20 65 61 (f ea
6b50: 63 68 2d 70 61 74 20 74 61 69 6c 2d 6c 65 66 74 ch-pat tail-left
6b60: 2f 6c 73 20 76 61 6c 73 29 29 29 29 29 29 29 29 /ls vals))))))))
6b70: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6c . (el
6b80: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 se.
6b90: 20 28 69 66 20 28 65 71 76 3f 20 6f 62 6a 20 70 (if (eqv? obj p
6ba0: 61 74 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 at).
6bb0: 20 20 20 20 20 20 76 61 6c 73 0a 20 20 20 20 20 vals.
6bc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 66 61 (fa
6bd0: 69 6c 29 29 29 29 29 29 29 29 29 0a 29 0a 0a 23 il))))))))).)..#
6be0: 21 65 6f 66 0a 0a 3b 3b 3b 20 65 78 61 6d 70 6c !eof..;;; exampl
6bf0: 65 73 20 6f 66 20 70 61 73 73 69 6e 67 20 61 6c es of passing al
6c00: 6f 6e 67 20 74 68 72 65 61 64 65 64 20 69 6e 66 ong threaded inf
6c10: 6f 72 6d 61 74 69 6f 6e 2e 0a 0a 3b 3b 3b 20 54 ormation...;;; T
6c20: 72 79 20 28 63 6f 6c 6c 65 63 74 2d 73 79 6d 62 ry (collect-symb
6c30: 6f 6c 73 20 27 28 69 66 20 28 78 20 79 20 27 61 ols '(if (x y 'a
6c40: 20 27 63 20 7a 7a 29 20 27 62 20 27 63 29 29 0a 'c zz) 'b 'c)).
6c50: 3b 3b 3b 20 4e 6f 74 65 20 74 68 61 74 20 69 74 ;;; Note that it
6c60: 20 63 6f 6d 6d 6f 6e 69 7a 65 73 20 74 68 65 20 commonizes the
6c70: 72 65 66 65 72 65 6e 63 65 20 74 6f 20 63 2e 20 reference to c.
6c80: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax
6c90: 20 77 69 74 68 2d 76 61 6c 75 65 73 0a 20 20 28 with-values. (
6ca0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a syntax-rules ().
6cb0: 20 20 20 20 28 28 5f 20 50 20 43 29 20 28 63 61 ((_ P C) (ca
6cc0: 6c 6c 2d 77 69 74 68 2d 76 61 6c 75 65 73 20 28 ll-with-values (
6cd0: 6c 61 6d 62 64 61 20 28 29 20 50 29 20 43 29 29 lambda () P) C))
6ce0: 29 29 0a 28 64 65 66 69 6e 65 20 63 6f 6c 6c 65 )).(define colle
6cf0: 63 74 2d 73 79 6d 62 6f 6c 73 0a 20 20 28 6c 61 ct-symbols. (la
6d00: 6d 62 64 61 20 28 65 78 70 29 0a 20 20 20 20 28 mbda (exp). (
6d10: 77 69 74 68 2d 76 61 6c 75 65 73 20 28 63 6f 6c with-values (col
6d20: 6c 65 63 74 2d 73 79 6d 62 6f 6c 73 2d 68 65 6c lect-symbols-hel
6d30: 70 20 65 78 70 29 0a 20 20 20 20 20 20 28 6c 61 p exp). (la
6d40: 6d 62 64 61 20 28 73 79 6d 62 6f 6c 2d 64 65 63 mbda (symbol-dec
6d50: 6c 73 20 65 78 70 29 0a 20 20 20 20 20 20 20 20 ls exp).
6d60: 28 6d 61 74 63 68 20 73 79 6d 62 6f 6c 2d 64 65 (match symbol-de
6d70: 63 6c 73 0a 20 20 20 20 20 20 20 20 20 20 28 28 cls. ((
6d80: 28 2c 73 79 6d 62 6f 6c 2d 6e 61 6d 65 20 2e 20 (,symbol-name .
6d90: 2c 73 79 6d 62 6f 6c 2d 76 61 72 29 20 2e 2e 2e ,symbol-var) ...
6da0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 60 28 6c ). `(l
6db0: 65 74 20 28 28 2c 73 79 6d 62 6f 6c 2d 76 61 72 et ((,symbol-var
6dc0: 20 28 71 75 6f 74 65 20 2c 73 79 6d 62 6f 6c 2d (quote ,symbol-
6dd0: 6e 61 6d 65 29 29 20 2e 2e 2e 29 20 2c 65 78 70 name)) ...) ,exp
6de0: 29 29 29 29 29 29 29 0a 28 64 65 66 69 6e 65 20 ))))))).(define
6df0: 63 6f 6c 6c 65 63 74 2d 73 79 6d 62 6f 6c 73 2d collect-symbols-
6e00: 68 65 6c 70 0a 20 20 28 6c 61 6d 62 64 61 20 28 help. (lambda (
6e10: 65 78 70 29 0a 20 20 20 20 28 6c 65 74 20 28 28 exp). (let ((
6e20: 73 79 6d 62 6f 6c 2d 65 6e 76 20 27 28 29 29 29 symbol-env '()))
6e30: 0a 20 20 20 20 20 20 28 6d 61 74 63 68 2b 20 28 . (match+ (
6e40: 73 79 6d 62 6f 6c 2d 65 6e 76 29 20 65 78 70 0a symbol-env) exp.
6e50: 20 20 20 20 20 20 20 20 28 2c 78 0a 20 20 20 20 (,x.
6e60: 20 20 20 20 20 20 28 67 75 61 72 64 20 28 73 79 (guard (sy
6e70: 6d 62 6f 6c 3f 20 78 29 29 0a 20 20 20 20 20 20 mbol? x)).
6e80: 20 20 20 20 28 76 61 6c 75 65 73 20 73 79 6d 62 (values symb
6e90: 6f 6c 2d 65 6e 76 20 78 29 29 0a 20 20 20 20 20 ol-env x)).
6ea0: 20 20 20 28 28 71 75 6f 74 65 20 2c 78 29 0a 20 ((quote ,x).
6eb0: 20 20 20 20 20 20 20 20 28 67 75 61 72 64 20 28 (guard (
6ec0: 73 79 6d 62 6f 6c 3f 20 78 29 29 0a 20 20 20 20 symbol? x)).
6ed0: 20 20 20 20 20 28 6c 65 74 20 28 28 70 61 69 72 (let ((pair
6ee0: 2f 66 61 6c 73 65 20 28 61 73 73 71 20 78 20 73 /false (assq x s
6ef0: 79 6d 62 6f 6c 2d 65 6e 76 29 29 29 0a 20 20 20 ymbol-env))).
6f00: 20 20 20 20 20 20 20 20 28 69 66 20 70 61 69 72 (if pair
6f10: 2f 66 61 6c 73 65 0a 20 20 20 20 20 20 20 20 20 /false.
6f20: 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 73 79 (values sy
6f30: 6d 62 6f 6c 2d 65 6e 76 20 28 63 64 72 20 70 61 mbol-env (cdr pa
6f40: 69 72 2f 66 61 6c 73 65 29 29 0a 20 20 20 20 20 ir/false)).
6f50: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let (
6f60: 28 76 20 28 67 65 6e 73 79 6d 29 29 29 0a 20 20 (v (gensym))).
6f70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 (
6f80: 76 61 6c 75 65 73 20 28 63 6f 6e 73 20 28 63 6f values (cons (co
6f90: 6e 73 20 78 20 76 29 20 73 79 6d 62 6f 6c 2d 65 ns x v) symbol-e
6fa0: 6e 76 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 nv).
6fb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 76 29 29 v))
6fc0: 29 29 29 0a 20 20 20 20 20 20 20 20 28 28 71 75 ))). ((qu
6fd0: 6f 74 65 20 2c 78 29 0a 20 20 20 20 20 20 20 20 ote ,x).
6fe0: 20 28 76 61 6c 75 65 73 20 73 79 6d 62 6f 6c 2d (values symbol-
6ff0: 65 6e 76 20 60 28 71 75 6f 74 65 20 2c 78 29 29 env `(quote ,x))
7000: 29 0a 20 20 20 20 20 20 20 20 28 28 69 66 20 2c ). ((if ,
7010: 5b 74 5d 20 2c 5b 63 5d 20 2c 5b 61 5d 29 0a 20 [t] ,[c] ,[a]).
7020: 20 20 20 20 20 20 20 20 28 76 61 6c 75 65 73 20 (values
7030: 73 79 6d 62 6f 6c 2d 65 6e 76 20 60 28 69 66 20 symbol-env `(if
7040: 2c 74 20 2c 63 20 2c 61 29 29 29 0a 20 20 20 20 ,t ,c ,a))).
7050: 20 20 20 20 28 28 2c 5b 6f 70 5d 20 2c 5b 61 72 ((,[op] ,[ar
7060: 67 5d 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 g] ...).
7070: 20 28 76 61 6c 75 65 73 20 73 79 6d 62 6f 6c 2d (values symbol-
7080: 65 6e 76 20 60 28 2c 6f 70 20 2c 61 72 67 20 2e env `(,op ,arg .
7090: 2e 2e 29 29 29 29 29 29 29 0a 0a 3b 3b 3b 20 74 ..)))))))..;;; t
70a0: 68 65 20 67 72 61 6d 6d 61 72 20 66 6f 72 20 74 he grammar for t
70b0: 68 69 73 20 6f 6e 65 20 69 73 20 6a 75 73 74 20 his one is just
70c0: 69 66 2d 65 78 70 72 73 20 61 6e 64 20 65 76 65 if-exprs and eve
70d0: 72 79 74 68 69 6e 67 20 65 6c 73 65 0a 0a 28 64 rything else..(d
70e0: 65 66 69 6e 65 20 63 6f 6c 6c 65 63 74 2d 6c 65 efine collect-le
70f0: 61 76 65 73 0a 20 20 28 6c 61 6d 62 64 61 20 28 aves. (lambda (
7100: 65 78 70 20 61 63 63 29 0a 20 20 20 20 28 6d 61 exp acc). (ma
7110: 74 63 68 2b 20 28 61 63 63 29 20 65 78 70 0a 20 tch+ (acc) exp.
7120: 20 20 20 20 20 28 28 69 66 20 2c 5b 5d 20 2c 5b ((if ,[] ,[
7130: 5d 20 2c 5b 5d 29 0a 20 20 20 20 20 20 20 61 63 ] ,[]). ac
7140: 63 29 0a 20 20 20 20 20 20 28 28 2c 5b 5d 20 2c c). ((,[] ,
7150: 5b 5d 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 61 [] ...). a
7160: 63 63 29 0a 20 20 20 20 20 20 28 2c 78 0a 20 20 cc). (,x.
7170: 20 20 20 20 20 20 28 63 6f 6e 73 20 78 20 61 63 (cons x ac
7180: 63 29 29 29 29 29 0a 0a 3b 3b 20 68 65 72 65 27 c)))))..;; here'
7190: 73 20 73 6f 6d 65 74 68 69 6e 67 20 74 68 61 74 s something that
71a0: 20 74 61 6b 65 73 20 61 70 61 72 74 20 71 75 6f takes apart quo
71b0: 74 65 64 20 73 74 75 66 66 2e 20 0a 0a 28 64 65 ted stuff. ..(de
71c0: 66 69 6e 65 20 64 65 73 74 72 75 63 74 0a 20 20 fine destruct.
71d0: 28 6c 61 6d 62 64 61 20 28 64 61 74 75 6d 29 0a (lambda (datum).
71e0: 20 20 20 20 28 6d 61 74 63 68 20 64 61 74 75 6d (match datum
71f0: 0a 20 20 20 20 20 20 28 28 29 20 60 27 28 29 29 . (() `'())
7200: 0a 20 20 20 20 20 20 28 28 2c 5b 58 5d 20 2e 20 . ((,[X] .
7210: 2c 5b 59 5d 29 60 28 63 6f 6e 73 20 2c 58 20 2c ,[Y])`(cons ,X ,
7220: 59 29 29 0a 20 20 20 20 20 20 28 23 28 2c 5b 58 Y)). (#(,[X
7230: 5d 20 2e 2e 2e 29 20 60 28 76 65 63 74 6f 72 20 ] ...) `(vector
7240: 2c 58 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20 28 ,X ...)). (
7250: 2c 74 68 69 6e 67 0a 20 20 20 20 20 20 20 20 28 ,thing. (
7260: 67 75 61 72 64 20 28 73 79 6d 62 6f 6c 3f 20 74 guard (symbol? t
7270: 68 69 6e 67 29 29 0a 20 20 20 20 20 20 20 20 60 hing)). `
7280: 27 2c 74 68 69 6e 67 29 0a 20 20 20 20 20 20 28 ',thing). (
7290: 2c 74 68 69 6e 67 0a 20 20 20 20 20 20 20 20 74 ,thing. t
72a0: 68 69 6e 67 29 29 29 29 0a 0a 3b 3b 20 65 78 61 hing))))..;; exa
72b0: 6d 70 6c 65 73 20 75 73 69 6e 67 20 65 78 70 6c mples using expl
72c0: 69 63 69 74 20 43 61 74 61 73 0a 0a 28 64 65 66 icit Catas..(def
72d0: 69 6e 65 20 73 75 6d 73 71 75 61 72 65 73 0a 20 ine sumsquares.
72e0: 20 28 6c 61 6d 62 64 61 20 28 6c 73 29 0a 20 20 (lambda (ls).
72f0: 20 20 28 64 65 66 69 6e 65 20 73 71 75 61 72 65 (define square
7300: 20 0a 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 . (lambda
7310: 28 78 29 0a 20 20 20 20 20 20 20 20 28 2a 20 78 (x). (* x
7320: 20 78 29 29 29 0a 20 20 20 20 28 6d 61 74 63 68 x))). (match
7330: 20 6c 73 20 0a 20 20 20 20 20 20 5b 28 2c 5b 61 ls . [(,[a
7340: 2a 5d 20 2e 2e 2e 29 20 28 61 70 70 6c 79 20 2b *] ...) (apply +
7350: 20 61 2a 29 5d 0a 20 20 20 20 20 20 5b 2c 5b 73 a*)]. [,[s
7360: 71 75 61 72 65 20 2d 3e 20 6e 5d 20 6e 5d 29 29 quare -> n] n]))
7370: 29 0a 0a 28 64 65 66 69 6e 65 20 73 75 6d 73 71 )..(define sumsq
7380: 75 61 72 65 73 0a 20 20 28 6c 61 6d 62 64 61 20 uares. (lambda
7390: 28 6c 73 29 0a 20 20 20 20 28 64 65 66 69 6e 65 (ls). (define
73a0: 20 73 71 75 61 72 65 20 0a 20 20 20 20 20 20 28 square . (
73b0: 6c 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 lambda (x).
73c0: 20 20 20 28 2a 20 78 20 78 29 29 29 0a 20 20 20 (* x x))).
73d0: 20 28 6c 65 74 20 28 5b 61 63 63 20 30 5d 29 0a (let ([acc 0]).
73e0: 20 20 20 20 20 20 28 6d 61 74 63 68 2b 20 28 61 (match+ (a
73f0: 63 63 29 20 6c 73 20 0a 20 20 20 20 20 20 20 20 cc) ls .
7400: 5b 28 2c 5b 5d 20 2e 2e 2e 29 20 61 63 63 5d 0a [(,[] ...) acc].
7410: 20 20 20 20 20 20 20 20 5b 2c 5b 28 6c 61 6d 62 [,[(lamb
7420: 64 61 20 28 61 63 63 20 78 29 20 28 2b 20 61 63 da (acc x) (+ ac
7430: 63 20 28 73 71 75 61 72 65 20 78 29 29 29 20 2d c (square x))) -
7440: 3e 5d 20 61 63 63 5d 29 29 29 29 0a 0a 3b 3b 3b >] acc]))))..;;;
7450: 20 54 68 65 20 66 6f 6c 6c 6f 77 69 6e 67 20 75 The following u
7460: 73 65 73 20 65 78 70 6c 69 63 69 74 20 43 61 74 ses explicit Cat
7470: 61 73 20 74 6f 20 70 61 72 73 65 20 70 72 6f 67 as to parse prog
7480: 72 61 6d 73 20 69 6e 20 74 68 65 0a 3b 3b 3b 20 rams in the.;;;
7490: 73 69 6d 70 6c 65 20 6c 61 6e 67 75 61 67 65 20 simple language
74a0: 64 65 66 69 6e 65 64 20 62 79 20 74 68 65 20 67 defined by the g
74b0: 72 61 6d 6d 61 72 20 62 65 6c 6f 77 0a 0a 3b 3b rammar below..;;
74c0: 3b 20 3c 50 72 6f 67 3e 20 2d 3e 20 28 70 72 6f ; <Prog> -> (pro
74d0: 67 72 61 6d 20 3c 53 74 6d 74 3e 2a 20 3c 45 78 gram <Stmt>* <Ex
74e0: 70 72 3e 29 0a 3b 3b 3b 20 3c 53 74 6d 74 3e 20 pr>).;;; <Stmt>
74f0: 2d 3e 20 28 69 66 20 3c 45 78 70 72 3e 20 3c 53 -> (if <Expr> <S
7500: 74 6d 74 3e 20 3c 53 74 6d 74 3e 29 0a 3b 3b 3b tmt> <Stmt>).;;;
7510: 20 20 20 20 20 20 20 20 20 7c 20 28 73 65 74 21 | (set!
7520: 20 3c 76 61 72 3e 20 3c 45 78 70 72 3e 29 0a 3b <var> <Expr>).;
7530: 3b 3b 20 3c 45 78 70 72 3e 20 2d 3e 20 3c 76 61 ;; <Expr> -> <va
7540: 72 3e 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 7c r>.;;; |
7550: 20 3c 69 6e 74 65 67 65 72 3e 0a 3b 3b 3b 20 20 <integer>.;;;
7560: 20 20 20 20 20 20 20 7c 20 28 69 66 20 3c 45 78 | (if <Ex
7570: 70 72 3e 20 3c 45 78 70 72 3e 20 3c 45 78 70 72 pr> <Expr> <Expr
7580: 3e 29 0a 3b 3b 3b 20 20 20 20 20 20 20 20 20 7c >).;;; |
7590: 20 28 3c 45 78 70 72 3e 20 3c 45 78 70 72 2a 3e (<Expr> <Expr*>
75a0: 29 0a 0a 28 64 65 66 69 6e 65 20 70 61 72 73 65 )..(define parse
75b0: 0a 20 20 28 6c 61 6d 62 64 61 20 28 78 29 0a 20 . (lambda (x).
75c0: 20 20 20 28 64 65 66 69 6e 65 20 50 72 6f 67 0a (define Prog.
75d0: 20 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 (lambda (x
75e0: 29 0a 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 ). (match
75f0: 20 78 0a 20 20 20 20 20 20 20 20 20 20 5b 28 70 x. [(p
7600: 72 6f 67 72 61 6d 20 2c 5b 53 74 6d 74 20 2d 3e rogram ,[Stmt ->
7610: 20 73 2a 5d 20 2e 2e 2e 20 2c 5b 45 78 70 72 20 s*] ... ,[Expr
7620: 2d 3e 20 65 5d 29 0a 20 20 20 20 20 20 20 20 20 -> e]).
7630: 20 20 60 28 62 65 67 69 6e 20 2c 73 2a 20 2e 2e `(begin ,s* ..
7640: 2e 20 2c 65 29 5d 0a 20 20 20 20 20 20 20 20 20 . ,e)].
7650: 20 5b 2c 6f 74 68 65 72 20 28 65 72 72 6f 72 20 [,other (error
7660: 27 70 61 72 73 65 20 22 69 6e 76 61 6c 69 64 20 'parse "invalid
7670: 70 72 6f 67 72 61 6d 20 7e 73 22 20 6f 74 68 65 program ~s" othe
7680: 72 29 5d 29 29 29 0a 20 20 20 20 28 64 65 66 69 r)]))). (defi
7690: 6e 65 20 53 74 6d 74 0a 20 20 20 20 20 20 28 6c ne Stmt. (l
76a0: 61 6d 62 64 61 20 28 78 29 0a 20 20 20 20 20 20 ambda (x).
76b0: 20 20 28 6d 61 74 63 68 20 78 0a 20 20 20 20 20 (match x.
76c0: 20 20 20 20 20 5b 28 69 66 20 2c 5b 45 78 70 72 [(if ,[Expr
76d0: 20 2d 3e 20 65 5d 20 2c 5b 53 74 6d 74 20 2d 3e -> e] ,[Stmt ->
76e0: 20 73 31 5d 20 2c 5b 53 74 6d 74 20 2d 3e 20 73 s1] ,[Stmt -> s
76f0: 32 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 60 2]). `
7700: 28 69 66 20 2c 65 20 2c 73 31 20 2c 73 32 29 5d (if ,e ,s1 ,s2)]
7710: 0a 20 20 20 20 20 20 20 20 20 20 5b 28 73 65 74 . [(set
7720: 21 20 2c 76 20 2c 5b 45 78 70 72 20 2d 3e 20 65 ! ,v ,[Expr -> e
7730: 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 67 ]). (g
7740: 75 61 72 64 20 28 73 79 6d 62 6f 6c 3f 20 76 29 uard (symbol? v)
7750: 29 0a 20 20 20 20 20 20 20 20 20 20 20 60 28 73 ). `(s
7760: 65 74 21 20 2c 76 20 2c 65 29 5d 0a 20 20 20 20 et! ,v ,e)].
7770: 20 20 20 20 20 20 5b 2c 6f 74 68 65 72 20 28 65 [,other (e
7780: 72 72 6f 72 20 27 70 61 72 73 65 20 22 69 6e 76 rror 'parse "inv
7790: 61 6c 69 64 20 73 74 61 74 65 6d 65 6e 74 20 7e alid statement ~
77a0: 73 22 20 6f 74 68 65 72 29 5d 29 29 29 0a 20 20 s" other)]))).
77b0: 20 20 28 64 65 66 69 6e 65 20 45 78 70 72 0a 20 (define Expr.
77c0: 20 20 20 20 20 28 6c 61 6d 62 64 61 20 28 78 29 (lambda (x)
77d0: 0a 20 20 20 20 20 20 20 20 28 6d 61 74 63 68 20 . (match
77e0: 78 0a 20 20 20 20 20 20 20 20 20 20 5b 2c 76 20 x. [,v
77f0: 28 67 75 61 72 64 20 28 73 79 6d 62 6f 6c 3f 20 (guard (symbol?
7800: 76 29 29 20 76 5d 0a 20 20 20 20 20 20 20 20 20 v)) v].
7810: 20 5b 2c 6e 20 28 67 75 61 72 64 20 28 69 6e 74 [,n (guard (int
7820: 65 67 65 72 3f 20 6e 29 29 20 6e 5d 0a 20 20 20 eger? n)) n].
7830: 20 20 20 20 20 20 20 5b 28 69 66 20 2c 5b 65 31 [(if ,[e1
7840: 5d 20 2c 5b 65 32 5d 20 2c 5b 65 33 5d 29 0a 20 ] ,[e2] ,[e3]).
7850: 20 20 20 20 20 20 20 20 20 20 60 28 69 66 20 2c `(if ,
7860: 65 31 20 2c 65 32 20 2c 65 33 29 5d 0a 20 20 20 e1 ,e2 ,e3)].
7870: 20 20 20 20 20 20 20 5b 28 2c 5b 72 61 74 6f 72 [(,[rator
7880: 5d 20 2c 5b 72 61 6e 64 2a 5d 20 2e 2e 2e 29 20 ] ,[rand*] ...)
7890: 60 28 2c 72 61 74 6f 72 20 2c 72 61 6e 64 2a 20 `(,rator ,rand*
78a0: 2e 2e 2e 29 5d 0a 20 20 20 20 20 20 20 20 20 20 ...)].
78b0: 5b 2c 6f 74 68 65 72 20 28 65 72 72 6f 72 20 27 [,other (error '
78c0: 70 61 72 73 65 20 22 69 6e 76 61 6c 69 64 20 65 parse "invalid e
78d0: 78 70 72 65 73 73 69 6f 6e 20 7e 73 22 20 6f 74 xpression ~s" ot
78e0: 68 65 72 29 5d 29 29 29 0a 20 20 20 20 28 50 72 her)]))). (Pr
78f0: 6f 67 20 78 29 29 29 0a 3b 3b 3b 20 28 70 61 72 og x))).;;; (par
7900: 73 65 20 27 28 70 72 6f 67 72 61 6d 20 28 73 65 se '(program (se
7910: 74 21 20 78 20 33 29 20 28 2b 20 78 20 34 29 29 t! x 3) (+ x 4))
7920: 29 29 20 3d 3e 20 28 62 65 67 69 6e 20 28 73 65 )) => (begin (se
7930: 74 21 20 78 20 33 29 20 28 2b 20 78 20 34 29 29 t! x 3) (+ x 4))
7940: 0a 0a 3b 3b 20 43 48 41 4e 47 45 4c 4f 47 0a 0a ..;; CHANGELOG..
7950: 3b 3b 20 5b 33 31 20 4a 61 6e 75 61 72 79 20 32 ;; [31 January 2
7960: 30 31 30 5d 0a 3b 3b 20 72 6b 64 20 72 65 70 6c 010].;; rkd repl
7970: 61 63 65 64 20 5f 20 77 69 74 68 20 6b 20 69 6e aced _ with k in
7980: 20 74 68 65 20 73 79 6e 74 61 78 2d 63 61 73 65 the syntax-case
7990: 20 70 61 74 74 65 72 6e 73 20 66 6f 72 20 6d 61 patterns for ma
79a0: 74 63 68 2c 20 6d 61 74 63 68 2b 2c 0a 3b 3b 20 tch, match+,.;;
79b0: 65 74 63 2e 2c 20 73 69 6e 63 65 20 69 6e 20 52 etc., since in R
79c0: 36 52 53 2c 20 5f 20 69 73 20 6e 6f 74 20 61 20 6RS, _ is not a
79d0: 70 61 74 74 65 72 6e 20 76 61 72 69 61 62 6c 65 pattern variable
79e0: 2e 0a 0a 3b 3b 20 5b 33 31 20 4a 61 6e 75 61 72 ...;; [31 Januar
79f0: 79 20 32 30 31 30 5d 0a 3b 3b 20 72 6b 64 20 72 y 2010].;; rkd r
7a00: 65 6e 61 6d 65 64 20 73 79 6e 74 61 78 2d 6f 62 enamed syntax-ob
7a10: 6a 65 63 74 2d 3e 64 61 74 75 6d 20 61 6e 64 20 ject->datum and
7a20: 64 61 74 75 6d 2d 3e 73 79 6e 74 61 78 2d 6f 62 datum->syntax-ob
7a30: 6a 65 63 74 20 74 6f 20 74 68 65 69 72 0a 3b 3b ject to their.;;
7a40: 20 52 36 52 53 20 6e 61 6d 65 73 20 73 79 6e 74 R6RS names synt
7a50: 61 78 2d 3e 64 61 74 75 6d 20 61 6e 64 20 64 61 ax->datum and da
7a60: 74 75 6d 2d 3e 73 79 6e 74 61 78 2e 20 20 61 6c tum->syntax. al
7a70: 73 6f 20 72 65 70 6c 61 63 65 64 20 74 68 65 0a so replaced the.
7a80: 3b 3b 20 6c 69 74 65 72 61 6c 2d 69 64 65 6e 74 ;; literal-ident
7a90: 69 66 69 65 72 3d 3f 20 63 61 6c 6c 73 20 77 69 ifier=? calls wi
7aa0: 74 68 20 66 72 65 65 2d 69 64 65 6e 74 69 66 69 th free-identifi
7ab0: 65 72 3d 3f 20 63 61 6c 6c 73 2e 0a 0a 3b 3b 20 er=? calls...;;
7ac0: 5b 33 20 46 65 62 72 75 61 72 79 20 32 30 30 38 [3 February 2008
7ad0: 5d 0a 3b 3b 20 72 6b 64 20 6d 6f 64 69 66 69 65 ].;; rkd modifie
7ae0: 64 20 6f 76 65 72 6c 6f 61 64 65 64 20 71 75 61 d overloaded qua
7af0: 73 69 71 75 6f 74 65 20 74 6f 20 68 61 6e 64 6c siquote to handl
7b00: 65 20 65 78 70 72 65 73 73 69 6f 6e 73 20 66 6f e expressions fo
7b10: 6c 6c 6f 77 65 64 0a 3b 3b 20 62 79 20 6d 6f 72 llowed.;; by mor
7b20: 65 20 74 68 61 6e 20 6f 6e 65 20 65 6c 6c 69 70 e than one ellip
7b30: 73 69 73 2e 0a 0a 3b 3b 20 5b 33 20 46 65 62 72 sis...;; [3 Febr
7b40: 75 61 72 79 20 32 30 30 38 5d 0a 3b 3b 20 61 7a uary 2008].;; az
7b50: 69 7a 20 6d 6f 64 69 66 69 65 64 20 6d 61 70 70 iz modified mapp
7b60: 65 72 20 74 6f 20 71 75 6f 74 65 20 74 68 65 20 er to quote the
7b70: 69 6e 73 65 72 74 65 64 20 65 6d 70 74 79 20 6c inserted empty l
7b80: 69 73 74 73 0a 0a 3b 3b 20 5b 33 20 4d 61 72 63 ists..;; [3 Marc
7b90: 68 20 32 30 30 37 5d 0a 3b 3b 20 61 7a 69 7a 20 h 2007].;; aziz
7ba0: 6d 69 6e 6f 72 20 63 68 61 6e 67 65 20 74 6f 20 minor change to
7bb0: 65 61 67 65 72 6c 79 20 63 61 74 63 68 20 6d 61 eagerly catch ma
7bc0: 6c 66 6f 72 6d 65 64 20 63 6c 61 75 73 65 73 20 lformed clauses
7bd0: 28 65 2e 67 2e 20 61 20 63 6c 61 75 73 65 0a 3b (e.g. a clause.;
7be0: 3b 20 74 68 61 74 27 73 20 6e 6f 74 20 61 20 6c ; that's not a l
7bf0: 69 73 74 20 6f 66 20 32 20 6f 72 20 6d 6f 72 65 ist of 2 or more
7c00: 20 73 75 62 66 6f 72 6d 73 29 2e 0a 0a 3b 3b 20 subforms)...;;
7c10: 5b 31 33 20 4d 61 72 63 68 20 32 30 30 32 5d 0a [13 March 2002].
7c20: 3b 3b 20 72 6b 64 20 61 64 64 65 64 20 66 6f 6c ;; rkd added fol
7c30: 6c 6f 77 69 6e 67 20 63 68 61 6e 67 65 20 62 79 lowing change by
7c40: 20 46 72 69 65 64 6d 61 6e 20 61 6e 64 20 47 61 Friedman and Ga
7c50: 6e 7a 20 74 6f 20 74 68 65 20 6d 61 69 6e 20 73 nz to the main s
7c60: 6f 75 72 63 65 0a 3b 3b 20 63 6f 64 65 20 74 68 ource.;; code th
7c70: 72 65 61 64 20 61 6e 64 20 66 69 78 65 64 20 61 read and fixed a
7c80: 20 63 6f 75 70 6c 65 20 6f 66 20 6d 69 6e 6f 72 couple of minor
7c90: 20 70 72 6f 62 6c 65 6d 73 2e 0a 0a 3b 3b 20 5b problems...;; [
7ca0: 39 20 4d 61 72 63 68 20 32 30 30 32 5d 0a 3b 3b 9 March 2002].;;
7cb0: 20 44 61 6e 20 46 72 69 65 64 6d 61 6e 20 61 6e Dan Friedman an
7cc0: 64 20 53 74 65 76 65 20 47 61 6e 7a 20 61 64 64 d Steve Ganz add
7cd0: 65 64 20 74 68 65 20 61 62 69 6c 69 74 79 20 74 ed the ability t
7ce0: 6f 20 75 73 65 20 69 64 65 6e 74 69 63 61 6c 20 o use identical
7cf0: 70 61 74 74 65 72 6e 0a 3b 3b 20 76 61 72 69 61 pattern.;; varia
7d00: 62 6c 65 73 2e 20 20 54 68 65 20 70 61 74 74 65 bles. The patte
7d10: 72 6e 73 20 72 65 70 72 65 73 65 6e 74 65 64 20 rns represented
7d20: 62 79 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 by the variables
7d30: 20 61 72 65 20 63 6f 6d 70 61 72 65 64 0a 3b 3b are compared.;;
7d40: 20 75 73 69 6e 67 20 74 68 65 20 76 61 6c 75 65 using the value
7d50: 20 6f 66 20 74 68 65 20 70 61 72 61 6d 65 74 65 of the paramete
7d60: 72 20 6d 61 74 63 68 2d 65 71 75 61 6c 69 74 79 r match-equality
7d70: 2d 74 65 73 74 2c 20 77 68 69 63 68 20 64 65 66 -test, which def
7d80: 61 75 6c 74 73 0a 3b 3b 20 74 6f 20 65 71 75 61 aults.;; to equa
7d90: 6c 3f 2e 0a 3b 3b 0a 3b 3b 20 3e 20 28 6d 61 74 l?..;;.;; > (mat
7da0: 63 68 20 27 28 31 20 32 20 31 20 32 20 31 29 0a ch '(1 2 1 2 1).
7db0: 3b 3b 20 20 20 20 20 5b 28 2c 61 20 2c 62 20 2c ;; [(,a ,b ,
7dc0: 61 20 2c 62 20 2c 61 29 20 28 67 75 61 72 64 20 a ,b ,a) (guard
7dd0: 28 6e 75 6d 62 65 72 3f 20 61 29 20 28 6e 75 6d (number? a) (num
7de0: 62 65 72 3f 20 62 29 29 20 28 2b 20 61 20 62 29 ber? b)) (+ a b)
7df0: 5d 29 0a 3b 3b 20 33 0a 3b 3b 20 3b 3b 0a 3b 3b ]).;; 3.;; ;;.;;
7e00: 20 3e 20 28 6d 61 74 63 68 20 27 28 28 31 20 32 > (match '((1 2
7e10: 20 33 29 20 35 20 28 31 20 32 20 33 29 29 0a 3b 3) 5 (1 2 3)).;
7e20: 3b 20 20 20 20 20 5b 28 28 2c 61 20 2e 2e 2e 29 ; [((,a ...)
7e30: 20 2c 62 20 28 2c 61 20 2e 2e 2e 29 29 20 60 28 ,b (,a ...)) `(
7e40: 2c 61 20 2e 2e 2e 20 2c 62 29 5d 29 0a 3b 3b 20 ,a ... ,b)]).;;
7e50: 28 31 20 32 20 33 20 35 29 0a 3b 3b 20 3b 3b 0a (1 2 3 5).;; ;;.
7e60: 3b 3b 20 3e 20 28 70 61 72 61 6d 65 74 65 72 69 ;; > (parameteri
7e70: 7a 65 20 28 5b 6d 61 74 63 68 2d 65 71 75 61 6c ze ([match-equal
7e80: 69 74 79 2d 74 65 73 74 20 28 6c 61 6d 62 64 61 ity-test (lambda
7e90: 20 28 78 20 79 29 20 28 65 71 75 61 6c 3f 20 78 (x y) (equal? x
7ea0: 20 28 72 65 76 65 72 73 65 20 79 29 29 29 5d 29 (reverse y)))])
7eb0: 0a 3b 3b 20 20 20 20 20 28 6d 61 74 63 68 20 27 .;; (match '
7ec0: 28 28 31 20 32 20 33 29 20 28 33 20 32 20 31 29 ((1 2 3) (3 2 1)
7ed0: 29 20 20 20 0a 3b 3b 20 20 20 20 20 20 20 5b 28 ) .;; [(
7ee0: 2c 61 20 2c 61 29 20 27 79 65 73 5d 0a 3b 3b 20 ,a ,a) 'yes].;;
7ef0: 20 20 20 20 20 20 5b 2c 6f 6f 70 73 20 27 6e 6f [,oops 'no
7f00: 5d 29 29 0a 3b 3b 20 79 65 73 0a 0a 3b 3b 20 5b ])).;; yes..;; [
7f10: 31 30 20 4a 61 6e 20 32 30 30 32 5d 0a 3b 3b 20 10 Jan 2002].;;
7f20: 65 68 20 66 69 78 65 64 20 62 75 67 20 74 68 61 eh fixed bug tha
7f30: 74 20 63 61 75 73 65 64 20 28 6d 61 74 63 68 20 t caused (match
7f40: 27 28 28 31 20 32 20 33 20 34 29 29 20 28 28 28 '((1 2 3 4)) (((
7f50: 2c 61 20 2e 2e 2e 20 2c 64 29 20 2e 20 2c 78 29 ,a ... ,d) . ,x)
7f60: 20 61 29 29 20 74 6f 0a 3b 3b 20 62 6c 6f 77 20 a)) to.;; blow
7f70: 75 70 2e 20 20 54 68 65 20 62 75 67 20 77 61 73 up. The bug was
7f80: 20 63 61 75 73 65 64 20 62 79 20 61 20 62 75 67 caused by a bug
7f90: 20 69 6e 20 74 68 65 20 73 65 78 70 2d 64 69 73 in the sexp-dis
7fa0: 70 61 74 63 68 20 70 72 6f 63 65 64 75 72 65 0a patch procedure.
7fb0: 3b 3b 20 77 68 65 72 65 20 61 20 62 61 73 65 20 ;; where a base
7fc0: 76 61 6c 75 65 20 65 6d 70 74 79 20 6c 69 73 74 value empty list
7fd0: 20 77 61 73 20 70 61 73 73 65 64 20 74 6f 20 61 was passed to a
7fe0: 6e 20 61 63 63 75 6d 75 6c 61 74 6f 72 20 66 72 n accumulator fr
7ff0: 6f 6d 20 69 6e 73 69 64 65 0a 3b 3b 20 74 68 65 om inside.;; the
8000: 20 72 65 63 75 72 73 69 6f 6e 2c 20 69 6e 73 74 recursion, inst
8010: 65 61 64 20 6f 66 20 70 61 73 73 69 6e 67 20 74 ead of passing t
8020: 68 65 20 6f 6c 64 20 76 61 6c 75 65 20 6f 66 20 he old value of
8030: 74 68 65 20 61 63 63 75 6d 75 6c 61 74 6f 72 2e the accumulator.
8040: 0a 0a 3b 3b 20 5b 31 34 20 4a 61 6e 20 32 30 30 ..;; [14 Jan 200
8050: 31 5d 0a 3b 3b 20 72 6b 64 20 61 64 64 65 64 20 1].;; rkd added
8060: 73 79 6e 74 61 78 20 63 68 65 63 6b 73 20 74 6f syntax checks to
8070: 20 75 6e 71 75 6f 74 65 20 70 61 74 74 65 72 6e unquote pattern
8080: 20 70 61 72 73 69 6e 67 20 74 6f 20 77 65 65 64 parsing to weed
8090: 20 6f 75 74 20 69 6e 76 61 6c 69 64 0a 3b 3b 20 out invalid.;;
80a0: 70 61 74 74 65 72 6e 73 20 6c 69 6b 65 20 2c 23 patterns like ,#
80b0: 28 61 29 20 61 6e 64 20 2c 5b 28 76 65 63 74 6f (a) and ,[(vecto
80c0: 72 2d 72 65 66 20 64 20 31 29 5d 2e 0a 0a 3b 3b r-ref d 1)]...;;
80d0: 20 5b 31 34 20 4a 61 6e 20 32 30 30 31 5d 0a 3b [14 Jan 2001].;
80e0: 3b 20 72 6b 64 20 61 64 64 65 64 20 2c 5b 43 61 ; rkd added ,[Ca
80f0: 74 61 20 2d 3e 20 49 64 2a 20 2e 2e 2e 5d 20 74 ta -> Id* ...] t
8100: 6f 20 61 6c 6c 6f 77 20 73 70 65 63 69 66 69 63 o allow specific
8110: 61 74 69 6f 6e 20 6f 66 20 72 65 63 75 72 73 69 ation of recursi
8120: 6f 6e 0a 3b 3b 20 66 75 6e 63 74 69 6f 6e 2e 20 on.;; function.
8130: 20 2c 5b 49 64 2a 20 2e 2e 2e 5d 20 72 65 63 75 ,[Id* ...] recu
8140: 72 73 20 74 6f 20 6d 61 74 63 68 3b 20 2c 5b 43 rs to match; ,[C
8150: 61 74 61 20 2d 3e 20 49 64 2a 20 2e 2e 2e 5d 20 ata -> Id* ...]
8160: 72 65 63 75 72 73 0a 3b 3b 20 74 6f 20 43 61 74 recurs.;; to Cat
8170: 61 2e 0a 0a 3b 3b 20 5b 31 34 20 4a 61 6e 20 32 a...;; [14 Jan 2
8180: 30 30 31 5d 0a 3b 3b 20 72 6b 64 20 74 69 67 68 001].;; rkd tigh
8190: 74 65 6e 65 64 20 75 70 20 63 68 65 63 6b 73 20 tened up checks
81a0: 66 6f 72 20 65 6c 6c 69 70 73 65 73 20 61 6e 64 for ellipses and
81b0: 20 6e 65 73 74 65 64 20 71 75 61 73 69 71 75 6f nested quasiquo
81c0: 74 65 3b 20 77 61 73 20 63 6f 6d 70 61 72 69 6e te; was comparin
81d0: 67 0a 3b 3b 20 73 79 6d 62 6f 6c 69 63 20 6e 61 g.;; symbolic na
81e0: 6d 65 73 2c 20 77 68 69 63 68 2c 20 61 73 20 68 mes, which, as h
81f0: 61 64 20 62 65 65 6e 20 6e 6f 74 65 64 20 69 6e ad been noted in
8200: 20 74 68 65 20 73 6f 75 72 63 65 2c 20 69 73 20 the source, is
8210: 61 20 70 6f 73 73 69 62 6c 65 0a 3b 3b 20 68 79 a possible.;; hy
8220: 67 69 65 6e 65 20 62 75 67 2e 20 20 52 65 70 6c giene bug. Repl
8230: 61 63 65 64 20 65 72 72 6f 72 20 63 61 6c 6c 20 aced error call
8240: 69 6e 20 67 75 61 72 64 2d 62 6f 64 79 20 77 69 in guard-body wi
8250: 74 68 20 73 79 6e 74 61 78 2d 65 72 72 6f 72 20 th syntax-error
8260: 74 6f 0a 3b 3b 20 61 6c 6c 6f 77 20 65 72 72 6f to.;; allow erro
8270: 72 20 74 6f 20 69 6e 63 6c 75 64 65 20 73 6f 75 r to include sou
8280: 72 63 65 20 6c 69 6e 65 2f 63 68 61 72 61 63 74 rce line/charact
8290: 65 72 20 69 6e 66 6f 72 6d 61 74 69 6f 6e 2e 0a er information..
82a0: 0a 3b 3b 20 5b 31 33 20 4a 61 6e 20 32 30 30 31 .;; [13 Jan 2001
82b0: 5d 0a 3b 3b 20 72 6b 64 20 66 69 78 65 64 20 6d ].;; rkd fixed m
82c0: 61 74 63 68 20 70 61 74 74 65 72 6e 73 20 6f 66 atch patterns of
82d0: 20 74 68 65 20 66 6f 72 6d 20 28 73 74 75 66 66 the form (stuff
82e0: 2a 20 2c 5b 78 5d 20 2e 2e 2e 20 73 74 75 66 66 * ,[x] ... stuff
82f0: 2b 29 2c 20 77 68 69 63 68 0a 3b 3b 20 68 61 64 +), which.;; had
8300: 20 62 65 65 6e 20 72 65 63 75 72 72 69 6e 67 20 been recurring
8310: 6f 6e 20 73 75 62 66 6f 72 6d 73 20 6f 66 20 65 on subforms of e
8320: 61 63 68 20 69 74 65 6d 20 72 61 74 68 65 72 20 ach item rather
8330: 74 68 61 6e 20 6f 6e 20 74 68 65 20 69 74 65 6d than on the item
8340: 73 0a 3b 3b 20 74 68 65 6d 73 65 6c 76 65 73 2e s.;; themselves.
8350: 0a 0a 3b 3b 20 5b 32 39 20 46 65 62 20 32 30 30 ..;; [29 Feb 200
8360: 30 5d 0a 3b 3b 20 46 69 78 65 64 20 61 20 63 61 0].;; Fixed a ca
8370: 73 65 20 73 65 6e 73 69 74 69 76 69 74 79 20 62 se sensitivity b
8380: 75 67 2e 0a 0a 3b 3b 20 5b 32 34 20 46 65 62 20 ug...;; [24 Feb
8390: 32 30 30 30 5d 0a 3b 3b 20 4d 61 74 63 68 65 72 2000].;; Matcher
83a0: 20 6e 6f 77 20 68 61 6e 64 6c 65 73 20 76 65 63 now handles vec
83b0: 74 6f 72 20 70 61 74 74 65 72 6e 73 2e 20 20 51 tor patterns. Q
83c0: 75 61 73 69 71 75 6f 74 65 20 61 6c 73 6f 20 68 uasiquote also h
83d0: 61 6e 64 6c 65 73 0a 3b 3b 20 76 65 63 74 6f 72 andles.;; vector
83e0: 20 70 61 74 74 65 72 6e 73 2c 20 62 75 74 20 64 patterns, but d
83f0: 6f 65 73 20 4e 4f 54 20 64 6f 20 74 68 65 20 63 oes NOT do the c
8400: 73 76 36 2e 32 20 6f 70 74 69 6d 69 7a 61 74 69 sv6.2 optimizati
8410: 6f 6e 20 6f 66 0a 3b 3b 20 60 23 28 61 20 31 20 on of.;; `#(a 1
8420: 2c 28 2b 20 33 20 34 29 20 78 20 79 29 20 3d 3d ,(+ 3 4) x y) ==
8430: 3e 20 28 76 65 63 74 6f 72 20 27 61 20 31 20 28 > (vector 'a 1 (
8440: 2b 20 33 20 34 29 20 27 78 20 27 79 29 2e 0a 3b + 3 4) 'x 'y)..;
8450: 3b 20 41 6c 73 6f 20 66 69 78 65 64 20 62 75 67 ; Also fixed bug
8460: 20 69 6e 20 28 50 20 2e 2e 2e 20 2e 20 50 29 20 in (P ... . P)
8470: 6d 61 74 63 68 69 6e 67 20 63 6f 64 65 2e 20 0a matching code. .
8480: 0a 3b 3b 20 5b 32 33 20 46 65 62 20 32 30 30 30 .;; [23 Feb 2000
8490: 5d 0a 3b 3b 20 4b 53 4d 20 66 69 78 65 64 20 62 ].;; KSM fixed b
84a0: 75 67 20 69 6e 20 75 6e 71 75 6f 74 65 2d 73 70 ug in unquote-sp
84b0: 6c 69 63 69 6e 67 20 69 6e 73 69 64 65 20 71 75 licing inside qu
84c0: 61 73 69 71 75 6f 74 65 2e 0a 0a 3b 3b 20 5b 31 asiquote...;; [1
84d0: 30 20 46 65 62 20 32 30 30 30 5d 0a 3b 3b 20 4e 0 Feb 2000].;; N
84e0: 65 77 20 66 6f 72 6d 73 20 6d 61 74 63 68 2b 20 ew forms match+
84f0: 61 6e 64 20 74 72 61 63 65 2d 6d 61 74 63 68 2b and trace-match+
8500: 20 74 68 72 65 61 64 20 61 72 67 75 6d 65 6e 74 thread argument
8510: 73 20 72 69 67 68 74 2d 74 6f 2d 6c 65 66 74 2e s right-to-left.
8520: 0a 3b 3b 20 54 68 65 20 70 61 74 74 65 72 6e 20 .;; The pattern
8530: 28 50 20 2e 2e 2e 20 2e 20 50 29 20 6e 6f 77 20 (P ... . P) now
8540: 77 6f 72 6b 73 20 74 68 65 20 77 61 79 20 79 6f works the way yo
8550: 75 20 6d 69 67 68 74 20 65 78 70 65 63 74 2e 0a u might expect..
8560: 3b 3b 20 49 6e 66 69 6e 69 74 65 20 6c 69 73 74 ;; Infinite list
8570: 73 20 61 72 65 20 6e 6f 77 20 70 72 6f 70 65 72 s are now proper
8580: 6c 79 20 6d 61 74 63 68 65 64 20 28 61 6e 64 20 ly matched (and
8590: 6e 6f 74 20 6d 61 74 63 68 65 64 29 2e 0a 3b 3b not matched)..;;
85a0: 20 52 65 6d 6f 76 65 64 20 74 68 65 20 40 20 70 Removed the @ p
85b0: 61 74 74 65 72 6e 2e 0a 3b 3b 20 49 6e 74 65 72 attern..;; Inter
85c0: 6e 61 6c 3a 20 4e 6f 20 6c 6f 6e 67 65 72 20 63 nal: No longer c
85d0: 6f 6e 76 65 72 74 69 6e 67 20 69 6e 74 6f 20 73 onverting into s
85e0: 79 6e 74 61 78 2d 63 61 73 65 2e 20 0a 0a 3b 3b yntax-case. ..;;
85f0: 20 5b 36 20 46 65 62 20 32 30 30 30 5d 0a 3b 3b [6 Feb 2000].;;
8600: 20 41 64 64 65 64 20 65 78 70 61 6e 73 69 6f 6e Added expansion
8610: 2d 74 69 6d 65 20 65 72 72 6f 72 20 6d 65 73 73 -time error mess
8620: 61 67 65 20 66 6f 72 20 72 65 66 65 72 72 69 6e age for referrin
8630: 67 20 74 6f 20 63 61 74 61 20 76 61 72 69 61 62 g to cata variab
8640: 6c 65 0a 3b 3b 20 69 6e 20 61 20 67 75 61 72 64 le.;; in a guard
8650: 2e 0a 0a 3b 3b 20 5b 34 20 46 65 62 20 32 30 30 ...;; [4 Feb 200
8660: 30 5d 0a 3b 3b 20 46 69 78 65 64 20 62 61 63 6b 0].;; Fixed back
8670: 71 75 6f 74 65 20 73 6f 20 69 74 20 63 61 6e 20 quote so it can
8680: 68 61 6e 64 6c 65 20 6e 65 73 74 65 64 20 62 61 handle nested ba
8690: 63 6b 71 75 6f 74 65 20 28 6f 6f 70 73 29 2e 0a ckquote (oops)..
86a0: 3b 3b 20 44 6f 75 62 6c 65 2d 62 61 63 6b 71 75 ;; Double-backqu
86b0: 6f 74 65 64 20 65 6c 69 70 73 65 73 20 61 72 65 oted elipses are
86c0: 20 6e 65 75 74 72 61 6c 69 7a 65 64 20 6a 75 73 neutralized jus
86d0: 74 20 61 73 20 64 6f 75 62 6c 65 2d 62 61 63 6b t as double-back
86e0: 71 75 6f 74 65 64 0a 3b 3b 20 75 6e 71 75 6f 74 quoted.;; unquot
86f0: 65 73 20 61 72 65 2e 20 20 53 6f 3a 0a 3b 3b 20 es are. So:.;;
8700: 20 20 60 28 61 20 2c 27 28 31 20 32 20 33 29 20 `(a ,'(1 2 3)
8710: 2e 2e 2e 20 62 29 20 20 20 20 3d 65 76 61 6c 3d ... b) =eval=
8720: 3e 20 28 61 20 31 20 32 20 33 20 62 29 0a 3b 3b > (a 1 2 3 b).;;
8730: 20 20 20 60 60 28 61 20 2c 27 28 31 20 32 20 33 ``(a ,'(1 2 3
8740: 29 20 2e 2e 2e 20 62 29 20 20 20 3d 65 76 61 6c ) ... b) =eval
8750: 3d 3e 20 60 28 61 20 2c 27 28 31 20 32 20 33 29 => `(a ,'(1 2 3)
8760: 20 2e 2e 2e 20 62 29 0a 3b 3b 20 20 20 60 60 28 ... b).;; ``(
8770: 61 20 2c 28 2c 28 31 20 32 20 33 29 20 2e 2e 2e a ,(,(1 2 3) ...
8780: 29 20 62 29 20 3d 65 76 61 6c 3d 3e 20 60 28 61 ) b) =eval=> `(a
8790: 20 2c 28 31 20 32 20 33 29 20 62 29 0a 3b 3b 20 ,(1 2 3) b).;;
87a0: 41 64 64 65 64 20 73 75 70 70 6f 72 74 20 66 6f Added support fo
87b0: 72 0a 3b 3b 20 20 20 60 28 28 75 6e 71 75 6f 74 r.;; `((unquot
87c0: 65 2d 73 70 6c 69 63 69 6e 67 20 78 20 79 20 7a e-splicing x y z
87d0: 29 20 62 29 20 3d 65 78 70 61 6e 64 3d 3d 3e 20 ) b) =expand==>
87e0: 28 61 70 70 65 6e 64 20 78 20 79 20 7a 20 28 6c (append x y z (l
87f0: 69 73 74 20 27 62 29 29 0a 0a 3b 3b 20 5b 31 20 ist 'b))..;; [1
8800: 46 65 62 20 32 30 30 30 5d 0a 3b 3b 20 46 69 78 Feb 2000].;; Fix
8810: 65 64 20 61 20 62 75 67 20 69 6e 76 6f 6c 76 69 ed a bug involvi
8820: 6e 67 20 66 6f 72 67 65 74 74 69 6e 67 20 74 6f ng forgetting to
8830: 20 71 75 6f 74 65 20 73 74 75 66 66 20 69 6e 20 quote stuff in
8840: 74 68 65 20 72 65 76 69 73 65 64 20 62 61 63 6b the revised back
8850: 71 75 6f 74 65 2e 0a 3b 3b 20 52 65 63 6f 67 6e quote..;; Recogn
8860: 69 7a 65 64 20 75 6e 71 75 6f 74 65 2d 73 70 6c ized unquote-spl
8870: 69 63 69 6e 67 20 61 6e 64 20 73 69 67 6e 61 6c icing and signal
8880: 6c 65 64 20 65 72 72 6f 72 73 20 69 6e 20 74 68 led errors in th
8890: 65 20 61 70 70 72 6f 70 72 69 61 74 65 20 70 6c e appropriate pl
88a0: 61 63 65 73 2e 0a 3b 3b 20 41 64 64 65 64 20 73 aces..;; Added s
88b0: 75 70 70 6f 72 74 20 66 6f 72 20 64 65 65 70 20 upport for deep
88c0: 65 6c 69 70 73 65 73 20 69 6e 20 62 61 63 6b 71 elipses in backq
88d0: 75 6f 74 65 2e 0a 3b 3b 20 52 65 77 72 6f 74 65 uote..;; Rewrote
88e0: 20 62 61 63 6b 71 75 6f 74 65 20 73 6f 20 69 74 backquote so it
88f0: 20 64 6f 65 73 20 74 68 65 20 72 65 62 75 69 6c does the rebuil
8900: 64 69 6e 67 20 64 69 72 65 63 74 6c 79 20 69 6e ding directly in
8910: 73 74 65 61 64 20 6f 66 0a 3b 3b 20 65 78 70 61 stead of.;; expa
8920: 6e 64 69 6e 67 20 69 6e 74 6f 20 43 68 65 7a 27 nding into Chez'
8930: 73 20 62 61 63 6b 71 75 6f 74 65 2e 20 0a 0a 3b s backquote. ..;
8940: 3b 20 5b 33 31 20 4a 61 6e 20 32 30 30 30 5d 0a ; [31 Jan 2000].
8950: 3b 3b 20 4b 65 6e 74 20 44 79 62 76 69 67 20 66 ;; Kent Dybvig f
8960: 69 78 65 64 20 74 65 6d 70 6c 61 74 65 20 62 75 ixed template bu
8970: 67 2e 0a 0a 3b 3b 20 5b 33 31 20 4a 61 6e 20 32 g...;; [31 Jan 2
8980: 30 30 30 5d 0a 3b 3b 20 41 64 64 65 64 20 74 68 000].;; Added th
8990: 65 20 74 72 61 63 65 2d 6d 61 74 63 68 20 66 6f e trace-match fo
89a0: 72 6d 2c 20 61 6e 64 20 6d 61 64 65 20 67 75 61 rm, and made gua
89b0: 72 64 73 20 63 6f 6e 74 61 69 6e 0a 3b 3b 20 61 rds contain.;; a
89c0: 6e 20 65 78 70 6c 69 63 69 74 20 61 6e 64 20 65 n explicit and e
89d0: 78 70 72 65 73 73 69 6f 6e 3a 0a 3b 3b 20 20 20 xpression:.;;
89e0: 20 28 67 75 61 72 64 20 45 20 2e 2e 2e 29 20 3d (guard E ...) =
89f0: 3d 3e 20 28 67 75 61 72 64 20 28 61 6e 64 20 45 => (guard (and E
8a00: 20 2e 2e 2e 29 29 0a 0a 3b 3b 20 5b 32 36 20 4a ...))..;; [26 J
8a10: 61 6e 20 32 30 30 30 5d 0a 3b 3b 20 49 6e 73 69 an 2000].;; Insi
8a20: 64 65 20 74 68 65 20 63 6c 61 75 73 65 73 20 6f de the clauses o
8a30: 66 20 6d 61 74 63 68 20 65 78 70 72 65 73 73 69 f match expressi
8a40: 6f 6e 73 2c 20 74 68 65 20 66 6f 6c 6c 6f 77 69 ons, the followi
8a50: 6e 67 0a 3b 3b 20 74 72 61 6e 73 66 6f 72 6d 61 ng.;; transforma
8a60: 74 69 6f 6e 20 69 73 20 70 65 72 66 6f 72 6d 65 tion is performe
8a70: 64 20 69 6e 73 69 64 65 20 62 61 63 6b 71 75 6f d inside backquo
8a80: 74 65 20 65 78 70 72 65 73 73 69 6f 6e 73 3a 0a te expressions:.
8a90: 3b 3b 20 20 20 20 2c 76 20 2e 2e 2e 20 20 20 20 ;; ,v ...
8aa0: 20 20 3d 3d 3e 20 2c 40 76 0a 3b 3b 20 20 20 20 ==> ,@v.;;
8ab0: 28 2c 76 20 2c 77 29 20 2e 2e 2e 20 3d 3d 3e 20 (,v ,w) ... ==>
8ac0: 2c 40 28 6d 61 70 20 6c 69 73 74 20 76 20 77 29 ,@(map list v w)
8ad0: 0a 3b 3b 20 20 20 20 65 74 63 2e 0a 0a .;; etc...