Artifact 0b8200f7e6aa198f9d78b6ecb27a856be8c64dca:
- File srfi/s42/ec.scm — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 34227)
0000: 3b 20 3c 50 4c 41 49 4e 54 45 58 54 3e 0a 3b 20 ; <PLAINTEXT>.; 0010: 45 61 67 65 72 20 43 6f 6d 70 72 65 68 65 6e 73 Eager Comprehens 0020: 69 6f 6e 73 20 69 6e 20 5b 6f 75 74 65 72 2e 2e ions in [outer.. 0030: 69 6e 6e 65 72 7c 65 78 70 72 5d 2d 43 6f 6e 76 inner|expr]-Conv 0040: 65 6e 74 69 6f 6e 0a 3b 20 3d 3d 3d 3d 3d 3d 3d ention.; ======= 0050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0060: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0070: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============. 0080: 3b 0a 3b 20 73 65 62 61 73 74 69 61 6e 2e 65 67 ;.; sebastian.eg 0090: 6e 65 72 40 70 68 69 6c 69 70 73 2e 63 6f 6d 2c ner@philips.com, 00a0: 20 45 69 6e 64 68 6f 76 65 6e 2c 20 54 68 65 20 Eindhoven, The 00b0: 4e 65 74 68 65 72 6c 61 6e 64 73 2c 20 32 35 2d Netherlands, 25- 00c0: 41 70 72 2d 32 30 30 35 0a 3b 20 53 63 68 65 6d Apr-2005.; Schem 00d0: 65 20 52 35 52 53 20 28 69 6e 63 6c 2e 20 6d 61 e R5RS (incl. ma 00e0: 63 72 6f 73 29 2c 20 53 52 46 49 2d 32 33 20 28 cros), SRFI-23 ( 00f0: 65 72 72 6f 72 29 2e 0a 3b 0a 3b 20 4d 6f 64 69 error)..;.; Modi 0100: 66 69 65 64 20 62 79 20 44 65 72 69 63 6b 20 45 fied by Derick E 0110: 64 64 69 6e 67 74 6f 6e 20 74 6f 20 62 65 20 61 ddington to be a 0120: 62 6c 65 20 74 6f 20 62 65 20 69 6e 63 6c 75 64 ble to be includ 0130: 65 64 20 69 6e 74 6f 20 61 6e 20 52 36 52 53 20 ed into an R6RS 0140: 6c 69 62 72 61 72 79 2e 0a 3b 20 0a 3b 20 4c 6f library..; .; Lo 0150: 61 64 69 6e 67 20 74 68 65 20 69 6d 70 6c 65 6d ading the implem 0160: 65 6e 74 61 74 69 6f 6e 20 69 6e 74 6f 20 53 63 entation into Sc 0170: 68 65 6d 65 34 38 20 30 2e 35 37 3a 0a 3b 20 20 heme48 0.57:.; 0180: 20 2c 6f 70 65 6e 20 73 72 66 69 2d 32 33 0a 3b ,open srfi-23.; 0190: 20 20 20 2c 6c 6f 61 64 20 65 63 2e 73 63 6d 0a ,load ec.scm. 01a0: 3b 0a 3b 20 4c 6f 61 64 69 6e 67 20 74 68 65 20 ;.; Loading the 01b0: 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 69 implementation i 01c0: 6e 74 6f 20 50 4c 54 2f 44 72 53 63 68 65 6d 65 nto PLT/DrScheme 01d0: 20 32 30 32 3a 0a 3b 20 20 20 3b 20 46 69 6c 65 202:.; ; File 01e0: 20 3e 20 4f 70 65 6e 20 2e 2e 2e 20 22 65 63 2e > Open ... "ec. 01f0: 73 63 6d 22 2c 20 63 6c 69 63 6b 20 45 78 65 63 scm", click Exec 0200: 75 74 65 0a 3b 0a 3b 20 4c 6f 61 64 69 6e 67 20 ute.;.; Loading 0210: 74 68 65 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 the implementati 0220: 6f 6e 20 69 6e 74 6f 20 53 43 4d 20 35 64 37 3a on into SCM 5d7: 0230: 0a 3b 20 20 20 28 72 65 71 75 69 72 65 20 27 6d .; (require 'm 0240: 61 63 72 6f 29 20 28 72 65 71 75 69 72 65 20 27 acro) (require ' 0250: 72 65 63 6f 72 64 29 20 0a 3b 20 20 20 28 6c 6f record) .; (lo 0260: 61 64 20 22 65 63 2e 73 63 6d 22 29 0a 3b 0a 3b ad "ec.scm").;.; 0270: 20 49 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 20 Implementation 0280: 63 6f 6d 6d 65 6e 74 73 3a 0a 3b 20 20 20 2a 20 comments:.; * 0290: 41 6c 6c 20 6c 6f 63 61 6c 20 28 6e 6f 74 20 65 All local (not e 02a0: 78 70 6f 72 74 65 64 29 20 69 64 65 6e 74 69 66 xported) identif 02b0: 69 65 72 73 20 61 72 65 20 6e 61 6d 65 64 20 65 iers are named e 02c0: 63 2d 3c 73 6f 6d 65 74 68 69 6e 67 3e 2e 0a 3b c-<something>..; 02d0: 20 20 20 2a 20 54 68 69 73 20 69 6d 70 6c 65 6d * This implem 02e0: 65 6e 74 61 74 69 6f 6e 20 66 6f 63 75 73 65 73 entation focuses 02f0: 20 6f 6e 20 70 6f 72 74 61 62 69 6c 69 74 79 2c on portability, 0300: 20 70 65 72 66 6f 72 6d 61 6e 63 65 2c 20 0a 3b performance, .; 0310: 20 20 20 20 20 72 65 61 64 61 62 69 6c 69 74 79 readability 0320: 2c 20 61 6e 64 20 73 69 6d 70 6c 69 63 69 74 79 , and simplicity 0330: 20 72 6f 75 67 68 6c 79 20 69 6e 20 74 68 69 73 roughly in this 0340: 20 6f 72 64 65 72 2e 20 44 65 73 69 67 6e 0a 3b order. Design.; 0350: 20 20 20 20 20 64 65 63 69 73 69 6f 6e 73 20 72 decisions r 0360: 65 6c 61 74 65 64 20 74 6f 20 70 65 72 66 6f 72 elated to perfor 0370: 6d 61 6e 63 65 20 61 72 65 20 74 61 6b 65 6e 20 mance are taken 0380: 66 6f 72 20 53 63 68 65 6d 65 34 38 2e 0a 3b 20 for Scheme48..; 0390: 20 20 2a 20 41 6c 74 65 72 6e 61 74 69 76 65 20 * Alternative 03a0: 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e 73 2c implementations, 03b0: 20 43 6f 6d 6d 65 6e 74 73 20 61 6e 64 20 57 61 Comments and Wa 03c0: 72 6e 69 6e 67 73 20 61 72 65 20 0a 3b 20 20 20 rnings are .; 03d0: 20 20 6d 65 6e 74 69 6f 6e 65 64 20 61 66 74 65 mentioned afte 03e0: 72 20 74 68 65 20 64 65 66 69 6e 69 74 69 6f 6e r the definition 03f0: 20 77 69 74 68 20 61 20 68 65 61 64 69 6e 67 2e with a heading. 0400: 0a 0a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ...; =========== 0410: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0420: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0430: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0440: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============. 0450: 3b 20 54 68 65 20 66 75 6e 64 61 6d 65 6e 74 61 ; The fundamenta 0460: 6c 20 63 6f 6d 70 72 65 68 65 6e 73 69 6f 6e 20 l comprehension 0470: 64 6f 2d 65 63 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d do-ec.; ======== 0480: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0490: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 04a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 04b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 04c0: 3d 3d 0a 3b 0a 3b 20 41 6c 6c 20 65 61 67 65 72 ==.;.; All eager 04d0: 20 63 6f 6d 70 72 65 68 65 6e 73 69 6f 6e 73 20 comprehensions 04e0: 61 72 65 20 72 65 64 75 63 65 64 20 69 6e 74 6f are reduced into 04f0: 20 64 6f 2d 65 63 20 61 6e 64 0a 3b 20 61 6c 6c do-ec and.; all 0500: 20 67 65 6e 65 72 61 74 6f 72 73 20 61 72 65 20 generators are 0510: 72 65 64 75 63 65 64 20 74 6f 20 3a 64 6f 2e 20 reduced to :do. 0520: 0a 3b 0a 3b 20 57 65 20 75 73 65 20 74 68 65 20 .;.; We use the 0530: 66 6f 6c 6c 6f 77 69 6e 67 20 73 68 6f 72 74 20 following short 0540: 6e 61 6d 65 73 20 66 6f 72 20 73 79 6e 74 61 63 names for syntac 0550: 74 69 63 20 76 61 72 69 61 62 6c 65 73 0a 3b 20 tic variables.; 0560: 20 20 71 20 20 20 20 2d 20 71 75 61 6c 69 66 69 q - qualifi 0570: 65 72 0a 3b 20 20 20 63 63 20 20 20 2d 20 63 75 er.; cc - cu 0580: 72 72 65 6e 74 20 63 6f 6e 74 69 6e 75 61 74 69 rrent continuati 0590: 6f 6e 2c 20 74 68 69 6e 67 20 74 6f 20 63 61 6c on, thing to cal 05a0: 6c 20 61 74 20 74 68 65 20 65 6e 64 3b 0a 3b 20 l at the end;.; 05b0: 20 20 20 20 20 20 20 20 20 74 68 65 20 43 50 53 the CPS 05c0: 20 69 73 20 28 6d 20 28 63 63 20 2e 2e 2e 29 20 is (m (cc ...) 05d0: 61 72 67 20 2e 2e 2e 29 20 2d 3e 20 28 63 63 20 arg ...) -> (cc 05e0: 2e 2e 2e 20 65 78 70 72 20 2e 2e 2e 29 0a 3b 20 ... expr ...).; 05f0: 20 20 63 6d 64 20 20 2d 20 61 6e 20 65 78 70 72 cmd - an expr 0600: 65 73 73 69 6f 6e 20 62 65 69 6e 67 20 65 76 61 ession being eva 0610: 6c 75 61 74 65 64 20 66 6f 72 20 69 74 73 20 73 luated for its s 0620: 69 64 65 2d 65 66 66 65 63 74 73 0a 3b 20 20 20 ide-effects.; 0630: 65 78 70 72 20 2d 20 61 6e 20 65 78 70 72 65 73 expr - an expres 0640: 73 69 6f 6e 0a 3b 20 20 20 67 65 6e 20 20 2d 20 sion.; gen - 0650: 61 20 67 65 6e 65 72 61 74 6f 72 20 6f 66 20 61 a generator of a 0660: 6e 20 65 61 67 65 72 20 63 6f 6d 70 72 65 68 65 n eager comprehe 0670: 6e 73 69 6f 6e 0a 3b 20 20 20 6f 62 20 20 20 2d nsion.; ob - 0680: 20 6f 75 74 65 72 20 62 69 6e 64 69 6e 67 0a 3b outer binding.; 0690: 20 20 20 6f 63 20 20 20 2d 20 6f 75 74 65 72 20 oc - outer 06a0: 63 6f 6d 6d 61 6e 64 0a 3b 20 20 20 6c 62 20 20 command.; lb 06b0: 20 2d 20 6c 6f 6f 70 20 62 69 6e 64 69 6e 67 0a - loop binding. 06c0: 3b 20 20 20 6e 65 31 3f 20 2d 20 6e 6f 74 2d 65 ; ne1? - not-e 06d0: 6e 64 31 3f 20 28 62 65 66 6f 72 65 20 74 68 65 nd1? (before the 06e0: 20 70 61 79 6c 6f 61 64 29 0a 3b 20 20 20 69 62 payload).; ib 06f0: 20 20 20 2d 20 69 6e 6e 65 72 20 62 69 6e 64 69 - inner bindi 0700: 6e 67 0a 3b 20 20 20 69 63 20 20 20 2d 20 69 6e ng.; ic - in 0710: 6e 65 72 20 63 6f 6d 6d 61 6e 64 0a 3b 20 20 20 ner command.; 0720: 6e 65 32 3f 20 2d 20 6e 6f 74 2d 65 6e 64 32 3f ne2? - not-end2? 0730: 20 28 61 66 74 65 72 20 74 68 65 20 70 61 79 6c (after the payl 0740: 6f 61 64 29 0a 3b 20 20 20 6c 73 20 20 20 2d 20 oad).; ls - 0750: 6c 6f 6f 70 20 73 74 65 70 0a 3b 20 20 20 65 74 loop step.; et 0760: 63 20 20 2d 20 6d 6f 72 65 20 61 72 67 75 6d 65 c - more argume 0770: 6e 74 73 20 6f 66 20 6d 69 78 65 64 20 74 79 70 nts of mixed typ 0780: 65 0a 0a 0a 3b 20 28 64 6f 2d 65 63 20 71 20 2e e...; (do-ec q . 0790: 2e 2e 20 63 6d 64 29 0a 3b 20 20 20 68 61 6e 64 .. cmd).; hand 07a0: 6c 65 73 20 6e 65 73 74 65 64 2c 20 69 66 2f 6e les nested, if/n 07b0: 6f 74 2f 61 6e 64 2f 6f 72 2c 20 62 65 67 69 6e ot/and/or, begin 07c0: 2c 20 3a 6c 65 74 2c 20 61 6e 64 20 63 61 6c 6c , :let, and call 07d0: 73 20 67 65 6e 65 72 61 74 6f 72 20 0a 3b 20 20 s generator .; 07e0: 20 6d 61 63 72 6f 73 20 69 6e 20 43 50 53 20 74 macros in CPS t 07f0: 6f 20 74 72 61 6e 73 66 6f 72 6d 20 74 68 65 6d o transform them 0800: 20 69 6e 74 6f 20 66 75 6c 6c 79 20 64 65 63 6f into fully deco 0810: 72 61 74 65 64 20 3a 64 6f 2e 0a 3b 20 20 20 54 rated :do..; T 0820: 68 65 20 63 6f 64 65 20 67 65 6e 65 72 61 74 69 he code generati 0830: 6f 6e 20 66 6f 72 20 61 20 3a 64 6f 20 69 73 20 on for a :do is 0840: 64 65 6c 65 67 61 74 65 64 20 74 6f 20 64 6f 2d delegated to do- 0850: 65 63 3a 64 6f 2e 0a 0a 28 64 65 66 69 6e 65 2d ec:do...(define- 0860: 73 79 6e 74 61 78 20 64 6f 2d 65 63 0a 20 20 28 syntax do-ec. ( 0870: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 6e 65 syntax-rules (ne 0880: 73 74 65 64 20 69 66 20 6e 6f 74 20 61 6e 64 20 sted if not and 0890: 6f 72 20 62 65 67 69 6e 20 3a 64 6f 20 6c 65 74 or begin :do let 08a0: 29 0a 0a 20 20 20 20 3b 20 65 78 70 6c 69 63 69 ).. ; explici 08b0: 74 20 6e 65 73 74 69 6e 67 20 2d 3e 20 69 6d 70 t nesting -> imp 08c0: 6c 69 63 69 74 20 6e 65 73 74 69 6e 67 0a 20 20 licit nesting. 08d0: 20 20 28 28 64 6f 2d 65 63 20 28 6e 65 73 74 65 ((do-ec (neste 08e0: 64 20 71 20 2e 2e 2e 29 20 65 74 63 20 2e 2e 2e d q ...) etc ... 08f0: 29 0a 20 20 20 20 20 28 64 6f 2d 65 63 20 71 20 ). (do-ec q 0900: 2e 2e 2e 20 65 74 63 20 2e 2e 2e 29 20 29 0a 0a ... etc ...) ).. 0910: 20 20 20 20 3b 20 69 6d 70 6c 69 63 69 74 20 6e ; implicit n 0920: 65 73 74 69 6e 67 20 2d 3e 20 66 6f 6c 64 20 64 esting -> fold d 0930: 6f 2d 65 63 0a 20 20 20 20 28 28 64 6f 2d 65 63 o-ec. ((do-ec 0940: 20 71 31 20 71 32 20 65 74 63 31 20 65 74 63 20 q1 q2 etc1 etc 0950: 2e 2e 2e 29 0a 20 20 20 20 20 28 64 6f 2d 65 63 ...). (do-ec 0960: 20 71 31 20 28 64 6f 2d 65 63 20 71 32 20 65 74 q1 (do-ec q2 et 0970: 63 31 20 65 74 63 20 2e 2e 2e 29 29 20 29 0a 0a c1 etc ...)) ).. 0980: 20 20 20 20 3b 20 6e 6f 20 71 75 61 6c 69 66 69 ; no qualifi 0990: 65 72 73 20 61 74 20 61 6c 6c 20 2d 3e 20 65 76 ers at all -> ev 09a0: 61 6c 75 61 74 65 20 63 6d 64 20 6f 6e 63 65 0a aluate cmd once. 09b0: 20 20 20 20 28 28 64 6f 2d 65 63 20 63 6d 64 29 ((do-ec cmd) 09c0: 0a 20 20 20 20 20 28 62 65 67 69 6e 20 63 6d 64 . (begin cmd 09d0: 20 28 69 66 20 23 66 20 23 66 29 29 20 29 0a 0a (if #f #f)) ).. 09e0: 3b 20 6e 6f 77 20 28 64 6f 2d 65 63 20 71 20 63 ; now (do-ec q c 09f0: 6d 64 29 20 72 65 6d 61 69 6e 73 0a 0a 20 20 20 md) remains.. 0a00: 20 3b 20 66 69 6c 74 65 72 20 2d 3e 20 6d 61 6b ; filter -> mak 0a10: 65 20 63 6f 6e 64 69 74 69 6f 6e 61 6c 0a 20 20 e conditional. 0a20: 20 20 28 28 64 6f 2d 65 63 20 28 69 66 20 74 65 ((do-ec (if te 0a30: 73 74 29 20 63 6d 64 29 0a 20 20 20 20 20 28 69 st) cmd). (i 0a40: 66 20 74 65 73 74 20 28 64 6f 2d 65 63 20 63 6d f test (do-ec cm 0a50: 64 29 29 20 29 0a 20 20 20 20 28 28 64 6f 2d 65 d)) ). ((do-e 0a60: 63 20 28 6e 6f 74 20 74 65 73 74 29 20 63 6d 64 c (not test) cmd 0a70: 29 0a 20 20 20 20 20 28 69 66 20 28 6e 6f 74 20 ). (if (not 0a80: 74 65 73 74 29 20 28 64 6f 2d 65 63 20 63 6d 64 test) (do-ec cmd 0a90: 29 29 20 29 0a 20 20 20 20 28 28 64 6f 2d 65 63 )) ). ((do-ec 0aa0: 20 28 61 6e 64 20 74 65 73 74 20 2e 2e 2e 29 20 (and test ...) 0ab0: 63 6d 64 29 0a 20 20 20 20 20 28 69 66 20 28 61 cmd). (if (a 0ac0: 6e 64 20 74 65 73 74 20 2e 2e 2e 29 20 28 64 6f nd test ...) (do 0ad0: 2d 65 63 20 63 6d 64 29 29 20 29 0a 20 20 20 20 -ec cmd)) ). 0ae0: 28 28 64 6f 2d 65 63 20 28 6f 72 20 74 65 73 74 ((do-ec (or test 0af0: 20 2e 2e 2e 29 20 63 6d 64 29 0a 20 20 20 20 20 ...) cmd). 0b00: 28 69 66 20 28 6f 72 20 74 65 73 74 20 2e 2e 2e (if (or test ... 0b10: 29 20 28 64 6f 2d 65 63 20 63 6d 64 29 29 20 29 ) (do-ec cmd)) ) 0b20: 0a 0a 20 20 20 20 3b 20 62 65 67 69 6e 20 2d 3e .. ; begin -> 0b30: 20 6d 61 6b 65 20 61 20 73 65 71 75 65 6e 63 65 make a sequence 0b40: 0a 20 20 20 20 28 28 64 6f 2d 65 63 20 28 62 65 . ((do-ec (be 0b50: 67 69 6e 20 65 74 63 20 2e 2e 2e 29 20 63 6d 64 gin etc ...) cmd 0b60: 29 0a 20 20 20 20 20 28 62 65 67 69 6e 20 65 74 ). (begin et 0b70: 63 20 2e 2e 2e 20 28 64 6f 2d 65 63 20 63 6d 64 c ... (do-ec cmd 0b80: 29 29 20 29 0a 0a 20 20 20 20 3b 20 66 75 6c 6c )) ).. ; full 0b90: 79 20 64 65 63 6f 72 61 74 65 64 20 3a 64 6f 2d y decorated :do- 0ba0: 67 65 6e 65 72 61 74 6f 72 20 2d 3e 20 64 65 6c generator -> del 0bb0: 65 67 61 74 65 20 74 6f 20 64 6f 2d 65 63 3a 64 egate to do-ec:d 0bc0: 6f 0a 20 20 20 20 28 28 64 6f 2d 65 63 20 28 3a o. ((do-ec (: 0bd0: 64 6f 20 6f 6c 65 74 20 6c 62 73 20 6e 65 31 3f do olet lbs ne1? 0be0: 20 69 6c 65 74 20 6e 65 32 3f 20 6c 73 73 29 20 ilet ne2? lss) 0bf0: 63 6d 64 29 0a 20 20 20 20 20 28 64 6f 2d 65 63 cmd). (do-ec 0c00: 3a 64 6f 20 63 6d 64 20 28 3a 64 6f 20 6f 6c 65 :do cmd (:do ole 0c10: 74 20 6c 62 73 20 6e 65 31 3f 20 69 6c 65 74 20 t lbs ne1? ilet 0c20: 6e 65 32 3f 20 6c 73 73 29 29 20 29 0a 0a 3b 20 ne2? lss)) )..; 0c30: 61 6e 79 74 68 69 6e 67 20 65 6c 73 65 20 2d 3e anything else -> 0c40: 20 63 61 6c 6c 20 67 65 6e 65 72 61 74 6f 72 2d call generator- 0c50: 6d 61 63 72 6f 20 69 6e 20 43 50 53 3b 20 72 65 macro in CPS; re 0c60: 65 6e 74 72 79 20 61 74 20 28 2a 29 0a 0a 20 20 entry at (*).. 0c70: 20 20 28 28 64 6f 2d 65 63 20 28 67 20 61 72 67 ((do-ec (g arg 0c80: 31 20 61 72 67 20 2e 2e 2e 29 20 63 6d 64 29 0a 1 arg ...) cmd). 0c90: 20 20 20 20 20 28 67 20 28 64 6f 2d 65 63 3a 64 (g (do-ec:d 0ca0: 6f 20 63 6d 64 29 20 61 72 67 31 20 61 72 67 20 o cmd) arg1 arg 0cb0: 2e 2e 2e 29 20 29 29 29 0a 0a 0a 3b 20 28 64 6f ...) )))...; (do 0cc0: 2d 65 63 3a 64 6f 20 63 6d 64 20 28 3a 64 6f 20 -ec:do cmd (:do 0cd0: 6f 6c 65 74 20 6c 62 73 20 6e 65 31 3f 20 69 6c olet lbs ne1? il 0ce0: 65 74 20 6e 65 32 3f 20 6c 73 73 29 29 0a 3b 20 et ne2? lss)).; 0cf0: 20 20 67 65 6e 65 72 61 74 65 73 20 63 6f 64 65 generates code 0d00: 20 66 6f 72 20 61 20 73 69 6e 67 6c 65 20 66 75 for a single fu 0d10: 6c 6c 79 20 64 65 63 6f 72 61 74 65 64 20 3a 64 lly decorated :d 0d20: 6f 2d 67 65 6e 65 72 61 74 6f 72 0a 3b 20 20 20 o-generator.; 0d30: 77 69 74 68 20 63 6d 64 20 61 73 20 70 61 79 6c with cmd as payl 0d40: 6f 61 64 2c 20 74 61 6b 69 6e 67 20 63 61 72 65 oad, taking care 0d50: 20 6f 66 20 73 70 65 63 69 61 6c 20 63 61 73 65 of special case 0d60: 73 2e 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 s...(define-synt 0d70: 61 78 20 64 6f 2d 65 63 3a 64 6f 0a 20 20 28 73 ax do-ec:do. (s 0d80: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 3a 64 6f yntax-rules (:do 0d90: 20 6c 65 74 29 0a 0a 20 20 20 20 3b 20 72 65 65 let).. ; ree 0da0: 6e 74 72 79 20 70 6f 69 6e 74 20 28 2a 29 20 2d ntry point (*) - 0db0: 3e 20 67 65 6e 65 72 61 74 65 20 63 6f 64 65 0a > generate code. 0dc0: 20 20 20 20 28 28 64 6f 2d 65 63 3a 64 6f 20 63 ((do-ec:do c 0dd0: 6d 64 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 md . 0de0: 20 20 20 28 3a 64 6f 20 28 6c 65 74 20 6f 62 73 (:do (let obs 0df0: 20 6f 63 20 2e 2e 2e 29 20 0a 20 20 20 20 20 20 oc ...) . 0e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 62 lb 0e10: 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s . 0e20: 20 20 20 20 20 20 20 6e 65 31 3f 20 0a 20 20 20 ne1? . 0e30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0e40: 20 28 6c 65 74 20 69 62 73 20 69 63 20 2e 2e 2e (let ibs ic ... 0e50: 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ) . 0e60: 20 20 20 20 20 20 20 6e 65 32 3f 20 0a 20 20 20 ne2? . 0e70: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0e80: 20 28 6c 73 20 2e 2e 2e 29 20 29 29 0a 20 20 20 (ls ...) )). 0e90: 20 20 28 65 63 2d 73 69 6d 70 6c 69 66 79 0a 20 (ec-simplify. 0ea0: 20 20 20 20 20 20 28 6c 65 74 20 6f 62 73 0a 20 (let obs. 0eb0: 20 20 20 20 20 20 20 20 6f 63 20 2e 2e 2e 0a 20 oc .... 0ec0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 6c 6f 6f (let loo 0ed0: 70 20 6c 62 73 0a 20 20 20 20 20 20 20 20 20 20 p lbs. 0ee0: 20 28 65 63 2d 73 69 6d 70 6c 69 66 79 0a 20 20 (ec-simplify. 0ef0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 6e (if n 0f00: 65 31 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 e1?. 0f10: 20 20 20 20 20 28 65 63 2d 73 69 6d 70 6c 69 66 (ec-simplif 0f20: 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 y. 0f30: 20 20 20 20 20 28 6c 65 74 20 69 62 73 0a 20 20 (let ibs. 0f40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0f50: 20 20 20 20 69 63 20 2e 2e 2e 0a 20 20 20 20 20 ic .... 0f60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0f70: 20 63 6d 64 0a 20 20 20 20 20 20 20 20 20 20 20 cmd. 0f80: 20 20 20 20 20 20 20 20 20 20 20 28 65 63 2d 73 (ec-s 0f90: 69 6d 70 6c 69 66 79 0a 20 20 20 20 20 20 20 20 implify. 0fa0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0fb0: 28 69 66 20 6e 65 32 3f 0a 20 20 20 20 20 20 20 (if ne2?. 0fc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0fd0: 20 20 20 20 20 28 6c 6f 6f 70 20 6c 73 20 2e 2e (loop ls .. 0fe0: 2e 29 20 29 29 29 29 29 29 29 29 29 29 20 29 29 .) )))))))))) )) 0ff0: 0a 0a 20 20 20 20 0a 3b 20 28 65 63 2d 73 69 6d .. .; (ec-sim 1000: 70 6c 69 66 79 20 3c 65 78 70 72 65 73 73 69 6f plify <expressio 1010: 6e 3e 29 0a 3b 20 20 20 67 65 6e 65 72 61 74 65 n>).; generate 1020: 73 20 70 6f 74 65 6e 74 69 61 6c 6c 79 20 6d 6f s potentially mo 1030: 72 65 20 65 66 66 69 63 69 65 6e 74 20 63 6f 64 re efficient cod 1040: 65 20 66 6f 72 20 3c 65 78 70 72 65 73 73 69 6f e for <expressio 1050: 6e 3e 2e 0a 3b 20 20 20 54 68 65 20 6d 61 63 72 n>..; The macr 1060: 6f 20 68 61 6e 64 6c 65 73 20 69 66 2c 20 28 62 o handles if, (b 1070: 65 67 69 6e 20 3c 63 6f 6d 6d 61 6e 64 3e 2a 29 egin <command>*) 1080: 2c 20 61 6e 64 20 28 6c 65 74 20 28 29 20 3c 63 , and (let () <c 1090: 6f 6d 6d 61 6e 64 3e 2a 29 0a 3b 20 20 20 61 6e ommand>*).; an 10a0: 64 20 74 61 6b 65 73 20 63 61 72 65 20 6f 66 20 d takes care of 10b0: 73 70 65 63 69 61 6c 20 63 61 73 65 73 2e 0a 0a special cases... 10c0: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 65 (define-syntax e 10d0: 63 2d 73 69 6d 70 6c 69 66 79 0a 20 20 28 73 79 c-simplify. (sy 10e0: 6e 74 61 78 2d 72 75 6c 65 73 20 28 69 66 20 6e ntax-rules (if n 10f0: 6f 74 20 6c 65 74 20 62 65 67 69 6e 29 0a 0a 3b ot let begin)..; 1100: 20 6f 6e 65 2d 20 61 6e 64 20 74 77 6f 2d 73 69 one- and two-si 1110: 64 65 64 20 69 66 0a 0a 20 20 20 20 3b 20 6c 69 ded if.. ; li 1120: 74 65 72 61 6c 20 3c 74 65 73 74 3e 0a 20 20 20 teral <test>. 1130: 20 28 28 65 63 2d 73 69 6d 70 6c 69 66 79 20 28 ((ec-simplify ( 1140: 69 66 20 23 74 20 63 6f 6e 73 65 71 75 65 6e 74 if #t consequent 1150: 29 29 0a 20 20 20 20 20 63 6f 6e 73 65 71 75 65 )). conseque 1160: 6e 74 20 29 0a 20 20 20 20 28 28 65 63 2d 73 69 nt ). ((ec-si 1170: 6d 70 6c 69 66 79 20 28 69 66 20 23 66 20 63 6f mplify (if #f co 1180: 6e 73 65 71 75 65 6e 74 29 29 0a 20 20 20 20 20 nsequent)). 1190: 28 69 66 20 23 66 20 23 66 29 20 29 0a 20 20 20 (if #f #f) ). 11a0: 20 28 28 65 63 2d 73 69 6d 70 6c 69 66 79 20 28 ((ec-simplify ( 11b0: 69 66 20 23 74 20 63 6f 6e 73 65 71 75 65 6e 74 if #t consequent 11c0: 20 61 6c 74 65 72 6e 61 74 65 29 29 0a 20 20 20 alternate)). 11d0: 20 20 63 6f 6e 73 65 71 75 65 6e 74 20 29 0a 20 consequent ). 11e0: 20 20 20 28 28 65 63 2d 73 69 6d 70 6c 69 66 79 ((ec-simplify 11f0: 20 28 69 66 20 23 66 20 63 6f 6e 73 65 71 75 65 (if #f conseque 1200: 6e 74 20 61 6c 74 65 72 6e 61 74 65 29 29 0a 20 nt alternate)). 1210: 20 20 20 20 61 6c 74 65 72 6e 61 74 65 20 29 0a alternate ). 1220: 0a 20 20 20 20 3b 20 28 6e 6f 74 20 28 6e 6f 74 . ; (not (not 1230: 20 3c 74 65 73 74 3e 29 29 0a 20 20 20 20 28 28 <test>)). (( 1240: 65 63 2d 73 69 6d 70 6c 69 66 79 20 28 69 66 20 ec-simplify (if 1250: 28 6e 6f 74 20 28 6e 6f 74 20 74 65 73 74 29 29 (not (not test)) 1260: 20 63 6f 6e 73 65 71 75 65 6e 74 29 29 0a 20 20 consequent)). 1270: 20 20 20 28 65 63 2d 73 69 6d 70 6c 69 66 79 20 (ec-simplify 1280: 28 69 66 20 74 65 73 74 20 63 6f 6e 73 65 71 75 (if test consequ 1290: 65 6e 74 29 29 20 29 0a 20 20 20 20 28 28 65 63 ent)) ). ((ec 12a0: 2d 73 69 6d 70 6c 69 66 79 20 28 69 66 20 28 6e -simplify (if (n 12b0: 6f 74 20 28 6e 6f 74 20 74 65 73 74 29 29 20 63 ot (not test)) c 12c0: 6f 6e 73 65 71 75 65 6e 74 20 61 6c 74 65 72 6e onsequent altern 12d0: 61 74 65 29 29 0a 20 20 20 20 20 28 65 63 2d 73 ate)). (ec-s 12e0: 69 6d 70 6c 69 66 79 20 28 69 66 20 74 65 73 74 implify (if test 12f0: 20 63 6f 6e 73 65 71 75 65 6e 74 20 61 6c 74 65 consequent alte 1300: 72 6e 61 74 65 29 29 20 29 0a 0a 3b 20 28 6c 65 rnate)) )..; (le 1310: 74 20 28 29 20 3c 63 6f 6d 6d 61 6e 64 3e 2a 29 t () <command>*) 1320: 20 0a 0a 20 20 20 20 3b 20 65 6d 70 74 79 20 3c .. ; empty < 1330: 62 69 6e 64 69 6e 67 20 73 70 65 63 3e 2a 0a 20 binding spec>*. 1340: 20 20 20 28 28 65 63 2d 73 69 6d 70 6c 69 66 79 ((ec-simplify 1350: 20 28 6c 65 74 20 28 29 20 63 6f 6d 6d 61 6e 64 (let () command 1360: 20 2e 2e 2e 29 29 0a 20 20 20 20 20 28 65 63 2d ...)). (ec- 1370: 73 69 6d 70 6c 69 66 79 20 28 62 65 67 69 6e 20 simplify (begin 1380: 63 6f 6d 6d 61 6e 64 20 2e 2e 2e 29 29 20 29 0a command ...)) ). 1390: 0a 3b 20 62 65 67 69 6e 20 0a 0a 20 20 20 20 3b .; begin .. ; 13a0: 20 66 6c 61 74 74 65 6e 20 75 73 65 20 68 65 6c flatten use hel 13b0: 70 65 72 20 28 65 63 2d 73 69 6d 70 6c 69 66 79 per (ec-simplify 13c0: 20 31 20 64 6f 6e 65 20 74 6f 2d 64 6f 29 0a 20 1 done to-do). 13d0: 20 20 20 28 28 65 63 2d 73 69 6d 70 6c 69 66 79 ((ec-simplify 13e0: 20 28 62 65 67 69 6e 20 63 6f 6d 6d 61 6e 64 20 (begin command 13f0: 2e 2e 2e 29 29 0a 20 20 20 20 20 28 65 63 2d 73 ...)). (ec-s 1400: 69 6d 70 6c 69 66 79 20 31 20 28 29 20 28 63 6f implify 1 () (co 1410: 6d 6d 61 6e 64 20 2e 2e 2e 29 29 20 29 0a 20 20 mmand ...)) ). 1420: 20 20 28 28 65 63 2d 73 69 6d 70 6c 69 66 79 20 ((ec-simplify 1430: 31 20 64 6f 6e 65 20 28 28 62 65 67 69 6e 20 74 1 done ((begin t 1440: 6f 2d 64 6f 31 20 2e 2e 2e 29 20 74 6f 2d 64 6f o-do1 ...) to-do 1450: 32 20 2e 2e 2e 29 29 0a 20 20 20 20 20 28 65 63 2 ...)). (ec 1460: 2d 73 69 6d 70 6c 69 66 79 20 31 20 64 6f 6e 65 -simplify 1 done 1470: 20 28 74 6f 2d 64 6f 31 20 2e 2e 2e 20 74 6f 2d (to-do1 ... to- 1480: 64 6f 32 20 2e 2e 2e 29 29 20 29 0a 20 20 20 20 do2 ...)) ). 1490: 28 28 65 63 2d 73 69 6d 70 6c 69 66 79 20 31 20 ((ec-simplify 1 14a0: 28 64 6f 6e 65 20 2e 2e 2e 29 20 28 74 6f 2d 64 (done ...) (to-d 14b0: 6f 31 20 74 6f 2d 64 6f 20 2e 2e 2e 29 29 0a 20 o1 to-do ...)). 14c0: 20 20 20 20 28 65 63 2d 73 69 6d 70 6c 69 66 79 (ec-simplify 14d0: 20 31 20 28 64 6f 6e 65 20 2e 2e 2e 20 74 6f 2d 1 (done ... to- 14e0: 64 6f 31 29 20 28 74 6f 2d 64 6f 20 2e 2e 2e 29 do1) (to-do ...) 14f0: 29 20 29 0a 0a 20 20 20 20 3b 20 65 78 69 74 20 ) ).. ; exit 1500: 68 65 6c 70 65 72 0a 20 20 20 20 28 28 65 63 2d helper. ((ec- 1510: 73 69 6d 70 6c 69 66 79 20 31 20 28 29 20 28 29 simplify 1 () () 1520: 29 0a 20 20 20 20 20 28 69 66 20 23 66 20 23 66 ). (if #f #f 1530: 29 20 29 0a 20 20 20 20 28 28 65 63 2d 73 69 6d ) ). ((ec-sim 1540: 70 6c 69 66 79 20 31 20 28 63 6f 6d 6d 61 6e 64 plify 1 (command 1550: 29 20 28 29 29 0a 20 20 20 20 20 63 6f 6d 6d 61 ) ()). comma 1560: 6e 64 20 29 0a 20 20 20 20 28 28 65 63 2d 73 69 nd ). ((ec-si 1570: 6d 70 6c 69 66 79 20 31 20 28 63 6f 6d 6d 61 6e mplify 1 (comman 1580: 64 31 20 63 6f 6d 6d 61 6e 64 20 2e 2e 2e 29 20 d1 command ...) 1590: 28 29 29 0a 20 20 20 20 20 28 62 65 67 69 6e 20 ()). (begin 15a0: 63 6f 6d 6d 61 6e 64 31 20 63 6f 6d 6d 61 6e 64 command1 command 15b0: 20 2e 2e 2e 29 20 29 0a 0a 3b 20 61 6e 79 74 68 ...) )..; anyth 15c0: 69 6e 67 20 65 6c 73 65 0a 0a 20 20 20 20 28 28 ing else.. (( 15d0: 65 63 2d 73 69 6d 70 6c 69 66 79 20 65 78 70 72 ec-simplify expr 15e0: 65 73 73 69 6f 6e 29 0a 20 20 20 20 20 65 78 70 ession). exp 15f0: 72 65 73 73 69 6f 6e 20 29 29 29 0a 0a 0a 3b 20 ression )))...; 1600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1620: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1630: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1640: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 20 54 68 65 ==========.; The 1650: 20 73 70 65 63 69 61 6c 20 67 65 6e 65 72 61 74 special generat 1660: 6f 72 73 20 3a 64 6f 2c 20 3a 6c 65 74 2c 20 3a ors :do, :let, : 1670: 70 61 72 61 6c 6c 65 6c 2c 20 3a 77 68 69 6c 65 parallel, :while 1680: 2c 20 61 6e 64 20 3a 75 6e 74 69 6c 0a 3b 20 3d , and :until.; = 1690: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 16a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 16b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 16c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 16d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 =========..(defi 16e0: 6e 65 2d 73 79 6e 74 61 78 20 3a 64 6f 0a 20 20 ne-syntax :do. 16f0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules () 1700: 0a 0a 20 20 20 20 3b 20 66 75 6c 6c 20 64 65 63 .. ; full dec 1710: 6f 72 61 74 65 64 20 2d 3e 20 63 6f 6e 74 69 6e orated -> contin 1720: 75 65 20 77 69 74 68 20 63 63 2c 20 72 65 65 6e ue with cc, reen 1730: 74 72 79 20 61 74 20 28 2a 29 0a 20 20 20 20 28 try at (*). ( 1740: 28 3a 64 6f 20 28 63 63 20 2e 2e 2e 29 20 6f 6c (:do (cc ...) ol 1750: 65 74 20 6c 62 73 20 6e 65 31 3f 20 69 6c 65 74 et lbs ne1? ilet 1760: 20 6e 65 32 3f 20 6c 73 73 29 0a 20 20 20 20 20 ne2? lss). 1770: 28 63 63 20 2e 2e 2e 20 28 3a 64 6f 20 6f 6c 65 (cc ... (:do ole 1780: 74 20 6c 62 73 20 6e 65 31 3f 20 69 6c 65 74 20 t lbs ne1? ilet 1790: 6e 65 32 3f 20 6c 73 73 29 29 20 29 0a 0a 20 20 ne2? lss)) ).. 17a0: 20 20 3b 20 73 68 6f 72 74 20 66 6f 72 6d 20 2d ; short form - 17b0: 3e 20 66 69 6c 6c 20 69 6e 20 64 65 66 61 75 6c > fill in defaul 17c0: 74 20 76 61 6c 75 65 73 0a 20 20 20 20 28 28 3a t values. ((: 17d0: 64 6f 20 63 63 20 6c 62 73 20 6e 65 31 3f 20 6c do cc lbs ne1? l 17e0: 73 73 29 0a 20 20 20 20 20 28 3a 64 6f 20 63 63 ss). (:do cc 17f0: 20 28 6c 65 74 20 28 29 29 20 6c 62 73 20 6e 65 (let ()) lbs ne 1800: 31 3f 20 28 6c 65 74 20 28 29 29 20 23 74 20 6c 1? (let ()) #t l 1810: 73 73 29 20 29 29 29 0a 20 20 20 20 0a 0a 28 64 ss) ))). ..(d 1820: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 3a 6c 65 efine-syntax :le 1830: 74 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 t. (syntax-rule 1840: 73 20 28 69 6e 64 65 78 29 0a 20 20 20 20 28 28 s (index). (( 1850: 3a 6c 65 74 20 63 63 20 76 61 72 20 28 69 6e 64 :let cc var (ind 1860: 65 78 20 69 29 20 65 78 70 72 65 73 73 69 6f 6e ex i) expression 1870: 29 0a 20 20 20 20 20 28 3a 64 6f 20 63 63 20 28 ). (:do cc ( 1880: 6c 65 74 20 28 28 76 61 72 20 65 78 70 72 65 73 let ((var expres 1890: 73 69 6f 6e 29 20 28 69 20 30 29 29 29 20 28 29 sion) (i 0))) () 18a0: 20 23 74 20 28 6c 65 74 20 28 29 29 20 23 66 20 #t (let ()) #f 18b0: 28 29 29 20 29 0a 20 20 20 20 28 28 3a 6c 65 74 ()) ). ((:let 18c0: 20 63 63 20 76 61 72 20 65 78 70 72 65 73 73 69 cc var expressi 18d0: 6f 6e 29 0a 20 20 20 20 20 28 3a 64 6f 20 63 63 on). (:do cc 18e0: 20 28 6c 65 74 20 28 28 76 61 72 20 65 78 70 72 (let ((var expr 18f0: 65 73 73 69 6f 6e 29 29 29 20 28 29 20 23 74 20 ession))) () #t 1900: 28 6c 65 74 20 28 29 29 20 23 66 20 28 29 29 20 (let ()) #f ()) 1910: 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 2d 73 79 )))...(define-sy 1920: 6e 74 61 78 20 3a 70 61 72 61 6c 6c 65 6c 0a 20 ntax :parallel. 1930: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 1940: 3a 64 6f 29 0a 20 20 20 20 28 28 3a 70 61 72 61 :do). ((:para 1950: 6c 6c 65 6c 20 63 63 29 0a 20 20 20 20 20 63 63 llel cc). cc 1960: 20 29 0a 20 20 20 20 28 28 3a 70 61 72 61 6c 6c ). ((:parall 1970: 65 6c 20 63 63 20 28 67 20 61 72 67 31 20 61 72 el cc (g arg1 ar 1980: 67 20 2e 2e 2e 29 20 67 65 6e 20 2e 2e 2e 29 0a g ...) gen ...). 1990: 20 20 20 20 20 28 67 20 28 3a 70 61 72 61 6c 6c (g (:parall 19a0: 65 6c 2d 31 20 63 63 20 28 67 65 6e 20 2e 2e 2e el-1 cc (gen ... 19b0: 29 29 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 )) arg1 arg ...) 19c0: 20 29 29 29 0a 0a 3b 20 28 3a 70 61 72 61 6c 6c )))..; (:parall 19d0: 65 6c 2d 31 20 63 63 20 28 74 6f 2d 64 6f 20 2e el-1 cc (to-do . 19e0: 2e 2e 29 20 72 65 73 75 6c 74 20 5b 20 6e 65 78 ..) result [ nex 19f0: 74 20 5d 20 29 0a 3b 20 20 20 20 69 74 65 72 61 t ] ).; itera 1a00: 74 65 73 20 6f 76 65 72 20 74 6f 2d 64 6f 20 62 tes over to-do b 1a10: 79 20 63 6f 6e 76 65 72 74 69 6e 67 20 74 68 65 y converting the 1a20: 20 66 69 72 73 74 20 67 65 6e 65 72 61 74 6f 72 first generator 1a30: 20 69 6e 74 6f 20 0a 3b 20 20 20 20 74 68 65 20 into .; the 1a40: 3a 64 6f 2d 67 65 6e 65 72 61 74 6f 72 20 6e 65 :do-generator ne 1a50: 78 74 20 61 6e 64 20 6d 65 72 67 69 6e 67 20 6e xt and merging n 1a60: 65 78 74 20 69 6e 74 6f 20 72 65 73 75 6c 74 2e ext into result. 1a70: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax 1a80: 20 3a 70 61 72 61 6c 6c 65 6c 2d 31 20 20 3b 20 :parallel-1 ; 1a90: 75 73 65 64 20 61 73 20 0a 20 20 28 73 79 6e 74 used as . (synt 1aa0: 61 78 2d 72 75 6c 65 73 20 28 3a 64 6f 20 6c 65 ax-rules (:do le 1ab0: 74 29 0a 0a 20 20 20 20 3b 20 70 72 6f 63 65 73 t).. ; proces 1ac0: 73 20 6e 65 78 74 20 65 6c 65 6d 65 6e 74 20 6f s next element o 1ad0: 66 20 74 6f 2d 64 6f 2c 20 72 65 65 6e 74 72 79 f to-do, reentry 1ae0: 20 61 74 20 28 2a 2a 29 0a 20 20 20 20 28 28 3a at (**). ((: 1af0: 70 61 72 61 6c 6c 65 6c 2d 31 20 63 63 20 28 28 parallel-1 cc (( 1b00: 67 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 20 g arg1 arg ...) 1b10: 67 65 6e 20 2e 2e 2e 29 20 72 65 73 75 6c 74 29 gen ...) result) 1b20: 0a 20 20 20 20 20 28 67 20 28 3a 70 61 72 61 6c . (g (:paral 1b30: 6c 65 6c 2d 31 20 63 63 20 28 67 65 6e 20 2e 2e lel-1 cc (gen .. 1b40: 2e 29 20 72 65 73 75 6c 74 29 20 61 72 67 31 20 .) result) arg1 1b50: 61 72 67 20 2e 2e 2e 29 20 29 0a 0a 20 20 20 20 arg ...) ).. 1b60: 3b 20 72 65 65 6e 74 72 79 20 70 6f 69 6e 74 20 ; reentry point 1b70: 28 2a 2a 29 20 2d 3e 20 6d 65 72 67 65 20 6e 65 (**) -> merge ne 1b80: 78 74 20 69 6e 74 6f 20 72 65 73 75 6c 74 0a 20 xt into result. 1b90: 20 20 20 28 28 3a 70 61 72 61 6c 6c 65 6c 2d 31 ((:parallel-1 1ba0: 20 0a 20 20 20 20 20 20 20 63 63 20 0a 20 20 20 . cc . 1bb0: 20 20 20 20 67 65 6e 73 20 0a 20 20 20 20 20 20 gens . 1bc0: 20 28 3a 64 6f 20 28 6c 65 74 20 28 6f 62 31 20 (:do (let (ob1 1bd0: 2e 2e 2e 29 20 6f 63 31 20 2e 2e 2e 29 20 0a 20 ...) oc1 ...) . 1be0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 62 31 20 (lb1 1bf0: 2e 2e 2e 29 20 0a 20 20 20 20 20 20 20 20 20 20 ...) . 1c00: 20 20 6e 65 31 3f 31 20 0a 20 20 20 20 20 20 20 ne1?1 . 1c10: 20 20 20 20 20 28 6c 65 74 20 28 69 62 31 20 2e (let (ib1 . 1c20: 2e 2e 29 20 69 63 31 20 2e 2e 2e 29 20 0a 20 20 ..) ic1 ...) . 1c30: 20 20 20 20 20 20 20 20 20 20 6e 65 32 3f 31 20 ne2?1 1c40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 73 . (ls 1c50: 31 20 2e 2e 2e 29 20 29 0a 20 20 20 20 20 20 20 1 ...) ). 1c60: 28 3a 64 6f 20 28 6c 65 74 20 28 6f 62 32 20 2e (:do (let (ob2 . 1c70: 2e 2e 29 20 6f 63 32 20 2e 2e 2e 29 20 0a 20 20 ..) oc2 ...) . 1c80: 20 20 20 20 20 20 20 20 20 20 28 6c 62 32 20 2e (lb2 . 1c90: 2e 2e 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 ..) . 1ca0: 20 6e 65 31 3f 32 20 0a 20 20 20 20 20 20 20 20 ne1?2 . 1cb0: 20 20 20 20 28 6c 65 74 20 28 69 62 32 20 2e 2e (let (ib2 .. 1cc0: 2e 29 20 69 63 32 20 2e 2e 2e 29 20 0a 20 20 20 .) ic2 ...) . 1cd0: 20 20 20 20 20 20 20 20 20 6e 65 32 3f 32 20 0a ne2?2 . 1ce0: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 73 32 (ls2 1cf0: 20 2e 2e 2e 29 20 29 29 0a 20 20 20 20 20 28 3a ...) )). (: 1d00: 70 61 72 61 6c 6c 65 6c 2d 31 20 0a 20 20 20 20 parallel-1 . 1d10: 20 20 20 63 63 20 0a 20 20 20 20 20 20 20 67 65 cc . ge 1d20: 6e 73 20 0a 20 20 20 20 20 20 20 28 3a 64 6f 20 ns . (:do 1d30: 28 6c 65 74 20 28 6f 62 31 20 2e 2e 2e 20 6f 62 (let (ob1 ... ob 1d40: 32 20 2e 2e 2e 29 20 6f 63 31 20 2e 2e 2e 20 6f 2 ...) oc1 ... o 1d50: 63 32 20 2e 2e 2e 29 20 0a 20 20 20 20 20 20 20 c2 ...) . 1d60: 20 20 20 20 20 28 6c 62 31 20 2e 2e 2e 20 6c 62 (lb1 ... lb 1d70: 32 20 2e 2e 2e 29 20 0a 20 20 20 20 20 20 20 20 2 ...) . 1d80: 20 20 20 20 28 61 6e 64 20 6e 65 31 3f 31 20 6e (and ne1?1 n 1d90: 65 31 3f 32 29 20 0a 20 20 20 20 20 20 20 20 20 e1?2) . 1da0: 20 20 20 28 6c 65 74 20 28 69 62 31 20 2e 2e 2e (let (ib1 ... 1db0: 20 69 62 32 20 2e 2e 2e 29 20 69 63 31 20 2e 2e ib2 ...) ic1 .. 1dc0: 2e 20 69 63 32 20 2e 2e 2e 29 20 0a 20 20 20 20 . ic2 ...) . 1dd0: 20 20 20 20 20 20 20 20 28 61 6e 64 20 6e 65 32 (and ne2 1de0: 3f 31 20 6e 65 32 3f 32 29 20 0a 20 20 20 20 20 ?1 ne2?2) . 1df0: 20 20 20 20 20 20 20 28 6c 73 31 20 2e 2e 2e 20 (ls1 ... 1e00: 6c 73 32 20 2e 2e 2e 29 20 29 29 29 0a 0a 20 20 ls2 ...) ))).. 1e10: 20 20 3b 20 6e 6f 20 6d 6f 72 65 20 67 65 6e 73 ; no more gens 1e20: 20 2d 3e 20 63 6f 6e 74 69 6e 75 65 20 77 69 74 -> continue wit 1e30: 68 20 63 63 2c 20 72 65 65 6e 74 72 79 20 61 74 h cc, reentry at 1e40: 20 28 2a 29 0a 20 20 20 20 28 28 3a 70 61 72 61 (*). ((:para 1e50: 6c 6c 65 6c 2d 31 20 28 63 63 20 2e 2e 2e 29 20 llel-1 (cc ...) 1e60: 28 29 20 72 65 73 75 6c 74 29 0a 20 20 20 20 20 () result). 1e70: 28 63 63 20 2e 2e 2e 20 72 65 73 75 6c 74 29 20 (cc ... result) 1e80: 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e )))..(define-syn 1e90: 74 61 78 20 3a 77 68 69 6c 65 0a 20 20 28 73 79 tax :while. (sy 1ea0: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 ntax-rules (). 1eb0: 20 20 28 28 3a 77 68 69 6c 65 20 63 63 20 28 67 ((:while cc (g 1ec0: 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 20 74 arg1 arg ...) t 1ed0: 65 73 74 29 0a 20 20 20 20 20 28 67 20 28 3a 77 est). (g (:w 1ee0: 68 69 6c 65 2d 31 20 63 63 20 74 65 73 74 29 20 hile-1 cc test) 1ef0: 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 20 29 29 arg1 arg ...) )) 1f00: 29 0a 0a 3b 20 28 3a 77 68 69 6c 65 2d 31 20 63 )..; (:while-1 c 1f10: 63 20 74 65 73 74 20 28 3a 64 6f 20 2e 2e 2e 29 c test (:do ...) 1f20: 29 0a 3b 20 20 20 20 6d 6f 64 69 66 69 65 73 20 ).; modifies 1f30: 74 68 65 20 66 75 6c 6c 79 20 64 65 63 6f 72 61 the fully decora 1f40: 74 65 64 20 3a 64 6f 2d 67 65 6e 65 72 61 74 6f ted :do-generato 1f50: 72 20 73 75 63 68 20 74 68 61 74 20 69 74 0a 3b r such that it.; 1f60: 20 20 20 20 72 75 6e 73 20 77 68 69 6c 65 20 74 runs while t 1f70: 65 73 74 20 69 73 20 61 20 74 72 75 65 20 76 61 est is a true va 1f80: 6c 75 65 2e 20 0a 3b 20 20 20 20 20 20 20 54 68 lue. .; Th 1f90: 65 20 6f 72 69 67 69 6e 61 6c 20 69 6d 70 6c 65 e original imple 1fa0: 6d 65 6e 74 61 74 69 6f 6e 20 6a 75 73 74 20 72 mentation just r 1fb0: 65 70 6c 61 63 65 64 20 6e 65 31 3f 20 62 79 0a eplaced ne1? by. 1fc0: 3b 20 20 20 20 28 61 6e 64 20 6e 65 31 3f 20 74 ; (and ne1? t 1fd0: 65 73 74 29 20 61 73 20 66 6f 6c 6c 6f 77 73 3a est) as follows: 1fe0: 0a 3b 0a 3b 20 20 20 20 20 20 28 64 65 66 69 6e .;.; (defin 1ff0: 65 2d 73 79 6e 74 61 78 20 3a 77 68 69 6c 65 2d e-syntax :while- 2000: 31 0a 3b 20 20 20 20 20 20 20 20 28 73 79 6e 74 1.; (synt 2010: 61 78 2d 72 75 6c 65 73 20 28 3a 64 6f 29 0a 3b ax-rules (:do).; 2020: 20 20 20 20 20 20 20 20 20 20 28 28 3a 77 68 69 ((:whi 2030: 6c 65 2d 31 20 63 63 20 74 65 73 74 20 28 3a 64 le-1 cc test (:d 2040: 6f 20 6f 6c 65 74 20 6c 62 73 20 6e 65 31 3f 20 o olet lbs ne1? 2050: 69 6c 65 74 20 6e 65 32 3f 20 6c 73 73 29 29 0a ilet ne2? lss)). 2060: 3b 20 20 20 20 20 20 20 20 20 20 20 28 3a 64 6f ; (:do 2070: 20 63 63 20 6f 6c 65 74 20 6c 62 73 20 28 61 6e cc olet lbs (an 2080: 64 20 6e 65 31 3f 20 74 65 73 74 29 20 69 6c 65 d ne1? test) ile 2090: 74 20 6e 65 32 3f 20 6c 73 73 29 20 29 29 29 0a t ne2? lss) ))). 20a0: 3b 0a 3b 20 20 20 20 55 6e 66 6f 72 74 75 6e 61 ;.; Unfortuna 20b0: 74 65 6c 79 2c 20 74 68 69 73 20 63 6f 64 65 20 tely, this code 20c0: 69 73 20 77 72 6f 6e 67 20 62 65 63 61 75 73 65 is wrong because 20d0: 20 6e 65 31 3f 20 6d 61 79 20 64 65 70 65 6e 64 ne1? may depend 20e0: 0a 3b 20 20 20 20 69 6e 20 74 68 65 20 69 6e 6e .; in the inn 20f0: 65 72 20 62 69 6e 64 69 6e 67 73 20 69 6e 74 72 er bindings intr 2100: 6f 64 75 63 65 64 20 69 6e 20 69 6c 65 74 2c 20 oduced in ilet, 2110: 62 75 74 20 6e 65 31 3f 20 69 73 20 65 76 61 6c but ne1? is eval 2120: 75 61 74 65 64 0a 3b 20 20 20 20 6f 75 74 73 69 uated.; outsi 2130: 64 65 20 6f 66 20 74 68 65 20 69 6e 6e 65 72 20 de of the inner 2140: 62 69 6e 64 69 6e 67 73 2e 20 28 52 65 66 65 72 bindings. (Refer 2150: 20 74 6f 20 74 68 65 20 73 70 65 63 69 66 69 63 to the specific 2160: 61 74 69 6f 6e 20 6f 66 0a 3b 20 20 20 20 3a 64 ation of.; :d 2170: 6f 20 74 6f 20 73 65 65 20 74 68 65 20 73 74 72 o to see the str 2180: 75 63 74 75 72 65 2e 29 20 0a 3b 20 20 20 20 20 ucture.) .; 2190: 20 20 54 68 65 20 70 72 6f 62 6c 65 6d 20 6d 61 The problem ma 21a0: 6e 69 66 65 73 74 73 20 69 74 73 65 6c 66 20 28 nifests itself ( 21b0: 61 73 20 73 75 6e 6e 61 6e 40 68 61 6e 64 67 72 as sunnan@handgr 21c0: 61 6e 61 74 2e 6f 72 67 20 0a 3b 20 20 20 20 6f anat.org .; o 21d0: 62 73 65 72 76 65 64 29 20 77 68 65 6e 20 74 68 bserved) when th 21e0: 65 20 3a 6c 69 73 74 2d 67 65 6e 65 72 61 74 6f e :list-generato 21f0: 72 20 69 73 20 6d 6f 64 69 66 69 65 64 3a 0a 3b r is modified:.; 2200: 20 0a 3b 20 20 20 20 20 20 28 64 6f 2d 65 63 20 .; (do-ec 2210: 28 3a 77 68 69 6c 65 20 28 3a 6c 69 73 74 20 78 (:while (:list x 2220: 20 27 28 31 20 32 29 29 20 28 3d 20 78 20 31 29 '(1 2)) (= x 1) 2230: 29 20 28 64 69 73 70 6c 61 79 20 78 29 29 2e 0a ) (display x)).. 2240: 3b 0a 3b 20 20 20 20 49 6e 20 6f 72 64 65 72 20 ;.; In order 2250: 74 6f 20 67 65 6e 65 72 61 74 65 20 70 72 6f 70 to generate prop 2260: 65 72 20 63 6f 64 65 2c 20 77 65 20 69 6e 74 72 er code, we intr 2270: 6f 64 75 63 65 20 74 65 6d 70 6f 72 61 72 79 0a oduce temporary. 2280: 3b 20 20 20 20 76 61 72 69 61 62 6c 65 73 20 73 ; variables s 2290: 61 76 69 6e 67 20 74 68 65 20 76 61 6c 75 65 73 aving the values 22a0: 20 6f 66 20 74 68 65 20 69 6e 6e 65 72 20 62 69 of the inner bi 22b0: 6e 64 69 6e 67 73 2e 20 54 68 65 20 69 6e 6e 65 ndings. The inne 22c0: 72 0a 3b 20 20 20 20 62 69 6e 64 69 6e 67 73 20 r.; bindings 22d0: 61 72 65 20 65 78 65 63 75 74 65 64 20 69 6e 20 are executed in 22e0: 61 20 6e 65 77 20 6e 65 31 3f 2c 20 77 68 69 63 a new ne1?, whic 22f0: 68 20 61 6c 73 6f 20 65 76 61 6c 75 61 74 65 73 h also evaluates 2300: 20 6e 65 31 3f 0a 3b 20 20 20 20 6f 75 74 73 69 ne1?.; outsi 2310: 64 65 20 74 68 65 20 73 63 6f 70 65 20 6f 66 20 de the scope of 2320: 74 68 65 20 69 6e 6e 65 72 20 62 69 6e 64 69 6e the inner bindin 2330: 67 73 2c 20 74 68 65 6e 20 74 68 65 20 69 6e 6e gs, then the inn 2340: 65 72 20 63 6f 6d 6d 61 6e 64 73 0a 3b 20 20 20 er commands.; 2350: 20 61 72 65 20 65 78 65 63 75 74 65 64 20 28 70 are executed (p 2360: 6f 73 73 69 62 6c 79 20 63 68 61 6e 67 69 6e 67 ossibly changing 2370: 20 74 68 65 20 76 61 72 69 61 62 6c 65 73 29 2c the variables), 2380: 20 61 6e 64 20 74 68 65 6e 20 74 68 65 0a 3b 20 and then the.; 2390: 20 20 20 76 61 6c 75 65 73 20 6f 66 20 74 68 65 values of the 23a0: 20 69 6e 6e 65 72 20 62 69 6e 64 69 6e 67 73 20 inner bindings 23b0: 61 72 65 20 73 61 76 65 64 20 61 6e 64 20 28 61 are saved and (a 23c0: 6e 64 20 6e 65 31 3f 20 74 65 73 74 29 20 69 73 nd ne1? test) is 23d0: 0a 3b 20 20 20 20 72 65 74 75 72 6e 65 64 2e 20 .; returned. 23e0: 49 6e 20 74 68 65 20 6e 65 77 20 69 6c 65 74 2c In the new ilet, 23f0: 20 74 68 65 20 69 6e 6e 65 72 20 76 61 72 69 61 the inner varia 2400: 62 6c 65 73 20 61 72 65 20 62 6f 75 6e 64 20 61 bles are bound a 2410: 6e 64 0a 3b 20 20 20 20 69 6e 69 74 69 61 6c 69 nd.; initiali 2420: 7a 65 64 20 61 6e 64 20 74 68 65 69 72 20 76 61 zed and their va 2430: 6c 75 65 73 20 61 72 65 20 72 65 73 74 6f 72 65 lues are restore 2440: 64 2e 20 53 6f 20 77 65 20 63 6f 6e 73 74 72 75 d. So we constru 2450: 63 74 3a 0a 3b 0a 3b 20 20 20 20 20 28 6c 65 74 ct:.;.; (let 2460: 20 28 6f 62 20 2e 2e 20 28 69 62 2d 74 6d 70 20 (ob .. (ib-tmp 2470: 23 66 29 20 2e 2e 2e 29 0a 3b 20 20 20 20 20 20 #f) ...).; 2480: 20 6f 63 20 2e 2e 2e 0a 3b 20 20 20 20 20 20 20 oc ....; 2490: 28 6c 65 74 20 6c 6f 6f 70 20 28 6c 62 20 2e 2e (let loop (lb .. 24a0: 2e 29 0a 3b 20 20 20 20 20 20 20 20 20 28 69 66 .).; (if 24b0: 20 28 6c 65 74 20 28 6e 65 31 3f 2d 76 61 6c 75 (let (ne1?-valu 24c0: 65 20 6e 65 31 3f 29 0a 3b 20 20 20 20 20 20 20 e ne1?).; 24d0: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 69 (let ((i 24e0: 62 2d 76 61 72 20 69 62 2d 72 68 73 29 20 2e 2e b-var ib-rhs) .. 24f0: 2e 29 0a 3b 20 20 20 20 20 20 20 20 20 20 20 20 .).; 2500: 20 20 20 20 20 69 63 20 2e 2e 2e 0a 3b 20 20 20 ic ....; 2510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 73 (s 2520: 65 74 21 20 69 62 2d 74 6d 70 20 69 62 2d 76 61 et! ib-tmp ib-va 2530: 72 29 20 2e 2e 2e 29 0a 3b 20 20 20 20 20 20 20 r) ...).; 2540: 20 20 20 20 20 20 20 20 28 61 6e 64 20 6e 65 31 (and ne1 2550: 3f 2d 76 61 6c 75 65 20 74 65 73 74 29 29 0a 3b ?-value test)).; 2560: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 (le 2570: 74 20 28 28 69 62 2d 76 61 72 20 69 62 2d 74 6d t ((ib-var ib-tm 2580: 70 29 20 2e 2e 2e 29 0a 3b 20 20 20 20 20 20 20 p) ...).; 2590: 20 20 20 20 20 20 20 20 2f 70 61 79 6c 6f 61 64 /payload 25a0: 2f 0a 3b 20 20 20 20 20 20 20 20 20 20 20 20 20 /.; 25b0: 20 20 28 69 66 20 6e 65 32 3f 0a 3b 20 20 20 20 (if ne2?.; 25c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 25d0: 6c 6f 6f 70 20 6c 73 20 2e 2e 2e 29 20 29 29 29 loop ls ...) ))) 25e0: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 ))..(define-synt 25f0: 61 78 20 3a 77 68 69 6c 65 2d 31 0a 20 20 28 73 ax :while-1. (s 2600: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 3a 64 6f yntax-rules (:do 2610: 20 6c 65 74 29 0a 20 20 20 20 28 28 3a 77 68 69 let). ((:whi 2620: 6c 65 2d 31 20 63 63 20 74 65 73 74 20 28 3a 64 le-1 cc test (:d 2630: 6f 20 6f 6c 65 74 20 6c 62 73 20 6e 65 31 3f 20 o olet lbs ne1? 2640: 69 6c 65 74 20 6e 65 32 3f 20 6c 73 73 29 29 0a ilet ne2? lss)). 2650: 20 20 20 20 20 28 3a 77 68 69 6c 65 2d 32 20 63 (:while-2 c 2660: 63 20 74 65 73 74 20 28 29 20 28 29 20 28 29 20 c test () () () 2670: 28 3a 64 6f 20 6f 6c 65 74 20 6c 62 73 20 6e 65 (:do olet lbs ne 2680: 31 3f 20 69 6c 65 74 20 6e 65 32 3f 20 6c 73 73 1? ilet ne2? lss 2690: 29 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 )))))..(define-s 26a0: 79 6e 74 61 78 20 3a 77 68 69 6c 65 2d 32 0a 20 yntax :while-2. 26b0: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 26c0: 3a 64 6f 20 6c 65 74 29 0a 20 20 20 20 28 28 3a :do let). ((: 26d0: 77 68 69 6c 65 2d 32 20 63 63 20 0a 20 20 20 20 while-2 cc . 26e0: 20 20 20 20 20 20 20 20 20 20 20 74 65 73 74 20 test 26f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 2700: 28 69 62 2d 6c 65 74 20 20 20 20 20 2e 2e 2e 29 (ib-let ...) 2710: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 2720: 28 69 62 2d 73 61 76 65 20 20 20 20 2e 2e 2e 29 (ib-save ...) 2730: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 2740: 28 69 62 2d 72 65 73 74 6f 72 65 20 2e 2e 2e 29 (ib-restore ...) 2750: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 2760: 28 3a 64 6f 20 6f 6c 65 74 20 0a 20 20 20 20 20 (:do olet . 2770: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c l 2780: 62 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 bs . 2790: 20 20 20 20 20 20 20 20 6e 65 31 3f 20 0a 20 20 ne1? . 27a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 27b0: 20 20 28 6c 65 74 20 28 28 69 62 2d 76 61 72 20 (let ((ib-var 27c0: 69 62 2d 72 68 73 29 20 69 62 20 2e 2e 2e 29 20 ib-rhs) ib ...) 27d0: 69 63 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 ic ...). 27e0: 20 20 20 20 20 20 20 20 20 20 20 20 6e 65 32 3f ne2? 27f0: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 2800: 20 20 20 20 20 20 6c 73 73 29 29 0a 20 20 20 20 lss)). 2810: 20 28 3a 77 68 69 6c 65 2d 32 20 63 63 20 0a 20 (:while-2 cc . 2820: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 74 65 te 2830: 73 74 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 st . 2840: 20 20 20 28 69 62 2d 6c 65 74 20 20 20 20 20 2e (ib-let . 2850: 2e 2e 20 28 69 62 2d 74 6d 70 20 23 66 29 29 0a .. (ib-tmp #f)). 2860: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 2870: 69 62 2d 73 61 76 65 20 20 20 20 2e 2e 2e 20 28 ib-save ... ( 2880: 69 62 2d 76 61 72 20 69 62 2d 72 68 73 29 29 0a ib-var ib-rhs)). 2890: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 28a0: 69 62 2d 72 65 73 74 6f 72 65 20 2e 2e 2e 20 28 ib-restore ... ( 28b0: 69 62 2d 76 61 72 20 69 62 2d 74 6d 70 29 29 0a ib-var ib-tmp)). 28c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 28d0: 3a 64 6f 20 6f 6c 65 74 20 0a 20 20 20 20 20 20 :do olet . 28e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6c 62 lb 28f0: 73 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s . 2900: 20 20 20 20 20 20 20 6e 65 31 3f 20 0a 20 20 20 ne1? . 2910: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2920: 20 28 6c 65 74 20 28 69 62 20 2e 2e 2e 29 20 69 (let (ib ...) i 2930: 63 20 2e 2e 2e 20 28 73 65 74 21 20 69 62 2d 74 c ... (set! ib-t 2940: 6d 70 20 69 62 2d 76 61 72 29 29 20 0a 20 20 20 mp ib-var)) . 2950: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2960: 20 6e 65 32 3f 20 0a 20 20 20 20 20 20 20 20 20 ne2? . 2970: 20 20 20 20 20 20 20 20 20 20 20 6c 73 73 29 29 lss)) 2980: 29 0a 20 20 20 20 28 28 3a 77 68 69 6c 65 2d 32 ). ((:while-2 2990: 20 63 63 0a 20 20 20 20 20 20 20 20 20 20 20 20 cc. 29a0: 20 20 20 74 65 73 74 0a 20 20 20 20 20 20 20 20 test. 29b0: 20 20 20 20 20 20 20 28 69 62 2d 6c 65 74 20 20 (ib-let 29c0: 20 20 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 ...). 29d0: 20 20 20 20 20 20 20 28 69 62 2d 73 61 76 65 20 (ib-save 29e0: 20 20 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 ...). 29f0: 20 20 20 20 20 20 20 28 69 62 2d 72 65 73 74 6f (ib-resto 2a00: 72 65 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 re ...). 2a10: 20 20 20 20 20 20 20 28 3a 64 6f 20 28 6c 65 74 (:do (let 2a20: 20 28 6f 62 20 2e 2e 2e 29 20 6f 63 20 2e 2e 2e (ob ...) oc ... 2a30: 29 20 6c 62 73 20 6e 65 31 3f 20 28 6c 65 74 20 ) lbs ne1? (let 2a40: 28 29 20 69 63 20 2e 2e 2e 29 20 6e 65 32 3f 20 () ic ...) ne2? 2a50: 6c 73 73 29 29 0a 20 20 20 20 20 28 3a 64 6f 20 lss)). (:do 2a60: 63 63 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 cc. (le 2a70: 74 20 28 6f 62 20 2e 2e 2e 20 69 62 2d 6c 65 74 t (ob ... ib-let 2a80: 20 2e 2e 2e 29 20 6f 63 20 2e 2e 2e 29 0a 20 20 ...) oc ...). 2a90: 20 20 20 20 20 20 20 20 6c 62 73 0a 20 20 20 20 lbs. 2aa0: 20 20 20 20 20 20 28 6c 65 74 20 28 28 6e 65 31 (let ((ne1 2ab0: 3f 2d 76 61 6c 75 65 20 6e 65 31 3f 29 29 0a 20 ?-value ne1?)). 2ac0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 (let 2ad0: 28 69 62 2d 73 61 76 65 20 2e 2e 2e 29 0a 20 20 (ib-save ...). 2ae0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 69 63 ic 2af0: 20 2e 2e 2e 0a 20 20 20 20 20 20 20 20 20 20 20 .... 2b00: 20 20 20 20 20 28 61 6e 64 20 6e 65 31 3f 2d 76 (and ne1?-v 2b10: 61 6c 75 65 20 74 65 73 74 29 29 29 0a 20 20 20 alue test))). 2b20: 20 20 20 20 20 20 20 28 6c 65 74 20 28 69 62 2d (let (ib- 2b30: 72 65 73 74 6f 72 65 20 2e 2e 2e 29 29 0a 20 20 restore ...)). 2b40: 20 20 20 20 20 20 20 20 6e 65 32 3f 0a 20 20 20 ne2?. 2b50: 20 20 20 20 20 20 20 6c 73 73 29 29 29 29 0a 0a lss)))).. 2b60: 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 .(define-syntax 2b70: 3a 75 6e 74 69 6c 0a 20 20 28 73 79 6e 74 61 78 :until. (syntax 2b80: 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 -rules (). (( 2b90: 3a 75 6e 74 69 6c 20 63 63 20 28 67 20 61 72 67 :until cc (g arg 2ba0: 31 20 61 72 67 20 2e 2e 2e 29 20 74 65 73 74 29 1 arg ...) test) 2bb0: 0a 20 20 20 20 20 28 67 20 28 3a 75 6e 74 69 6c . (g (:until 2bc0: 2d 31 20 63 63 20 74 65 73 74 29 20 61 72 67 31 -1 cc test) arg1 2bd0: 20 61 72 67 20 2e 2e 2e 29 20 29 29 29 0a 0a 28 arg ...) )))..( 2be0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 3a 75 define-syntax :u 2bf0: 6e 74 69 6c 2d 31 0a 20 20 28 73 79 6e 74 61 78 ntil-1. (syntax 2c00: 2d 72 75 6c 65 73 20 28 3a 64 6f 29 0a 20 20 20 -rules (:do). 2c10: 20 28 28 3a 75 6e 74 69 6c 2d 31 20 63 63 20 74 ((:until-1 cc t 2c20: 65 73 74 20 28 3a 64 6f 20 6f 6c 65 74 20 6c 62 est (:do olet lb 2c30: 73 20 6e 65 31 3f 20 69 6c 65 74 20 6e 65 32 3f s ne1? ilet ne2? 2c40: 20 6c 73 73 29 29 0a 20 20 20 20 20 28 3a 64 6f lss)). (:do 2c50: 20 63 63 20 6f 6c 65 74 20 6c 62 73 20 6e 65 31 cc olet lbs ne1 2c60: 3f 20 69 6c 65 74 20 28 61 6e 64 20 6e 65 32 3f ? ilet (and ne2? 2c70: 20 28 6e 6f 74 20 74 65 73 74 29 29 20 6c 73 73 (not test)) lss 2c80: 29 20 29 29 29 0a 0a 0a 3b 20 3d 3d 3d 3d 3d 3d ) )))...; ====== 2c90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2ca0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2cb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2cc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2cd0: 3d 3d 3d 3d 0a 3b 20 54 68 65 20 74 79 70 65 64 ====.; The typed 2ce0: 20 67 65 6e 65 72 61 74 6f 72 73 20 3a 6c 69 73 generators :lis 2cf0: 74 20 3a 73 74 72 69 6e 67 20 3a 76 65 63 74 6f t :string :vecto 2d00: 72 20 65 74 63 2e 0a 3b 20 3d 3d 3d 3d 3d 3d 3d r etc..; ======= 2d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2d20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2d30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2d40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 2d50: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e ===..(define-syn 2d60: 74 61 78 20 3a 6c 69 73 74 0a 20 20 28 73 79 6e tax :list. (syn 2d70: 74 61 78 2d 72 75 6c 65 73 20 28 69 6e 64 65 78 tax-rules (index 2d80: 29 0a 20 20 20 20 28 28 3a 6c 69 73 74 20 63 63 ). ((:list cc 2d90: 20 76 61 72 20 28 69 6e 64 65 78 20 69 29 20 61 var (index i) a 2da0: 72 67 20 2e 2e 2e 29 0a 20 20 20 20 20 28 3a 70 rg ...). (:p 2db0: 61 72 61 6c 6c 65 6c 20 63 63 20 28 3a 6c 69 73 arallel cc (:lis 2dc0: 74 20 76 61 72 20 61 72 67 20 2e 2e 2e 29 20 28 t var arg ...) ( 2dd0: 3a 69 6e 74 65 67 65 72 73 20 69 29 29 20 29 0a :integers i)) ). 2de0: 20 20 20 20 28 28 3a 6c 69 73 74 20 63 63 20 76 ((:list cc v 2df0: 61 72 20 61 72 67 31 20 61 72 67 32 20 61 72 67 ar arg1 arg2 arg 2e00: 20 2e 2e 2e 29 0a 20 20 20 20 20 28 3a 6c 69 73 ...). (:lis 2e10: 74 20 63 63 20 76 61 72 20 28 61 70 70 65 6e 64 t cc var (append 2e20: 20 61 72 67 31 20 61 72 67 32 20 61 72 67 20 2e arg1 arg2 arg . 2e30: 2e 2e 29 29 20 29 0a 20 20 20 20 28 28 3a 6c 69 ..)) ). ((:li 2e40: 73 74 20 63 63 20 76 61 72 20 61 72 67 29 0a 20 st cc var arg). 2e50: 20 20 20 20 28 3a 64 6f 20 63 63 0a 20 20 20 20 (:do cc. 2e60: 20 20 20 20 20 20 28 6c 65 74 20 28 29 29 0a 20 (let ()). 2e70: 20 20 20 20 20 20 20 20 20 28 28 74 20 61 72 67 ((t arg 2e80: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 6e 6f )). (no 2e90: 74 20 28 6e 75 6c 6c 3f 20 74 29 29 0a 20 20 20 t (null? t)). 2ea0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 (let ((va 2eb0: 72 20 28 63 61 72 20 74 29 29 29 29 0a 20 20 20 r (car t)))). 2ec0: 20 20 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 #t. 2ed0: 20 20 20 20 28 28 63 64 72 20 74 29 29 20 29 29 ((cdr t)) )) 2ee0: 29 29 0a 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e ))...(define-syn 2ef0: 74 61 78 20 3a 73 74 72 69 6e 67 0a 20 20 28 73 tax :string. (s 2f00: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 69 6e 64 yntax-rules (ind 2f10: 65 78 29 0a 20 20 20 20 28 28 3a 73 74 72 69 6e ex). ((:strin 2f20: 67 20 63 63 20 76 61 72 20 28 69 6e 64 65 78 20 g cc var (index 2f30: 69 29 20 61 72 67 29 0a 20 20 20 20 20 28 3a 64 i) arg). (:d 2f40: 6f 20 63 63 0a 20 20 20 20 20 20 20 20 20 20 28 o cc. ( 2f50: 6c 65 74 20 28 28 73 74 72 20 61 72 67 29 20 28 let ((str arg) ( 2f60: 6c 65 6e 20 30 29 29 20 0a 20 20 20 20 20 20 20 len 0)) . 2f70: 20 20 20 20 20 28 73 65 74 21 20 6c 65 6e 20 28 (set! len ( 2f80: 73 74 72 69 6e 67 2d 6c 65 6e 67 74 68 20 73 74 string-length st 2f90: 72 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 r))). ( 2fa0: 28 69 20 30 29 29 0a 20 20 20 20 20 20 20 20 20 (i 0)). 2fb0: 20 28 3c 20 69 20 6c 65 6e 29 0a 20 20 20 20 20 (< i len). 2fc0: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 (let ((var 2fd0: 28 73 74 72 69 6e 67 2d 72 65 66 20 73 74 72 20 (string-ref str 2fe0: 69 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 i)))). 2ff0: 23 74 0a 20 20 20 20 20 20 20 20 20 20 28 28 2b #t. ((+ 3000: 20 69 20 31 29 29 20 29 29 0a 20 20 20 20 28 28 i 1)) )). (( 3010: 3a 73 74 72 69 6e 67 20 63 63 20 76 61 72 20 28 :string cc var ( 3020: 69 6e 64 65 78 20 69 29 20 61 72 67 31 20 61 72 index i) arg1 ar 3030: 67 32 20 61 72 67 20 2e 2e 2e 29 0a 20 20 20 20 g2 arg ...). 3040: 20 28 3a 73 74 72 69 6e 67 20 63 63 20 76 61 72 (:string cc var 3050: 20 28 69 6e 64 65 78 20 69 29 20 28 73 74 72 69 (index i) (stri 3060: 6e 67 2d 61 70 70 65 6e 64 20 61 72 67 31 20 61 ng-append arg1 a 3070: 72 67 32 20 61 72 67 20 2e 2e 2e 29 29 20 29 0a rg2 arg ...)) ). 3080: 20 20 20 20 28 28 3a 73 74 72 69 6e 67 20 63 63 ((:string cc 3090: 20 76 61 72 20 61 72 67 31 20 61 72 67 20 2e 2e var arg1 arg .. 30a0: 2e 29 0a 20 20 20 20 20 28 3a 73 74 72 69 6e 67 .). (:string 30b0: 20 63 63 20 76 61 72 20 28 69 6e 64 65 78 20 69 cc var (index i 30c0: 29 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 20 ) arg1 arg ...) 30d0: 29 29 29 0a 0a 3b 20 41 6c 74 65 72 6e 61 74 69 )))..; Alternati 30e0: 76 65 3a 20 41 6e 20 69 6d 70 6c 65 6d 65 6e 74 ve: An implement 30f0: 61 74 69 6f 6e 20 69 6e 20 74 68 65 20 73 74 79 ation in the sty 3100: 6c 65 20 6f 66 20 3a 76 65 63 74 6f 72 20 63 61 le of :vector ca 3110: 6e 20 61 6c 73 6f 0a 3b 20 20 20 62 65 20 75 73 n also.; be us 3120: 65 64 20 66 6f 72 20 3a 73 74 72 69 6e 67 2e 20 ed for :string. 3130: 48 6f 77 65 76 65 72 2c 20 69 74 20 69 73 20 6c However, it is l 3140: 65 73 73 20 69 6e 74 65 72 65 73 74 69 6e 67 20 ess interesting 3150: 61 73 20 74 68 65 0a 3b 20 20 20 6f 76 65 72 68 as the.; overh 3160: 65 61 64 20 6f 66 20 73 74 72 69 6e 67 2d 61 70 ead of string-ap 3170: 70 65 6e 64 20 69 73 20 6d 75 63 68 20 6c 65 73 pend is much les 3180: 73 20 74 68 61 6e 20 66 6f 72 20 27 76 65 63 74 s than for 'vect 3190: 6f 72 2d 61 70 70 65 6e 64 27 2e 0a 0a 0a 28 64 or-append'....(d 31a0: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 3a 76 65 efine-syntax :ve 31b0: 63 74 6f 72 0a 20 20 28 73 79 6e 74 61 78 2d 72 ctor. (syntax-r 31c0: 75 6c 65 73 20 28 69 6e 64 65 78 29 0a 20 20 20 ules (index). 31d0: 20 28 28 3a 76 65 63 74 6f 72 20 63 63 20 76 61 ((:vector cc va 31e0: 72 20 61 72 67 29 0a 20 20 20 20 20 28 3a 76 65 r arg). (:ve 31f0: 63 74 6f 72 20 63 63 20 76 61 72 20 28 69 6e 64 ctor cc var (ind 3200: 65 78 20 69 29 20 61 72 67 29 20 29 0a 20 20 20 ex i) arg) ). 3210: 20 28 28 3a 76 65 63 74 6f 72 20 63 63 20 76 61 ((:vector cc va 3220: 72 20 28 69 6e 64 65 78 20 69 29 20 61 72 67 29 r (index i) arg) 3230: 0a 20 20 20 20 20 28 3a 64 6f 20 63 63 0a 20 20 . (:do cc. 3240: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 (let ((v 3250: 65 63 20 61 72 67 29 20 28 6c 65 6e 20 30 29 29 ec arg) (len 0)) 3260: 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 73 . (s 3270: 65 74 21 20 6c 65 6e 20 28 76 65 63 74 6f 72 2d et! len (vector- 3280: 6c 65 6e 67 74 68 20 76 65 63 29 29 29 0a 20 20 length vec))). 3290: 20 20 20 20 20 20 20 20 28 28 69 20 30 29 29 0a ((i 0)). 32a0: 20 20 20 20 20 20 20 20 20 20 28 3c 20 69 20 6c (< i l 32b0: 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c en). (l 32c0: 65 74 20 28 28 76 61 72 20 28 76 65 63 74 6f 72 et ((var (vector 32d0: 2d 72 65 66 20 76 65 63 20 69 29 29 29 29 0a 20 -ref vec i)))). 32e0: 20 20 20 20 20 20 20 20 20 23 74 0a 20 20 20 20 #t. 32f0: 20 20 20 20 20 20 28 28 2b 20 69 20 31 29 29 20 ((+ i 1)) 3300: 29 29 0a 0a 20 20 20 20 28 28 3a 76 65 63 74 6f )).. ((:vecto 3310: 72 20 63 63 20 76 61 72 20 28 69 6e 64 65 78 20 r cc var (index 3320: 69 29 20 61 72 67 31 20 61 72 67 32 20 61 72 67 i) arg1 arg2 arg 3330: 20 2e 2e 2e 29 0a 20 20 20 20 20 28 3a 70 61 72 ...). (:par 3340: 61 6c 6c 65 6c 20 63 63 20 28 3a 76 65 63 74 6f allel cc (:vecto 3350: 72 20 63 63 20 76 61 72 20 61 72 67 31 20 61 72 r cc var arg1 ar 3360: 67 32 20 61 72 67 20 2e 2e 2e 29 20 28 3a 69 6e g2 arg ...) (:in 3370: 74 65 67 65 72 73 20 69 29 29 20 29 0a 20 20 20 tegers i)) ). 3380: 20 28 28 3a 76 65 63 74 6f 72 20 63 63 20 76 61 ((:vector cc va 3390: 72 20 61 72 67 31 20 61 72 67 32 20 61 72 67 20 r arg1 arg2 arg 33a0: 2e 2e 2e 29 0a 20 20 20 20 20 28 3a 64 6f 20 63 ...). (:do c 33b0: 63 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 c. (let 33c0: 20 28 28 76 65 63 20 23 66 29 0a 20 20 20 20 20 ((vec #f). 33d0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 6e 20 (len 33e0: 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 0). 33f0: 20 20 20 28 76 65 63 73 20 28 65 63 2d 3a 76 65 (vecs (ec-:ve 3400: 63 74 6f 72 2d 66 69 6c 74 65 72 20 28 6c 69 73 ctor-filter (lis 3410: 74 20 61 72 67 31 20 61 72 67 32 20 61 72 67 20 t arg1 arg2 arg 3420: 2e 2e 2e 29 29 29 20 29 29 0a 20 20 20 20 20 20 ...))) )). 3430: 20 20 20 20 28 28 6b 20 30 29 29 0a 20 20 20 20 ((k 0)). 3440: 20 20 20 20 20 20 28 69 66 20 28 3c 20 6b 20 6c (if (< k l 3450: 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 en). 3460: 20 20 23 74 0a 20 20 20 20 20 20 20 20 20 20 20 #t. 3470: 20 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 76 65 (if (null? ve 3480: 63 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 cs). 3490: 20 20 20 20 20 20 23 66 0a 20 20 20 20 20 20 20 #f. 34a0: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi 34b0: 6e 20 28 73 65 74 21 20 76 65 63 20 28 63 61 72 n (set! vec (car 34c0: 20 76 65 63 73 29 29 0a 20 20 20 20 20 20 20 20 vecs)). 34d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 34e0: 20 28 73 65 74 21 20 76 65 63 73 20 28 63 64 72 (set! vecs (cdr 34f0: 20 76 65 63 73 29 29 0a 20 20 20 20 20 20 20 20 vecs)). 3500: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3510: 20 28 73 65 74 21 20 6c 65 6e 20 28 76 65 63 74 (set! len (vect 3520: 6f 72 2d 6c 65 6e 67 74 68 20 76 65 63 29 29 0a or-length vec)). 3530: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3540: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 6b (set! k 3550: 20 30 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0). 3560: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 74 20 #t 3570: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c ))). (l 3580: 65 74 20 28 28 76 61 72 20 28 76 65 63 74 6f 72 et ((var (vector 3590: 2d 72 65 66 20 76 65 63 20 6b 29 29 29 29 0a 20 -ref vec k)))). 35a0: 20 20 20 20 20 20 20 20 20 23 74 0a 20 20 20 20 #t. 35b0: 20 20 20 20 20 20 28 28 2b 20 6b 20 31 29 29 20 ((+ k 1)) 35c0: 29 29 29 29 0a 0a 28 64 65 66 69 6e 65 20 28 65 ))))..(define (e 35d0: 63 2d 3a 76 65 63 74 6f 72 2d 66 69 6c 74 65 72 c-:vector-filter 35e0: 20 76 65 63 73 29 0a 20 20 28 69 66 20 28 6e 75 vecs). (if (nu 35f0: 6c 6c 3f 20 76 65 63 73 29 0a 20 20 20 20 20 20 ll? vecs). 3600: 27 28 29 0a 20 20 20 20 20 20 28 69 66 20 28 7a '(). (if (z 3610: 65 72 6f 3f 20 28 76 65 63 74 6f 72 2d 6c 65 6e ero? (vector-len 3620: 67 74 68 20 28 63 61 72 20 76 65 63 73 29 29 29 gth (car vecs))) 3630: 0a 20 20 20 20 20 20 20 20 20 20 28 65 63 2d 3a . (ec-: 3640: 76 65 63 74 6f 72 2d 66 69 6c 74 65 72 20 28 63 vector-filter (c 3650: 64 72 20 76 65 63 73 29 29 0a 20 20 20 20 20 20 dr vecs)). 3660: 20 20 20 20 28 63 6f 6e 73 20 28 63 61 72 20 76 (cons (car v 3670: 65 63 73 29 20 28 65 63 2d 3a 76 65 63 74 6f 72 ecs) (ec-:vector 3680: 2d 66 69 6c 74 65 72 20 28 63 64 72 20 76 65 63 -filter (cdr vec 3690: 73 29 29 29 20 29 29 29 0a 0a 3b 20 41 6c 74 65 s))) )))..; Alte 36a0: 72 6e 61 74 69 76 65 3a 20 41 20 73 69 6d 70 6c rnative: A simpl 36b0: 65 72 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f er implementatio 36c0: 6e 20 66 6f 72 20 3a 76 65 63 74 6f 72 20 75 73 n for :vector us 36d0: 65 73 20 76 65 63 74 6f 72 2d 3e 6c 69 73 74 0a es vector->list. 36e0: 3b 20 20 20 61 70 70 65 6e 64 20 61 6e 64 20 3a ; append and : 36f0: 6c 69 73 74 20 69 6e 20 74 68 65 20 6d 75 6c 74 list in the mult 3700: 69 2d 61 72 67 75 6d 65 6e 74 20 63 61 73 65 2e i-argument case. 3710: 20 50 6c 65 61 73 65 20 72 65 66 65 72 20 74 6f Please refer to 3720: 20 74 68 65 0a 3b 20 20 20 27 64 65 73 69 67 6e the.; 'design 3730: 2e 73 63 6d 27 20 66 6f 72 20 6d 6f 72 65 20 64 .scm' for more d 3740: 65 74 61 69 6c 73 2e 0a 0a 0a 28 64 65 66 69 6e etails....(defin 3750: 65 2d 73 79 6e 74 61 78 20 3a 69 6e 74 65 67 65 e-syntax :intege 3760: 72 73 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c rs. (syntax-rul 3770: 65 73 20 28 69 6e 64 65 78 29 0a 20 20 20 20 28 es (index). ( 3780: 28 3a 69 6e 74 65 67 65 72 73 20 63 63 20 76 61 (:integers cc va 3790: 72 20 28 69 6e 64 65 78 20 69 29 29 0a 20 20 20 r (index i)). 37a0: 20 20 28 3a 64 6f 20 63 63 20 28 28 76 61 72 20 (:do cc ((var 37b0: 30 29 20 28 69 20 30 29 29 20 23 74 20 28 28 2b 0) (i 0)) #t ((+ 37c0: 20 76 61 72 20 31 29 20 28 2b 20 69 20 31 29 29 var 1) (+ i 1)) 37d0: 29 20 29 0a 20 20 20 20 28 28 3a 69 6e 74 65 67 ) ). ((:integ 37e0: 65 72 73 20 63 63 20 76 61 72 29 0a 20 20 20 20 ers cc var). 37f0: 20 28 3a 64 6f 20 63 63 20 28 28 76 61 72 20 30 (:do cc ((var 0 3800: 29 29 20 23 74 20 28 28 2b 20 76 61 72 20 31 29 )) #t ((+ var 1) 3810: 29 29 20 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 )) )))...(define 3820: 2d 73 79 6e 74 61 78 20 3a 72 61 6e 67 65 0a 20 -syntax :range. 3830: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 3840: 69 6e 64 65 78 29 0a 0a 20 20 20 20 3b 20 68 61 index).. ; ha 3850: 6e 64 6c 65 20 69 6e 64 65 78 20 76 61 72 69 61 ndle index varia 3860: 62 6c 65 20 61 6e 64 20 61 64 64 20 6f 70 74 69 ble and add opti 3870: 6f 6e 61 6c 20 61 72 67 73 0a 20 20 20 20 28 28 onal args. (( 3880: 3a 72 61 6e 67 65 20 63 63 20 76 61 72 20 28 69 :range cc var (i 3890: 6e 64 65 78 20 69 29 20 61 72 67 31 20 61 72 67 ndex i) arg1 arg 38a0: 20 2e 2e 2e 29 0a 20 20 20 20 20 28 3a 70 61 72 ...). (:par 38b0: 61 6c 6c 65 6c 20 63 63 20 28 3a 72 61 6e 67 65 allel cc (:range 38c0: 20 76 61 72 20 61 72 67 31 20 61 72 67 20 2e 2e var arg1 arg .. 38d0: 2e 29 20 28 3a 69 6e 74 65 67 65 72 73 20 69 29 .) (:integers i) 38e0: 29 20 29 0a 20 20 20 20 28 28 3a 72 61 6e 67 65 ) ). ((:range 38f0: 20 63 63 20 76 61 72 20 61 72 67 31 29 0a 20 20 cc var arg1). 3900: 20 20 20 28 3a 72 61 6e 67 65 20 63 63 20 76 61 (:range cc va 3910: 72 20 30 20 61 72 67 31 20 31 29 20 29 0a 20 20 r 0 arg1 1) ). 3920: 20 20 28 28 3a 72 61 6e 67 65 20 63 63 20 76 61 ((:range cc va 3930: 72 20 61 72 67 31 20 61 72 67 32 29 0a 20 20 20 r arg1 arg2). 3940: 20 20 28 3a 72 61 6e 67 65 20 63 63 20 76 61 72 (:range cc var 3950: 20 61 72 67 31 20 61 72 67 32 20 31 29 20 29 0a arg1 arg2 1) ). 3960: 0a 3b 20 73 70 65 63 69 61 6c 20 63 61 73 65 73 .; special cases 3970: 20 28 70 61 72 74 69 61 6c 6c 79 20 65 76 61 6c (partially eval 3980: 75 61 74 65 64 20 62 79 20 68 61 6e 64 20 66 72 uated by hand fr 3990: 6f 6d 20 67 65 6e 65 72 61 6c 20 63 61 73 65 29 om general case) 39a0: 0a 0a 20 20 20 20 28 28 3a 72 61 6e 67 65 20 63 .. ((:range c 39b0: 63 20 76 61 72 20 30 20 61 72 67 32 20 31 29 0a c var 0 arg2 1). 39c0: 20 20 20 20 20 28 3a 64 6f 20 63 63 0a 20 20 20 (:do cc. 39d0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 62 20 (let ((b 39e0: 61 72 67 32 29 29 0a 20 20 20 20 20 20 20 20 20 arg2)). 39f0: 20 20 20 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 (if (not (and 3a00: 20 28 69 6e 74 65 67 65 72 3f 20 62 29 20 28 65 (integer? b) (e 3a10: 78 61 63 74 3f 20 62 29 29 29 0a 20 20 20 20 20 xact? b))). 3a20: 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro 3a30: 72 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r . 3a40: 20 20 20 20 20 20 22 61 72 67 75 6d 65 6e 74 73 "arguments 3a50: 20 6f 66 20 3a 72 61 6e 67 65 20 61 72 65 20 6e of :range are n 3a60: 6f 74 20 65 78 61 63 74 20 69 6e 74 65 67 65 72 ot exact integer 3a70: 20 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ". 3a80: 20 20 20 20 20 20 22 28 75 73 65 20 3a 72 65 61 "(use :rea 3a90: 6c 2d 72 61 6e 67 65 3f 29 22 20 30 20 62 20 31 l-range?)" 0 b 1 3aa0: 20 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 ))). ( 3ab0: 28 76 61 72 20 30 29 29 0a 20 20 20 20 20 20 20 (var 0)). 3ac0: 20 20 20 28 3c 20 76 61 72 20 62 29 0a 20 20 20 (< var b). 3ad0: 20 20 20 20 20 20 20 28 6c 65 74 20 28 29 29 0a (let ()). 3ae0: 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 20 20 #t. 3af0: 20 20 20 20 20 20 20 28 28 2b 20 76 61 72 20 31 ((+ var 1 3b00: 29 29 20 29 29 0a 0a 20 20 20 20 28 28 3a 72 61 )) )).. ((:ra 3b10: 6e 67 65 20 63 63 20 76 61 72 20 30 20 61 72 67 nge cc var 0 arg 3b20: 32 20 2d 31 29 0a 20 20 20 20 20 28 3a 64 6f 20 2 -1). (:do 3b30: 63 63 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 cc. (le 3b40: 74 20 28 28 62 20 61 72 67 32 29 29 0a 20 20 20 t ((b arg2)). 3b50: 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e 6f (if (no 3b60: 74 20 28 61 6e 64 20 28 69 6e 74 65 67 65 72 3f t (and (integer? 3b70: 20 62 29 20 28 65 78 61 63 74 3f 20 62 29 29 29 b) (exact? b))) 3b80: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 3b90: 20 28 65 72 72 6f 72 20 0a 20 20 20 20 20 20 20 (error . 3ba0: 20 20 20 20 20 20 20 20 20 20 20 20 22 61 72 67 "arg 3bb0: 75 6d 65 6e 74 73 20 6f 66 20 3a 72 61 6e 67 65 uments of :range 3bc0: 20 61 72 65 20 6e 6f 74 20 65 78 61 63 74 20 69 are not exact i 3bd0: 6e 74 65 67 65 72 20 22 0a 20 20 20 20 20 20 20 nteger ". 3be0: 20 20 20 20 20 20 20 20 20 20 20 20 22 28 75 73 "(us 3bf0: 65 20 3a 72 65 61 6c 2d 72 61 6e 67 65 3f 29 22 e :real-range?)" 3c00: 20 30 20 62 20 31 20 29 29 29 0a 20 20 20 20 20 0 b 1 ))). 3c10: 20 20 20 20 20 28 28 76 61 72 20 30 29 29 0a 20 ((var 0)). 3c20: 20 20 20 20 20 20 20 20 20 28 3e 20 76 61 72 20 (> var 3c30: 62 29 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 b). (le 3c40: 74 20 28 29 29 0a 20 20 20 20 20 20 20 20 20 20 t ()). 3c50: 23 74 0a 20 20 20 20 20 20 20 20 20 20 28 28 2d #t. ((- 3c60: 20 76 61 72 20 31 29 29 20 29 29 0a 0a 20 20 20 var 1)) )).. 3c70: 20 28 28 3a 72 61 6e 67 65 20 63 63 20 76 61 72 ((:range cc var 3c80: 20 61 72 67 31 20 61 72 67 32 20 31 29 0a 20 20 arg1 arg2 1). 3c90: 20 20 20 28 3a 64 6f 20 63 63 0a 20 20 20 20 20 (:do cc. 3ca0: 20 20 20 20 20 28 6c 65 74 20 28 28 61 20 61 72 (let ((a ar 3cb0: 67 31 29 20 28 62 20 61 72 67 32 29 29 0a 20 20 g1) (b arg2)). 3cc0: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 6e (if (n 3cd0: 6f 74 20 28 61 6e 64 20 28 69 6e 74 65 67 65 72 ot (and (integer 3ce0: 3f 20 61 29 20 28 65 78 61 63 74 3f 20 61 29 0a ? a) (exact? a). 3cf0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d00: 20 20 20 20 20 20 20 20 20 20 28 69 6e 74 65 67 (integ 3d10: 65 72 3f 20 62 29 20 28 65 78 61 63 74 3f 20 62 er? b) (exact? b 3d20: 29 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 ) )). 3d30: 20 20 20 20 20 28 65 72 72 6f 72 20 0a 20 20 20 (error . 3d40: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d50: 22 61 72 67 75 6d 65 6e 74 73 20 6f 66 20 3a 72 "arguments of :r 3d60: 61 6e 67 65 20 61 72 65 20 6e 6f 74 20 65 78 61 ange are not exa 3d70: 63 74 20 69 6e 74 65 67 65 72 20 22 0a 20 20 20 ct integer ". 3d80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3d90: 22 28 75 73 65 20 3a 72 65 61 6c 2d 72 61 6e 67 "(use :real-rang 3da0: 65 3f 29 22 20 61 20 62 20 31 20 29 29 20 29 0a e?)" a b 1 )) ). 3db0: 20 20 20 20 20 20 20 20 20 20 28 28 76 61 72 20 ((var 3dc0: 61 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 3c a)). (< 3dd0: 20 76 61 72 20 62 29 0a 20 20 20 20 20 20 20 20 var b). 3de0: 20 20 28 6c 65 74 20 28 29 29 0a 20 20 20 20 20 (let ()). 3df0: 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 20 20 #t. 3e00: 20 20 28 28 2b 20 76 61 72 20 31 29 29 20 29 29 ((+ var 1)) )) 3e10: 0a 0a 20 20 20 20 28 28 3a 72 61 6e 67 65 20 63 .. ((:range c 3e20: 63 20 76 61 72 20 61 72 67 31 20 61 72 67 32 20 c var arg1 arg2 3e30: 2d 31 29 0a 20 20 20 20 20 28 3a 64 6f 20 63 63 -1). (:do cc 3e40: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 . (let 3e50: 28 28 61 20 61 72 67 31 29 20 28 62 20 61 72 67 ((a arg1) (b arg 3e60: 32 29 20 28 73 20 2d 31 29 20 28 73 74 6f 70 20 2) (s -1) (stop 3e70: 30 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 0)). 3e80: 28 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 28 69 (if (not (and (i 3e90: 6e 74 65 67 65 72 3f 20 61 29 20 28 65 78 61 63 nteger? a) (exac 3ea0: 74 3f 20 61 29 0a 20 20 20 20 20 20 20 20 20 20 t? a). 3eb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 3ec0: 28 69 6e 74 65 67 65 72 3f 20 62 29 20 28 65 78 (integer? b) (ex 3ed0: 61 63 74 3f 20 62 29 20 29 29 0a 20 20 20 20 20 act? b) )). 3ee0: 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 6f (erro 3ef0: 72 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 r . 3f00: 20 20 20 20 20 20 22 61 72 67 75 6d 65 6e 74 73 "arguments 3f10: 20 6f 66 20 3a 72 61 6e 67 65 20 61 72 65 20 6e of :range are n 3f20: 6f 74 20 65 78 61 63 74 20 69 6e 74 65 67 65 72 ot exact integer 3f30: 20 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ". 3f40: 20 20 20 20 20 20 22 28 75 73 65 20 3a 72 65 61 "(use :rea 3f50: 6c 2d 72 61 6e 67 65 3f 29 22 20 61 20 62 20 2d l-range?)" a b - 3f60: 31 20 29 29 20 29 0a 20 20 20 20 20 20 20 20 20 1 )) ). 3f70: 20 28 28 76 61 72 20 61 29 29 0a 20 20 20 20 20 ((var a)). 3f80: 20 20 20 20 20 28 3e 20 76 61 72 20 62 29 0a 20 (> var b). 3f90: 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 29 (let () 3fa0: 29 0a 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 ). #t. 3fb0: 20 20 20 20 20 20 20 20 20 28 28 2d 20 76 61 72 ((- var 3fc0: 20 31 29 29 20 29 29 0a 0a 3b 20 74 68 65 20 67 1)) ))..; the g 3fd0: 65 6e 65 72 61 6c 20 63 61 73 65 0a 0a 20 20 20 eneral case.. 3fe0: 20 28 28 3a 72 61 6e 67 65 20 63 63 20 76 61 72 ((:range cc var 3ff0: 20 61 72 67 31 20 61 72 67 32 20 61 72 67 33 29 arg1 arg2 arg3) 4000: 0a 20 20 20 20 20 28 3a 64 6f 20 63 63 0a 20 20 . (:do cc. 4010: 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 61 (let ((a 4020: 20 61 72 67 31 29 20 28 62 20 61 72 67 32 29 20 arg1) (b arg2) 4030: 28 73 20 61 72 67 33 29 20 28 73 74 6f 70 20 30 (s arg3) (stop 0 4040: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 )). ( 4050: 69 66 20 28 6e 6f 74 20 28 61 6e 64 20 28 69 6e if (not (and (in 4060: 74 65 67 65 72 3f 20 61 29 20 28 65 78 61 63 74 teger? a) (exact 4070: 3f 20 61 29 0a 20 20 20 20 20 20 20 20 20 20 20 ? a). 4080: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 4090: 69 6e 74 65 67 65 72 3f 20 62 29 20 28 65 78 61 integer? b) (exa 40a0: 63 74 3f 20 62 29 0a 20 20 20 20 20 20 20 20 20 ct? b). 40b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 40c0: 20 28 69 6e 74 65 67 65 72 3f 20 73 29 20 28 65 (integer? s) (e 40d0: 78 61 63 74 3f 20 73 29 20 29 29 0a 20 20 20 20 xact? s) )). 40e0: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 72 72 (err 40f0: 6f 72 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 or . 4100: 20 20 20 20 20 20 20 22 61 72 67 75 6d 65 6e 74 "argument 4110: 73 20 6f 66 20 3a 72 61 6e 67 65 20 61 72 65 20 s of :range are 4120: 6e 6f 74 20 65 78 61 63 74 20 69 6e 74 65 67 65 not exact intege 4130: 72 20 22 0a 20 20 20 20 20 20 20 20 20 20 20 20 r ". 4140: 20 20 20 20 20 20 20 22 28 75 73 65 20 3a 72 65 "(use :re 4150: 61 6c 2d 72 61 6e 67 65 3f 29 22 20 61 20 62 20 al-range?)" a b 4160: 73 20 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 s )). 4170: 20 28 69 66 20 28 7a 65 72 6f 3f 20 73 29 0a 20 (if (zero? s). 4180: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 4190: 65 72 72 6f 72 20 22 73 74 65 70 20 73 69 7a 65 error "step size 41a0: 20 6d 75 73 74 20 6e 6f 74 20 62 65 20 7a 65 72 must not be zer 41b0: 6f 20 69 6e 20 3a 72 61 6e 67 65 22 29 20 29 0a o in :range") ). 41c0: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set 41d0: 21 20 73 74 6f 70 20 28 2b 20 61 20 28 2a 20 28 ! stop (+ a (* ( 41e0: 6d 61 78 20 30 20 28 63 65 69 6c 69 6e 67 20 28 max 0 (ceiling ( 41f0: 2f 20 28 2d 20 62 20 61 29 20 73 29 29 29 20 73 / (- b a) s))) s 4200: 29 29 29 20 29 0a 20 20 20 20 20 20 20 20 20 20 ))) ). 4210: 28 28 76 61 72 20 61 29 29 0a 20 20 20 20 20 20 ((var a)). 4220: 20 20 20 20 28 6e 6f 74 20 28 3d 20 76 61 72 20 (not (= var 4230: 73 74 6f 70 29 29 0a 20 20 20 20 20 20 20 20 20 stop)). 4240: 20 28 6c 65 74 20 28 29 29 0a 20 20 20 20 20 20 (let ()). 4250: 20 20 20 20 23 74 0a 20 20 20 20 20 20 20 20 20 #t. 4260: 20 28 28 2b 20 76 61 72 20 73 29 29 20 29 29 29 ((+ var s)) ))) 4270: 29 0a 0a 3b 20 43 6f 6d 6d 65 6e 74 3a 20 54 68 )..; Comment: Th 4280: 65 20 6d 61 63 72 6f 20 3a 72 61 6e 67 65 20 69 e macro :range i 4290: 6e 73 65 72 74 73 20 73 6f 6d 65 20 63 6f 64 65 nserts some code 42a0: 20 74 6f 20 6d 61 6b 65 20 73 75 72 65 20 74 68 to make sure th 42b0: 65 20 76 61 6c 75 65 73 0a 3b 20 20 20 61 72 65 e values.; are 42c0: 20 65 78 61 63 74 20 69 6e 74 65 67 65 72 73 2e exact integers. 42d0: 20 54 68 69 73 20 6f 76 65 72 68 65 61 64 20 68 This overhead h 42e0: 61 73 20 70 72 6f 76 65 6e 20 76 65 72 79 20 68 as proven very h 42f0: 65 6c 70 66 75 6c 20 66 6f 72 20 0a 3b 20 20 20 elpful for .; 4300: 73 61 76 69 6e 67 20 75 73 65 72 73 20 66 72 6f saving users fro 4310: 6d 20 74 68 65 6d 73 65 6c 76 65 73 2e 0a 0a 0a m themselves.... 4320: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 3a (define-syntax : 4330: 72 65 61 6c 2d 72 61 6e 67 65 0a 20 20 28 73 79 real-range. (sy 4340: 6e 74 61 78 2d 72 75 6c 65 73 20 28 69 6e 64 65 ntax-rules (inde 4350: 78 29 0a 0a 20 20 20 20 3b 20 61 64 64 20 6f 70 x).. ; add op 4360: 74 69 6f 6e 61 6c 20 61 72 67 73 20 61 6e 64 20 tional args and 4370: 69 6e 64 65 78 20 76 61 72 69 61 62 6c 65 0a 20 index variable. 4380: 20 20 20 28 28 3a 72 65 61 6c 2d 72 61 6e 67 65 ((:real-range 4390: 20 63 63 20 76 61 72 20 61 72 67 31 29 0a 20 20 cc var arg1). 43a0: 20 20 20 28 3a 72 65 61 6c 2d 72 61 6e 67 65 20 (:real-range 43b0: 63 63 20 76 61 72 20 28 69 6e 64 65 78 20 69 29 cc var (index i) 43c0: 20 30 20 61 72 67 31 20 31 29 20 29 0a 20 20 20 0 arg1 1) ). 43d0: 20 28 28 3a 72 65 61 6c 2d 72 61 6e 67 65 20 63 ((:real-range c 43e0: 63 20 76 61 72 20 28 69 6e 64 65 78 20 69 29 20 c var (index i) 43f0: 61 72 67 31 29 0a 20 20 20 20 20 28 3a 72 65 61 arg1). (:rea 4400: 6c 2d 72 61 6e 67 65 20 63 63 20 76 61 72 20 28 l-range cc var ( 4410: 69 6e 64 65 78 20 69 29 20 30 20 61 72 67 31 20 index i) 0 arg1 4420: 31 29 20 29 0a 20 20 20 20 28 28 3a 72 65 61 6c 1) ). ((:real 4430: 2d 72 61 6e 67 65 20 63 63 20 76 61 72 20 61 72 -range cc var ar 4440: 67 31 20 61 72 67 32 29 0a 20 20 20 20 20 28 3a g1 arg2). (: 4450: 72 65 61 6c 2d 72 61 6e 67 65 20 63 63 20 76 61 real-range cc va 4460: 72 20 28 69 6e 64 65 78 20 69 29 20 61 72 67 31 r (index i) arg1 4470: 20 61 72 67 32 20 31 29 20 29 0a 20 20 20 20 28 arg2 1) ). ( 4480: 28 3a 72 65 61 6c 2d 72 61 6e 67 65 20 63 63 20 (:real-range cc 4490: 76 61 72 20 28 69 6e 64 65 78 20 69 29 20 61 72 var (index i) ar 44a0: 67 31 20 61 72 67 32 29 0a 20 20 20 20 20 28 3a g1 arg2). (: 44b0: 72 65 61 6c 2d 72 61 6e 67 65 20 63 63 20 76 61 real-range cc va 44c0: 72 20 28 69 6e 64 65 78 20 69 29 20 61 72 67 31 r (index i) arg1 44d0: 20 61 72 67 32 20 31 29 20 29 0a 20 20 20 20 28 arg2 1) ). ( 44e0: 28 3a 72 65 61 6c 2d 72 61 6e 67 65 20 63 63 20 (:real-range cc 44f0: 76 61 72 20 61 72 67 31 20 61 72 67 32 20 61 72 var arg1 arg2 ar 4500: 67 33 29 0a 20 20 20 20 20 28 3a 72 65 61 6c 2d g3). (:real- 4510: 72 61 6e 67 65 20 63 63 20 76 61 72 20 28 69 6e range cc var (in 4520: 64 65 78 20 69 29 20 61 72 67 31 20 61 72 67 32 dex i) arg1 arg2 4530: 20 61 72 67 33 29 20 29 0a 0a 20 20 20 20 3b 20 arg3) ).. ; 4540: 74 68 65 20 66 75 6c 6c 79 20 71 75 61 6c 69 66 the fully qualif 4550: 69 65 64 20 63 61 73 65 0a 20 20 20 20 28 28 3a ied case. ((: 4560: 72 65 61 6c 2d 72 61 6e 67 65 20 63 63 20 76 61 real-range cc va 4570: 72 20 28 69 6e 64 65 78 20 69 29 20 61 72 67 31 r (index i) arg1 4580: 20 61 72 67 32 20 61 72 67 33 29 0a 20 20 20 20 arg2 arg3). 4590: 20 28 3a 64 6f 20 63 63 0a 20 20 20 20 20 20 20 (:do cc. 45a0: 20 20 20 28 6c 65 74 20 28 28 61 20 61 72 67 31 (let ((a arg1 45b0: 29 20 28 62 20 61 72 67 32 29 20 28 73 20 61 72 ) (b arg2) (s ar 45c0: 67 33 29 20 28 69 73 74 6f 70 20 30 29 29 0a 20 g3) (istop 0)). 45d0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if ( 45e0: 6e 6f 74 20 28 61 6e 64 20 28 72 65 61 6c 3f 20 not (and (real? 45f0: 61 29 20 28 72 65 61 6c 3f 20 62 29 20 28 72 65 a) (real? b) (re 4600: 61 6c 3f 20 73 29 29 29 0a 20 20 20 20 20 20 20 al? s))). 4610: 20 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 (error 4620: 22 61 72 67 75 6d 65 6e 74 73 20 6f 66 20 3a 72 "arguments of :r 4630: 65 61 6c 2d 72 61 6e 67 65 20 61 72 65 20 6e 6f eal-range are no 4640: 74 20 72 65 61 6c 22 20 61 20 62 20 73 29 20 29 t real" a b s) ) 4650: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 . (if 4660: 20 28 61 6e 64 20 28 65 78 61 63 74 3f 20 61 29 (and (exact? a) 4670: 20 28 6f 72 20 28 6e 6f 74 20 28 65 78 61 63 74 (or (not (exact 4680: 3f 20 62 29 29 20 28 6e 6f 74 20 28 65 78 61 63 ? b)) (not (exac 4690: 74 3f 20 73 29 29 29 29 0a 20 20 20 20 20 20 20 t? s)))). 46a0: 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 61 (set! a 46b0: 20 28 65 78 61 63 74 2d 3e 69 6e 65 78 61 63 74 (exact->inexact 46c0: 20 61 29 29 20 29 0a 20 20 20 20 20 20 20 20 20 a)) ). 46d0: 20 20 20 28 73 65 74 21 20 69 73 74 6f 70 20 28 (set! istop ( 46e0: 2f 20 28 2d 20 62 20 61 29 20 73 29 29 20 29 0a / (- b a) s)) ). 46f0: 20 20 20 20 20 20 20 20 20 20 28 28 69 20 30 29 ((i 0) 4700: 29 0a 20 20 20 20 20 20 20 20 20 20 28 3c 20 69 ). (< i 4710: 20 69 73 74 6f 70 29 0a 20 20 20 20 20 20 20 20 istop). 4720: 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 2b 20 (let ((var (+ 4730: 61 20 28 2a 20 73 20 69 29 29 29 29 29 0a 20 20 a (* s i))))). 4740: 20 20 20 20 20 20 20 20 23 74 0a 20 20 20 20 20 #t. 4750: 20 20 20 20 20 28 28 2b 20 69 20 31 29 29 20 29 ((+ i 1)) ) 4760: 29 29 29 0a 0a 3b 20 43 6f 6d 6d 65 6e 74 3a 20 )))..; Comment: 4770: 54 68 65 20 6d 61 63 72 6f 20 3a 72 65 61 6c 2d The macro :real- 4780: 72 61 6e 67 65 20 61 64 61 70 74 73 20 74 68 65 range adapts the 4790: 20 65 78 61 63 74 6e 65 73 73 20 6f 66 20 74 68 exactness of th 47a0: 65 20 73 74 61 72 74 0a 3b 20 20 20 76 61 6c 75 e start.; valu 47b0: 65 20 69 6e 20 63 61 73 65 20 61 6e 79 20 6f 66 e in case any of 47c0: 20 74 68 65 20 6f 74 68 65 72 20 76 61 6c 75 65 the other value 47d0: 73 20 69 73 20 69 6e 65 78 61 63 74 2e 20 54 68 s is inexact. Th 47e0: 69 73 20 69 73 20 61 0a 3b 20 20 20 70 72 65 63 is is a.; prec 47f0: 61 75 74 69 6f 6e 20 74 6f 20 61 76 6f 69 64 20 aution to avoid 4800: 28 6c 69 73 74 2d 65 63 20 28 3a 20 78 20 30 20 (list-ec (: x 0 4810: 33 2e 30 29 20 78 29 20 3d 3e 20 27 28 30 20 31 3.0) x) => '(0 1 4820: 2e 30 20 32 2e 30 29 2e 0a 0a 20 20 20 20 0a 28 .0 2.0)... .( 4830: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 3a 63 define-syntax :c 4840: 68 61 72 2d 72 61 6e 67 65 0a 20 20 28 73 79 6e har-range. (syn 4850: 74 61 78 2d 72 75 6c 65 73 20 28 69 6e 64 65 78 tax-rules (index 4860: 29 0a 20 20 20 20 28 28 3a 63 68 61 72 2d 72 61 ). ((:char-ra 4870: 6e 67 65 20 63 63 20 76 61 72 20 28 69 6e 64 65 nge cc var (inde 4880: 78 20 69 29 20 61 72 67 31 20 61 72 67 32 29 0a x i) arg1 arg2). 4890: 20 20 20 20 20 28 3a 70 61 72 61 6c 6c 65 6c 20 (:parallel 48a0: 63 63 20 28 3a 63 68 61 72 2d 72 61 6e 67 65 20 cc (:char-range 48b0: 76 61 72 20 61 72 67 31 20 61 72 67 32 29 20 28 var arg1 arg2) ( 48c0: 3a 69 6e 74 65 67 65 72 73 20 69 29 29 20 29 0a :integers i)) ). 48d0: 20 20 20 20 28 28 3a 63 68 61 72 2d 72 61 6e 67 ((:char-rang 48e0: 65 20 63 63 20 76 61 72 20 61 72 67 31 20 61 72 e cc var arg1 ar 48f0: 67 32 29 0a 20 20 20 20 20 28 3a 64 6f 20 63 63 g2). (:do cc 4900: 0a 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 . (let 4910: 28 28 69 6d 61 78 20 28 63 68 61 72 2d 3e 69 6e ((imax (char->in 4920: 74 65 67 65 72 20 61 72 67 32 29 29 29 29 0a 20 teger arg2)))). 4930: 20 20 20 20 20 20 20 20 20 28 28 69 20 28 63 68 ((i (ch 4940: 61 72 2d 3e 69 6e 74 65 67 65 72 20 61 72 67 31 ar->integer arg1 4950: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 3c ))). (< 4960: 3d 20 69 20 69 6d 61 78 29 0a 20 20 20 20 20 20 = i imax). 4970: 20 20 20 20 28 6c 65 74 20 28 28 76 61 72 20 28 (let ((var ( 4980: 69 6e 74 65 67 65 72 2d 3e 63 68 61 72 20 69 29 integer->char i) 4990: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 23 74 ))). #t 49a0: 0a 20 20 20 20 20 20 20 20 20 20 28 28 2b 20 69 . ((+ i 49b0: 20 31 29 29 20 29 29 29 29 0a 0a 3b 20 57 61 72 1)) ))))..; War 49c0: 6e 69 6e 67 3a 20 54 68 65 72 65 20 69 73 20 6e ning: There is n 49d0: 6f 20 52 35 52 53 2d 77 61 79 20 74 6f 20 69 6d o R5RS-way to im 49e0: 70 6c 65 6d 65 6e 74 20 74 68 65 20 3a 63 68 61 plement the :cha 49f0: 72 2d 72 61 6e 67 65 20 67 65 6e 65 72 61 74 6f r-range generato 4a00: 72 20 0a 3b 20 20 20 62 65 63 61 75 73 65 20 74 r .; because t 4a10: 68 65 20 69 6e 74 65 67 65 72 73 20 6f 62 74 61 he integers obta 4a20: 69 6e 65 64 20 62 79 20 63 68 61 72 2d 3e 69 6e ined by char->in 4a30: 74 65 67 65 72 20 61 72 65 20 6e 6f 74 20 6e 65 teger are not ne 4a40: 63 65 73 73 61 72 69 6c 79 20 0a 3b 20 20 20 63 cessarily .; c 4a50: 6f 6e 73 65 63 75 74 69 76 65 2e 20 57 65 20 73 onsecutive. We s 4a60: 69 6d 70 6c 79 20 61 73 73 75 6d 65 20 74 68 69 imply assume thi 4a70: 73 20 61 6e 79 68 6f 77 20 66 6f 72 20 69 6c 6c s anyhow for ill 4a80: 75 73 74 72 61 74 69 6f 6e 2e 0a 0a 0a 28 64 65 ustration....(de 4a90: 66 69 6e 65 2d 73 79 6e 74 61 78 20 3a 70 6f 72 fine-syntax :por 4aa0: 74 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 t. (syntax-rule 4ab0: 73 20 28 69 6e 64 65 78 29 0a 20 20 20 20 28 28 s (index). (( 4ac0: 3a 70 6f 72 74 20 63 63 20 76 61 72 20 28 69 6e :port cc var (in 4ad0: 64 65 78 20 69 29 20 61 72 67 31 20 61 72 67 20 dex i) arg1 arg 4ae0: 2e 2e 2e 29 0a 20 20 20 20 20 28 3a 70 61 72 61 ...). (:para 4af0: 6c 6c 65 6c 20 63 63 20 28 3a 70 6f 72 74 20 76 llel cc (:port v 4b00: 61 72 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 ar arg1 arg ...) 4b10: 20 28 3a 69 6e 74 65 67 65 72 73 20 69 29 29 20 (:integers i)) 4b20: 29 0a 20 20 20 20 28 28 3a 70 6f 72 74 20 63 63 ). ((:port cc 4b30: 20 76 61 72 20 61 72 67 29 0a 20 20 20 20 20 28 var arg). ( 4b40: 3a 70 6f 72 74 20 63 63 20 76 61 72 20 61 72 67 :port cc var arg 4b50: 20 72 65 61 64 29 20 29 0a 20 20 20 20 28 28 3a read) ). ((: 4b60: 70 6f 72 74 20 63 63 20 76 61 72 20 61 72 67 31 port cc var arg1 4b70: 20 61 72 67 32 29 0a 20 20 20 20 20 28 3a 64 6f arg2). (:do 4b80: 20 63 63 0a 20 20 20 20 20 20 20 20 20 20 28 6c cc. (l 4b90: 65 74 20 28 28 70 6f 72 74 20 61 72 67 31 29 20 et ((port arg1) 4ba0: 28 72 65 61 64 2d 70 72 6f 63 20 61 72 67 32 29 (read-proc arg2) 4bb0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 76 )). ((v 4bc0: 61 72 20 28 72 65 61 64 2d 70 72 6f 63 20 70 6f ar (read-proc po 4bd0: 72 74 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 rt))). 4be0: 28 6e 6f 74 20 28 65 6f 66 2d 6f 62 6a 65 63 74 (not (eof-object 4bf0: 3f 20 76 61 72 29 29 0a 20 20 20 20 20 20 20 20 ? var)). 4c00: 20 20 28 6c 65 74 20 28 29 29 0a 20 20 20 20 20 (let ()). 4c10: 20 20 20 20 20 23 74 0a 20 20 20 20 20 20 20 20 #t. 4c20: 20 20 28 28 72 65 61 64 2d 70 72 6f 63 20 70 6f ((read-proc po 4c30: 72 74 29 29 20 29 29 29 29 0a 0a 0a 3b 20 3d 3d rt)) ))))...; == 4c40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4c50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4c60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4c70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4c80: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 20 54 68 65 20 74 ========.; The t 4c90: 79 70 65 64 20 67 65 6e 65 72 61 74 6f 72 20 3a yped generator : 4ca0: 64 69 73 70 61 74 63 68 65 64 20 61 6e 64 20 75 dispatched and u 4cb0: 74 69 6c 69 74 69 65 73 20 66 6f 72 20 63 6f 6e tilities for con 4cc0: 73 74 72 75 63 74 69 6e 67 20 64 69 73 70 61 74 structing dispat 4cd0: 63 68 65 72 73 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d chers.; ======== 4ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4d10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 4d20: 3d 3d 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 ==..(define-synt 4d30: 61 78 20 3a 64 69 73 70 61 74 63 68 65 64 0a 20 ax :dispatched. 4d40: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 4d50: 69 6e 64 65 78 29 0a 20 20 20 20 28 28 3a 64 69 index). ((:di 4d60: 73 70 61 74 63 68 65 64 20 63 63 20 76 61 72 20 spatched cc var 4d70: 28 69 6e 64 65 78 20 69 29 20 64 69 73 70 61 74 (index i) dispat 4d80: 63 68 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 ch arg1 arg ...) 4d90: 0a 20 20 20 20 20 28 3a 70 61 72 61 6c 6c 65 6c . (:parallel 4da0: 20 63 63 20 0a 20 20 20 20 20 20 20 20 20 20 20 cc . 4db0: 20 20 20 20 20 28 3a 69 6e 74 65 67 65 72 73 20 (:integers 4dc0: 69 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 i). 4dd0: 20 20 20 28 3a 64 69 73 70 61 74 63 68 65 64 20 (:dispatched 4de0: 76 61 72 20 64 69 73 70 61 74 63 68 20 61 72 67 var dispatch arg 4df0: 31 20 61 72 67 20 2e 2e 2e 29 20 29 29 0a 20 20 1 arg ...) )). 4e00: 20 20 28 28 3a 64 69 73 70 61 74 63 68 65 64 20 ((:dispatched 4e10: 63 63 20 76 61 72 20 64 69 73 70 61 74 63 68 20 cc var dispatch 4e20: 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 0a 20 20 arg1 arg ...). 4e30: 20 20 20 28 3a 64 6f 20 63 63 0a 20 20 20 20 20 (:do cc. 4e40: 20 20 20 20 20 28 6c 65 74 20 28 28 64 20 64 69 (let ((d di 4e50: 73 70 61 74 63 68 29 20 0a 20 20 20 20 20 20 20 spatch) . 4e60: 20 20 20 20 20 20 20 20 20 28 61 72 67 73 20 28 (args ( 4e70: 6c 69 73 74 20 61 72 67 31 20 61 72 67 20 2e 2e list arg1 arg .. 4e80: 2e 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 .)) . 4e90: 20 20 20 20 20 28 67 20 23 66 29 20 0a 20 20 20 (g #f) . 4ea0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 65 6d (em 4eb0: 70 74 79 20 28 6c 69 73 74 20 23 66 29 29 20 29 pty (list #f)) ) 4ec0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 . (se 4ed0: 74 21 20 67 20 28 64 20 61 72 67 73 29 29 0a 20 t! g (d args)). 4ee0: 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 28 (if ( 4ef0: 6e 6f 74 20 28 70 72 6f 63 65 64 75 72 65 3f 20 not (procedure? 4f00: 67 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 g)). 4f10: 20 20 20 20 28 65 72 72 6f 72 20 22 75 6e 72 65 (error "unre 4f20: 63 6f 67 6e 69 7a 65 64 20 61 72 67 75 6d 65 6e cognized argumen 4f30: 74 73 20 69 6e 20 64 69 73 70 61 74 63 68 69 6e ts in dispatchin 4f40: 67 22 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 g" . 4f50: 20 20 20 20 20 20 20 20 20 20 20 61 72 67 73 20 args 4f60: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 4f70: 20 20 20 20 20 20 20 20 28 64 20 27 28 29 29 20 (d '()) 4f80: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 ))). (( 4f90: 76 61 72 20 28 67 20 65 6d 70 74 79 29 29 29 0a var (g empty))). 4fa0: 20 20 20 20 20 20 20 20 20 20 28 6e 6f 74 20 28 (not ( 4fb0: 65 71 3f 20 76 61 72 20 65 6d 70 74 79 29 29 0a eq? var empty)). 4fc0: 20 20 20 20 20 20 20 20 20 20 28 6c 65 74 20 28 (let ( 4fd0: 29 29 0a 20 20 20 20 20 20 20 20 20 20 23 74 0a )). #t. 4fe0: 20 20 20 20 20 20 20 20 20 20 28 28 67 20 65 6d ((g em 4ff0: 70 74 79 29 29 20 29 29 29 29 0a 0a 3b 20 43 6f pty)) ))))..; Co 5000: 6d 6d 65 6e 74 3a 20 54 68 65 20 75 6e 69 71 75 mment: The uniqu 5010: 65 20 6f 62 6a 65 63 74 20 65 6d 70 74 79 20 69 e object empty i 5020: 73 20 63 72 65 61 74 65 64 20 61 73 20 61 20 6e s created as a n 5030: 65 77 6c 79 20 61 6c 6c 6f 63 61 74 65 64 0a 3b ewly allocated.; 5040: 20 20 20 6e 6f 6e 2d 65 6d 70 74 79 20 6c 69 73 non-empty lis 5050: 74 2e 20 49 74 20 69 73 20 63 6f 6d 70 61 72 65 t. It is compare 5060: 64 20 75 73 69 6e 67 20 65 71 3f 20 77 68 69 63 d using eq? whic 5070: 68 20 64 69 73 74 69 6e 67 75 69 73 68 65 73 0a h distinguishes. 5080: 3b 20 20 20 74 68 65 20 6f 62 6a 65 63 74 20 66 ; the object f 5090: 72 6f 6d 20 61 6e 79 20 6f 74 68 65 72 20 6f 62 rom any other ob 50a0: 6a 65 63 74 2c 20 61 63 63 6f 72 64 69 6e 67 20 ject, according 50b0: 74 6f 20 52 35 52 53 20 36 2e 31 2e 0a 0a 0a 28 to R5RS 6.1....( 50c0: 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 3a 67 define-syntax :g 50d0: 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 0a 20 20 enerator-proc. 50e0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 3a (syntax-rules (: 50f0: 64 6f 20 6c 65 74 29 0a 0a 20 20 20 20 3b 20 63 do let).. ; c 5100: 61 6c 6c 20 67 20 77 69 74 68 20 61 20 76 61 72 all g with a var 5110: 69 61 62 6c 65 2c 20 72 65 65 6e 74 72 79 20 61 iable, reentry a 5120: 74 20 28 2a 2a 29 0a 20 20 20 20 28 28 3a 67 65 t (**). ((:ge 5130: 6e 65 72 61 74 6f 72 2d 70 72 6f 63 20 28 67 20 nerator-proc (g 5140: 61 72 67 20 2e 2e 2e 29 29 0a 20 20 20 20 20 28 arg ...)). ( 5150: 67 20 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 g (:generator-pr 5160: 6f 63 20 76 61 72 29 20 76 61 72 20 61 72 67 20 oc var) var arg 5170: 2e 2e 2e 29 20 29 0a 0a 20 20 20 20 3b 20 72 65 ...) ).. ; re 5180: 65 6e 74 72 79 20 70 6f 69 6e 74 20 28 2a 2a 29 entry point (**) 5190: 20 2d 3e 20 6d 61 6b 65 20 74 68 65 20 63 6f 64 -> make the cod 51a0: 65 20 66 72 6f 6d 20 61 20 73 69 6e 67 6c 65 20 e from a single 51b0: 3a 64 6f 0a 20 20 20 20 28 28 3a 67 65 6e 65 72 :do. ((:gener 51c0: 61 74 6f 72 2d 70 72 6f 63 0a 20 20 20 20 20 20 ator-proc. 51d0: 20 76 61 72 20 0a 20 20 20 20 20 20 20 28 3a 64 var . (:d 51e0: 6f 20 28 6c 65 74 20 6f 62 73 20 6f 63 20 2e 2e o (let obs oc .. 51f0: 2e 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 20 .) . 5200: 28 28 6c 76 20 6c 69 29 20 2e 2e 2e 29 20 0a 20 ((lv li) ...) . 5210: 20 20 20 20 20 20 20 20 20 20 20 6e 65 31 3f 20 ne1? 5220: 0a 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 65 . (le 5230: 74 20 28 28 69 20 76 29 20 2e 2e 2e 29 20 69 63 t ((i v) ...) ic 5240: 20 2e 2e 2e 29 20 0a 20 20 20 20 20 20 20 20 20 ...) . 5250: 20 20 20 6e 65 32 3f 20 0a 20 20 20 20 20 20 20 ne2? . 5260: 20 20 20 20 20 28 6c 73 20 2e 2e 2e 29 29 20 29 (ls ...)) ) 5270: 0a 20 20 20 20 20 28 65 63 2d 73 69 6d 70 6c 69 . (ec-simpli 5280: 66 79 20 0a 20 20 20 20 20 20 28 6c 65 74 20 6f fy . (let o 5290: 62 73 0a 20 20 20 20 20 20 20 20 20 20 6f 63 20 bs. oc 52a0: 2e 2e 2e 0a 20 20 20 20 20 20 20 20 20 20 28 6c .... (l 52b0: 65 74 20 28 28 6c 76 20 6c 69 29 20 2e 2e 2e 20 et ((lv li) ... 52c0: 28 6e 65 32 20 23 74 29 29 0a 20 20 20 20 20 20 (ne2 #t)). 52d0: 20 20 20 20 20 20 28 65 63 2d 73 69 6d 70 6c 69 (ec-simpli 52e0: 66 79 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 fy. 52f0: 28 6c 65 74 20 28 28 69 20 23 66 29 20 2e 2e 2e (let ((i #f) ... 5300: 29 20 3b 20 76 20 6e 6f 74 20 79 65 74 20 76 61 ) ; v not yet va 5310: 6c 69 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 lid. 5320: 20 20 20 28 6c 61 6d 62 64 61 20 28 65 6d 70 74 (lambda (empt 5330: 79 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 y). 5340: 20 20 20 20 28 69 66 20 28 61 6e 64 20 6e 65 31 (if (and ne1 5350: 3f 20 6e 65 32 29 0a 20 20 20 20 20 20 20 20 20 ? ne2). 5360: 20 20 20 20 20 20 20 20 20 20 20 20 28 65 63 2d (ec- 5370: 73 69 6d 70 6c 69 66 79 0a 20 20 20 20 20 20 20 simplify. 5380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 5390: 62 65 67 69 6e 20 0a 20 20 20 20 20 20 20 20 20 begin . 53a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 53b0: 73 65 74 21 20 69 20 76 29 20 2e 2e 2e 0a 20 20 set! i v) .... 53c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 53d0: 20 20 20 20 20 20 69 63 20 2e 2e 2e 0a 20 20 20 ic .... 53e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 53f0: 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 6c 75 (let ((valu 5400: 65 20 76 61 72 29 29 0a 20 20 20 20 20 20 20 20 e var)). 5410: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5420: 20 20 28 65 63 2d 73 69 6d 70 6c 69 66 79 0a 20 (ec-simplify. 5430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5440: 20 20 20 20 20 20 20 20 20 20 28 69 66 20 6e 65 (if ne 5450: 32 3f 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 2?. 5460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5470: 20 20 28 65 63 2d 73 69 6d 70 6c 69 66 79 20 0a (ec-simplify . 5480: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5490: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 54a0: 28 62 65 67 69 6e 20 28 73 65 74 21 20 6c 76 20 (begin (set! lv 54b0: 6c 73 29 20 2e 2e 2e 29 20 29 0a 20 20 20 20 20 ls) ...) ). 54c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 54d0: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set! 54e0: 6e 65 32 20 23 66 29 20 29 29 0a 20 20 20 20 20 ne2 #f) )). 54f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5500: 20 20 20 20 20 76 61 6c 75 65 20 29 29 29 0a 20 value ))). 5510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5520: 20 20 20 20 65 6d 70 74 79 20 29 29 29 29 29 29 empty )))))) 5530: 29 29 0a 0a 20 20 20 20 3b 20 73 69 6c 65 6e 63 )).. ; silenc 5540: 65 20 77 61 72 6e 69 6e 67 73 20 6f 66 20 73 6f e warnings of so 5550: 6d 65 20 6d 61 63 72 6f 20 65 78 70 61 6e 64 65 me macro expande 5560: 72 73 0a 20 20 20 20 28 28 3a 67 65 6e 65 72 61 rs. ((:genera 5570: 74 6f 72 2d 70 72 6f 63 20 76 61 72 29 0a 20 20 tor-proc var). 5580: 20 20 20 28 65 72 72 6f 72 20 22 69 6c 6c 65 67 (error "illeg 5590: 61 6c 20 6d 61 63 72 6f 20 63 61 6c 6c 22 29 20 al macro call") 55a0: 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 20 28 64 )))...(define (d 55b0: 69 73 70 61 74 63 68 2d 75 6e 69 6f 6e 20 64 31 ispatch-union d1 55c0: 20 64 32 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 d2). (lambda ( 55d0: 61 72 67 73 29 0a 20 20 20 20 28 6c 65 74 20 28 args). (let ( 55e0: 28 67 31 20 28 64 31 20 61 72 67 73 29 29 20 28 (g1 (d1 args)) ( 55f0: 67 32 20 28 64 32 20 61 72 67 73 29 29 29 0a 20 g2 (d2 args))). 5600: 20 20 20 20 20 28 69 66 20 67 31 0a 20 20 20 20 (if g1. 5610: 20 20 20 20 20 20 28 69 66 20 67 32 20 0a 20 20 (if g2 . 5620: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 20 (if 5630: 28 6e 75 6c 6c 3f 20 61 72 67 73 29 0a 20 20 20 (null? args). 5640: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 5650: 61 70 70 65 6e 64 20 28 69 66 20 28 6c 69 73 74 append (if (list 5660: 3f 20 67 31 29 20 67 31 20 28 6c 69 73 74 20 67 ? g1) g1 (list g 5670: 31 29 29 20 0a 20 20 20 20 20 20 20 20 20 20 20 1)) . 5680: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 5690: 69 66 20 28 6c 69 73 74 3f 20 67 32 29 20 67 32 if (list? g2) g2 56a0: 20 28 6c 69 73 74 20 67 32 29 29 20 29 0a 20 20 (list g2)) ). 56b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 56c0: 28 65 72 72 6f 72 20 22 64 69 73 70 61 74 63 68 (error "dispatch 56d0: 69 6e 67 20 63 6f 6e 66 6c 69 63 74 22 20 61 72 ing conflict" ar 56e0: 67 73 20 28 64 31 20 27 28 29 29 20 28 64 32 20 gs (d1 '()) (d2 56f0: 27 28 29 29 29 20 29 0a 20 20 20 20 20 20 20 20 '())) ). 5700: 20 20 20 20 20 20 67 31 20 29 0a 20 20 20 20 20 g1 ). 5710: 20 20 20 20 20 28 69 66 20 67 32 20 67 32 20 23 (if g2 g2 # 5720: 66 29 20 29 29 29 29 0a 0a 0a 3b 20 3d 3d 3d 3d f) ))))...; ==== 5730: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 5740: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 5750: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 5760: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 5770: 3d 3d 3d 3d 3d 3d 0a 3b 20 54 68 65 20 64 69 73 ======.; The dis 5780: 70 61 74 63 68 69 6e 67 20 67 65 6e 65 72 61 74 patching generat 5790: 6f 72 20 3a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d or :.; ========= 57a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 57b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 57c0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 57d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 57e0: 3d 0a 0a 28 64 65 66 69 6e 65 20 28 6d 61 6b 65 =..(define (make 57f0: 2d 69 6e 69 74 69 61 6c 2d 3a 2d 64 69 73 70 61 -initial-:-dispa 5800: 74 63 68 29 0a 20 20 28 6c 61 6d 62 64 61 20 28 tch). (lambda ( 5810: 61 72 67 73 29 0a 20 20 20 20 28 63 61 73 65 20 args). (case 5820: 28 6c 65 6e 67 74 68 20 61 72 67 73 29 0a 20 20 (length args). 5830: 20 20 20 20 28 28 30 29 20 27 53 52 46 49 34 32 ((0) 'SRFI42 5840: 29 0a 20 20 20 20 20 20 28 28 31 29 20 28 6c 65 ). ((1) (le 5850: 74 20 28 28 61 31 20 28 63 61 72 20 61 72 67 73 t ((a1 (car args 5860: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ))). 5870: 20 28 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 (cond. 5880: 20 20 20 20 20 28 28 6c 69 73 74 3f 20 61 31 29 ((list? a1) 5890: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 58a0: 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 (:generator-proc 58b0: 20 28 3a 6c 69 73 74 20 61 31 29 29 20 29 0a 20 (:list a1)) ). 58c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 73 ((s 58d0: 74 72 69 6e 67 3f 20 61 31 29 0a 20 20 20 20 20 tring? a1). 58e0: 20 20 20 20 20 20 20 20 20 20 28 3a 67 65 6e 65 (:gene 58f0: 72 61 74 6f 72 2d 70 72 6f 63 20 28 3a 73 74 72 rator-proc (:str 5900: 69 6e 67 20 61 31 29 29 20 29 0a 20 20 20 20 20 ing a1)) ). 5910: 20 20 20 20 20 20 20 20 20 28 28 76 65 63 74 6f ((vecto 5920: 72 3f 20 61 31 29 0a 20 20 20 20 20 20 20 20 20 r? a1). 5930: 20 20 20 20 20 20 28 3a 67 65 6e 65 72 61 74 6f (:generato 5940: 72 2d 70 72 6f 63 20 28 3a 76 65 63 74 6f 72 20 r-proc (:vector 5950: 61 31 29 29 20 29 0a 20 20 20 20 20 20 20 20 20 a1)) ). 5960: 20 20 20 20 20 28 28 61 6e 64 20 28 69 6e 74 65 ((and (inte 5970: 67 65 72 3f 20 61 31 29 20 28 65 78 61 63 74 3f ger? a1) (exact? 5980: 20 61 31 29 29 0a 20 20 20 20 20 20 20 20 20 20 a1)). 5990: 20 20 20 20 20 28 3a 67 65 6e 65 72 61 74 6f 72 (:generator 59a0: 2d 70 72 6f 63 20 28 3a 72 61 6e 67 65 20 61 31 -proc (:range a1 59b0: 29 29 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 )) ). 59c0: 20 20 20 28 28 72 65 61 6c 3f 20 61 31 29 0a 20 ((real? a1). 59d0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3a (: 59e0: 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 20 28 generator-proc ( 59f0: 3a 72 65 61 6c 2d 72 61 6e 67 65 20 61 31 29 29 :real-range a1)) 5a00: 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 5a10: 20 28 28 69 6e 70 75 74 2d 70 6f 72 74 3f 20 61 ((input-port? a 5a20: 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1). 5a30: 20 20 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 (:generator-pr 5a40: 6f 63 20 28 3a 70 6f 72 74 20 61 31 29 29 20 29 oc (:port a1)) ) 5a50: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . ( 5a60: 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 else. 5a70: 20 20 20 20 23 66 20 29 29 29 29 0a 20 20 20 20 #f )))). 5a80: 20 20 28 28 32 29 20 28 6c 65 74 20 28 28 61 31 ((2) (let ((a1 5a90: 20 28 63 61 72 20 61 72 67 73 29 29 20 28 61 32 (car args)) (a2 5aa0: 20 28 63 61 64 72 20 61 72 67 73 29 29 29 0a 20 (cadr args))). 5ab0: 20 20 20 20 20 20 20 20 20 20 20 20 28 63 6f 6e (con 5ac0: 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 d. 5ad0: 28 28 61 6e 64 20 28 6c 69 73 74 3f 20 61 31 29 ((and (list? a1) 5ae0: 20 28 6c 69 73 74 3f 20 61 32 29 29 0a 20 20 20 (list? a2)). 5af0: 20 20 20 20 20 20 20 20 20 20 20 20 28 3a 67 65 (:ge 5b00: 6e 65 72 61 74 6f 72 2d 70 72 6f 63 20 28 3a 6c nerator-proc (:l 5b10: 69 73 74 20 61 31 20 61 32 29 29 20 29 0a 20 20 ist a1 a2)) ). 5b20: 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 6e ((an 5b30: 64 20 28 73 74 72 69 6e 67 3f 20 61 31 29 20 28 d (string? a1) ( 5b40: 73 74 72 69 6e 67 3f 20 61 32 29 29 0a 20 20 20 string? a2)). 5b50: 20 20 20 20 20 20 20 20 20 20 20 20 28 3a 67 65 (:ge 5b60: 6e 65 72 61 74 6f 72 2d 70 72 6f 63 20 28 3a 73 nerator-proc (:s 5b70: 74 72 69 6e 67 20 61 31 20 61 32 29 29 20 29 0a tring a1 a2)) ). 5b80: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 (( 5b90: 61 6e 64 20 28 76 65 63 74 6f 72 3f 20 61 31 29 and (vector? a1) 5ba0: 20 28 76 65 63 74 6f 72 3f 20 61 32 29 29 0a 20 (vector? a2)). 5bb0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 3a (: 5bc0: 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 20 28 generator-proc ( 5bd0: 3a 76 65 63 74 6f 72 20 61 31 20 61 32 29 29 20 :vector a1 a2)) 5be0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 5bf0: 28 28 61 6e 64 20 28 69 6e 74 65 67 65 72 3f 20 ((and (integer? 5c00: 61 31 29 20 28 65 78 61 63 74 3f 20 61 31 29 20 a1) (exact? a1) 5c10: 28 69 6e 74 65 67 65 72 3f 20 61 32 29 20 28 65 (integer? a2) (e 5c20: 78 61 63 74 3f 20 61 32 29 29 0a 20 20 20 20 20 xact? a2)). 5c30: 20 20 20 20 20 20 20 20 20 20 28 3a 67 65 6e 65 (:gene 5c40: 72 61 74 6f 72 2d 70 72 6f 63 20 28 3a 72 61 6e rator-proc (:ran 5c50: 67 65 20 61 31 20 61 32 29 29 20 29 0a 20 20 20 ge a1 a2)) ). 5c60: 20 20 20 20 20 20 20 20 20 20 20 28 28 61 6e 64 ((and 5c70: 20 28 72 65 61 6c 3f 20 61 31 29 20 28 72 65 61 (real? a1) (rea 5c80: 6c 3f 20 61 32 29 29 0a 20 20 20 20 20 20 20 20 l? a2)). 5c90: 20 20 20 20 20 20 20 28 3a 67 65 6e 65 72 61 74 (:generat 5ca0: 6f 72 2d 70 72 6f 63 20 28 3a 72 65 61 6c 2d 72 or-proc (:real-r 5cb0: 61 6e 67 65 20 61 31 20 61 32 29 29 20 29 0a 20 ange a1 a2)) ). 5cc0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 28 61 ((a 5cd0: 6e 64 20 28 63 68 61 72 3f 20 61 31 29 20 28 63 nd (char? a1) (c 5ce0: 68 61 72 3f 20 61 32 29 29 0a 20 20 20 20 20 20 har? a2)). 5cf0: 20 20 20 20 20 20 20 20 20 28 3a 67 65 6e 65 72 (:gener 5d00: 61 74 6f 72 2d 70 72 6f 63 20 28 3a 63 68 61 72 ator-proc (:char 5d10: 2d 72 61 6e 67 65 20 61 31 20 61 32 29 29 20 29 -range a1 a2)) ) 5d20: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 . ( 5d30: 28 61 6e 64 20 28 69 6e 70 75 74 2d 70 6f 72 74 (and (input-port 5d40: 3f 20 61 31 29 20 28 70 72 6f 63 65 64 75 72 65 ? a1) (procedure 5d50: 3f 20 61 32 29 29 0a 20 20 20 20 20 20 20 20 20 ? a2)). 5d60: 20 20 20 20 20 20 28 3a 67 65 6e 65 72 61 74 6f (:generato 5d70: 72 2d 70 72 6f 63 20 28 3a 70 6f 72 74 20 61 31 r-proc (:port a1 5d80: 20 61 32 29 29 20 29 0a 20 20 20 20 20 20 20 20 a2)) ). 5d90: 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 (else. 5da0: 20 20 20 20 20 20 20 20 20 20 20 23 66 20 29 29 #f )) 5db0: 29 29 0a 20 20 20 20 20 20 28 28 33 29 20 28 6c )). ((3) (l 5dc0: 65 74 20 28 28 61 31 20 28 63 61 72 20 61 72 67 et ((a1 (car arg 5dd0: 73 29 29 20 28 61 32 20 28 63 61 64 72 20 61 72 s)) (a2 (cadr ar 5de0: 67 73 29 29 20 28 61 33 20 28 63 61 64 64 72 20 gs)) (a3 (caddr 5df0: 61 72 67 73 29 29 29 0a 20 20 20 20 20 20 20 20 args))). 5e00: 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 20 20 (cond. 5e10: 20 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 ((and ( 5e20: 6c 69 73 74 3f 20 61 31 29 20 28 6c 69 73 74 3f list? a1) (list? 5e30: 20 61 32 29 20 28 6c 69 73 74 3f 20 61 33 29 29 a2) (list? a3)) 5e40: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 5e50: 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 (:generator-proc 5e60: 20 28 3a 6c 69 73 74 20 61 31 20 61 32 20 61 33 (:list a1 a2 a3 5e70: 29 29 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 )) ). 5e80: 20 20 20 28 28 61 6e 64 20 28 73 74 72 69 6e 67 ((and (string 5e90: 3f 20 61 31 29 20 28 73 74 72 69 6e 67 3f 20 61 ? a1) (string? a 5ea0: 32 29 20 28 73 74 72 69 6e 67 3f 20 61 33 29 29 2) (string? a3)) 5eb0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 5ec0: 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 (:generator-proc 5ed0: 20 28 3a 73 74 72 69 6e 67 20 61 31 20 61 32 20 (:string a1 a2 5ee0: 61 33 29 29 20 29 0a 20 20 20 20 20 20 20 20 20 a3)) ). 5ef0: 20 20 20 20 20 28 28 61 6e 64 20 28 76 65 63 74 ((and (vect 5f00: 6f 72 3f 20 61 31 29 20 28 76 65 63 74 6f 72 3f or? a1) (vector? 5f10: 20 61 32 29 20 28 76 65 63 74 6f 72 3f 20 61 33 a2) (vector? a3 5f20: 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 )). 5f30: 20 20 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 (:generator-pr 5f40: 6f 63 20 28 3a 76 65 63 74 6f 72 20 61 31 20 61 oc (:vector a1 a 5f50: 32 20 61 33 29 29 20 29 0a 20 20 20 20 20 20 20 2 a3)) ). 5f60: 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 69 6e ((and (in 5f70: 74 65 67 65 72 3f 20 61 31 29 20 28 65 78 61 63 teger? a1) (exac 5f80: 74 3f 20 61 31 29 20 0a 20 20 20 20 20 20 20 20 t? a1) . 5f90: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 6e 74 (int 5fa0: 65 67 65 72 3f 20 61 32 29 20 28 65 78 61 63 74 eger? a2) (exact 5fb0: 3f 20 61 32 29 0a 20 20 20 20 20 20 20 20 20 20 ? a2). 5fc0: 20 20 20 20 20 20 20 20 20 20 28 69 6e 74 65 67 (integ 5fd0: 65 72 3f 20 61 33 29 20 28 65 78 61 63 74 3f 20 er? a3) (exact? 5fe0: 61 33 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 a3)). 5ff0: 20 20 20 20 28 3a 67 65 6e 65 72 61 74 6f 72 2d (:generator- 6000: 70 72 6f 63 20 28 3a 72 61 6e 67 65 20 61 31 20 proc (:range a1 6010: 61 32 20 61 33 29 29 20 29 0a 20 20 20 20 20 20 a2 a3)) ). 6020: 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 72 ((and (r 6030: 65 61 6c 3f 20 61 31 29 20 28 72 65 61 6c 3f 20 eal? a1) (real? 6040: 61 32 29 20 28 72 65 61 6c 3f 20 61 33 29 29 0a a2) (real? a3)). 6050: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 ( 6060: 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 20 :generator-proc 6070: 28 3a 72 65 61 6c 2d 72 61 6e 67 65 20 61 31 20 (:real-range a1 6080: 61 32 20 61 33 29 29 20 29 0a 20 20 20 20 20 20 a2 a3)) ). 6090: 20 20 20 20 20 20 20 20 28 65 6c 73 65 0a 20 20 (else. 60a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 23 66 20 #f 60b0: 29 29 29 29 0a 20 20 20 20 20 20 28 65 6c 73 65 )))). (else 60c0: 0a 20 20 20 20 20 20 20 28 6c 65 74 72 65 63 20 . (letrec 60d0: 28 28 65 76 65 72 79 3f 20 0a 20 20 20 20 20 20 ((every? . 60e0: 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d 62 (lamb 60f0: 64 61 20 28 70 72 65 64 20 61 72 67 73 29 0a 20 da (pred args). 6100: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6110: 20 20 28 69 66 20 28 6e 75 6c 6c 3f 20 61 72 67 (if (null? arg 6120: 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 s). 6130: 20 20 20 20 20 20 20 20 20 20 23 74 0a 20 20 20 #t. 6140: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6150: 20 20 20 20 28 61 6e 64 20 28 70 72 65 64 20 28 (and (pred ( 6160: 63 61 72 20 61 72 67 73 29 29 0a 20 20 20 20 20 car args)). 6170: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6180: 20 20 20 20 20 20 20 28 65 76 65 72 79 3f 20 70 (every? p 6190: 72 65 64 20 28 63 64 72 20 61 72 67 73 29 29 20 red (cdr args)) 61a0: 29 29 29 29 29 0a 20 20 20 20 20 20 20 20 20 28 ))))). ( 61b0: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 28 cond. ( 61c0: 28 65 76 65 72 79 3f 20 6c 69 73 74 3f 20 61 72 (every? list? ar 61d0: 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 gs). ( 61e0: 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 20 :generator-proc 61f0: 28 3a 6c 69 73 74 20 28 61 70 70 6c 79 20 61 70 (:list (apply ap 6200: 70 65 6e 64 20 61 72 67 73 29 29 29 20 29 0a 20 pend args))) ). 6210: 20 20 20 20 20 20 20 20 20 28 28 65 76 65 72 79 ((every 6220: 3f 20 73 74 72 69 6e 67 3f 20 61 72 67 73 29 0a ? string? args). 6230: 20 20 20 20 20 20 20 20 20 20 20 28 3a 67 65 6e (:gen 6240: 65 72 61 74 6f 72 2d 70 72 6f 63 20 28 3a 73 74 erator-proc (:st 6250: 72 69 6e 67 20 28 61 70 70 6c 79 20 73 74 72 69 ring (apply stri 6260: 6e 67 2d 61 70 70 65 6e 64 20 61 72 67 73 29 29 ng-append args)) 6270: 29 20 29 0a 20 20 20 20 20 20 20 20 20 20 28 28 ) ). (( 6280: 65 76 65 72 79 3f 20 76 65 63 74 6f 72 3f 20 61 every? vector? a 6290: 72 67 73 29 0a 20 20 20 20 20 20 20 20 20 20 20 rgs). 62a0: 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 (:generator-proc 62b0: 20 28 3a 6c 69 73 74 20 28 61 70 70 6c 79 20 61 (:list (apply a 62c0: 70 70 65 6e 64 20 28 6d 61 70 20 76 65 63 74 6f ppend (map vecto 62d0: 72 2d 3e 6c 69 73 74 20 61 72 67 73 29 29 29 29 r->list args)))) 62e0: 20 29 0a 20 20 20 20 20 20 20 20 20 20 28 65 6c ). (el 62f0: 73 65 0a 20 20 20 20 20 20 20 20 20 20 20 23 66 se. #f 6300: 20 29 29 29 29 29 29 29 0a 0a 28 64 65 66 69 6e )))))))..(defin 6310: 65 20 3a 2d 64 69 73 70 61 74 63 68 20 0a 20 20 e :-dispatch . 6320: 28 6d 61 6b 65 2d 70 61 72 61 6d 65 74 65 72 20 (make-parameter 6330: 28 6d 61 6b 65 2d 69 6e 69 74 69 61 6c 2d 3a 2d (make-initial-:- 6340: 64 69 73 70 61 74 63 68 29 0a 20 20 20 20 20 20 dispatch). 6350: 20 20 20 20 20 20 20 20 20 20 20 20 28 6c 61 6d (lam 6360: 62 64 61 20 28 78 29 20 28 69 66 20 28 70 72 6f bda (x) (if (pro 6370: 63 65 64 75 72 65 3f 20 78 29 20 78 20 28 65 72 cedure? x) x (er 6380: 72 6f 72 20 22 6e 6f 74 20 61 20 70 72 6f 63 65 ror "not a proce 6390: 64 75 72 65 22 20 78 29 29 29 29 29 0a 0a 28 64 dure" x)))))..(d 63a0: 65 66 69 6e 65 20 28 3a 2d 64 69 73 70 61 74 63 efine (:-dispatc 63b0: 68 2d 72 65 66 29 0a 20 20 28 3a 2d 64 69 73 70 h-ref). (:-disp 63c0: 61 74 63 68 29 29 0a 0a 28 64 65 66 69 6e 65 20 atch))..(define 63d0: 28 3a 2d 64 69 73 70 61 74 63 68 2d 73 65 74 21 (:-dispatch-set! 63e0: 20 64 69 73 70 61 74 63 68 29 0a 20 20 28 3a 2d dispatch). (:- 63f0: 64 69 73 70 61 74 63 68 20 64 69 73 70 61 74 63 dispatch dispatc 6400: 68 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e h))..(define-syn 6410: 74 61 78 20 3a 0a 20 20 28 73 79 6e 74 61 78 2d tax :. (syntax- 6420: 72 75 6c 65 73 20 28 69 6e 64 65 78 29 0a 20 20 rules (index). 6430: 20 20 28 28 3a 20 63 63 20 76 61 72 20 28 69 6e ((: cc var (in 6440: 64 65 78 20 69 29 20 61 72 67 31 20 61 72 67 20 dex i) arg1 arg 6450: 2e 2e 2e 29 0a 20 20 20 20 20 28 3a 64 69 73 70 ...). (:disp 6460: 61 74 63 68 65 64 20 63 63 20 76 61 72 20 28 69 atched cc var (i 6470: 6e 64 65 78 20 69 29 20 28 3a 2d 64 69 73 70 61 ndex i) (:-dispa 6480: 74 63 68 29 20 61 72 67 31 20 61 72 67 20 2e 2e tch) arg1 arg .. 6490: 2e 29 20 29 0a 20 20 20 20 28 28 3a 20 63 63 20 .) ). ((: cc 64a0: 76 61 72 20 61 72 67 31 20 61 72 67 20 2e 2e 2e var arg1 arg ... 64b0: 29 0a 20 20 20 20 20 28 3a 64 69 73 70 61 74 63 ). (:dispatc 64c0: 68 65 64 20 63 63 20 76 61 72 20 28 3a 2d 64 69 hed cc var (:-di 64d0: 73 70 61 74 63 68 29 20 61 72 67 31 20 61 72 67 spatch) arg1 arg 64e0: 20 2e 2e 2e 29 20 29 29 29 0a 0a 0a 3b 20 3d 3d ...) )))...; == 64f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6500: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6510: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6520: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6530: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 20 54 68 65 20 75 ========.; The u 6540: 74 69 6c 69 74 79 20 63 6f 6d 70 72 65 68 65 6e tility comprehen 6550: 73 69 6f 6e 73 20 66 6f 6c 64 2d 65 63 2c 20 66 sions fold-ec, f 6560: 6f 6c 64 33 2d 65 63 0a 3b 20 3d 3d 3d 3d 3d 3d old3-ec.; ====== 6570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 65a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 65b0: 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 2d 73 79 ====..(define-sy 65c0: 6e 74 61 78 20 66 6f 6c 64 33 2d 65 63 0a 20 20 ntax fold3-ec. 65d0: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 6e (syntax-rules (n 65e0: 65 73 74 65 64 29 0a 20 20 20 20 28 28 66 6f 6c ested). ((fol 65f0: 64 33 2d 65 63 20 78 30 20 28 6e 65 73 74 65 64 d3-ec x0 (nested 6600: 20 71 31 20 2e 2e 2e 29 20 71 20 65 74 63 31 20 q1 ...) q etc1 6610: 65 74 63 32 20 65 74 63 33 20 65 74 63 20 2e 2e etc2 etc3 etc .. 6620: 2e 29 0a 20 20 20 20 20 28 66 6f 6c 64 33 2d 65 .). (fold3-e 6630: 63 20 78 30 20 28 6e 65 73 74 65 64 20 71 31 20 c x0 (nested q1 6640: 2e 2e 2e 20 71 29 20 65 74 63 31 20 65 74 63 32 ... q) etc1 etc2 6650: 20 65 74 63 33 20 65 74 63 20 2e 2e 2e 29 20 29 etc3 etc ...) ) 6660: 0a 20 20 20 20 28 28 66 6f 6c 64 33 2d 65 63 20 . ((fold3-ec 6670: 78 30 20 71 31 20 71 32 20 65 74 63 31 20 65 74 x0 q1 q2 etc1 et 6680: 63 32 20 65 74 63 33 20 65 74 63 20 2e 2e 2e 29 c2 etc3 etc ...) 6690: 0a 20 20 20 20 20 28 66 6f 6c 64 33 2d 65 63 20 . (fold3-ec 66a0: 78 30 20 28 6e 65 73 74 65 64 20 71 31 20 71 32 x0 (nested q1 q2 66b0: 29 20 65 74 63 31 20 65 74 63 32 20 65 74 63 33 ) etc1 etc2 etc3 66c0: 20 65 74 63 20 2e 2e 2e 29 20 29 0a 20 20 20 20 etc ...) ). 66d0: 28 28 66 6f 6c 64 33 2d 65 63 20 78 30 20 65 78 ((fold3-ec x0 ex 66e0: 70 72 65 73 73 69 6f 6e 20 66 31 20 66 32 29 0a pression f1 f2). 66f0: 20 20 20 20 20 28 66 6f 6c 64 33 2d 65 63 20 78 (fold3-ec x 6700: 30 20 28 6e 65 73 74 65 64 29 20 65 78 70 72 65 0 (nested) expre 6710: 73 73 69 6f 6e 20 66 31 20 66 32 29 20 29 0a 0a ssion f1 f2) ).. 6720: 20 20 20 20 28 28 66 6f 6c 64 33 2d 65 63 20 78 ((fold3-ec x 6730: 30 20 71 75 61 6c 69 66 69 65 72 20 65 78 70 72 0 qualifier expr 6740: 65 73 73 69 6f 6e 20 66 31 20 66 32 29 0a 20 20 ession f1 f2). 6750: 20 20 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 (let ((result 6760: 20 23 66 29 20 28 65 6d 70 74 79 20 23 74 29 29 #f) (empty #t)) 6770: 0a 20 20 20 20 20 20 20 28 64 6f 2d 65 63 20 71 . (do-ec q 6780: 75 61 6c 69 66 69 65 72 0a 20 20 20 20 20 20 20 ualifier. 6790: 20 20 20 20 20 20 20 28 6c 65 74 20 28 28 76 61 (let ((va 67a0: 6c 75 65 20 65 78 70 72 65 73 73 69 6f 6e 29 29 lue expression)) 67b0: 20 3b 20 64 6f 6e 27 74 20 64 75 70 6c 69 63 61 ; don't duplica 67c0: 74 65 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 te. 67d0: 20 20 20 28 69 66 20 65 6d 70 74 79 0a 20 20 20 (if empty. 67e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 67f0: 20 28 62 65 67 69 6e 20 28 73 65 74 21 20 72 65 (begin (set! re 6800: 73 75 6c 74 20 28 66 31 20 76 61 6c 75 65 29 29 sult (f1 value)) 6810: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 6820: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set 6830: 21 20 65 6d 70 74 79 20 23 66 29 20 29 0a 20 20 ! empty #f) ). 6840: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6850: 20 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 (set! result ( 6860: 66 32 20 76 61 6c 75 65 20 72 65 73 75 6c 74 29 f2 value result) 6870: 29 20 29 29 29 0a 20 20 20 20 20 20 20 28 69 66 ) ))). (if 6880: 20 65 6d 70 74 79 20 78 30 20 72 65 73 75 6c 74 empty x0 result 6890: 29 20 29 29 29 29 0a 0a 0a 28 64 65 66 69 6e 65 ) ))))...(define 68a0: 2d 73 79 6e 74 61 78 20 66 6f 6c 64 2d 65 63 0a -syntax fold-ec. 68b0: 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 (syntax-rules 68c0: 28 6e 65 73 74 65 64 29 0a 20 20 20 20 28 28 66 (nested). ((f 68d0: 6f 6c 64 2d 65 63 20 78 30 20 28 6e 65 73 74 65 old-ec x0 (neste 68e0: 64 20 71 31 20 2e 2e 2e 29 20 71 20 65 74 63 31 d q1 ...) q etc1 68f0: 20 65 74 63 32 20 65 74 63 20 2e 2e 2e 29 0a 20 etc2 etc ...). 6900: 20 20 20 20 28 66 6f 6c 64 2d 65 63 20 78 30 20 (fold-ec x0 6910: 28 6e 65 73 74 65 64 20 71 31 20 2e 2e 2e 20 71 (nested q1 ... q 6920: 29 20 65 74 63 31 20 65 74 63 32 20 65 74 63 20 ) etc1 etc2 etc 6930: 2e 2e 2e 29 20 29 0a 20 20 20 20 28 28 66 6f 6c ...) ). ((fol 6940: 64 2d 65 63 20 78 30 20 71 31 20 71 32 20 65 74 d-ec x0 q1 q2 et 6950: 63 31 20 65 74 63 32 20 65 74 63 20 2e 2e 2e 29 c1 etc2 etc ...) 6960: 0a 20 20 20 20 20 28 66 6f 6c 64 2d 65 63 20 78 . (fold-ec x 6970: 30 20 28 6e 65 73 74 65 64 20 71 31 20 71 32 29 0 (nested q1 q2) 6980: 20 65 74 63 31 20 65 74 63 32 20 65 74 63 20 2e etc1 etc2 etc . 6990: 2e 2e 29 20 29 0a 20 20 20 20 28 28 66 6f 6c 64 ..) ). ((fold 69a0: 2d 65 63 20 78 30 20 65 78 70 72 65 73 73 69 6f -ec x0 expressio 69b0: 6e 20 66 32 29 0a 20 20 20 20 20 28 66 6f 6c 64 n f2). (fold 69c0: 2d 65 63 20 78 30 20 28 6e 65 73 74 65 64 29 20 -ec x0 (nested) 69d0: 65 78 70 72 65 73 73 69 6f 6e 20 66 32 29 20 29 expression f2) ) 69e0: 0a 0a 20 20 20 20 28 28 66 6f 6c 64 2d 65 63 20 .. ((fold-ec 69f0: 78 30 20 71 75 61 6c 69 66 69 65 72 20 65 78 70 x0 qualifier exp 6a00: 72 65 73 73 69 6f 6e 20 66 32 29 0a 20 20 20 20 ression f2). 6a10: 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 20 78 (let ((result x 6a20: 30 29 29 0a 20 20 20 20 20 20 20 28 64 6f 2d 65 0)). (do-e 6a30: 63 20 71 75 61 6c 69 66 69 65 72 20 28 73 65 74 c qualifier (set 6a40: 21 20 72 65 73 75 6c 74 20 28 66 32 20 65 78 70 ! result (f2 exp 6a50: 72 65 73 73 69 6f 6e 20 72 65 73 75 6c 74 29 29 ression result)) 6a60: 29 0a 20 20 20 20 20 20 20 72 65 73 75 6c 74 20 ). result 6a70: 29 29 29 29 0a 0a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d ))))...; ======= 6a80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6a90: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6aa0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6ab0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6ac0: 3d 3d 3d 0a 3b 20 54 68 65 20 63 6f 6d 70 72 65 ===.; The compre 6ad0: 68 65 6e 73 69 6f 6e 73 20 6c 69 73 74 2d 65 63 hensions list-ec 6ae0: 20 73 74 72 69 6e 67 2d 65 63 20 76 65 63 74 6f string-ec vecto 6af0: 72 2d 65 63 20 65 74 63 2e 0a 3b 20 3d 3d 3d 3d r-ec etc..; ==== 6b00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6b10: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6b20: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 6b40: 3d 3d 3d 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 2d ======..(define- 6b50: 73 79 6e 74 61 78 20 6c 69 73 74 2d 65 63 0a 20 syntax list-ec. 6b60: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 6b70: 29 0a 20 20 20 20 28 28 6c 69 73 74 2d 65 63 20 ). ((list-ec 6b80: 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a 20 20 etc1 etc ...). 6b90: 20 20 20 28 72 65 76 65 72 73 65 20 28 66 6f 6c (reverse (fol 6ba0: 64 2d 65 63 20 27 28 29 20 65 74 63 31 20 65 74 d-ec '() etc1 et 6bb0: 63 20 2e 2e 2e 20 63 6f 6e 73 29 29 20 29 29 29 c ... cons)) ))) 6bc0: 0a 0a 3b 20 41 6c 74 65 72 6e 61 74 69 76 65 3a ..; Alternative: 6bd0: 20 52 65 76 65 72 73 65 20 63 61 6e 20 73 61 66 Reverse can saf 6be0: 65 6c 79 20 62 65 20 72 65 70 6c 61 63 65 64 20 ely be replaced 6bf0: 62 79 20 72 65 76 65 72 73 65 21 20 69 66 20 79 by reverse! if y 6c00: 6f 75 20 68 61 76 65 20 69 74 2e 0a 3b 0a 3b 20 ou have it..;.; 6c10: 41 6c 74 65 72 6e 61 74 69 76 65 3a 20 49 74 20 Alternative: It 6c20: 69 73 20 70 6f 73 73 69 62 6c 65 20 74 6f 20 63 is possible to c 6c30: 6f 6e 73 74 72 75 63 74 20 74 68 65 20 72 65 73 onstruct the res 6c40: 75 6c 74 20 69 6e 20 74 68 65 20 63 6f 72 72 65 ult in the corre 6c50: 63 74 20 6f 72 64 65 72 0a 3b 20 20 20 75 73 69 ct order.; usi 6c60: 6e 67 20 73 65 74 2d 63 64 72 21 20 74 6f 20 61 ng set-cdr! to a 6c70: 64 64 20 61 74 20 74 68 65 20 74 61 69 6c 2e 20 dd at the tail. 6c80: 54 68 69 73 20 72 65 6d 6f 76 65 73 20 74 68 65 This removes the 6c90: 20 6f 76 65 72 68 65 61 64 20 6f 66 20 63 6f 70 overhead of cop 6ca0: 79 69 6e 67 0a 3b 20 20 20 61 74 20 74 68 65 20 ying.; at the 6cb0: 65 6e 64 2c 20 61 74 20 74 68 65 20 63 6f 73 74 end, at the cost 6cc0: 20 6f 66 20 6d 6f 72 65 20 62 6f 6f 6b 2d 6b 65 of more book-ke 6cd0: 65 70 69 6e 67 2e 0a 0a 0a 28 64 65 66 69 6e 65 eping....(define 6ce0: 2d 73 79 6e 74 61 78 20 61 70 70 65 6e 64 2d 65 -syntax append-e 6cf0: 63 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 c. (syntax-rule 6d00: 73 20 28 29 0a 20 20 20 20 28 28 61 70 70 65 6e s (). ((appen 6d10: 64 2d 65 63 20 65 74 63 31 20 65 74 63 20 2e 2e d-ec etc1 etc .. 6d20: 2e 29 0a 20 20 20 20 20 28 61 70 70 6c 79 20 61 .). (apply a 6d30: 70 70 65 6e 64 20 28 6c 69 73 74 2d 65 63 20 65 ppend (list-ec e 6d40: 74 63 31 20 65 74 63 20 2e 2e 2e 29 29 20 29 29 tc1 etc ...)) )) 6d50: 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 )..(define-synta 6d60: 78 20 73 74 72 69 6e 67 2d 65 63 0a 20 20 28 73 x string-ec. (s 6d70: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 yntax-rules (). 6d80: 20 20 20 28 28 73 74 72 69 6e 67 2d 65 63 20 65 ((string-ec e 6d90: 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 tc1 etc ...). 6da0: 20 20 28 6c 69 73 74 2d 3e 73 74 72 69 6e 67 20 (list->string 6db0: 28 6c 69 73 74 2d 65 63 20 65 74 63 31 20 65 74 (list-ec etc1 et 6dc0: 63 20 2e 2e 2e 29 29 20 29 29 29 0a 0a 3b 20 41 c ...)) )))..; A 6dd0: 6c 74 65 72 6e 61 74 69 76 65 3a 20 46 6f 72 20 lternative: For 6de0: 76 65 72 79 20 6c 6f 6e 67 20 73 74 72 69 6e 67 very long string 6df0: 73 2c 20 74 68 65 20 69 6e 74 65 72 6d 65 64 69 s, the intermedi 6e00: 61 74 65 20 6c 69 73 74 20 6d 61 79 20 62 65 20 ate list may be 6e10: 61 0a 3b 20 20 20 70 72 6f 62 6c 65 6d 2e 20 41 a.; problem. A 6e20: 20 6d 6f 72 65 20 73 70 61 63 65 2d 61 77 61 72 more space-awar 6e30: 65 20 69 6d 70 6c 65 6d 65 6e 74 61 74 69 6f 6e e implementation 6e40: 20 63 6f 6c 6c 65 63 74 20 74 68 65 20 63 68 61 collect the cha 6e50: 72 61 63 74 65 72 73 20 0a 3b 20 20 20 69 6e 20 racters .; in 6e60: 61 6e 20 69 6e 74 65 72 6d 65 64 69 61 74 65 20 an intermediate 6e70: 6c 69 73 74 20 61 6e 64 20 77 68 65 6e 20 74 68 list and when th 6e80: 69 73 20 6c 69 73 74 20 62 65 63 6f 6d 65 73 20 is list becomes 6e90: 74 6f 6f 20 6c 61 72 67 65 20 69 74 20 69 73 0a too large it is. 6ea0: 3b 20 20 20 63 6f 6e 76 65 72 74 65 64 20 69 6e ; converted in 6eb0: 74 6f 20 61 6e 20 69 6e 74 65 72 6d 65 64 69 61 to an intermedia 6ec0: 74 65 20 73 74 72 69 6e 67 2e 20 41 74 20 74 68 te string. At th 6ed0: 65 20 65 6e 64 2c 20 74 68 65 20 69 6e 74 65 72 e end, the inter 6ee0: 6d 65 64 69 61 74 65 0a 3b 20 20 20 73 74 72 69 mediate.; stri 6ef0: 6e 67 73 20 61 72 65 20 63 6f 6e 63 61 74 65 6e ngs are concaten 6f00: 61 74 65 64 20 77 69 74 68 20 73 74 72 69 6e 67 ated with string 6f10: 2d 61 70 70 65 6e 64 2e 0a 0a 0a 28 64 65 66 69 -append....(defi 6f20: 6e 65 2d 73 79 6e 74 61 78 20 73 74 72 69 6e 67 ne-syntax string 6f30: 2d 61 70 70 65 6e 64 2d 65 63 0a 20 20 28 73 79 -append-ec. (sy 6f40: 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 ntax-rules (). 6f50: 20 20 28 28 73 74 72 69 6e 67 2d 61 70 70 65 6e ((string-appen 6f60: 64 2d 65 63 20 65 74 63 31 20 65 74 63 20 2e 2e d-ec etc1 etc .. 6f70: 2e 29 0a 20 20 20 20 20 28 61 70 70 6c 79 20 73 .). (apply s 6f80: 74 72 69 6e 67 2d 61 70 70 65 6e 64 20 28 6c 69 tring-append (li 6f90: 73 74 2d 65 63 20 65 74 63 31 20 65 74 63 20 2e st-ec etc1 etc . 6fa0: 2e 2e 29 29 20 29 29 29 0a 0a 28 64 65 66 69 6e ..)) )))..(defin 6fb0: 65 2d 73 79 6e 74 61 78 20 76 65 63 74 6f 72 2d e-syntax vector- 6fc0: 65 63 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c ec. (syntax-rul 6fd0: 65 73 20 28 29 0a 20 20 20 20 28 28 76 65 63 74 es (). ((vect 6fe0: 6f 72 2d 65 63 20 65 74 63 31 20 65 74 63 20 2e or-ec etc1 etc . 6ff0: 2e 2e 29 0a 20 20 20 20 20 28 6c 69 73 74 2d 3e ..). (list-> 7000: 76 65 63 74 6f 72 20 28 6c 69 73 74 2d 65 63 20 vector (list-ec 7010: 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 29 20 29 etc1 etc ...)) ) 7020: 29 29 0a 0a 3b 20 43 6f 6d 6d 65 6e 74 3a 20 41 ))..; Comment: A 7030: 20 73 69 6d 69 6c 61 72 20 61 70 70 72 6f 61 63 similar approac 7040: 68 20 61 73 20 66 6f 72 20 73 74 72 69 6e 67 2d h as for string- 7050: 65 63 20 63 61 6e 20 62 65 20 75 73 65 64 20 66 ec can be used f 7060: 6f 72 20 76 65 63 74 6f 72 2d 65 63 2e 0a 3b 20 or vector-ec..; 7070: 20 20 48 6f 77 65 76 65 72 2c 20 74 68 65 20 73 However, the s 7080: 70 61 63 65 20 6f 76 65 72 68 65 61 64 20 66 6f pace overhead fo 7090: 72 20 74 68 65 20 69 6e 74 65 72 6d 65 64 69 61 r the intermedia 70a0: 74 65 20 6c 69 73 74 20 69 73 20 6d 75 63 68 20 te list is much 70b0: 6c 6f 77 65 72 0a 3b 20 20 20 74 68 61 6e 20 66 lower.; than f 70c0: 6f 72 20 73 74 72 69 6e 67 2d 65 63 20 61 6e 64 or string-ec and 70d0: 20 61 73 20 74 68 65 72 65 20 69 73 20 6e 6f 20 as there is no 70e0: 76 65 63 74 6f 72 2d 61 70 70 65 6e 64 2c 20 74 vector-append, t 70f0: 68 65 20 69 6e 74 65 72 6d 65 64 69 61 74 65 0a he intermediate. 7100: 3b 20 20 20 76 65 63 74 6f 72 73 20 6d 75 73 74 ; vectors must 7110: 20 62 65 20 63 6f 70 69 65 64 20 65 78 70 6c 69 be copied expli 7120: 63 69 74 6c 79 2e 0a 0a 28 64 65 66 69 6e 65 2d citly...(define- 7130: 73 79 6e 74 61 78 20 76 65 63 74 6f 72 2d 6f 66 syntax vector-of 7140: 2d 6c 65 6e 67 74 68 2d 65 63 0a 20 20 28 73 79 -length-ec. (sy 7150: 6e 74 61 78 2d 72 75 6c 65 73 20 28 6e 65 73 74 ntax-rules (nest 7160: 65 64 29 0a 20 20 20 20 28 28 76 65 63 74 6f 72 ed). ((vector 7170: 2d 6f 66 2d 6c 65 6e 67 74 68 2d 65 63 20 6b 20 -of-length-ec k 7180: 28 6e 65 73 74 65 64 20 71 31 20 2e 2e 2e 29 20 (nested q1 ...) 7190: 71 20 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a q etc1 etc ...). 71a0: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 6f 66 2d (vector-of- 71b0: 6c 65 6e 67 74 68 2d 65 63 20 6b 20 28 6e 65 73 length-ec k (nes 71c0: 74 65 64 20 71 31 20 2e 2e 2e 20 71 29 20 65 74 ted q1 ... q) et 71d0: 63 31 20 65 74 63 20 2e 2e 2e 29 20 29 0a 20 20 c1 etc ...) ). 71e0: 20 20 28 28 76 65 63 74 6f 72 2d 6f 66 2d 6c 65 ((vector-of-le 71f0: 6e 67 74 68 2d 65 63 20 6b 20 71 31 20 71 32 20 ngth-ec k q1 q2 7200: 20 20 20 20 20 20 20 20 20 20 20 20 65 74 63 31 etc1 7210: 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 20 20 28 etc ...). ( 7220: 76 65 63 74 6f 72 2d 6f 66 2d 6c 65 6e 67 74 68 vector-of-length 7230: 2d 65 63 20 6b 20 28 6e 65 73 74 65 64 20 71 31 -ec k (nested q1 7240: 20 71 32 29 20 20 20 20 65 74 63 31 20 65 74 63 q2) etc1 etc 7250: 20 2e 2e 2e 29 20 29 0a 20 20 20 20 28 28 76 65 ...) ). ((ve 7260: 63 74 6f 72 2d 6f 66 2d 6c 65 6e 67 74 68 2d 65 ctor-of-length-e 7270: 63 20 6b 20 65 78 70 72 65 73 73 69 6f 6e 29 0a c k expression). 7280: 20 20 20 20 20 28 76 65 63 74 6f 72 2d 6f 66 2d (vector-of- 7290: 6c 65 6e 67 74 68 2d 65 63 20 6b 20 28 6e 65 73 length-ec k (nes 72a0: 74 65 64 29 20 65 78 70 72 65 73 73 69 6f 6e 29 ted) expression) 72b0: 20 29 0a 0a 20 20 20 20 28 28 76 65 63 74 6f 72 ).. ((vector 72c0: 2d 6f 66 2d 6c 65 6e 67 74 68 2d 65 63 20 6b 20 -of-length-ec k 72d0: 71 75 61 6c 69 66 69 65 72 20 65 78 70 72 65 73 qualifier expres 72e0: 73 69 6f 6e 29 0a 20 20 20 20 20 28 6c 65 74 20 sion). (let 72f0: 28 28 6c 65 6e 20 6b 29 29 0a 20 20 20 20 20 20 ((len k)). 7300: 20 28 6c 65 74 20 28 28 76 65 63 20 28 6d 61 6b (let ((vec (mak 7310: 65 2d 76 65 63 74 6f 72 20 6c 65 6e 29 29 0a 20 e-vector len)). 7320: 20 20 20 20 20 20 20 20 20 20 20 20 28 69 20 30 (i 0 7330: 29 20 29 0a 20 20 20 20 20 20 20 20 20 28 64 6f ) ). (do 7340: 2d 65 63 20 71 75 61 6c 69 66 69 65 72 0a 20 20 -ec qualifier. 7350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 (i 7360: 66 20 28 3c 20 69 20 6c 65 6e 29 0a 20 20 20 20 f (< i len). 7370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 7380: 28 62 65 67 69 6e 20 28 76 65 63 74 6f 72 2d 73 (begin (vector-s 7390: 65 74 21 20 76 65 63 20 69 20 65 78 70 72 65 73 et! vec i expres 73a0: 73 69 6f 6e 29 0a 20 20 20 20 20 20 20 20 20 20 sion). 73b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 73c0: 20 28 73 65 74 21 20 69 20 28 2b 20 69 20 31 29 (set! i (+ i 1) 73d0: 29 20 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 ) ). 73e0: 20 20 20 20 20 20 20 20 28 65 72 72 6f 72 20 22 (error " 73f0: 76 65 63 74 6f 72 20 69 73 20 74 6f 6f 20 73 68 vector is too sh 7400: 6f 72 74 20 66 6f 72 20 74 68 65 20 63 6f 6d 70 ort for the comp 7410: 72 65 68 65 6e 73 69 6f 6e 22 29 20 29 29 0a 20 rehension") )). 7420: 20 20 20 20 20 20 20 20 28 69 66 20 28 3d 20 69 (if (= i 7430: 20 6c 65 6e 29 0a 20 20 20 20 20 20 20 20 20 20 len). 7440: 20 20 20 76 65 63 0a 20 20 20 20 20 20 20 20 20 vec. 7450: 20 20 20 20 28 65 72 72 6f 72 20 22 76 65 63 74 (error "vect 7460: 6f 72 20 69 73 20 74 6f 6f 20 6c 6f 6e 67 20 66 or is too long f 7470: 6f 72 20 74 68 65 20 63 6f 6d 70 72 65 68 65 6e or the comprehen 7480: 73 69 6f 6e 22 29 20 29 29 29 29 29 29 0a 0a 0a sion") ))))))... 7490: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 73 (define-syntax s 74a0: 75 6d 2d 65 63 0a 20 20 28 73 79 6e 74 61 78 2d um-ec. (syntax- 74b0: 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 73 rules (). ((s 74c0: 75 6d 2d 65 63 20 65 74 63 31 20 65 74 63 20 2e um-ec etc1 etc . 74d0: 2e 2e 29 0a 20 20 20 20 20 28 66 6f 6c 64 2d 65 ..). (fold-e 74e0: 63 20 28 2b 29 20 65 74 63 31 20 65 74 63 20 2e c (+) etc1 etc . 74f0: 2e 2e 20 2b 29 20 29 29 29 0a 0a 28 64 65 66 69 .. +) )))..(defi 7500: 6e 65 2d 73 79 6e 74 61 78 20 70 72 6f 64 75 63 ne-syntax produc 7510: 74 2d 65 63 0a 20 20 28 73 79 6e 74 61 78 2d 72 t-ec. (syntax-r 7520: 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 70 72 ules (). ((pr 7530: 6f 64 75 63 74 2d 65 63 20 65 74 63 31 20 65 74 oduct-ec etc1 et 7540: 63 20 2e 2e 2e 29 0a 20 20 20 20 20 28 66 6f 6c c ...). (fol 7550: 64 2d 65 63 20 28 2a 29 20 65 74 63 31 20 65 74 d-ec (*) etc1 et 7560: 63 20 2e 2e 2e 20 2a 29 20 29 29 29 0a 0a 28 64 c ... *) )))..(d 7570: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6d 69 6e efine-syntax min 7580: 2d 65 63 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 -ec. (syntax-ru 7590: 6c 65 73 20 28 29 0a 20 20 20 20 28 28 6d 69 6e les (). ((min 75a0: 2d 65 63 20 65 74 63 31 20 65 74 63 20 2e 2e 2e -ec etc1 etc ... 75b0: 29 0a 20 20 20 20 20 28 66 6f 6c 64 33 2d 65 63 ). (fold3-ec 75c0: 20 28 6d 69 6e 29 20 65 74 63 31 20 65 74 63 20 (min) etc1 etc 75d0: 2e 2e 2e 20 6d 69 6e 20 6d 69 6e 29 20 29 29 29 ... min min) ))) 75e0: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax 75f0: 20 6d 61 78 2d 65 63 0a 20 20 28 73 79 6e 74 61 max-ec. (synta 7600: 78 2d 72 75 6c 65 73 20 28 29 0a 20 20 20 20 28 x-rules (). ( 7610: 28 6d 61 78 2d 65 63 20 65 74 63 31 20 65 74 63 (max-ec etc1 etc 7620: 20 2e 2e 2e 29 0a 20 20 20 20 20 28 66 6f 6c 64 ...). (fold 7630: 33 2d 65 63 20 28 6d 61 78 29 20 65 74 63 31 20 3-ec (max) etc1 7640: 65 74 63 20 2e 2e 2e 20 6d 61 78 20 6d 61 78 29 etc ... max max) 7650: 20 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 )))..(define-sy 7660: 6e 74 61 78 20 6c 61 73 74 2d 65 63 0a 20 20 28 ntax last-ec. ( 7670: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 6e 65 syntax-rules (ne 7680: 73 74 65 64 29 0a 20 20 20 20 28 28 6c 61 73 74 sted). ((last 7690: 2d 65 63 20 64 65 66 61 75 6c 74 20 28 6e 65 73 -ec default (nes 76a0: 74 65 64 20 71 31 20 2e 2e 2e 29 20 71 20 65 74 ted q1 ...) q et 76b0: 63 31 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 20 c1 etc ...). 76c0: 20 28 6c 61 73 74 2d 65 63 20 64 65 66 61 75 6c (last-ec defaul 76d0: 74 20 28 6e 65 73 74 65 64 20 71 31 20 2e 2e 2e t (nested q1 ... 76e0: 20 71 29 20 65 74 63 31 20 65 74 63 20 2e 2e 2e q) etc1 etc ... 76f0: 29 20 29 0a 20 20 20 20 28 28 6c 61 73 74 2d 65 ) ). ((last-e 7700: 63 20 64 65 66 61 75 6c 74 20 71 31 20 71 32 20 c default q1 q2 7710: 20 20 20 20 20 20 20 20 20 20 20 20 65 74 63 31 etc1 7720: 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 20 20 28 etc ...). ( 7730: 6c 61 73 74 2d 65 63 20 64 65 66 61 75 6c 74 20 last-ec default 7740: 28 6e 65 73 74 65 64 20 71 31 20 71 32 29 20 20 (nested q1 q2) 7750: 20 20 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 20 etc1 etc ...) 7760: 29 0a 20 20 20 20 28 28 6c 61 73 74 2d 65 63 20 ). ((last-ec 7770: 64 65 66 61 75 6c 74 20 65 78 70 72 65 73 73 69 default expressi 7780: 6f 6e 29 0a 20 20 20 20 20 28 6c 61 73 74 2d 65 on). (last-e 7790: 63 20 64 65 66 61 75 6c 74 20 28 6e 65 73 74 65 c default (neste 77a0: 64 29 20 65 78 70 72 65 73 73 69 6f 6e 29 20 29 d) expression) ) 77b0: 0a 0a 20 20 20 20 28 28 6c 61 73 74 2d 65 63 20 .. ((last-ec 77c0: 64 65 66 61 75 6c 74 20 71 75 61 6c 69 66 69 65 default qualifie 77d0: 72 20 65 78 70 72 65 73 73 69 6f 6e 29 0a 20 20 r expression). 77e0: 20 20 20 28 6c 65 74 20 28 28 72 65 73 75 6c 74 (let ((result 77f0: 20 64 65 66 61 75 6c 74 29 29 0a 20 20 20 20 20 default)). 7800: 20 20 28 64 6f 2d 65 63 20 71 75 61 6c 69 66 69 (do-ec qualifi 7810: 65 72 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 er (set! result 7820: 65 78 70 72 65 73 73 69 6f 6e 29 29 0a 20 20 20 expression)). 7830: 20 20 20 20 72 65 73 75 6c 74 20 29 29 29 29 0a result )))). 7840: 0a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..; ============ 7850: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 7860: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 7870: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 7880: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.; 7890: 20 54 68 65 20 66 75 6e 64 61 6d 65 6e 74 61 6c The fundamental 78a0: 20 65 61 72 6c 79 2d 73 74 6f 70 70 69 6e 67 20 early-stopping 78b0: 63 6f 6d 70 72 65 68 65 6e 73 69 6f 6e 20 66 69 comprehension fi 78c0: 72 73 74 2d 65 63 0a 3b 20 3d 3d 3d 3d 3d 3d 3d rst-ec.; ======= 78d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 78e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 78f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 7900: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 7910: 3d 3d 3d 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e ===..(define-syn 7920: 74 61 78 20 66 69 72 73 74 2d 65 63 0a 20 20 28 tax first-ec. ( 7930: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 6e 65 syntax-rules (ne 7940: 73 74 65 64 29 0a 20 20 20 20 28 28 66 69 72 73 sted). ((firs 7950: 74 2d 65 63 20 64 65 66 61 75 6c 74 20 28 6e 65 t-ec default (ne 7960: 73 74 65 64 20 71 31 20 2e 2e 2e 29 20 71 20 65 sted q1 ...) q e 7970: 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 tc1 etc ...). 7980: 20 20 28 66 69 72 73 74 2d 65 63 20 64 65 66 61 (first-ec defa 7990: 75 6c 74 20 28 6e 65 73 74 65 64 20 71 31 20 2e ult (nested q1 . 79a0: 2e 2e 20 71 29 20 65 74 63 31 20 65 74 63 20 2e .. q) etc1 etc . 79b0: 2e 2e 29 20 29 0a 20 20 20 20 28 28 66 69 72 73 ..) ). ((firs 79c0: 74 2d 65 63 20 64 65 66 61 75 6c 74 20 71 31 20 t-ec default q1 79d0: 71 32 20 20 20 20 20 20 20 20 20 20 20 20 20 65 q2 e 79e0: 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 tc1 etc ...). 79f0: 20 20 28 66 69 72 73 74 2d 65 63 20 64 65 66 61 (first-ec defa 7a00: 75 6c 74 20 28 6e 65 73 74 65 64 20 71 31 20 71 ult (nested q1 q 7a10: 32 29 20 20 20 20 65 74 63 31 20 65 74 63 20 2e 2) etc1 etc . 7a20: 2e 2e 29 20 29 0a 20 20 20 20 28 28 66 69 72 73 ..) ). ((firs 7a30: 74 2d 65 63 20 64 65 66 61 75 6c 74 20 65 78 70 t-ec default exp 7a40: 72 65 73 73 69 6f 6e 29 0a 20 20 20 20 20 28 66 ression). (f 7a50: 69 72 73 74 2d 65 63 20 64 65 66 61 75 6c 74 20 irst-ec default 7a60: 28 6e 65 73 74 65 64 29 20 65 78 70 72 65 73 73 (nested) express 7a70: 69 6f 6e 29 20 29 0a 0a 20 20 20 20 28 28 66 69 ion) ).. ((fi 7a80: 72 73 74 2d 65 63 20 64 65 66 61 75 6c 74 20 71 rst-ec default q 7a90: 75 61 6c 69 66 69 65 72 20 65 78 70 72 65 73 73 ualifier express 7aa0: 69 6f 6e 29 0a 20 20 20 20 20 28 6c 65 74 20 28 ion). (let ( 7ab0: 28 72 65 73 75 6c 74 20 64 65 66 61 75 6c 74 29 (result default) 7ac0: 20 28 73 74 6f 70 20 23 66 29 29 0a 20 20 20 20 (stop #f)). 7ad0: 20 20 20 28 65 63 2d 67 75 61 72 64 65 64 2d 64 (ec-guarded-d 7ae0: 6f 2d 65 63 20 0a 20 20 20 20 20 20 20 20 20 73 o-ec . s 7af0: 74 6f 70 20 0a 20 20 20 20 20 20 20 20 20 28 6e top . (n 7b00: 65 73 74 65 64 20 71 75 61 6c 69 66 69 65 72 29 ested qualifier) 7b10: 0a 20 20 20 20 20 20 20 20 20 28 62 65 67 69 6e . (begin 7b20: 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 65 78 (set! result ex 7b30: 70 72 65 73 73 69 6f 6e 29 0a 20 20 20 20 20 20 pression). 7b40: 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 20 (set! 7b50: 73 74 6f 70 20 23 74 29 20 29 29 0a 20 20 20 20 stop #t) )). 7b60: 20 20 20 72 65 73 75 6c 74 20 29 29 29 29 0a 0a result )))).. 7b70: 3b 20 28 65 63 2d 67 75 61 72 64 65 64 2d 64 6f ; (ec-guarded-do 7b80: 2d 65 63 20 73 74 6f 70 20 28 6e 65 73 74 65 64 -ec stop (nested 7b90: 20 71 20 2e 2e 2e 29 20 63 6d 64 29 0a 3b 20 20 q ...) cmd).; 7ba0: 20 63 6f 6e 73 74 72 75 63 74 73 20 28 64 6f 2d constructs (do- 7bb0: 65 63 20 71 20 2e 2e 2e 20 63 6d 64 29 20 77 68 ec q ... cmd) wh 7bc0: 65 72 65 20 74 68 65 20 67 65 6e 65 72 61 74 6f ere the generato 7bd0: 72 73 20 67 65 6e 20 69 6e 20 71 20 2e 2e 2e 20 rs gen in q ... 7be0: 61 72 65 0a 3b 20 20 20 72 65 70 6c 61 63 65 64 are.; replaced 7bf0: 20 62 79 20 28 3a 75 6e 74 69 6c 20 67 65 6e 20 by (:until gen 7c00: 73 74 6f 70 29 2e 0a 0a 28 64 65 66 69 6e 65 2d stop)...(define- 7c10: 73 79 6e 74 61 78 20 65 63 2d 67 75 61 72 64 65 syntax ec-guarde 7c20: 64 2d 64 6f 2d 65 63 0a 20 20 28 73 79 6e 74 61 d-do-ec. (synta 7c30: 78 2d 72 75 6c 65 73 20 28 6e 65 73 74 65 64 20 x-rules (nested 7c40: 69 66 20 6e 6f 74 20 61 6e 64 20 6f 72 20 62 65 if not and or be 7c50: 67 69 6e 29 0a 0a 20 20 20 20 28 28 65 63 2d 67 gin).. ((ec-g 7c60: 75 61 72 64 65 64 2d 64 6f 2d 65 63 20 73 74 6f uarded-do-ec sto 7c70: 70 20 28 6e 65 73 74 65 64 20 28 6e 65 73 74 65 p (nested (neste 7c80: 64 20 71 31 20 2e 2e 2e 29 20 71 32 20 2e 2e 2e d q1 ...) q2 ... 7c90: 29 20 63 6d 64 29 0a 20 20 20 20 20 28 65 63 2d ) cmd). (ec- 7ca0: 67 75 61 72 64 65 64 2d 64 6f 2d 65 63 20 73 74 guarded-do-ec st 7cb0: 6f 70 20 28 6e 65 73 74 65 64 20 71 31 20 2e 2e op (nested q1 .. 7cc0: 2e 20 71 32 20 2e 2e 2e 29 20 63 6d 64 29 20 29 . q2 ...) cmd) ) 7cd0: 0a 0a 20 20 20 20 28 28 65 63 2d 67 75 61 72 64 .. ((ec-guard 7ce0: 65 64 2d 64 6f 2d 65 63 20 73 74 6f 70 20 28 6e ed-do-ec stop (n 7cf0: 65 73 74 65 64 20 28 69 66 20 74 65 73 74 29 20 ested (if test) 7d00: 71 20 2e 2e 2e 29 20 63 6d 64 29 0a 20 20 20 20 q ...) cmd). 7d10: 20 28 69 66 20 74 65 73 74 20 28 65 63 2d 67 75 (if test (ec-gu 7d20: 61 72 64 65 64 2d 64 6f 2d 65 63 20 73 74 6f 70 arded-do-ec stop 7d30: 20 28 6e 65 73 74 65 64 20 71 20 2e 2e 2e 29 20 (nested q ...) 7d40: 63 6d 64 29 29 20 29 0a 20 20 20 20 28 28 65 63 cmd)) ). ((ec 7d50: 2d 67 75 61 72 64 65 64 2d 64 6f 2d 65 63 20 73 -guarded-do-ec s 7d60: 74 6f 70 20 28 6e 65 73 74 65 64 20 28 6e 6f 74 top (nested (not 7d70: 20 74 65 73 74 29 20 71 20 2e 2e 2e 29 20 63 6d test) q ...) cm 7d80: 64 29 0a 20 20 20 20 20 28 69 66 20 28 6e 6f 74 d). (if (not 7d90: 20 74 65 73 74 29 20 28 65 63 2d 67 75 61 72 64 test) (ec-guard 7da0: 65 64 2d 64 6f 2d 65 63 20 73 74 6f 70 20 28 6e ed-do-ec stop (n 7db0: 65 73 74 65 64 20 71 20 2e 2e 2e 29 20 63 6d 64 ested q ...) cmd 7dc0: 29 29 20 29 0a 20 20 20 20 28 28 65 63 2d 67 75 )) ). ((ec-gu 7dd0: 61 72 64 65 64 2d 64 6f 2d 65 63 20 73 74 6f 70 arded-do-ec stop 7de0: 20 28 6e 65 73 74 65 64 20 28 61 6e 64 20 74 65 (nested (and te 7df0: 73 74 20 2e 2e 2e 29 20 71 20 2e 2e 2e 29 20 63 st ...) q ...) c 7e00: 6d 64 29 0a 20 20 20 20 20 28 69 66 20 28 61 6e md). (if (an 7e10: 64 20 74 65 73 74 20 2e 2e 2e 29 20 28 65 63 2d d test ...) (ec- 7e20: 67 75 61 72 64 65 64 2d 64 6f 2d 65 63 20 73 74 guarded-do-ec st 7e30: 6f 70 20 28 6e 65 73 74 65 64 20 71 20 2e 2e 2e op (nested q ... 7e40: 29 20 63 6d 64 29 29 20 29 0a 20 20 20 20 28 28 ) cmd)) ). (( 7e50: 65 63 2d 67 75 61 72 64 65 64 2d 64 6f 2d 65 63 ec-guarded-do-ec 7e60: 20 73 74 6f 70 20 28 6e 65 73 74 65 64 20 28 6f stop (nested (o 7e70: 72 20 74 65 73 74 20 2e 2e 2e 29 20 71 20 2e 2e r test ...) q .. 7e80: 2e 29 20 63 6d 64 29 0a 20 20 20 20 20 28 69 66 .) cmd). (if 7e90: 20 28 6f 72 20 74 65 73 74 20 2e 2e 2e 29 20 28 (or test ...) ( 7ea0: 65 63 2d 67 75 61 72 64 65 64 2d 64 6f 2d 65 63 ec-guarded-do-ec 7eb0: 20 73 74 6f 70 20 28 6e 65 73 74 65 64 20 71 20 stop (nested q 7ec0: 2e 2e 2e 29 20 63 6d 64 29 29 20 29 0a 0a 20 20 ...) cmd)) ).. 7ed0: 20 20 28 28 65 63 2d 67 75 61 72 64 65 64 2d 64 ((ec-guarded-d 7ee0: 6f 2d 65 63 20 73 74 6f 70 20 28 6e 65 73 74 65 o-ec stop (neste 7ef0: 64 20 28 62 65 67 69 6e 20 65 74 63 20 2e 2e 2e d (begin etc ... 7f00: 29 20 71 20 2e 2e 2e 29 20 63 6d 64 29 0a 20 20 ) q ...) cmd). 7f10: 20 20 20 28 62 65 67 69 6e 20 65 74 63 20 2e 2e (begin etc .. 7f20: 2e 20 28 65 63 2d 67 75 61 72 64 65 64 2d 64 6f . (ec-guarded-do 7f30: 2d 65 63 20 73 74 6f 70 20 28 6e 65 73 74 65 64 -ec stop (nested 7f40: 20 71 20 2e 2e 2e 29 20 63 6d 64 29 29 20 29 0a q ...) cmd)) ). 7f50: 0a 20 20 20 20 28 28 65 63 2d 67 75 61 72 64 65 . ((ec-guarde 7f60: 64 2d 64 6f 2d 65 63 20 73 74 6f 70 20 28 6e 65 d-do-ec stop (ne 7f70: 73 74 65 64 20 67 65 6e 20 71 20 2e 2e 2e 29 20 sted gen q ...) 7f80: 63 6d 64 29 0a 20 20 20 20 20 28 64 6f 2d 65 63 cmd). (do-ec 7f90: 20 0a 20 20 20 20 20 20 20 28 3a 75 6e 74 69 6c . (:until 7fa0: 20 67 65 6e 20 73 74 6f 70 29 20 0a 20 20 20 20 gen stop) . 7fb0: 20 20 20 28 65 63 2d 67 75 61 72 64 65 64 2d 64 (ec-guarded-d 7fc0: 6f 2d 65 63 20 73 74 6f 70 20 28 6e 65 73 74 65 o-ec stop (neste 7fd0: 64 20 71 20 2e 2e 2e 29 20 63 6d 64 29 20 29 29 d q ...) cmd) )) 7fe0: 0a 0a 20 20 20 20 28 28 65 63 2d 67 75 61 72 64 .. ((ec-guard 7ff0: 65 64 2d 64 6f 2d 65 63 20 73 74 6f 70 20 28 6e ed-do-ec stop (n 8000: 65 73 74 65 64 29 20 63 6d 64 29 0a 20 20 20 20 ested) cmd). 8010: 20 28 64 6f 2d 65 63 20 63 6d 64 29 20 29 29 29 (do-ec cmd) ))) 8020: 0a 0a 3b 20 41 6c 74 65 72 6e 61 74 69 76 65 3a ..; Alternative: 8030: 20 49 6e 73 74 65 61 64 20 6f 66 20 6d 6f 64 69 Instead of modi 8040: 66 79 69 6e 67 20 74 68 65 20 67 65 6e 65 72 61 fying the genera 8050: 74 6f 72 20 77 69 74 68 20 3a 75 6e 74 69 6c 2c tor with :until, 8060: 20 69 74 20 69 73 0a 3b 20 20 20 70 6f 73 73 69 it is.; possi 8070: 62 6c 65 20 74 6f 20 75 73 65 20 63 61 6c 6c 2d ble to use call- 8080: 77 69 74 68 2d 63 75 72 72 65 6e 74 2d 63 6f 6e with-current-con 8090: 74 69 6e 75 61 74 69 6f 6e 3a 0a 3b 0a 3b 20 20 tinuation:.;.; 80a0: 20 28 64 65 66 69 6e 65 2d 73 79 6e 61 74 78 20 (define-synatx 80b0: 66 69 72 73 74 2d 65 63 20 0a 3b 20 20 20 20 20 first-ec .; 80c0: 2e 2e 2e 73 61 6d 65 20 61 73 20 61 62 6f 76 65 ...same as above 80d0: 2e 2e 2e 0a 3b 20 20 20 20 20 28 28 66 69 72 73 ....; ((firs 80e0: 74 2d 65 63 20 64 65 66 61 75 6c 74 20 71 75 61 t-ec default qua 80f0: 6c 69 66 69 65 72 20 65 78 70 72 65 73 73 69 6f lifier expressio 8100: 6e 29 0a 3b 20 20 20 20 20 20 28 63 61 6c 6c 2d n).; (call- 8110: 77 69 74 68 2d 63 75 72 72 65 6e 74 2d 63 6f 6e with-current-con 8120: 74 69 6e 75 61 74 69 6f 6e 20 0a 3b 20 20 20 20 tinuation .; 8130: 20 20 20 28 6c 61 6d 62 64 61 20 28 63 63 29 0a (lambda (cc). 8140: 3b 20 20 20 20 20 20 20 20 28 64 6f 2d 65 63 20 ; (do-ec 8150: 71 75 61 6c 69 66 69 65 72 20 28 63 63 20 65 78 qualifier (cc ex 8160: 70 72 65 73 73 69 6f 6e 29 29 0a 3b 20 20 20 20 pression)).; 8170: 20 20 20 20 64 65 66 61 75 6c 74 20 29 29 29 20 default ))) 8180: 29 29 0a 3b 0a 3b 20 20 20 54 68 69 73 20 69 73 )).;.; This is 8190: 20 6d 75 63 68 20 73 69 6d 70 6c 65 72 20 62 75 much simpler bu 81a0: 74 20 6e 6f 74 20 6e 65 63 65 73 73 61 72 69 6c t not necessaril 81b0: 79 20 61 73 20 65 66 66 69 63 69 65 6e 74 2e 0a y as efficient.. 81c0: 0a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ..; ============ 81d0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 81e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 81f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 8200: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b ==============.; 8210: 20 54 68 65 20 65 61 72 6c 79 2d 73 74 6f 70 70 The early-stopp 8220: 69 6e 67 20 63 6f 6d 70 72 65 68 65 6e 73 69 6f ing comprehensio 8230: 6e 73 20 61 6e 79 3f 2d 65 63 20 65 76 65 72 79 ns any?-ec every 8240: 3f 2d 65 63 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d ?-ec.; ========= 8250: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 8260: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 8270: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 8280: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 8290: 3d 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 =..(define-synta 82a0: 78 20 61 6e 79 3f 2d 65 63 0a 20 20 28 73 79 6e x any?-ec. (syn 82b0: 74 61 78 2d 72 75 6c 65 73 20 28 6e 65 73 74 65 tax-rules (neste 82c0: 64 29 0a 20 20 20 20 28 28 61 6e 79 3f 2d 65 63 d). ((any?-ec 82d0: 20 28 6e 65 73 74 65 64 20 71 31 20 2e 2e 2e 29 (nested q1 ...) 82e0: 20 71 20 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 q etc1 etc ...) 82f0: 0a 20 20 20 20 20 28 61 6e 79 3f 2d 65 63 20 28 . (any?-ec ( 8300: 6e 65 73 74 65 64 20 71 31 20 2e 2e 2e 20 71 29 nested q1 ... q) 8310: 20 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 20 29 etc1 etc ...) ) 8320: 0a 20 20 20 20 28 28 61 6e 79 3f 2d 65 63 20 71 . ((any?-ec q 8330: 31 20 71 32 20 20 20 20 20 20 20 20 20 20 20 20 1 q2 8340: 20 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a 20 etc1 etc ...). 8350: 20 20 20 20 28 61 6e 79 3f 2d 65 63 20 28 6e 65 (any?-ec (ne 8360: 73 74 65 64 20 71 31 20 71 32 29 20 20 20 20 65 sted q1 q2) e 8370: 74 63 31 20 65 74 63 20 2e 2e 2e 29 20 29 0a 20 tc1 etc ...) ). 8380: 20 20 20 28 28 61 6e 79 3f 2d 65 63 20 65 78 70 ((any?-ec exp 8390: 72 65 73 73 69 6f 6e 29 0a 20 20 20 20 20 28 61 ression). (a 83a0: 6e 79 3f 2d 65 63 20 28 6e 65 73 74 65 64 29 20 ny?-ec (nested) 83b0: 65 78 70 72 65 73 73 69 6f 6e 29 20 29 0a 0a 20 expression) ).. 83c0: 20 20 20 28 28 61 6e 79 3f 2d 65 63 20 71 75 61 ((any?-ec qua 83d0: 6c 69 66 69 65 72 20 65 78 70 72 65 73 73 69 6f lifier expressio 83e0: 6e 29 0a 20 20 20 20 20 28 66 69 72 73 74 2d 65 n). (first-e 83f0: 63 20 23 66 20 71 75 61 6c 69 66 69 65 72 20 28 c #f qualifier ( 8400: 69 66 20 65 78 70 72 65 73 73 69 6f 6e 29 20 23 if expression) # 8410: 74 29 20 29 29 29 0a 0a 28 64 65 66 69 6e 65 2d t) )))..(define- 8420: 73 79 6e 74 61 78 20 65 76 65 72 79 3f 2d 65 63 syntax every?-ec 8430: 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 . (syntax-rules 8440: 20 28 6e 65 73 74 65 64 29 0a 20 20 20 20 28 28 (nested). (( 8450: 65 76 65 72 79 3f 2d 65 63 20 28 6e 65 73 74 65 every?-ec (neste 8460: 64 20 71 31 20 2e 2e 2e 29 20 71 20 65 74 63 31 d q1 ...) q etc1 8470: 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 20 20 28 etc ...). ( 8480: 65 76 65 72 79 3f 2d 65 63 20 28 6e 65 73 74 65 every?-ec (neste 8490: 64 20 71 31 20 2e 2e 2e 20 71 29 20 65 74 63 31 d q1 ... q) etc1 84a0: 20 65 74 63 20 2e 2e 2e 29 20 29 0a 20 20 20 20 etc ...) ). 84b0: 28 28 65 76 65 72 79 3f 2d 65 63 20 71 31 20 71 ((every?-ec q1 q 84c0: 32 20 20 20 20 20 20 20 20 20 20 20 20 20 65 74 2 et 84d0: 63 31 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 20 c1 etc ...). 84e0: 20 28 65 76 65 72 79 3f 2d 65 63 20 28 6e 65 73 (every?-ec (nes 84f0: 74 65 64 20 71 31 20 71 32 29 20 20 20 20 65 74 ted q1 q2) et 8500: 63 31 20 65 74 63 20 2e 2e 2e 29 20 29 0a 20 20 c1 etc ...) ). 8510: 20 20 28 28 65 76 65 72 79 3f 2d 65 63 20 65 78 ((every?-ec ex 8520: 70 72 65 73 73 69 6f 6e 29 0a 20 20 20 20 20 28 pression). ( 8530: 65 76 65 72 79 3f 2d 65 63 20 28 6e 65 73 74 65 every?-ec (neste 8540: 64 29 20 65 78 70 72 65 73 73 69 6f 6e 29 20 29 d) expression) ) 8550: 0a 0a 20 20 20 20 28 28 65 76 65 72 79 3f 2d 65 .. ((every?-e 8560: 63 20 71 75 61 6c 69 66 69 65 72 20 65 78 70 72 c qualifier expr 8570: 65 73 73 69 6f 6e 29 0a 20 20 20 20 20 28 66 69 ession). (fi 8580: 72 73 74 2d 65 63 20 23 74 20 71 75 61 6c 69 66 rst-ec #t qualif 8590: 69 65 72 20 28 69 66 20 28 6e 6f 74 20 65 78 70 ier (if (not exp 85a0: 72 65 73 73 69 6f 6e 29 29 20 23 66 29 20 29 29 ression)) #f) )) 85b0: 29 0a 0a )..