Commit | Line | Data |
---|---|---|
08394899 MS |
1 | ;;;; optargs.scm -- support for optional arguments |
2 | ;;;; | |
3 | ;;;; Copyright (C) 1997, 1998, 1999 Free Software Foundation, Inc. | |
4 | ;;;; | |
5 | ;;;; This program is free software; you can redistribute it and/or modify | |
6 | ;;;; it under the terms of the GNU General Public License as published by | |
7 | ;;;; the Free Software Foundation; either version 2, or (at your option) | |
8 | ;;;; any later version. | |
9 | ;;;; | |
10 | ;;;; This program is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
13 | ;;;; GNU General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU General Public License | |
16 | ;;;; along with this software; see the file COPYING. If not, write to | |
c6e23ea2 JB |
17 | ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330, |
18 | ;;;; Boston, MA 02111-1307 USA | |
08394899 MS |
19 | ;;;; |
20 | ;;;; Contributed by Maciej Stachowiak <mstachow@alum.mit.edu> | |
21 | ||
22 | \f | |
23 | ||
24 | (define-module (ice-9 optargs)) | |
25 | ||
26 | \f | |
27 | ||
28 | ;;; {Optional Arguments} | |
29 | ;;; | |
30 | ;;; The C interface for creating Guile procedures has a very handy | |
31 | ;;; "optional argument" feature. This module attempts to provide | |
32 | ;;; similar functionality for procedures defined in Scheme with | |
33 | ;;; a convenient and attractive syntax. | |
34 | ;;; | |
35 | ;;; exported macros are: | |
36 | ;;; bound? | |
37 | ;;; let-optional | |
38 | ;;; let-optional* | |
39 | ;;; let-keywords | |
40 | ;;; let-keywords* | |
41 | ;;; lambda* | |
42 | ;;; define* | |
43 | ;;; define*-public | |
44 | ;;; defmacro* | |
45 | ;;; defmacro*-public | |
46 | ;;; | |
47 | ;;; | |
48 | ;;; Summary of the lambda* extended parameter list syntax (brackets | |
49 | ;;; are used to indicate grouping only): | |
50 | ;;; | |
dfb49627 MV |
51 | ;;; ext-param-list ::= [identifier]* [#:optional [ext-var-decl]+]? |
52 | ;;; [#:key [ext-var-decl]+ [#:allow-other-keys]?]? | |
53 | ;;; [[#:rest identifier]|[. identifier]]? | |
08394899 MS |
54 | ;;; |
55 | ;;; ext-var-decl ::= identifier | ( identifier expression ) | |
56 | ;;; | |
57 | ;;; The characters `*', `+' and `?' are not to be taken literally; they | |
58 | ;;; mean respectively, zero or more occurences, one or more occurences, | |
59 | ;;; and one or zero occurences. | |
60 | ;;; | |
61 | ||
62 | ||
63 | ||
64 | ;; bound? var | |
65 | ;; Checks if a variable is bound in the current environment. | |
66 | ;; | |
67 | ;; defined? doesn't quite cut it as it stands, since it only | |
68 | ;; cheks bindings in the top-level environment, not those in | |
69 | ;; local scope only. | |
70 | ;; | |
71 | ||
72 | (defmacro-public bound? (var) | |
73 | `(catch 'misc-error | |
74 | (lambda () | |
75 | ,var | |
76 | (not (eq? ,var ,(variable-ref | |
77 | (make-undefined-variable))))) | |
78 | (lambda args #f))) | |
79 | ||
80 | ||
81 | ;; let-optional rest-arg (binding ...) . body | |
82 | ;; let-optional* rest-arg (binding ...) . body | |
83 | ;; macros used to bind optional arguments | |
84 | ;; | |
85 | ;; These two macros give you an optional argument interface that | |
86 | ;; is very "Schemey" and introduces no fancy syntax. They are | |
87 | ;; compatible with the scsh macros of the same name, but are slightly | |
88 | ;; extended. Each of binding may be of one of the forms <var> or | |
89 | ;; (<var> <default-value>). rest-arg should be the rest-argument of | |
90 | ;; the procedures these are used from. The items in rest-arg are | |
91 | ;; sequentially bound to the variable namess are given. When rest-arg | |
92 | ;; runs out, the remaining vars are bound either to the default values | |
93 | ;; or left unbound if no default value was specified. rest-arg remains | |
94 | ;; bound to whatever may have been left of rest-arg. | |
95 | ;; | |
96 | ||
97 | (defmacro-public let-optional (REST-ARG BINDINGS . BODY) | |
98 | (let-optional-template REST-ARG BINDINGS BODY 'let)) | |
99 | ||
100 | (defmacro-public let-optional* (REST-ARG BINDINGS . BODY) | |
101 | (let-optional-template REST-ARG BINDINGS BODY 'let*)) | |
102 | ||
103 | ||
104 | ||
105 | ;; let-keywords rest-arg allow-other-keys? (binding ...) . body | |
106 | ;; let-keywords* rest-arg allow-other-keys? (binding ...) . body | |
107 | ;; macros used to bind keyword arguments | |
108 | ;; | |
109 | ;; These macros pick out keyword arguments from rest-arg, but do not | |
110 | ;; modify it. This is consistent at least with Common Lisp, which | |
111 | ;; duplicates keyword args in the rest arg. More explanation of what | |
112 | ;; keyword arguments in a lambda list look like can be found below in | |
113 | ;; the documentation for lambda*. Bindings can have the same form as | |
114 | ;; for let-optional. If allow-other-keys? is false, an error will be | |
115 | ;; thrown if anything that looks like a keyword argument but does not | |
116 | ;; match a known keyword parameter will result in an error. | |
117 | ;; | |
118 | ||
119 | ||
120 | (defmacro-public let-keywords (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) | |
121 | (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let)) | |
122 | ||
123 | (defmacro-public let-keywords* (REST-ARG ALLOW-OTHER-KEYS? BINDINGS . BODY) | |
124 | (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY 'let*)) | |
125 | ||
126 | ||
127 | ;; some utility procedures for implementing the various let-forms. | |
128 | ||
129 | (define (let-o-k-template REST-ARG BINDINGS BODY let-type proc) | |
130 | (let ((bindings (map (lambda (x) | |
131 | (if (list? x) | |
132 | x | |
133 | (list x (variable-ref | |
134 | (make-undefined-variable))))) | |
135 | BINDINGS))) | |
136 | `(,let-type ,(map proc bindings) ,@BODY))) | |
137 | ||
138 | (define (let-optional-template REST-ARG BINDINGS BODY let-type) | |
139 | (if (null? BINDINGS) | |
140 | `(begin ,@BODY) | |
141 | (let-o-k-template REST-ARG BINDINGS BODY let-type | |
142 | (lambda (optional) | |
143 | `(,(car optional) | |
144 | (cond | |
145 | ((not (null? ,REST-ARG)) | |
146 | (let ((result (car ,REST-ARG))) | |
147 | ,(list 'set! REST-ARG | |
148 | `(cdr ,REST-ARG)) | |
149 | result)) | |
150 | (else | |
151 | ,(cadr optional)))))))) | |
152 | ||
153 | (define (let-keywords-template REST-ARG ALLOW-OTHER-KEYS? BINDINGS BODY let-type) | |
154 | (if (null? BINDINGS) | |
155 | `(begin ,@BODY) | |
156 | (let* ((kb-list-gensym (gensym "kb:G")) | |
157 | (bindfilter (lambda (key) | |
158 | `(,(car key) | |
159 | (cond | |
160 | ((assq ',(car key) ,kb-list-gensym) | |
161 | => cdr) | |
162 | (else | |
163 | ,(cadr key))))))) | |
164 | `(let* ((ra->kbl ,rest-arg->keyword-binding-list) | |
165 | (,kb-list-gensym (ra->kbl ,REST-ARG ',(map | |
166 | (lambda (x) (symbol->keyword (if (pair? x) (car x) x))) | |
167 | BINDINGS) | |
168 | ,ALLOW-OTHER-KEYS?))) | |
169 | ,(let-o-k-template REST-ARG BINDINGS BODY let-type bindfilter))))) | |
170 | ||
171 | ||
172 | (define (rest-arg->keyword-binding-list rest-arg keywords allow-other-keys?) | |
173 | (if (null? rest-arg) | |
174 | () | |
175 | (let loop ((first (car rest-arg)) | |
176 | (rest (cdr rest-arg)) | |
177 | (accum ())) | |
178 | (let ((next (lambda (a) | |
179 | (if (null? (cdr rest)) | |
180 | a | |
181 | (loop (cadr rest) (cddr rest) a))))) | |
182 | (if (keyword? first) | |
183 | (cond | |
184 | ((memq first keywords) | |
185 | (if (null? rest) | |
186 | (error "Keyword argument has no value.") | |
187 | (next (cons (cons (keyword->symbol first) | |
188 | (car rest)) accum)))) | |
189 | ((not allow-other-keys?) | |
190 | (error "Unknown keyword in arguments.")) | |
191 | (else (if (null? rest) | |
192 | accum | |
193 | (next accum)))) | |
194 | (if (null? rest) | |
195 | accum | |
196 | (loop (car rest) (cdr rest) accum))))))) | |
197 | ||
dfb49627 MV |
198 | ;; This is a reader extension to support the (deprecated) use of |
199 | ;; "#&optional" instead of "#:optional" | |
08394899 MS |
200 | |
201 | (read-hash-extend #\& (lambda (c port) | |
202 | (case (read port) | |
dfb49627 MV |
203 | ((optional) #:optional) |
204 | ((key) #:key) | |
205 | ((rest) #:rest) | |
206 | ((allow-other-keys) #:allow-other-keys-value) | |
08394899 MS |
207 | (else (error "Bad #& value."))))) |
208 | ||
209 | ||
210 | ;; lambda* args . body | |
211 | ;; lambda extended for optional and keyword arguments | |
212 | ;; | |
213 | ;; lambda* creates a procedure that takes optional arguments. These | |
214 | ;; are specified by putting them inside brackets at the end of the | |
215 | ;; paramater list, but before any dotted rest argument. For example, | |
dfb49627 | 216 | ;; (lambda* (a b #:optional c d . e) '()) |
08394899 MS |
217 | ;; creates a procedure with fixed arguments a and b, optional arguments c |
218 | ;; and d, and rest argument e. If the optional arguments are omitted | |
219 | ;; in a call, the variables for them are unbound in the procedure. This | |
220 | ;; can be checked with the bound? macro. | |
221 | ;; | |
222 | ;; lambda* can also take keyword arguments. For example, a procedure | |
223 | ;; defined like this: | |
dfb49627 | 224 | ;; (lambda* (#:key xyzzy larch) '()) |
08394899 MS |
225 | ;; can be called with any of the argument lists (#:xyzzy 11) |
226 | ;; (#:larch 13) (#:larch 42 #:xyzzy 19) (). Whichever arguments | |
227 | ;; are given as keywords are bound to values. | |
228 | ;; | |
229 | ;; Optional and keyword arguments can also be given default values | |
230 | ;; which they take on when they are not present in a call, by giving a | |
231 | ;; two-item list in place of an optional argument, for example in: | |
dfb49627 | 232 | ;; (lambda* (foo #:optional (bar 42) #:key (baz 73)) (list foo bar baz)) |
08394899 MS |
233 | ;; foo is a fixed argument, bar is an optional argument with default |
234 | ;; value 42, and baz is a keyword argument with default value 73. | |
235 | ;; Default value expressions are not evaluated unless they are needed | |
236 | ;; and until the procedure is called. | |
237 | ;; | |
238 | ;; lambda* now supports two more special parameter list keywords. | |
239 | ;; | |
240 | ;; lambda*-defined procedures now throw an error by default if a | |
241 | ;; keyword other than one of those specified is found in the actual | |
dfb49627 | 242 | ;; passed arguments. However, specifying #:allow-other-keys |
08394899 MS |
243 | ;; immediately after the kyword argument declarations restores the |
244 | ;; previous behavior of ignoring unknown keywords. lambda* also now | |
245 | ;; guarantees that if the same keyword is passed more than once, the | |
246 | ;; last one passed is the one that takes effect. For example, | |
dfb49627 | 247 | ;; ((lambda* (#:key (heads 0) (tails 0)) (display (list heads tails))) |
08394899 MS |
248 | ;; #:heads 37 #:tails 42 #:heads 99) |
249 | ;; would result in (99 47) being displayed. | |
250 | ;; | |
dfb49627 MV |
251 | ;; #:rest is also now provided as a synonym for the dotted syntax rest |
252 | ;; argument. The argument lists (a . b) and (a #:rest b) are equivalent in | |
08394899 MS |
253 | ;; all respects to lambda*. This is provided for more similarity to DSSSL, |
254 | ;; MIT-Scheme and Kawa among others, as well as for refugees from other | |
255 | ;; Lisp dialects. | |
256 | ||
257 | ||
258 | (defmacro-public lambda* (ARGLIST . BODY) | |
259 | (parse-arglist | |
260 | ARGLIST | |
261 | (lambda (non-optional-args optionals keys aok? rest-arg) | |
262 | ; Check for syntax errors. | |
263 | (if (not (every? symbol? non-optional-args)) | |
264 | (error "Syntax error in fixed argument declaration.")) | |
265 | (if (not (every? ext-decl? optionals)) | |
266 | (error "Syntax error in optional argument declaration.")) | |
267 | (if (not (every? ext-decl? keys)) | |
268 | (error "Syntax error in keyword argument declaration.")) | |
269 | (if (not (or (symbol? rest-arg) (eq? #f rest-arg))) | |
270 | (error "Syntax error in rest argument declaration.")) | |
271 | ;; generate the code. | |
272 | (let ((rest-gensym (or rest-arg (gensym "lambda*:G")))) | |
273 | (if (not (and (null? optionals) (null? keys))) | |
274 | `(lambda (,@non-optional-args . ,rest-gensym) | |
275 | ;; Make sure that if the proc had a docstring, we put it | |
276 | ;; here where it will be visible. | |
277 | ,@(if (and (not (null? BODY)) | |
278 | (string? (car BODY))) | |
279 | (list (car BODY)) | |
280 | '()) | |
281 | (let-optional* | |
282 | ,rest-gensym | |
283 | ,optionals | |
284 | (let-keywords* ,rest-gensym | |
285 | ,aok? | |
286 | ,keys | |
287 | ,@(if (and (not rest-arg) (null? keys)) | |
288 | `((if (not (null? ,rest-gensym)) | |
289 | (error "Too many arguments."))) | |
290 | '()) | |
291 | ,@BODY))) | |
fa5518d1 | 292 | `(lambda (,@non-optional-args . ,(if rest-arg rest-arg '())) |
08394899 MS |
293 | ,@BODY)))))) |
294 | ||
295 | ||
296 | (define (every? pred lst) | |
297 | (or (null? lst) | |
298 | (and (pred (car lst)) | |
299 | (every? pred (cdr lst))))) | |
300 | ||
301 | (define (ext-decl? obj) | |
302 | (or (symbol? obj) | |
303 | (and (list? obj) (= 2 (length obj)) (symbol? (car obj))))) | |
304 | ||
305 | (define (parse-arglist arglist cont) | |
306 | (define (split-list-at val lst cont) | |
307 | (cond | |
308 | ((memq val lst) | |
309 | => (lambda (pos) | |
310 | (if (memq val (cdr pos)) | |
311 | (error (with-output-to-string | |
312 | (lambda () | |
313 | (map display `(,val | |
314 | " specified more than once in argument list."))))) | |
315 | (cont (reverse (cdr (memq val (reverse lst)))) (cdr pos) #t)))) | |
316 | (else (cont lst '() #f)))) | |
317 | (define (parse-opt-and-fixed arglist keys aok? rest cont) | |
318 | (split-list-at | |
dfb49627 | 319 | #:optional arglist |
08394899 MS |
320 | (lambda (before after split?) |
321 | (if (and split? (null? after)) | |
dfb49627 | 322 | (error "#:optional specified but no optional arguments declared.") |
08394899 MS |
323 | (cont before after keys aok? rest))))) |
324 | (define (parse-keys arglist rest cont) | |
325 | (split-list-at | |
dfb49627 | 326 | #:allow-other-keys arglist |
08394899 MS |
327 | (lambda (aok-before aok-after aok-split?) |
328 | (if (and aok-split? (not (null? aok-after))) | |
dfb49627 | 329 | (error "#:allow-other-keys not at end of keyword argument declarations.") |
08394899 | 330 | (split-list-at |
dfb49627 | 331 | #:key aok-before |
08394899 MS |
332 | (lambda (key-before key-after key-split?) |
333 | (cond | |
334 | ((and aok-split? (not key-split?)) | |
dfb49627 | 335 | (error "#:allow-other-keys specified but no keyword arguments declared.")) |
08394899 MS |
336 | (key-split? |
337 | (cond | |
dfb49627 MV |
338 | ((null? key-after) (error "#:key specified but no keyword arguments declared.")) |
339 | ((memq #:optional key-after) (error "#:optional arguments declared after #:key arguments.")) | |
08394899 MS |
340 | (else (parse-opt-and-fixed key-before key-after aok-split? rest cont)))) |
341 | (else (parse-opt-and-fixed arglist '() #f rest cont))))))))) | |
342 | (define (parse-rest arglist cont) | |
343 | (cond | |
fcdd6672 | 344 | ((null? arglist) (cont '() '() '() #f #f)) |
08394899 MS |
345 | ((not (pair? arglist)) (cont '() '() '() #f arglist)) |
346 | ((not (list? arglist)) | |
347 | (let* ((copy (list-copy arglist)) | |
348 | (lp (last-pair copy)) | |
349 | (ra (cdr lp))) | |
350 | (set-cdr! lp '()) | |
dfb49627 MV |
351 | (if (memq #:rest copy) |
352 | (error "Cannot specify both #:rest and dotted rest argument.") | |
08394899 MS |
353 | (parse-keys copy ra cont)))) |
354 | (else (split-list-at | |
dfb49627 | 355 | #:rest arglist |
08394899 MS |
356 | (lambda (before after split?) |
357 | (if split? | |
358 | (case (length after) | |
dfb49627 | 359 | ((0) (error "#:rest not followed by argument.")) |
08394899 | 360 | ((1) (parse-keys before (car after) cont)) |
dfb49627 | 361 | (else (error "#:rest argument must be declared last."))) |
08394899 MS |
362 | (parse-keys before #f cont))))))) |
363 | ||
364 | (parse-rest arglist cont)) | |
365 | ||
366 | ||
367 | ||
368 | ;; define* args . body | |
369 | ;; define*-public args . body | |
370 | ;; define and define-public extended for optional and keyword arguments | |
371 | ;; | |
372 | ;; define* and define*-public support optional arguments with | |
373 | ;; a similar syntax to lambda*. They also support arbitrary-depth | |
374 | ;; currying, just like Guile's define. Some examples: | |
dfb49627 | 375 | ;; (define* (x y #:optional a (z 3) #:key w . u) (display (list y z u))) |
08394899 MS |
376 | ;; defines a procedure x with a fixed argument y, an optional agument |
377 | ;; a, another optional argument z with default value 3, a keyword argument w, | |
378 | ;; and a rest argument u. | |
dfb49627 | 379 | ;; (define-public* ((foo #:optional bar) #:optional baz) '()) |
08394899 MS |
380 | ;; This illustrates currying. A procedure foo is defined, which, |
381 | ;; when called with an optional argument bar, returns a procedure that | |
382 | ;; takes an optional argument baz. | |
383 | ;; | |
dfb49627 | 384 | ;; Of course, define*[-public] also supports #:rest and #:allow-other-keys |
08394899 MS |
385 | ;; in the same way as lambda*. |
386 | ||
387 | (defmacro-public define* (ARGLIST . BODY) | |
388 | (define*-guts 'define ARGLIST BODY)) | |
389 | ||
390 | (defmacro-public define*-public (ARGLIST . BODY) | |
391 | (define*-guts 'define-public ARGLIST BODY)) | |
392 | ||
393 | ;; The guts of define* and define*-public. | |
394 | (define (define*-guts DT ARGLIST BODY) | |
395 | (define (nest-lambda*s arglists) | |
396 | (if (null? arglists) | |
397 | BODY | |
398 | `((lambda* ,(car arglists) ,@(nest-lambda*s (cdr arglists)))))) | |
399 | (define (define*-guts-helper ARGLIST arglists) | |
400 | (let ((first (car ARGLIST)) | |
401 | (al (cons (cdr ARGLIST) arglists))) | |
402 | (if (symbol? first) | |
403 | `(,DT ,first ,@(nest-lambda*s al)) | |
404 | (define*-guts-helper first al)))) | |
405 | (if (symbol? ARGLIST) | |
406 | `(,DT ,ARGLIST ,@BODY) | |
407 | (define*-guts-helper ARGLIST '()))) | |
408 | ||
409 | ||
410 | ||
411 | ;; defmacro* name args . body | |
412 | ;; defmacro*-public args . body | |
413 | ;; defmacro and defmacro-public extended for optional and keyword arguments | |
414 | ;; | |
415 | ;; These are just like defmacro and defmacro-public except that they | |
dfb49627 MV |
416 | ;; take lambda*-style extended paramter lists, where #:optional, |
417 | ;; #:key, #:allow-other-keys and #:rest are allowed with the usual | |
08394899 | 418 | ;; semantics. Here is an example of a macro with an optional argument: |
dfb49627 | 419 | ;; (defmacro* transmorgify (a #:optional b) |
08394899 MS |
420 | |
421 | (defmacro-public defmacro* (NAME ARGLIST . BODY) | |
422 | (defmacro*-guts 'define NAME ARGLIST BODY)) | |
423 | ||
424 | (defmacro-public defmacro*-public (NAME ARGLIST . BODY) | |
425 | (defmacro*-guts 'define-public NAME ARGLIST BODY)) | |
426 | ||
427 | ;; The guts of defmacro* and defmacro*-public | |
428 | (define (defmacro*-guts DT NAME ARGLIST BODY) | |
429 | `(,DT ,NAME | |
430 | (,(lambda (transformer) (defmacro:transformer transformer)) | |
431 | (lambda* ,ARGLIST ,@BODY)))) |