From 56706c27ac75d1350d2a5fc3cc63443bb00da073 Mon Sep 17 00:00:00 2001 From: AlexKnauth Date: Fri, 10 Jun 2016 13:27:13 -0400 Subject: [PATCH] use syntax-track-origin when substituting identifiers --- tapl/typecheck.rkt | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/tapl/typecheck.rkt b/tapl/typecheck.rkt index 9258e22..1ca6f97 100644 --- a/tapl/typecheck.rkt +++ b/tapl/typecheck.rkt @@ -756,10 +756,19 @@ (free-identifier=? #'actual #'lit)) fail-msg) stx))]))) + (define (merge-type-tags stx) + (define t (syntax-property stx 'type)) + (or (and (pair? t) + (identifier? (car t)) (identifier? (cdr t)) + (free-identifier=? (car t) (cdr t)) + (set-stx-prop/preserved stx 'type (car t))) + stx)) ; subst τ for y in e, if (bound-id=? x y) (define (subst τ x e [cmp bound-identifier=?]) (syntax-parse e - [y:id #:when (cmp e x) (transfer-stx-props τ e)] + [y:id + #:when (cmp e x) + (transfer-stx-props τ (merge-type-tags (syntax-track-origin τ e e)))] [(esub ...) #:with res (stx-map (λ (e1) (subst τ x e1 cmp)) #'(esub ...)) (transfer-stx-props #'res e #:ctx e)]