diff options
Diffstat (limited to 'compiler/types/InstEnv.lhs')
| -rw-r--r-- | compiler/types/InstEnv.lhs | 108 |
1 files changed, 75 insertions, 33 deletions
diff --git a/compiler/types/InstEnv.lhs b/compiler/types/InstEnv.lhs index e1ab8da5c7..636147a461 100644 --- a/compiler/types/InstEnv.lhs +++ b/compiler/types/InstEnv.lhs @@ -16,7 +16,7 @@ module InstEnv ( instanceHead, instanceSig, mkLocalInstance, mkImportedInstance, instanceDFunId, tidyClsInstDFun, instanceRoughTcs, - InstEnv, emptyInstEnv, extendInstEnv, overwriteInstEnv, + InstEnv, emptyInstEnv, extendInstEnv, deleteFromInstEnv, identicalInstHead, extendInstEnvList, lookupUniqueInstEnv, lookupInstEnv', lookupInstEnv, instEnvElts, classInstances, orphNamesOfClsInst, instanceBindFun, instanceCantMatch, roughMatchTcs @@ -160,7 +160,8 @@ pprInstance :: ClsInst -> SDoc -- Prints the ClsInst as an instance declaration pprInstance ispec = hang (pprInstanceHdr ispec) - 2 (ptext (sLit "--") <+> pprDefinedAt (getName ispec)) + 2 (vcat [ ptext (sLit "--") <+> pprDefinedAt (getName ispec) + , ifPprDebug (ppr (is_dfun ispec)) ]) -- * pprInstanceHdr is used in VStudio to populate the ClassView tree pprInstanceHdr :: ClsInst -> SDoc @@ -420,26 +421,22 @@ extendInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm }) where add (ClsIE cur_insts) _ = ClsIE (ins_item : cur_insts) -overwriteInstEnv :: InstEnv -> ClsInst -> InstEnv -overwriteInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm, is_tys = tys }) - = addToUFM_C add inst_env cls_nm (ClsIE [ins_item]) +deleteFromInstEnv :: InstEnv -> ClsInst -> InstEnv +deleteFromInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm }) + = adjustUFM adjust inst_env cls_nm where - add (ClsIE cur_insts) _ = ClsIE (replaceInst cur_insts) - - rough_tcs = roughMatchTcs tys - replaceInst [] = [ins_item] - replaceInst (item@(ClsInst { is_tcs = mb_tcs, is_tvs = tpl_tvs - , is_tys = tpl_tys }) : rest) - -- Fast check for no match, uses the "rough match" fields - | instanceCantMatch rough_tcs mb_tcs - = item : replaceInst rest - - | let tpl_tv_set = mkVarSet tpl_tvs - , Just _ <- tcMatchTys tpl_tv_set tpl_tys tys - = ins_item : rest - - | otherwise - = item : replaceInst rest + adjust (ClsIE items) = ClsIE (filterOut (identicalInstHead ins_item) items) + +identicalInstHead :: ClsInst -> ClsInst -> Bool +-- ^ True when when the instance heads are the same +-- e.g. both are Eq [(a,b)] +-- Obviously should be insenstive to alpha-renaming +identicalInstHead (ClsInst { is_cls_nm = cls_nm1, is_tcs = rough1, is_tvs = tvs1, is_tys = tys1 }) + (ClsInst { is_cls_nm = cls_nm2, is_tcs = rough2, is_tvs = tvs2, is_tys = tys2 }) + = cls_nm1 == cls_nm2 + && not (instanceCantMatch rough1 rough2) -- Fast check for no match, uses the "rough match" fields + && isJust (tcMatchTys (mkVarSet tvs1) tys1 tys2) + && isJust (tcMatchTys (mkVarSet tvs2) tys2 tys1) \end{code} @@ -453,6 +450,54 @@ overwriteInstEnv inst_env ins_item@(ClsInst { is_cls_nm = cls_nm, is_tys = tys } 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 [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/type-class-extensions.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 pragama, or + if it appears in a module compiled with -XIncoherentInstances. + + * An instance is "overlappable" + if it has an OVERLAPPABLE or OVERLAPS pragama, 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 pragama, 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. + + * Find all non-candidate instances that unify with the target + constraint. Such non-candidates instances might match when the + target constraint is further instantiated. If all of them are + incoherent, proceed; if not, the search fails. + + * 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. + + * If only one candidate remains, pick it. Otherwise if all remaining + candidates are incoherent, pick an arbitrary candidate. Otherwise fail. + + \begin{code} type DFunInstType = Maybe Type -- Just ty => Instantiate with this type @@ -536,7 +581,7 @@ lookupInstEnv' ie cls tys = find ((item, map (lookup_tv subst) tpl_tvs) : ms) us rest -- Does not match, so next check whether the things unify - -- See Note [Overlapping instances] and Note [Incoherent Instances] + -- See Note [Overlapping instances] and Note [Incoherent instances] | Incoherent <- overlapMode oflag = find ms us rest @@ -566,7 +611,7 @@ lookupInstEnv' ie cls tys lookupInstEnv :: (InstEnv, InstEnv) -- External and home package inst-env -> Class -> [Type] -- What we are looking for -> ClsInstLookupResult - +-- ^ See Note [Rules for instance lookup] lookupInstEnv (pkg_ie, home_ie) cls tys = (safe_matches, all_unifs, safe_fail) where @@ -606,7 +651,7 @@ lookupInstEnv (pkg_ie, home_ie) cls tys if inSameMod x then go bad unchecked else go (i:bad) unchecked - + inSameMod b = let na = getName $ getName inst la = isInternalName na @@ -617,7 +662,8 @@ lookupInstEnv (pkg_ie, home_ie) cls tys --------------- --------------- insert_overlapping :: InstMatch -> [InstMatch] -> [InstMatch] --- Add a new solution, knocking out strictly less specific ones +-- ^ Add a new solution, knocking out strictly less specific ones +-- See Note [Rules for instance lookup] insert_overlapping new_item [] = [new_item] insert_overlapping new_item (item:items) | new_beats_old && old_beats_new = item : insert_overlapping new_item items @@ -653,29 +699,25 @@ insert_overlapping new_item (item:items) Previous change: Trac #3877, Dec 10. -} overlap_ok = hasOverlappingFlag (overlapMode (is_flag instA)) || hasOverlappableFlag (overlapMode (is_flag instB)) - - \end{code} Note [Incoherent instances] ~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -For some classes, the choise of a particular instance does not matter, any one +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 + 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 +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]): @@ -686,7 +728,7 @@ Example: instance [incoherent] [Int] b c instance [incoherent] C a Int c Thanks to the incoherent flags, - foo :: ([a],b,Int) + [Wanted] C [a] b Int works: Only instance one matches, the others just unify, but are marked incoherent. |