Fix typed provide uses in some modules
When identifiers provided by typed modules were used in certain submodules of the form (module* n #f ...) or were used by modules implemented in a language defined by TR, the wrong redirection was used in the expansion. The reason was because TR's identifier redirection decided whether it was in a typed or untyped context at module visit time, but that's too early in the cases above. (because TR's #%module-begin may not have begun expanding yet) The fix uses a rename-transformer that delays the decision to use the typed or untyped identifier until expansion time. Closes GH issue #163 and #181 Closes PR 15118
This commit is contained in:
parent
552f509102
commit
241f04bcdb
|
@ -9,8 +9,5 @@
|
|||
(define-syntax (def-export stx)
|
||||
(syntax-parse stx
|
||||
[(def-export export-id:identifier id:identifier cnt-id:identifier)
|
||||
#'(define-syntax export-id
|
||||
(let ([c #'cnt-id])
|
||||
(if (unbox typed-context?)
|
||||
(renamer #'id c)
|
||||
(renamer c))))]))
|
||||
#'(define-syntax export-id (typed-renaming (syntax-property #'id 'not-free-identifier=? #t)
|
||||
(syntax-property #'cnt-id 'not-free-identifier=? #t)))]))
|
||||
|
|
|
@ -1,16 +1,24 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide renamer un-rename)
|
||||
(require typed-racket/utils/tc-utils)
|
||||
|
||||
(provide typed-renaming un-rename)
|
||||
|
||||
;; target : identifier
|
||||
;; alternate : identifier
|
||||
(define-struct typed-renaming (target alternate)
|
||||
#:property prop:rename-transformer 0)
|
||||
|
||||
(define (renamer id [alt #f])
|
||||
(if alt
|
||||
(make-typed-renaming (syntax-property id 'not-free-identifier=? #t) alt)
|
||||
(make-rename-transformer (syntax-property id 'not-free-identifier=? #t))))
|
||||
;; prevent the rename transformer from expanding in
|
||||
;; module-begin context because the typed context flag
|
||||
;; will not be set until the module-begin
|
||||
#:property prop:expansion-contexts
|
||||
'(expression top-level module definition-context)
|
||||
;; delay the rename transformer target selection until
|
||||
;; expansion time when the typed context flag is set correctly
|
||||
#:property prop:rename-transformer
|
||||
(λ (obj)
|
||||
(if (unbox typed-context?)
|
||||
(typed-renaming-target obj)
|
||||
(typed-renaming-alternate obj))))
|
||||
|
||||
;; Undo renaming for type lookup.
|
||||
;; Used because of macros that mark the identifier used as the binding such as
|
||||
|
|
18
typed-racket-test/succeed/gh-issue-163-1.rkt
Normal file
18
typed-racket-test/succeed/gh-issue-163-1.rkt
Normal file
|
@ -0,0 +1,18 @@
|
|||
#lang typed/racket
|
||||
|
||||
;; Test for GH issue 163
|
||||
|
||||
(: bar (case→ (→ 'a True) (→ 'b False)))
|
||||
(define (bar x) (if (eq? x 'a) #t #f))
|
||||
|
||||
(module m typed/racket
|
||||
(: foo (case→ (→ 'a True) (→ 'b False)))
|
||||
(define (foo x) (if (eq? x 'a) #t #f))
|
||||
|
||||
(provide foo))
|
||||
|
||||
(require 'm)
|
||||
|
||||
(module+ test
|
||||
(define b bar)
|
||||
(define f foo))
|
9
typed-racket-test/succeed/gh-issue-163-2.rkt
Normal file
9
typed-racket-test/succeed/gh-issue-163-2.rkt
Normal file
|
@ -0,0 +1,9 @@
|
|||
#lang racket
|
||||
|
||||
(module m typed/racket/base
|
||||
(define x 1)
|
||||
(provide x))
|
||||
|
||||
(module n typed/racket/base
|
||||
(require (submod ".." m))
|
||||
(module* a #f x))
|
16
typed-racket-test/succeed/gh-issue-181.rkt
Normal file
16
typed-racket-test/succeed/gh-issue-181.rkt
Normal file
|
@ -0,0 +1,16 @@
|
|||
#lang typed/racket
|
||||
|
||||
;; Test case for GH issue #181
|
||||
|
||||
(module m1 typed/racket
|
||||
(provide bar)
|
||||
(define-syntax-rule (bar) 42))
|
||||
|
||||
(module m2 typed/racket
|
||||
(require typed/racket
|
||||
(submod ".." m1))
|
||||
(provide (all-from-out typed/racket)
|
||||
bar))
|
||||
|
||||
(module m3 (submod ".." m2)
|
||||
(bar))
|
Loading…
Reference in New Issue
Block a user