diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-02-08 22:46:32 +0000 |
|---|---|---|
| committer | Simon Peyton Jones <simonpj@microsoft.com> | 2021-02-12 14:16:16 +0000 |
| commit | 101b242a23a72a140f3ca2248732847401084da3 (patch) | |
| tree | b1a1d606200bfca42e24a1594691fd1fa79b5a5a /compiler/GHC/Tc | |
| parent | 40983d2331fe34c0af6925db7588d5ac6a19ae36 (diff) | |
| download | haskell-wip/T19336.tar.gz | |
Fix a serious bug in roughMatchTcswip/T19336
The roughMatchTcs function enables a quick definitely-no-match test
in lookupInstEnv. Unfortunately, it didn't account for type families.
This didn't matter when type families were flattened away, but now
they aren't flattened it matters a lot.
The fix is very easy. See INVARIANT in GHC.Core.InstEnv
Note [ClsInst laziness and the rough-match fields]
Fixes #19336
The change makes compiler perf worse on two very-type-family-heavy
benchmarks, T9872{a,d}:
T9872a(normal) ghc/alloc 2172536442.7 2216337648.0 +2.0%
T9872d(normal) ghc/alloc 614584024.0 621081384.0 +1.1%
(Everything else is 0.0% or at most 0.1%.)
I think we just have to put up with this. Some cases were being
wrongly filtered out by roughMatchTcs that might actually match, which
could lead to false apartness checks. And it only affects these very
type-family-heavy cases.
Metric Increase:
T9872a
T9872d
Diffstat (limited to 'compiler/GHC/Tc')
| -rw-r--r-- | compiler/GHC/Tc/Instance/FunDeps.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Tc/Module.hs | 3 |
2 files changed, 5 insertions, 4 deletions
diff --git a/compiler/GHC/Tc/Instance/FunDeps.hs b/compiler/GHC/Tc/Instance/FunDeps.hs index 3abb0140b1..623ed147ff 100644 --- a/compiler/GHC/Tc/Instance/FunDeps.hs +++ b/compiler/GHC/Tc/Instance/FunDeps.hs @@ -236,7 +236,7 @@ improveFromInstEnv _ _ _ = [] improveClsFD :: [TyVar] -> FunDep TyVar -- One functional dependency from the class -> ClsInst -- An instance template - -> [Type] -> [Maybe Name] -- Arguments of this (C tys) predicate + -> [Type] -> [RoughMatchTc] -- Arguments of this (C tys) predicate -> [([TyCoVar], [TypeEqn])] -- Empty or singleton improveClsFD clas_tvs fd @@ -666,7 +666,7 @@ checkFunDeps inst_envs (ClsInst { is_tvs = qtvs1, is_cls = cls -- instance C Int Char Char -- The second instance conflicts with the first by *both* fundeps -trimRoughMatchTcs :: [TyVar] -> FunDep TyVar -> [Maybe Name] -> [Maybe Name] +trimRoughMatchTcs :: [TyVar] -> FunDep TyVar -> [RoughMatchTc] -> [RoughMatchTc] -- Computing rough_tcs for a particular fundep -- class C a b c | a -> b where ... -- For each instance .... => C ta tb tc @@ -679,4 +679,4 @@ trimRoughMatchTcs clas_tvs (ltvs, _) mb_tcs = zipWith select clas_tvs mb_tcs where select clas_tv mb_tc | clas_tv `elem` ltvs = mb_tc - | otherwise = Nothing + | otherwise = OtherTc diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 75a5bda5fe..6d9770d7f1 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -114,6 +114,7 @@ import GHC.Core.DataCon import GHC.Core.Type import GHC.Core.Class import GHC.Core.Coercion.Axiom +import GHC.Core.Unify( RoughMatchTc(..) ) import GHC.Core.FamInstEnv ( FamInst, pprFamInst, famInstsRepTyCons , famInstEnvElts, extendFamInstEnvList, normaliseType ) @@ -1679,7 +1680,7 @@ tcMissingParentClassWarn warnFlag isName shouldName -- "<location>: Warning: <type> is an instance of <is> but not -- <should>" e.g. "Foo is an instance of Monad but not Applicative" ; let instLoc = srcLocSpan . nameSrcLoc $ getName isInst - warnMsg (Just name:_) = + warnMsg (KnownTc name:_) = addWarnAt (Reason warnFlag) instLoc $ hsep [ (quotes . ppr . nameOccName) name , text "is an instance of" |