[commit: ghc] wip/rae: Fix #13909 by tweaking an error message. (f5e7cf0)

[git at git.haskell.org]

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

On branch  : wip/rae
Link       : http://ghc.haskell.org/trac/ghc/changeset/f5e7cf0c64006523c8c71ee18bf6c84c31aec329/ghc

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

commit f5e7cf0c64006523c8c71ee18bf6c84c31aec329
Author: Richard Eisenberg <rae at cs.brynmawr.edu>
Date:   Tue Aug 15 19:07:59 2017 -0400

    Fix #13909 by tweaking an error message.
    
    GHC was complaining about numbers of arguments when the real
    problem is impredicativity.
    
    test case: typecheck/should_fail/T13909


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

f5e7cf0c64006523c8c71ee18bf6c84c31aec329
 compiler/typecheck/TcErrors.hs                      |  7 ++++++-
 testsuite/tests/typecheck/should_fail/T13909.hs     | 12 ++++++++++++
 testsuite/tests/typecheck/should_fail/T13909.stderr |  5 +++++
 testsuite/tests/typecheck/should_fail/all.T         |  1 +
 4 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs
index 3aa5dd8..325c837 100644
--- a/compiler/typecheck/TcErrors.hs
+++ b/compiler/typecheck/TcErrors.hs
@@ -2015,8 +2015,11 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act
                   | otherwise            = text "kind" <+> quotes (ppr exp)
 
     num_args_msg = case level of
-      TypeLevel -> Nothing
       KindLevel
+        | not (isMetaTyVarTy exp) && not (isMetaTyVarTy act)
+           -- if one is a meta-tyvar, then it's possible that the user
+           -- has asked for something impredicative, and we couldn't unify.
+           -- Don't bother with counting arguments.
         -> let n_act = count_args act
                n_exp = count_args exp in
            case n_act - n_exp of
@@ -2031,6 +2034,8 @@ mkExpectedActualMsg ty1 ty2 (TypeEqOrigin { uo_actual = act
                   | otherwise = text "more arguments to"  -- n > 1
              _ -> Nothing
 
+      _ -> Nothing
+
     maybe_num_args_msg = case num_args_msg of
       Nothing -> empty
       Just m  -> m
diff --git a/testsuite/tests/typecheck/should_fail/T13909.hs b/testsuite/tests/typecheck/should_fail/T13909.hs
new file mode 100644
index 0000000..4f0cbdc
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13909.hs
@@ -0,0 +1,12 @@
+{-# LANGUAGE TypeInType #-}
+module T13909 where
+
+import Data.Kind
+
+data Hm (k :: Type) (a :: k) :: Type
+
+class HasName (a :: k) where
+  getName :: proxy a -> String
+
+instance HasName Hm where
+  getName _ = "Hm"
diff --git a/testsuite/tests/typecheck/should_fail/T13909.stderr b/testsuite/tests/typecheck/should_fail/T13909.stderr
new file mode 100644
index 0000000..599be5a
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T13909.stderr
@@ -0,0 +1,5 @@
+
+T13909.hs:11:18: error:
+    • Expected kind ‘k0’, but ‘Hm’ has kind ‘forall k -> k -> *’
+    • In the first argument of ‘HasName’, namely ‘Hm’
+      In the instance declaration for ‘HasName Hm’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index d865c76..7127a5d 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -454,3 +454,4 @@ test('T13819', normal, compile_fail, [''])
 test('T11963', normal, compile_fail, [''])
 test('T14000', normal, compile_fail, [''])
 test('T14055', normal, compile_fail, [''])
+test('T13909', normal, compile_fail, [''])