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

Use the same info here as the provide/contract -contract uses do.

Browse Source 
svn: r11685
This commit is contained in:
Stevie Strickland 2008-09-12 16:20:38 +00:00
parent c32c61ab74
commit f191636cc7
1 changed files with 12 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -48,6 +48,16 @@ improve method arity mismatch contract violation error messages?
(error name "expected a contract or a procedure of arity one, got ~e" x))
x)
;; id->contract-src-info : identifier -> syntax
;; constructs the last argument to the -contract, given an identifier
(define-for-syntax (id->contract-src-info id)
#`(list (make-srcloc #,id
#,(syntax-line id)
#,(syntax-column id)
#,(syntax-position id)
#,(syntax-span id))
#,(format "~s" (syntax->datum id))))
;
;
;
@ -132,7 +142,7 @@ improve method arity mismatch contract violation error messages?
id
pos-blame-id
'neg-blame-id
(quote-syntax f))
(quote-syntax #,(id->contract-src-info #'f)))
arg ...))]
[ident
(identifier? (syntax ident))
@ -141,7 +151,7 @@ improve method arity mismatch contract violation error messages?
id
pos-blame-id
'neg-blame-id
(quote-syntax ident)))])))))
(quote-syntax #,(id->contract-src-info #'ident))))])))))
(define-for-syntax (check-and-split-with-contract-args args)
(let loop ([args args]
@ -244,16 +254,6 @@ improve method arity mismatch contract violation error messages?
provide-stx
id)))))
;; id->contract-src-info : identifier -> syntax
;; constructs the last argument to the -contract, given an identifier
(define-for-syntax (id->contract-src-info id)
#`(list (make-srcloc #,id
#,(syntax-line id)
#,(syntax-column id)
#,(syntax-position id)
#,(syntax-span id))
#,(format "~s" (syntax->datum id))))
(define-for-syntax (make-provide/contract-transformer contract-id id pos-module-source)
(make-set!-transformer
(let ([saved-id-table (make-hasheq)])