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

Make TR-generated identifiers have the same name as original identifiers.

Browse Source 
Makes error messages nicer, and makes it easier to correlate with source code.

original commit: 16a75761b052f49d0257afb19cc5282bae34558e
This commit is contained in:
Vincent St-Amour 2013-02-05 18:11:52 -05:00
parent e4e84ecf70
commit 1bc88189d1
1 changed files with 9 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/typed-racket/typecheck/provide-handling.rkt
View File

@ -30,6 +30,11 @@
(cond [(s:member i vd (lambda (i j) (free-identifier=? i (binding-name j)))) => car]
[else #f]))
(define new-id-introducer (make-syntax-introducer))
(define cnt-id-introducer (make-syntax-introducer))
(define error-id-introducer (make-syntax-introducer))
(define untyped-id-introducer (make-syntax-introducer))
;; generate-contract-defs : dict[id -> def-binding] dict[id -> list[id]] id -> syntax
;; defs: defines in this module
;; provs: provides in this module
@ -46,7 +51,7 @@
(define mapping (make-free-id-table))
;; mk : id [id] -> (values syntax id aliases)
(define (mk internal-id [new-id (generate-temporary internal-id)])
(define (mk internal-id [new-id (new-id-introducer internal-id)])
(define (mk-untyped-syntax b defn-id internal-id)
(match b
[(def-struct-stx-binding _ (? struct-info? si))
@ -87,7 +92,7 @@
[(def-binding _ (app (λ (ty) (type->contract ty (λ () #f) #:out #t)) (? values cnt)))
(values
(with-syntax* ([id internal-id]
[cnt-id (generate-temporary #'id)]
[cnt-id (cnt-id-introducer #'id)]
[export-id new-id]
[module-source pos-blame-id]
[the-contract (generate-temporary 'generated-contract)])
@ -113,7 +118,7 @@
[(def-binding id ty)
(values
(with-syntax* ([id internal-id]
[error-id (generate-temporary #'id)]
[error-id (error-id-introducer #'id)]
[export-id new-id])
#'(begin
(define-syntax (error-id stx)
@ -124,7 +129,7 @@
[(and b (def-stx-binding _))
(with-syntax* ([id internal-id]
[export-id new-id]
[untyped-id (generate-temporary #'id)])
[untyped-id (untyped-id-introducer #'id)])
(define-values (d aliases)
(mk-untyped-syntax b #'untyped-id internal-id))
(define/with-syntax def d)