Fix unused-given-constraint bug
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 19 Sep 2017 11:37:13 +0000 (12:37 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Tue, 19 Sep 2017 11:38:28 +0000 (12:38 +0100)
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.

compiler/typecheck/TcEvidence.hs
compiler/typecheck/TcSimplify.hs
testsuite/tests/indexed-types/should_compile/T14237.hs [new file with mode: 0644]
testsuite/tests/indexed-types/should_compile/all.T

index 4f305c6..eda4b28 100644 (file)
@@ -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
index 1d28eee..60d8f62 100644 (file)
@@ -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 (file)
index 0000000..cab9fd2
--- /dev/null
@@ -0,0 +1,7 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# OPTIONS_GHC -fwarn-redundant-constraints #-}
+
+module T14237 where
+
+f :: (Integer ~ a) => a -> Integer
+f = (+ 1)
index 67ee1b7..6407324 100644 (file)
@@ -270,3 +270,4 @@ test('T14045', normal, compile, [''])
 test('T12938', normal, compile, [''])
 test('T14131', normal, compile, [''])
 test('T14162', normal, compile, [''])
+test('T14237', normal, compile, [''])