diff options
Diffstat (limited to 'compiler/GHC/Core/InstEnv.hs')
| -rw-r--r-- | compiler/GHC/Core/InstEnv.hs | 47 |
1 files changed, 18 insertions, 29 deletions
diff --git a/compiler/GHC/Core/InstEnv.hs b/compiler/GHC/Core/InstEnv.hs index 0a5b306705..840465425f 100644 --- a/compiler/GHC/Core/InstEnv.hs +++ b/compiler/GHC/Core/InstEnv.hs @@ -49,7 +49,7 @@ import GHC.Types.Basic import GHC.Types.Unique.DFM import GHC.Types.Id import Data.Data ( Data ) -import Data.Maybe ( isJust, isNothing ) +import Data.Maybe ( isJust ) import GHC.Utils.Misc import GHC.Utils.Outputable @@ -70,8 +70,8 @@ data ClsInst = ClsInst { -- Used for "rough matching"; see -- Note [ClsInst laziness and the rough-match fields] -- INVARIANT: is_tcs = roughMatchTcs is_tys - is_cls_nm :: Name -- ^ Class name - , is_tcs :: [Maybe Name] -- ^ Top of type args + is_cls_nm :: Name -- ^ Class name + , is_tcs :: [RoughMatchTc] -- ^ Top of type args -- | @is_dfun_name = idName . is_dfun@. -- @@ -107,10 +107,10 @@ fuzzyClsInstCmp x y = stableNameCmp (is_cls_nm x) (is_cls_nm y) `mappend` mconcat (map cmp (zip (is_tcs x) (is_tcs y))) where - cmp (Nothing, Nothing) = EQ - cmp (Nothing, Just _) = LT - cmp (Just _, Nothing) = GT - cmp (Just x, Just y) = stableNameCmp x y + cmp (OtherTc, OtherTc) = EQ + cmp (OtherTc, KnownTc _) = LT + cmp (KnownTc _, OtherTc) = GT + cmp (KnownTc x, KnownTc y) = stableNameCmp x y isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool isOverlappable i = hasOverlappableFlag (overlapMode (is_flag i)) @@ -135,25 +135,16 @@ We avoid this as follows: pull in interfaces that it refers to. See Note [Proper-match fields]. * Rough-match fields. During instance lookup, we use the is_cls_nm :: Name and - is_tcs :: [Maybe Name] fields to perform a "rough match", *without* poking + is_tcs :: [RoughMatchTc] fields to perform a "rough match", *without* poking inside the DFunId. The rough-match fields allow us to say "definitely does not - match", based only on Names. + match", based only on Names. See GHC.Core.Unify + Note [Rough matching in class and family instances] This laziness is very important; see #12367. Try hard to avoid pulling on the structured fields unless you really need the instance. * Another place to watch is InstEnv.instIsVisible, which needs the module to which the ClsInst belongs. We can get this from is_dfun_name. - -* In is_tcs, - Nothing means that this type arg is a type variable - - (Just n) means that this type arg is a - TyConApp with a type constructor of n. - This is always a real tycon, never a synonym! - (Two different synonyms might match, but two - different real tycons can't.) - NB: newtypes are not transparent, though! -} {- @@ -206,10 +197,9 @@ updateClsInstDFun :: (DFunId -> DFunId) -> ClsInst -> ClsInst updateClsInstDFun tidy_dfun ispec = ispec { is_dfun = tidy_dfun (is_dfun ispec) } -instanceRoughTcs :: ClsInst -> [Maybe Name] +instanceRoughTcs :: ClsInst -> [RoughMatchTc] instanceRoughTcs = is_tcs - instance NamedThing ClsInst where getName ispec = getName (is_dfun ispec) @@ -300,12 +290,12 @@ mkLocalInstance dfun oflag tvs cls tys choose_one nss = chooseOrphanAnchor (unionNameSets nss) -mkImportedInstance :: Name -- ^ the name of the class - -> [Maybe Name] -- ^ the types which the class was applied to - -> Name -- ^ the 'Name' of the dictionary binding - -> DFunId -- ^ the 'Id' of the dictionary. - -> OverlapFlag -- ^ may this instance overlap? - -> IsOrphan -- ^ is this instance an orphan? +mkImportedInstance :: Name -- ^ the name of the class + -> [RoughMatchTc] -- ^ the types which the class was applied to + -> Name -- ^ the 'Name' of the dictionary binding + -> DFunId -- ^ the 'Id' of the dictionary. + -> OverlapFlag -- ^ may this instance overlap? + -> IsOrphan -- ^ is this instance an orphan? -> ClsInst -- Used for imported instances, where we get the rough-match stuff -- from the interface file @@ -842,7 +832,6 @@ lookupInstEnv' ie vis_mods cls tys = lookup ie where rough_tcs = roughMatchTcs tys - all_tvs = all isNothing rough_tcs -------------- lookup env = case lookupUDFM env cls of @@ -871,7 +860,7 @@ lookupInstEnv' ie vis_mods cls tys | otherwise = ASSERT2( tys_tv_set `disjointVarSet` tpl_tv_set, - (ppr cls <+> ppr tys <+> ppr all_tvs) $$ + (ppr cls <+> ppr tys) $$ (ppr tpl_tvs <+> ppr tpl_tys) ) -- Unification will break badly if the variables overlap |