From 4b1814f0cdd25711f4ae93aa1a9157815a97bde8 Mon Sep 17 00:00:00 2001
From: Simon Peyton Jones <simonpj@microsoft.com>
Date: Fri, 21 Mar 2014 15:55:39 +0000
Subject: [PATCH] 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 a8b7b28cdb98d14c6fb43d5ad3293fd4a5c1f8b4)
Conflicts:
testsuite/tests/typecheck/should_fail/all.T
---
compiler/typecheck/TcValidity.lhs | 74 ++++++++++---------
.../tests/typecheck/should_fail/T7019.stderr | 2 +-
.../tests/typecheck/should_fail/T7019a.stderr | 3 +-
.../tests/typecheck/should_fail/T8912.hs | 11 +++
.../tests/typecheck/should_fail/T8912.stderr | 6 ++
testsuite/tests/typecheck/should_fail/all.T | 1 +
.../typecheck/should_fail/tcfail041.stderr | 9 ++-
.../typecheck/should_fail/tcfail211.stderr | 10 +--
8 files changed, 71 insertions(+), 45 deletions(-)
create mode 100644 testsuite/tests/typecheck/should_fail/T8912.hs
create mode 100644 testsuite/tests/typecheck/should_fail/T8912.stderr
diff --git a/compiler/typecheck/TcValidity.lhs b/compiler/typecheck/TcValidity.lhs
index 20547bc51e04..d080c08f1162 100644
--- a/compiler/typecheck/TcValidity.lhs
+++ b/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)
diff --git a/testsuite/tests/typecheck/should_fail/T7019.stderr b/testsuite/tests/typecheck/should_fail/T7019.stderr
index 23baa974691e..dd967c87851c 100644
--- a/testsuite/tests/typecheck/should_fail/T7019.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7019.stderr
@@ -1,6 +1,6 @@
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)’
diff --git a/testsuite/tests/typecheck/should_fail/T7019a.stderr b/testsuite/tests/typecheck/should_fail/T7019a.stderr
index ee3cea11ce19..301a6cd11ce1 100644
--- a/testsuite/tests/typecheck/should_fail/T7019a.stderr
+++ b/testsuite/tests/typecheck/should_fail/T7019a.stderr
@@ -1,6 +1,7 @@
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’
diff --git a/testsuite/tests/typecheck/should_fail/T8912.hs b/testsuite/tests/typecheck/should_fail/T8912.hs
new file mode 100644
index 000000000000..5ffb47ebde36
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8912.hs
@@ -0,0 +1,11 @@
+{-# 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"
diff --git a/testsuite/tests/typecheck/should_fail/T8912.stderr b/testsuite/tests/typecheck/should_fail/T8912.stderr
new file mode 100644
index 000000000000..24607c29befc
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T8912.stderr
@@ -0,0 +1,6 @@
+
+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]’
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index 092a7daa613d..37546d6d8fe6 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/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, [''])
diff --git a/testsuite/tests/typecheck/should_fail/tcfail041.stderr b/testsuite/tests/typecheck/should_fail/tcfail041.stderr
index fd0d7d8fd271..ba5d4a15d71d 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail041.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail041.stderr
@@ -1,5 +1,6 @@
-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’
diff --git a/testsuite/tests/typecheck/should_fail/tcfail211.stderr b/testsuite/tests/typecheck/should_fail/tcfail211.stderr
index 191805298a41..3adb97cd75a7 100644
--- a/testsuite/tests/typecheck/should_fail/tcfail211.stderr
+++ b/testsuite/tests/typecheck/should_fail/tcfail211.stderr
@@ -1,6 +1,6 @@
-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’
--
GitLab