diff options
author | Richard Eisenberg <eir@cis.upenn.edu> | 2015-12-18 15:53:26 -0500 |
---|---|---|
committer | Richard Eisenberg <eir@cis.upenn.edu> | 2015-12-26 09:14:58 -0500 |
commit | 5e4e9e00dd36bf6316a406a14bc9482c7bcff527 (patch) | |
tree | 6dddffef93fb107f9f90e561fca4c663a5545716 | |
parent | bc8cac12f54bf032eb8578f6b112403bee5cb2de (diff) | |
download | haskell-5e4e9e00dd36bf6316a406a14bc9482c7bcff527.tar.gz |
Fix #11255.
We need to instantiate types in tuples. Quite straightforward.
-rw-r--r-- | compiler/typecheck/TcHsType.hs | 13 | ||||
-rw-r--r-- | testsuite/tests/polykinds/T11255.hs | 6 | ||||
-rw-r--r-- | 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 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, ['']) |