Prevent Template Haskell splices from throwing a spurious TypeInType error
authorRyan Scott <ryan.gl.scott@gmail.com>
Fri, 10 Feb 2017 15:31:10 +0000 (10:31 -0500)
committerRyan Scott <ryan.gl.scott@gmail.com>
Fri, 10 Feb 2017 15:31:10 +0000 (10:31 -0500)
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

compiler/rename/RnTypes.hs
testsuite/tests/th/T12503.hs [new file with mode: 0644]
testsuite/tests/th/all.T

index 91d6978..9cf78c2 100644 (file)
@@ -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 (file)
index 0000000..517c4ba
--- /dev/null
@@ -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])
index 9a08b65..56aca1a 100644 (file)
@@ -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'])