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

Made it ok to use rest-like stuff with keywords when allowing other keywords

Browse Source 
(either explicitly or implicitly).

svn: r2676
This commit is contained in:
Eli Barzilay 2006-04-15 21:15:08 +00:00
parent 5552630953
commit 88341ddf0e
2 changed files with 40 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

37
collects/mzlib/kw.ss
View File

@ -188,7 +188,7 @@
'()))] '()))]
[opts (pop-formals #:optional)] [opts (pop-formals #:optional)]
[keys (pop-formals #:key)]) [keys (pop-formals #:key)])
;; now get all rest-like vars ;; now get all rest-like vars and modes
(let loop ([formals formals] [rests '()] [modes '()]) (let loop ([formals formals] [rests '()] [modes '()])
(if (null? formals) (if (null? formals)
(apply process-vars vars opts keys rests modes only-vars?) (apply process-vars vars opts keys rests modes only-vars?)
@ -197,12 +197,16 @@
(cond [(memq k '(#:optional #:key)) (cond [(memq k '(#:optional #:key))
(serror k-stx "misplaced ~a" k)] (serror k-stx "misplaced ~a" k)]
[(memq k mode-keywords) [(memq k mode-keywords)
(cond [(null? keys) (cond
(serror k-stx "cannot use without #:key arguments")] #; ;(*)
[(pair? (cdar formals)) ;; don't throw an error here, it still fine if used with
(serror (cadar formals) ;; #:allow-other-keys (explicit or implicit), also below
"identifier following mode keyword ~a" k)] [(null? keys)
[else (loop (cdr formals) rests (cons k modes))])] (serror k-stx "cannot use without #:key arguments")]
[(pair? (cdar formals))
(serror (cadar formals)
"identifier following mode keyword ~a" k)]
[else (loop (cdr formals) rests (cons k modes))])]
[(not (memq k rest-like-kwds)) [(not (memq k rest-like-kwds))
(serror k-stx "unknown meta keyword")] (serror k-stx "unknown meta keyword")]
[(assq k rests) [(assq k rests)
@ -211,6 +215,9 @@
(serror k-stx "missing variable name")] (serror k-stx "missing variable name")]
[(not (null? (cddar formals))) [(not (null? (cddar formals)))
(serror k-stx "too many variable names")] (serror k-stx "too many variable names")]
#; ;(*)
;; same as above: don't throw an error here, still fine if
;; used with #:allow-other-keys (explicit or implicit)
[(and (null? keys) (not (eq? #:rest k))) [(and (null? keys) (not (eq? #:rest k)))
(serror k-stx "cannot use without #:key arguments")] (serror k-stx "cannot use without #:key arguments")]
[else (loop (cdr formals) [else (loop (cdr formals)
@ -367,14 +374,24 @@
(with-syntax ([body (make-rest-body expr)] [keys keys]) (with-syntax ([body (make-rest-body expr)] [keys keys])
#'(let* keys body))) #'(let* keys body)))
;; ------------------------------------------------------------------------ ;; ------------------------------------------------------------------------
;; more sanity tests (see commented code above -- search for "(*)")
(let ([r (or all-keys other-keys other-keys+body body rest)])
(when (and (not allow-other-keys?) (null? keys))
(when r (serror r "cannot use without #:key or #:allow-other-keys"))
(when allow-duplicate-keys?
(serror #f (string-append "cannot allow duplicate keys without"
" #:key or #:allow-other-keys"))))
(when (and allow-other-keys? (null? keys) (not r))
(serror #f "cannout allow other keys without using them in some way")))
;; ------------------------------------------------------------------------
;; body generation starts here ;; body generation starts here
(cond (cond
;; no optionals or keys => plain lambda ;; no optionals or keys (or other-keys) => plain lambda
[(and (null? opts) (null? keys)) [(and (null? opts) (null? keys) (not allow-other-keys?))
(with-syntax ([vars (append! vars (or rest '()))] [expr expr]) (with-syntax ([vars (append! vars (or rest '()))] [expr expr])
(syntax/loc stx (lambda vars expr)))] (syntax/loc stx (lambda vars expr)))]
;; no keys => make a case-lambda for optionals ;; no keys => make a case-lambda for optionals
[(null? keys) [(and (null? keys) (not allow-other-keys?))
(let ([clauses (make-opt-clauses expr (or rest '()))]) (let ([clauses (make-opt-clauses expr (or rest '()))])
(with-syntax ([name name] [clauses clauses]) (with-syntax ([name name] [clauses clauses])
(syntax/loc stx (letrec ([name (case-lambda . clauses)]) name))))] (syntax/loc stx (letrec ([name (case-lambda . clauses)]) name))))]

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

@ -375,9 +375,11 @@
:st-err: <= (lambda/kw (x #:body x #:allow-other-keys) 1) :st-err: <= (lambda/kw (x #:body x #:allow-other-keys) 1)
:st-err: <= (lambda/kw (x #:optional ()) 1) :st-err: <= (lambda/kw (x #:optional ()) 1)
:st-err: <= (lambda/kw (x #:optional (x y z)) 1) :st-err: <= (lambda/kw (x #:optional (x y z)) 1)
:st-err: <= (lambda/kw (x #:other-keys z) 1) ;; :st-err: <= (lambda/kw (x #:other-keys z) 1) <-- these are all
:st-err: <= (lambda/kw (x #:other-keys+body z) 1) ;; :st-err: <= (lambda/kw (x #:other-keys+body z) 1) <-- fine!
:st-err: <= (lambda/kw (x #:all-keys z) 1) ;; :st-err: <= (lambda/kw (x #:all-keys z) 1) <-- (see below)
:st-err: <= (lambda/kw (x #:other-keys z #:forbid-other-keys) 1)
:st-err: <= (lambda/kw (x #:all-keys z #:forbid-other-keys) 1)
:st-err: <= (lambda/kw (x #:key y #:allow-other-keys z) 1) :st-err: <= (lambda/kw (x #:key y #:allow-other-keys z) 1)
:st-err: <= (lambda/kw (x #:key y #:forbid-body z) 1) :st-err: <= (lambda/kw (x #:key y #:forbid-body z) 1)
:st-err: <= (lambda/kw (x #:key y #:allow-body #:rest r #:forbid-body) 1) :st-err: <= (lambda/kw (x #:key y #:allow-body #:rest r #:forbid-body) 1)
@ -387,4 +389,12 @@
:st-err: <= (lambda/kw (#:key a #:body r #:forbid-body) r) :st-err: <= (lambda/kw (#:key a #:body r #:forbid-body) r)
:st-err: <= (lambda/kw (#:key a #:other-keys r #:forbid-other-keys) r)) :st-err: <= (lambda/kw (#:key a #:other-keys r #:forbid-other-keys) r))
;; it is ok to have no keys, and still specify all-keys etc
(let ([f (lambda/kw (x #:all-keys ak) (list x ak))])
(t (f 1) => '(1 ())
(f 1 #:a 2) => '(1 (#:a 2))
(f 1 #:a 2 #:b 3) => '(1 (#:a 2 #:b 3))
(f 1 #:a 2 #:a 3) => '(1 (#:a 2 #:a 3))
(f 1 #:a 2 #:a 3) => '(1 (#:a 2 #:a 3))))
) )