Artifact feb68b25d4eb4962522a23ad53052b1503f1f9f9:
- File srfi/s61/cond.sls — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 1126)
0000: 3b 3b 20 43 6f 70 79 72 69 67 68 74 20 28 63 29 ;; Copyright (c) 0010: 20 32 30 30 39 20 44 65 72 69 63 6b 20 45 64 64 2009 Derick Edd 0020: 69 6e 67 74 6f 6e 2e 20 20 41 6c 6c 20 72 69 67 ington. All rig 0030: 68 74 73 20 72 65 73 65 72 76 65 64 2e 0a 3b 3b hts reserved..;; 0040: 20 4c 69 63 65 6e 73 65 64 20 75 6e 64 65 72 20 Licensed under 0050: 61 6e 20 4d 49 54 2d 73 74 79 6c 65 20 6c 69 63 an MIT-style lic 0060: 65 6e 73 65 2e 20 20 4d 79 20 6c 69 63 65 6e 73 ense. My licens 0070: 65 20 69 73 20 69 6e 20 74 68 65 20 66 69 6c 65 e is in the file 0080: 0a 3b 3b 20 6e 61 6d 65 64 20 4c 49 43 45 4e 53 .;; named LICENS 0090: 45 20 66 72 6f 6d 20 74 68 65 20 6f 72 69 67 69 E from the origi 00a0: 6e 61 6c 20 63 6f 6c 6c 65 63 74 69 6f 6e 20 74 nal collection t 00b0: 68 69 73 20 66 69 6c 65 20 69 73 20 64 69 73 74 his file is dist 00c0: 72 69 62 75 74 65 64 0a 3b 3b 20 77 69 74 68 2e ributed.;; with. 00d0: 20 20 49 66 20 74 68 69 73 20 66 69 6c 65 20 69 If this file i 00e0: 73 20 72 65 64 69 73 74 72 69 62 75 74 65 64 20 s redistributed 00f0: 77 69 74 68 20 73 6f 6d 65 20 6f 74 68 65 72 20 with some other 0100: 63 6f 6c 6c 65 63 74 69 6f 6e 2c 20 6d 79 0a 3b collection, my.; 0110: 3b 20 6c 69 63 65 6e 73 65 20 6d 75 73 74 20 61 ; license must a 0120: 6c 73 6f 20 62 65 20 69 6e 63 6c 75 64 65 64 2e lso be included. 0130: 0a 0a 23 21 72 36 72 73 0a 28 6c 69 62 72 61 72 ..#!r6rs.(librar 0140: 79 20 28 73 72 66 69 20 73 36 31 20 63 6f 6e 64 y (srfi s61 cond 0150: 29 0a 20 20 28 65 78 70 6f 72 74 0a 20 20 20 20 ). (export. 0160: 28 72 65 6e 61 6d 65 20 28 67 65 6e 65 72 61 6c (rename (general 0170: 2d 63 6f 6e 64 20 63 6f 6e 64 29 29 29 0a 20 20 -cond cond))). 0180: 28 69 6d 70 6f 72 74 0a 20 20 20 20 28 72 6e 72 (import. (rnr 0190: 73 29 29 0a 20 20 0a 20 20 28 64 65 66 69 6e 65 s)). . (define 01a0: 2d 73 79 6e 74 61 78 20 67 65 6e 65 72 61 6c 2d -syntax general- 01b0: 63 6f 6e 64 0a 20 20 20 20 28 6c 61 6d 62 64 61 cond. (lambda 01c0: 20 28 73 74 78 29 0a 20 20 20 20 20 20 28 73 79 (stx). (sy 01d0: 6e 74 61 78 2d 63 61 73 65 20 73 74 78 20 28 29 ntax-case stx () 01e0: 0a 20 20 20 20 20 20 20 20 5b 28 5f 20 63 6c 61 . [(_ cla 01f0: 75 73 65 73 20 2e 2e 2e 29 0a 20 20 20 20 20 20 uses ...). 0200: 20 20 20 28 77 69 74 68 2d 73 79 6e 74 61 78 20 (with-syntax 0210: 28 5b 28 6f 75 72 73 20 2e 2e 2e 29 0a 20 20 20 ([(ours ...). 0220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0230: 20 20 20 20 20 28 6d 61 70 20 28 6c 61 6d 62 64 (map (lambd 0240: 61 20 28 63 29 0a 20 20 20 20 20 20 20 20 20 20 a (c). 0250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0260: 20 20 20 20 20 28 73 79 6e 74 61 78 2d 63 61 73 (syntax-cas 0270: 65 20 63 20 28 3d 3e 29 0a 20 20 20 20 20 20 20 e c (=>). 0280: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0290: 20 20 20 20 20 20 20 20 20 20 5b 28 67 65 6e 65 [(gene 02a0: 72 61 74 6f 72 20 67 75 61 72 64 20 3d 3e 20 72 rator guard => r 02b0: 65 63 65 69 76 65 72 29 0a 20 20 20 20 20 20 20 eceiver). 02c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 02d0: 20 20 20 20 20 20 20 20 20 20 20 23 27 28 28 6c #'((l 02e0: 65 74 2d 76 61 6c 75 65 73 20 28 5b 76 61 6c 73 et-values ([vals 02f0: 20 67 65 6e 65 72 61 74 6f 72 5d 29 0a 20 20 20 generator]). 0300: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0310: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0320: 20 20 20 20 28 61 6e 64 20 28 61 70 70 6c 79 20 (and (apply 0330: 67 75 61 72 64 20 76 61 6c 73 29 0a 20 20 20 20 guard vals). 0340: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0350: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0360: 20 20 20 20 20 20 20 20 76 61 6c 73 29 29 0a 20 vals)). 0370: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0380: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0390: 20 20 20 20 3d 3e 20 28 6c 61 6d 62 64 61 20 28 => (lambda ( 03a0: 76 61 6c 73 29 0a 20 20 20 20 20 20 20 20 20 20 vals). 03b0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 03c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 03d0: 28 61 70 70 6c 79 20 72 65 63 65 69 76 65 72 20 (apply receiver 03e0: 76 61 6c 73 29 29 29 5d 0a 20 20 20 20 20 20 20 vals)))]. 03f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0400: 20 20 20 20 20 20 20 20 20 20 5b 5f 20 63 5d 29 [_ c]) 0410: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 0420: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 23 # 0430: 27 28 63 6c 61 75 73 65 73 20 2e 2e 2e 29 29 5d '(clauses ...))] 0440: 29 0a 20 20 20 20 20 20 20 20 20 20 20 23 27 28 ). #'( 0450: 63 6f 6e 64 20 6f 75 72 73 20 2e 2e 2e 29 29 5d cond ours ...))] 0460: 29 29 29 0a 29 0a ))).).