diff options
Diffstat (limited to 'compiler/GHC/Core/Unify.hs')
| -rw-r--r-- | compiler/GHC/Core/Unify.hs | 33 |
1 files changed, 8 insertions, 25 deletions
diff --git a/compiler/GHC/Core/Unify.hs b/compiler/GHC/Core/Unify.hs index a4dbdcb75d..a18899ec09 100644 --- a/compiler/GHC/Core/Unify.hs +++ b/compiler/GHC/Core/Unify.hs @@ -11,8 +11,8 @@ module GHC.Core.Unify ( tcMatchTyX_BM, ruleMatchTyKiX, -- * Rough matching - RoughMatchTc(..), roughMatchTcs, instanceCantMatch, - typesCantMatch, isRoughOtherTc, + RoughMatchTc(..), roughMatchTcs, roughMatchTcsLookup, instanceCantMatch, + typesCantMatch, isRoughWildcard, -- Side-effect free unification tcUnifyTy, tcUnifyTyKi, tcUnifyTys, tcUnifyTyKis, @@ -39,6 +39,7 @@ import GHC.Core.TyCon import GHC.Core.TyCo.Rep import GHC.Core.TyCo.FVs ( tyCoVarsOfCoList, tyCoFVsOfTypes ) import GHC.Core.TyCo.Subst ( mkTvSubst ) +import GHC.Core.RoughMap import GHC.Core.Map.Type import GHC.Utils.FV( FV, fvVarSet, fvVarList ) import GHC.Utils.Misc @@ -49,11 +50,9 @@ import GHC.Types.Unique.FM import GHC.Types.Unique.Set import {-# SOURCE #-} GHC.Tc.Utils.TcType ( tcEqType ) import GHC.Exts( oneShot ) -import GHC.Utils.Panic import GHC.Utils.Panic.Plain import GHC.Data.FastString -import Data.Data ( Data ) import Data.List ( mapAccumL ) import Control.Monad import qualified Data.Semigroup as S @@ -291,27 +290,11 @@ But it is never albeit perhaps only after 'a' is instantiated. -} -data RoughMatchTc - = KnownTc Name -- INVARIANT: Name refers to a TyCon tc that responds - -- true to `isGenerativeTyCon tc Nominal`. See - -- Note [Rough matching in class and family instances] - | OtherTc -- e.g. type variable at the head - deriving( Data ) - -isRoughOtherTc :: RoughMatchTc -> Bool -isRoughOtherTc OtherTc = True -isRoughOtherTc (KnownTc {}) = False - roughMatchTcs :: [Type] -> [RoughMatchTc] -roughMatchTcs tys = map rough tys - where - rough ty - | Just (ty', _) <- splitCastTy_maybe ty = rough ty' - | Just (tc,_) <- splitTyConApp_maybe ty - , not (isTypeFamilyTyCon tc) = assertPpr (isGenerativeTyCon tc Nominal) (ppr tc) $ - KnownTc (tyConName tc) - -- See Note [Rough matching in class and family instances] - | otherwise = OtherTc +roughMatchTcs tys = map typeToRoughMatchTc tys + +roughMatchTcsLookup :: [Type] -> [RoughMatchLookupTc] +roughMatchTcsLookup tys = map typeToRoughMatchLookupTc tys instanceCantMatch :: [RoughMatchTc] -> [RoughMatchTc] -> Bool -- (instanceCantMatch tcs1 tcs2) returns True if tcs1 cannot @@ -321,7 +304,7 @@ instanceCantMatch (mt : ts) (ma : as) = itemCantMatch mt ma || instanceCantMatch instanceCantMatch _ _ = False -- Safe itemCantMatch :: RoughMatchTc -> RoughMatchTc -> Bool -itemCantMatch (KnownTc t) (KnownTc a) = t /= a +itemCantMatch (RM_KnownTc t) (RM_KnownTc a) = t /= a itemCantMatch _ _ = False |