X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FFunDeps.lhs;h=5ece0471884ec94b704736a60133a1328c7ce17f;hb=67ee8a93fc96a38c3f73468cb86d8421a11d2911;hp=9347f5f665d7c04d7b6387001bae2d0213b3f419;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs index 9347f5f..5ece047 100644 --- a/compiler/types/FunDeps.lhs +++ b/compiler/types/FunDeps.lhs @@ -1,4 +1,4 @@ -% + % (c) The GRASP/AQUA Project, Glasgow University, 2000 % \section[FunDeps]{FunDeps - functional dependencies} @@ -17,9 +17,10 @@ module FunDeps ( import Name ( Name, getSrcLoc ) import Var ( TyVar ) -import Class ( Class, FunDep, classTvsFds ) -import Unify ( tcUnifyTys, BindFlag(..) ) +import Class ( Class, FunDep, pprFundeps, classTvsFds ) +import TcGadt ( tcUnifyTys, BindFlag(..) ) import Type ( substTys, notElemTvSubst ) +import Coercion ( isEqPred ) import TcType ( Type, PredType(..), tcEqType, predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred ) import InstEnv ( Instance(..), InstEnv, instanceHead, classInstances, @@ -125,6 +126,7 @@ oclose preds fixed_tvs \begin{code} grow :: [PredType] -> TyVarSet -> TyVarSet +-- See Note [Ambiguity] in TcSimplify grow preds fixed_tvs | null preds = fixed_tvs | otherwise = loop fixed_tvs @@ -218,8 +220,13 @@ NOTA BENE: \begin{code} improve inst_env preds - = [ eqn | group <- equivClassesByUniq (predTyUnique . fst) preds, + = [ eqn | group <- equivClassesByUniq (predTyUnique . fst) (filterEqPreds preds), eqn <- checkGroup inst_env group ] + where + filterEqPreds = filter (not . isEqPred . fst) + -- Equality predicates don't have uniques + -- In any case, improvement *generates*, rather than + -- *consumes*, equality constraints ---------- checkGroup :: (Class -> [Instance]) @@ -484,17 +491,4 @@ trimRoughMatchTcs clas_tvs (ltvs,_) mb_tcs \end{code} -%************************************************************************ -%* * -\subsection{Miscellaneous} -%* * -%************************************************************************ - -\begin{code} -pprFundeps :: Outputable a => [FunDep a] -> SDoc -pprFundeps [] = empty -pprFundeps fds = hsep (ptext SLIT("|") : punctuate comma (map ppr_fd fds)) - -ppr_fd (us, vs) = hsep [interppSP us, ptext SLIT("->"), interppSP vs] -\end{code}