diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2018-08-22 10:00:20 +0100 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2018-08-23 11:40:51 +0100 |
commit | 8c7f90abcc1e8f9f29b751f23174e8db89ba6983 (patch) | |
tree | 09ee6f191eef2ddff8e192bce42b80be9c254a69 | |
parent | db6f1d9cfc74690798645a7cc5b25040c36bb35d (diff) | |
download | haskell-8c7f90abcc1e8f9f29b751f23174e8db89ba6983.tar.gz |
Fix a typo in TcValidity.checkFamInstRhs
In error message generation we were using the wrong
type constructor in inst_head. Result: the type became
ill-kinded, and that sent the compiler into a loop.
A separate patch fixes the loop. This patch fixes the
actual bug -- Trac #15473.
I also improved the "occurs more often" error message
a bit. But it's still pretty terrible:
* Variable ‘a’ occurs more often
in the type family application ‘Undefined’
than in the instance head ‘LetInterleave xs t ts is y z’
It looks like nonsense, but all becomes clear if you use
-fprint-explicit-kinds. Really we should fix this by spotting
when invisible arguments are involved and at least suggesting
-fprint-explicit-kinds.
-rw-r--r-- | compiler/typecheck/TcValidity.hs | 24 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/T15473.stderr | 8 | ||||
-rw-r--r-- | testsuite/tests/typecheck/should_compile/all.T | 2 |
3 files changed, 23 insertions, 11 deletions
diff --git a/compiler/typecheck/TcValidity.hs b/compiler/typecheck/TcValidity.hs index 2682367ae1..d773420b2c 100644 --- a/compiler/typecheck/TcValidity.hs +++ b/compiler/typecheck/TcValidity.hs @@ -63,7 +63,7 @@ import Unique ( mkAlphaTyVarUnique ) import qualified GHC.LanguageExtensions as LangExt import Control.Monad -import Data.List ( (\\) ) +import Data.List ( (\\), nub ) import qualified Data.List.NonEmpty as NE {- @@ -1570,13 +1570,14 @@ smallerMsg what inst_head noMoreMsg :: [TcTyVar] -> SDoc -> SDoc -> SDoc noMoreMsg tvs what inst_head - = vcat [ hang (text "Variable" <> plural tvs <+> quotes (pprWithCommas ppr tvs) + = vcat [ hang (text "Variable" <> plural tvs1 <+> quotes (pprWithCommas ppr tvs1) <+> occurs <+> text "more often") 2 (sep [ text "in the" <+> what , text "than in the instance head" <+> quotes inst_head ]) , parens undecidableMsg ] where - occurs = if isSingleton tvs then text "occurs" + tvs1 = nub tvs + occurs = if isSingleton tvs1 then text "occurs" else text "occur" undecidableMsg, constraintKindsMsg :: SDoc @@ -1928,22 +1929,25 @@ checkValidTyFamEqn mb_clsinfo fam_tc tvs cvs typats rhs pp_lhs loc checkFamInstRhs :: TyCon -> [Type] -- LHS -> [(TyCon, [Type])] -- type family calls in RHS -> [MsgDoc] -checkFamInstRhs tc lhsTys famInsts +checkFamInstRhs lhs_tc lhs_tys famInsts = mapMaybe check famInsts where - lhs_size = sizeTyConAppArgs tc lhsTys - fvs = fvTypes lhsTys + lhs_size = sizeTyConAppArgs lhs_tc lhs_tys + inst_head = pprType (TyConApp lhs_tc lhs_tys) + lhs_fvs = fvTypes lhs_tys check (tc, tys) | not (all isTyFamFree tys) = Just (nestedMsg what) | not (null bad_tvs) = Just (noMoreMsg bad_tvs what inst_head) | lhs_size <= fam_app_size = Just (smallerMsg what inst_head) | otherwise = Nothing where - what = text "type family application" - <+> quotes (pprType (TyConApp tc tys)) - inst_head = pprType (TyConApp tc lhsTys) - bad_tvs = fvTypes tys \\ fvs + what = text "type family application" + <+> quotes (pprType (TyConApp tc tys)) fam_app_size = sizeTyConAppArgs tc tys + bad_tvs = fvTypes tys \\ lhs_fvs + -- The (\\) is list difference; e.g. + -- [a,b,a,a] \\ [a,a] = [b,a] + -- So we are counting repetitions checkValidFamPats :: Maybe ClsInstInfo -> TyCon -> [TyVar] -> [CoVar] -> [Type] -- ^ patterns the user wrote diff --git a/testsuite/tests/typecheck/should_compile/T15473.stderr b/testsuite/tests/typecheck/should_compile/T15473.stderr new file mode 100644 index 0000000000..6fdeaa115c --- /dev/null +++ b/testsuite/tests/typecheck/should_compile/T15473.stderr @@ -0,0 +1,8 @@ + +T15473.hs:11:3: error: + • Variable ‘a’ occurs more often + in the type family application ‘Undefined’ + than in the instance head ‘LetInterleave xs t ts is y z’ + (Use UndecidableInstances to permit this) + • In the equations for closed type family ‘LetInterleave’ + In the type family declaration for ‘LetInterleave’ diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T index 75f9aba433..64df3a89d4 100644 --- a/testsuite/tests/typecheck/should_compile/all.T +++ b/testsuite/tests/typecheck/should_compile/all.T @@ -647,5 +647,5 @@ test('T15431a', normal, compile, ['']) test('T15428', normal, compile, ['']) test('T15412', normal, compile, ['']) test('T15141', normal, compile, ['']) -test('T15473', expect_broken(15473), compile, ['']) +test('T15473', normal, compile_fail, ['']) test('T15499', normal, compile, ['']) |