From f90b6f402150b5780bd9da790d9f0e88a11b09ae Mon Sep 17 00:00:00 2001
From: Aaron Allen <aaron@flipstone.com>
Date: Sun, 8 May 2022 16:18:03 -0500
Subject: [PATCH] Diagnostics conversions, part 6 (#20116)

Replaces uses of `TcRnUnknownMessage` with proper diagnostics
constructors in `GHC.Tc.Gen.Match`, `GHC.Tc.Gen.Pat`, and
`GHC.Tc.Gen.Sig`.
---
 compiler/GHC/Tc/Errors/Ppr.hs   |  74 ++++++++++++++++++++++
 compiler/GHC/Tc/Errors/Types.hs | 108 ++++++++++++++++++++++++++++++++
 compiler/GHC/Tc/Gen/Match.hs    |  22 +++----
 compiler/GHC/Tc/Gen/Pat.hs      |  47 ++++++--------
 compiler/GHC/Tc/Gen/Sig.hs      |  37 +++--------
 compiler/GHC/Types/Hint.hs      |   6 ++
 compiler/GHC/Types/Hint/Ppr.hs  |   7 ++-
 7 files changed, 229 insertions(+), 72 deletions(-)

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index b8ed303dd736..3dc1ea685b7c 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -895,6 +895,48 @@ instance Diagnostic TcRnMessage where
                      ClassPE        -> same_rec_group_msg
                      TyConPE        -> same_rec_group_msg
           same_rec_group_msg = text "it is defined and used in the same recursive group"
+    TcRnMatchesHaveDiffNumArgs argsContext match1 bad_matches
+      -> mkSimpleDecorated $
+           (vcat [ pprArgsContext argsContext <+>
+                   text "have different numbers of arguments"
+                 , nest 2 (ppr (getLocA match1))
+                 , nest 2 (ppr (getLocA (NE.head bad_matches)))])
+        where
+          pprArgsContext = \case
+            EquationArgs name -> (text "Equations for" <+>) . quotes $ ppr name
+            PatternArgs matchCtx -> pprMatchContextNouns matchCtx
+    TcRnCannotBindScopedTyVarInPatSig sig_tvs
+      -> mkSimpleDecorated $
+           hang (text "You cannot bind scoped type variable"
+                  <> plural (NE.toList sig_tvs)
+                 <+> pprQuotedList (map fst $ NE.toList sig_tvs))
+              2 (text "in a pattern binding signature")
+    TcRnCannotBindTyVarsInPatBind _offenders
+      -> mkSimpleDecorated $
+           text "Binding type variables is not allowed in pattern bindings"
+    TcRnTooManyTyArgsInConPattern con_like expected_number actual_number
+      -> mkSimpleDecorated $
+           text "Too many type arguments in constructor pattern for" <+> quotes (ppr con_like) $$
+           text "Expected no more than" <+> ppr expected_number <> semi <+> text "got" <+> ppr actual_number
+    TcRnMultipleInlinePragmas poly_id fst_inl_prag inl_prags
+      -> mkSimpleDecorated $
+           hang (text "Multiple INLINE pragmas for" <+> ppr poly_id)
+             2 (vcat (text "Ignoring all but the first"
+                      : map pp_inl (fst_inl_prag : NE.toList inl_prags)))
+         where
+           pp_inl (L loc prag) = ppr prag <+> parens (ppr loc)
+    TcRnUnexpectedPragmas poly_id bad_sigs
+      -> mkSimpleDecorated $
+           hang (text "Discarding unexpected pragmas for" <+> ppr poly_id)
+              2 (vcat (map (ppr . getLoc) $ NE.toList bad_sigs))
+    TcRnNonOverloadedSpecialisePragma fun_name
+       -> mkSimpleDecorated $
+            text "SPECIALISE pragma for non-overloaded function"
+              <+> quotes (ppr fun_name)
+    TcRnSpecialiseNotVisible name
+      -> mkSimpleDecorated $
+         text "You cannot SPECIALISE" <+> quotes (ppr name)
+           <+> text "because its definition is not visible in this module"
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -1185,6 +1227,22 @@ instance Diagnostic TcRnMessage where
       -> ErrorWithoutFlag
     TcRnUnpromotableThing{}
       -> ErrorWithoutFlag
+    TcRnMatchesHaveDiffNumArgs{}
+      -> ErrorWithoutFlag
+    TcRnCannotBindScopedTyVarInPatSig{}
+      -> ErrorWithoutFlag
+    TcRnCannotBindTyVarsInPatBind{}
+      -> ErrorWithoutFlag
+    TcRnTooManyTyArgsInConPattern{}
+      -> ErrorWithoutFlag
+    TcRnMultipleInlinePragmas{}
+      -> WarningWithoutFlag
+    TcRnUnexpectedPragmas{}
+      -> WarningWithoutFlag
+    TcRnNonOverloadedSpecialisePragma{}
+      -> WarningWithoutFlag
+    TcRnSpecialiseNotVisible{}
+      -> WarningWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -1477,6 +1535,22 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnUnpromotableThing{}
       -> noHints
+    TcRnMatchesHaveDiffNumArgs{}
+      -> noHints
+    TcRnCannotBindScopedTyVarInPatSig{}
+      -> noHints
+    TcRnCannotBindTyVarsInPatBind{}
+      -> noHints
+    TcRnTooManyTyArgsInConPattern{}
+      -> noHints
+    TcRnMultipleInlinePragmas{}
+      -> noHints
+    TcRnUnexpectedPragmas{}
+      -> noHints
+    TcRnNonOverloadedSpecialisePragma{}
+      -> noHints
+    TcRnSpecialiseNotVisible name
+      -> [SuggestSpecialiseVisibilityHints name]
 
 
 -- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z",
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index e1679d82d093..ad5f3db81bcc 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -64,6 +64,7 @@ module GHC.Tc.Errors.Types (
   , UnsupportedCallConvention(..)
   , ExpectedBackends
   , ArgOrResult(..)
+  , MatchArgsContext(..)
   ) where
 
 import GHC.Prelude
@@ -2008,6 +2009,106 @@ data TcRnMessage where
   -}
   TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage
 
