Artifact bd53090b5e1cb91d03ee382a9484cd53512b60ce:

• File srfi/s0/cond-expand.sls — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 1682)

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 30 20 63 6f 6e 64 2d  y (srfi s0 cond-
0150: 65 78 70 61 6e 64 29 0a 20 20 28 65 78 70 6f 72  expand).  (expor
0160: 74 20 0a 20 20 20 20 63 6f 6e 64 2d 65 78 70 61  t .    cond-expa
0170: 6e 64 29 0a 20 20 28 69 6d 70 6f 72 74 0a 20 20  nd).  (import.  
0180: 20 20 28 72 6e 72 73 29 0a 20 20 20 20 28 66 6f    (rnrs).    (fo
0190: 72 20 28 73 72 66 69 20 70 72 69 76 61 74 65 20  r (srfi private 
01a0: 72 65 67 69 73 74 72 79 29 20 65 78 70 61 6e 64  registry) expand
01b0: 29 29 0a 20 20 0a 20 20 28 64 65 66 69 6e 65 2d  )).  .  (define-
01c0: 73 79 6e 74 61 78 20 63 6f 6e 64 2d 65 78 70 61  syntax cond-expa
01d0: 6e 64 0a 20 20 20 20 28 6c 61 6d 62 64 61 20 28  nd.    (lambda (
01e0: 73 74 78 29 0a 20 20 20 20 20 20 28 73 79 6e 74  stx).      (synt
01f0: 61 78 2d 63 61 73 65 20 73 74 78 20 28 61 6e 64  ax-case stx (and
0200: 20 6f 72 20 6e 6f 74 20 65 6c 73 65 29 0a 20 20   or not else).  
0210: 20 20 20 20 20 20 5b 28 5f 29 20 0a 20 20 20 20        [(_) .    
0220: 20 20 20 20 20 28 73 79 6e 74 61 78 2d 76 69 6f       (syntax-vio
0230: 6c 61 74 69 6f 6e 20 23 66 20 22 55 6e 66 75 6c  lation #f "Unful
0240: 66 69 6c 6c 65 64 20 63 6f 6e 64 2d 65 78 70 61  filled cond-expa
0250: 6e 64 22 20 73 74 78 29 5d 0a 20 20 20 20 20 20  nd" stx)].      
0260: 20 20 5b 28 5f 20 28 65 6c 73 65 20 62 6f 64 79    [(_ (else body
0270: 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20 20 20 20   ...)).         
0280: 23 27 28 62 65 67 69 6e 20 62 6f 64 79 20 2e 2e  #'(begin body ..
0290: 2e 29 5d 0a 20 20 20 20 20 20 20 20 5b 28 5f 20  .)].        [(_ 
02a0: 28 28 61 6e 64 29 20 62 6f 64 79 20 2e 2e 2e 29  ((and) body ...)
02b0: 20 6d 6f 72 65 2d 63 6c 61 75 73 65 73 20 2e 2e   more-clauses ..
02c0: 2e 29 0a 20 20 20 20 20 20 20 20 20 23 27 28 62  .).         #'(b
02d0: 65 67 69 6e 20 62 6f 64 79 20 2e 2e 2e 29 5d 0a  egin body ...)].
02e0: 20 20 20 20 20 20 20 20 5b 28 5f 20 28 28 61 6e          [(_ ((an
02f0: 64 20 72 65 71 31 20 72 65 71 32 20 2e 2e 2e 29  d req1 req2 ...)
0300: 20 62 6f 64 79 20 2e 2e 2e 29 20 6d 6f 72 65 2d   body ...) more-
0310: 63 6c 61 75 73 65 73 20 2e 2e 2e 29 0a 20 20 20  clauses ...).   
0320: 20 20 20 20 20 20 23 27 28 63 6f 6e 64 2d 65 78        #'(cond-ex
0330: 70 61 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20  pand.           
0340: 20 28 72 65 71 31 0a 20 20 20 20 20 20 20 20 20   (req1.         
0350: 20 20 20 20 28 63 6f 6e 64 2d 65 78 70 61 6e 64      (cond-expand
0360: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 28  .              (
0370: 28 61 6e 64 20 72 65 71 32 20 2e 2e 2e 29 20 62  (and req2 ...) b
0380: 6f 64 79 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20  ody ...).       
0390: 20 20 20 20 20 20 20 6d 6f 72 65 2d 63 6c 61 75         more-clau
03a0: 73 65 73 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20  ses ...)).      
03b0: 20 20 20 20 20 20 6d 6f 72 65 2d 63 6c 61 75 73        more-claus
03c0: 65 73 20 2e 2e 2e 29 5d 0a 20 20 20 20 20 20 20  es ...)].       
03d0: 20 5b 28 5f 20 28 28 6f 72 29 20 62 6f 64 79 20   [(_ ((or) body 
03e0: 2e 2e 2e 29 20 6d 6f 72 65 2d 63 6c 61 75 73 65  ...) more-clause
03f0: 73 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20 20  s ...).         
0400: 23 27 28 63 6f 6e 64 2d 65 78 70 61 6e 64 20 6d  #'(cond-expand m
0410: 6f 72 65 2d 63 6c 61 75 73 65 73 20 2e 2e 2e 29  ore-clauses ...)
0420: 5d 0a 20 20 20 20 20 20 20 20 5b 28 5f 20 28 28  ].        [(_ ((
0430: 6f 72 20 72 65 71 31 20 72 65 71 32 20 2e 2e 2e  or req1 req2 ...
0440: 29 20 62 6f 64 79 20 2e 2e 2e 29 20 6d 6f 72 65  ) body ...) more
0450: 2d 63 6c 61 75 73 65 73 20 2e 2e 2e 29 0a 20 20  -clauses ...).  
0460: 20 20 20 20 20 20 20 23 27 28 63 6f 6e 64 2d 65         #'(cond-e
0470: 78 70 61 6e 64 0a 20 20 20 20 20 20 20 20 20 20  xpand.          
0480: 20 20 28 72 65 71 31 0a 20 20 20 20 20 20 20 20    (req1.        
0490: 20 20 20 20 20 28 62 65 67 69 6e 20 62 6f 64 79       (begin body
04a0: 20 2e 2e 2e 29 29 0a 20 20 20 20 20 20 20 20 20   ...)).         
04b0: 20 20 20 28 65 6c 73 65 0a 20 20 20 20 20 20 20     (else.       
04c0: 20 20 20 20 20 20 28 63 6f 6e 64 2d 65 78 70 61        (cond-expa
04d0: 6e 64 0a 20 20 20 20 20 20 20 20 20 20 20 20 20  nd.             
04e0: 20 28 28 6f 72 20 72 65 71 32 20 2e 2e 2e 29 20   ((or req2 ...) 
04f0: 62 6f 64 79 20 2e 2e 2e 29 0a 20 20 20 20 20 20  body ...).      
0500: 20 20 20 20 20 20 20 20 6d 6f 72 65 2d 63 6c 61          more-cla
0510: 75 73 65 73 20 2e 2e 2e 29 29 29 5d 0a 20 20 20  uses ...)))].   
0520: 20 20 20 20 20 5b 28 5f 20 28 28 6e 6f 74 20 72       [(_ ((not r
0530: 65 71 29 20 62 6f 64 79 20 2e 2e 2e 29 20 6d 6f  eq) body ...) mo
0540: 72 65 2d 63 6c 61 75 73 65 73 20 2e 2e 2e 29 0a  re-clauses ...).
0550: 20 20 20 20 20 20 20 20 20 23 27 28 63 6f 6e 64           #'(cond
0560: 2d 65 78 70 61 6e 64 0a 20 20 20 20 20 20 20 20  -expand.        
0570: 20 20 20 20 28 72 65 71 0a 20 20 20 20 20 20 20      (req.       
0580: 20 20 20 20 20 20 28 63 6f 6e 64 2d 65 78 70 61        (cond-expa
0590: 6e 64 20 6d 6f 72 65 2d 63 6c 61 75 73 65 73 20  nd more-clauses 
05a0: 2e 2e 2e 29 29 0a 20 20 20 20 20 20 20 20 20 20  ...)).          
05b0: 20 20 28 65 6c 73 65 20 62 6f 64 79 20 2e 2e 2e    (else body ...
05c0: 29 29 5d 0a 20 20 20 20 20 20 20 20 5b 28 5f 20  ))].        [(_ 
05d0: 28 66 65 61 74 75 72 65 2d 69 64 20 62 6f 64 79  (feature-id body
05e0: 20 2e 2e 2e 29 20 6d 6f 72 65 2d 63 6c 61 75 73   ...) more-claus
05f0: 65 73 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 20  es ...).        
0600: 20 28 69 66 20 28 6d 65 6d 62 65 72 20 28 73 79   (if (member (sy
0610: 6e 74 61 78 2d 3e 64 61 74 75 6d 20 23 27 66 65  ntax->datum #'fe
0620: 61 74 75 72 65 2d 69 64 29 20 61 76 61 69 6c 61  ature-id) availa
0630: 62 6c 65 2d 66 65 61 74 75 72 65 73 29 0a 20 20  ble-features).  
0640: 20 20 20 20 20 20 20 20 20 23 27 28 62 65 67 69           #'(begi
0650: 6e 20 62 6f 64 79 20 2e 2e 2e 29 0a 20 20 20 20  n body ...).    
0660: 20 20 20 20 20 20 20 23 27 28 63 6f 6e 64 2d 65         #'(cond-e
0670: 78 70 61 6e 64 20 6d 6f 72 65 2d 63 6c 61 75 73  xpand more-claus
0680: 65 73 20 2e 2e 2e 29 29 5d 29 29 29 0a 20 20 0a  es ...))]))).  .
0690: 29 0a                                            ).