[commit: ghc] master: Prevent Template Haskell splices from throwing a spurious TypeInType error (283a346)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/283a346586e5bf711ecd8cc61263d87771f8f744/ghc

>---------------------------------------------------------------

commit 283a346586e5bf711ecd8cc61263d87771f8f744
Author: Ryan Scott <ryan.gl.scott at gmail.com>
Date:   Fri Feb 10 10:31:10 2017 -0500

    Prevent Template Haskell splices from throwing a spurious TypeInType error
    
    Summary:
    There was a rather annoying corner case where splicing poly-kinded
    Template Haskell declarations could trigger an error muttering about
    `TypeInType` not being enabled, whereas the equivalent non-TH code would
    compile without issue. This was causing by overzealous validity check in the
    renamer, wherein failed to distinguish between two different `Exact` names
    with the same `OccName`. As a result, it mistakenly believed some type
    variables were being used as both type and kind variables simultaneously! Ack.
    
    This avoids the issue by simply disabling the aforementioned validity check
    for Exact names. Fixes #12503.
    
    Test Plan: ./validate
    
    Reviewers: austin, bgamari, goldfire
    
    Subscribers: thomie
    
    Differential Revision: https://phabricator.haskell.org/D3022


>---------------------------------------------------------------

283a346586e5bf711ecd8cc61263d87771f8f744
 compiler/rename/RnTypes.hs   | 40 ++++++++++++++++++++++++++++++++++++++--
 testsuite/tests/th/T12503.hs | 29 +++++++++++++++++++++++++++++
 testsuite/tests/th/all.T     |  1 +
 3 files changed, 68 insertions(+), 2 deletions(-)

diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 91d6978..9cf78c2 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -1692,18 +1692,20 @@ extract_tv t_or_k ltv@(L _ tv) acc
   | isRdrTyVar tv = case acc of
       FKTV kvs k_set tvs t_set all
         |  isTypeLevel t_or_k
-        -> do { when (occ `elemOccSet` k_set) $
+        -> do { when (not_exact && occ `elemOccSet` k_set) $
                 mixedVarsErr ltv
               ; return (FKTV kvs k_set (ltv : tvs) (t_set `extendOccSet` occ)
                              (ltv : all)) }
         |  otherwise
-        -> do { when (occ `elemOccSet` t_set) $
+        -> do { when (not_exact && occ `elemOccSet` t_set) $
                 mixedVarsErr ltv
               ; return (FKTV (ltv : kvs) (k_set `extendOccSet` occ) tvs t_set
                              (ltv : all)) }
   | otherwise     = return acc
   where
     occ = rdrNameOcc tv
+    -- See Note [TypeInType validity checking and Template Haskell]
+    not_exact = not $ isExact tv
 
 mixedVarsErr :: Located RdrName -> RnM ()
 mixedVarsErr (L loc tv)
@@ -1716,3 +1718,37 @@ mixedVarsErr (L loc tv)
 -- just used in this module; seemed convenient here
 nubL :: Eq a => [Located a] -> [Located a]
 nubL = nubBy eqLocated
+
+{-
+Note [TypeInType validity checking and Template Haskell]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+extract_tv enforces an invariant that no variable can be used as both a kind
+and a type unless -XTypeInType is enabled. It does so by accumulating two sets
+of variables' OccNames (one for type variables and one for kind variables) that
+it has seen before. If a new type variable's OccName appears in the kind set,
+then it errors, and similarly for kind variables and the type set.
+
+This relies on the assumption that any two variables with the same OccName
+are the same. While this is always true of user-written code, it is not always
+true in the presence of Template Haskell! GHC Trac #12503 demonstrates a
+scenario where two different Exact TH-generated names can have the same
+OccName. As a result, if one of these Exact names is for a type variable
+and the other Exact name is for a kind variable, then extracting them both
+can lead to a spurious error in extract_tv.
+
+To avoid such a scenario, we simply don't check the invariant in extract_tv
+when the name is Exact. This allows Template Haskell users to write code that
+uses -XPolyKinds without needing to enable -XTypeInType.
+
+This is a somewhat arbitrary design choice, as adding this special case causes
+this code to be accepted when spliced in via Template Haskell:
+
+  data T1 k e
+  class C1 b
+  instance C1 (T1 k (e :: k))
+
+Even if -XTypeInType is _not enabled. But accepting too many programs without
+the prerequisite GHC extensions is better than the alternative, where some
+programs would not be accepted unless enabling an extension which has nothing
+to do with the code itself.
+-}
diff --git a/testsuite/tests/th/T12503.hs b/testsuite/tests/th/T12503.hs
new file mode 100644
index 0000000..517c4ba
--- /dev/null
+++ b/testsuite/tests/th/T12503.hs
@@ -0,0 +1,29 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE PolyKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+module T12503 where
+
+import Language.Haskell.TH
+
+data T1 k
+class C1 a
+
+$(do TyConI (DataD [] tName [ KindedTV kName kKind] _ _ _)
+       <- reify ''T1
+     d <- instanceD (cxt [])
+                    (conT ''C1 `appT`
+                      (conT tName `appT` sigT (varT kName) kKind))
+                    []
+     return [d])
+
+data family T2 (a :: b)
+data instance T2 b
+class C2 a
+
+$(do FamilyI (DataFamilyD tName _ _) [DataInstD [] _ [tyVar] _ _ _]
+       <- reify ''T2
+     d <- instanceD (cxt [])
+                    (conT ''C2 `appT` (conT tName `appT` return tyVar))
+                    []
+     return [d])
diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T
index 9a08b65..56aca1a 100644
--- a/testsuite/tests/th/all.T
+++ b/testsuite/tests/th/all.T
@@ -363,6 +363,7 @@ test('T12478_2', omit_ways(['ghci']), compile_and_run, ['-v0'])
 test('T12478_3', omit_ways(['ghci']), compile, ['-v0'])
 test('T12478_4', omit_ways(['ghci']), compile_fail, ['-v0'])
 test('T12478_5', omit_ways(['ghci']), compile, ['-v0'])
+test('T12503', normal, compile, ['-v0'])
 test('T12513', omit_ways(['ghci']), compile_fail, ['-v0'])
 test('T12530', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
 test('T12646', normal, compile, ['-v0'])