From 55ef0e7c0727ac417187f6e982cdd4c3791f760b Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Mon, 25 Mar 2013 21:03:41 -0500 Subject: [PATCH] make negative blame also use "/" instead of having the full collection path in there --- collects/racket/contract/private/provide.rkt | 13 ++++++++++--- 1 file changed, 10 insertions(+), 3 deletions(-) diff --git a/collects/racket/contract/private/provide.rkt b/collects/racket/contract/private/provide.rkt index a78f1a21a6..30501c632c 100644 --- a/collects/racket/contract/private/provide.rkt +++ b/collects/racket/contract/private/provide.rkt @@ -18,6 +18,7 @@ [make-module-identifier-mapping make-free-identifier-mapping] [module-identifier-mapping-get free-identifier-mapping-get] [module-identifier-mapping-put! free-identifier-mapping-put!])) + setup/path-to-relative "arrow.rkt" "base.rkt" "guts.rkt" @@ -90,7 +91,7 @@ #`(contract contract-id id pos-module-source - (quote-module-name) + (maybe-call-path->relative-string/library (quote-module-name)) 'external-id #,srcloc-code))))))]) (when key (hash-set! saved-id-table key lifted-id)) @@ -118,8 +119,14 @@ (let ([contract-id (provide/contract-transformer-contract-id self)] [id (provide/contract-transformer-id self)] [external-id (provide/contract-transformer-external-id self)]) - (provide/contract-transformer contract-id id external-id new-pos (make-hasheq)))) - ) + (provide/contract-transformer contract-id id external-id new-pos (make-hasheq))))) + + +(define (maybe-call-path->relative-string/library x) + (if (path? x) + (path->relative-string/library x) + x)) + (define-for-syntax (true-provide/contract provide-stx just-check-errors? who) (syntax-case provide-stx ()