Artifact bae520fc7195bc40dcd7096dd91f41933500652b:
- File srfi/s39/parameters.sls — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 1598)
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 3b 3b 20 46 61 6c 6c 2d 62 61 63 6b 20 6c ..;; Fall-back l 0140: 69 62 72 61 72 79 20 69 6e 20 63 61 73 65 20 74 ibrary in case t 0150: 68 65 20 68 6f 73 74 20 53 63 68 65 6d 65 20 73 he host Scheme s 0160: 79 73 74 65 6d 20 64 6f 65 73 20 6e 6f 74 20 70 ystem does not p 0170: 72 6f 76 69 64 65 20 53 52 46 49 2d 33 39 2e 0a rovide SRFI-39.. 0180: 0a 23 21 72 36 72 73 0a 28 6c 69 62 72 61 72 79 .#!r6rs.(library 0190: 20 28 73 72 66 69 20 73 33 39 20 70 61 72 61 6d (srfi s39 param 01a0: 65 74 65 72 73 29 0a 20 20 28 65 78 70 6f 72 74 eters). (export 01b0: 0a 20 20 20 20 6d 61 6b 65 2d 70 61 72 61 6d 65 . make-parame 01c0: 74 65 72 20 0a 20 20 20 20 70 61 72 61 6d 65 74 ter . paramet 01d0: 65 72 69 7a 65 29 0a 20 20 28 69 6d 70 6f 72 74 erize). (import 01e0: 0a 20 20 20 20 28 72 6e 72 73 29 29 0a 0a 20 20 . (rnrs)).. 01f0: 28 64 65 66 69 6e 65 20 6d 61 6b 65 2d 70 61 72 (define make-par 0200: 61 6d 65 74 65 72 0a 20 20 20 20 28 63 61 73 65 ameter. (case 0210: 2d 6c 61 6d 62 64 61 0a 20 20 20 20 20 20 5b 28 -lambda. [( 0220: 76 61 6c 29 20 28 6d 61 6b 65 2d 70 61 72 61 6d val) (make-param 0230: 65 74 65 72 20 76 61 6c 20 76 61 6c 75 65 73 29 eter val values) 0240: 5d 0a 20 20 20 20 20 20 5b 28 76 61 6c 20 67 75 ]. [(val gu 0250: 61 72 64 29 0a 20 20 20 20 20 20 20 28 75 6e 6c ard). (unl 0260: 65 73 73 20 28 70 72 6f 63 65 64 75 72 65 3f 20 ess (procedure? 0270: 67 75 61 72 64 29 0a 20 20 20 20 20 20 20 20 20 guard). 0280: 28 61 73 73 65 72 74 69 6f 6e 2d 76 69 6f 6c 61 (assertion-viola 0290: 74 69 6f 6e 20 27 6d 61 6b 65 2d 70 61 72 61 6d tion 'make-param 02a0: 65 74 65 72 20 22 6e 6f 74 20 61 20 70 72 6f 63 eter "not a proc 02b0: 65 64 75 72 65 22 20 67 75 61 72 64 29 29 0a 20 edure" guard)). 02c0: 20 20 20 20 20 20 28 6c 65 74 20 28 5b 70 20 28 (let ([p ( 02d0: 63 61 73 65 2d 6c 61 6d 62 64 61 0a 20 20 20 20 case-lambda. 02e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 28 [( 02f0: 29 20 76 61 6c 5d 0a 20 20 20 20 20 20 20 20 20 ) val]. 0300: 20 20 20 20 20 20 20 20 20 5b 28 78 29 20 28 73 [(x) (s 0310: 65 74 21 20 76 61 6c 20 28 67 75 61 72 64 20 78 et! val (guard x 0320: 29 29 5d 29 5d 29 0a 20 20 20 20 20 20 20 20 20 ))])]). 0330: 28 70 20 76 61 6c 29 0a 20 20 20 20 20 20 20 20 (p val). 0340: 20 70 29 5d 29 29 0a 20 20 20 20 20 20 0a 20 20 p)])). . 0350: 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 70 (define-syntax p 0360: 61 72 61 6d 65 74 65 72 69 7a 65 0a 20 20 20 20 arameterize. 0370: 3b 3b 20 44 65 72 69 76 65 64 20 66 72 6f 6d 20 ;; Derived from 0380: 49 6b 61 72 75 73 27 73 20 69 6d 70 6c 65 6d 65 Ikarus's impleme 0390: 6e 74 61 74 69 6f 6e 20 6f 66 20 70 61 72 61 6d ntation of param 03a0: 65 74 65 72 69 7a 65 2e 0a 20 20 20 20 28 6c 61 eterize.. (la 03b0: 6d 62 64 61 20 28 73 74 78 29 0a 20 20 20 20 20 mbda (stx). 03c0: 20 28 73 79 6e 74 61 78 2d 63 61 73 65 20 73 74 (syntax-case st 03d0: 78 20 28 29 0a 20 20 20 20 20 20 20 20 5b 28 5f x (). [(_ 03e0: 20 28 29 20 62 30 20 62 20 2e 2e 2e 29 0a 20 20 () b0 b ...). 03f0: 20 20 20 20 20 20 20 23 27 28 6c 65 74 20 28 29 #'(let () 0400: 20 62 30 20 62 20 2e 2e 2e 29 5d 0a 20 20 20 20 b0 b ...)]. 0410: 20 20 20 20 5b 28 5f 20 28 5b 70 20 65 5d 20 2e [(_ ([p e] . 0420: 2e 2e 29 20 62 30 20 62 20 2e 2e 2e 29 0a 20 20 ..) b0 b ...). 0430: 20 20 20 20 20 20 20 28 77 69 74 68 2d 73 79 6e (with-syn 0440: 74 61 78 20 28 5b 28 74 70 20 2e 2e 2e 29 20 28 tax ([(tp ...) ( 0450: 67 65 6e 65 72 61 74 65 2d 74 65 6d 70 6f 72 61 generate-tempora 0460: 72 69 65 73 20 23 27 28 70 20 2e 2e 2e 29 29 5d ries #'(p ...))] 0470: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 . 0480: 20 20 20 20 20 20 20 20 5b 28 74 65 20 2e 2e 2e [(te ... 0490: 29 20 28 67 65 6e 65 72 61 74 65 2d 74 65 6d 70 ) (generate-temp 04a0: 6f 72 61 72 69 65 73 20 23 27 28 65 20 2e 2e 2e oraries #'(e ... 04b0: 29 29 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 ))]). 04c0: 23 27 28 6c 65 74 20 28 5b 74 70 20 70 5d 20 2e #'(let ([tp p] . 04d0: 2e 2e 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 ... 04e0: 20 20 20 20 20 20 5b 74 65 20 65 5d 20 2e 2e 2e [te e] ... 04f0: 29 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 ). 0500: 20 28 6c 65 74 20 28 5b 73 77 61 70 20 28 6c 61 (let ([swap (la 0510: 6d 62 64 61 20 28 29 0a 20 20 20 20 20 20 20 20 mbda (). 0520: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0530: 20 20 20 20 20 28 6c 65 74 20 28 5b 74 20 28 74 (let ([t (t 0540: 70 29 5d 29 0a 20 20 20 20 20 20 20 20 20 20 20 p)]). 0550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0560: 20 20 20 20 28 74 70 20 74 65 29 0a 20 20 20 20 (tp te). 0570: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 0580: 20 20 20 20 20 20 20 20 20 20 20 28 73 65 74 21 (set! 0590: 20 74 65 20 74 29 29 0a 20 20 20 20 20 20 20 20 te t)). 05a0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 05b0: 20 20 20 20 20 2e 2e 2e 29 5d 29 0a 20 20 20 20 ...)]). 05c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 28 64 79 (dy 05d0: 6e 61 6d 69 63 2d 77 69 6e 64 0a 20 20 20 20 20 namic-wind. 05e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 73 77 61 swa 05f0: 70 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 p. 0600: 20 20 20 20 28 6c 61 6d 62 64 61 20 28 29 20 62 (lambda () b 0610: 30 20 62 20 2e 2e 2e 29 0a 20 20 20 20 20 20 20 0 b ...). 0620: 20 20 20 20 20 20 20 20 20 20 20 73 77 61 70 29 swap) 0630: 29 29 29 5d 29 29 29 20 20 0a 0a 29 0a 0a )))]))) ..)..