{- (c) The University of Glasgow 2006 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 \section[InstEnv]{Utilities for typechecking instance declarations} The bits common to TcInstDcls and TcDeriv. -} {-# LANGUAGE CPP, DeriveDataTypeable #-} module InstEnv ( DFunId, InstMatch, ClsInstLookupResult, OverlapFlag(..), OverlapMode(..), setOverlapModeMaybe, ClsInst(..), DFunInstType, pprInstance, pprInstanceHdr, pprInstances, instanceHead, instanceSig, mkLocalInstance, mkImportedInstance, instanceDFunId, updateClsInstDFun, instanceRoughTcs, fuzzyClsInstCmp, orphNamesOfClsInst, InstEnvs(..), VisibleOrphanModules, InstEnv, emptyInstEnv, extendInstEnv, deleteFromInstEnv, deleteDFunFromInstEnv, identicalClsInstHead, extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv, instEnvElts, instEnvClasses, memberInstEnv, instIsVisible, classInstances, instanceBindFun, instanceCantMatch, roughMatchTcs, isOverlappable, isOverlapping, isIncoherent ) where #include "HsVersions.h" import GhcPrelude import TcType -- InstEnv is really part of the type checker, -- and depends on TcType in many ways import CoreSyn ( IsOrphan(..), isOrphan, chooseOrphanAnchor ) import Module import Class import Var import VarSet import Name import NameSet import Unify import Outputable import ErrUtils import BasicTypes import UniqDFM import Util import Id import Data.Data ( Data ) import Data.Maybe ( isJust, isNothing ) {- ************************************************************************ * * ClsInst: the data type for type-class instances * * ************************************************************************ -} -- | A type-class instance. Note that there is some tricky laziness at work -- here. See Note [ClsInst laziness and the rough-match fields] for more -- details. data ClsInst = ClsInst { -- Used for "rough matching"; see -- Note [ClsInst laziness and the rough-match fields] -- INVARIANT: is_tcs = roughMatchTcs is_tys ClsInst -> Name is_cls_nm :: Name -- ^ Class name , ClsInst -> [Maybe Name] is_tcs :: [Maybe Name] -- ^ Top of type args -- | @is_dfun_name = idName . is_dfun@. -- -- We use 'is_dfun_name' for the visibility check, -- 'instIsVisible', which needs to know the 'Module' which the -- dictionary is defined in. However, we cannot use the 'Module' -- attached to 'is_dfun' since doing so would mean we would -- potentially pull in an entire interface file unnecessarily. -- This was the cause of #12367. , ClsInst -> Name is_dfun_name :: Name -- Used for "proper matching"; see Note [Proper-match fields] , ClsInst -> [TyVar] is_tvs :: [TyVar] -- Fresh template tyvars for full match -- See Note [Template tyvars are fresh] , ClsInst -> Class is_cls :: Class -- The real class , ClsInst -> [Type] is_tys :: [Type] -- Full arg types (mentioning is_tvs) -- INVARIANT: is_dfun Id has type -- forall is_tvs. (...) => is_cls is_tys -- (modulo alpha conversion) , ClsInst -> TyVar is_dfun :: DFunId -- See Note [Haddock assumptions] , ClsInst -> OverlapFlag is_flag :: OverlapFlag -- See detailed comments with -- the decl of BasicTypes.OverlapFlag , ClsInst -> IsOrphan is_orphan :: IsOrphan } deriving Typeable ClsInst DataType Constr Typeable ClsInst -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ClsInst -> c ClsInst) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ClsInst) -> (ClsInst -> Constr) -> (ClsInst -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ClsInst)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClsInst)) -> ((forall b. Data b => b -> b) -> ClsInst -> ClsInst) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r) -> (forall u. (forall d. Data d => d -> u) -> ClsInst -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> ClsInst -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst) -> Data ClsInst ClsInst -> DataType ClsInst -> Constr (forall b. Data b => b -> b) -> ClsInst -> ClsInst (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ClsInst -> c ClsInst (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ClsInst forall a. Typeable a -> (forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> a -> c a) -> (forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a) -> (a -> Constr) -> (a -> DataType) -> (forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c a)) -> (forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a)) -> ((forall b. Data b => b -> b) -> a -> a) -> (forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r) -> (forall u. (forall d. Data d => d -> u) -> a -> [u]) -> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u) -> (forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> (forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> a -> m a) -> Data a forall u. Int -> (forall d. Data d => d -> u) -> ClsInst -> u forall u. (forall d. Data d => d -> u) -> ClsInst -> [u] forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ClsInst forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ClsInst -> c ClsInst forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ClsInst) forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClsInst) $cClsInst :: Constr $tClsInst :: DataType gmapMo :: (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst $cgmapMo :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst gmapMp :: (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst $cgmapMp :: forall (m :: * -> *). MonadPlus m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst gmapM :: (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst $cgmapM :: forall (m :: * -> *). Monad m => (forall d. Data d => d -> m d) -> ClsInst -> m ClsInst gmapQi :: Int -> (forall d. Data d => d -> u) -> ClsInst -> u $cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ClsInst -> u gmapQ :: (forall d. Data d => d -> u) -> ClsInst -> [u] $cgmapQ :: forall u. (forall d. Data d => d -> u) -> ClsInst -> [u] gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r $cgmapQr :: forall r r'. (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r $cgmapQl :: forall r r'. (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> ClsInst -> r gmapT :: (forall b. Data b => b -> b) -> ClsInst -> ClsInst $cgmapT :: (forall b. Data b => b -> b) -> ClsInst -> ClsInst dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClsInst) $cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *). Typeable t => (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ClsInst) dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ClsInst) $cdataCast1 :: forall (t :: * -> *) (c :: * -> *). Typeable t => (forall d. Data d => c (t d)) -> Maybe (c ClsInst) dataTypeOf :: ClsInst -> DataType $cdataTypeOf :: ClsInst -> DataType toConstr :: ClsInst -> Constr $ctoConstr :: ClsInst -> Constr gunfold :: (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ClsInst $cgunfold :: forall (c :: * -> *). (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c ClsInst gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ClsInst -> c ClsInst $cgfoldl :: forall (c :: * -> *). (forall d b. Data d => c (d -> b) -> d -> c b) -> (forall g. g -> c g) -> ClsInst -> c ClsInst $cp1Data :: Typeable ClsInst Data -- | A fuzzy comparison function for class instances, intended for sorting -- instances before displaying them to the user. fuzzyClsInstCmp :: ClsInst -> ClsInst -> Ordering fuzzyClsInstCmp :: ClsInst -> ClsInst -> Ordering fuzzyClsInstCmp ClsInst x ClsInst y = Name -> Name -> Ordering stableNameCmp (ClsInst -> Name is_cls_nm ClsInst x) (ClsInst -> Name is_cls_nm ClsInst y) Ordering -> Ordering -> Ordering forall a. Monoid a => a -> a -> a `mappend` [Ordering] -> Ordering forall a. Monoid a => [a] -> a mconcat (((Maybe Name, Maybe Name) -> Ordering) -> [(Maybe Name, Maybe Name)] -> [Ordering] forall a b. (a -> b) -> [a] -> [b] map (Maybe Name, Maybe Name) -> Ordering cmp ([Maybe Name] -> [Maybe Name] -> [(Maybe Name, Maybe Name)] forall a b. [a] -> [b] -> [(a, b)] zip (ClsInst -> [Maybe Name] is_tcs ClsInst x) (ClsInst -> [Maybe Name] is_tcs ClsInst y))) where cmp :: (Maybe Name, Maybe Name) -> Ordering cmp (Maybe Name Nothing, Maybe Name Nothing) = Ordering EQ cmp (Maybe Name Nothing, Just Name _) = Ordering LT cmp (Just Name _, Maybe Name Nothing) = Ordering GT cmp (Just Name x, Just Name y) = Name -> Name -> Ordering stableNameCmp Name x Name y isOverlappable, isOverlapping, isIncoherent :: ClsInst -> Bool isOverlappable :: ClsInst -> Bool isOverlappable ClsInst i = OverlapMode -> Bool hasOverlappableFlag (OverlapFlag -> OverlapMode overlapMode (ClsInst -> OverlapFlag is_flag ClsInst i)) isOverlapping :: ClsInst -> Bool isOverlapping ClsInst i = OverlapMode -> Bool hasOverlappingFlag (OverlapFlag -> OverlapMode overlapMode (ClsInst -> OverlapFlag is_flag ClsInst i)) isIncoherent :: ClsInst -> Bool isIncoherent ClsInst i = OverlapMode -> Bool hasIncoherentFlag (OverlapFlag -> OverlapMode overlapMode (ClsInst -> OverlapFlag is_flag ClsInst i)) {- Note [ClsInst laziness and the rough-match fields] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we load 'instance A.C B.T' from A.hi, but suppose that the type B.T is otherwise unused in the program. Then it's stupid to load B.hi, the data type declaration for B.T -- and perhaps further instance declarations! We avoid this as follows: * is_cls_nm, is_tcs, is_dfun_name are all Names. We can poke them to our heart's content. * Proper-match fields. is_dfun, and its related fields is_tvs, is_cls, is_tys contain TyVars, Class, Type, Class etc, and so are all lazy thunks. When we poke any of these fields we'll typecheck the DFunId declaration, and hence 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 inside the DFunId. The rough-match fields allow us to say "definitely does not match", based only on Names. 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! -} {- Note [Template tyvars are fresh] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ The is_tvs field of a ClsInst has *completely fresh* tyvars. That is, they are * distinct from any other ClsInst * distinct from any tyvars free in predicates that may be looked up in the class instance environment Reason for freshness: we use unification when checking for overlap etc, and that requires the tyvars to be distinct. The invariant is checked by the ASSERT in lookupInstEnv'. Note [Proper-match fields] ~~~~~~~~~~~~~~~~~~~~~~~~~ The is_tvs, is_cls, is_tys fields are simply cached values, pulled out (lazily) from the dfun id. They are cached here simply so that we don't need to decompose the DFunId each time we want to match it. The hope is that the rough-match fields mean that we often never poke the proper-match fields. However, note that: * is_tvs must be a superset of the free vars of is_tys * is_tvs, is_tys may be alpha-renamed compared to the ones in the dfun Id Note [Haddock assumptions] ~~~~~~~~~~~~~~~~~~~~~~~~~~ For normal user-written instances, Haddock relies on * the SrcSpan of * the Name of * the is_dfun of * an Instance being equal to * the SrcSpan of * the instance head type of * the InstDecl used to construct the Instance. -} instanceDFunId :: ClsInst -> DFunId instanceDFunId :: ClsInst -> TyVar instanceDFunId = ClsInst -> TyVar is_dfun updateClsInstDFun :: (DFunId -> DFunId) -> ClsInst -> ClsInst updateClsInstDFun :: (TyVar -> TyVar) -> ClsInst -> ClsInst updateClsInstDFun TyVar -> TyVar tidy_dfun ClsInst ispec = ClsInst ispec { is_dfun :: TyVar is_dfun = TyVar -> TyVar tidy_dfun (ClsInst -> TyVar is_dfun ClsInst ispec) } instanceRoughTcs :: ClsInst -> [Maybe Name] instanceRoughTcs :: ClsInst -> [Maybe Name] instanceRoughTcs = ClsInst -> [Maybe Name] is_tcs instance NamedThing ClsInst where getName :: ClsInst -> Name getName ClsInst ispec = TyVar -> Name forall a. NamedThing a => a -> Name getName (ClsInst -> TyVar is_dfun ClsInst ispec) instance Outputable ClsInst where ppr :: ClsInst -> SDoc ppr = ClsInst -> SDoc pprInstance pprInstance :: ClsInst -> SDoc -- Prints the ClsInst as an instance declaration pprInstance :: ClsInst -> SDoc pprInstance ClsInst ispec = SDoc -> Int -> SDoc -> SDoc hang (ClsInst -> SDoc pprInstanceHdr ClsInst ispec) Int 2 ([SDoc] -> SDoc vcat [ String -> SDoc text String "--" SDoc -> SDoc -> SDoc <+> Name -> SDoc pprDefinedAt (ClsInst -> Name forall a. NamedThing a => a -> Name getName ClsInst ispec) , SDoc -> SDoc whenPprDebug (TyVar -> SDoc forall a. Outputable a => a -> SDoc ppr (ClsInst -> TyVar is_dfun ClsInst ispec)) ]) -- * pprInstanceHdr is used in VStudio to populate the ClassView tree pprInstanceHdr :: ClsInst -> SDoc -- Prints the ClsInst as an instance declaration pprInstanceHdr :: ClsInst -> SDoc pprInstanceHdr (ClsInst { is_flag :: ClsInst -> OverlapFlag is_flag = OverlapFlag flag, is_dfun :: ClsInst -> TyVar is_dfun = TyVar dfun }) = String -> SDoc text String "instance" SDoc -> SDoc -> SDoc <+> OverlapFlag -> SDoc forall a. Outputable a => a -> SDoc ppr OverlapFlag flag SDoc -> SDoc -> SDoc <+> Type -> SDoc pprSigmaType (TyVar -> Type idType TyVar dfun) pprInstances :: [ClsInst] -> SDoc pprInstances :: [ClsInst] -> SDoc pprInstances [ClsInst] ispecs = [SDoc] -> SDoc vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc] forall a b. (a -> b) -> [a] -> [b] map ClsInst -> SDoc pprInstance [ClsInst] ispecs) instanceHead :: ClsInst -> ([TyVar], Class, [Type]) -- Returns the head, using the fresh tyavs from the ClsInst instanceHead :: ClsInst -> ([TyVar], Class, [Type]) instanceHead (ClsInst { is_tvs :: ClsInst -> [TyVar] is_tvs = [TyVar] tvs, is_tys :: ClsInst -> [Type] is_tys = [Type] tys, is_dfun :: ClsInst -> TyVar is_dfun = TyVar dfun }) = ([TyVar] tvs, Class cls, [Type] tys) where ([TyVar] _, [Type] _, Class cls, [Type] _) = Type -> ([TyVar], [Type], Class, [Type]) tcSplitDFunTy (TyVar -> Type idType TyVar dfun) -- | Collects the names of concrete types and type constructors that make -- up the head of a class instance. For instance, given `class Foo a b`: -- -- `instance Foo (Either (Maybe Int) a) Bool` would yield -- [Either, Maybe, Int, Bool] -- -- Used in the implementation of ":info" in GHCi. -- -- The 'tcSplitSigmaTy' is because of -- instance Foo a => Baz T where ... -- The decl is an orphan if Baz and T are both not locally defined, -- even if Foo *is* locally defined orphNamesOfClsInst :: ClsInst -> NameSet orphNamesOfClsInst :: ClsInst -> NameSet orphNamesOfClsInst (ClsInst { is_cls_nm :: ClsInst -> Name is_cls_nm = Name cls_nm, is_tys :: ClsInst -> [Type] is_tys = [Type] tys }) = [Type] -> NameSet orphNamesOfTypes [Type] tys NameSet -> NameSet -> NameSet `unionNameSet` Name -> NameSet unitNameSet Name cls_nm instanceSig :: ClsInst -> ([TyVar], [Type], Class, [Type]) -- Decomposes the DFunId instanceSig :: ClsInst -> ([TyVar], [Type], Class, [Type]) instanceSig ClsInst ispec = Type -> ([TyVar], [Type], Class, [Type]) tcSplitDFunTy (TyVar -> Type idType (ClsInst -> TyVar is_dfun ClsInst ispec)) mkLocalInstance :: DFunId -> OverlapFlag -> [TyVar] -> Class -> [Type] -> ClsInst -- Used for local instances, where we can safely pull on the DFunId. -- Consider using newClsInst instead; this will also warn if -- the instance is an orphan. mkLocalInstance :: TyVar -> OverlapFlag -> [TyVar] -> Class -> [Type] -> ClsInst mkLocalInstance TyVar dfun OverlapFlag oflag [TyVar] tvs Class cls [Type] tys = ClsInst :: Name -> [Maybe Name] -> Name -> [TyVar] -> Class -> [Type] -> TyVar -> OverlapFlag -> IsOrphan -> ClsInst ClsInst { is_flag :: OverlapFlag is_flag = OverlapFlag oflag, is_dfun :: TyVar is_dfun = TyVar dfun , is_tvs :: [TyVar] is_tvs = [TyVar] tvs , is_dfun_name :: Name is_dfun_name = Name dfun_name , is_cls :: Class is_cls = Class cls, is_cls_nm :: Name is_cls_nm = Name cls_name , is_tys :: [Type] is_tys = [Type] tys, is_tcs :: [Maybe Name] is_tcs = [Type] -> [Maybe Name] roughMatchTcs [Type] tys , is_orphan :: IsOrphan is_orphan = IsOrphan orph } where cls_name :: Name cls_name = Class -> Name className Class cls dfun_name :: Name dfun_name = TyVar -> Name idName TyVar dfun this_mod :: Module this_mod = ASSERT( isExternalName dfun_name ) nameModule dfun_name is_local :: Name -> Bool is_local Name name = Module -> Name -> Bool nameIsLocalOrFrom Module this_mod Name name -- Compute orphanhood. See Note [Orphans] in InstEnv ([TyVar] cls_tvs, [FunDep TyVar] fds) = Class -> ([TyVar], [FunDep TyVar]) classTvsFds Class cls arg_names :: [NameSet] arg_names = [(Name -> Bool) -> NameSet -> NameSet filterNameSet Name -> Bool is_local (Type -> NameSet orphNamesOfType Type ty) | Type ty <- [Type] tys] -- See Note [When exactly is an instance decl an orphan?] orph :: IsOrphan orph | Name -> Bool is_local Name cls_name = OccName -> IsOrphan NotOrphan (Name -> OccName nameOccName Name cls_name) | (IsOrphan -> Bool) -> [IsOrphan] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all IsOrphan -> Bool notOrphan [IsOrphan] mb_ns = ASSERT( not (null mb_ns) ) head mb_ns | Bool otherwise = IsOrphan IsOrphan notOrphan :: IsOrphan -> Bool notOrphan NotOrphan{} = Bool True notOrphan IsOrphan _ = Bool False mb_ns :: [IsOrphan] -- One for each fundep; a locally-defined name -- that is not in the "determined" arguments mb_ns :: [IsOrphan] mb_ns | [FunDep TyVar] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [FunDep TyVar] fds = [[NameSet] -> IsOrphan choose_one [NameSet] arg_names] | Bool otherwise = (FunDep TyVar -> IsOrphan) -> [FunDep TyVar] -> [IsOrphan] forall a b. (a -> b) -> [a] -> [b] map FunDep TyVar -> IsOrphan forall (t :: * -> *) a. Foldable t => (a, t TyVar) -> IsOrphan do_one [FunDep TyVar] fds do_one :: (a, t TyVar) -> IsOrphan do_one (a _ltvs, t TyVar rtvs) = [NameSet] -> IsOrphan choose_one [NameSet ns | (TyVar tv,NameSet ns) <- [TyVar] cls_tvs [TyVar] -> [NameSet] -> [(TyVar, NameSet)] forall a b. [a] -> [b] -> [(a, b)] `zip` [NameSet] arg_names , Bool -> Bool not (TyVar tv TyVar -> t TyVar -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool `elem` t TyVar rtvs)] choose_one :: [NameSet] -> IsOrphan choose_one [NameSet] nss = NameSet -> IsOrphan chooseOrphanAnchor ([NameSet] -> NameSet unionNameSets [NameSet] 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? -> ClsInst -- Used for imported instances, where we get the rough-match stuff -- from the interface file -- The bound tyvars of the dfun are guaranteed fresh, because -- the dfun has been typechecked out of the same interface file mkImportedInstance :: Name -> [Maybe Name] -> Name -> TyVar -> OverlapFlag -> IsOrphan -> ClsInst mkImportedInstance Name cls_nm [Maybe Name] mb_tcs Name dfun_name TyVar dfun OverlapFlag oflag IsOrphan orphan = ClsInst :: Name -> [Maybe Name] -> Name -> [TyVar] -> Class -> [Type] -> TyVar -> OverlapFlag -> IsOrphan -> ClsInst ClsInst { is_flag :: OverlapFlag is_flag = OverlapFlag oflag, is_dfun :: TyVar is_dfun = TyVar dfun , is_tvs :: [TyVar] is_tvs = [TyVar] tvs, is_tys :: [Type] is_tys = [Type] tys , is_dfun_name :: Name is_dfun_name = Name dfun_name , is_cls_nm :: Name is_cls_nm = Name cls_nm, is_cls :: Class is_cls = Class cls, is_tcs :: [Maybe Name] is_tcs = [Maybe Name] mb_tcs , is_orphan :: IsOrphan is_orphan = IsOrphan orphan } where ([TyVar] tvs, [Type] _, Class cls, [Type] tys) = Type -> ([TyVar], [Type], Class, [Type]) tcSplitDFunTy (TyVar -> Type idType TyVar dfun) {- Note [When exactly is an instance decl an orphan?] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ (see MkIface.instanceToIfaceInst, which implements this) Roughly speaking, an instance is an orphan if its head (after the =>) mentions nothing defined in this module. Functional dependencies complicate the situation though. Consider module M where { class C a b | a -> b } and suppose we are compiling module X: module X where import M data T = ... instance C Int T where ... This instance is an orphan, because when compiling a third module Y we might get a constraint (C Int v), and we'd want to improve v to T. So we must make sure X's instances are loaded, even if we do not directly use anything from X. More precisely, an instance is an orphan iff If there are no fundeps, then at least of the names in the instance head is locally defined. If there are fundeps, then for every fundep, at least one of the names free in a *non-determined* part of the instance head is defined in this module. (Note that these conditions hold trivially if the class is locally defined.) ************************************************************************ * * InstEnv, ClsInstEnv * * ************************************************************************ A @ClsInstEnv@ all the instances of that class. The @Id@ inside a ClsInstEnv mapping is the dfun for that instance. If class C maps to a list containing the item ([a,b], [t1,t2,t3], dfun), then forall a b, C t1 t2 t3 can be constructed by dfun or, to put it another way, we have instance (...) => C t1 t2 t3, witnessed by dfun -} --------------------------------------------------- {- Note [InstEnv determinism] ~~~~~~~~~~~~~~~~~~~~~~~~~~ We turn InstEnvs into a list in some places that don't directly affect the ABI. That happens when we create output for `:info`. Unfortunately that nondeterminism is nonlocal and it's hard to tell what it affects without following a chain of functions. It's also easy to accidentally make that nondeterminism affect the ABI. Furthermore the envs should be relatively small, so it should be free to use deterministic maps here. Testing with nofib and validate detected no difference between UniqFM and UniqDFM. See also Note [Deterministic UniqFM] -} type InstEnv = UniqDFM ClsInstEnv -- Maps Class to instances for that class -- See Note [InstEnv determinism] -- | 'InstEnvs' represents the combination of the global type class instance -- environment, the local type class instance environment, and the set of -- transitively reachable orphan modules (according to what modules have been -- directly imported) used to test orphan instance visibility. data InstEnvs = InstEnvs { InstEnvs -> InstEnv ie_global :: InstEnv, -- External-package instances InstEnvs -> InstEnv ie_local :: InstEnv, -- Home-package instances InstEnvs -> VisibleOrphanModules ie_visible :: VisibleOrphanModules -- Set of all orphan modules transitively -- reachable from the module being compiled -- See Note [Instance lookup and orphan instances] } -- | Set of visible orphan modules, according to what modules have been directly -- imported. This is based off of the dep_orphs field, which records -- transitively reachable orphan modules (modules that define orphan instances). type VisibleOrphanModules = ModuleSet newtype ClsInstEnv = ClsIE [ClsInst] -- The instances for a particular class, in any order instance Outputable ClsInstEnv where ppr :: ClsInstEnv -> SDoc ppr (ClsIE [ClsInst] is) = [ClsInst] -> SDoc pprInstances [ClsInst] is -- INVARIANTS: -- * The is_tvs are distinct in each ClsInst -- of a ClsInstEnv (so we can safely unify them) -- Thus, the @ClassInstEnv@ for @Eq@ might contain the following entry: -- [a] ===> dfun_Eq_List :: forall a. Eq a => Eq [a] -- The "a" in the pattern must be one of the forall'd variables in -- the dfun type. emptyInstEnv :: InstEnv emptyInstEnv :: InstEnv emptyInstEnv = InstEnv forall elt. UniqDFM elt emptyUDFM instEnvElts :: InstEnv -> [ClsInst] instEnvElts :: InstEnv -> [ClsInst] instEnvElts InstEnv ie = [ClsInst elt | ClsIE [ClsInst] elts <- InstEnv -> [ClsInstEnv] forall elt. UniqDFM elt -> [elt] eltsUDFM InstEnv ie, ClsInst elt <- [ClsInst] elts] -- See Note [InstEnv determinism] instEnvClasses :: InstEnv -> [Class] instEnvClasses :: InstEnv -> [Class] instEnvClasses InstEnv ie = [ClsInst -> Class is_cls ClsInst e | ClsIE (ClsInst e : [ClsInst] _) <- InstEnv -> [ClsInstEnv] forall elt. UniqDFM elt -> [elt] eltsUDFM InstEnv ie] -- | Test if an instance is visible, by checking that its origin module -- is in 'VisibleOrphanModules'. -- See Note [Instance lookup and orphan instances] instIsVisible :: VisibleOrphanModules -> ClsInst -> Bool instIsVisible :: VisibleOrphanModules -> ClsInst -> Bool instIsVisible VisibleOrphanModules vis_mods ClsInst ispec -- NB: Instances from the interactive package always are visible. We can't -- add interactive modules to the set since we keep creating new ones -- as a GHCi session progresses. = case Name -> Maybe Module nameModule_maybe (ClsInst -> Name is_dfun_name ClsInst ispec) of Maybe Module Nothing -> Bool True Just Module mod | Module -> Bool isInteractiveModule Module mod -> Bool True | IsOrphan IsOrphan <- ClsInst -> IsOrphan is_orphan ClsInst ispec -> Module mod Module -> VisibleOrphanModules -> Bool `elemModuleSet` VisibleOrphanModules vis_mods | Bool otherwise -> Bool True classInstances :: InstEnvs -> Class -> [ClsInst] classInstances :: InstEnvs -> Class -> [ClsInst] classInstances (InstEnvs { ie_global :: InstEnvs -> InstEnv ie_global = InstEnv pkg_ie, ie_local :: InstEnvs -> InstEnv ie_local = InstEnv home_ie, ie_visible :: InstEnvs -> VisibleOrphanModules ie_visible = VisibleOrphanModules vis_mods }) Class cls = InstEnv -> [ClsInst] get InstEnv home_ie [ClsInst] -> [ClsInst] -> [ClsInst] forall a. [a] -> [a] -> [a] ++ InstEnv -> [ClsInst] get InstEnv pkg_ie where get :: InstEnv -> [ClsInst] get InstEnv env = case InstEnv -> Class -> Maybe ClsInstEnv forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt lookupUDFM InstEnv env Class cls of Just (ClsIE [ClsInst] insts) -> (ClsInst -> Bool) -> [ClsInst] -> [ClsInst] forall a. (a -> Bool) -> [a] -> [a] filter (VisibleOrphanModules -> ClsInst -> Bool instIsVisible VisibleOrphanModules vis_mods) [ClsInst] insts Maybe ClsInstEnv Nothing -> [] -- | Checks for an exact match of ClsInst in the instance environment. -- We use this when we do signature checking in TcRnDriver memberInstEnv :: InstEnv -> ClsInst -> Bool memberInstEnv :: InstEnv -> ClsInst -> Bool memberInstEnv InstEnv inst_env ins_item :: ClsInst ins_item@(ClsInst { is_cls_nm :: ClsInst -> Name is_cls_nm = Name cls_nm } ) = Bool -> (ClsInstEnv -> Bool) -> Maybe ClsInstEnv -> Bool forall b a. b -> (a -> b) -> Maybe a -> b maybe Bool False (\(ClsIE [ClsInst] items) -> (ClsInst -> Bool) -> [ClsInst] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any (ClsInst -> ClsInst -> Bool identicalDFunType ClsInst ins_item) [ClsInst] items) (InstEnv -> Name -> Maybe ClsInstEnv forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt lookupUDFM InstEnv inst_env Name cls_nm) where identicalDFunType :: ClsInst -> ClsInst -> Bool identicalDFunType ClsInst cls1 ClsInst cls2 = Type -> Type -> Bool eqType (TyVar -> Type varType (ClsInst -> TyVar is_dfun ClsInst cls1)) (TyVar -> Type varType (ClsInst -> TyVar is_dfun ClsInst cls2)) extendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv extendInstEnvList :: InstEnv -> [ClsInst] -> InstEnv extendInstEnvList InstEnv inst_env [ClsInst] ispecs = (InstEnv -> ClsInst -> InstEnv) -> InstEnv -> [ClsInst] -> InstEnv forall (t :: * -> *) b a. Foldable t => (b -> a -> b) -> b -> t a -> b foldl' InstEnv -> ClsInst -> InstEnv extendInstEnv InstEnv inst_env [ClsInst] ispecs extendInstEnv :: InstEnv -> ClsInst -> InstEnv extendInstEnv :: InstEnv -> ClsInst -> InstEnv extendInstEnv InstEnv inst_env ins_item :: ClsInst ins_item@(ClsInst { is_cls_nm :: ClsInst -> Name is_cls_nm = Name cls_nm }) = (ClsInstEnv -> ClsInstEnv -> ClsInstEnv) -> InstEnv -> Name -> ClsInstEnv -> InstEnv forall key elt. Uniquable key => (elt -> elt -> elt) -> UniqDFM elt -> key -> elt -> UniqDFM elt addToUDFM_C ClsInstEnv -> ClsInstEnv -> ClsInstEnv forall p. ClsInstEnv -> p -> ClsInstEnv add InstEnv inst_env Name cls_nm ([ClsInst] -> ClsInstEnv ClsIE [ClsInst ins_item]) where add :: ClsInstEnv -> p -> ClsInstEnv add (ClsIE [ClsInst] cur_insts) p _ = [ClsInst] -> ClsInstEnv ClsIE (ClsInst ins_item ClsInst -> [ClsInst] -> [ClsInst] forall a. a -> [a] -> [a] : [ClsInst] cur_insts) deleteFromInstEnv :: InstEnv -> ClsInst -> InstEnv deleteFromInstEnv :: InstEnv -> ClsInst -> InstEnv deleteFromInstEnv InstEnv inst_env ins_item :: ClsInst ins_item@(ClsInst { is_cls_nm :: ClsInst -> Name is_cls_nm = Name cls_nm }) = (ClsInstEnv -> ClsInstEnv) -> InstEnv -> Name -> InstEnv forall key elt. Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt adjustUDFM ClsInstEnv -> ClsInstEnv adjust InstEnv inst_env Name cls_nm where adjust :: ClsInstEnv -> ClsInstEnv adjust (ClsIE [ClsInst] items) = [ClsInst] -> ClsInstEnv ClsIE ((ClsInst -> Bool) -> [ClsInst] -> [ClsInst] forall a. (a -> Bool) -> [a] -> [a] filterOut (ClsInst -> ClsInst -> Bool identicalClsInstHead ClsInst ins_item) [ClsInst] items) deleteDFunFromInstEnv :: InstEnv -> DFunId -> InstEnv -- Delete a specific instance fron an InstEnv deleteDFunFromInstEnv :: InstEnv -> TyVar -> InstEnv deleteDFunFromInstEnv InstEnv inst_env TyVar dfun = (ClsInstEnv -> ClsInstEnv) -> InstEnv -> Class -> InstEnv forall key elt. Uniquable key => (elt -> elt) -> UniqDFM elt -> key -> UniqDFM elt adjustUDFM ClsInstEnv -> ClsInstEnv adjust InstEnv inst_env Class cls where ([TyVar] _, [Type] _, Class cls, [Type] _) = Type -> ([TyVar], [Type], Class, [Type]) tcSplitDFunTy (TyVar -> Type idType TyVar dfun) adjust :: ClsInstEnv -> ClsInstEnv adjust (ClsIE [ClsInst] items) = [ClsInst] -> ClsInstEnv ClsIE ((ClsInst -> Bool) -> [ClsInst] -> [ClsInst] forall a. (a -> Bool) -> [a] -> [a] filterOut ClsInst -> Bool same_dfun [ClsInst] items) same_dfun :: ClsInst -> Bool same_dfun (ClsInst { is_dfun :: ClsInst -> TyVar is_dfun = TyVar dfun' }) = TyVar dfun TyVar -> TyVar -> Bool forall a. Eq a => a -> a -> Bool == TyVar dfun' identicalClsInstHead :: ClsInst -> ClsInst -> Bool -- ^ True when when the instance heads are the same -- e.g. both are Eq [(a,b)] -- Used for overriding in GHCi -- Obviously should be insenstive to alpha-renaming identicalClsInstHead :: ClsInst -> ClsInst -> Bool identicalClsInstHead (ClsInst { is_cls_nm :: ClsInst -> Name is_cls_nm = Name cls_nm1, is_tcs :: ClsInst -> [Maybe Name] is_tcs = [Maybe Name] rough1, is_tys :: ClsInst -> [Type] is_tys = [Type] tys1 }) (ClsInst { is_cls_nm :: ClsInst -> Name is_cls_nm = Name cls_nm2, is_tcs :: ClsInst -> [Maybe Name] is_tcs = [Maybe Name] rough2, is_tys :: ClsInst -> [Type] is_tys = [Type] tys2 }) = Name cls_nm1 Name -> Name -> Bool forall a. Eq a => a -> a -> Bool == Name cls_nm2 Bool -> Bool -> Bool && Bool -> Bool not ([Maybe Name] -> [Maybe Name] -> Bool instanceCantMatch [Maybe Name] rough1 [Maybe Name] rough2) -- Fast check for no match, uses the "rough match" fields Bool -> Bool -> Bool && Maybe TCvSubst -> Bool forall a. Maybe a -> Bool isJust ([Type] -> [Type] -> Maybe TCvSubst tcMatchTys [Type] tys1 [Type] tys2) Bool -> Bool -> Bool && Maybe TCvSubst -> Bool forall a. Maybe a -> Bool isJust ([Type] -> [Type] -> Maybe TCvSubst tcMatchTys [Type] tys2 [Type] tys1) {- ************************************************************************ * * Looking up an instance * * ************************************************************************ @lookupInstEnv@ looks up in a @InstEnv@, using a one-way match. Since the env is kept ordered, the first match must be the only one. The thing we are looking up can have an arbitrary "flexi" part. Note [Instance lookup and orphan instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Suppose we are compiling a module M, and we have a zillion packages loaded, and we are looking up an instance for C (T W). If we find a match in module 'X' from package 'p', should be "in scope"; that is, is p:X in the transitive closure of modules imported from M? The difficulty is that the "zillion packages" might include ones loaded through earlier invocations of the GHC API, or earlier module loads in GHCi. They might not be in the dependencies of M itself; and if not, the instances in them should not be visible. #2182, #8427. There are two cases: * If the instance is *not an orphan*, then module X defines C, T, or W. And in order for those types to be involved in typechecking M, it must be that X is in the transitive closure of M's imports. So we can use the instance. * If the instance *is an orphan*, the above reasoning does not apply. So we keep track of the set of orphan modules transitively below M; this is the ie_visible field of InstEnvs, of type VisibleOrphanModules. If module p:X is in this set, then we can use the instance, otherwise we can't. Note [Rules for instance lookup] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ These functions implement the carefully-written rules in the user manual section on "overlapping instances". At risk of duplication, here are the rules. If the rules change, change this text and the user manual simultaneously. The link may be this: http://www.haskell.org/ghc/docs/latest/html/users_guide/glasgow_exts.html#instance-overlap The willingness to be overlapped or incoherent is a property of the instance declaration itself, controlled as follows: * An instance is "incoherent" if it has an INCOHERENT pragma, or if it appears in a module compiled with -XIncoherentInstances. * An instance is "overlappable" if it has an OVERLAPPABLE or OVERLAPS pragma, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. * An instance is "overlapping" if it has an OVERLAPPING or OVERLAPS pragma, or if it appears in a module compiled with -XOverlappingInstances, or if the instance is incoherent. compiled with -XOverlappingInstances. Now suppose that, in some client module, we are searching for an instance of the target constraint (C ty1 .. tyn). The search works like this. * Find all instances `I` that *match* the target constraint; that is, the target constraint is a substitution instance of `I`. These instance declarations are the *candidates*. * Eliminate any candidate `IX` for which both of the following hold: - There is another candidate `IY` that is strictly more specific; that is, `IY` is a substitution instance of `IX` but not vice versa. - Either `IX` is *overlappable*, or `IY` is *overlapping*. (This "either/or" design, rather than a "both/and" design, allow a client to deliberately override an instance from a library, without requiring a change to the library.) - If exactly one non-incoherent candidate remains, select it. If all remaining candidates are incoherent, select an arbitrary one. Otherwise the search fails (i.e. when more than one surviving candidate is not incoherent). - If the selected candidate (from the previous step) is incoherent, the search succeeds, returning that candidate. - If not, find all instances that *unify* with the target constraint, but do not *match* it. Such non-candidate instances might match when the target constraint is further instantiated. If all of them are incoherent, the search succeeds, returning the selected candidate; if not, the search fails. Notice that these rules are not influenced by flag settings in the client module, where the instances are *used*. These rules make it possible for a library author to design a library that relies on overlapping instances without the client having to know. Note [Overlapping instances] (NB: these notes are quite old) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Overlap is permitted, but only in such a way that one can make a unique choice when looking up. That is, overlap is only permitted if one template matches the other, or vice versa. So this is ok: [a] [Int] but this is not (Int,a) (b,Int) If overlap is permitted, the list is kept most specific first, so that the first lookup is the right choice. For now we just use association lists. \subsection{Avoiding a problem with overlapping} Consider this little program: \begin{pseudocode} class C a where c :: a class C a => D a where d :: a instance C Int where c = 17 instance D Int where d = 13 instance C a => C [a] where c = [c] instance ({- C [a], -} D a) => D [a] where d = c instance C [Int] where c = [37] main = print (d :: [Int]) \end{pseudocode} What do you think `main' prints (assuming we have overlapping instances, and all that turned on)? Well, the instance for `D' at type `[a]' is defined to be `c' at the same type, and we've got an instance of `C' at `[Int]', so the answer is `[37]', right? (the generic `C [a]' instance shouldn't apply because the `C [Int]' instance is more specific). Ghc-4.04 gives `[37]', while ghc-4.06 gives `[17]', so 4.06 is wrong. That was easy ;-) Let's just consult hugs for good measure. Wait - if I use old hugs (pre-September99), I get `[17]', and stranger yet, if I use hugs98, it doesn't even compile! What's going on!? What hugs complains about is the `D [a]' instance decl. \begin{pseudocode} ERROR "mj.hs" (line 10): Cannot build superclass instance *** Instance : D [a] *** Context supplied : D a *** Required superclass : C [a] \end{pseudocode} You might wonder what hugs is complaining about. It's saying that you need to add `C [a]' to the context of the `D [a]' instance (as appears in comments). But there's that `C [a]' instance decl one line above that says that I can reduce the need for a `C [a]' instance to the need for a `C a' instance, and in this case, I already have the necessary `C a' instance (since we have `D a' explicitly in the context, and `C' is a superclass of `D'). Unfortunately, the above reasoning indicates a premature commitment to the generic `C [a]' instance. I.e., it prematurely rules out the more specific instance `C [Int]'. This is the mistake that ghc-4.06 makes. The fix is to add the context that hugs suggests (uncomment the `C [a]'), effectively deferring the decision about which instance to use. Now, interestingly enough, 4.04 has this same bug, but it's covered up in this case by a little known `optimization' that was disabled in 4.06. Ghc-4.04 silently inserts any missing superclass context into an instance declaration. In this case, it silently inserts the `C [a]', and everything happens to work out. (See `basicTypes/MkId:mkDictFunId' for the code in question. Search for `Mark Jones', although Mark claims no credit for the `optimization' in question, and would rather it stopped being called the `Mark Jones optimization' ;-) So, what's the fix? I think hugs has it right. Here's why. Let's try something else out with ghc-4.04. Let's add the following line: d' :: D a => [a] d' = c Everyone raise their hand who thinks that `d :: [Int]' should give a different answer from `d' :: [Int]'. Well, in ghc-4.04, it does. The `optimization' only applies to instance decls, not to regular bindings, giving inconsistent behavior. Old hugs had this same bug. Here's how we fixed it: like GHC, the list of instances for a given class is ordered, so that more specific instances come before more generic ones. For example, the instance list for C might contain: ..., C Int, ..., C a, ... When we go to look for a `C Int' instance we'll get that one first. But what if we go looking for a `C b' (`b' is unconstrained)? We'll pass the `C Int' instance, and keep going. But if `b' is unconstrained, then we don't know yet if the more specific instance will eventually apply. GHC keeps going, and matches on the generic `C a'. The fix is to, at each step, check to see if there's a reverse match, and if so, abort the search. This prevents hugs from prematurely chosing a generic instance when a more specific one exists. --Jeff BUT NOTE [Nov 2001]: we must actually *unify* not reverse-match in this test. Suppose the instance envt had ..., forall a b. C a a b, ..., forall a b c. C a b c, ... (still most specific first) Now suppose we are looking for (C x y Int), where x and y are unconstrained. C x y Int doesn't match the template {a,b} C a a b but neither does C a a b match the template {x,y} C x y Int But still x and y might subsequently be unified so they *do* match. Simple story: unify, don't match. -} type DFunInstType = Maybe Type -- Just ty => Instantiate with this type -- Nothing => Instantiate with any type of this tyvar's kind -- See Note [DFunInstType: instantiating types] type InstMatch = (ClsInst, [DFunInstType]) type ClsInstLookupResult = ( [InstMatch] -- Successful matches , [ClsInst] -- These don't match but do unify , [InstMatch] ) -- Unsafe overlapped instances under Safe Haskell -- (see Note [Safe Haskell Overlapping Instances] in -- TcSimplify). {- Note [DFunInstType: instantiating types] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ A successful match is a ClsInst, together with the types at which the dfun_id in the ClsInst should be instantiated The instantiating types are (Either TyVar Type)s because the dfun might have some tyvars that *only* appear in arguments dfun :: forall a b. C a b, Ord b => D [a] When we match this against D [ty], we return the instantiating types [Just ty, Nothing] where the 'Nothing' indicates that 'b' can be freely instantiated. (The caller instantiates it to a flexi type variable, which will presumably later become fixed via functional dependencies.) -} -- |Look up an instance in the given instance environment. The given class application must match exactly -- one instance and the match may not contain any flexi type variables. If the lookup is unsuccessful, -- yield 'Left errorMessage'. lookupUniqueInstEnv :: InstEnvs -> Class -> [Type] -> Either MsgDoc (ClsInst, [Type]) lookupUniqueInstEnv :: InstEnvs -> Class -> [Type] -> Either SDoc (ClsInst, [Type]) lookupUniqueInstEnv InstEnvs instEnv Class cls [Type] tys = case Bool -> InstEnvs -> Class -> [Type] -> ClsInstLookupResult lookupInstEnv Bool False InstEnvs instEnv Class cls [Type] tys of ([(ClsInst inst, [DFunInstType] inst_tys)], [ClsInst] _, [InstMatch] _) | Bool noFlexiVar -> (ClsInst, [Type]) -> Either SDoc (ClsInst, [Type]) forall a b. b -> Either a b Right (ClsInst inst, [Type] inst_tys') | Bool otherwise -> SDoc -> Either SDoc (ClsInst, [Type]) forall a b. a -> Either a b Left (SDoc -> Either SDoc (ClsInst, [Type])) -> SDoc -> Either SDoc (ClsInst, [Type]) forall a b. (a -> b) -> a -> b $ String -> SDoc text String "flexible type variable:" SDoc -> SDoc -> SDoc <+> (Type -> SDoc forall a. Outputable a => a -> SDoc ppr (Type -> SDoc) -> Type -> SDoc forall a b. (a -> b) -> a -> b $ TyCon -> [Type] -> Type mkTyConApp (Class -> TyCon classTyCon Class cls) [Type] tys) where inst_tys' :: [Type] inst_tys' = [Type ty | Just Type ty <- [DFunInstType] inst_tys] noFlexiVar :: Bool noFlexiVar = (DFunInstType -> Bool) -> [DFunInstType] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all DFunInstType -> Bool forall a. Maybe a -> Bool isJust [DFunInstType] inst_tys ClsInstLookupResult _other -> SDoc -> Either SDoc (ClsInst, [Type]) forall a b. a -> Either a b Left (SDoc -> Either SDoc (ClsInst, [Type])) -> SDoc -> Either SDoc (ClsInst, [Type]) forall a b. (a -> b) -> a -> b $ String -> SDoc text String "instance not found" SDoc -> SDoc -> SDoc <+> (Type -> SDoc forall a. Outputable a => a -> SDoc ppr (Type -> SDoc) -> Type -> SDoc forall a b. (a -> b) -> a -> b $ TyCon -> [Type] -> Type mkTyConApp (Class -> TyCon classTyCon Class cls) [Type] tys) lookupInstEnv' :: InstEnv -- InstEnv to look in -> VisibleOrphanModules -- But filter against this -> Class -> [Type] -- What we are looking for -> ([InstMatch], -- Successful matches [ClsInst]) -- These don't match but do unify -- (no incoherent ones in here) -- The second component of the result pair happens when we look up -- Foo [a] -- in an InstEnv that has entries for -- Foo [Int] -- Foo [b] -- Then which we choose would depend on the way in which 'a' -- is instantiated. So we report that Foo [b] is a match (mapping b->a) -- but Foo [Int] is a unifier. This gives the caller a better chance of -- giving a suitable error message lookupInstEnv' :: InstEnv -> VisibleOrphanModules -> Class -> [Type] -> ([InstMatch], [ClsInst]) lookupInstEnv' InstEnv ie VisibleOrphanModules vis_mods Class cls [Type] tys = InstEnv -> ([InstMatch], [ClsInst]) lookup InstEnv ie where rough_tcs :: [Maybe Name] rough_tcs = [Type] -> [Maybe Name] roughMatchTcs [Type] tys all_tvs :: Bool all_tvs = (Maybe Name -> Bool) -> [Maybe Name] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all Maybe Name -> Bool forall a. Maybe a -> Bool isNothing [Maybe Name] rough_tcs -------------- lookup :: InstEnv -> ([InstMatch], [ClsInst]) lookup InstEnv env = case InstEnv -> Class -> Maybe ClsInstEnv forall key elt. Uniquable key => UniqDFM elt -> key -> Maybe elt lookupUDFM InstEnv env Class cls of Maybe ClsInstEnv Nothing -> ([],[]) -- No instances for this class Just (ClsIE [ClsInst] insts) -> [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find [] [] [ClsInst] insts -------------- find :: [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find [InstMatch] ms [ClsInst] us [] = ([InstMatch] ms, [ClsInst] us) find [InstMatch] ms [ClsInst] us (item :: ClsInst item@(ClsInst { is_tcs :: ClsInst -> [Maybe Name] is_tcs = [Maybe Name] mb_tcs, is_tvs :: ClsInst -> [TyVar] is_tvs = [TyVar] tpl_tvs , is_tys :: ClsInst -> [Type] is_tys = [Type] tpl_tys }) : [ClsInst] rest) | Bool -> Bool not (VisibleOrphanModules -> ClsInst -> Bool instIsVisible VisibleOrphanModules vis_mods ClsInst item) = [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find [InstMatch] ms [ClsInst] us [ClsInst] rest -- See Note [Instance lookup and orphan instances] -- Fast check for no match, uses the "rough match" fields | [Maybe Name] -> [Maybe Name] -> Bool instanceCantMatch [Maybe Name] rough_tcs [Maybe Name] mb_tcs = [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find [InstMatch] ms [ClsInst] us [ClsInst] rest | Just TCvSubst subst <- [Type] -> [Type] -> Maybe TCvSubst tcMatchTys [Type] tpl_tys [Type] tys = [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find ((ClsInst item, (TyVar -> DFunInstType) -> [TyVar] -> [DFunInstType] forall a b. (a -> b) -> [a] -> [b] map (TCvSubst -> TyVar -> DFunInstType lookupTyVar TCvSubst subst) [TyVar] tpl_tvs) InstMatch -> [InstMatch] -> [InstMatch] forall a. a -> [a] -> [a] : [InstMatch] ms) [ClsInst] us [ClsInst] rest -- Does not match, so next check whether the things unify -- See Note [Overlapping instances] -- Ignore ones that are incoherent: Note [Incoherent instances] | ClsInst -> Bool isIncoherent ClsInst item = [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find [InstMatch] ms [ClsInst] us [ClsInst] rest | Bool otherwise = ASSERT2( tyCoVarsOfTypes tys `disjointVarSet` tpl_tv_set, (ppr cls <+> ppr tys <+> ppr all_tvs) $$ (ppr tpl_tvs <+> ppr tpl_tys) ) -- Unification will break badly if the variables overlap -- They shouldn't because we allocate separate uniques for them -- See Note [Template tyvars are fresh] case (TyVar -> BindFlag) -> [Type] -> [Type] -> Maybe TCvSubst tcUnifyTys TyVar -> BindFlag instanceBindFun [Type] tpl_tys [Type] tys of Just TCvSubst _ -> [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find [InstMatch] ms (ClsInst itemClsInst -> [ClsInst] -> [ClsInst] forall a. a -> [a] -> [a] :[ClsInst] us) [ClsInst] rest Maybe TCvSubst Nothing -> [InstMatch] -> [ClsInst] -> [ClsInst] -> ([InstMatch], [ClsInst]) find [InstMatch] ms [ClsInst] us [ClsInst] rest where tpl_tv_set :: TyCoVarSet tpl_tv_set = [TyVar] -> TyCoVarSet mkVarSet [TyVar] tpl_tvs --------------- -- This is the common way to call this function. lookupInstEnv :: Bool -- Check Safe Haskell overlap restrictions -> InstEnvs -- External and home package inst-env -> Class -> [Type] -- What we are looking for -> ClsInstLookupResult -- ^ See Note [Rules for instance lookup] -- ^ See Note [Safe Haskell Overlapping Instances] in TcSimplify -- ^ See Note [Safe Haskell Overlapping Instances Implementation] in TcSimplify lookupInstEnv :: Bool -> InstEnvs -> Class -> [Type] -> ClsInstLookupResult lookupInstEnv Bool check_overlap_safe (InstEnvs { ie_global :: InstEnvs -> InstEnv ie_global = InstEnv pkg_ie , ie_local :: InstEnvs -> InstEnv ie_local = InstEnv home_ie , ie_visible :: InstEnvs -> VisibleOrphanModules ie_visible = VisibleOrphanModules vis_mods }) Class cls [Type] tys = -- pprTrace "lookupInstEnv" (ppr cls <+> ppr tys $$ ppr home_ie) $ ([InstMatch] final_matches, [ClsInst] final_unifs, [InstMatch] unsafe_overlapped) where ([InstMatch] home_matches, [ClsInst] home_unifs) = InstEnv -> VisibleOrphanModules -> Class -> [Type] -> ([InstMatch], [ClsInst]) lookupInstEnv' InstEnv home_ie VisibleOrphanModules vis_mods Class cls [Type] tys ([InstMatch] pkg_matches, [ClsInst] pkg_unifs) = InstEnv -> VisibleOrphanModules -> Class -> [Type] -> ([InstMatch], [ClsInst]) lookupInstEnv' InstEnv pkg_ie VisibleOrphanModules vis_mods Class cls [Type] tys all_matches :: [InstMatch] all_matches = [InstMatch] home_matches [InstMatch] -> [InstMatch] -> [InstMatch] forall a. [a] -> [a] -> [a] ++ [InstMatch] pkg_matches all_unifs :: [ClsInst] all_unifs = [ClsInst] home_unifs [ClsInst] -> [ClsInst] -> [ClsInst] forall a. [a] -> [a] -> [a] ++ [ClsInst] pkg_unifs final_matches :: [InstMatch] final_matches = (InstMatch -> [InstMatch] -> [InstMatch]) -> [InstMatch] -> [InstMatch] -> [InstMatch] forall (t :: * -> *) a b. Foldable t => (a -> b -> b) -> b -> t a -> b foldr InstMatch -> [InstMatch] -> [InstMatch] insert_overlapping [] [InstMatch] all_matches -- Even if the unifs is non-empty (an error situation) -- we still prune the matches, so that the error message isn't -- misleading (complaining of multiple matches when some should be -- overlapped away) unsafe_overlapped :: [InstMatch] unsafe_overlapped = case [InstMatch] final_matches of [InstMatch match] -> InstMatch -> [InstMatch] forall b. (ClsInst, b) -> [InstMatch] check_safe InstMatch match [InstMatch] _ -> [] -- If the selected match is incoherent, discard all unifiers final_unifs :: [ClsInst] final_unifs = case [InstMatch] final_matches of (InstMatch m:[InstMatch] _) | ClsInst -> Bool isIncoherent (InstMatch -> ClsInst forall a b. (a, b) -> a fst InstMatch m) -> [] [InstMatch] _ -> [ClsInst] all_unifs -- NOTE [Safe Haskell isSafeOverlap] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -- We restrict code compiled in 'Safe' mode from overriding code -- compiled in any other mode. The rationale is that code compiled -- in 'Safe' mode is code that is untrusted by the ghc user. So -- we shouldn't let that code change the behaviour of code the -- user didn't compile in 'Safe' mode since that's the code they -- trust. So 'Safe' instances can only overlap instances from the -- same module. A same instance origin policy for safe compiled -- instances. check_safe :: (ClsInst, b) -> [InstMatch] check_safe (ClsInst inst,b _) = case Bool check_overlap_safe Bool -> Bool -> Bool && ClsInst -> Bool unsafeTopInstance ClsInst inst of -- make sure it only overlaps instances from the same module Bool True -> [InstMatch] -> [InstMatch] -> [InstMatch] forall b. [(ClsInst, b)] -> [(ClsInst, b)] -> [(ClsInst, b)] go [] [InstMatch] all_matches -- most specific is from a trusted location. Bool False -> [] where go :: [(ClsInst, b)] -> [(ClsInst, b)] -> [(ClsInst, b)] go [(ClsInst, b)] bad [] = [(ClsInst, b)] bad go [(ClsInst, b)] bad (i :: (ClsInst, b) i@(ClsInst x,b _):[(ClsInst, b)] unchecked) = if ClsInst -> Bool forall a. NamedThing a => a -> Bool inSameMod ClsInst x Bool -> Bool -> Bool || ClsInst -> Bool isOverlappable ClsInst x then [(ClsInst, b)] -> [(ClsInst, b)] -> [(ClsInst, b)] go [(ClsInst, b)] bad [(ClsInst, b)] unchecked else [(ClsInst, b)] -> [(ClsInst, b)] -> [(ClsInst, b)] go ((ClsInst, b) i(ClsInst, b) -> [(ClsInst, b)] -> [(ClsInst, b)] forall a. a -> [a] -> [a] :[(ClsInst, b)] bad) [(ClsInst, b)] unchecked inSameMod :: a -> Bool inSameMod a b = let na :: Name na = Name -> Name forall a. NamedThing a => a -> Name getName (Name -> Name) -> Name -> Name forall a b. (a -> b) -> a -> b $ ClsInst -> Name forall a. NamedThing a => a -> Name getName ClsInst inst la :: Bool la = Name -> Bool isInternalName Name na nb :: Name nb = Name -> Name forall a. NamedThing a => a -> Name getName (Name -> Name) -> Name -> Name forall a b. (a -> b) -> a -> b $ a -> Name forall a. NamedThing a => a -> Name getName a b lb :: Bool lb = Name -> Bool isInternalName Name nb in (Bool la Bool -> Bool -> Bool && Bool lb) Bool -> Bool -> Bool || (HasDebugCallStack => Name -> Module Name -> Module nameModule Name na Module -> Module -> Bool forall a. Eq a => a -> a -> Bool == HasDebugCallStack => Name -> Module Name -> Module nameModule Name nb) -- We consider the most specific instance unsafe when it both: -- (1) Comes from a module compiled as `Safe` -- (2) Is an orphan instance, OR, an instance for a MPTC unsafeTopInstance :: ClsInst -> Bool unsafeTopInstance ClsInst inst = OverlapFlag -> Bool isSafeOverlap (ClsInst -> OverlapFlag is_flag ClsInst inst) Bool -> Bool -> Bool && (IsOrphan -> Bool isOrphan (ClsInst -> IsOrphan is_orphan ClsInst inst) Bool -> Bool -> Bool || Class -> Int classArity (ClsInst -> Class is_cls ClsInst inst) Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 1) --------------- insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch] -- ^ Add a new solution, knocking out strictly less specific ones -- See Note [Rules for instance lookup] insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch] insert_overlapping InstMatch new_item [] = [InstMatch new_item] insert_overlapping new_item :: InstMatch new_item@(ClsInst new_inst,[DFunInstType] _) (old_item :: InstMatch old_item@(ClsInst old_inst,[DFunInstType] _) : [InstMatch] old_items) | Bool new_beats_old -- New strictly overrides old , Bool -> Bool not Bool old_beats_new , ClsInst new_inst ClsInst -> ClsInst -> Bool `can_override` ClsInst old_inst = InstMatch -> [InstMatch] -> [InstMatch] insert_overlapping InstMatch new_item [InstMatch] old_items | Bool old_beats_new -- Old strictly overrides new , Bool -> Bool not Bool new_beats_old , ClsInst old_inst ClsInst -> ClsInst -> Bool `can_override` ClsInst new_inst = InstMatch old_item InstMatch -> [InstMatch] -> [InstMatch] forall a. a -> [a] -> [a] : [InstMatch] old_items -- Discard incoherent instances; see Note [Incoherent instances] | ClsInst -> Bool isIncoherent ClsInst old_inst -- Old is incoherent; discard it = InstMatch -> [InstMatch] -> [InstMatch] insert_overlapping InstMatch new_item [InstMatch] old_items | ClsInst -> Bool isIncoherent ClsInst new_inst -- New is incoherent; discard it = InstMatch old_item InstMatch -> [InstMatch] -> [InstMatch] forall a. a -> [a] -> [a] : [InstMatch] old_items -- Equal or incomparable, and neither is incoherent; keep both | Bool otherwise = InstMatch old_item InstMatch -> [InstMatch] -> [InstMatch] forall a. a -> [a] -> [a] : InstMatch -> [InstMatch] -> [InstMatch] insert_overlapping InstMatch new_item [InstMatch] old_items where new_beats_old :: Bool new_beats_old = ClsInst new_inst ClsInst -> ClsInst -> Bool `more_specific_than` ClsInst old_inst old_beats_new :: Bool old_beats_new = ClsInst old_inst ClsInst -> ClsInst -> Bool `more_specific_than` ClsInst new_inst -- `instB` can be instantiated to match `instA` -- or the two are equal ClsInst instA more_specific_than :: ClsInst -> ClsInst -> Bool `more_specific_than` ClsInst instB = Maybe TCvSubst -> Bool forall a. Maybe a -> Bool isJust ([Type] -> [Type] -> Maybe TCvSubst tcMatchTys (ClsInst -> [Type] is_tys ClsInst instB) (ClsInst -> [Type] is_tys ClsInst instA)) ClsInst instA can_override :: ClsInst -> ClsInst -> Bool `can_override` ClsInst instB = ClsInst -> Bool isOverlapping ClsInst instA Bool -> Bool -> Bool || ClsInst -> Bool isOverlappable ClsInst instB -- Overlap permitted if either the more specific instance -- is marked as overlapping, or the more general one is -- marked as overlappable. -- Latest change described in: #9242. -- Previous change: #3877, Dec 10. {- Note [Incoherent instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ For some classes, the choice of a particular instance does not matter, any one is good. E.g. consider class D a b where { opD :: a -> b -> String } instance D Int b where ... instance D a Int where ... g (x::Int) = opD x x -- Wanted: D Int Int For such classes this should work (without having to add an "instance D Int Int", and using -XOverlappingInstances, which would then work). This is what -XIncoherentInstances is for: Telling GHC "I don't care which instance you use; if you can use one, use it." Should this logic only work when *all* candidates have the incoherent flag, or even when all but one have it? The right choice is the latter, which can be justified by comparing the behaviour with how -XIncoherentInstances worked when it was only about the unify-check (note [Overlapping instances]): Example: class C a b c where foo :: (a,b,c) instance C [a] b Int instance [incoherent] [Int] b c instance [incoherent] C a Int c Thanks to the incoherent flags, [Wanted] C [a] b Int works: Only instance one matches, the others just unify, but are marked incoherent. So I can write (foo :: ([a],b,Int)) :: ([Int], Int, Int). but if that works then I really want to be able to write foo :: ([Int], Int, Int) as well. Now all three instances from above match. None is more specific than another, so none is ruled out by the normal overlapping rules. One of them is not incoherent, but we still want this to compile. Hence the "all-but-one-logic". The implementation is in insert_overlapping, where we remove matching incoherent instances as long as there are others. ************************************************************************ * * Binding decisions * * ************************************************************************ -} instanceBindFun :: TyCoVar -> BindFlag instanceBindFun :: TyVar -> BindFlag instanceBindFun TyVar tv | TyVar -> Bool isOverlappableTyVar TyVar tv = BindFlag Skolem | Bool otherwise = BindFlag BindMe -- Note [Binding when looking up instances] {- Note [Binding when looking up instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ When looking up in the instance environment, or family-instance environment, we are careful about multiple matches, as described above in Note [Overlapping instances] The key_tys can contain skolem constants, and we can guarantee that those are never going to be instantiated to anything, so we should not involve them in the unification test. Example: class Foo a where { op :: a -> Int } instance Foo a => Foo [a] -- NB overlap instance Foo [Int] -- NB overlap data T = forall a. Foo a => MkT a f :: T -> Int f (MkT x) = op [x,x] The op [x,x] means we need (Foo [a]). Without the filterVarSet we'd complain, saying that the choice of instance depended on the instantiation of 'a'; but of course it isn't *going* to be instantiated. We do this only for isOverlappableTyVar skolems. For example we reject g :: forall a => [a] -> Int g x = op x on the grounds that the correct instance depends on the instantiation of 'a' -}