[commit: ghc] master: Reject forall types in constraints in signatures (9c621e9)

[git at git.haskell.org]

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

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

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

commit 9c621e9b1c7d8a02b48f06f041da605ce27f4d80
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Thu Jun 19 17:26:11 2014 +0100

    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.


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

9c621e9b1c7d8a02b48f06f041da605ce27f4d80
 compiler/typecheck/TcHsType.lhs                     | 6 +++++-
 testsuite/tests/typecheck/should_fail/T7019.stderr  | 9 ++++-----
 testsuite/tests/typecheck/should_fail/T7019a.stderr | 7 ++-----
 testsuite/tests/typecheck/should_fail/T8806.stderr  | 2 +-
 testsuite/tests/typecheck/should_fail/T9196.hs      | 8 ++++++++
 testsuite/tests/typecheck/should_fail/T9196.stderr  | 8 ++++++++
 testsuite/tests/typecheck/should_fail/all.T         | 2 ++
 7 files changed, 30 insertions(+), 12 deletions(-)

diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index 69579ad..59aafea 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -396,7 +396,11 @@ 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
+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
diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr
index dd967c8..6e47926 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 301a6cd..f888931 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 5d50c4e..ab88b7f 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 0000000..11d713b
--- /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 0000000..6f5a204
--- /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 676c910..a1dab9d 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, [''])
+