Fix unused-given-constraint bug

This bug was shown up by Trac #14237.  It turned out
to be an outright error in TcSimplify.neededEvVars,
easily fixed.

I improved the comments.

4 files changed, 23 insertions, 2 deletions

diff --git a/compiler/typecheck/TcEvidence.hs b/compiler/typecheck/TcEvidence.hs
index 4f305c6920..eda4b28e97 100644
--- a/compiler/typecheck/TcEvidence.hs
+++ b/compiler/typecheck/TcEvidence.hs
@@ -376,9 +376,11 @@ data EvBindsVar
       ebv_binds :: IORef EvBindMap,
       -- The main payload: the value-level evidence bindings
       --     (dictionaries etc)
+      -- Some Given, some Wanted
 
       ebv_tcvs :: IORef CoVarSet
       -- The free coercion vars of the (rhss of) the coercion bindings
+      -- All of these are Wanted
       --
       -- Coercions don't actually have bindings
       -- because we plug them in-place (via a mutable
diff --git a/compiler/typecheck/TcSimplify.hs b/compiler/typecheck/TcSimplify.hs
index 1d28eeee4c..60d8f621be 100644
--- a/compiler/typecheck/TcSimplify.hs
+++ b/compiler/typecheck/TcSimplify.hs
@@ -1559,11 +1559,22 @@ neededEvVars :: (EvBindMap, TcTyVarSet) -> VarSet -> VarSet
 -- Find all the evidence variables that are "needed",
 --    and then delete all those bound by the evidence bindings
 -- See Note [Tracking redundant constraints]
+--
+--   - Start from initial_seeds (from nested implications)
+--   - Add free vars of RHS of all Wanted evidence bindings
+--     and coercion variables accumulated in tcvs (all Wanted)
+--   - Do transitive closure through Given bindings
+--     e.g.   Neede {a,b}
+--            Given  a = sc_sel a2
+--            Then a2 is needed too
+--   - Finally delete all the binders of the evidence bindings
+--
 neededEvVars (ev_binds, tcvs) initial_seeds
- = (needed `unionVarSet` tcvs) `minusVarSet` bndrs
+ = needed `minusVarSet` bndrs
  where
-   seeds  = foldEvBindMap add_wanted initial_seeds ev_binds
    needed = transCloVarSet also_needs seeds
+   seeds  = foldEvBindMap add_wanted initial_seeds ev_binds
+            `unionVarSet` tcvs
    bndrs  = foldEvBindMap add_bndr emptyVarSet ev_binds
 
    add_wanted :: EvBind -> VarSet -> VarSet
diff --git a/testsuite/tests/indexed-types/should_compile/T14237.hs b/testsuite/tests/indexed-types/should_compile/T14237.hs
new file mode 100644
index 0000000000..cab9fd2052
--- /dev/null
+++ b/testsuite/tests/indexed-types/should_compile/T14237.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fwarn-redundant-constraints #-}
+
+module T14237 where
+
+f :: (Integer ~ a) => a -> Integer
+f = (+ 1)
diff --git a/testsuite/tests/indexed-types/should_compile/all.T b/testsuite/tests/indexed-types/should_compile/all.T
index 67ee1b77f3..6407324e82 100644
--- a/testsuite/tests/indexed-types/should_compile/all.T
+++ b/testsuite/tests/indexed-types/should_compile/all.T
@@ -270,3 +270,4 @@ test('T14045', normal, compile, [''])
 test('T12938', normal, compile, [''])
 test('T14131', normal, compile, [''])
 test('T14162', normal, compile, [''])
+test('T14237', normal, compile, [''])