[commit: ghc] wip/new-flatten-skolems-Oct14: When reporting the context of given constraints, stop when you find one that binds a variable mentioned in the wanted (5d40a36)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/new-flatten-skolems-Oct14
Link       : http://ghc.haskell.org/trac/ghc/changeset/5d40a36eaad349d8d50f8a0c54d02f434ac328e6/ghc

>---------------------------------------------------------------

commit 5d40a36eaad349d8d50f8a0c54d02f434ac328e6
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 29 17:45:34 2014 +0000

    When reporting the context of given constraints, stop when you find one
    that binds a variable mentioned in the wanted
    
    There is really no point in reporting ones further out; they can't be useful


>---------------------------------------------------------------

5d40a36eaad349d8d50f8a0c54d02f434ac328e6
 compiler/typecheck/TcErrors.lhs | 23 +++++++++++++++++------
 1 file changed, 17 insertions(+), 6 deletions(-)

diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs
index 72fe9fa..9a6b31f 100644
--- a/compiler/typecheck/TcErrors.lhs
+++ b/compiler/typecheck/TcErrors.lhs
@@ -1068,7 +1068,7 @@ mk_dict_err fam_envs ctxt (ct, (matches, unifiers, safe_haskell))
 
     add_to_ctxt_fixes has_ambig_tvs
       | not has_ambig_tvs && all_tyvars
-      , (orig:origs) <- mapMaybe get_good_orig (cec_encl ctxt)
+      , (orig:origs) <- usefulContext ctxt pred 
       = [sep [ ptext (sLit "add") <+> pprParendType pred
                <+> ptext (sLit "to the context of")
              , nest 2 $ ppr_skol orig $$
@@ -1079,11 +1079,6 @@ mk_dict_err fam_envs ctxt (ct, (matches, unifiers, safe_haskell))
     ppr_skol (PatSkol dc _) = ptext (sLit "the data constructor") <+> quotes (ppr dc)
     ppr_skol skol_info      = ppr skol_info
 
-        -- Do not suggest adding constraints to an *inferred* type signature!
-    get_good_orig ic = case ic_info ic of
-                         SigSkol (InfSigCtxt {}) _ -> Nothing
-                         origin                    -> Just origin
-
     no_inst_msg
       | clas == coercibleClass
       = let (ty1, ty2) = getEqPredTys pred
@@ -1218,6 +1213,22 @@ mk_dict_err fam_envs ctxt (ct, (matches, unifiers, safe_haskell))
                            , ptext (sLit "is not in scope") ])
         | otherwise = Nothing
 
+usefulContext :: ReportErrCtxt -> TcPredType -> [SkolemInfo]
+usefulContext ctxt pred
+  = go (cec_encl ctxt)
+  where
+    pred_tvs = tyVarsOfType pred
+    go [] = []
+    go (ic : ics)
+       = case ic_info ic of
+               -- Do not suggest adding constraints to an *inferred* type signature!
+           SigSkol (InfSigCtxt {}) _ -> rest
+           info                      -> info : rest
+       where
+          -- Stop when the context binds a variable free in the predicate
+          rest | any (`elemVarSet` pred_tvs) (ic_skols ic) = []
+               | otherwise                                 = go ics
+
 show_fixes :: [SDoc] -> SDoc
 show_fixes []     = empty
 show_fixes (f:fs) = sep [ ptext (sLit "Possible fix:")