Artifact 44fae7f851774143a95be8631c547ae8c107b033:
- File srfi/s42/extension.scm — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 5197)
0000: 3b 20 3c 50 4c 41 49 4e 54 45 58 54 3e 0a 3b 20 ; <PLAINTEXT>.; 0010: 45 78 61 6d 70 6c 65 73 20 66 6f 72 20 41 70 70 Examples for App 0020: 6c 69 63 61 74 69 6f 6e 20 53 70 65 63 69 66 69 lication Specifi 0030: 63 20 45 78 74 65 6e 73 69 6f 6e 73 20 6f 66 20 c Extensions of 0040: 45 61 67 65 72 20 43 6f 6d 70 72 65 68 65 6e 73 Eager Comprehens 0050: 69 6f 6e 73 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d ions.; ========= 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 3d ================ 0080: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0090: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 ===========.;.; 00a0: 73 65 62 61 73 74 69 61 6e 2e 65 67 6e 65 72 40 sebastian.egner@ 00b0: 70 68 69 6c 69 70 73 2e 63 6f 6d 2c 20 45 69 6e philips.com, Ein 00c0: 64 68 6f 76 65 6e 2c 20 54 68 65 20 4e 65 74 68 dhoven, The Neth 00d0: 65 72 6c 61 6e 64 73 2c 20 46 65 62 2d 32 30 30 erlands, Feb-200 00e0: 33 2e 0a 3b 20 53 63 68 65 6d 65 20 52 35 52 53 3..; Scheme R5RS 00f0: 20 28 69 6e 63 6c 2e 20 6d 61 63 72 6f 73 29 2c (incl. macros), 0100: 20 53 52 46 49 2d 32 33 20 28 65 72 72 6f 72 29 SRFI-23 (error) 0110: 2e 0a 3b 20 0a 3b 20 52 75 6e 6e 69 6e 67 20 74 ..; .; Running t 0120: 68 65 20 65 78 74 65 6e 73 69 6f 6e 73 20 69 6e he extensions in 0130: 20 53 63 68 65 6d 65 34 38 20 28 76 65 72 73 69 Scheme48 (versi 0140: 6f 6e 20 30 2e 35 37 29 3a 0a 3b 20 20 20 3b 20 on 0.57):.; ; 0150: 6c 6f 61 64 20 22 65 78 61 6d 70 6c 65 73 2e 73 load "examples.s 0160: 63 6d 22 20 61 73 20 64 65 73 63 72 69 62 65 64 cm" as described 0170: 20 74 68 65 72 65 0a 3b 20 20 20 2c 6c 6f 61 64 there.; ,load 0180: 20 65 78 74 65 6e 73 69 6f 6e 2e 73 63 6d 0a 3b extension.scm.; 0190: 0a 3b 20 52 75 6e 6e 69 6e 67 20 74 68 65 20 65 .; Running the e 01a0: 78 74 65 6e 73 69 6f 6e 73 20 69 6e 20 50 4c 54 xtensions in PLT 01b0: 20 28 76 65 72 73 69 6f 6e 20 32 30 32 29 3a 0a (version 202):. 01c0: 3b 20 20 20 3b 20 6c 6f 61 64 20 22 65 78 61 6d ; ; load "exam 01d0: 70 6c 65 73 2e 73 63 6d 22 20 61 73 20 64 65 73 ples.scm" as des 01e0: 63 72 69 62 65 64 20 74 68 65 72 65 0a 3b 20 20 cribed there.; 01f0: 20 28 6c 6f 61 64 20 22 65 78 74 65 6e 73 69 6f (load "extensio 0200: 6e 2e 73 63 6d 22 29 0a 3b 0a 3b 20 52 75 6e 6e n.scm").;.; Runn 0210: 69 6e 67 20 74 68 65 20 65 78 74 65 6e 73 69 6f ing the extensio 0220: 6e 73 20 69 6e 20 53 43 4d 20 28 76 65 72 73 69 ns in SCM (versi 0230: 6f 6e 20 35 64 37 29 3a 0a 3b 20 20 20 3b 20 6c on 5d7):.; ; l 0240: 6f 61 64 20 22 65 78 61 6d 70 6c 65 73 2e 73 63 oad "examples.sc 0250: 6d 22 20 61 73 20 64 65 73 63 72 69 62 65 64 20 m" as described 0260: 74 68 65 72 65 0a 3b 20 20 20 28 6c 6f 61 64 20 there.; (load 0270: 22 65 78 74 65 6e 73 69 6f 6e 2e 73 63 6d 22 29 "extension.scm") 0280: 0a 0a 3b 20 72 65 73 65 74 20 53 52 46 49 0a 0a ..; reset SRFI.. 0290: 28 73 65 74 21 20 3a 2d 64 69 73 70 61 74 63 68 (set! :-dispatch 02a0: 20 28 6d 61 6b 65 2d 69 6e 69 74 69 61 6c 2d 3a (make-initial-: 02b0: 2d 64 69 73 70 61 74 63 68 29 29 0a 0a 28 64 65 -dispatch))..(de 02c0: 66 69 6e 65 20 6d 79 2d 63 68 65 63 6b 2d 63 6f fine my-check-co 02d0: 72 72 65 63 74 20 30 29 0a 28 64 65 66 69 6e 65 rrect 0).(define 02e0: 20 6d 79 2d 63 68 65 63 6b 2d 77 72 6f 6e 67 20 my-check-wrong 02f0: 20 20 30 29 0a 0a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 0)...; ======= 0300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0330: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0340: 3d 3d 3d 0a 3b 20 45 78 74 65 6e 64 69 6e 67 20 ===.; Extending 0350: 74 68 65 20 70 72 65 64 65 66 69 6e 65 64 20 64 the predefined d 0360: 69 73 70 61 74 63 68 69 6e 67 20 67 65 6e 65 72 ispatching gener 0370: 61 74 6f 72 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d ator.; ========= 0380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0390: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 03a0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 03b0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 03c0: 3d 0a 0a 3b 20 65 78 61 6d 70 6c 65 20 66 72 6f =..; example fro 03d0: 6d 20 53 52 46 49 20 64 6f 63 75 6d 65 6e 74 20 m SRFI document 03e0: 28 66 6f 72 20 3a 64 69 73 70 61 74 63 68 29 0a (for :dispatch). 03f0: 0a 28 64 65 66 69 6e 65 20 28 65 78 61 6d 70 6c .(define (exampl 0400: 65 2d 64 69 73 70 61 74 63 68 20 61 72 67 73 29 e-dispatch args) 0410: 0a 20 20 28 63 6f 6e 64 0a 20 20 20 28 28 6e 75 . (cond. ((nu 0420: 6c 6c 3f 20 61 72 67 73 29 0a 20 20 20 20 27 65 ll? args). 'e 0430: 78 61 6d 70 6c 65 20 29 0a 20 20 20 28 28 61 6e xample ). ((an 0440: 64 20 28 3d 20 28 6c 65 6e 67 74 68 20 61 72 67 d (= (length arg 0450: 73 29 20 31 29 20 28 73 79 6d 62 6f 6c 3f 20 28 s) 1) (symbol? ( 0460: 63 61 72 20 61 72 67 73 29 29 20 29 0a 20 20 20 car args)) ). 0470: 20 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f (:generator-pro 0480: 63 20 28 3a 73 74 72 69 6e 67 20 28 73 79 6d 62 c (:string (symb 0490: 6f 6c 2d 3e 73 74 72 69 6e 67 20 28 63 61 72 20 ol->string (car 04a0: 61 72 67 73 29 29 29 29 20 29 0a 20 20 20 28 65 args)))) ). (e 04b0: 6c 73 65 0a 20 20 20 20 23 66 20 29 29 29 0a 0a lse. #f ))).. 04c0: 28 3a 2d 64 69 73 70 61 74 63 68 2d 73 65 74 21 (:-dispatch-set! 04d0: 20 28 64 69 73 70 61 74 63 68 2d 75 6e 69 6f 6e (dispatch-union 04e0: 20 28 3a 2d 64 69 73 70 61 74 63 68 2d 72 65 66 (:-dispatch-ref 04f0: 29 20 65 78 61 6d 70 6c 65 2d 64 69 73 70 61 74 ) example-dispat 0500: 63 68 29 29 0a 0a 3b 20 72 75 6e 20 74 68 65 20 ch))..; run the 0510: 65 78 61 6d 70 6c 65 0a 0a 28 6d 79 2d 63 68 65 example..(my-che 0520: 63 6b 20 28 6c 69 73 74 2d 65 63 20 28 3a 20 63 ck (list-ec (: c 0530: 20 27 61 62 63 29 20 63 29 20 3d 3e 20 27 28 23 'abc) c) => '(# 0540: 5c 61 20 23 5c 62 20 23 5c 63 29 29 0a 0a 0a 3b \a #\b #\c))...; 0550: 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d =============== 0560: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0570: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0580: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0590: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 20 41 64 ===========.; Ad 05a0: 64 69 6e 67 20 61 6e 20 61 70 70 6c 69 63 61 74 ding an applicat 05b0: 69 6f 6e 20 73 70 65 63 69 66 69 63 20 64 69 73 ion specific dis 05c0: 70 61 74 63 68 69 6e 67 20 67 65 6e 65 72 61 74 patching generat 05d0: 6f 72 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d or.; =========== 05e0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 05f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0600: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0610: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a ===============. 0620: 0a 3b 20 65 78 61 6d 70 6c 65 20 66 72 6f 6d 20 .; example from 0630: 53 52 46 49 20 64 6f 63 75 6d 65 6e 74 20 28 66 SRFI document (f 0640: 6f 72 20 3a 64 69 73 70 61 74 63 68 29 0a 0a 28 or :dispatch)..( 0650: 64 65 66 69 6e 65 20 28 3a 6d 79 2d 64 69 73 70 define (:my-disp 0660: 61 74 63 68 20 61 72 67 73 29 0a 20 20 28 63 61 atch args). (ca 0670: 73 65 20 28 6c 65 6e 67 74 68 20 61 72 67 73 29 se (length args) 0680: 0a 20 20 20 20 28 28 30 29 20 27 65 78 61 6d 70 . ((0) 'examp 0690: 6c 65 29 0a 20 20 20 20 28 28 31 29 20 28 6c 65 le). ((1) (le 06a0: 74 20 28 28 61 31 20 28 63 61 72 20 61 72 67 73 t ((a1 (car args 06b0: 29 29 29 0a 20 20 20 20 20 20 20 20 20 20 20 28 ))). ( 06c0: 63 6f 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 cond. 06d0: 20 28 28 6c 69 73 74 3f 20 61 31 29 0a 20 20 20 ((list? a1). 06e0: 20 20 20 20 20 20 20 20 20 20 28 3a 67 65 6e 65 (:gene 06f0: 72 61 74 6f 72 2d 70 72 6f 63 20 28 3a 6c 69 73 rator-proc (:lis 0700: 74 20 61 31 29 29 20 29 0a 20 20 20 20 20 20 20 t a1)) ). 0710: 20 20 20 20 20 28 28 73 74 72 69 6e 67 3f 20 61 ((string? a 0720: 31 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 1). 0730: 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 72 6f 63 (:generator-proc 0740: 20 28 3a 73 74 72 69 6e 67 20 61 31 29 29 20 29 (:string a1)) ) 0750: 0a 3b 20 20 20 20 20 20 20 20 20 20 20 2e 2e 2e .; ... 0760: 6d 6f 72 65 20 75 6e 61 72 79 20 63 61 73 65 73 more unary cases 0770: 2e 2e 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 .... 0780: 28 65 6c 73 65 0a 20 20 20 20 20 20 20 20 20 20 (else. 0790: 20 20 20 23 66 20 29 29 29 29 0a 20 20 20 20 28 #f )))). ( 07a0: 28 32 29 20 28 6c 65 74 20 28 28 61 31 20 28 63 (2) (let ((a1 (c 07b0: 61 72 20 61 72 67 73 29 29 20 28 61 32 20 28 63 ar args)) (a2 (c 07c0: 61 64 72 20 61 72 67 73 29 29 29 0a 20 20 20 20 adr args))). 07d0: 20 20 20 20 20 20 20 28 63 6f 6e 64 0a 20 20 20 (cond. 07e0: 20 20 20 20 20 20 20 20 20 28 28 61 6e 64 20 28 ((and ( 07f0: 6c 69 73 74 3f 20 61 31 29 20 28 6c 69 73 74 3f list? a1) (list? 0800: 20 61 32 29 29 0a 20 20 20 20 20 20 20 20 20 20 a2)). 0810: 20 20 20 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 (:generator-p 0820: 72 6f 63 20 28 3a 6c 69 73 74 20 61 31 20 61 32 roc (:list a1 a2 0830: 29 29 20 29 0a 3b 20 20 20 20 20 20 20 20 20 20 )) ).; 0840: 20 2e 2e 2e 6d 6f 72 65 20 62 69 6e 61 72 79 20 ...more binary 0850: 63 61 73 65 73 2e 2e 2e 0a 20 20 20 20 20 20 20 cases.... 0860: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else. 0870: 20 20 20 20 20 20 20 20 23 66 20 29 29 29 29 0a #f )))). 0880: 3b 20 20 20 2e 2e 2e 6d 6f 72 65 20 61 72 69 74 ; ...more arit 0890: 79 20 63 61 73 65 73 2e 2e 2e 0a 20 20 20 20 28 y cases.... ( 08a0: 65 6c 73 65 0a 20 20 20 20 20 28 63 6f 6e 64 0a else. (cond. 08b0: 20 20 20 20 20 20 28 28 65 76 65 72 79 3f 2d 65 ((every?-e 08c0: 63 20 28 3a 6c 69 73 74 20 61 20 61 72 67 73 29 c (:list a args) 08d0: 20 28 6c 69 73 74 3f 20 61 29 29 0a 20 20 20 20 (list? a)). 08e0: 20 20 20 28 3a 67 65 6e 65 72 61 74 6f 72 2d 70 (:generator-p 08f0: 72 6f 63 20 28 3a 6c 69 73 74 20 28 61 70 70 6c roc (:list (appl 0900: 79 20 61 70 70 65 6e 64 20 61 72 67 73 29 29 29 y append args))) 0910: 20 29 0a 3b 20 20 20 20 20 2e 2e 2e 6d 6f 72 65 ).; ...more 0920: 20 6c 61 72 67 65 20 76 61 72 69 61 62 6c 65 20 large variable 0930: 61 72 69 74 79 20 63 61 73 65 73 2e 2e 2e 0a 20 arity cases.... 0940: 20 20 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 (else. 0950: 20 20 23 66 20 29 29 29 29 29 0a 0a 28 64 65 66 #f )))))..(def 0960: 69 6e 65 2d 73 79 6e 74 61 78 20 3a 6d 79 0a 20 ine-syntax :my. 0970: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 0980: 69 6e 64 65 78 29 0a 20 20 20 20 28 28 3a 6d 79 index). ((:my 0990: 20 63 63 20 76 61 72 20 28 69 6e 64 65 78 20 69 cc var (index i 09a0: 29 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 0a ) arg1 arg ...). 09b0: 20 20 20 20 20 28 3a 64 69 73 70 61 74 63 68 65 (:dispatche 09c0: 64 20 63 63 20 76 61 72 20 28 69 6e 64 65 78 20 d cc var (index 09d0: 69 29 20 3a 6d 79 2d 64 69 73 70 61 74 63 68 20 i) :my-dispatch 09e0: 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 20 29 0a arg1 arg ...) ). 09f0: 20 20 20 20 28 28 3a 6d 79 20 63 63 20 76 61 72 ((:my cc var 0a00: 20 61 72 67 31 20 61 72 67 20 2e 2e 2e 29 0a 20 arg1 arg ...). 0a10: 20 20 20 20 28 3a 64 69 73 70 61 74 63 68 65 64 (:dispatched 0a20: 20 63 63 20 76 61 72 20 3a 6d 79 2d 64 69 73 70 cc var :my-disp 0a30: 61 74 63 68 20 61 72 67 31 20 61 72 67 20 2e 2e atch arg1 arg .. 0a40: 2e 29 20 29 29 29 0a 0a 3b 20 72 75 6e 20 74 68 .) )))..; run th 0a50: 65 20 65 78 61 6d 70 6c 65 0a 0a 28 6d 79 2d 63 e example..(my-c 0a60: 68 65 63 6b 20 28 6c 69 73 74 2d 65 63 20 28 3a heck (list-ec (: 0a70: 6d 79 20 78 20 22 61 62 63 22 29 20 78 29 20 3d my x "abc") x) = 0a80: 3e 20 27 28 23 5c 61 20 23 5c 62 20 23 5c 63 29 > '(#\a #\b #\c) 0a90: 29 0a 0a 28 6d 79 2d 63 68 65 63 6b 20 28 6c 69 )..(my-check (li 0aa0: 73 74 2d 65 63 20 28 3a 6d 79 20 78 20 27 28 31 st-ec (:my x '(1 0ab0: 29 20 27 28 32 29 20 27 28 33 29 29 20 78 29 20 ) '(2) '(3)) x) 0ac0: 3d 3e 20 27 28 31 20 32 20 33 29 29 0a 0a 28 6d => '(1 2 3))..(m 0ad0: 79 2d 63 68 65 63 6b 20 0a 20 20 28 6c 69 73 74 y-check . (list 0ae0: 2d 65 63 20 28 3a 6d 79 20 78 20 28 69 6e 64 65 -ec (:my x (inde 0af0: 78 20 69 29 20 22 61 62 63 22 29 20 28 6c 69 73 x i) "abc") (lis 0b00: 74 20 78 20 69 29 29 20 0a 20 20 3d 3e 20 27 28 t x i)) . => '( 0b10: 28 23 5c 61 20 30 29 20 28 23 5c 62 20 31 29 20 (#\a 0) (#\b 1) 0b20: 28 23 5c 63 20 32 29 29 20 29 0a 0a 0a 3b 20 3d (#\c 2)) )...; = 0b30: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b40: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0b70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 20 41 64 64 69 =========.; Addi 0b80: 6e 67 20 61 6e 20 61 70 70 6c 69 63 61 74 69 6f ng an applicatio 0b90: 6e 20 73 70 65 63 69 66 69 63 20 74 79 70 65 64 n specific typed 0ba0: 20 67 65 6e 65 72 61 74 6f 72 0a 3b 20 3d 3d 3d generator.; === 0bb0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0bc0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0bd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0be0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0bf0: 3d 3d 3d 3d 3d 3d 3d 0a 0a 3b 20 65 78 61 6d 70 =======..; examp 0c00: 6c 65 20 66 72 6f 6d 20 53 52 46 49 20 64 6f 63 le from SRFI doc 0c10: 75 6d 65 6e 74 0a 0a 28 64 65 66 69 6e 65 2d 73 ument..(define-s 0c20: 79 6e 74 61 78 20 3a 6d 79 67 65 6e 0a 20 20 28 yntax :mygen. ( 0c30: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a syntax-rules (). 0c40: 20 20 20 20 28 28 3a 6d 79 67 65 6e 20 63 63 20 ((:mygen cc 0c50: 76 61 72 20 61 72 67 29 0a 20 20 20 20 20 28 3a var arg). (: 0c60: 6c 69 73 74 20 63 63 20 76 61 72 20 28 72 65 76 list cc var (rev 0c70: 65 72 73 65 20 61 72 67 29 29 20 29 29 29 0a 0a erse arg)) ))).. 0c80: 3b 20 72 75 6e 20 74 68 65 20 65 78 61 6d 70 6c ; run the exampl 0c90: 65 0a 0a 28 6d 79 2d 63 68 65 63 6b 20 28 6c 69 e..(my-check (li 0ca0: 73 74 2d 65 63 20 28 3a 6d 79 67 65 6e 20 78 20 st-ec (:mygen x 0cb0: 27 28 31 20 32 20 33 29 29 20 78 29 20 3d 3e 20 '(1 2 3)) x) => 0cc0: 27 28 33 20 32 20 31 29 29 0a 0a 0a 3b 20 3d 3d '(3 2 1))...; == 0cd0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0ce0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0cf0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0d00: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0d10: 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 20 41 64 64 69 6e ========.; Addin 0d20: 67 20 61 70 70 6c 69 63 61 74 69 6f 6e 20 73 70 g application sp 0d30: 65 63 69 66 69 63 20 63 6f 6d 70 72 65 68 65 6e ecific comprehen 0d40: 73 69 6f 6e 73 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d sions.; ======== 0d50: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0d60: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0d70: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0d80: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0d90: 3d 3d 0a 0a 3b 20 65 78 61 6d 70 6c 65 20 66 72 ==..; example fr 0da0: 6f 6d 20 53 52 46 49 20 64 6f 63 75 6d 65 6e 74 om SRFI document 0db0: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax 0dc0: 20 6e 65 77 2d 6c 69 73 74 2d 65 63 0a 20 20 28 new-list-ec. ( 0dd0: 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 0a syntax-rules (). 0de0: 20 20 20 20 28 28 6e 65 77 2d 6c 69 73 74 2d 65 ((new-list-e 0df0: 63 20 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a c etc1 etc ...). 0e00: 20 20 20 20 20 28 72 65 76 65 72 73 65 20 28 66 (reverse (f 0e10: 6f 6c 64 2d 65 63 20 27 28 29 20 65 74 63 31 20 old-ec '() etc1 0e20: 65 74 63 20 2e 2e 2e 20 63 6f 6e 73 29 29 20 29 etc ... cons)) ) 0e30: 29 29 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 ))..(define-synt 0e40: 61 78 20 6e 65 77 2d 6d 69 6e 2d 65 63 0a 20 20 ax new-min-ec. 0e50: 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 29 (syntax-rules () 0e60: 0a 20 20 20 20 28 28 6e 65 77 2d 6d 69 6e 2d 65 . ((new-min-e 0e70: 63 20 65 74 63 31 20 65 74 63 20 2e 2e 2e 29 0a c etc1 etc ...). 0e80: 20 20 20 20 20 28 66 6f 6c 64 33 2d 65 63 20 28 (fold3-ec ( 0e90: 6d 69 6e 29 20 65 74 63 31 20 65 74 63 20 2e 2e min) etc1 etc .. 0ea0: 2e 20 6d 69 6e 20 6d 69 6e 29 20 29 29 29 0a 0a . min min) ))).. 0eb0: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 6e (define-syntax n 0ec0: 65 77 2d 66 6f 6c 64 33 2d 65 63 0a 20 20 28 73 ew-fold3-ec. (s 0ed0: 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 6e 65 73 yntax-rules (nes 0ee0: 74 65 64 29 0a 20 20 20 20 28 28 6e 65 77 2d 66 ted). ((new-f 0ef0: 6f 6c 64 33 2d 65 63 20 78 30 20 28 6e 65 73 74 old3-ec x0 (nest 0f00: 65 64 20 71 31 20 2e 2e 2e 29 20 71 20 65 74 63 ed q1 ...) q etc 0f10: 31 20 65 74 63 32 20 65 74 63 33 20 65 74 63 20 1 etc2 etc3 etc 0f20: 2e 2e 2e 29 0a 20 20 20 20 20 28 6e 65 77 2d 66 ...). (new-f 0f30: 6f 6c 64 33 2d 65 63 20 78 30 20 28 6e 65 73 74 old3-ec x0 (nest 0f40: 65 64 20 71 31 20 2e 2e 2e 20 71 29 20 65 74 63 ed q1 ... q) etc 0f50: 31 20 65 74 63 32 20 65 74 63 33 20 65 74 63 20 1 etc2 etc3 etc 0f60: 2e 2e 2e 29 20 29 0a 20 20 20 20 28 28 6e 65 77 ...) ). ((new 0f70: 2d 66 6f 6c 64 33 2d 65 63 20 78 30 20 71 31 20 -fold3-ec x0 q1 0f80: 71 32 20 65 74 63 31 20 65 74 63 32 20 65 74 63 q2 etc1 etc2 etc 0f90: 33 20 65 74 63 20 2e 2e 2e 29 0a 20 20 20 20 20 3 etc ...). 0fa0: 28 6e 65 77 2d 66 6f 6c 64 33 2d 65 63 20 78 30 (new-fold3-ec x0 0fb0: 20 28 6e 65 73 74 65 64 20 71 31 20 71 32 29 20 (nested q1 q2) 0fc0: 65 74 63 31 20 65 74 63 32 20 65 74 63 33 20 65 etc1 etc2 etc3 e 0fd0: 74 63 20 2e 2e 2e 29 20 29 0a 20 20 20 20 28 28 tc ...) ). (( 0fe0: 6e 65 77 2d 66 6f 6c 64 33 2d 65 63 20 78 30 20 new-fold3-ec x0 0ff0: 65 78 70 72 65 73 73 69 6f 6e 20 66 31 20 66 32 expression f1 f2 1000: 29 0a 20 20 20 20 20 28 6e 65 77 2d 66 6f 6c 64 ). (new-fold 1010: 33 2d 65 63 20 78 30 20 28 6e 65 73 74 65 64 29 3-ec x0 (nested) 1020: 20 65 78 70 72 65 73 73 69 6f 6e 20 66 31 20 66 expression f1 f 1030: 32 29 20 29 0a 0a 20 20 20 20 28 28 6e 65 77 2d 2) ).. ((new- 1040: 66 6f 6c 64 33 2d 65 63 20 78 30 20 71 75 61 6c fold3-ec x0 qual 1050: 69 66 69 65 72 20 65 78 70 72 65 73 73 69 6f 6e ifier expression 1060: 20 66 31 20 66 32 29 0a 20 20 20 20 20 28 6c 65 f1 f2). (le 1070: 74 20 28 28 72 65 73 75 6c 74 20 23 66 29 20 28 t ((result #f) ( 1080: 65 6d 70 74 79 20 23 74 29 29 0a 20 20 20 20 20 empty #t)). 1090: 20 20 28 64 6f 2d 65 63 20 71 75 61 6c 69 66 69 (do-ec qualifi 10a0: 65 72 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 er. 10b0: 20 28 6c 65 74 20 28 28 76 61 6c 75 65 20 65 78 (let ((value ex 10c0: 70 72 65 73 73 69 6f 6e 29 29 20 3b 20 64 6f 6e pression)) ; don 10d0: 27 74 20 64 75 70 6c 69 63 61 74 65 0a 20 20 20 't duplicate. 10e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 69 66 (if 10f0: 20 65 6d 70 74 79 0a 20 20 20 20 20 20 20 20 20 empty. 1100: 20 20 20 20 20 20 20 20 20 20 20 28 62 65 67 69 (begi 1110: 6e 20 28 73 65 74 21 20 72 65 73 75 6c 74 20 28 n (set! result ( 1120: 66 31 20 76 61 6c 75 65 29 29 0a 20 20 20 20 20 f1 value)). 1130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 1140: 20 20 20 20 20 20 28 73 65 74 21 20 65 6d 70 74 (set! empt 1150: 79 20 23 66 29 20 29 0a 20 20 20 20 20 20 20 20 y #f) ). 1160: 20 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 (set 1170: 21 20 72 65 73 75 6c 74 20 28 66 32 20 76 61 6c ! result (f2 val 1180: 75 65 20 72 65 73 75 6c 74 29 29 20 29 29 29 0a ue result)) ))). 1190: 20 20 20 20 20 20 20 28 69 66 20 65 6d 70 74 79 (if empty 11a0: 20 78 30 20 72 65 73 75 6c 74 29 20 29 29 29 29 x0 result) )))) 11b0: 0a 0a 3b 20 72 75 6e 20 74 68 65 20 65 78 61 6d ..; run the exam 11c0: 70 6c 65 0a 0a 28 6d 79 2d 63 68 65 63 6b 20 28 ple..(my-check ( 11d0: 6e 65 77 2d 6c 69 73 74 2d 65 63 20 28 3a 20 69 new-list-ec (: i 11e0: 20 35 29 20 69 29 20 3d 3e 20 27 28 30 20 31 20 5) i) => '(0 1 11f0: 32 20 33 20 34 29 29 0a 0a 28 6d 79 2d 63 68 65 2 3 4))..(my-che 1200: 63 6b 20 28 6e 65 77 2d 6d 69 6e 2d 65 63 20 28 ck (new-min-ec ( 1210: 3a 20 69 20 35 29 20 69 29 20 3d 3e 20 30 29 0a : i 5) i) => 0). 1220: 0a 28 6d 79 2d 63 68 65 63 6b 20 0a 20 28 6c 65 .(my-check . (le 1230: 74 20 28 28 66 31 20 28 6c 61 6d 62 64 61 20 28 t ((f1 (lambda ( 1240: 78 29 20 28 6c 69 73 74 20 27 66 31 20 78 29 29 x) (list 'f1 x)) 1250: 29 0a 20 20 20 20 20 20 20 28 66 32 20 28 6c 61 ). (f2 (la 1260: 6d 62 64 61 20 28 78 20 72 65 73 75 6c 74 29 20 mbda (x result) 1270: 28 6c 69 73 74 20 27 66 32 20 78 20 72 65 73 75 (list 'f2 x resu 1280: 6c 74 29 29 29 20 29 0a 20 20 20 28 6e 65 77 2d lt))) ). (new- 1290: 66 6f 6c 64 33 2d 65 63 20 28 65 72 72 6f 72 20 fold3-ec (error 12a0: 22 62 61 64 22 29 20 28 3a 20 69 20 35 29 20 69 "bad") (: i 5) i 12b0: 20 66 31 20 66 32 29 20 29 0a 20 3d 3e 20 27 28 f1 f2) ). => '( 12c0: 66 32 20 34 20 28 66 32 20 33 20 28 66 32 20 32 f2 4 (f2 3 (f2 2 12d0: 20 28 66 32 20 31 20 28 66 31 20 30 29 29 29 29 (f2 1 (f1 0)))) 12e0: 29 20 29 0a 0a 0a 3b 20 3d 3d 3d 3d 3d 3d 3d 3d ) )...; ======== 12f0: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1300: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1310: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1320: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1330: 3d 3d 0a 3b 20 53 75 6d 6d 61 72 79 0a 3b 20 3d ==.; Summary.; = 1340: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1350: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1360: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1370: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 1380: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 0a 28 62 65 67 69 =========..(begi 1390: 6e 0a 20 20 28 6e 65 77 6c 69 6e 65 29 0a 20 20 n. (newline). 13a0: 28 6e 65 77 6c 69 6e 65 29 0a 20 20 28 64 69 73 (newline). (dis 13b0: 70 6c 61 79 20 22 63 6f 72 72 65 63 74 20 65 78 play "correct ex 13c0: 61 6d 70 6c 65 73 20 3a 20 22 29 0a 20 20 28 64 amples : "). (d 13d0: 69 73 70 6c 61 79 20 6d 79 2d 63 68 65 63 6b 2d isplay my-check- 13e0: 63 6f 72 72 65 63 74 29 0a 20 20 28 6e 65 77 6c correct). (newl 13f0: 69 6e 65 29 0a 20 20 28 64 69 73 70 6c 61 79 20 ine). (display 1400: 22 77 72 6f 6e 67 20 65 78 61 6d 70 6c 65 73 20 "wrong examples 1410: 20 20 3a 20 22 29 0a 20 20 28 64 69 73 70 6c 61 : "). (displa 1420: 79 20 6d 79 2d 63 68 65 63 6b 2d 77 72 6f 6e 67 y my-check-wrong 1430: 29 0a 20 20 28 6e 65 77 6c 69 6e 65 29 0a 20 20 ). (newline). 1440: 28 6e 65 77 6c 69 6e 65 29 20 29 0a 0a (newline) )..