Fix #11255.
authorRichard Eisenberg <eir@cis.upenn.edu>
Fri, 18 Dec 2015 20:53:26 +0000 (15:53 -0500)
committerRichard Eisenberg <eir@cis.upenn.edu>
Sat, 26 Dec 2015 14:14:58 +0000 (09:14 -0500)
We need to instantiate types in tuples. Quite straightforward.

compiler/typecheck/TcHsType.hs
testsuite/tests/polykinds/T11255.hs [new file with mode: 0644]
testsuite/tests/polykinds/all.T

index 6214a8a..7e4e1d6 100644 (file)
@@ -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 (file)
index 0000000..0126132
--- /dev/null
@@ -0,0 +1,6 @@
+{-# LANGUAGE TypeFamilies, PolyKinds, DataKinds, UndecidableInstances #-}
+
+module T11255 where
+
+type family Default :: k
+type instance Default = '(Default, Default)
index 5a8a904..5a11ac7 100644 (file)
@@ -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, [''])