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

More error checking, shouldn't have allowed (define/contract x number? 1 2),

Browse Source 
for example.

svn: r11680
This commit is contained in:
Stevie Strickland 2008-09-12 15:19:29 +00:00
parent 33d3cb7cd0
commit a44810f4f5
1 changed files with 11 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/scheme/private/contract.ss
View File

@ -70,11 +70,20 @@ improve method arity mismatch contract violation error messages?
;; it to the result of `expr'. These variables may not be set!'d. ;; it to the result of `expr'. These variables may not be set!'d.
(define-syntax (define/contract define-stx) (define-syntax (define/contract define-stx)
(syntax-case define-stx () (syntax-case define-stx ()
[(_ name contract-expr expr0 expr ...) [(_ name contract-expr)
(raise-syntax-error 'define/contract
"no body after contract"
define-stx)]
[(_ name contract-expr expr)
(identifier? (syntax name)) (identifier? (syntax name))
#'(with-contract name #'(with-contract name
([name (verify-contract 'define/contract contract-expr)]) ([name (verify-contract 'define/contract contract-expr)])
(define name expr0 expr ...))] (define name expr))]
[(_ name contract-expr expr0 expr ...)
(identifier? (syntax name))
(raise-syntax-error 'define/contract
"multiple expressions after identifier and contract"
define-stx)]
[(_ name+arg-list contract body0 body ...) [(_ name+arg-list contract body0 body ...)
(let-values ([(name lam-expr) (let-values ([(name lam-expr)
(normalize-definition (datum->syntax #'define-stx (list* 'define/contract #'name+arg-list #'body0 #'(body ...))) (normalize-definition (datum->syntax #'define-stx (list* 'define/contract #'name+arg-list #'body0 #'(body ...)))