[commit: ghc] ghc-7.10: Fix fundep coverage-condition check for poly-kinds (d5c0892)

[git at git.haskell.org]

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

On branch  : ghc-7.10
Link       : http://ghc.haskell.org/trac/ghc/changeset/d5c089208735014a09d43b1ee757f52ddbfc92bf/ghc

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

commit d5c089208735014a09d43b1ee757f52ddbfc92bf
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Wed Apr 15 10:28:40 2015 +0100

    Fix fundep coverage-condition check for poly-kinds
    
    See Note [Closing over kinds in coverage] in FunDeps.
    I'd already fixed this bug once, for Trac #8391, but I put the
    call to closeOverKinds in the wrong place, so Trac #10109
    failed.  (It checks the /liberal/ coverage condition, which
    
    The fix was easy: move the call to the right place!
    
    (cherry picked from commit 49d9b009a2affb6015b8f6e2f15e4660a53c0d9a)


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

d5c089208735014a09d43b1ee757f52ddbfc92bf
 compiler/typecheck/FunDeps.hs                      |  9 +++++----
 testsuite/tests/typecheck/should_compile/T10109.hs | 10 ++++++++++
 testsuite/tests/typecheck/should_compile/all.T     |  1 +
 3 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/FunDeps.hs b/compiler/typecheck/FunDeps.hs
index a55fa2e..a6e5552 100644
--- a/compiler/typecheck/FunDeps.hs
+++ b/compiler/typecheck/FunDeps.hs
@@ -395,11 +395,12 @@ checkInstCoverage be_liberal clas theta inst_taus
        = NotValid msg
        where
          (ls,rs) = instFD fd tyvars inst_taus
-         ls_tvs = closeOverKinds (tyVarsOfTypes ls)  -- See Note [Closing over kinds in coverage]
+         ls_tvs = tyVarsOfTypes ls
          rs_tvs = tyVarsOfTypes rs
 
-         conservative_ok = rs_tvs `subVarSet` ls_tvs
-         liberal_ok      = rs_tvs `subVarSet` oclose theta ls_tvs
+         conservative_ok = rs_tvs `subVarSet` closeOverKinds ls_tvs
+         liberal_ok      = rs_tvs `subVarSet` closeOverKinds (oclose theta ls_tvs)
+                           -- closeOverKinds: see Note [Closing over kinds in coverage]
 
          msg = vcat [ sep [ ptext (sLit "The")
                             <+> ppWhen be_liberal (ptext (sLit "liberal"))
@@ -432,7 +433,7 @@ Example (Trac #8391), using liberal coverage
     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.
+that (a:k) fixes k.  Trac #10109 is another example.
 
 Note [The liberal coverage condition]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/typecheck/should_compile/T10109.hs b/testsuite/tests/typecheck/should_compile/T10109.hs
new file mode 100644
index 0000000..a61b2bc
--- /dev/null
+++ b/testsuite/tests/typecheck/should_compile/T10109.hs
@@ -0,0 +1,10 @@
+{-# LANGUAGE PolyKinds, MultiParamTypeClasses, FunctionalDependencies,
+             UndecidableInstances, FlexibleInstances #-}
+
+module T10109 where
+
+data Succ a
+
+class Add (a :: k1) (b :: k2) (ab :: k3) | a b -> ab
+instance (Add a b ab) => Add (Succ a) b (Succ ab)
+
diff --git a/testsuite/tests/typecheck/should_compile/all.T b/testsuite/tests/typecheck/should_compile/all.T
index de13ee3..e23f67c 100644
--- a/testsuite/tests/typecheck/should_compile/all.T
+++ b/testsuite/tests/typecheck/should_compile/all.T
@@ -442,3 +442,4 @@ test('T10031', normal, compile, [''])
 test('T10072', normal, compile_fail, [''])
 test('T10177', normal, compile, [''])
 test('T10195', normal, compile, [''])
+test('T10109', normal, compile, [''])