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

Don't allow dot-notation with other meta-keywords

Browse Source 
svn: r1139
This commit is contained in:
Eli Barzilay 2005-10-24 10:43:32 +00:00
parent acfb67ec9b
commit 4130a38299
2 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
collects/mzlib/kw.ss
View File

@ -40,8 +40,17 @@
;; turns formals into a syntax list ;; turns formals into a syntax list
(define (formals->list formals) (define (formals->list formals)
(syntax-case formals () (syntax-case formals ()
[(formal ... . rest) ; dot is exactly like #:rest [(formal ... . rest)
(formals->list #'(formal ... #:rest rest))] ;; dot is exactly like #:rest, but don't allow it with other
;; meta-keywords since its meaning is confusing
(let* ([formals (syntax->list #'(formal ...))]
[kwd (ormap (lambda (s) (and (keyword? (syntax-e* s)) s))
formals)])
(if kwd
(serror #'rest "use #:rest or #:body instead of dot notation"
;; (syntax-e* kwd) <- confusing to show this
)
(append formals (list #'#:rest #'rest))))]
[(formal ...) (syntax->list formals)])) [(formal ...) (syntax->list formals)]))
;; is an expression simple? (=> evaluating cannot have side effects) ;; is an expression simple? (=> evaluating cannot have side effects)
(define (simple-expr? expr) (define (simple-expr? expr)
@ -111,9 +120,9 @@
([(only-vars?) (and (pair? only-vars?) (car only-vars?))] ([(only-vars?) (and (pair? only-vars?) (car only-vars?))]
[(opts keys0) (values (map process-opt opts) (map process-key keys0))] [(opts keys0) (values (map process-opt opts) (map process-key keys0))]
[(rest body rest-keys all-keys other-keys) [(rest body rest-keys all-keys other-keys)
(apply values (apply values (map (lambda (k)
(map (lambda (k) (cond [(assq k rests) => cdr] [else #f])) (cond [(assq k rests) => cdr] [else #f]))
'(#:rest #:body #:rest-keys #:all-keys #:other-keys)))] rest-like-kwds))]
[(rest* body* other-keys*) [(rest* body* other-keys*)
(values (or rest (gensym #'rest)) (values (or rest (gensym #'rest))
(if (and body (identifier? body)) body (gensym #'body)) (if (and body (identifier? body)) body (gensym #'body))

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

@ -288,6 +288,7 @@
;; test syntax errors ;; test syntax errors
(t :st-err: <= (lambda/kw (x #:blah y) 1) (t :st-err: <= (lambda/kw (x #:blah y) 1)
:st-err: <= (lambda/kw (x #:rest) 1) :st-err: <= (lambda/kw (x #:rest) 1)
:st-err: <= (lambda/kw (x #:key k . r) 1)
:st-err: <= (lambda/kw (x #:key k #:key o) 1) :st-err: <= (lambda/kw (x #:key k #:key o) 1)
:st-err: <= (lambda/kw (x #:key k #:optional o) 1) :st-err: <= (lambda/kw (x #:key k #:optional o) 1)
:st-err: <= (lambda/kw (x #:optional k #:optional o) 1) :st-err: <= (lambda/kw (x #:optional k #:optional o) 1)