X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FInstEnv.lhs;h=9cb68c80e5dcb19535db16072095dc8b4dfe61aa;hb=58b05365235ae6ea3940430700a642dfe5593986;hp=7aaf6ddbb711972dcfc4938720532dd4f9e69154;hpb=c76c69c5b62f1ca4fa52d75b0dfbd37b7eddbb09;p=ghc-hetmet.git diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs index 7aaf6dd..9cb68c8 100644 --- a/compiler/types/InstEnv.lhs +++ b/compiler/types/InstEnv.lhs @@ -1,4 +1,5 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[InstEnv]{Utilities for typechecking instance declarations} @@ -20,27 +21,21 @@ module InstEnv ( #include "HsVersions.h" -import Class ( Class ) -import Var ( Id, TyVar, isTcTyVar ) +import Class +import Var import VarSet -import Name ( Name, NamedThing(..), getSrcLoc, nameIsLocalOrFrom, nameModule ) -import OccName ( OccName ) -import NameSet ( unionNameSets, unitNameSet, nameSetToList ) -import Type ( TvSubst ) -import TcType ( Type, PredType, tcEqType, - tcSplitDFunTy, tyVarsOfTypes, isExistentialTyVar, - pprThetaArrow, pprClassPred, - tyClsNamesOfType, tcSplitTyConApp_maybe - ) -import TyCon ( tyConName ) -import TcGadt ( tcUnifyTys, BindFlag(..) ) -import Unify ( tcMatchTys ) +import Name +import TcType +import TyCon +import TcGadt +import Unify import Outputable -import BasicTypes ( OverlapFlag(..) ) -import UniqFM ( UniqFM, lookupUFM, emptyUFM, addToUFM_C, eltsUFM ) -import Id ( idType, idName ) -import SrcLoc ( pprDefnLoc ) -import Maybe ( isJust, isNothing ) +import BasicTypes +import UniqFM +import Id +import SrcLoc + +import Data.Maybe ( isJust, isNothing ) \end{code} @@ -55,77 +50,59 @@ type DFunId = Id data Instance = Instance { is_cls :: Name -- Class name - -- Used for "rough matching"; see note below + -- Used for "rough matching"; see Note [Rough-match field] + -- INVARIANT: is_tcs = roughMatchTcs is_tys , is_tcs :: [Maybe Name] -- Top of type args - -- Used for "proper matching"; see note + -- Used for "proper matching"; see Note [Proper-match fields] , is_tvs :: TyVarSet -- Template tyvars for full match , is_tys :: [Type] -- Full arg types + -- INVARIANT: is_dfun Id has type + -- forall is_tvs. (...) => is_cls is_tys , is_dfun :: DFunId , is_flag :: OverlapFlag -- See detailed comments with -- the decl of BasicTypes.OverlapFlag + } +\end{code} + +Note [Rough-match field] +~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The is_cls, is_tcs fields allow a "rough match" to be done +without poking inside the DFunId. Poking the DFunId forces +us to suck in all the type constructors etc it involves, +which is a total waste of time if it has no chance of matching +So the Name, [Maybe Name] fields allow us to say "definitely +does not match", based only on the 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 [Proper-match fields] +~~~~~~~~~~~~~~~~~~~~~~~~~ +The is_tvs, 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 fast-match fields mean +that we often never poke th proper-match fields - , is_orph :: Maybe OccName } - --- The "rough-match" fields --- ~~~~~~~~~~~~~~~~~~~~~~~~~ --- The is_cls, is_args fields allow a "rough match" to be done --- without poking inside the DFunId. Poking the DFunId forces --- us to suck in all the type constructors etc it involves, --- which is a total waste of time if it has no chance of matching --- So the Name, [Maybe Name] fields allow us to say "definitely --- does not match", based only on the 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! --- --- The "proper-match" fields --- ~~~~~~~~~~~~~~~~~~~~~~~~~ --- The is_tvs, is_tys fields are simply cahced 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 fast-match fields mean --- that we often never poke th proper-match fields --- --- However, note that: --- * is_tvs must be a superset of the free vars of is_tys --- --- * The is_dfun must itself be quantified over exactly is_tvs --- (This is so that we can use the matching substitution to --- instantiate the dfun's context.) --- --- The "orphan" field --- ~~~~~~~~~~~~~~~~~~ --- An instance is an orphan if its head (after the =>) mentions --- nothing defined in this module. --- --- Just n The head mentions n, which is defined in this module --- This is used for versioning; the instance decl is --- considered part of the defn of n when computing versions --- --- Nothing The head mentions nothing defined in this module --- --- If a module contains any orphans, then its interface file is read --- regardless, so that its instances are not missed. --- --- Functional dependencies worsen the situation a bit. Consider --- class C a b | a -> b --- In some other module we might have --- module M where --- data T = ... --- instance C Int T where ... --- This isn't considered an orphan, so we will only read M's interface --- if something from M is used (e.g. T). So there's a risk we'll --- miss the improvement from the instance. Workaround: import M. +However, note that: + * is_tvs must be a superset of the free vars of is_tys + * The is_dfun must itself be quantified over exactly is_tvs + (This is so that we can use the matching substitution to + instantiate the dfun's context.) + + + +\begin{code} instanceDFunId :: Instance -> DFunId instanceDFunId = is_dfun @@ -180,26 +157,18 @@ mkLocalInstance :: DFunId -> OverlapFlag -> Instance mkLocalInstance dfun oflag = Instance { is_flag = oflag, is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys, - is_cls = cls_name, is_tcs = roughMatchTcs tys, - is_orph = orph } + is_cls = className cls, is_tcs = roughMatchTcs tys } where (tvs, _, cls, tys) = tcSplitDFunTy (idType dfun) - mod = nameModule (idName dfun) - cls_name = getName cls - tycl_names = foldr (unionNameSets . tyClsNamesOfType) - (unitNameSet cls_name) tys - orph = case filter (nameIsLocalOrFrom mod) (nameSetToList tycl_names) of - [] -> Nothing - (n:ns) -> Just (getOccName n) - -mkImportedInstance :: Name -> [Maybe Name] -> Maybe OccName + +mkImportedInstance :: Name -> [Maybe Name] -> DFunId -> OverlapFlag -> Instance -- Used for imported instances, where we get the rough-match stuff -- from the interface file -mkImportedInstance cls mb_tcs orph dfun oflag +mkImportedInstance cls mb_tcs dfun oflag = Instance { is_flag = oflag, is_dfun = dfun, is_tvs = mkVarSet tvs, is_tys = tys, - is_cls = cls, is_tcs = mb_tcs, is_orph = orph } + is_cls = cls, is_tcs = mb_tcs } where (tvs, _, _, tys) = tcSplitDFunTy (idType dfun) @@ -475,9 +444,9 @@ lookupInstEnv (pkg_ie, home_ie) cls tys = find ms us rest | otherwise - = ASSERT2( not (tyVarsOfTypes tys `intersectsVarSet` tpl_tvs), - (ppr cls <+> ppr tys <+> ppr all_tvs) $$ - (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys) + = ASSERT2( tyVarsOfTypes tys `disjointVarSet` tpl_tvs, + (ppr cls <+> ppr tys <+> ppr all_tvs) $$ + (ppr dfun <+> ppr tpl_tvs <+> ppr tpl_tys) ) -- Unification will break badly if the variables overlap -- They shouldn't because we allocate separate uniques for them