diff options
| author | Simon Peyton Jones <simonpj@microsoft.com> | 2021-02-08 22:46:32 +0000 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2021-02-13 21:32:38 -0500 |
| commit | be3c0d62c73361b8805a51a88770991c3b6f9331 (patch) | |
| tree | 3b80955de8b3499c95259cc1294ea825cefaac36 /compiler/GHC/IfaceToCore.hs | |
| parent | dcc4b2de37f73a05a106b78bae0b99eb9715cf01 (diff) | |
| download | haskell-be3c0d62c73361b8805a51a88770991c3b6f9331.tar.gz | |
Fix a serious bug in roughMatchTcs
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/IfaceToCore.hs')
| -rw-r--r-- | compiler/GHC/IfaceToCore.hs | 9 |
1 files changed, 7 insertions, 2 deletions
diff --git a/compiler/GHC/IfaceToCore.hs b/compiler/GHC/IfaceToCore.hs index 0cc11a1bab..5a843c5e7e 100644 --- a/compiler/GHC/IfaceToCore.hs +++ b/compiler/GHC/IfaceToCore.hs @@ -53,6 +53,7 @@ import GHC.Core.TyCo.Subst ( substTyCoVars ) import GHC.Core.InstEnv import GHC.Core.FamInstEnv import GHC.Core +import GHC.Core.Unify( RoughMatchTc(..) ) import GHC.Core.Utils import GHC.Core.Unfold.Make import GHC.Core.Lint @@ -1145,13 +1146,17 @@ look at it. ************************************************************************ -} +tcRoughTyCon :: Maybe IfaceTyCon -> RoughMatchTc +tcRoughTyCon (Just tc) = KnownTc (ifaceTyConName tc) +tcRoughTyCon Nothing = OtherTc + tcIfaceInst :: IfaceClsInst -> IfL ClsInst tcIfaceInst (IfaceClsInst { ifDFun = dfun_name, ifOFlag = oflag , ifInstCls = cls, ifInstTys = mb_tcs , ifInstOrph = orph }) = do { dfun <- forkM (text "Dict fun" <+> ppr dfun_name) $ fmap tyThingId (tcIfaceImplicit dfun_name) - ; let mb_tcs' = map (fmap ifaceTyConName) mb_tcs + ; let mb_tcs' = map tcRoughTyCon mb_tcs ; return (mkImportedInstance cls mb_tcs' dfun_name dfun oflag orph) } tcIfaceFamInst :: IfaceFamInst -> IfL FamInst @@ -1161,7 +1166,7 @@ tcIfaceFamInst (IfaceFamInst { ifFamInstFam = fam, ifFamInstTys = mb_tcs tcIfaceCoAxiom axiom_name -- will panic if branched, but that's OK ; let axiom'' = toUnbranchedAxiom axiom' - mb_tcs' = map (fmap ifaceTyConName) mb_tcs + mb_tcs' = map tcRoughTyCon mb_tcs ; return (mkImportedFamInst fam mb_tcs' axiom'') } {- |