summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRichard Eisenberg <eir@cis.upenn.edu>2015-12-18 15:53:26 -0500
committerRichard Eisenberg <eir@cis.upenn.edu>2015-12-26 09:14:58 -0500
commit5e4e9e00dd36bf6316a406a14bc9482c7bcff527 (patch)
tree6dddffef93fb107f9f90e561fca4c663a5545716
parentbc8cac12f54bf032eb8578f6b112403bee5cb2de (diff)
downloadhaskell-5e4e9e00dd36bf6316a406a14bc9482c7bcff527.tar.gz
Fix #11255.
We need to instantiate types in tuples. Quite straightforward.
-rw-r--r--compiler/typecheck/TcHsType.hs13
-rw-r--r--testsuite/tests/polykinds/T11255.hs6
-rw-r--r--testsuite/tests/polykinds/all.T1
3 files changed, 15 insertions, 5 deletions
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 6214a8a94d..7e4e1d6d20 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 0000000000..01261325b3
--- /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 5a8a9043ab..5a11ac78e5 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, [''])