X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FFunDeps.lhs;h=02b0a2ab0522f31a1ef251eee576acdee7e803f3;hb=59fa6266f00b6edcfc20c491c8de9a1b215dfa22;hp=170304c59f70c424aa5c3e5750028b7923e272a4;hpb=5e5310b3cb4f78e30cc7b90879eb016e97c214cb;p=ghc-hetmet.git diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs index 170304c..02b0a2a 100644 --- a/compiler/types/FunDeps.lhs +++ b/compiler/types/FunDeps.lhs @@ -10,7 +10,7 @@ It's better to read it as: "if we know these, then we're going to know these" \begin{code} module FunDeps ( Equation, pprEquation, - oclose, grow, improveOne, + oclose, improveOne, checkInstCoverage, checkFunDeps, pprFundeps ) where @@ -132,44 +132,6 @@ oclose preds fixed_tvs ] \end{code} -Note [Growing the tau-tvs using constraints] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -(grow preds tvs) is the result of extend the set of tyvars tvs - using all conceivable links from pred - -E.g. tvs = {a}, preds = {H [a] b, K (b,Int) c, Eq e} -Then grow precs tvs = {a,b,c} - -All the type variables from an implicit parameter are added, whether or -not they are mentioned in tvs; see Note [Implicit parameters and ambiguity] -in TcSimplify. - -See also Note [Ambiguity] in TcSimplify - -\begin{code} -grow :: [PredType] -> TyVarSet -> TyVarSet -grow preds fixed_tvs - | null preds = fixed_tvs - | otherwise = loop real_fixed_tvs - where - -- Add the implicit parameters; - -- see Note [Implicit parameters and ambiguity] in TcSimplify - real_fixed_tvs = foldr unionVarSet fixed_tvs ip_tvs - - loop fixed_tvs - | new_fixed_tvs `subVarSet` fixed_tvs = fixed_tvs - | otherwise = loop new_fixed_tvs - where - new_fixed_tvs = foldl extend fixed_tvs non_ip_tvs - - extend fixed_tvs pred_tvs - | fixed_tvs `intersectsVarSet` pred_tvs = fixed_tvs `unionVarSet` pred_tvs - | otherwise = fixed_tvs - - (ip_tvs, non_ip_tvs) = partitionWith get_ip preds - get_ip (IParam _ ty) = Left (tyVarsOfType ty) - get_ip other = Right (tyVarsOfPred other) -\end{code} %************************************************************************ %* * @@ -294,8 +256,9 @@ improveOne inst_env pred@(ClassP cls tys, _) preds , not (instanceCantMatch inst_tcs trimmed_tcs) , eqn <- checkClsFD qtvs fd cls_tvs tys_inst tys , let p_inst = (mkClassPred cls tys_inst, - ptext (sLit "arising from the instance declaration at") - <+> ppr (getSrcLoc ispec)) + sep [ ptext (sLit "arising from the dependency") <+> quotes (pprFunDep fd) + , ptext (sLit "in the instance declaration at") + <+> ppr (getSrcLoc ispec)]) ] improveOne _ _ _