X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypes%2FFunDeps.lhs;h=0bea32fe57b124df03882711e3d6a6e45471b410;hb=ced4c13ea3577e01556a2f76c2cc458c0be6c83c;hp=af7cfec7f90976e9e5101d677b2a2d0bc8077c9e;hpb=dc667ab52ab208427094e497ece94132c57db8f2;p=ghc-hetmet.git diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs index af7cfec..0bea32f 100644 --- a/compiler/types/FunDeps.lhs +++ b/compiler/types/FunDeps.lhs @@ -9,8 +9,8 @@ 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, + Equation, pprEquation, + oclose, improveFromInstEnv, improveFromAnother, 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} %************************************************************************ %* * @@ -238,6 +200,21 @@ NOTA BENE: \begin{code} type Pred_Loc = (PredType, SDoc) -- SDoc says where the Pred comes from +improveFromInstEnv :: (Class -> [Instance]) + -> Pred_Loc + -> [(Equation,Pred_Loc,Pred_Loc)] +-- Improvement from top-level instances +improveFromInstEnv _inst_env pred + = improveOne _inst_env pred [] -- TODO: Refactor to directly use instance_eqnd? + +improveFromAnother :: Pred_Loc + -> Pred_Loc + -> [(Equation,Pred_Loc,Pred_Loc)] +-- Improvement from another local (given or wanted) constraint +improveFromAnother pred1 pred2 + = improveOne (\_ -> []) pred1 [pred2] -- TODO: Refactor to directly use pairwise_eqns? + + improveOne :: (Class -> [Instance]) -- Gives instances for given class -> Pred_Loc -- Do improvement triggered by this -> [Pred_Loc] -- Current constraints