Add TcRnSimplifierTooManyIterations to TcRnMessage

5 files changed, 33 insertions, 6 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 9953971c24..fc69df5379 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -62,6 +62,11 @@ instance Diagnostic TcRnMessage where
       -> mkSimpleDecorated $
            vcat [text "Multiple warning declarations for" <+> quotes (ppr rdr_name),
                  text "also at " <+> ppr (getLocA d)]
+    TcRnSimplifierTooManyIterations limit wc
+      -> mkSimpleDecorated $
+           hang (text "solveWanteds: too many iterations"
+                   <+> parens (text "limit =" <+> ppr limit))
+                2 (text "Unsolved:" <+> ppr wc)
 
   diagnosticReason = \case
     TcRnUnknownMessage m
@@ -89,6 +94,8 @@ instance Diagnostic TcRnMessage where
       -> WarningWithFlag Opt_WarnNameShadowing
     TcRnDuplicateWarningDecls{}
       -> ErrorWithoutFlag
+    TcRnSimplifierTooManyIterations{}
+      -> ErrorWithoutFlag
 
   diagnosticHints = \case
     TcRnUnknownMessage m
@@ -116,6 +123,8 @@ instance Diagnostic TcRnMessage where
       -> noHints
     TcRnDuplicateWarningDecls{}
       -> noHints
+    TcRnSimplifierTooManyIterations{}
+      -> [SuggestIncreaseSimplifierIterations]
 
 messageWithInfoDiagnosticMessage :: UnitState
                                  -> ErrInfo
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index f76ac52727..1e8a18a8a0 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -10,6 +10,7 @@ module GHC.Tc.Errors.Types (
   ) where
 
 import GHC.Hs
+import GHC.Tc.Types.Constraint
 import GHC.Types.Error
 import GHC.Types.Name (Name, OccName)
 import GHC.Types.Name.Reader
@@ -19,6 +20,7 @@ import GHC.Utils.Outputable
 import Data.Typeable
 import GHC.Core.Type (Type, Var)
 import GHC.Unit.State (UnitState)
+import GHC.Types.Basic
 
 {-
 Note [Migrating TcM Messages]
@@ -196,6 +198,20 @@ data TcRnMessage where
   -}
   TcRnDuplicateWarningDecls :: !(LocatedN RdrName) -> !RdrName -> TcRnMessage
 
+  {-| TcRnDuplicateWarningDecls is an error that occurs whenever
+      the constraint solver in the simplifier hits the iterations' limit.
+
+      Examples(s):
+        None.
+
+     Test cases:
+        None.
+  -}
+  TcRnSimplifierTooManyIterations :: !IntWithInf
+                                  -- ^ The limit.
+                                  -> WantedConstraints
+                                  -> TcRnMessage
+
 
 -- | Where a shadowed name comes from
 data ShadowedNameProvenance
diff --git a/compiler/GHC/Tc/Solver.hs b/compiler/GHC/Tc/Solver.hs
index 3840d833b4..f645e4d49c 100644
--- a/compiler/GHC/Tc/Solver.hs
+++ b/compiler/GHC/Tc/Solver.hs
@@ -1795,12 +1795,7 @@ maybe_simplify_again n limit unif_happened wc@(WC { wc_simple = simples })
          -- Typically if we blow the limit we are going to report some other error
          -- (an unsolved constraint), and we don't want that error to suppress
          -- the iteration limit warning!
-         addErrTcS $ TcRnUnknownMessage $ mkPlainError noHints $
-           (hang (text "solveWanteds: too many iterations"
-                   <+> parens (text "limit =" <+> ppr limit))
-                2 (vcat [ text "Unsolved:" <+> ppr wc
-                        , text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit"
-                  ]))
+         addErrTcS $ TcRnSimplifierTooManyIterations limit wc
        ; return wc }
 
   | unif_happened
diff --git a/compiler/GHC/Types/Hint.hs b/compiler/GHC/Types/Hint.hs
index 475e0ee6fb..883bfa4af4 100644
--- a/compiler/GHC/Types/Hint.hs
+++ b/compiler/GHC/Types/Hint.hs
@@ -116,6 +116,11 @@ data GhcHint
 
   | SuggestAddPhaseToCompetingRule !RuleName
 
+    {-| Suggests increasing the limit for the number of iterations in the simplifier.
+
+    -}
+  | SuggestIncreaseSimplifierIterations
+
 -- | An 'InstantiationSuggestion' for a '.hsig' file. This is generated
 -- by GHC in case of a 'DriverUnexpectedSignature' and suggests a way
 -- to instantiate a particular signature, where the first argument is
diff --git a/compiler/GHC/Types/Hint/Ppr.hs b/compiler/GHC/Types/Hint/Ppr.hs
index ad8c614c16..e8558b854f 100644
--- a/compiler/GHC/Types/Hint/Ppr.hs
+++ b/compiler/GHC/Types/Hint/Ppr.hs
@@ -61,6 +61,8 @@ instance Outputable GhcHint where
     SuggestAddPhaseToCompetingRule bad_rule
       -> vcat [ text "Add phase [n] or [~n] to the competing rule"
               , whenPprDebug (ppr bad_rule) ]
+    SuggestIncreaseSimplifierIterations
+      -> text "Set limit with -fconstraint-solver-iterations=n; n=0 for no limit"
 
 perhapsAsPat :: SDoc
 perhapsAsPat = text "Perhaps you meant an as-pattern, which must not be surrounded by whitespace"