Fix fundep coverage-condition check for poly-kinds
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 15 Apr 2015 09:28:40 +0000 (10:28 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 15 Apr 2015 09:29:06 +0000 (10:29 +0100)
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!

compiler/typecheck/FunDeps.hs
testsuite/tests/typecheck/should_compile/T10109.hs [new file with mode: 0644]
testsuite/tests/typecheck/should_compile/all.T

index 2d0ac33..53ecb48 100644 (file)
@@ -382,11 +382,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"))
@@ -419,7 +420,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 (file)
index 0000000..a61b2bc
--- /dev/null
@@ -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)
+
index 827811f..d7b3fad 100644 (file)
@@ -448,3 +448,4 @@ test('T10156', normal, compile, [''])
 test('T10177', normal, compile, [''])
 test('T10185', expect_broken(10185), compile, [''])
 test('T10195', normal, compile, [''])
+test('T10109', normal, compile, [''])