Implicit parameters should not be allowed in class and instance declarations

Trac #8912 pointed out that GHC 7.4 and 7.6 have omitted this test, although
7.2 and earlier had it.  This patch puts the test back in, and refactors a
little.

(cherry picked from commit a8b7b28c)

Conflicts:
	testsuite/tests/typecheck/should_fail/all.T

compiler/typecheck/TcValidity.lhs

@@ -38,7 +38,6 @@ import Name
 import VarEnv
 import VarSet
 import ErrUtils
-import PrelNames
 import DynFlags
 import Util
 import Maybes
@@ -436,9 +435,21 @@ If we do both, we get exponential behaviour!!
 %*                                                                      *
 %************************************************************************
 
+Note [Implicit parameters in instance decls]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Implicit parameters _only_ allowed in type signatures; not in instance
+decls, superclasses etc. The reason for not allowing implicit params in
+instances is a bit subtle.  If we allowed
+  instance (?x::Int, Eq a) => Foo [a] where ...
+then when we saw
+     (e :: (?x::Int) => t)
+it would be unclear how to discharge all the potential usas of the ?x
+in e.  For example, a constraint Foo [Int] might come out of e,and
+applying the instance decl would show up two uses of ?x.  Trac #8912.
+
 \begin{code}
 checkValidTheta :: UserTypeCtxt -> ThetaType -> TcM ()
-checkValidTheta ctxt theta 
+checkValidTheta ctxt theta
   = addErrCtxt (checkThetaCtxt ctxt theta) (check_valid_theta ctxt theta)
 
 -------------------------
@@ -460,36 +471,21 @@ check_pred_ty :: DynFlags -> UserTypeCtxt -> PredType -> TcM ()
 -- type synonyms have been checked at their definition site
 
 check_pred_ty dflags ctxt pred
-  | Just (tc,tys) <- tcSplitTyConApp_maybe pred
-  = case () of 
-      _ | Just cls <- tyConClass_maybe tc
-        -> check_class_pred dflags ctxt cls tys
-
-        | tc `hasKey` eqTyConKey
-        , let [_, ty1, ty2] = tys
-        -> check_eq_pred dflags ctxt ty1 ty2
-
-        | isTupleTyCon tc
-        -> check_tuple_pred dflags ctxt pred tys
-  
-        | otherwise   -- X t1 t2, where X is presumably a
-                      -- type/data family returning ConstraintKind
-        -> check_irred_pred dflags ctxt pred tys
-
-  | (TyVarTy _, arg_tys) <- tcSplitAppTys pred
-  = check_irred_pred dflags ctxt pred arg_tys
-
-  | otherwise
-  = badPred pred
+  = case classifyPredType pred of
+      ClassPred cls tys -> check_class_pred dflags ctxt pred cls tys
+      EqPred ty1 ty2    -> check_eq_pred    dflags ctxt pred ty1 ty2
+      TuplePred tys     -> check_tuple_pred dflags ctxt pred tys
+      IrredPred _       -> check_irred_pred dflags ctxt pred
 
-badPred :: PredType -> TcM ()
-badPred pred = failWithTc (ptext (sLit "Malformed predicate") <+> quotes (ppr pred))
 
