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

Preserve source location for struct constructor contracts.

Browse Source
This commit is contained in:
Vincent St-Amour 2013-01-29 14:17:18 -05:00
parent ad9de1f325
commit d3507c4c3e
1 changed files with 18 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -74,17 +74,24 @@
[pos-module-source pos-module-source]
[loc-id (identifier-prune-to-source-module id)])
(let ([srcloc-code
(with-syntax
([src
(or (and (path-string? (syntax-source #'id))
(path->relative-string/library
(syntax-source #'id) #f))
(syntax-source #'id))]
[line (syntax-line #'id)]
[col (syntax-column #'id)]
[pos (syntax-position #'id)]
[span (syntax-span #'id)])
#'(make-srcloc 'src 'line 'col 'pos 'span))])
;; If id has no source location, use the external-id's.
;; Otherwise, constructor contracts have no useful
;; source location information. This may not be the best
;; solution. We may want to look deeper into this.
(with-syntax ([location-id (if (syntax-source #'id)
#'id
#'external-id)])
(with-syntax
([src
(or (and (path-string? (syntax-source #'location-id))
(path->relative-string/library
(syntax-source #'location-id) #f))
(syntax-source #'location-id))]
[line (syntax-line #'location-id)]
[col (syntax-column #'location-id)]
[pos (syntax-position #'location-id)]
[span (syntax-span #'location-id)])
#'(make-srcloc 'src 'line 'col 'pos 'span)))])
(syntax-local-introduce
(syntax-local-lift-expression
#`(contract contract-id