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

Pull out the querying of current-contract-region (even though it doesn't

Browse Source 
work), as we shouldn't be forming the if clause (here a cond) in the syntax
(as it should be evaluated at expansion time).

svn: r11642
This commit is contained in:
Stevie Strickland 2008-09-11 13:51:03 +00:00
parent 0d90b5274c
commit 8cbc41042e
1 changed files with 30 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -142,9 +142,10 @@ improve method arity mismatch contract violation error messages?
(define-for-syntax (make-with-contract-transformer contract-id id pos-blame-id) (define-for-syntax (make-with-contract-transformer contract-id id pos-blame-id)
(make-set!-transformer (make-set!-transformer
(lambda (stx) (lambda (stx)
(with-syntax ([neg-blame-id #`(if #,(current-contract-region) (let ([neg-blame-id (cond
#,(current-contract-region) [(current-contract-region) => values]
(module-source-as-symbol #'#,id))] [else #`(module-source-as-symbol #'#,id)])])
(with-syntax ([neg-blame-id neg-blame-id]
[pos-blame-id #`(quote #,(syntax-e pos-blame-id))] [pos-blame-id #`(quote #,(syntax-e pos-blame-id))]
[contract-id contract-id] [contract-id contract-id]
[id id]) [id id])
@ -169,7 +170,7 @@ improve method arity mismatch contract violation error messages?
id id
pos-blame-id pos-blame-id
neg-blame-id neg-blame-id
(quote-syntax ident)))]))))) (quote-syntax ident)))]))))))
(define-syntax (with-contract stx) (define-syntax (with-contract stx)
(let ([introducer (make-syntax-introducer)]) (let ([introducer (make-syntax-introducer)])