summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--compiler/GHC/Rename/Module.hs7
-rw-r--r--compiler/GHC/Rename/Utils.hs11
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs12
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs2
-rw-r--r--compiler/GHC/Tc/Validity.hs14
-rw-r--r--testsuite/tests/dependent/should_fail/T16326_Fail6.stderr2
-rw-r--r--testsuite/tests/dependent/should_fail/T16326_Fail8.stderr2
-rw-r--r--testsuite/tests/dependent/should_fail/T18271.stderr2
8 files changed, 29 insertions, 23 deletions
diff --git a/compiler/GHC/Rename/Module.hs b/compiler/GHC/Rename/Module.hs
index fa0b748cd6..922e0f7a8e 100644
--- a/compiler/GHC/Rename/Module.hs
+++ b/compiler/GHC/Rename/Module.hs
@@ -618,7 +618,8 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
Just (L _ cls) -> Right cls
Nothing -> Left
( getLocA head_ty'
- , hang (text "Illegal head of an instance declaration:"
+ , mkTcRnUnknownMessage $ mkPlainError noHints $
+ hang (text "Illegal head of an instance declaration:"
<+> quotes (ppr head_ty'))
2 (vcat [ text "Instance heads must be of the form"
, nest 2 $ text "C ty_1 ... ty_n"
@@ -681,9 +682,7 @@ rnClsInstDecl (ClsInstDecl { cid_poly_ty = inst_ty, cid_binds = mbinds
-- reach the typechecker, lest we encounter different errors that are
-- hopelessly confusing (such as the one in #16114).
bail_out (l, err_msg) = do
- addErrAt l $
- TcRnWithHsDocContext ctxt $
- mkTcRnUnknownMessage $ mkPlainError noHints err_msg
+ addErrAt l $ TcRnWithHsDocContext ctxt err_msg
pure $ mkUnboundName (mkTcOccFS (fsLit "<class>"))
rnFamEqn :: HsDocContext
diff --git a/compiler/GHC/Rename/Utils.hs b/compiler/GHC/Rename/Utils.hs
index f422314699..fcf6b21b7a 100644
--- a/compiler/GHC/Rename/Utils.hs
+++ b/compiler/GHC/Rename/Utils.hs
@@ -288,7 +288,7 @@ Note [No nested foralls or contexts in instance types] in GHC.Hs.Type).
-- "GHC.Rename.Module" and 'renameSig' in "GHC.Rename.Bind").
-- See @Note [No nested foralls or contexts in instance types]@ in
-- "GHC.Hs.Type".
-noNestedForallsContextsErr :: SDoc -> LHsType GhcRn -> Maybe (SrcSpan, SDoc)
+noNestedForallsContextsErr :: SDoc -> LHsType GhcRn -> Maybe (SrcSpan, TcRnMessage)
noNestedForallsContextsErr what lty =
case ignoreParens lty of
L l (HsForAllTy { hst_tele = tele })
@@ -297,9 +297,7 @@ noNestedForallsContextsErr what lty =
-- types of terms, so we give a slightly more descriptive error
-- message in the event that they contain visible dependent
-- quantification (currently only allowed in kinds).
- -> Just (locA l, vcat [ text "Illegal visible, dependent quantification" <+>
- text "in the type of a term"
- , text "(GHC does not yet support this)" ])
+ -> Just (locA l, TcRnVDQInTermType Nothing)
| HsForAllInvis{} <- tele
-> Just (locA l, nested_foralls_contexts_err)
L l (HsQualTy {})
@@ -307,6 +305,7 @@ noNestedForallsContextsErr what lty =
_ -> Nothing
where
nested_foralls_contexts_err =
+ mkTcRnUnknownMessage $ mkPlainError noHints $
what <+> text "cannot contain nested"
<+> quotes forAllLit <> text "s or contexts"
@@ -314,9 +313,7 @@ noNestedForallsContextsErr what lty =
addNoNestedForallsContextsErr :: HsDocContext -> SDoc -> LHsType GhcRn -> RnM ()
addNoNestedForallsContextsErr ctxt what lty =
whenIsJust (noNestedForallsContextsErr what lty) $ \(l, err_msg) ->
- addErrAt l $
- TcRnWithHsDocContext ctxt $
- mkTcRnUnknownMessage $ mkPlainError noHints err_msg
+ addErrAt l $ TcRnWithHsDocContext ctxt err_msg
{-
************************************************************************
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 5b0f08b8a1..60b92643da 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -364,12 +364,16 @@ instance Diagnostic TcRnMessage where
2 (text "type:" <+> quotes (ppr ty))
, hang (text "where the body of the forall has this kind:")
2 (quotes (pprKind kind)) ]
- TcRnVDQInTermType ty
+ TcRnVDQInTermType mb_ty
-> mkSimpleDecorated $ vcat
- [ hang (text "Illegal visible, dependent quantification" <+>
- text "in the type of a term:")
- 2 (pprType ty)
+ [ case mb_ty of
+ Nothing -> main_msg
+ Just ty -> hang (main_msg <> char ':') 2 (pprType ty)
, text "(GHC does not yet support this)" ]
+ where
+ main_msg =
+ text "Illegal visible, dependent quantification" <+>
+ text "in the type of a term"
TcRnBadQuantPredHead ty
-> mkSimpleDecorated $
hang (text "Quantified predicate must have a class or type variable head:")
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index ac802272d5..053e53a16a 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -915,7 +915,7 @@ data TcRnMessage where
dependent/should_fail/T17687
dependent/should_fail/T18271
-}
- TcRnVDQInTermType :: !Type -> TcRnMessage
+ TcRnVDQInTermType :: !(Maybe Type) -> TcRnMessage
{-| TcRnBadQuantPredHead is an error that occurs whenever a quantified predicate
lacks a class or type variable head.
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 9af0fbdeb5..4dc4161664 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -733,7 +733,7 @@ check_type ve (CastTy ty _) = check_type ve ty
--
-- Critically, this case must come *after* the case for TyConApp.
-- See Note [Liberal type synonyms].
-check_type ve@(ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt
+check_type ve@(ValidityEnv{ ve_tidy_env = env
, ve_rank = rank, ve_expand = expand }) ty
| not (null tvbs && null theta)
= do { traceTc "check_type" (ppr ty $$ ppr rank)
@@ -745,9 +745,7 @@ check_type ve@(ValidityEnv{ ve_tidy_env = env, ve_ctxt = ctxt
-- Reject forall (a :: Eq b => b). blah
-- In a kind signature we don't allow constraints
- ; checkTcM (all (isInvisibleArgFlag . binderArgFlag) tvbs
- || vdqAllowed ctxt)
- (env, TcRnVDQInTermType (tidyType env ty))
+ ; checkVdqOK ve tvbs ty
-- Reject visible, dependent quantification in the type of a
-- term (e.g., `f :: forall a -> a -> Maybe a`)
@@ -938,6 +936,14 @@ checkConstraintsOK ve theta ty
checkTcM (all isEqPred theta) (env, TcRnConstraintInKind (tidyType env ty))
where env = ve_tidy_env ve
+checkVdqOK :: ValidityEnv -> [TyVarBinder] -> Type -> TcM ()
+checkVdqOK ve tvbs ty = do
+ checkTcM (vdqAllowed ctxt || no_vdq)
+ (env, TcRnVDQInTermType (Just (tidyType env ty)))
+ where
+ no_vdq = all (isInvisibleArgFlag . binderArgFlag) tvbs
+ ValidityEnv{ve_tidy_env = env, ve_ctxt = ctxt} = ve
+
{-
Note [Liberal type synonyms]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/testsuite/tests/dependent/should_fail/T16326_Fail6.stderr b/testsuite/tests/dependent/should_fail/T16326_Fail6.stderr
index e4acd7a7fd..6790247a36 100644
--- a/testsuite/tests/dependent/should_fail/T16326_Fail6.stderr
+++ b/testsuite/tests/dependent/should_fail/T16326_Fail6.stderr
@@ -1,5 +1,5 @@
-T16326_Fail6.hs:9:12: error:
+T16326_Fail6.hs:9:12: error: [GHC-51580]
Illegal visible, dependent quantification in the type of a term
(GHC does not yet support this)
In the definition of data constructor ‘MkFoo’
diff --git a/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr b/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr
index d7666cf84d..b464931e6e 100644
--- a/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr
+++ b/testsuite/tests/dependent/should_fail/T16326_Fail8.stderr
@@ -1,5 +1,5 @@
-T16326_Fail8.hs:7:10: error:
+T16326_Fail8.hs:7:10: error: [GHC-51580]
Illegal visible, dependent quantification in the type of a term
(GHC does not yet support this)
In an instance declaration
diff --git a/testsuite/tests/dependent/should_fail/T18271.stderr b/testsuite/tests/dependent/should_fail/T18271.stderr
index 0bc21f394d..8d906b3b2d 100644
--- a/testsuite/tests/dependent/should_fail/T18271.stderr
+++ b/testsuite/tests/dependent/should_fail/T18271.stderr
@@ -1,5 +1,5 @@
-T18271.hs:7:19: error:
+T18271.hs:7:19: error: [GHC-51580]
Illegal visible, dependent quantification in the type of a term
(GHC does not yet support this)
In a deriving declaration
View Lorry Controller Status