Reject forall types in constraints in signatures

Fixes Trac #9196.  Thanks to archblob for an initial stab at this.
In the end I fixed it in the kind checker rather than the subsequent
validity check, (a) so that the error messages look more uniform,
and (b) so that I did not need to meddle with isPredTy.

7 files changed, 32 insertions, 14 deletions

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 69579ada30..59aafeafba 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -396,13 +396,17 @@ tc_hs_type hs_ty@(HsAppTy ty1 ty2) exp_kind
     (fun_ty, arg_tys) = splitHsAppTys ty1 [ty2]
 
 --------- Foralls
-tc_hs_type hs_ty@(HsForAllTy _ hs_tvs context ty) exp_kind
-  = tcHsTyVarBndrs hs_tvs $ \ tvs' -> 
+tc_hs_type hs_ty@(HsForAllTy _ hs_tvs context ty) exp_kind@(EK exp_k _)
+  | isConstraintKind exp_k
+  = failWithTc (hang (ptext (sLit "Illegal constraint:")) 2 (ppr hs_ty))
+
+  | otherwise
+  = tcHsTyVarBndrs hs_tvs $ \ tvs' ->
     -- Do not kind-generalise here!  See Note [Kind generalisation]
     do { ctxt' <- tcHsContext context
        ; ty' <- if null (unLoc context) then  -- Plain forall, no context
                    tc_lhs_type ty exp_kind    -- Why exp_kind?  See Note [Body kind of forall]
-                else     
+                else
                    -- If there is a context, then this forall is really a
                    -- _function_, so the kind of the result really is *
                    -- The body kind (result of the function can be * or #, hence ekOpen
diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr
index dd967c8785..6e47926037 100644
--- a/testsuite/tests/typecheck/should_fail/T7019.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7019.stderr
@@ -1,6 +1,5 @@
 
-T7019.hs:14:10:
-    Illegal polymorphic or qualified type: C c
-    In the context: (C c)
-    While checking an instance declaration
-    In the instance declaration for ‘Monad (Free c)’
+T7019.hs:11:12:
+    Illegal constraint: forall a. c (Free c a)
+    In the type ‘forall a. c (Free c a)’
+    In the type declaration for ‘C’
diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr
index 301a6cd11c..f88893153f 100644
--- a/testsuite/tests/typecheck/should_fail/T7019a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr
@@ -1,7 +1,4 @@
 
-T7019a.hs:11:1:
-    Illegal polymorphic or qualified type:
-      forall b. Context (Associated a b)
-    In the context: (forall b. Context (Associated a b))
-    While checking the super-classes of class ‘Class’
+T7019a.hs:11:8:
+    Illegal constraint: forall b. Context (Associated a b)
     In the class declaration for ‘Class’
diff --git a/testsuite/tests/typecheck/should_fail/T8806.stderr b/testsuite/tests/typecheck/should_fail/T8806.stderr
index 5d50c4ec10..ab88b7f2eb 100644
--- a/testsuite/tests/typecheck/should_fail/T8806.stderr
+++ b/testsuite/tests/typecheck/should_fail/T8806.stderr
@@ -4,5 +4,5 @@ T8806.hs:5:6:
     In the type signature for ‘f’: f :: Int => Int
 
 T8806.hs:8:7:
-    Expected a constraint, but ‘Int’ has kind ‘*’
+    Illegal constraint: Int => Show a
     In the type signature for ‘g’: g :: (Int => Show a) => Int
diff --git a/testsuite/tests/typecheck/should_fail/T9196.hs b/testsuite/tests/typecheck/should_fail/T9196.hs
new file mode 100644
index 0000000000..11d713b5e9
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9196.hs
@@ -0,0 +1,8 @@
+{-# LANGUAGE RankNTypes #-}
+module T9196 where
+
+f :: (forall a. Eq a) => a -> a
+f x = x
+
+g :: (Eq a => Ord a) => a -> a
+g x = x
diff --git a/testsuite/tests/typecheck/should_fail/T9196.stderr b/testsuite/tests/typecheck/should_fail/T9196.stderr
new file mode 100644
index 0000000000..6f5a204edd
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T9196.stderr
@@ -0,0 +1,8 @@
+
+T9196.hs:4:7:
+    Illegal constraint: forall a. Eq a
+    In the type signature for ‘f’: f :: (forall a. Eq a) => a -> a
+
+T9196.hs:7:7:
+    Illegal constraint: Eq a => Ord a
+    In the type signature for ‘g’: g :: (Eq a => Ord a) => a -> a
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 676c910417..a1dab9df0f 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -333,3 +333,5 @@ test('T8806', normal, compile_fail, [''])
 test('T8912', normal, compile_fail, [''])
 test('T9033', normal, compile_fail, [''])
 test('T8883', normal, compile_fail, [''])
+test('T9196', normal, compile_fail, [''])
+