suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

When both optionals and keywords are used, the first keyword marks the end

Browse Source 
of the optionals.

svn: r2322
This commit is contained in:
Eli Barzilay 2006-02-27 04:42:27 +00:00
parent d9e3e1e267
commit 70d2fa327d
2 changed files with 45 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
collects/mzlib/kw.ss
View File

@ -384,10 +384,30 @@
[body (make-keys-body expr)])
(syntax/loc stx (lambda vars body)))]
;; both opts and keys => combine the above two
;; (the problem with this is that things that follow the required
;; arguments are always taken as optionals, even if they're keywords, so
;; the following piece of code is used.)
#;
[else
(let ([clauses (make-opt-clauses (make-keys-body expr) rest*)])
(with-syntax ([name name] [clauses clauses])
(syntax/loc stx (letrec ([name (case-lambda . clauses)]) name))))]))
(syntax/loc stx (letrec ([name (case-lambda . clauses)]) name))))]
;; both opts and keys => pop optionals as long as they're not keywords
[else
(with-syntax
([rest rest*]
[vars (append! vars rest*)]
[body (make-keys-body expr)]
[((optvar optexpr) ...)
(apply append
(map (lambda (opt)
(with-syntax ([(ovar odef) opt] [rest rest*])
(list #'[otmp (if (null? rest)
#t (keyword? (car rest)))]
#'[ovar (if otmp odef (car rest))]
#'[rest (if otmp rest (cdr rest))])))
opts))])
(syntax/loc stx (lambda vars (let* ([optvar optexpr] ...) body))))]))
(syntax-case stx ()
[(_ formals expr0 expr ...)
(generate-body #'formals #'(let () expr0 expr ...))]))

28
collects/tests/mzscheme/kw.ss
View File

@ -227,14 +227,34 @@
;; optionals and keys
(let ([f (lambda/kw (#:optional a b #:key c d) (list a b c d))])
;; the parts that are commented out are relying on the old (CL-like)
;; behavior of always treating the first arguments as optionals. Now a
;; keyword marks the end of the optionals.
(t '(#f #f #f #f) <= (f)
'(1 #f #f #f) <= (f 1)
'(1 2 #f #f) <= (f 1 2)
'(#:c #:d #f #f) <= (f #:c #:d)
'(#:c 1 #f #f) <= (f #:c 1)
;; '(#:c #:d #f #f) <= (f #:c #:d)
;; '(#:c 1 #f #f) <= (f #:c 1)
'(1 2 #:d #f) <= (f 1 2 #:c #:d)
'(#:c #:d #:d #f) <= (f #:c #:d #:c #:d)
'(#:c 1 #:d #f) <= (f #:c 1 #:c #:d)))
;; '(#:c #:d #:d #f) <= (f #:c #:d #:c #:d)
;; '(#:c 1 #:d #f) <= (f #:c 1 #:c #:d)
;; Test new behavior on the commented expressions that are valid
'(#f #f #:d #f) <= (f #:c #:d)
'(#f #f 1 #f) <= (f #:c 1)
;; Now test the new behavior
'(#f #f #f 2) <= (f #:d 2)
'(1 #f #f 2) <= (f 1 #:d 2)
'(1 2 #f 2) <= (f 1 2 #:d 2)
'(1 #f #f 2) <= (f 1 #f #:d 2)))
(let ([f (lambda/kw (x #:optional a b #:key c d) (list x a b c d))])
;; also test that the required argument is still working fine
(t '(0 #f #f #f 2) <= (f 0 #:d 2)
'(0 1 #f #f 2) <= (f 0 1 #:d 2)
'(0 1 2 #f 2) <= (f 0 1 2 #:d 2)
'(0 1 #f #f 2) <= (f 0 1 #f #:d 2)
'(#:x 1 #f #f 2) <= (f #:x 1 #f #:d 2)
;; and test errors
:rt-err: <= (f 0 #:c 2 #:c 3)))
;; multi-level arg lists with #:body specs
(let ([f (lambda/kw (#:key x y #:body (z)) (list x y z))])