source: project/release/5/dotted-lambdas/tags/1.1/dotted-lambdas.scm @ 39485

Last change on this file since 39485 was 39485, checked in by juergen, 5 months ago

dotted-lambdas 1.1

File size: 6.8 KB
Line 
1; Copyright (c) 2021 , Juergen Lorenz, ju (at) jugilo (dot) de
2; All rights reserved.
3;
4; Redistribution and use in source and binary forms, with or without
5; modification, are permitted provided that the following conditions are
6; met:
7;
8; Redistributions of source code must retain the above copyright
9; notice, this list of conditions and the following disclaimer.
10;
11; Redistributions in binary form must reproduce the above copyright
12; notice, this list of conditions and the following disclaimer in the
13; documentation and/or other materials provided with the distribution.
14; Neither the name of the author nor the names of its contributors may be
15; used to endorse or promote products derived from this software without
16; specific prior written permission.
17;   
18; THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
19; IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
20; TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
21; PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
22; HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
23; SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
24; TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
25; PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
26; LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
27; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
28; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
29
30
31#|[
32Scheme lambdas allow for variable length argument lists by using a
33dotted list as argument list.
34
35dotted-lambdas use ordinary lists of length at least 2 instead, whose
36last item is one of the symbols .., ... or ....
37
38The meaning of theses symbols, which are legal identifiers, is
39
40* two dots:   the argument to the left references a callable list
41              with zero or one items
42* three dots: the argument to the left references a callable list
43* four dots:  the argument to the left references a nonempty callable list
44
45Using the appropriate dots-type gives you additional control over the
46length of the variable argument lists.
47
48We've used callable lists instead of ordinary lists for ease of use.
49Indeed, (lst 3) is much easyer on the fingers than (list-ref lst 3).
50
51Note, that there is an egg written by Mario, callable-data-structures,
52and one written by me, callable-sequences, which could have been used instead.
53But since we only need list arguments and their values on indexes, the
54only necessary routine, callable, is defined here, so that there are no
55dependencies.
56
57The implementation of the macro is quite simple. I use a not so
58well-known Chicken extension of syntax-rules, which allows to replace
59the ellipsis with another symbol, here !!!. So I can use ..,  ... and
60....  as keywords.
61]|#
62
63(module dotted-lambdas (
64  callable
65  lambda*
66  define*
67  dotted-lambdas
68  )
69
70  (import scheme
71          (only (chicken base) print error case-lambda)
72          )
73
74#|[
75(callable lst)
76--- procedure ---
77makes the list argument, lst, callable, i.e. encapsulates it
78in a procedure of zero or one argument.
79With no argument it returns the encapsulated list and with one argument,
80an index, returns the list's value at that index.
81]|#
82(define (callable lst)
83  (let ((len (length lst)))
84    (case-lambda
85      (() lst)
86      ((k)
87       (list-ref lst k)))))
88
89#|[
90(lambda* (x ... xs ..) xpr . xprs)
91(lambda* (x ... xs ...) xpr . xprs)
92(lambda* (x ... xs ....) xpr . xprs)
93(lambda* (x ...) xpr . xprs)
94--- macro ---
95the first three evaluate to (lambda (x ... . xs) xpr . xprs)
96making xs callable and checking if xs is of length at most 1,
97arbitrary or at least1, respectively.
98The last one evaluates to ordinary (lambda (x ...) xpr . xprs)
99]|#
100(define-syntax lambda*
101  (syntax-rules !!! (.. ... ....)
102    ((_ (x !!! xs ..) xpr . xprs) 
103     (lambda (x !!! . xs)
104       (if (or (null? xs) (null? (cdr xs)))
105         (let ((xs (callable xs))) xpr . xprs)
106         (error 'lambda* "too many arguments for .." xs))))
107    ((_ (x !!! xs ...) xpr . xprs) 
108     (lambda (x !!! . xs)
109       (let ((xs (callable xs)))
110         xpr . xprs)))
111    ((_ (x !!! xs ....) xpr . xprs) 
112     (lambda (x !!! . xs)
113       (if (null? xs)
114         (error 'lambda* "not enough arguments for ...." xs)
115         (let ((xs (callable xs))) xpr . xprs))))
116    ((_ (x !!!) xpr . xprs) ; without dots: normal lambda
117     (lambda (x !!!) xpr . xprs))
118    ))
119
120; Note, that ... as well as .. and .... are legal Scheme identifiers
121
122#|[
123(define* (name x ... xs ..) xpr . xprs)
124(define* (name x ... xs ...) xpr . xprs)
125(define* (name x ... xs ....) xpr . xprs)
126(define* (name x ...) xpr . xprs)
127--- macro ---
128syntactic sugar for, e.g.
129(define name (lambda* (x ... xs ..) xpr . xprs))
130]|#
131(define-syntax define*
132  (syntax-rules !!! (.. ... ....)
133    ((_ (name x !!! xs ..) xpr . xprs) 
134     (define name (lambda* (x !!! xs ..) xpr . xprs)))
135    ((_ (name x !!! xs ...) xpr . xprs) 
136     (define name (lambda* (x !!! xs ...) xpr . xprs)))
137    ((_ (name x !!! xs ....) xpr . xprs) 
138     (define name (lambda* (x !!! xs ....) xpr . xprs)))
139    ((_ (name x !!!) xpr . xprs) 
140     (define name (lambda* (x !!!) xpr . xprs)))
141    ))
142
143#|[
144(dotted-lambdas)
145(dotted-lambdas sym)
146--- procedure ---
147documentation procedure
148]|#
149(define dotted-lambdas
150  (let (
151    (alist '(
152      (callable
153        procedure:
154        (callable lst)
155        "makes the list argument, lst, callable, i.e. encapsulates it"
156        "in a procedure of zero or one argument."
157        "With no argument it returns the encapsulated list and with one argument,"
158        "an index, returns the list's value at that index."
159        )
160      (lambda*
161        macro:
162        (lambda* (x ... xs ..) xpr . xprs)
163        (lambda* (x ... xs ...) xpr . xprs)
164        (lambda* (x ... xs ....) xpr . xprs)
165        (lambda* (x ...) xpr . xprs)
166        "the first three evaluate to (lambda (x ... . xs) xpr . xprs)"
167        "making xs callable and checking if xs is of length at most 1,"
168        "arbitrary or at least1, respectively."
169        "The last one evaluates to ordinary (lambda (x ...) xpr . xprs)"
170        )
171      (define
172        macro:
173        (define* (name x ... xs ..) xpr . xprs)
174        (define* (name x ... xs ...) xpr . xprs)
175        (define* (name x ... xs ....) xpr . xprs)
176        (define* (name x ...) xpr . xprs)
177        (define name (lambda* (x ... xs ..) xpr . xprs))
178        "syntactic sugar for, e.g."
179        )
180      (dotted-lambdas
181        procedure:
182        (dotted-lambdas)
183        (dotted-lambdas sym)
184        "with sym: documentation of exported symbol"
185        "without sym: list of exported symbols"
186        )
187        ))
188      )
189      (case-lambda
190        (() (map car alist))
191        ((sym)
192         (let ((pair (assq sym alist)))
193           (if pair
194             (for-each print (cdr pair))
195             (print "Choose one of " (map car alist))))))))
196)
Note: See TracBrowser for help on using the repository browser.