summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAaron Allen <aaron@flipstone.com>2022-05-08 16:18:03 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-06-06 09:50:39 -0400
commitf2e037fd453a13e15cca487e37c21ce3c8756007 (patch)
tree8232276c33bb0589adc8c1659c10f8e0346ecafc
parent9ce9ea5071af5c7a5b6fcef11ac6e19c14480901 (diff)
downloadhaskell-f2e037fd453a13e15cca487e37c21ce3c8756007.tar.gz
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`.
-rw-r--r--compiler/GHC/Tc/Errors/Ppr.hs74
-rw-r--r--compiler/GHC/Tc/Errors/Types.hs108
-rw-r--r--compiler/GHC/Tc/Gen/Match.hs22
-rw-r--r--compiler/GHC/Tc/Gen/Pat.hs47
-rw-r--r--compiler/GHC/Tc/Gen/Sig.hs37
-rw-r--r--compiler/GHC/Types/Hint.hs6
-rw-r--r--compiler/GHC/Types/Hint/Ppr.hs7
7 files changed, 229 insertions, 72 deletions
diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index b8ed303dd7..3dc1ea685b 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 e1679d82d0..ad5f3db81b 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 9646cfeace..e1a0c2401b 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 cd429f0cc5..62deebfe78 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 16a46f4454..66c7c80ced 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 25b66c0283..c348addb7e 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 08c5efdb36..f1595d96ac 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"