Commit | Line | Data |
---|---|---|
08394899 MS |
1 | ;;;; optargs.scm -- support for optional arguments |
2 | ;;;; | |
7aec4ce0 | 3 | ;;;; Copyright (C) 1997, 1998, 1999, 2001, 2002, 2004, 2006, 2009, 2010 Free Software Foundation, Inc. |
afab82bc | 4 | ;;;; |
73be1d9e MV |
5 | ;;;; This library is free software; you can redistribute it and/or |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 | 8 | ;;;; version 3 of the License, or (at your option) any later version. |
73be1d9e MV |
9 | ;;;; |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
08394899 | 11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
73be1d9e MV |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
92205699 | 17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA |
a482f2cc | 18 | ;;;; |
08394899 MS |
19 | ;;;; Contributed by Maciej Stachowiak <mstachow@alum.mit.edu> |
20 | ||
21 | \f | |
22 | ||
afab82bc | 23 | ;;; Commentary: |
08394899 MS |
24 | |
25 | ;;; {Optional Arguments} | |
26 | ;;; | |
27 | ;;; The C interface for creating Guile procedures has a very handy | |
28 | ;;; "optional argument" feature. This module attempts to provide | |
29 | ;;; similar functionality for procedures defined in Scheme with | |
30 | ;;; a convenient and attractive syntax. | |
31 | ;;; | |
32 | ;;; exported macros are: | |
08394899 MS |
33 | ;;; let-optional |
34 | ;;; let-optional* | |
35 | ;;; let-keywords | |
36 | ;;; let-keywords* | |
37 | ;;; lambda* | |
38 | ;;; define* | |
afab82bc | 39 | ;;; define*-public |
08394899 MS |
40 | ;;; defmacro* |
41 | ;;; defmacro*-public | |
42 | ;;; | |
43 | ;;; | |
44 | ;;; Summary of the lambda* extended parameter list syntax (brackets | |
45 | ;;; are used to indicate grouping only): | |
46 | ;;; | |
dfb49627 | 47 | ;;; ext-param-list ::= [identifier]* [#:optional [ext-var-decl]+]? |
afab82bc | 48 | ;;; [#:key [ext-var-decl]+ [#:allow-other-keys]?]? |
dfb49627 | 49 | ;;; [[#:rest identifier]|[. identifier]]? |
08394899 | 50 | ;;; |
afab82bc | 51 | ;;; ext-var-decl ::= identifier | ( identifier expression ) |
08394899 MS |
52 | ;;; |
53 | ;;; The characters `*', `+' and `?' are not to be taken literally; they | |
54 | ;;; mean respectively, zero or more occurences, one or more occurences, | |
55 | ;;; and one or zero occurences. | |
56 | ;;; | |
57 | ||
afab82bc | 58 | ;;; Code: |
08394899 | 59 | |
1a179b03 | 60 | (define-module (ice-9 optargs) |
df1cd5e5 | 61 | #:use-module (system base pmatch) |
97bc28b6 | 62 | #:re-export (lambda* define*) |
4d3406a8 AW |
63 | #:export (let-optional |
64 | let-optional* | |
65 | let-keywords | |
66 | let-keywords* | |
4d3406a8 AW |
67 | define*-public |
68 | defmacro* | |
69 | defmacro*-public)) | |
08394899 | 70 | |
08394899 MS |
71 | ;; let-optional rest-arg (binding ...) . body |
72 | ;; let-optional* rest-arg (binding ...) . body | |
73 | ;; macros used to bind optional arguments | |
74 | ;; | |
296ff5e7 MV |
75 | ;; These two macros give you an optional argument interface that is |
76 | ;; very "Schemey" and introduces no fancy syntax. They are compatible | |
77 | ;; with the scsh macros of the same name, but are slightly | |
08394899 MS |
78 | ;; extended. Each of binding may be of one of the forms <var> or |
79 | ;; (<var> <default-value>). rest-arg should be the rest-argument of | |
80 | ;; the procedures these are used from. The items in rest-arg are | |
81 | ;; sequentially bound to the variable namess are given. When rest-arg | |
82 | ;; runs out, the remaining vars are bound either to the default values | |
296ff5e7 | 83 | ;; or to `#f' if no default value was specified. rest-arg remains |
08394899 MS |
84 | ;; bound to whatever may have been left of rest-arg. |
85 | ;; | |
86 | ||
4d3406a8 AW |
87 | (define (vars&inits bindings) |
88 | (let lp ((bindings bindings) (vars '()) (inits '())) | |
89 | (syntax-case bindings () | |
90 | (() | |
91 | (values (reverse vars) (reverse inits))) | |
92 | (((v init) . rest) (identifier? #'v) | |
93 | (lp #'rest (cons #'v vars) (cons #'init inits))) | |
94 | ((v . rest) (identifier? #'v) | |
95 | (lp #'rest (cons #'v vars) (cons #'#f inits)))))) | |
96 | ||
97 | (define-syntax let-optional | |
98 | (lambda (x) | |
99 | (syntax-case x () | |
100 | ((_ rest-arg (binding ...) b0 b1 ...) (identifier? #'rest-arg) | |
101 | (call-with-values (lambda () (vars&inits #'(binding ...))) | |
102 | (lambda (vars inits) | |
103 | (with-syntax ((n (length vars)) | |
104 | (n+1 (1+ (length vars))) | |
105 | (vars (append vars (list #'rest-arg))) | |
106 | ((t ...) (generate-temporaries vars)) | |
107 | ((i ...) inits)) | |
108 | #'(let ((t (lambda vars i)) | |
109 | ...) | |
110 | (apply (lambda vars b0 b1 ...) | |
111 | (or (parse-lambda-case '(0 n n n+1 #f '()) | |
112 | (list t ...) | |
4d3406a8 AW |
113 | rest-arg) |
114 | (error "sth" rest-arg))))))))))) | |
115 | ||
116 | (define-syntax let-optional* | |
117 | (lambda (x) | |
118 | (syntax-case x () | |
119 | ((_ rest-arg (binding ...) b0 b1 ...) (identifier? #'rest-arg) | |
120 | (call-with-values (lambda () (vars&inits #'(binding ...))) | |
121 | (lambda (vars inits) | |
122 | (with-syntax ((n (length vars)) | |
123 | (n+1 (1+ (length vars))) | |
124 | (vars (append vars (list #'rest-arg))) | |
125 | ((i ...) inits)) | |
126 | #'(apply (lambda vars b0 b1 ...) | |
127 | (or (parse-lambda-case '(0 n n n+1 #f '()) | |
128 | (list (lambda vars i) ...) | |
4d3406a8 AW |
129 | rest-arg) |
130 | (error "sth" rest-arg)))))))))) | |
08394899 MS |
131 | |
132 | ||
133 | ;; let-keywords rest-arg allow-other-keys? (binding ...) . body | |
134 | ;; let-keywords* rest-arg allow-other-keys? (binding ...) . body | |
135 | ;; macros used to bind keyword arguments | |
136 | ;; | |
137 | ;; These macros pick out keyword arguments from rest-arg, but do not | |
138 | ;; modify it. This is consistent at least with Common Lisp, which | |
139 | ;; duplicates keyword args in the rest arg. More explanation of what | |
140 | ;; keyword arguments in a lambda list look like can be found below in | |
141 | ;; the documentation for lambda*. Bindings can have the same form as | |
afab82bc | 142 | ;; for let-optional. If allow-other-keys? is false, an error will be |
08394899 MS |
143 | ;; thrown if anything that looks like a keyword argument but does not |
144 | ;; match a known keyword parameter will result in an error. | |
145 | ;; | |
146 | ||
147 | ||
4d3406a8 AW |
148 | (define-syntax let-keywords |
149 | (lambda (x) | |
150 | (syntax-case x () | |
151 | ((_ rest-arg aok (binding ...) b0 b1 ...) (identifier? #'rest-arg) | |
152 | (call-with-values (lambda () (vars&inits #'(binding ...))) | |
153 | (lambda (vars inits) | |
154 | (with-syntax ((n (length vars)) | |
155 | (vars vars) | |
e581ec78 | 156 | (ivars (generate-temporaries vars)) |
4d3406a8 AW |
157 | ((kw ...) (map symbol->keyword |
158 | (map syntax->datum vars))) | |
159 | ((idx ...) (iota (length vars))) | |
160 | ((t ...) (generate-temporaries vars)) | |
161 | ((i ...) inits)) | |
e581ec78 | 162 | #'(let ((t (lambda ivars i)) |
4d3406a8 AW |
163 | ...) |
164 | (apply (lambda vars b0 b1 ...) | |
165 | (or (parse-lambda-case '(0 0 #f n aok ((kw . idx) ...)) | |
166 | (list t ...) | |
4d3406a8 AW |
167 | rest-arg) |
168 | (error "sth" rest-arg)))))))) | |
169 | ((_ rest-arg aok (binding ...) b0 b1 ...) | |
170 | #'(let ((r rest-arg)) | |
171 | (let-keywords r aok (binding ...) b0 b1 ...)))))) | |
172 | ||
173 | (define-syntax let-keywords* | |
174 | (lambda (x) | |
175 | (syntax-case x () | |
176 | ((_ rest-arg aok (binding ...) b0 b1 ...) (identifier? #'rest-arg) | |
177 | (call-with-values (lambda () (vars&inits #'(binding ...))) | |
178 | (lambda (vars inits) | |
179 | (with-syntax ((n (length vars)) | |
180 | (vars vars) | |
181 | ((kw ...) (map symbol->keyword | |
182 | (map syntax->datum vars))) | |
183 | ((idx ...) (iota (length vars))) | |
184 | ((i ...) inits)) | |
185 | #'(apply (lambda vars b0 b1 ...) | |
186 | (or (parse-lambda-case '(0 0 #f n aok ((kw . idx) ...)) | |
187 | (list (lambda vars i) ...) | |
4d3406a8 AW |
188 | rest-arg) |
189 | (error "sth" rest-arg))))))) | |
190 | ((_ rest-arg aok (binding ...) b0 b1 ...) | |
191 | #'(let ((r rest-arg)) | |
192 | (let-keywords* r aok (binding ...) b0 b1 ...)))))) | |
08394899 MS |
193 | |
194 | ;; lambda* args . body | |
195 | ;; lambda extended for optional and keyword arguments | |
afab82bc | 196 | ;; |
08394899 MS |
197 | ;; lambda* creates a procedure that takes optional arguments. These |
198 | ;; are specified by putting them inside brackets at the end of the | |
199 | ;; paramater list, but before any dotted rest argument. For example, | |
dfb49627 | 200 | ;; (lambda* (a b #:optional c d . e) '()) |
08394899 MS |
201 | ;; creates a procedure with fixed arguments a and b, optional arguments c |
202 | ;; and d, and rest argument e. If the optional arguments are omitted | |
296ff5e7 | 203 | ;; in a call, the variables for them are bound to `#f'. |
08394899 MS |
204 | ;; |
205 | ;; lambda* can also take keyword arguments. For example, a procedure | |
206 | ;; defined like this: | |
dfb49627 | 207 | ;; (lambda* (#:key xyzzy larch) '()) |
08394899 MS |
208 | ;; can be called with any of the argument lists (#:xyzzy 11) |
209 | ;; (#:larch 13) (#:larch 42 #:xyzzy 19) (). Whichever arguments | |
210 | ;; are given as keywords are bound to values. | |
211 | ;; | |
212 | ;; Optional and keyword arguments can also be given default values | |
213 | ;; which they take on when they are not present in a call, by giving a | |
214 | ;; two-item list in place of an optional argument, for example in: | |
afab82bc | 215 | ;; (lambda* (foo #:optional (bar 42) #:key (baz 73)) (list foo bar baz)) |
08394899 MS |
216 | ;; foo is a fixed argument, bar is an optional argument with default |
217 | ;; value 42, and baz is a keyword argument with default value 73. | |
218 | ;; Default value expressions are not evaluated unless they are needed | |
afab82bc | 219 | ;; and until the procedure is called. |
08394899 MS |
220 | ;; |
221 | ;; lambda* now supports two more special parameter list keywords. | |
222 | ;; | |
223 | ;; lambda*-defined procedures now throw an error by default if a | |
224 | ;; keyword other than one of those specified is found in the actual | |
dfb49627 | 225 | ;; passed arguments. However, specifying #:allow-other-keys |
b4ad0dda | 226 | ;; immediately after the keyword argument declarations restores the |
08394899 MS |
227 | ;; previous behavior of ignoring unknown keywords. lambda* also now |
228 | ;; guarantees that if the same keyword is passed more than once, the | |
229 | ;; last one passed is the one that takes effect. For example, | |
dfb49627 | 230 | ;; ((lambda* (#:key (heads 0) (tails 0)) (display (list heads tails))) |
08394899 MS |
231 | ;; #:heads 37 #:tails 42 #:heads 99) |
232 | ;; would result in (99 47) being displayed. | |
233 | ;; | |
dfb49627 MV |
234 | ;; #:rest is also now provided as a synonym for the dotted syntax rest |
235 | ;; argument. The argument lists (a . b) and (a #:rest b) are equivalent in | |
08394899 MS |
236 | ;; all respects to lambda*. This is provided for more similarity to DSSSL, |
237 | ;; MIT-Scheme and Kawa among others, as well as for refugees from other | |
238 | ;; Lisp dialects. | |
239 | ||
240 | ||
08394899 MS |
241 | ;; define* args . body |
242 | ;; define*-public args . body | |
243 | ;; define and define-public extended for optional and keyword arguments | |
244 | ;; | |
245 | ;; define* and define*-public support optional arguments with | |
4d3406a8 | 246 | ;; a similar syntax to lambda*. Some examples: |
dfb49627 | 247 | ;; (define* (x y #:optional a (z 3) #:key w . u) (display (list y z u))) |
08394899 MS |
248 | ;; defines a procedure x with a fixed argument y, an optional agument |
249 | ;; a, another optional argument z with default value 3, a keyword argument w, | |
250 | ;; and a rest argument u. | |
08394899 | 251 | ;; |
dfb49627 | 252 | ;; Of course, define*[-public] also supports #:rest and #:allow-other-keys |
08394899 MS |
253 | ;; in the same way as lambda*. |
254 | ||
4d3406a8 | 255 | (define-syntax define*-public |
7aec4ce0 AW |
256 | (lambda (x) |
257 | (syntax-case x () | |
258 | ((_ (id . args) b0 b1 ...) | |
259 | #'(define-public id (lambda* args b0 b1 ...))) | |
260 | ((_ id val) (identifier? #'id) | |
261 | #'(define-public id val))))) | |
08394899 MS |
262 | |
263 | ||
264 | ;; defmacro* name args . body | |
265 | ;; defmacro*-public args . body | |
266 | ;; defmacro and defmacro-public extended for optional and keyword arguments | |
afab82bc | 267 | ;; |
08394899 | 268 | ;; These are just like defmacro and defmacro-public except that they |
dfb49627 MV |
269 | ;; take lambda*-style extended paramter lists, where #:optional, |
270 | ;; #:key, #:allow-other-keys and #:rest are allowed with the usual | |
08394899 | 271 | ;; semantics. Here is an example of a macro with an optional argument: |
dfb49627 | 272 | ;; (defmacro* transmorgify (a #:optional b) |
08394899 | 273 | |
4d3406a8 | 274 | (define-syntax defmacro* |
aac006dd AW |
275 | (lambda (x) |
276 | (syntax-case x () | |
277 | ((_ id args doc b0 b1 ...) (string? (syntax->datum #'doc)) | |
278 | #'(define-macro id doc (lambda* args b0 b1 ...))) | |
279 | ((_ id args b0 b1 ...) | |
280 | #'(define-macro id #f (lambda* args b0 b1 ...)))))) | |
4d3406a8 AW |
281 | (define-syntax defmacro*-public |
282 | (syntax-rules () | |
aac006dd | 283 | ((_ id args b0 b1 ...) |
4d3406a8 | 284 | (begin |
aac006dd | 285 | (defmacro* id args b0 b1 ...) |
4d3406a8 | 286 | (export-syntax id))))) |
afab82bc | 287 | |
df1cd5e5 AW |
288 | ;;; Support for optional & keyword args with the interpreter. |
289 | (define *uninitialized* (list 'uninitialized)) | |
1e2a8edb | 290 | (define (parse-lambda-case spec inits args) |
df1cd5e5 AW |
291 | (pmatch spec |
292 | ((,nreq ,nopt ,rest-idx ,nargs ,allow-other-keys? ,kw-indices) | |
293 | (define (req args prev tail n) | |
294 | (cond | |
295 | ((zero? n) | |
296 | (if prev (set-cdr! prev '())) | |
297 | (let ((slots-tail (make-list (- nargs nreq) *uninitialized*))) | |
298 | (opt (if prev (append! args slots-tail) slots-tail) | |
299 | slots-tail tail nopt inits))) | |
300 | ((null? tail) | |
301 | #f) ;; fail | |
302 | (else | |
303 | (req args tail (cdr tail) (1- n))))) | |
304 | (define (opt slots slots-tail args-tail n inits) | |
305 | (cond | |
306 | ((zero? n) | |
307 | (rest-or-key slots slots-tail args-tail inits rest-idx)) | |
308 | ((null? args-tail) | |
309 | (set-car! slots-tail (apply (car inits) slots)) | |
310 | (opt slots (cdr slots-tail) '() (1- n) (cdr inits))) | |
311 | (else | |
312 | (set-car! slots-tail (car args-tail)) | |
313 | (opt slots (cdr slots-tail) (cdr args-tail) (1- n) (cdr inits))))) | |
314 | (define (rest-or-key slots slots-tail args-tail inits rest-idx) | |
315 | (cond | |
316 | (rest-idx | |
317 | ;; it has to be this way, vars are allocated in this order | |
318 | (set-car! slots-tail args-tail) | |
319 | (if (pair? kw-indices) | |
ff74e44e | 320 | (permissive-keys slots (cdr slots-tail) args-tail inits) |
df1cd5e5 AW |
321 | (rest-or-key slots (cdr slots-tail) '() inits #f))) |
322 | ((pair? kw-indices) | |
323 | ;; fail early here, because once we're in keyword land we throw | |
324 | ;; errors instead of failing | |
325 | (and (or (null? args-tail) rest-idx (keyword? (car args-tail))) | |
326 | (key slots slots-tail args-tail inits))) | |
327 | ((pair? args-tail) | |
328 | #f) ;; fail | |
329 | (else | |
1e2a8edb | 330 | slots))) |
ff74e44e AW |
331 | (define (permissive-keys slots slots-tail args-tail inits) |
332 | (cond | |
333 | ((null? args-tail) | |
334 | (if (null? inits) | |
335 | slots | |
336 | (begin | |
337 | (if (eq? (car slots-tail) *uninitialized*) | |
338 | (set-car! slots-tail (apply (car inits) slots))) | |
339 | (permissive-keys slots (cdr slots-tail) '() (cdr inits))))) | |
340 | ((not (keyword? (car args-tail))) | |
341 | (permissive-keys slots slots-tail (cdr args-tail) inits)) | |
342 | ((and (keyword? (car args-tail)) | |
343 | (pair? (cdr args-tail)) | |
344 | (assq-ref kw-indices (car args-tail))) | |
345 | => (lambda (i) | |
346 | (list-set! slots i (cadr args-tail)) | |
347 | (permissive-keys slots slots-tail (cddr args-tail) inits))) | |
348 | ((and (keyword? (car args-tail)) | |
349 | (pair? (cdr args-tail)) | |
350 | allow-other-keys?) | |
351 | (permissive-keys slots slots-tail (cddr args-tail) inits)) | |
f6a8e791 AW |
352 | (else (scm-error 'keyword-argument-error #f "Unrecognized keyword" |
353 | '() args-tail)))) | |
df1cd5e5 AW |
354 | (define (key slots slots-tail args-tail inits) |
355 | (cond | |
356 | ((null? args-tail) | |
357 | (if (null? inits) | |
1e2a8edb | 358 | slots |
df1cd5e5 AW |
359 | (begin |
360 | (if (eq? (car slots-tail) *uninitialized*) | |
361 | (set-car! slots-tail (apply (car inits) slots))) | |
362 | (key slots (cdr slots-tail) '() (cdr inits))))) | |
363 | ((not (keyword? (car args-tail))) | |
364 | (if rest-idx | |
365 | ;; no error checking, everything goes to the rest.. | |
366 | (key slots slots-tail '() inits) | |
f6a8e791 AW |
367 | (scm-error 'keyword-argument-error #f "Invalid keyword" |
368 | '() args-tail))) | |
df1cd5e5 AW |
369 | ((and (keyword? (car args-tail)) |
370 | (pair? (cdr args-tail)) | |
371 | (assq-ref kw-indices (car args-tail))) | |
372 | => (lambda (i) | |
373 | (list-set! slots i (cadr args-tail)) | |
374 | (key slots slots-tail (cddr args-tail) inits))) | |
375 | ((and (keyword? (car args-tail)) | |
376 | (pair? (cdr args-tail)) | |
377 | allow-other-keys?) | |
378 | (key slots slots-tail (cddr args-tail) inits)) | |
f6a8e791 AW |
379 | (else (scm-error 'keyword-argument-error #f "Unrecognized keyword" |
380 | '() args-tail)))) | |
df1cd5e5 AW |
381 | (let ((args (list-copy args))) |
382 | (req args #f args nreq))) | |
383 | (else (error "unexpected spec" spec)))) |