Commit 8c7f90ab authored by Simon Peyton Jones's avatar Simon Peyton Jones

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.
parent db6f1d9c
......@@ -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
......
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’
......@@ -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, [''])
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment