Use TcRnVDQInTermType in noNestedForallsContextsErr (#20115)

When faced with VDQ in the type of a term, GHC generates the following
error message:

	Illegal visible, dependent quantification in the type of a term
	(GHC does not yet support this)

Prior to this patch, there were two ways this message could have been
generated and represented:

	1. with the dedicated constructor TcRnVDQInTermType
	    (see check_type in GHC.Tc.Validity)
	2. with the transitional constructor TcRnUnknownMessage
	    (see noNestedForallsContextsErr in GHC.Rename.Utils)

Not only this led to duplication of code generating the final SDoc,
it also made it tricky to track the origin of the error message.

This patch fixes the problem by using TcRnVDQInTermType exclusively.

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