From 241f04bcdb82d46af73890ccca484df3edbf27fa Mon Sep 17 00:00:00 2001
From: Asumu Takikawa <asumu@ccs.neu.edu>
Date: Thu, 20 Aug 2015 04:00:15 -0400
Subject: [PATCH] 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
---
 .../typed-racket/typecheck/def-export.rkt     |  7 ++----
 .../typed-racket/typecheck/renamer.rkt        | 22 +++++++++++++------
 typed-racket-test/succeed/gh-issue-163-1.rkt  | 18 +++++++++++++++
 typed-racket-test/succeed/gh-issue-163-2.rkt  |  9 ++++++++
 typed-racket-test/succeed/gh-issue-181.rkt    | 16 ++++++++++++++
 5 files changed, 60 insertions(+), 12 deletions(-)
 create mode 100644 typed-racket-test/succeed/gh-issue-163-1.rkt
 create mode 100644 typed-racket-test/succeed/gh-issue-163-2.rkt
 create mode 100644 typed-racket-test/succeed/gh-issue-181.rkt

diff --git a/typed-racket-lib/typed-racket/typecheck/def-export.rkt b/typed-racket-lib/typed-racket/typecheck/def-export.rkt
index 7197e7ac..02511d58 100644
--- a/typed-racket-lib/typed-racket/typecheck/def-export.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/def-export.rkt
@@ -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)))]))
diff --git a/typed-racket-lib/typed-racket/typecheck/renamer.rkt b/typed-racket-lib/typed-racket/typecheck/renamer.rkt
index e33b2b20..157620d4 100644
--- a/typed-racket-lib/typed-racket/typecheck/renamer.rkt
+++ b/typed-racket-lib/typed-racket/typecheck/renamer.rkt
@@ -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
diff --git a/typed-racket-test/succeed/gh-issue-163-1.rkt b/typed-racket-test/succeed/gh-issue-163-1.rkt
new file mode 100644
index 00000000..f7f084ec
--- /dev/null
+++ b/typed-racket-test/succeed/gh-issue-163-1.rkt
@@ -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))
diff --git a/typed-racket-test/succeed/gh-issue-163-2.rkt b/typed-racket-test/succeed/gh-issue-163-2.rkt
new file mode 100644
index 00000000..13f04d60
--- /dev/null
+++ b/typed-racket-test/succeed/gh-issue-163-2.rkt
@@ -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))
diff --git a/typed-racket-test/succeed/gh-issue-181.rkt b/typed-racket-test/succeed/gh-issue-181.rkt
new file mode 100644
index 00000000..79db25ad
--- /dev/null
+++ b/typed-racket-test/succeed/gh-issue-181.rkt
@@ -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))