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

make negative blame also use "<collects>/" instead of having

Browse Source 
the full collection path in there
This commit is contained in:
Robby Findler 2013-03-25 21:03:41 -05:00
parent 2ec097a955
commit 55ef0e7c07
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/racket/contract/private/provide.rkt
View File

@ -18,6 +18,7 @@
[make-module-identifier-mapping make-free-identifier-mapping] [make-module-identifier-mapping make-free-identifier-mapping]
[module-identifier-mapping-get free-identifier-mapping-get] [module-identifier-mapping-get free-identifier-mapping-get]
[module-identifier-mapping-put! free-identifier-mapping-put!])) [module-identifier-mapping-put! free-identifier-mapping-put!]))
setup/path-to-relative
"arrow.rkt" "arrow.rkt"
"base.rkt" "base.rkt"
"guts.rkt" "guts.rkt"
@ -90,7 +91,7 @@
#`(contract contract-id #`(contract contract-id
id id
pos-module-source pos-module-source
(quote-module-name) (maybe-call-path->relative-string/library (quote-module-name))
'external-id 'external-id
#,srcloc-code))))))]) #,srcloc-code))))))])
(when key (hash-set! saved-id-table key lifted-id)) (when key (hash-set! saved-id-table key lifted-id))
@ -118,8 +119,14 @@
(let ([contract-id (provide/contract-transformer-contract-id self)] (let ([contract-id (provide/contract-transformer-contract-id self)]
[id (provide/contract-transformer-id self)] [id (provide/contract-transformer-id self)]
[external-id (provide/contract-transformer-external-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) (define-for-syntax (true-provide/contract provide-stx just-check-errors? who)
(syntax-case provide-stx () (syntax-case provide-stx ()