Artifact 70a77029357a472c30c624cb2dc4cfdaaa7a3408:
- File srfi/s26/cut-impl.scm — part of check-in [31d22b4672] at 2016-10-26 16:08:57 on branch trunk — fixed include issue with cut (user: aldo size: 3977)
- File srfi/s26/cut.scm — part of check-in [80c8c83034] at 2016-07-07 18:11:39 on branch trunk — initial import (user: ovenpasta@pizzahack.eu size: 3977)
0000: 3b 20 52 45 46 45 52 45 4e 43 45 20 49 4d 50 4c ; REFERENCE IMPL 0010: 45 4d 45 4e 54 41 54 49 4f 4e 20 46 4f 52 20 53 EMENTATION FOR S 0020: 52 46 49 2d 32 36 20 22 43 55 54 22 0a 3b 20 3d RFI-26 "CUT".; = 0030: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0040: 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d 3d ================ 0050: 3d 3d 3d 3d 3d 3d 3d 3d 3d 0a 3b 0a 3b 20 53 65 =========.;.; Se 0060: 62 61 73 74 69 61 6e 2e 45 67 6e 65 72 40 70 68 bastian.Egner@ph 0070: 69 6c 69 70 73 2e 63 6f 6d 2c 20 35 2d 4a 75 6e ilips.com, 5-Jun 0080: 2d 32 30 30 32 2e 0a 3b 20 61 64 61 70 74 65 64 -2002..; adapted 0090: 20 66 72 6f 6d 20 74 68 65 20 70 6f 73 74 69 6e from the postin 00a0: 67 20 62 79 20 41 6c 20 50 65 74 72 6f 66 73 6b g by Al Petrofsk 00b0: 79 20 3c 61 6c 40 70 65 74 72 6f 66 73 6b 79 2e y <al@petrofsky. 00c0: 6f 72 67 3e 0a 3b 20 70 6c 61 63 65 64 20 69 6e org>.; placed in 00d0: 20 74 68 65 20 70 75 62 6c 69 63 20 64 6f 6d 61 the public doma 00e0: 69 6e 0a 3b 0a 3b 20 54 68 65 20 63 6f 64 65 20 in.;.; The code 00f0: 74 6f 20 68 61 6e 64 6c 65 20 74 68 65 20 76 61 to handle the va 0100: 72 69 61 62 6c 65 20 61 72 67 75 6d 65 6e 74 20 riable argument 0110: 63 61 73 65 20 77 61 73 20 6f 72 69 67 69 6e 61 case was origina 0120: 6c 6c 79 0a 3b 20 70 72 6f 70 6f 73 65 64 20 62 lly.; proposed b 0130: 79 20 4d 69 63 68 61 65 6c 20 53 70 65 72 62 65 y Michael Sperbe 0140: 72 20 61 6e 64 20 68 61 73 20 62 65 65 6e 20 61 r and has been a 0150: 64 61 70 74 65 64 20 74 6f 20 74 68 65 20 6e 65 dapted to the ne 0160: 77 0a 3b 20 73 79 6e 74 61 78 20 6f 66 20 74 68 w.; syntax of th 0170: 65 20 6d 61 63 72 6f 20 75 73 69 6e 67 20 61 6e e macro using an 0180: 20 65 78 70 6c 69 63 69 74 20 72 65 73 74 2d 73 explicit rest-s 0190: 6c 6f 74 20 73 79 6d 62 6f 6c 2e 20 54 68 65 0a lot symbol. The. 01a0: 3b 20 63 6f 64 65 20 74 6f 20 65 76 61 6c 75 61 ; code to evalua 01b0: 74 65 20 74 68 65 20 6e 6f 6e 2d 73 6c 6f 74 73 te the non-slots 01c0: 20 66 6f 72 20 63 75 74 65 20 68 61 73 20 62 65 for cute has be 01d0: 65 6e 20 70 72 6f 70 6f 73 65 64 20 62 79 0a 3b en proposed by.; 01e0: 20 44 61 6c 65 20 4a 6f 72 64 61 6e 2e 20 54 68 Dale Jordan. Th 01f0: 65 20 63 6f 64 65 20 74 6f 20 61 6c 6c 6f 77 20 e code to allow 0200: 61 20 73 6c 6f 74 20 66 6f 72 20 74 68 65 20 70 a slot for the p 0210: 72 6f 63 65 64 75 72 65 20 70 6f 73 69 74 69 6f rocedure positio 0220: 6e 0a 3b 20 61 6e 64 20 74 6f 20 70 72 6f 63 65 n.; and to proce 0230: 73 73 20 74 68 65 20 6d 61 63 72 6f 20 75 73 69 ss the macro usi 0240: 6e 67 20 61 6e 20 69 6e 74 65 72 6e 61 6c 20 6d ng an internal m 0250: 61 63 72 6f 20 69 73 20 62 61 73 65 64 20 6f 6e acro is based on 0260: 20 0a 3b 20 61 20 73 75 67 67 65 73 74 69 6f 6e .; a suggestion 0270: 20 62 79 20 41 6c 20 50 65 74 72 6f 66 73 6b 79 by Al Petrofsky 0280: 2e 20 54 68 65 20 63 6f 64 65 20 66 6f 75 6e 64 . The code found 0290: 20 62 65 6c 6f 77 20 69 73 2c 20 77 69 74 68 0a below is, with. 02a0: 3b 20 65 78 63 65 70 74 69 6f 6e 20 6f 66 20 74 ; exception of t 02b0: 68 69 73 20 68 65 61 64 65 72 20 61 6e 64 20 73 his header and s 02c0: 6f 6d 65 20 63 68 61 6e 67 65 73 20 69 6e 20 76 ome changes in v 02d0: 61 72 69 61 62 6c 65 20 6e 61 6d 65 73 2c 0a 3b ariable names,.; 02e0: 20 65 6e 74 69 72 65 6c 79 20 77 72 69 74 74 65 entirely writte 02f0: 6e 20 62 79 20 41 6c 20 50 65 74 72 6f 66 73 6b n by Al Petrofsk 0300: 79 2e 0a 3b 0a 3b 20 63 6f 6d 70 6c 69 61 6e 63 y..;.; complianc 0310: 65 3a 0a 3b 20 20 20 53 63 68 65 6d 65 20 52 35 e:.; Scheme R5 0320: 52 53 20 28 69 6e 63 6c 75 64 69 6e 67 20 6d 61 RS (including ma 0330: 63 72 6f 73 29 2e 0a 3b 0a 3b 20 6c 6f 61 64 69 cros)..;.; loadi 0340: 6e 67 20 74 68 69 73 20 66 69 6c 65 20 69 6e 74 ng this file int 0350: 6f 20 53 63 68 65 6d 65 20 34 38 20 30 2e 35 37 o Scheme 48 0.57 0360: 3a 0a 3b 20 20 20 2c 6c 6f 61 64 20 63 75 74 2e :.; ,load cut. 0370: 73 63 6d 0a 3b 0a 3b 20 68 69 73 74 6f 72 79 20 scm.;.; history 0380: 6f 66 20 74 68 69 73 20 66 69 6c 65 3a 0a 3b 20 of this file:.; 0390: 20 20 53 45 2c 20 20 36 2d 46 65 62 2d 32 30 30 SE, 6-Feb-200 03a0: 32 3a 20 69 6e 69 74 69 61 6c 20 76 65 72 73 69 2: initial versi 03b0: 6f 6e 20 61 73 20 27 63 75 72 72 79 27 20 77 69 on as 'curry' wi 03c0: 74 68 20 22 2e 20 3c 3e 22 20 6e 6f 74 61 74 69 th ". <>" notati 03d0: 6f 6e 0a 3b 20 20 20 53 45 2c 20 31 34 2d 46 65 on.; SE, 14-Fe 03e0: 62 2d 32 30 30 32 3a 20 72 65 76 69 73 65 64 20 b-2002: revised 03f0: 66 6f 72 20 3c 2e 2e 2e 3e 0a 3b 20 20 20 53 45 for <...>.; SE 0400: 2c 20 32 37 2d 46 65 62 2d 32 30 30 32 3a 20 72 , 27-Feb-2002: r 0410: 65 76 69 73 65 64 20 66 6f 72 20 27 63 75 74 27 evised for 'cut' 0420: 0a 3b 20 20 20 53 45 2c 20 30 33 2d 4a 75 6e 2d .; SE, 03-Jun- 0430: 32 30 30 32 3a 20 72 65 76 69 73 65 64 20 66 6f 2002: revised fo 0440: 72 20 70 72 6f 63 2d 73 6c 6f 74 2c 20 63 75 74 r proc-slot, cut 0450: 65 0a 3b 20 20 20 53 45 2c 20 30 34 2d 4a 75 6e e.; SE, 04-Jun 0460: 2d 32 30 30 32 3a 20 72 65 77 72 69 74 74 65 6e -2002: rewritten 0470: 20 77 69 74 68 20 69 6e 74 65 72 6e 61 6c 20 74 with internal t 0480: 72 61 6e 73 66 6f 72 6d 65 72 20 28 6e 6f 20 22 ransformer (no " 0490: 6c 6f 6f 70 22 20 70 61 74 74 65 72 6e 29 0a 3b loop" pattern).; 04a0: 20 20 20 53 45 2c 20 30 35 2d 4a 75 6e 2d 32 30 SE, 05-Jun-20 04b0: 30 32 3a 20 72 65 70 6c 61 63 65 20 6d 79 20 63 02: replace my c 04c0: 6f 64 65 20 62 79 20 41 6c 27 73 3b 20 73 75 62 ode by Al's; sub 04d0: 73 74 69 74 75 74 65 64 20 22 63 6f 6e 73 74 61 stituted "consta 04e0: 6e 74 22 20 65 74 63 2e 0a 3b 20 20 20 20 20 74 nt" etc..; t 04f0: 6f 20 6d 61 74 63 68 20 74 68 65 20 63 6f 6e 76 o match the conv 0500: 65 6e 74 69 6f 6e 20 69 6e 20 74 68 65 20 53 52 ention in the SR 0510: 46 49 2d 64 6f 63 75 6d 65 6e 74 0a 0a 3b 20 28 FI-document..; ( 0520: 73 72 66 69 2d 32 36 2d 69 6e 74 65 72 6e 61 6c srfi-26-internal 0530: 2d 63 75 74 20 73 6c 6f 74 2d 6e 61 6d 65 73 20 -cut slot-names 0540: 63 6f 6d 62 69 6e 61 74 69 6f 6e 20 2e 20 73 65 combination . se 0550: 29 0a 3b 20 20 20 74 72 61 6e 73 66 6f 72 6d 65 ).; transforme 0560: 72 20 75 73 65 64 20 69 6e 74 65 72 6e 61 6c 6c r used internall 0570: 79 0a 3b 20 20 20 20 20 73 6c 6f 74 2d 6e 61 6d y.; slot-nam 0580: 65 73 20 20 3a 20 74 68 65 20 69 6e 74 65 72 6e es : the intern 0590: 61 6c 20 6e 61 6d 65 73 20 6f 66 20 74 68 65 20 al names of the 05a0: 73 6c 6f 74 73 0a 3b 20 20 20 20 20 63 6f 6d 62 slots.; comb 05b0: 69 6e 61 74 69 6f 6e 20 3a 20 70 72 6f 63 65 64 ination : proced 05c0: 75 72 65 20 62 65 69 6e 67 20 73 70 65 63 69 61 ure being specia 05d0: 6c 69 7a 65 64 2c 20 66 6f 6c 6c 6f 77 65 64 20 lized, followed 05e0: 62 79 20 69 74 73 20 61 72 67 75 6d 65 6e 74 73 by its arguments 05f0: 0a 3b 20 20 20 20 20 73 65 20 20 20 20 20 20 20 .; se 0600: 20 20 20 3a 20 73 6c 6f 74 73 2d 6f 72 2d 65 78 : slots-or-ex 0610: 70 72 73 2c 20 74 68 65 20 71 75 61 6c 69 66 69 prs, the qualifi 0620: 65 72 73 20 6f 66 20 74 68 65 20 6d 61 63 72 6f ers of the macro 0630: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax 0640: 20 73 72 66 69 2d 32 36 2d 69 6e 74 65 72 6e 61 srfi-26-interna 0650: 6c 2d 63 75 74 0a 20 20 28 73 79 6e 74 61 78 2d l-cut. (syntax- 0660: 72 75 6c 65 73 20 28 3c 3e 20 3c 2e 2e 2e 3e 29 rules (<> <...>) 0670: 0a 0a 20 20 20 20 3b 3b 20 63 6f 6e 73 74 72 75 .. ;; constru 0680: 63 74 20 66 69 78 65 64 2d 20 6f 72 20 76 61 72 ct fixed- or var 0690: 69 61 62 6c 65 2d 61 72 69 74 79 20 70 72 6f 63 iable-arity proc 06a0: 65 64 75 72 65 3a 0a 20 20 20 20 3b 3b 20 20 20 edure:. ;; 06b0: 28 62 65 67 69 6e 20 70 72 6f 63 29 20 74 68 72 (begin proc) thr 06c0: 6f 77 73 20 61 6e 20 65 72 72 6f 72 20 69 66 20 ows an error if 06d0: 70 72 6f 63 20 69 73 20 6e 6f 74 20 61 6e 20 3c proc is not an < 06e0: 65 78 70 72 65 73 73 69 6f 6e 3e 0a 20 20 20 20 expression>. 06f0: 28 28 73 72 66 69 2d 32 36 2d 69 6e 74 65 72 6e ((srfi-26-intern 0700: 61 6c 2d 63 75 74 20 28 73 6c 6f 74 2d 6e 61 6d al-cut (slot-nam 0710: 65 20 2e 2e 2e 29 20 28 70 72 6f 63 20 61 72 67 e ...) (proc arg 0720: 20 2e 2e 2e 29 29 0a 20 20 20 20 20 28 6c 61 6d ...)). (lam 0730: 62 64 61 20 28 73 6c 6f 74 2d 6e 61 6d 65 20 2e bda (slot-name . 0740: 2e 2e 29 20 28 28 62 65 67 69 6e 20 70 72 6f 63 ..) ((begin proc 0750: 29 20 61 72 67 20 2e 2e 2e 29 29 29 0a 20 20 20 ) arg ...))). 0760: 20 28 28 73 72 66 69 2d 32 36 2d 69 6e 74 65 72 ((srfi-26-inter 0770: 6e 61 6c 2d 63 75 74 20 28 73 6c 6f 74 2d 6e 61 nal-cut (slot-na 0780: 6d 65 20 2e 2e 2e 29 20 28 70 72 6f 63 20 61 72 me ...) (proc ar 0790: 67 20 2e 2e 2e 29 20 3c 2e 2e 2e 3e 29 0a 20 20 g ...) <...>). 07a0: 20 20 20 28 6c 61 6d 62 64 61 20 28 73 6c 6f 74 (lambda (slot 07b0: 2d 6e 61 6d 65 20 2e 2e 2e 20 2e 20 72 65 73 74 -name ... . rest 07c0: 2d 73 6c 6f 74 29 20 28 61 70 70 6c 79 20 70 72 -slot) (apply pr 07d0: 6f 63 20 61 72 67 20 2e 2e 2e 20 72 65 73 74 2d oc arg ... rest- 07e0: 73 6c 6f 74 29 29 29 0a 0a 20 20 20 20 3b 3b 20 slot))).. ;; 07f0: 70 72 6f 63 65 73 73 20 6f 6e 65 20 73 6c 6f 74 process one slot 0800: 2d 6f 72 2d 65 78 70 72 0a 20 20 20 20 28 28 73 -or-expr. ((s 0810: 72 66 69 2d 32 36 2d 69 6e 74 65 72 6e 61 6c 2d rfi-26-internal- 0820: 63 75 74 20 28 73 6c 6f 74 2d 6e 61 6d 65 20 2e cut (slot-name . 0830: 2e 2e 29 20 20 20 28 70 6f 73 69 74 69 6f 6e 20 ..) (position 0840: 2e 2e 2e 29 20 20 20 20 20 20 3c 3e 20 20 2e 20 ...) <> . 0850: 73 65 29 0a 20 20 20 20 20 28 73 72 66 69 2d 32 se). (srfi-2 0860: 36 2d 69 6e 74 65 72 6e 61 6c 2d 63 75 74 20 28 6-internal-cut ( 0870: 73 6c 6f 74 2d 6e 61 6d 65 20 2e 2e 2e 20 78 29 slot-name ... x) 0880: 20 28 70 6f 73 69 74 69 6f 6e 20 2e 2e 2e 20 78 (position ... x 0890: 29 20 20 20 20 20 20 20 20 2e 20 73 65 29 29 0a ) . se)). 08a0: 20 20 20 20 28 28 73 72 66 69 2d 32 36 2d 69 6e ((srfi-26-in 08b0: 74 65 72 6e 61 6c 2d 63 75 74 20 28 73 6c 6f 74 ternal-cut (slot 08c0: 2d 6e 61 6d 65 20 2e 2e 2e 29 20 20 20 28 70 6f -name ...) (po 08d0: 73 69 74 69 6f 6e 20 2e 2e 2e 29 20 20 20 20 20 sition ...) 08e0: 20 6e 73 65 20 2e 20 73 65 29 0a 20 20 20 20 20 nse . se). 08f0: 28 73 72 66 69 2d 32 36 2d 69 6e 74 65 72 6e 61 (srfi-26-interna 0900: 6c 2d 63 75 74 20 28 73 6c 6f 74 2d 6e 61 6d 65 l-cut (slot-name 0910: 20 2e 2e 2e 29 20 20 20 28 70 6f 73 69 74 69 6f ...) (positio 0920: 6e 20 2e 2e 2e 20 6e 73 65 29 20 20 20 20 20 20 n ... nse) 0930: 2e 20 73 65 29 29 29 29 0a 0a 3b 20 28 73 72 66 . se))))..; (srf 0940: 69 2d 32 36 2d 69 6e 74 65 72 6e 61 6c 2d 63 75 i-26-internal-cu 0950: 74 65 20 73 6c 6f 74 2d 6e 61 6d 65 73 20 6e 73 te slot-names ns 0960: 65 2d 62 69 6e 64 69 6e 67 73 20 63 6f 6d 62 69 e-bindings combi 0970: 6e 61 74 69 6f 6e 20 2e 20 73 65 29 0a 3b 20 20 nation . se).; 0980: 20 74 72 61 6e 73 66 6f 72 6d 65 72 20 75 73 65 transformer use 0990: 64 20 69 6e 74 65 72 6e 61 6c 6c 79 0a 3b 20 20 d internally.; 09a0: 20 20 20 73 6c 6f 74 2d 6e 61 6d 65 73 20 20 20 slot-names 09b0: 20 20 3a 20 74 68 65 20 69 6e 74 65 72 6e 61 6c : the internal 09c0: 20 6e 61 6d 65 73 20 6f 66 20 74 68 65 20 73 6c names of the sl 09d0: 6f 74 73 0a 3b 20 20 20 20 20 6e 73 65 2d 62 69 ots.; nse-bi 09e0: 6e 64 69 6e 67 73 20 20 20 3a 20 6c 65 74 2d 73 ndings : let-s 09f0: 74 79 6c 65 20 62 69 6e 64 69 6e 67 73 20 66 6f tyle bindings fo 0a00: 72 20 74 68 65 20 6e 6f 6e 2d 73 6c 6f 74 20 65 r the non-slot e 0a10: 78 70 72 65 73 73 69 6f 6e 73 2e 0a 3b 20 20 20 xpressions..; 0a20: 20 20 63 6f 6d 62 69 6e 61 74 69 6f 6e 20 20 20 combination 0a30: 20 3a 20 70 72 6f 63 65 64 75 72 65 20 62 65 69 : procedure bei 0a40: 6e 67 20 73 70 65 63 69 61 6c 69 7a 65 64 2c 20 ng specialized, 0a50: 66 6f 6c 6c 6f 77 65 64 20 62 79 20 69 74 73 20 followed by its 0a60: 61 72 67 75 6d 65 6e 74 73 0a 3b 20 20 20 20 20 arguments.; 0a70: 73 65 20 20 20 20 20 20 20 20 20 20 20 20 20 3a se : 0a80: 20 73 6c 6f 74 73 2d 6f 72 2d 65 78 70 72 73 2c slots-or-exprs, 0a90: 20 74 68 65 20 71 75 61 6c 69 66 69 65 72 73 20 the qualifiers 0aa0: 6f 66 20 74 68 65 20 6d 61 63 72 6f 0a 0a 28 64 of the macro..(d 0ab0: 65 66 69 6e 65 2d 73 79 6e 74 61 78 20 73 72 66 efine-syntax srf 0ac0: 69 2d 32 36 2d 69 6e 74 65 72 6e 61 6c 2d 63 75 i-26-internal-cu 0ad0: 74 65 0a 20 20 28 73 79 6e 74 61 78 2d 72 75 6c te. (syntax-rul 0ae0: 65 73 20 28 3c 3e 20 3c 2e 2e 2e 3e 29 0a 0a 20 es (<> <...>).. 0af0: 20 20 20 3b 3b 20 49 66 20 74 68 65 72 65 20 61 ;; If there a 0b00: 72 65 20 6e 6f 20 73 6c 6f 74 2d 6f 72 2d 65 78 re no slot-or-ex 0b10: 70 72 73 20 74 6f 20 70 72 6f 63 65 73 73 2c 20 prs to process, 0b20: 74 68 65 6e 3a 0a 20 20 20 20 3b 3b 20 63 6f 6e then:. ;; con 0b30: 73 74 72 75 63 74 20 61 20 66 69 78 65 64 2d 61 struct a fixed-a 0b40: 72 69 74 79 20 70 72 6f 63 65 64 75 72 65 2c 0a rity procedure,. 0b50: 20 20 20 20 28 28 73 72 66 69 2d 32 36 2d 69 6e ((srfi-26-in 0b60: 74 65 72 6e 61 6c 2d 63 75 74 65 0a 20 20 20 20 ternal-cute. 0b70: 20 20 28 73 6c 6f 74 2d 6e 61 6d 65 20 2e 2e 2e (slot-name ... 0b80: 29 20 6e 73 65 2d 62 69 6e 64 69 6e 67 73 20 28 ) nse-bindings ( 0b90: 70 72 6f 63 20 61 72 67 20 2e 2e 2e 29 29 0a 20 proc arg ...)). 0ba0: 20 20 20 20 28 6c 65 74 20 6e 73 65 2d 62 69 6e (let nse-bin 0bb0: 64 69 6e 67 73 20 28 6c 61 6d 62 64 61 20 28 73 dings (lambda (s 0bc0: 6c 6f 74 2d 6e 61 6d 65 20 2e 2e 2e 29 20 28 70 lot-name ...) (p 0bd0: 72 6f 63 20 61 72 67 20 2e 2e 2e 29 29 29 29 0a roc arg ...)))). 0be0: 20 20 20 20 3b 3b 20 6f 72 20 61 20 76 61 72 69 ;; or a vari 0bf0: 61 62 6c 65 2d 61 72 69 74 79 20 70 72 6f 63 65 able-arity proce 0c00: 64 75 72 65 0a 20 20 20 20 28 28 73 72 66 69 2d dure. ((srfi- 0c10: 32 36 2d 69 6e 74 65 72 6e 61 6c 2d 63 75 74 65 26-internal-cute 0c20: 0a 20 20 20 20 20 20 28 73 6c 6f 74 2d 6e 61 6d . (slot-nam 0c30: 65 20 2e 2e 2e 29 20 6e 73 65 2d 62 69 6e 64 69 e ...) nse-bindi 0c40: 6e 67 73 20 28 70 72 6f 63 20 61 72 67 20 2e 2e ngs (proc arg .. 0c50: 2e 29 20 3c 2e 2e 2e 3e 29 0a 20 20 20 20 20 28 .) <...>). ( 0c60: 6c 65 74 20 6e 73 65 2d 62 69 6e 64 69 6e 67 73 let nse-bindings 0c70: 20 28 6c 61 6d 62 64 61 20 28 73 6c 6f 74 2d 6e (lambda (slot-n 0c80: 61 6d 65 20 2e 2e 2e 20 2e 20 78 29 20 28 61 70 ame ... . x) (ap 0c90: 70 6c 79 20 70 72 6f 63 20 61 72 67 20 2e 2e 2e ply proc arg ... 0ca0: 20 78 29 29 29 29 0a 0a 20 20 20 20 3b 3b 20 6f x)))).. ;; o 0cb0: 74 68 65 72 77 69 73 65 2c 20 70 72 6f 63 65 73 therwise, proces 0cc0: 73 20 6f 6e 65 20 73 6c 6f 74 3a 0a 20 20 20 20 s one slot:. 0cd0: 28 28 73 72 66 69 2d 32 36 2d 69 6e 74 65 72 6e ((srfi-26-intern 0ce0: 61 6c 2d 63 75 74 65 0a 20 20 20 20 20 20 28 73 al-cute. (s 0cf0: 6c 6f 74 2d 6e 61 6d 65 20 2e 2e 2e 29 20 20 20 lot-name ...) 0d00: 20 20 20 20 20 20 6e 73 65 2d 62 69 6e 64 69 6e nse-bindin 0d10: 67 73 20 20 28 70 6f 73 69 74 69 6f 6e 20 2e 2e gs (position .. 0d20: 2e 29 20 20 20 3c 3e 20 20 2e 20 73 65 29 0a 20 .) <> . se). 0d30: 20 20 20 20 28 73 72 66 69 2d 32 36 2d 69 6e 74 (srfi-26-int 0d40: 65 72 6e 61 6c 2d 63 75 74 65 0a 20 20 20 20 20 ernal-cute. 0d50: 20 28 73 6c 6f 74 2d 6e 61 6d 65 20 2e 2e 2e 20 (slot-name ... 0d60: 78 29 20 20 20 20 20 20 20 6e 73 65 2d 62 69 6e x) nse-bin 0d70: 64 69 6e 67 73 20 20 28 70 6f 73 69 74 69 6f 6e dings (position 0d80: 20 2e 2e 2e 20 78 29 20 20 20 20 20 2e 20 73 65 ... x) . se 0d90: 29 29 0a 20 20 20 20 3b 3b 20 6f 72 20 6f 6e 65 )). ;; or one 0da0: 20 6e 6f 6e 2d 73 6c 6f 74 20 65 78 70 72 65 73 non-slot expres 0db0: 73 69 6f 6e 0a 20 20 20 20 28 28 73 72 66 69 2d sion. ((srfi- 0dc0: 32 36 2d 69 6e 74 65 72 6e 61 6c 2d 63 75 74 65 26-internal-cute 0dd0: 0a 20 20 20 20 20 20 73 6c 6f 74 2d 6e 61 6d 65 . slot-name 0de0: 73 20 20 20 20 20 20 20 20 20 20 20 20 20 20 6e s n 0df0: 73 65 2d 62 69 6e 64 69 6e 67 73 20 20 28 70 6f se-bindings (po 0e00: 73 69 74 69 6f 6e 20 2e 2e 2e 29 20 20 20 6e 73 sition ...) ns 0e10: 65 20 2e 20 73 65 29 0a 20 20 20 20 20 28 73 72 e . se). (sr 0e20: 66 69 2d 32 36 2d 69 6e 74 65 72 6e 61 6c 2d 63 fi-26-internal-c 0e30: 75 74 65 0a 20 20 20 20 20 20 73 6c 6f 74 2d 6e ute. slot-n 0e40: 61 6d 65 73 20 28 28 78 20 6e 73 65 29 20 2e 20 ames ((x nse) . 0e50: 6e 73 65 2d 62 69 6e 64 69 6e 67 73 29 20 28 70 nse-bindings) (p 0e60: 6f 73 69 74 69 6f 6e 20 2e 2e 2e 20 78 29 20 20 osition ... x) 0e70: 20 20 20 20 20 2e 20 73 65 29 29 29 29 0a 0a 3b . se))))..; 0e80: 20 65 78 70 6f 72 74 65 64 20 73 79 6e 74 61 78 exported syntax 0e90: 0a 0a 28 64 65 66 69 6e 65 2d 73 79 6e 74 61 78 ..(define-syntax 0ea0: 20 63 75 74 0a 20 20 28 73 79 6e 74 61 78 2d 72 cut. (syntax-r 0eb0: 75 6c 65 73 20 28 29 0a 20 20 20 20 28 28 63 75 ules (). ((cu 0ec0: 74 20 2e 20 73 6c 6f 74 73 2d 6f 72 2d 65 78 70 t . slots-or-exp 0ed0: 72 73 29 0a 20 20 20 20 20 28 73 72 66 69 2d 32 rs). (srfi-2 0ee0: 36 2d 69 6e 74 65 72 6e 61 6c 2d 63 75 74 20 28 6-internal-cut ( 0ef0: 29 20 28 29 20 2e 20 73 6c 6f 74 73 2d 6f 72 2d ) () . slots-or- 0f00: 65 78 70 72 73 29 29 29 29 0a 0a 28 64 65 66 69 exprs))))..(defi 0f10: 6e 65 2d 73 79 6e 74 61 78 20 63 75 74 65 0a 20 ne-syntax cute. 0f20: 20 28 73 79 6e 74 61 78 2d 72 75 6c 65 73 20 28 (syntax-rules ( 0f30: 29 0a 20 20 20 20 28 28 63 75 74 65 20 2e 20 73 ). ((cute . s 0f40: 6c 6f 74 73 2d 6f 72 2d 65 78 70 72 73 29 0a 20 lots-or-exprs). 0f50: 20 20 20 20 28 73 72 66 69 2d 32 36 2d 69 6e 74 (srfi-26-int 0f60: 65 72 6e 61 6c 2d 63 75 74 65 20 28 29 20 28 29 ernal-cute () () 0f70: 20 28 29 20 2e 20 73 6c 6f 74 73 2d 6f 72 2d 65 () . slots-or-e 0f80: 78 70 72 73 29 29 29 29 0a xprs)))).