[commit: ghc] master: Fix #11255. (5e4e9e0)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/5e4e9e00dd36bf6316a406a14bc9482c7bcff527/ghc

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

commit 5e4e9e00dd36bf6316a406a14bc9482c7bcff527
Author: Richard Eisenberg <eir at cis.upenn.edu>
Date:   Fri Dec 18 15:53:26 2015 -0500

    Fix #11255.
    
    We need to instantiate types in tuples. Quite straightforward.


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

5e4e9e00dd36bf6316a406a14bc9482c7bcff527
 compiler/typecheck/TcHsType.hs      | 13 ++++++++-----
 testsuite/tests/polykinds/T11255.hs |  6 ++++++
 testsuite/tests/polykinds/all.T     |  1 +
 3 files changed, 15 insertions(+), 5 deletions(-)

diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 6214a8a..7e4e1d6 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -600,13 +600,16 @@ tc_hs_type mode (HsExplicitListTy _k tys) exp_kind
     mk_nil  k     = mkTyConApp (promoteDataCon nilDataCon) [k]
 
 tc_hs_type mode (HsExplicitTupleTy _ tys) exp_kind
-  = do { tks <- mapM (tc_infer_lhs_type mode) tys
-       ; let n          = length tys
-             kind_con   = tupleTyCon           Boxed n
-             ty_con     = promotedTupleDataCon Boxed n
-             (taus, ks) = unzip tks
+  -- using newMetaKindVar means that we force instantiations of any polykinded
+  -- types. At first, I just used tc_infer_lhs_type, but that led to #11255.
+  = do { ks   <- replicateM arity newMetaKindVar
+       ; taus <- zipWithM (tc_lhs_type mode) tys ks
+       ; let kind_con   = tupleTyCon           Boxed arity
+             ty_con     = promotedTupleDataCon Boxed arity
              tup_k      = mkTyConApp kind_con ks
        ; checkExpectedKind (mkTyConApp ty_con (ks ++ taus)) tup_k exp_kind }
+  where
+    arity = length tys
 
 --------- Constraint types
 tc_hs_type mode (HsIParamTy n ty) exp_kind
diff --git a/testsuite/tests/polykinds/T11255.hs b/testsuite/tests/polykinds/T11255.hs
new file mode 100644
index 0000000..0126132
--- /dev/null
+++ b/testsuite/tests/polykinds/T11255.hs
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, UndecidableInstances #-}
+
+module T11255 where
+
+type family Default :: k
+type instance Default = '(Default, Default)
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 5a8a904..5a11ac7 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -131,3 +131,4 @@ test('TidyClassKinds', normal, compile_fail, ['-fprint-explicit-kinds'])
 test('T11249', normal, compile, [''])
 test('T11248', normal, compile, [''])
 test('T11278', normal, compile, [''])
+test('T11255', normal, compile, [''])