-check_class_pred :: DynFlags -> UserTypeCtxt -> Class -> [TcType] -> TcM ()
-check_class_pred dflags ctxt cls tys
+check_class_pred :: DynFlags -> UserTypeCtxt -> PredType -> Class -> [TcType] -> TcM ()
+check_class_pred dflags ctxt pred cls tys
   = do {        -- Class predicates are valid in all contexts
        ; checkTc (arity == n_tys) arity_err
 
+       ; checkTc (not (isIPClass cls) || okIPCtxt ctxt)
+                 (badIPPred pred)
+
                 -- Check the form of the argument types
        ; mapM_ checkValidMonoType tys
        ; checkTc (check_class_pred_tys dflags ctxt tys)
@@ -502,13 +498,23 @@ check_class_pred dflags ctxt cls tys
     arity_err  = arityErr "Class" class_name arity n_tys
     how_to_allow = parens (ptext (sLit "Use FlexibleContexts to permit this"))
 
+okIPCtxt :: UserTypeCtxt -> Bool
+  -- See Note [Implicit parameters in instance decls]
+okIPCtxt (ClassSCCtxt {})  = False
+okIPCtxt (InstDeclCtxt {}) = False
+okIPCtxt (SpecInstCtxt {}) = False
+okIPCtxt _                 = True
 
-check_eq_pred :: DynFlags -> UserTypeCtxt -> TcType -> TcType -> TcM ()
-check_eq_pred dflags _ctxt ty1 ty2
+badIPPred :: PredType -> SDoc
+badIPPred pred = ptext (sLit "Illegal implict parameter") <+> quotes (ppr pred)
+
+
+check_eq_pred :: DynFlags -> UserTypeCtxt -> PredType -> TcType -> TcType -> TcM ()
+check_eq_pred dflags _ctxt pred ty1 ty2
   = do {        -- Equational constraints are valid in all contexts if type
                 -- families are permitted
        ; checkTc (xopt Opt_TypeFamilies dflags || xopt Opt_GADTs dflags) 
-                 (eqPredTyErr (mkEqPred ty1 ty2))
+                 (eqPredTyErr pred)
 
                 -- Check the form of the argument types
        ; checkValidMonoType ty1
@@ -523,8 +529,8 @@ check_tuple_pred dflags ctxt pred ts
     -- This case will not normally be executed because 
     -- without -XConstraintKinds tuple types are only kind-checked as *
 
-check_irred_pred :: DynFlags -> UserTypeCtxt -> PredType -> [TcType] -> TcM ()
-check_irred_pred dflags ctxt pred arg_tys
+check_irred_pred :: DynFlags -> UserTypeCtxt -> PredType -> TcM ()
+check_irred_pred dflags ctxt pred
     -- The predicate looks like (X t1 t2) or (x t1 t2) :: Constraint
     -- But X is not a synonym; that's been expanded already
     --
@@ -541,9 +547,9 @@ check_irred_pred dflags ctxt pred arg_tys
     --
     -- It is equally dangerous to allow them in instance heads because in that case the
     -- Paterson conditions may not detect duplication of a type variable or size change.
-  = do { checkTc (xopt Opt_ConstraintKinds dflags)
+  = do { checkValidMonoType pred
+       ; checkTc (xopt Opt_ConstraintKinds dflags)
                  (predIrredErr pred)
-       ; mapM_ checkValidMonoType arg_tys
        ; unless (xopt Opt_UndecidableInstances dflags) $
                  -- Make sure it is OK to have an irred pred in this context
          checkTc (case ctxt of ClassSCCtxt _ -> False; InstDeclCtxt -> False; _ -> True)

testsuite/tests/typecheck/should_fail/T7019.stderr

 
 T7019.hs:14:10:
-    Malformed predicate ‘C c’
+    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)’

testsuite/tests/typecheck/should_fail/T7019a.stderr

 
 T7019a.hs:11:1:
-    Malformed predicate ‘forall b. Context (Associated a b)’
+    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’
     In the class declaration for ‘Class’

testsuite/tests/typecheck/should_fail/T8912.hs

+{-# LANGUAGE ImplicitParams #-}
+module T8912 where
+
+class C a where
+  toInt :: a -> Int
+
+instance (?imp :: Int) => C [a] where
+  toInt _ = ?imp
+
+test :: Int
+test = let ?imp = 5 in toInt "Hello, world"

testsuite/tests/typecheck/should_fail/T8912.stderr

+
+T8912.hs:7:10:
+    Illegal implict parameter ‘?imp::Int’
+    In the context: (?imp::Int)
+    While checking an instance declaration
+    In the instance declaration for ‘C [a]’

testsuite/tests/typecheck/should_fail/all.T

@@ -329,3 +329,4 @@ test('ContextStack2', normal, compile_fail, ['-ftype-function-depth=10'])
 test('T8570', extra_clean(['T85570a.o', 'T8570a.hi','T85570b.o', 'T8570b.hi']),
      multimod_compile_fail, ['T8570', '-v0'])
 test('T8603', normal, compile_fail, [''])
+test('T8912', normal, compile_fail, [''])

testsuite/tests/typecheck/should_fail/tcfail041.stderr

 
-tcfail041.hs:9:10:
-    Unbound implicit parameter (?imp::Int)
-      arising from the superclasses of an instance declaration
-    In the instance declaration for ‘D Int’
+tcfail041.hs:5:1:
+    Illegal implict parameter ‘?imp::Int’
+    In the context: (?imp::Int)
+    While checking the super-classes of class ‘D’
+    In the class declaration for ‘D’

testsuite/tests/typecheck/should_fail/tcfail211.stderr

 
-tcfail211.hs:16:13:
-    Unbound implicit parameter (?imp::Int) arising from a use of ‘test’
-    In the first argument of ‘print’, namely ‘test’
-    In the expression: print test
-    In an equation for ‘use’: use = print test
+tcfail211.hs:5:1:
+    Illegal implict parameter ‘?imp::Int’
+    In the context: (?imp::Int)
+    While checking the super-classes of class ‘D’
+    In the class declaration for ‘D’