If we're using known-good-contract here, we won't always have an identifier
for the contract, so use the contract in that case. Also rename to contract-stx in make-with-contract-transformer so its name isn't misleading. svn: r13269
This commit is contained in:
parent
9361e782ef
commit
72d551082d
|
@ -134,12 +134,12 @@ improve method arity mismatch contract violation error messages?
|
||||||
|
|
||||||
(define-syntax-parameter current-contract-region (λ (stx) #'(#%variable-reference)))
|
(define-syntax-parameter current-contract-region (λ (stx) #'(#%variable-reference)))
|
||||||
|
|
||||||
(define-for-syntax (make-with-contract-transformer contract-id id pos-blame-id)
|
(define-for-syntax (make-with-contract-transformer contract-stx id pos-blame-id)
|
||||||
(make-set!-transformer
|
(make-set!-transformer
|
||||||
(lambda (stx)
|
(lambda (stx)
|
||||||
(with-syntax ([neg-blame-id #'(current-contract-region)]
|
(with-syntax ([neg-blame-id #'(current-contract-region)]
|
||||||
[pos-blame-id pos-blame-id]
|
[pos-blame-id pos-blame-id]
|
||||||
[contract-id contract-id]
|
[contract-stx contract-stx]
|
||||||
[id id])
|
[id id])
|
||||||
(syntax-case stx (set!)
|
(syntax-case stx (set!)
|
||||||
[(set! id arg)
|
[(set! id arg)
|
||||||
|
@ -149,7 +149,7 @@ improve method arity mismatch contract violation error messages?
|
||||||
(syntax id))]
|
(syntax id))]
|
||||||
[(f arg ...)
|
[(f arg ...)
|
||||||
(syntax/loc stx
|
(syntax/loc stx
|
||||||
((-contract contract-id
|
((-contract contract-stx
|
||||||
id
|
id
|
||||||
pos-blame-id
|
pos-blame-id
|
||||||
neg-blame-id
|
neg-blame-id
|
||||||
|
@ -158,7 +158,7 @@ improve method arity mismatch contract violation error messages?
|
||||||
[ident
|
[ident
|
||||||
(identifier? (syntax ident))
|
(identifier? (syntax ident))
|
||||||
(syntax/loc stx
|
(syntax/loc stx
|
||||||
(-contract contract-id
|
(-contract contract-stx
|
||||||
id
|
id
|
||||||
pos-blame-id
|
pos-blame-id
|
||||||
neg-blame-id
|
neg-blame-id
|
||||||
|
@ -245,7 +245,7 @@ improve method arity mismatch contract violation error messages?
|
||||||
[always-defined
|
[always-defined
|
||||||
(list #`(define-syntaxes (#,p)
|
(list #`(define-syntaxes (#,p)
|
||||||
(make-with-contract-transformer
|
(make-with-contract-transformer
|
||||||
(quote-syntax #,contract-id)
|
(quote-syntax #,(if contract-id contract-id c))
|
||||||
(quote-syntax #,(marker-f p))
|
(quote-syntax #,(marker-f p))
|
||||||
(quote-syntax blame-stx)))
|
(quote-syntax blame-stx)))
|
||||||
#`(define-values ()
|
#`(define-values ()
|
||||||
|
|
Loading…
Reference in New Issue
Block a user