From f191636cc71c051702678777fb14dca21364886f Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Fri, 12 Sep 2008 16:20:38 +0000
Subject: [PATCH] Use the same info here as the provide/contract -contract uses
 do.

svn: r11685
---
 collects/scheme/private/contract.ss | 24 ++++++++++++------------
 1 file changed, 12 insertions(+), 12 deletions(-)

diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss
index c9e9031d42..9c27a916da 100644
--- a/collects/scheme/private/contract.ss
+++ b/collects/scheme/private/contract.ss
@@ -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)])