X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FFunDeps.lhs;h=06248b7b3cd4a79ee1ee6f534fb050be078e2b89;hb=d29f86b1fe7daf919e9b47a9003daed74b812790;hp=9347f5f665d7c04d7b6387001bae2d0213b3f419;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs index 9347f5f..06248b7 100644 --- a/compiler/types/FunDeps.lhs +++ b/compiler/types/FunDeps.lhs @@ -1,7 +1,9 @@ % +% (c) The University of Glasgow 2006 % (c) The GRASP/AQUA Project, Glasgow University, 2000 % -\section[FunDeps]{FunDeps - functional dependencies} + +FunDeps - functional dependencies It's better to read it as: "if we know these, then we're going to know these" @@ -15,22 +17,22 @@ module FunDeps ( #include "HsVersions.h" -import Name ( Name, getSrcLoc ) -import Var ( TyVar ) -import Class ( Class, FunDep, classTvsFds ) -import Unify ( tcUnifyTys, BindFlag(..) ) -import Type ( substTys, notElemTvSubst ) -import TcType ( Type, PredType(..), tcEqType, - predTyUnique, mkClassPred, tyVarsOfTypes, tyVarsOfPred ) -import InstEnv ( Instance(..), InstEnv, instanceHead, classInstances, - instanceCantMatch, roughMatchTcs ) +import Name +import Var +import Class +import TcGadt +import Type +import Coercion +import TcType +import InstEnv import VarSet import VarEnv import Outputable -import Util ( notNull ) -import List ( tails ) -import Maybe ( isJust ) -import ListSetOps ( equivClassesByUniq ) +import Util +import ListSetOps + +import Data.List ( tails ) +import Data.Maybe ( isJust ) \end{code} @@ -125,6 +127,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 +221,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 +492,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}