Close over kinds when checking fundep coverage (Trac #8391)

See Note [Closing over kinds in coverage] in FunDeps

1 files changed, 19 insertions, 2 deletions

diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs
index 8f255b7227..77010de984 100644
--- a/compiler/types/FunDeps.lhs
+++ b/compiler/types/FunDeps.lhs
@@ -466,10 +466,11 @@ checkInstCoverage be_liberal clas theta inst_taus
        | if be_liberal then liberal_ok else conservative_ok
        = Nothing
        | otherwise
-       = Just msg
+       = pprTrace "cic" (vcat [ppr clas <+> ppr inst_taus, ppr fd, ppr ls_tvs, ppr rs_tvs, ppr (oclose theta ls_tvs), ppr theta]) $
+         Just msg
        where
          (ls,rs) = instFD fd tyvars inst_taus
-         ls_tvs = tyVarsOfTypes ls
+         ls_tvs = closeOverKinds (tyVarsOfTypes ls)  -- See Note [Closing over kinds in coverage]
          rs_tvs = tyVarsOfTypes rs
 
          conservative_ok = rs_tvs `subVarSet` ls_tvs
@@ -492,6 +493,22 @@ checkInstCoverage be_liberal clas theta inst_taus
                       ptext (sLit "Using UndecidableInstances might help") ]
 \end{code}
 
+Note [Closing over kinds in coverage]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have a fundep  (a::k) -> b
+Then if 'a' is instantiated to (x y), where x:k2->*, y:k2,
+then fixing x really fixes k2 as well, and so k2 should be added to
+the lhs tyvars in the fundep check.
+
+Example (Trac #8391), using liberal coverage
+
+    type Foo a = a  -- Foo :: forall k. k -> k
+    class Bar a b | a -> b
+    instance Bar a (Foo a)
+
+In the instance decl, (a:k) does fix (Foo k a), but only if we notice
+that (a:k) fixes k.
+
 Note [Coverage condition]
 ~~~~~~~~~~~~~~~~~~~~~~~~~
 Example