+  {- TcRnMatchesHaveDiffNumArgs is an error occurring when something has matches
+     that have different numbers of arguments
+
+     Example(s):
+     foo x = True
+     foo x y = False
+
+    Test cases: rename/should_fail/rnfail045
+                typecheck/should_fail/T20768_fail
+  -}
+  TcRnMatchesHaveDiffNumArgs
+    :: !MatchArgsContext
+    -> !(LocatedA (Match GhcRn body))
+    -> !(NE.NonEmpty (LocatedA (Match GhcRn body))) -- ^ bad matches
+    -> TcRnMessage
+
+  {- TcRnCannotBindScopedTyVarInPatSig is an error stating that scoped type
+     variables cannot be used in pattern bindings.
+
+     Example(s):
+     let (x :: a) = 5
+
+     Test cases: typecheck/should_compile/tc141
+  -}
+  TcRnCannotBindScopedTyVarInPatSig :: !(NE.NonEmpty (Name, TcTyVar)) -> TcRnMessage
+
+  {- TcRnCannotBindTyVarsInPatBind is an error for when type
+     variables are introduced in a pattern binding
+
+     Example(s):
+     Just @a x = Just True
+
+    Test cases: typecheck/should_fail/TyAppPat_PatternBinding
+                typecheck/should_fail/TyAppPat_PatternBindingExistential
+  -}
+  TcRnCannotBindTyVarsInPatBind :: !(NE.NonEmpty (Name, TcTyVar)) -> TcRnMessage
+
+  {- TcRnTooManyTyArgsInConPattern is an error occurring when a constructor pattern
+     has more than the expected number of type arguments
+
+     Example(s):
+     f (Just @Int @Bool x) = x
+
+    Test cases: typecheck/should_fail/TyAppPat_TooMany
+                typecheck/should_fail/T20443b
+  -}
+  TcRnTooManyTyArgsInConPattern
+    :: !ConLike
+    -> !Int -- ^ Expected number of args
+    -> !Int -- ^ Actual number of args
+    -> TcRnMessage
+
+  {- TcRnMultipleInlinePragmas is a warning signifying that multiple inline pragmas
+     reference the same definition.
+
+     Example(s):
+     {-# INLINE foo #-}
+     {-# INLINE foo #-}
+     foo :: Bool -> Bool
+     foo = id
+
+    Test cases: none
+  -}
+  TcRnMultipleInlinePragmas
+    :: !Id -- ^ Target of the pragmas
+    -> !(LocatedA InlinePragma) -- ^ The first pragma
+    -> !(NE.NonEmpty (LocatedA InlinePragma)) -- ^ Other pragmas
+    -> TcRnMessage
+
+  {- TcRnUnexpectedPragmas is a warning that occurrs when unexpected pragmas appear
+     in the source.
+
+     Example(s):
+
+    Test cases: none
+  -}
+  TcRnUnexpectedPragmas :: !Id -> !(NE.NonEmpty (LSig GhcRn)) -> TcRnMessage
+
+  {- TcRnNonOverloadedSpecialisePragma is a warning for a specialise pragma being
+     placed on a definition that is not overloaded.
+
+     Example(s):
+     {-# SPECIALISE foo :: Bool -> Bool #-}
+     foo :: Bool -> Bool
+     foo = id
+
+    Test cases: simplCore/should_compile/T8537
+                typecheck/should_compile/T10504
+  -}
+  TcRnNonOverloadedSpecialisePragma :: !(LIdP GhcRn) -> TcRnMessage
+
+  {- TcRnSpecialiseNotVisible is a warning that occurrs when the subject of a
+     SPECIALISE pragma has a definition that is not visible from the current module.
+
+     Example(s): none
+
+    Test cases: none
+  -}
+  TcRnSpecialiseNotVisible :: !Name -> TcRnMessage
+
 -- | Specifies which back ends can handle a requested foreign import or export
 type ExpectedBackends = [Backend]
 
@@ -3050,3 +3151,10 @@ data HsDocContext
   | SpliceTypeCtx (LHsType GhcPs)
   | ClassInstanceCtx
   | GenericCtx SDoc
+
+-- | Context for a mismatch in the number of arguments
+data MatchArgsContext
+  = EquationArgs
+      !Name -- ^ Name of the function
+  | PatternArgs
+      !(HsMatchContext GhcTc) -- ^ Pattern match specifics
diff --git a/compiler/GHC/Tc/Gen/Match.hs b/compiler/GHC/Tc/Gen/Match.hs
index 9646cfeacee7..e1a0c2401b01 100644
--- a/compiler/GHC/Tc/Gen/Match.hs
+++ b/compiler/GHC/Tc/Gen/Match.hs
@@ -71,7 +71,6 @@ import GHC.Utils.Panic
 import GHC.Utils.Misc
 import GHC.Driver.Session ( getDynFlags )
 
-import GHC.Types.Error
 import GHC.Types.Fixity (LexicalFixity(..))
 import GHC.Types.Name
 import GHC.Types.Id
@@ -79,6 +78,7 @@ import GHC.Types.SrcLoc
 
 import Control.Monad
 import Control.Arrow ( second )
+import qualified Data.List.NonEmpty as NE
 
 {-
 ************************************************************************
@@ -1143,32 +1143,28 @@ number of args are used in each equation.
 
 checkArgCounts :: AnnoBody body
                => Name -> MatchGroup GhcRn (LocatedA (body GhcRn)) -> TcM ()
-checkArgCounts = check_match_pats . (text "Equations for" <+>) . quotes . ppr
+checkArgCounts = check_match_pats . EquationArgs
 
 -- @checkPatCounts@ takes a @[RenamedMatch]@ and decides whether the same
 -- number of patterns are used in each alternative
 checkPatCounts :: AnnoBody body
                => HsMatchContext GhcTc -> MatchGroup GhcRn (LocatedA (body GhcRn))
                -> TcM ()
-checkPatCounts = check_match_pats . pprMatchContextNouns
+checkPatCounts = check_match_pats . PatternArgs
 
 check_match_pats :: AnnoBody body
-                 => SDoc -> MatchGroup GhcRn (LocatedA (body GhcRn))
+                 => MatchArgsContext -> MatchGroup GhcRn (LocatedA (body GhcRn))
                  -> TcM ()
 check_match_pats _ (MG { mg_alts = L _ [] })
     = return ()
-check_match_pats err_msg (MG { mg_alts = L _ (match1:matches) })
-    | null bad_matches
-    = return ()
+check_match_pats matchContext (MG { mg_alts = L _ (match1:matches) })
+    | Just bad_matches <- mb_bad_matches
+    = failWithTc $ TcRnMatchesHaveDiffNumArgs matchContext match1 bad_matches
     | otherwise
-    = failWithTc $ TcRnUnknownMessage $ mkPlainError noHints $
-      (vcat [ err_msg <+>
-              text "have different numbers of arguments"
-            , nest 2 (ppr (getLocA match1))
-            , nest 2 (ppr (getLocA (head bad_matches)))])
+    = return ()
   where
     n_args1 = args_in_match match1
-    bad_matches = [m | m <- matches, args_in_match m /= n_args1]
+    mb_bad_matches = NE.nonEmpty [m | m <- matches, args_in_match m /= n_args1]
 
     args_in_match :: (LocatedA (Match GhcRn body1) -> Int)
     args_in_match (L _ (Match { m_pats = pats })) = length pats
diff --git a/compiler/GHC/Tc/Gen/Pat.hs b/compiler/GHC/Tc/Gen/Pat.hs
index cd429f0cc51e..62deebfe78a1 100644
--- a/compiler/GHC/Tc/Gen/Pat.hs
+++ b/compiler/GHC/Tc/Gen/Pat.hs
@@ -71,6 +71,7 @@ import GHC.Utils.Panic.Plain
 import qualified GHC.LanguageExtensions as LangExt
 import Control.Arrow  ( second )
 import Control.Monad
+import qualified Data.List.NonEmpty as NE
 import GHC.Data.List.SetOps ( getNth )
 
 {-
@@ -743,26 +744,29 @@ tcPatSig in_pat_bind sig res_ty
         -- and not already in scope. These are the ones
         -- that should be brought into scope
 
-        ; if null sig_tvs then do {
+        ; case NE.nonEmpty sig_tvs of
+            Nothing -> do {
                 -- Just do the subsumption check and return
                   wrap <- addErrCtxtM (mk_msg sig_ty) $
                           tcSubTypePat PatSigOrigin PatSigCtxt res_ty sig_ty
                 ; return (sig_ty, [], sig_wcs, wrap)
-        } else do
+                }
+            Just sig_tvs_ne -> do
                 -- Type signature binds at least one scoped type variable
 
                 -- A pattern binding cannot bind scoped type variables
                 -- It is more convenient to make the test here
                 -- than in the renamer
-        { when in_pat_bind (addErr (patBindSigErr sig_tvs))
+              when in_pat_bind
+                (addErr (TcRnCannotBindScopedTyVarInPatSig sig_tvs_ne))
 
-        -- Now do a subsumption check of the pattern signature against res_ty
-        ; wrap <- addErrCtxtM (mk_msg sig_ty) $
-                  tcSubTypePat PatSigOrigin PatSigCtxt res_ty sig_ty
+              -- Now do a subsumption check of the pattern signature against res_ty
+              wrap <- addErrCtxtM (mk_msg sig_ty) $
+                      tcSubTypePat PatSigOrigin PatSigCtxt res_ty sig_ty
 
-        -- Phew!
-        ; return (sig_ty, sig_tvs, sig_wcs, wrap)
-        } }
+              -- Phew!
+              return (sig_ty, sig_tvs, sig_wcs, wrap)
+       }
   where
     mk_msg sig_ty tidy_env
        = do { (tidy_env, sig_ty) <- zonkTidyTcType tidy_env sig_ty
@@ -774,13 +778,6 @@ tcPatSig in_pat_bind sig res_ty
                                           2 (ppr res_ty)) ]
             ; return (tidy_env, msg) }
 
-patBindSigErr :: [(Name,TcTyVar)] -> TcRnMessage
-patBindSigErr sig_tvs
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    hang (text "You cannot bind scoped type variable" <> plural sig_tvs
-          <+> pprQuotedList (map fst sig_tvs))
-       2 (text "in a pattern binding signature")
-
 
 {- *********************************************************************
 *                                                                      *
@@ -1253,7 +1250,7 @@ tcConArgs con_like arg_tys tenv penv con_args thing_inside = case con_args of
         ; let con_spec_binders = filter ((== SpecifiedSpec) . binderArgFlag) $
                                  conLikeUserTyVarBinders con_like
         ; checkTc (type_args `leLength` con_spec_binders)
-                  (conTyArgArityErr con_like (length con_spec_binders) (length type_args))
+                  (TcRnTooManyTyArgsInConPattern con_like (length con_spec_binders) (length type_args))
 
         ; let pats_w_tys = zipEqual "tcConArgs" arg_pats arg_tys
         ; (type_args', (arg_pats', res))
@@ -1332,9 +1329,10 @@ tcConTyArg penv rn_ty thing_inside
                -- the kinds of later patterns. In any case, it all gets checked
                -- by the calls to unifyType in tcConArgs, which will also unify
                -- kinds.
-       ; when (not (null sig_ibs) && inPatBind penv) $
-           addErr (TcRnUnknownMessage $ mkPlainError noHints $
-                     text "Binding type variables is not allowed in pattern bindings")
+       ; case NE.nonEmpty sig_ibs of
+           Just sig_ibs_ne | inPatBind penv ->
+             addErr (TcRnCannotBindTyVarsInPatBind sig_ibs_ne)
+           _ -> pure ()
        ; result <- tcExtendNameTyVarEnv sig_wcs $
                    tcExtendNameTyVarEnv sig_ibs $
                    thing_inside
@@ -1362,15 +1360,6 @@ addDataConStupidTheta data_con inst_tys
          --     because the constructor might have existentials
     inst_theta = substTheta tenv stupid_theta
 
-conTyArgArityErr :: ConLike
-                 -> Int   -- expected # of arguments
-                 -> Int   -- actual # of arguments
-                 -> TcRnMessage
-conTyArgArityErr con_like expected_number actual_number
-  = TcRnUnknownMessage $ mkPlainError noHints $
-    text "Too many type arguments in constructor pattern for" <+> quotes (ppr con_like) $$
-    text "Expected no more than" <+> ppr expected_number <> semi <+> text "got" <+> ppr actual_number
-
 {-
 Note [Arrows and patterns]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 16a46f4454dc..66c7c80ceda8 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -68,9 +68,10 @@ import GHC.Utils.Misc as Utils ( singleton )
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 
-import GHC.Data.Maybe( orElse )
+import GHC.Data.Maybe( orElse, whenIsJust )
 
 import Data.Maybe( mapMaybe )
+import qualified Data.List.NonEmpty as NE
 import Control.Monad( unless )
 
 
@@ -631,15 +632,9 @@ addInlinePrags poly_id prags_for_me
          warn_multiple_inlines inl2 inls
        | otherwise
        = setSrcSpanA loc $
-         let dia = TcRnUnknownMessage $
-               mkPlainDiagnostic WarningWithoutFlag noHints $
-                 (hang (text "Multiple INLINE pragmas for" <+> ppr poly_id)
-                   2 (vcat (text "Ignoring all but the first"
-                            : map pp_inl (inl1:inl2:inls))))
+         let dia = TcRnMultipleInlinePragmas poly_id inl1 (inl2 NE.:| inls)
          in addDiagnosticTc dia
 
-    pp_inl (L loc prag) = ppr prag <+> parens (ppr loc)
-
 
 {- Note [Pattern synonym inline arity]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -776,7 +771,7 @@ tcSpecPrags :: Id -> [LSig GhcRn]
 -- Reason: required by tcSubExp
 tcSpecPrags poly_id prag_sigs
   = do { traceTc "tcSpecPrags" (ppr poly_id <+> ppr spec_sigs)
-       ; unless (null bad_sigs) warn_discarded_sigs
+       ; whenIsJust (NE.nonEmpty bad_sigs) warn_discarded_sigs
        ; pss <- mapAndRecoverM (wrapLocMA (tcSpecPrag poly_id)) spec_sigs
        ; return $ concatMap (\(L l ps) -> map (L (locA l)) ps) pss }
   where
@@ -784,11 +779,8 @@ tcSpecPrags poly_id prag_sigs
     bad_sigs  = filter is_bad_sig prag_sigs
     is_bad_sig s = not (isSpecLSig s || isInlineLSig s || isSCCFunSig s)
 
-    warn_discarded_sigs
-      = let dia = TcRnUnknownMessage $
-              mkPlainDiagnostic WarningWithoutFlag noHints $
-                (hang (text "Discarding unexpected pragmas for" <+> ppr poly_id)
-                    2 (vcat (map (ppr . getLoc) bad_sigs)))
+    warn_discarded_sigs bad_sigs_ne
+      = let dia = TcRnUnexpectedPragmas poly_id bad_sigs_ne
         in addDiagnosticTc dia
 
 --------------
@@ -803,9 +795,7 @@ tcSpecPrag poly_id prag@(SpecSig _ fun_name hs_tys inl)
 -- what the user wrote (#8537)
   = addErrCtxt (spec_ctxt prag) $
     do  { warnIf (not (isOverloadedTy poly_ty || isInlinePragma inl)) $
-                 TcRnUnknownMessage $ mkPlainDiagnostic WarningWithoutFlag noHints
-                   (text "SPECIALISE pragma for non-overloaded function"
-                    <+> quotes (ppr fun_name))
+                 TcRnNonOverloadedSpecialisePragma fun_name
                     -- Note [SPECIALISE pragmas]
         ; spec_prags <- mapM tc_one hs_tys
         ; traceTc "tcSpecPrag" (ppr poly_id $$ nest 2 (vcat (map ppr spec_prags)))
@@ -867,21 +857,10 @@ tcImpSpec (name, prag)
       ; if hasSomeUnfolding (realIdUnfolding id)
            -- See Note [SPECIALISE pragmas for imported Ids]
         then tcSpecPrag id prag
-        else do { let dia = TcRnUnknownMessage $
-                        mkPlainDiagnostic WarningWithoutFlag noHints (impSpecErr name)
+        else do { let dia = TcRnSpecialiseNotVisible name
                 ; addDiagnosticTc dia
                 ; return [] } }
 
-impSpecErr :: Name -> SDoc
-impSpecErr name
-  = hang (text "You cannot SPECIALISE" <+> quotes (ppr name))
-       2 (vcat [ text "because its definition is not visible in this module"
-               , text "Hint: make sure" <+> ppr mod <+> text "is compiled with -O"
-               , text "      and that" <+> quotes (ppr name)
-                 <+> text "has an INLINABLE pragma" ])
-  where
-    mod = nameModule name
-
 {- Note [SPECIALISE pragmas for imported Ids]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 An imported Id may or may not have an unfolding.  If not, we obviously
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 25b66c0283c8..c348addb7e2f 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -403,6 +403,12 @@ data GhcHint
                     typecheck/should_fail/T3176
     -}
   | SuggestPatternMatchingSyntax
+    {-| Suggest tips for making a definition visible for the purpose of writing
+        a SPECIALISE pragma for it in a different module.
+
+        Test cases: none
+    -}
+  | SuggestSpecialiseVisibilityHints Name
 
 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index 08c5efdb36cf..f1595d96ac23 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -14,7 +14,7 @@ import GHC.Types.Hint
 
 import GHC.Hs.Expr ()   -- instance Outputable
 import GHC.Types.Id
-import GHC.Types.Name (NameSpace, pprDefinedAt, occNameSpace, pprNameSpace, isValNameSpace)
+import GHC.Types.Name (NameSpace, pprDefinedAt, occNameSpace, pprNameSpace, isValNameSpace, nameModule)
 import GHC.Types.Name.Reader (RdrName,ImpDeclSpec (..), rdrNameOcc, rdrNameSpace)
 import GHC.Types.SrcLoc (SrcSpan(..), srcSpanStartLine)
 import GHC.Unit.Module.Imported (ImportedModsVal(..))
@@ -199,6 +199,11 @@ instance Outputable GhcHint where
       $$ text "The module header is the section at the top of the file, before the" <+> quotes (text "module") <+> text "keyword"
     SuggestPatternMatchingSyntax
       -> text "Use pattern-matching syntax instead"
+    SuggestSpecialiseVisibilityHints name
+      -> text "Make sure" <+> ppr mod <+> text "is compiled with -O and that"
+           <+> quotes (ppr name) <+> text "has an INLINABLE pragma"
+         where
+           mod = nameModule name
 
 perhapsAsPat :: SDoc
 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"
-- 
GitLab