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

Do a little better here, including using id->contract-src-info instead of

Browse Source 
just the identifier.

svn: r13631
This commit is contained in:
Stevie Strickland 2009-02-15 23:08:56 +00:00
parent 24e4cf5aca
commit 10b89445c6
1 changed files with 15 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -139,8 +139,7 @@ improve method arity mismatch contract violation error messages?
(lambda (stx)
(with-syntax ([neg-blame-id #'(current-contract-region)]
[pos-blame-id pos-blame-id]
[contract-stx contract-stx]
[id id])
[contract-stx contract-stx])
(syntax-case stx (set!)
[(set! id arg)
(raise-syntax-error 'with-contract
@ -148,21 +147,22 @@ improve method arity mismatch contract violation error messages?
stx
(syntax id))]
[(f arg ...)
(syntax/loc stx
((-contract contract-stx
id
pos-blame-id
neg-blame-id
#'f)
arg ...))]
(quasisyntax/loc stx
((let ([f (-contract contract-stx
#,id
pos-blame-id
neg-blame-id
#,(id->contract-src-info id))])
f) arg ...))]
[ident
(identifier? (syntax ident))
(syntax/loc stx
(-contract contract-stx
id
pos-blame-id
neg-blame-id
#'ident))])))))
(quasisyntax/loc stx
(let ([ident (-contract contract-stx
#,id
pos-blame-id
neg-blame-id
#,(id->contract-src-info id))])
ident))])))))
(define-for-syntax (partition-ids def-ids p/c-pairs unprotected-ids)
(let loop ([ids def-ids]