[commit: ghc] master: Close over kinds when checking fundep coverage (Trac #8391) (9d908c5)

[git at git.haskell.org]

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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/9d908c523bf61936ef372b70d5f8548fb36da26e/ghc

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

commit 9d908c523bf61936ef372b70d5f8548fb36da26e
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Oct 2 13:59:41 2013 +0100

    Close over kinds when checking fundep coverage (Trac #8391)
    
    See Note [Closing over kinds in coverage] in FunDeps


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

9d908c523bf61936ef372b70d5f8548fb36da26e
 compiler/types/FunDeps.lhs |   21 +++++++++++++++++++--
 1 file changed, 19 insertions(+), 2 deletions(-)

diff --git a/compiler/types/FunDeps.lhs b/compiler/types/FunDeps.lhs
index 8f255b7..77010de 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