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

We should use the name of the form in generating the error.

Browse Source 
svn: r11659
This commit is contained in:
Stevie Strickland 2008-09-11 22:58:25 +00:00
parent 249f3db1b5
commit e1f430df72
1 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -38,14 +38,14 @@ improve method arity mismatch contract violation error messages?
(define-syntax (verify-contract stx) (define-syntax (verify-contract stx)
(syntax-case stx () (syntax-case stx ()
[(_ x) (a:known-good-contract? #'x) #'x] [(_ name x) (a:known-good-contract? #'x) #'x]
[(_ x) #'(verify-contract/proc x)])) [(_ name x) #'(verify-contract/proc name x)]))
(define (verify-contract/proc x) (define (verify-contract/proc name x)
(unless (or (contract? x) (unless (or (contract? x)
(and (procedure? x) (and (procedure? x)
(procedure-arity-includes? x 1))) (procedure-arity-includes? x 1)))
(error 'provide/contract "expected a contract or a procedure of arity one, got ~e" x)) (error name "expected a contract or a procedure of arity one, got ~e" x))
x) x)
; ;
@ -73,7 +73,7 @@ improve method arity mismatch contract violation error messages?
[(_ name contract-expr expr0 expr ...) [(_ name contract-expr expr0 expr ...)
(identifier? (syntax name)) (identifier? (syntax name))
#'(with-contract name #'(with-contract name
([name (verify-contract contract-expr)]) ([name (verify-contract 'define/contract contract-expr)])
(define name expr0 expr ...))] (define name expr0 expr ...))]
[(_ name+arg-list contract body0 body ...) [(_ name+arg-list contract body0 body ...)
(let-values ([(name lam-expr) (let-values ([(name lam-expr)
@ -189,7 +189,7 @@ improve method arity mismatch contract violation error messages?
(begin-with-definitions (begin-with-definitions
body0 body ... body0 body ...
(values unprotected-id ... protected-id ...)))) (values unprotected-id ... protected-id ...))))
(define contract-id (verify-contract contract-expr)) ... (define contract-id (verify-contract 'with-contract contract-expr)) ...
(define-syntax protected-id (define-syntax protected-id
(make-with-contract-transformer (make-with-contract-transformer
(quote-syntax contract-id) (quote-syntax contract-id)
@ -572,7 +572,7 @@ improve method arity mismatch contract violation error messages?
#f #f
(with-syntax ([field-contract-id field-contract-id] (with-syntax ([field-contract-id field-contract-id]
[field-contract field-contract]) [field-contract field-contract])
#'(define field-contract-id (verify-contract field-contract))))) #'(define field-contract-id (verify-contract 'provide/contract field-contract)))))
field-contract-ids field-contract-ids
field-contracts))] field-contracts))]
[(field-contracts ...) field-contracts] [(field-contracts ...) field-contracts]
@ -760,7 +760,7 @@ improve method arity mismatch contract violation error messages?
#,@(if no-need-to-check-ctrct? #,@(if no-need-to-check-ctrct?
(list) (list)
(list #'(define contract-id (verify-contract ctrct)))) (list #'(define contract-id (verify-contract 'provide/contract ctrct))))
(define-syntax id-rename (define-syntax id-rename
(make-provide/contract-transformer (quote-syntax contract-id) (make-provide/contract-transformer (quote-syntax contract-id)
(quote-syntax id) (quote-syntax id)