    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    {-# OPTIONS_GHC -Wno-incomplete-uni-patterns   #-}
    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    module GHC.Tc.Errors(
           reportUnsolved, reportAllUnsolved, warnAllUnsolved,
           warnDefaulting,

           solverDepthErrorTcS
      ) where

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Tc.Types
    import GHC.Tc.Utils.Monad
    import GHC.Tc.Types.Constraint
    import GHC.Core.Predicate
    import GHC.Tc.Utils.TcMType
    import GHC.Tc.Utils.Env( tcInitTidyEnv )
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Utils.Unify ( checkTyVarEq )
    import GHC.Tc.Types.Origin
    import GHC.Rename.Unbound ( unknownNameSuggestions )
    import GHC.Core.Type
    import GHC.Core.Coercion
    import GHC.Core.TyCo.Rep
    import GHC.Core.TyCo.Ppr  ( pprTyVars, pprWithExplicitKindsWhen, pprSourceTyCon, pprWithTYPE )
    import GHC.Core.Unify     ( tcMatchTys, flattenTys )
    import GHC.Unit.Module
    import GHC.Tc.Instance.Family
    import GHC.Tc.Utils.Instantiate
    import GHC.Core.InstEnv
    import GHC.Core.TyCon
    import GHC.Core.Class
    import GHC.Core.DataCon
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Types.EvTerm
    import GHC.Hs.Binds ( PatSynBind(..) )
    import GHC.Types.Name
    import GHC.Types.Name.Reader ( lookupGRE_Name, GlobalRdrEnv, mkRdrUnqual )
    import GHC.Builtin.Names ( typeableClassName )
    import GHC.Types.Id
    import GHC.Types.Var
    import GHC.Types.Var.Set
    import GHC.Types.Var.Env
    import GHC.Types.Name.Set
    import GHC.Data.Bag
    import GHC.Utils.Error  ( pprLocMsgEnvelope )
    import GHC.Types.Basic
    import GHC.Types.Error
    import GHC.Core.ConLike ( ConLike(..))
    import GHC.Utils.Misc
    import GHC.Data.FastString
    import GHC.Utils.Outputable as O
    import GHC.Utils.Panic
    import GHC.Types.SrcLoc
    import GHC.Driver.Session
    import GHC.Driver.Ppr
    import GHC.Data.List.SetOps ( equivClasses )
    import GHC.Data.Maybe
    import qualified GHC.LanguageExtensions as LangExt
    import GHC.Utils.FV ( fvVarList, unionFV )

    import Control.Monad    ( when, unless )
    import Data.Foldable    ( toList )
    import Data.List        ( partition, mapAccumL, sortBy, unfoldr )

    import {-# SOURCE #-} GHC.Tc.Errors.Hole ( findValidHoleFits )

    -- import Data.Semigroup   ( Semigroup )
    import qualified Data.Semigroup as Semigroup

    {-
    ************************************************************************
    *                                                                      *
    \section{Errors and contexts}
    *                                                                      *
    ************************************************************************

    ToDo: for these error messages, should we note the location as coming
    from the insts, or just whatever seems to be around in the monad just
    now?

    Note [Deferring coercion errors to runtime]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    While developing, sometimes it is desirable to allow compilation to succeed even
    if there are type errors in the code. Consider the following case:

      module Main where

      a :: Int
      a = 'a'

      main = print "b"

    Even though `a` is ill-typed, it is not used in the end, so if all that we're
    interested in is `main` it is handy to be able to ignore the problems in `a`.

    Since we treat type equalities as evidence, this is relatively simple. Whenever
    we run into a type mismatch in GHC.Tc.Utils.Unify, we normally just emit an error. But it
    is always safe to defer the mismatch to the main constraint solver. If we do
    that, `a` will get transformed into

      co :: Int ~ Char
      co = ...

      a :: Int
      a = 'a' `cast` co

    The constraint solver would realize that `co` is an insoluble constraint, and
    emit an error with `reportUnsolved`. But we can also replace the right-hand side
    of `co` with `error "Deferred type error: Int ~ Char"`. This allows the program
    to compile, and it will run fine unless we evaluate `a`. This is what
    `deferErrorsToRuntime` does.

    It does this by keeping track of which errors correspond to which coercion
    in GHC.Tc.Errors. GHC.Tc.Errors.reportTidyWanteds does not print the errors
    and does not fail if -fdefer-type-errors is on, so that we can continue
    compilation. The errors are turned into warnings in `reportUnsolved`.
    -}

    -- | Report unsolved goals as errors or warnings. We may also turn some into
    -- deferred run-time errors if `-fdefer-type-errors` is on.
    reportUnsolved :: WantedConstraints -> TcM (Bag EvBind)
    reportUnsolved :: WantedConstraints -> TcM (Bag EvBind)
    reportUnsolved WantedConstraints
    wanted
      = do { EvBindsVar
    binds_var <- TcM EvBindsVar
    newTcEvBinds
           ; Bool
    defer_errors <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_DeferTypeErrors
           ; Bool
    warn_errors <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnDeferredTypeErrors -- implement #10283
           ; let type_errors :: TypeErrorChoice
    type_errors | Bool -> Bool
    not Bool
    defer_errors = TypeErrorChoice
    TypeError
                             | Bool
    warn_errors      = WarnReason -> TypeErrorChoice
    TypeWarn (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnDeferredTypeErrors)
                             | Bool
    otherwise        = TypeErrorChoice
    TypeDefer

           ; Bool
    defer_holes <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_DeferTypedHoles
           ; Bool
    warn_holes  <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnTypedHoles
           ; let expr_holes :: HoleChoice
    expr_holes | Bool -> Bool
    not Bool
    defer_holes = HoleChoice
    HoleError
                            | Bool
    warn_holes      = HoleChoice
    HoleWarn
                            | Bool
    otherwise       = HoleChoice
    HoleDefer

           ; Bool
    partial_sigs      <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.PartialTypeSignatures
           ; Bool
    warn_partial_sigs <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnPartialTypeSignatures
           ; let type_holes :: HoleChoice
    type_holes | Bool -> Bool
    not Bool
    partial_sigs  = HoleChoice
    HoleError
                            | Bool
    warn_partial_sigs = HoleChoice
    HoleWarn
                            | Bool
    otherwise         = HoleChoice
    HoleDefer

           ; Bool
    defer_out_of_scope <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_DeferOutOfScopeVariables
           ; Bool
    warn_out_of_scope <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnDeferredOutOfScopeVariables
           ; let out_of_scope_holes :: HoleChoice
    out_of_scope_holes | Bool -> Bool
    not Bool
    defer_out_of_scope = HoleChoice
    HoleError
                                    | Bool
    warn_out_of_scope      = HoleChoice
    HoleWarn
                                    | Bool
    otherwise              = HoleChoice
    HoleDefer

           ; TypeErrorChoice
    -> HoleChoice
    -> HoleChoice
    -> HoleChoice
    -> EvBindsVar
    -> WantedConstraints
    -> TcM ()
    report_unsolved TypeErrorChoice
    type_errors HoleChoice
    expr_holes
                             HoleChoice
    type_holes HoleChoice
    out_of_scope_holes
                             EvBindsVar
    binds_var WantedConstraints
    wanted

           ; EvBindMap
    ev_binds <- EvBindsVar -> TcM EvBindMap
    getTcEvBindsMap EvBindsVar
    binds_var
           ; Bag EvBind -> TcM (Bag EvBind)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvBindMap -> Bag EvBind
    evBindMapBinds EvBindMap
    ev_binds)}

    -- | Report *all* unsolved goals as errors, even if -fdefer-type-errors is on
    -- However, do not make any evidence bindings, because we don't
    -- have any convenient place to put them.
    -- NB: Type-level holes are OK, because there are no bindings.
    -- See Note [Deferring coercion errors to runtime]
    -- Used by solveEqualities for kind equalities
    --      (see Note [Fail fast on kind errors] in "GHC.Tc.Solver")
    reportAllUnsolved :: WantedConstraints -> TcM ()
    reportAllUnsolved :: WantedConstraints -> TcM ()
    reportAllUnsolved WantedConstraints
    wanted
      = do { EvBindsVar
    ev_binds <- TcM EvBindsVar
    newNoTcEvBinds

           ; Bool
    partial_sigs      <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    LangExt.PartialTypeSignatures
           ; Bool
    warn_partial_sigs <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnPartialTypeSignatures
           ; let type_holes :: HoleChoice
    type_holes | Bool -> Bool
    not Bool
    partial_sigs  = HoleChoice
    HoleError
                            | Bool
    warn_partial_sigs = HoleChoice
    HoleWarn
                            | Bool
    otherwise         = HoleChoice
    HoleDefer

           ; TypeErrorChoice
    -> HoleChoice
    -> HoleChoice
    -> HoleChoice
    -> EvBindsVar
    -> WantedConstraints
    -> TcM ()
    report_unsolved TypeErrorChoice
    TypeError HoleChoice
    HoleError HoleChoice
    type_holes HoleChoice
    HoleError
                             EvBindsVar
    ev_binds WantedConstraints
    wanted }

    -- | Report all unsolved goals as warnings (but without deferring any errors to
    -- run-time). See Note [Safe Haskell Overlapping Instances Implementation] in
    -- "GHC.Tc.Solver"
    warnAllUnsolved :: WantedConstraints -> TcM ()
    warnAllUnsolved :: WantedConstraints -> TcM ()
    warnAllUnsolved WantedConstraints
    wanted
      = do { EvBindsVar
    ev_binds <- TcM EvBindsVar
    newTcEvBinds
           ; TypeErrorChoice
    -> HoleChoice
    -> HoleChoice
    -> HoleChoice
    -> EvBindsVar
    -> WantedConstraints
    -> TcM ()
    report_unsolved (WarnReason -> TypeErrorChoice
    TypeWarn WarnReason
    NoReason) HoleChoice
    HoleWarn HoleChoice
    HoleWarn HoleChoice
    HoleWarn
                             EvBindsVar
    ev_binds WantedConstraints
    wanted }

    -- | Report unsolved goals as errors or warnings.
    report_unsolved :: TypeErrorChoice   -- Deferred type errors
                    -> HoleChoice        -- Expression holes
                    -> HoleChoice        -- Type holes
                    -> HoleChoice        -- Out of scope holes
                    -> EvBindsVar        -- cec_binds
                    -> WantedConstraints -> TcM ()
    report_unsolved :: TypeErrorChoice
    -> HoleChoice
    -> HoleChoice
    -> HoleChoice
    -> EvBindsVar
    -> WantedConstraints
    -> TcM ()
    report_unsolved TypeErrorChoice
    type_errors HoleChoice
    expr_holes
        HoleChoice
    type_holes HoleChoice
    out_of_scope_holes EvBindsVar
    binds_var WantedConstraints
    wanted
      | WantedConstraints -> Bool
    isEmptyWC WantedConstraints
    wanted
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise
      = do { String -> SDoc -> TcM ()
    traceTc String
    "reportUnsolved {" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "type errors:" SDoc -> SDoc -> SDoc
    <+> TypeErrorChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TypeErrorChoice
    type_errors
                  , String -> SDoc
    text String
    "expr holes:" SDoc -> SDoc -> SDoc
    <+> HoleChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HoleChoice
    expr_holes
                  , String -> SDoc
    text String
    "type holes:" SDoc -> SDoc -> SDoc
    <+> HoleChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HoleChoice
    type_holes
                  , String -> SDoc
    text String
    "scope holes:" SDoc -> SDoc -> SDoc
    <+> HoleChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HoleChoice
    out_of_scope_holes ]
           ; String -> SDoc -> TcM ()
    traceTc String
    "reportUnsolved (before zonking and tidying)" (WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    wanted)

           ; WantedConstraints
    wanted <- WantedConstraints -> TcM WantedConstraints
    zonkWC WantedConstraints
    wanted   -- Zonk to reveal all information
           ; let tidy_env :: TidyEnv
    tidy_env = TidyEnv -> [TcId] -> TidyEnv
    tidyFreeTyCoVars TidyEnv
    emptyTidyEnv [TcId]
    free_tvs
                 free_tvs :: [TcId]
    free_tvs = (TcId -> Bool) -> [TcId] -> [TcId]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut TcId -> Bool
    isCoVar ([TcId] -> [TcId]) -> [TcId] -> [TcId]
    forall a b. (a -> b) -> a -> b
    $
                            WantedConstraints -> [TcId]
    tyCoVarsOfWCList WantedConstraints
    wanted
                            -- tyCoVarsOfWC returns free coercion *holes*, even though
                            -- they are "bound" by other wanted constraints. They in
                            -- turn may mention variables bound further in, which makes
                            -- no sense. Really we should not return those holes at all;
                            -- for now we just filter them out.

           ; String -> SDoc -> TcM ()
    traceTc String
    "reportUnsolved (after zonking):" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Free tyvars:" SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    pprTyVars [TcId]
    free_tvs
                  , String -> SDoc
    text String
    "Tidy env:" SDoc -> SDoc -> SDoc
    <+> TidyEnv -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TidyEnv
    tidy_env
                  , String -> SDoc
    text String
    "Wanted:" SDoc -> SDoc -> SDoc
    <+> WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    wanted ]

           ; Bool
    warn_redundant <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnRedundantConstraints
           ; Bool
    exp_syns <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_PrintExpandedSynonyms
           ; let err_ctxt :: ReportErrCtxt
    err_ctxt = CEC { cec_encl :: [Implication]
    cec_encl  = []
                                , cec_tidy :: TidyEnv
    cec_tidy  = TidyEnv
    tidy_env
                                , cec_defer_type_errors :: TypeErrorChoice
    cec_defer_type_errors = TypeErrorChoice
    type_errors
                                , cec_expr_holes :: HoleChoice
    cec_expr_holes = HoleChoice
    expr_holes
                                , cec_type_holes :: HoleChoice
    cec_type_holes = HoleChoice
    type_holes
                                , cec_out_of_scope_holes :: HoleChoice
    cec_out_of_scope_holes = HoleChoice
    out_of_scope_holes
                                , cec_suppress :: Bool
    cec_suppress = WantedConstraints -> Bool
    insolubleWC WantedConstraints
    wanted
                                     -- See Note [Suppressing error messages]
                                     -- Suppress low-priority errors if there
                                     -- are insoluble errors anywhere;
                                     -- See #15539 and c.f. setting ic_status
                                     -- in GHC.Tc.Solver.setImplicationStatus
                                , cec_warn_redundant :: Bool
    cec_warn_redundant = Bool
    warn_redundant
                                , cec_expand_syns :: Bool
    cec_expand_syns = Bool
    exp_syns
                                , cec_binds :: EvBindsVar
    cec_binds    = EvBindsVar
    binds_var }

           ; TcLevel
    tc_lvl <- TcM TcLevel
    getTcLevel
           ; ReportErrCtxt -> TcLevel -> WantedConstraints -> TcM ()
    reportWanteds ReportErrCtxt
    err_ctxt TcLevel
    tc_lvl WantedConstraints
    wanted
           ; String -> SDoc -> TcM ()
    traceTc String
    "reportUnsolved }" SDoc
    empty }

    --------------------------------------------
    --      Internal functions
    --------------------------------------------

    -- | An error Report collects messages categorised by their importance.
    -- See Note [Error report] for details.
    data Report
      = Report { Report -> [SDoc]
    report_important :: [SDoc]
               , Report -> [SDoc]
    report_relevant_bindings :: [SDoc]
               , Report -> [SDoc]
    report_valid_hole_fits :: [SDoc]
               }

    instance Outputable Report where   -- Debugging only
      ppr :: Report -> SDoc
    ppr (Report { report_important :: Report -> [SDoc]
    report_important = [SDoc]
    imp
                  , report_relevant_bindings :: Report -> [SDoc]
    report_relevant_bindings = [SDoc]
    rel
                  , report_valid_hole_fits :: Report -> [SDoc]
    report_valid_hole_fits = [SDoc]
    val })
        = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "important:" SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat [SDoc]
    imp
               , String -> SDoc
    text String
    "relevant:"  SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat [SDoc]
    rel
               , String -> SDoc
    text String
    "valid:"  SDoc -> SDoc -> SDoc
    <+> [SDoc] -> SDoc
    vcat [SDoc]
    val ]

    {- Note [Error report]
    The idea is that error msgs are divided into three parts: the main msg, the
    context block (\"In the second argument of ...\"), and the relevant bindings
    block, which are displayed in that order, with a mark to divide them.  The
    idea is that the main msg ('report_important') varies depending on the error
    in question, but context and relevant bindings are always the same, which
    should simplify visual parsing.

    The context is added when the Report is passed off to 'mkErrorReport'.
    Unfortunately, unlike the context, the relevant bindings are added in
    multiple places so they have to be in the Report.
    -}

    instance Semigroup Report where
        Report [SDoc]
    a1 [SDoc]
    b1 [SDoc]
    c1 <> :: Report -> Report -> Report
    <> Report [SDoc]
    a2 [SDoc]
    b2 [SDoc]
    c2 = [SDoc] -> [SDoc] -> [SDoc] -> Report
    Report ([SDoc]
    a1 [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    a2) ([SDoc]
    b1 [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    b2) ([SDoc]
    c1 [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    c2)

    instance Monoid Report where
        mempty :: Report
    mempty = [SDoc] -> [SDoc] -> [SDoc] -> Report
    Report [] [] []
        mappend :: Report -> Report -> Report
    mappend = Report -> Report -> Report
    forall a. Semigroup a => a -> a -> a
    (Semigroup.<>)

    -- | Put a doc into the important msgs block.
    important :: SDoc -> Report
    important :: SDoc -> Report
    important SDoc
    doc = Report
    forall a. Monoid a => a
    mempty { report_important :: [SDoc]
    report_important = [SDoc
    doc] }

    -- | Put a doc into the relevant bindings block.
    mk_relevant_bindings :: SDoc -> Report
    mk_relevant_bindings :: SDoc -> Report
    mk_relevant_bindings SDoc
    doc = Report
    forall a. Monoid a => a
    mempty { report_relevant_bindings :: [SDoc]
    report_relevant_bindings = [SDoc
    doc] }

    -- | Put a doc into the valid hole fits block.
    valid_hole_fits :: SDoc -> Report
    valid_hole_fits :: SDoc -> Report
    valid_hole_fits SDoc
    docs = Report
    forall a. Monoid a => a
    mempty { report_valid_hole_fits :: [SDoc]
    report_valid_hole_fits = [SDoc
    docs] }

    data TypeErrorChoice   -- What to do for type errors found by the type checker
      = TypeError     -- A type error aborts compilation with an error message
      | TypeWarn WarnReason
                      -- A type error is deferred to runtime, plus a compile-time warning
                      -- The WarnReason should usually be (Reason Opt_WarnDeferredTypeErrors)
                      -- but it isn't for the Safe Haskell Overlapping Instances warnings
                      -- see warnAllUnsolved
      | TypeDefer     -- A type error is deferred to runtime; no error or warning at compile time

    data HoleChoice
      = HoleError     -- A hole is a compile-time error
      | HoleWarn      -- Defer to runtime, emit a compile-time warning
      | HoleDefer     -- Defer to runtime, no warning

    instance Outputable HoleChoice where
      ppr :: HoleChoice -> SDoc
    ppr HoleChoice
    HoleError = String -> SDoc
    text String
    "HoleError"
      ppr HoleChoice
    HoleWarn  = String -> SDoc
    text String
    "HoleWarn"
      ppr HoleChoice
    HoleDefer = String -> SDoc
    text String
    "HoleDefer"

    instance Outputable TypeErrorChoice  where
      ppr :: TypeErrorChoice -> SDoc
    ppr TypeErrorChoice
    TypeError         = String -> SDoc
    text String
    "TypeError"
      ppr (TypeWarn WarnReason
    reason) = String -> SDoc
    text String
    "TypeWarn" SDoc -> SDoc -> SDoc
    <+> WarnReason -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WarnReason
    reason
      ppr TypeErrorChoice
    TypeDefer         = String -> SDoc
    text String
    "TypeDefer"

    data ReportErrCtxt
        = CEC { ReportErrCtxt -> [Implication]
    cec_encl :: [Implication]  -- Enclosing implications
                                           --   (innermost first)
                                           -- ic_skols and givens are tidied, rest are not
              , ReportErrCtxt -> TidyEnv
    cec_tidy  :: TidyEnv

              , ReportErrCtxt -> EvBindsVar
    cec_binds :: EvBindsVar    -- Make some errors (depending on cec_defer)
                                           -- into warnings, and emit evidence bindings
                                           -- into 'cec_binds' for unsolved constraints

              , ReportErrCtxt -> TypeErrorChoice
    cec_defer_type_errors :: TypeErrorChoice -- Defer type errors until runtime

              -- cec_expr_holes is a union of:
              --   cec_type_holes - a set of typed holes: '_', '_a', '_foo'
              --   cec_out_of_scope_holes - a set of variables which are
              --                            out of scope: 'x', 'y', 'bar'
              , ReportErrCtxt -> HoleChoice
    cec_expr_holes :: HoleChoice           -- Holes in expressions
              , ReportErrCtxt -> HoleChoice
    cec_type_holes :: HoleChoice           -- Holes in types
              , ReportErrCtxt -> HoleChoice
    cec_out_of_scope_holes :: HoleChoice   -- Out of scope holes

              , ReportErrCtxt -> Bool
    cec_warn_redundant :: Bool    -- True <=> -Wredundant-constraints
              , ReportErrCtxt -> Bool
    cec_expand_syns    :: Bool    -- True <=> -fprint-expanded-synonyms

              , ReportErrCtxt -> Bool
    cec_suppress :: Bool    -- True <=> More important errors have occurred,
                                        --          so create bindings if need be, but
                                        --          don't issue any more errors/warnings
                                        -- See Note [Suppressing error messages]
          }

    instance Outputable ReportErrCtxt where
      ppr :: ReportErrCtxt -> SDoc
    ppr (CEC { cec_binds :: ReportErrCtxt -> EvBindsVar
    cec_binds              = EvBindsVar
    bvar
               , cec_defer_type_errors :: ReportErrCtxt -> TypeErrorChoice
    cec_defer_type_errors  = TypeErrorChoice
    dte
               , cec_expr_holes :: ReportErrCtxt -> HoleChoice
    cec_expr_holes         = HoleChoice
    eh
               , cec_type_holes :: ReportErrCtxt -> HoleChoice
    cec_type_holes         = HoleChoice
    th
               , cec_out_of_scope_holes :: ReportErrCtxt -> HoleChoice
    cec_out_of_scope_holes = HoleChoice
    osh
               , cec_warn_redundant :: ReportErrCtxt -> Bool
    cec_warn_redundant     = Bool
    wr
               , cec_expand_syns :: ReportErrCtxt -> Bool
    cec_expand_syns        = Bool
    es
               , cec_suppress :: ReportErrCtxt -> Bool
    cec_suppress           = Bool
    sup })
        = String -> SDoc
    text String
    "CEC" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    braces ([SDoc] -> SDoc
    vcat
             [ String -> SDoc
    text String
    "cec_binds"              SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> EvBindsVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindsVar
    bvar
             , String -> SDoc
    text String
    "cec_defer_type_errors"  SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> TypeErrorChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TypeErrorChoice
    dte
             , String -> SDoc
    text String
    "cec_expr_holes"         SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> HoleChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HoleChoice
    eh
             , String -> SDoc
    text String
    "cec_type_holes"         SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> HoleChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HoleChoice
    th
             , String -> SDoc
    text String
    "cec_out_of_scope_holes" SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> HoleChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HoleChoice
    osh
             , String -> SDoc
    text String
    "cec_warn_redundant"     SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    wr
             , String -> SDoc
    text String
    "cec_expand_syns"        SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    es
             , String -> SDoc
    text String
    "cec_suppress"           SDoc -> SDoc -> SDoc
    <+> SDoc
    equals SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    sup ])

    -- | Returns True <=> the ReportErrCtxt indicates that something is deferred
    deferringAnyBindings :: ReportErrCtxt -> Bool
      -- Don't check cec_type_holes, as these don't cause bindings to be deferred
    deferringAnyBindings :: ReportErrCtxt -> Bool
    deferringAnyBindings (CEC { cec_defer_type_errors :: ReportErrCtxt -> TypeErrorChoice
    cec_defer_type_errors  = TypeErrorChoice
    TypeError
                              , cec_expr_holes :: ReportErrCtxt -> HoleChoice
    cec_expr_holes         = HoleChoice
    HoleError
                              , cec_out_of_scope_holes :: ReportErrCtxt -> HoleChoice
    cec_out_of_scope_holes = HoleChoice
    HoleError }) = Bool
    False
    deferringAnyBindings ReportErrCtxt
    _                                            = Bool
    True

    maybeSwitchOffDefer :: EvBindsVar -> ReportErrCtxt -> ReportErrCtxt
    -- Switch off defer-type-errors inside CoEvBindsVar
    -- See Note [Failing equalities with no evidence bindings]
    maybeSwitchOffDefer :: EvBindsVar -> ReportErrCtxt -> ReportErrCtxt
    maybeSwitchOffDefer EvBindsVar
    evb ReportErrCtxt
    ctxt
     | CoEvBindsVar{} <- EvBindsVar
    evb
     = ReportErrCtxt
    ctxt { cec_defer_type_errors :: TypeErrorChoice
    cec_defer_type_errors  = TypeErrorChoice
    TypeError
            , cec_expr_holes :: HoleChoice
    cec_expr_holes         = HoleChoice
    HoleError
            , cec_out_of_scope_holes :: HoleChoice
    cec_out_of_scope_holes = HoleChoice
    HoleError }
     | Bool
    otherwise
     = ReportErrCtxt
    ctxt

    {- Note [Failing equalities with no evidence bindings]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we go inside an implication that has no term evidence
    (e.g. unifying under a forall), we can't defer type errors.  You could
    imagine using the /enclosing/ bindings (in cec_binds), but that may
    not have enough stuff in scope for the bindings to be well typed.  So
    we just switch off deferred type errors altogether.  See #14605.

    This is done by maybeSwitchOffDefer.  It's also useful in one other
    place: see Note [Wrapping failing kind equalities] in GHC.Tc.Solver.

    Note [Suppressing error messages]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The cec_suppress flag says "don't report any errors".  Instead, just create
    evidence bindings (as usual).  It's used when more important errors have occurred.

    Specifically (see reportWanteds)
      * If there are insoluble Givens, then we are in unreachable code and all bets
        are off.  So don't report any further errors.
      * If there are any insolubles (eg Int~Bool), here or in a nested implication,
        then suppress errors from the simple constraints here.  Sometimes the
        simple-constraint errors are a knock-on effect of the insolubles.

    This suppression behaviour is controlled by the Bool flag in
    ReportErrorSpec, as used in reportWanteds.

    But we need to take care: flags can turn errors into warnings, and we
    don't want those warnings to suppress subsequent errors (including
    suppressing the essential addTcEvBind for them: #15152). So in
    tryReporter we use askNoErrs to see if any error messages were
    /actually/ produced; if not, we don't switch on suppression.

    A consequence is that warnings never suppress warnings, so turning an
    error into a warning may allow subsequent warnings to appear that were
    previously suppressed.   (e.g. partial-sigs/should_fail/T14584)
    -}

    reportImplic :: ReportErrCtxt -> Implication -> TcM ()
    reportImplic :: ReportErrCtxt -> Implication -> TcM ()
    reportImplic ReportErrCtxt
    ctxt implic :: Implication
    implic@(Implic { ic_skols :: Implication -> [TcId]
    ic_skols = [TcId]
    tvs
                                     , ic_given :: Implication -> [TcId]
    ic_given = [TcId]
    given
                                     , ic_wanted :: Implication -> WantedConstraints
    ic_wanted = WantedConstraints
    wanted, ic_binds :: Implication -> EvBindsVar
    ic_binds = EvBindsVar
    evb
                                     , ic_status :: Implication -> ImplicStatus
    ic_status = ImplicStatus
    status, ic_info :: Implication -> SkolemInfo
    ic_info = SkolemInfo
    info
                                     , ic_tclvl :: Implication -> TcLevel
    ic_tclvl = TcLevel
    tc_lvl })
      | SkolemInfo
    BracketSkol <- SkolemInfo
    info
      , Bool -> Bool
    not Bool
    insoluble
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()        -- For Template Haskell brackets report only
                         -- definite errors. The whole thing will be re-checked
                         -- later when we plug it in, and meanwhile there may
                         -- certainly be un-satisfied constraints

      | Bool
    otherwise
      = do { String -> SDoc -> TcM ()
    traceTc String
    "reportImplic" (Implication -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Implication
    implic')
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    bad_telescope (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcId] -> TcM ()
    reportBadTelescope ReportErrCtxt
    ctxt TcLclEnv
    tcl_env SkolemInfo
    info [TcId]
    tvs
                   -- Do /not/ use the tidied tvs because then are in the
                   -- wrong order, so tidying will rename things wrongly
           ; ReportErrCtxt -> TcLevel -> WantedConstraints -> TcM ()
    reportWanteds ReportErrCtxt
    ctxt' TcLevel
    tc_lvl WantedConstraints
    wanted
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (ReportErrCtxt -> Bool
    cec_warn_redundant ReportErrCtxt
    ctxt) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcId] -> TcM ()
    warnRedundantConstraints ReportErrCtxt
    ctxt' TcLclEnv
    tcl_env SkolemInfo
    info' [TcId]
    dead_givens }
      where
        tcl_env :: TcLclEnv
    tcl_env      = Implication -> TcLclEnv
    ic_env Implication
    implic
        insoluble :: Bool
    insoluble    = ImplicStatus -> Bool
    isInsolubleStatus ImplicStatus
    status
        (TidyEnv
    env1, [TcId]
    tvs') = (TidyEnv -> TcId -> (TidyEnv, TcId))
    -> TidyEnv -> [TcId] -> (TidyEnv, [TcId])
    forall (t :: * -> *) s a b.
    Traversable t =>
    (s -> a -> (s, b)) -> s -> t a -> (s, t b)
    mapAccumL TidyEnv -> TcId -> (TidyEnv, TcId)
    tidyVarBndr (ReportErrCtxt -> TidyEnv
    cec_tidy ReportErrCtxt
    ctxt) ([TcId] -> (TidyEnv, [TcId])) -> [TcId] -> (TidyEnv, [TcId])
    forall a b. (a -> b) -> a -> b
    $
                       [TcId] -> [TcId]
    scopedSort [TcId]
    tvs
            -- scopedSort: the ic_skols may not be in dependency order
            -- (see Note [Skolems in an implication] in GHC.Tc.Types.Constraint)
            -- but tidying goes wrong on out-of-order constraints;
            -- so we sort them here before tidying
        info' :: SkolemInfo
    info'   = TidyEnv -> SkolemInfo -> SkolemInfo
    tidySkolemInfo TidyEnv
    env1 SkolemInfo
    info
        implic' :: Implication
    implic' = Implication
    implic { ic_skols :: [TcId]
    ic_skols = [TcId]
    tvs'
                         , ic_given :: [TcId]
    ic_given = (TcId -> TcId) -> [TcId] -> [TcId]
    forall a b. (a -> b) -> [a] -> [b]
    map (TidyEnv -> TcId -> TcId
    tidyEvVar TidyEnv
    env1) [TcId]
    given
                         , ic_info :: SkolemInfo
    ic_info  = SkolemInfo
    info' }

        ctxt1 :: ReportErrCtxt
    ctxt1 = EvBindsVar -> ReportErrCtxt -> ReportErrCtxt
    maybeSwitchOffDefer EvBindsVar
    evb ReportErrCtxt
    ctxt
        ctxt' :: ReportErrCtxt
    ctxt' = ReportErrCtxt
    ctxt1 { cec_tidy :: TidyEnv
    cec_tidy     = TidyEnv
    env1
                      , cec_encl :: [Implication]
    cec_encl     = Implication
    implic' Implication -> [Implication] -> [Implication]
    forall a. a -> [a] -> [a]
    : ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt

                      , cec_suppress :: Bool
    cec_suppress = Bool
    insoluble Bool -> Bool -> Bool
    || ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt
                            -- Suppress inessential errors if there
                            -- are insolubles anywhere in the
                            -- tree rooted here, or we've come across
                            -- a suppress-worthy constraint higher up (#11541)

                      , cec_binds :: EvBindsVar
    cec_binds    = EvBindsVar
    evb }

        dead_givens :: [TcId]
    dead_givens = case ImplicStatus
    status of
                        IC_Solved { ics_dead :: ImplicStatus -> [TcId]
    ics_dead = [TcId]
    dead } -> [TcId]
    dead
                        ImplicStatus
    _                             -> []

        bad_telescope :: Bool
    bad_telescope = case ImplicStatus
    status of
                  ImplicStatus
    IC_BadTelescope -> Bool
    True
                  ImplicStatus
    _               -> Bool
    False

    warnRedundantConstraints :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [EvVar] -> TcM ()
    -- See Note [Tracking redundant constraints] in GHC.Tc.Solver
    warnRedundantConstraints :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcId] -> TcM ()
    warnRedundantConstraints ReportErrCtxt
    ctxt TcLclEnv
    env SkolemInfo
    info [TcId]
    ev_vars
     | [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    redundant_evs
     = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

     | SigSkol {} <- SkolemInfo
    info
     = TcLclEnv -> TcM () -> TcM ()
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv TcLclEnv
    env (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $  -- We want to add "In the type signature for f"
                        -- to the error context, which is a bit tiresome
       SDoc -> TcM () -> TcM ()
    forall a. SDoc -> TcM a -> TcM a
    addErrCtxt (String -> SDoc
    text String
    "In" SDoc -> SDoc -> SDoc
    <+> SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    info) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
       do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
          ; MsgEnvelope DecoratedSDoc
    msg <- ReportErrCtxt
    -> TcLclEnv -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorReport ReportErrCtxt
    ctxt TcLclEnv
    env (SDoc -> Report
    important SDoc
    doc)
          ; WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnRedundantConstraints) MsgEnvelope DecoratedSDoc
    msg }

     | Bool
    otherwise  -- But for InstSkol there already *is* a surrounding
                  -- "In the instance declaration for Eq [a]" context
                  -- and we don't want to say it twice. Seems a bit ad-hoc
     = do { MsgEnvelope DecoratedSDoc
    msg <- ReportErrCtxt
    -> TcLclEnv -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorReport ReportErrCtxt
    ctxt TcLclEnv
    env (SDoc -> Report
    important SDoc
    doc)
          ; WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnRedundantConstraints) MsgEnvelope DecoratedSDoc
    msg }
     where
       doc :: SDoc
    doc = String -> SDoc
    text String
    "Redundant constraint" SDoc -> SDoc -> SDoc
    <> [TcId] -> SDoc
    forall a. [a] -> SDoc
    plural [TcId]
    redundant_evs SDoc -> SDoc -> SDoc
    <> SDoc
    colon
             SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    pprEvVarTheta [TcId]
    redundant_evs

       redundant_evs :: [TcId]
    redundant_evs =
           (TcId -> Bool) -> [TcId] -> [TcId]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut TcId -> Bool
    is_type_error ([TcId] -> [TcId]) -> [TcId] -> [TcId]
    forall a b. (a -> b) -> a -> b
    $
           case SkolemInfo
    info of -- See Note [Redundant constraints in instance decls]
             SkolemInfo
    InstSkol -> (TcId -> Bool) -> [TcId] -> [TcId]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (TcType -> Bool
    improving (TcType -> Bool) -> (TcId -> TcType) -> TcId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcId -> TcType
    idType) [TcId]
    ev_vars
             SkolemInfo
    _        -> [TcId]
    ev_vars

       -- See #15232
       is_type_error :: TcId -> Bool
    is_type_error = Maybe TcType -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe TcType -> Bool) -> (TcId -> Maybe TcType) -> TcId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcType -> Maybe TcType
    userTypeError_maybe (TcType -> Maybe TcType)
    -> (TcId -> TcType) -> TcId -> Maybe TcType
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcId -> TcType
    idType

       improving :: TcType -> Bool
    improving TcType
    pred -- (transSuperClasses p) does not include p
         = (TcType -> Bool) -> [TcType] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcType -> Bool
    isImprovementPred (TcType
    pred TcType -> [TcType] -> [TcType]
    forall a. a -> [a] -> [a]
    : TcType -> [TcType]
    transSuperClasses TcType
    pred)

    reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcTyVar] -> TcM ()
    reportBadTelescope :: ReportErrCtxt -> TcLclEnv -> SkolemInfo -> [TcId] -> TcM ()
    reportBadTelescope ReportErrCtxt
    ctxt TcLclEnv
    env (ForAllSkol SDoc
    telescope) [TcId]
    skols
      = do { MsgEnvelope DecoratedSDoc
    msg <- ReportErrCtxt
    -> TcLclEnv -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorReport ReportErrCtxt
    ctxt TcLclEnv
    env (SDoc -> Report
    important SDoc
    doc)
           ; MsgEnvelope DecoratedSDoc -> TcM ()
    reportError MsgEnvelope DecoratedSDoc
    msg }
      where
        doc :: SDoc
    doc = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "These kind and type variables:" SDoc -> SDoc -> SDoc
    <+> SDoc
    telescope SDoc -> SDoc -> SDoc
    $$
                    String -> SDoc
    text String
    "are out of dependency order. Perhaps try this ordering:")
                 Int
    2 ([TcId] -> SDoc
    pprTyVars [TcId]
    sorted_tvs)

        sorted_tvs :: [TcId]
    sorted_tvs = [TcId] -> [TcId]
    scopedSort [TcId]
    skols

    reportBadTelescope ReportErrCtxt
    _ TcLclEnv
    _ SkolemInfo
    skol_info [TcId]
    skols
      = String -> SDoc -> TcM ()
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "reportBadTelescope" (SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info SDoc -> SDoc -> SDoc
    $$ [TcId] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TcId]
    skols)

    {- Note [Redundant constraints in instance decls]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    For instance declarations, we don't report unused givens if
    they can give rise to improvement.  Example (#10100):
        class Add a b ab | a b -> ab, a ab -> b
        instance Add Zero b b
        instance Add a b ab => Add (Succ a) b (Succ ab)
    The context (Add a b ab) for the instance is clearly unused in terms
    of evidence, since the dictionary has no fields.  But it is still
    needed!  With the context, a wanted constraint
       Add (Succ Zero) beta (Succ Zero)
    we will reduce to (Add Zero beta Zero), and thence we get beta := Zero.
    But without the context we won't find beta := Zero.

    This only matters in instance declarations..
    -}

    reportWanteds :: ReportErrCtxt -> TcLevel -> WantedConstraints -> TcM ()
    reportWanteds :: ReportErrCtxt -> TcLevel -> WantedConstraints -> TcM ()
    reportWanteds ReportErrCtxt
    ctxt TcLevel
    tc_lvl (WC { wc_simple :: WantedConstraints -> Cts
    wc_simple = Cts
    simples, wc_impl :: WantedConstraints -> Bag Implication
    wc_impl = Bag Implication
    implics
                                  , wc_holes :: WantedConstraints -> Bag Hole
    wc_holes = Bag Hole
    holes })
      = do { String -> SDoc -> TcM ()
    traceTc String
    "reportWanteds" ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Simples =" SDoc -> SDoc -> SDoc
    <+> Cts -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Cts
    simples
                                           , String -> SDoc
    text String
    "Suppress =" SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt)
                                           , String -> SDoc
    text String
    "tidy_cts =" SDoc -> SDoc -> SDoc
    <+> [Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    tidy_cts
                                           , String -> SDoc
    text String
    "tidy_holes = " SDoc -> SDoc -> SDoc
    <+> [Hole] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Hole]
    tidy_holes ])

             -- First, deal with any out-of-scope errors:
           ; let ([Hole]
    out_of_scope, [Hole]
    other_holes) = (Hole -> Bool) -> [Hole] -> ([Hole], [Hole])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition Hole -> Bool
    isOutOfScopeHole [Hole]
    tidy_holes
                   -- don't suppress out-of-scope errors
                 ctxt_for_scope_errs :: ReportErrCtxt
    ctxt_for_scope_errs = ReportErrCtxt
    ctxt { cec_suppress :: Bool
    cec_suppress = Bool
    False }
           ; (()
    _, Bool
    no_out_of_scope) <- TcM () -> TcRn ((), Bool)
    forall a. TcRn a -> TcRn (a, Bool)
    askNoErrs (TcM () -> TcRn ((), Bool)) -> TcM () -> TcRn ((), Bool)
    forall a b. (a -> b) -> a -> b
    $
                                     [Ct] -> ReportErrCtxt -> [Hole] -> TcM ()
    reportHoles [Ct]
    tidy_cts ReportErrCtxt
    ctxt_for_scope_errs [Hole]
    out_of_scope

             -- Next, deal with things that are utterly wrong
             -- Like Int ~ Bool (incl nullary TyCons)
             -- or  Int ~ t a   (AppTy on one side)
             -- These /ones/ are not suppressed by the incoming context
             -- (but will be by out-of-scope errors)
           ; let ctxt_for_insols :: ReportErrCtxt
    ctxt_for_insols = ReportErrCtxt
    ctxt { cec_suppress :: Bool
    cec_suppress = Bool -> Bool
    not Bool
    no_out_of_scope }
           ; [Ct] -> ReportErrCtxt -> [Hole] -> TcM ()
    reportHoles [Ct]
    tidy_cts ReportErrCtxt
    ctxt_for_insols [Hole]
    other_holes
              -- holes never suppress

           ; (ReportErrCtxt
    ctxt1, [Ct]
    cts1) <- ReportErrCtxt
    -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    tryReporters ReportErrCtxt
    ctxt_for_insols [ReporterSpec]
    report1 [Ct]
    tidy_cts

             -- Now all the other constraints.  We suppress errors here if
             -- any of the first batch failed, or if the enclosing context
             -- says to suppress
           ; let ctxt2 :: ReportErrCtxt
    ctxt2 = ReportErrCtxt
    ctxt { cec_suppress :: Bool
    cec_suppress = ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt Bool -> Bool -> Bool
    || ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt1 }
           ; (ReportErrCtxt
    _, [Ct]
    leftovers) <- ReportErrCtxt
    -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    tryReporters ReportErrCtxt
    ctxt2 [ReporterSpec]
    report2 [Ct]
    cts1
           ; MASSERT2( null leftovers, ppr leftovers )

                -- All the Derived ones have been filtered out of simples
                -- by the constraint solver. This is ok; we don't want
                -- to report unsolved Derived goals as errors
                -- See Note [Do not report derived but soluble errors]

         ; (Implication -> TcM ()) -> Bag Implication -> TcM ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> Bag a -> m ()
    mapBagM_ (ReportErrCtxt -> Implication -> TcM ()
    reportImplic ReportErrCtxt
    ctxt2) Bag Implication
    implics }
                -- NB ctxt2: don't suppress inner insolubles if there's only a
                -- wanted insoluble here; but do suppress inner insolubles
                -- if there's a *given* insoluble here (= inaccessible code)
     where
        env :: TidyEnv
    env = ReportErrCtxt -> TidyEnv
    cec_tidy ReportErrCtxt
    ctxt
        tidy_cts :: [Ct]
    tidy_cts   = Cts -> [Ct]
    forall a. Bag a -> [a]
    bagToList ((Ct -> Ct) -> Cts -> Cts
    forall a b. (a -> b) -> Bag a -> Bag b
    mapBag (TidyEnv -> Ct -> Ct
    tidyCt TidyEnv
    env)   Cts
    simples)
        tidy_holes :: [Hole]
    tidy_holes = Bag Hole -> [Hole]
    forall a. Bag a -> [a]
    bagToList ((Hole -> Hole) -> Bag Hole -> Bag Hole
    forall a b. (a -> b) -> Bag a -> Bag b
    mapBag (TidyEnv -> Hole -> Hole
    tidyHole TidyEnv
    env) Bag Hole
    holes)

        -- report1: ones that should *not* be suppressed by
        --          an insoluble somewhere else in the tree
        -- It's crucial that anything that is considered insoluble
        -- (see GHC.Tc.Utils.insolubleCt) is caught here, otherwise
        -- we might suppress its error message, and proceed on past
        -- type checking to get a Lint error later
        report1 :: [ReporterSpec]
    report1 = [ (String
    "custom_error", (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    forall {p}. Ct -> p -> Bool
    is_user_type_error, Bool
    True,  Reporter
    mkUserTypeErrorReporter)

                  , ReporterSpec
    given_eq_spec
                  , (String
    "insoluble2",   (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    forall {p}. p -> Pred -> Bool
    utterly_wrong,  Bool
    True, (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkGroupReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr)
                  , (String
    "skolem eq1",   (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    very_wrong,     Bool
    True, Reporter
    mkSkolReporter)
                  , (String
    "skolem eq2",   (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    skolem_eq,      Bool
    True, Reporter
    mkSkolReporter)
                  , (String
    "non-tv eq",    (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    forall {p}. p -> Pred -> Bool
    non_tv_eq,      Bool
    True, Reporter
    mkSkolReporter)

                      -- The only remaining equalities are alpha ~ ty,
                      -- where alpha is untouchable; and representational equalities
                      -- Prefer homogeneous equalities over hetero, because the
                      -- former might be holding up the latter.
                      -- See Note [Equalities with incompatible kinds] in GHC.Tc.Solver.Canonical
                  , (String
    "Homo eqs",      (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    forall {p}. p -> Pred -> Bool
    is_homo_equality, Bool
    True,  (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkGroupReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr)
                  , (String
    "Other eqs",     (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    is_equality,      Bool
    True,  (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkGroupReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr)
                  , (String
    "Blocked eqs",   Ct -> Pred -> Bool
    is_equality,           Bool
    False, (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkSuppressReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkBlockedEqErr)]

        -- report2: we suppress these if there are insolubles elsewhere in the tree
        report2 :: [ReporterSpec]
    report2 = [ (String
    "Implicit params", Ct -> Pred -> Bool
    is_ip,           Bool
    False, (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkGroupReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkIPErr)
                  , (String
    "Irreds",          Ct -> Pred -> Bool
    is_irred,        Bool
    False, (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkGroupReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkIrredErr)
                  , (String
    "Dicts",           Ct -> Pred -> Bool
    is_dict,         Bool
    False, (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkGroupReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkDictErr) ]

        -- also checks to make sure the constraint isn't HoleBlockerReason
        -- See TcCanonical Note [Equalities with incompatible kinds], (4)
        unblocked :: (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
        unblocked :: (Ct -> Pred -> Bool) -> Ct -> Pred -> Bool
    unblocked Ct -> Pred -> Bool
    _ (CIrredCan { cc_reason :: Ct -> CtIrredReason
    cc_reason = HoleBlockerReason {}}) Pred
    _ = Bool
    False
        unblocked Ct -> Pred -> Bool
    checker Ct
    ct Pred
    pred = Ct -> Pred -> Bool
    checker Ct
    ct Pred
    pred

        -- rigid_nom_eq, rigid_nom_tv_eq,
        is_dict, is_equality, is_ip, is_irred :: Ct -> Pred -> Bool

        is_given_eq :: Ct -> Pred -> Bool
    is_given_eq Ct
    ct Pred
    pred
           | EqPred {} <- Pred
    pred = Ct -> Bool
    arisesFromGivens Ct
    ct
           | Bool
    otherwise         = Bool
    False
           -- I think all given residuals are equalities

        -- Things like (Int ~N Bool)
        utterly_wrong :: p -> Pred -> Bool
    utterly_wrong p
    _ (EqPred EqRel
    NomEq TcType
    ty1 TcType
    ty2) = TcType -> Bool
    isRigidTy TcType
    ty1 Bool -> Bool -> Bool
    && TcType -> Bool
    isRigidTy TcType
    ty2
        utterly_wrong p
    _ Pred
    _                      = Bool
    False

        -- Things like (a ~N Int)
        very_wrong :: Ct -> Pred -> Bool
    very_wrong Ct
    _ (EqPred EqRel
    NomEq TcType
    ty1 TcType
    ty2) = TcLevel -> TcType -> Bool
    isSkolemTy TcLevel
    tc_lvl TcType
    ty1 Bool -> Bool -> Bool
    && TcType -> Bool
    isRigidTy TcType
    ty2
        very_wrong Ct
    _ Pred
    _                      = Bool
    False

        -- Things like (a ~N b) or (a  ~N  F Bool)
        skolem_eq :: Ct -> Pred -> Bool
    skolem_eq Ct
    _ (EqPred EqRel
    NomEq TcType
    ty1 TcType
    _) = TcLevel -> TcType -> Bool
    isSkolemTy TcLevel
    tc_lvl TcType
    ty1
        skolem_eq Ct
    _ Pred
    _                    = Bool
    False

        -- Things like (F a  ~N  Int)
        non_tv_eq :: p -> Pred -> Bool
    non_tv_eq p
    _ (EqPred EqRel
    NomEq TcType
    ty1 TcType
    _) = Bool -> Bool
    not (TcType -> Bool
    isTyVarTy TcType
    ty1)
        non_tv_eq p
    _ Pred
    _                    = Bool
    False

        is_user_type_error :: Ct -> p -> Bool
    is_user_type_error Ct
    ct p
    _ = Ct -> Bool
    isUserTypeErrorCt Ct
    ct

        is_homo_equality :: p -> Pred -> Bool
    is_homo_equality p
    _ (EqPred EqRel
    _ TcType
    ty1 TcType
    ty2) = HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind TcType
    ty1 HasDebugCallStack => TcType -> TcType -> Bool
    TcType -> TcType -> Bool
    `tcEqType` HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind TcType
    ty2
        is_homo_equality p
    _ Pred
    _                  = Bool
    False

        is_equality :: Ct -> Pred -> Bool
    is_equality Ct
    _ (EqPred {}) = Bool
    True
        is_equality Ct
    _ Pred
    _           = Bool
    False

        is_dict :: Ct -> Pred -> Bool
    is_dict Ct
    _ (ClassPred {}) = Bool
    True
        is_dict Ct
    _ Pred
    _              = Bool
    False

        is_ip :: Ct -> Pred -> Bool
    is_ip Ct
    _ (ClassPred Class
    cls [TcType]
    _) = Class -> Bool
    isIPClass Class
    cls
        is_ip Ct
    _ Pred
    _                 = Bool
    False

        is_irred :: Ct -> Pred -> Bool
    is_irred Ct
    _ (IrredPred {}) = Bool
    True
        is_irred Ct
    _ Pred
    _              = Bool
    False

        given_eq_spec :: ReporterSpec
    given_eq_spec  -- See Note [Given errors]
          | [Implication] -> Bool
    has_gadt_match (ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt)
          = (String
    "insoluble1a", Ct -> Pred -> Bool
    is_given_eq, Bool
    True,  Reporter
    mkGivenErrorReporter)
          | Bool
    otherwise
          = (String
    "insoluble1b", Ct -> Pred -> Bool
    is_given_eq, Bool
    False, Reporter
    ignoreErrorReporter)
              -- False means don't suppress subsequent errors
              -- Reason: we don't report all given errors
              --         (see mkGivenErrorReporter), and we should only suppress
              --         subsequent errors if we actually report this one!
              --         #13446 is an example

        -- See Note [Given errors]
        has_gadt_match :: [Implication] -> Bool
    has_gadt_match [] = Bool
    False
        has_gadt_match (Implication
    implic : [Implication]
    implics)
          | PatSkol {} <- Implication -> SkolemInfo
    ic_info Implication
    implic
          , Implication -> HasGivenEqs
    ic_given_eqs Implication
    implic HasGivenEqs -> HasGivenEqs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HasGivenEqs
    NoGivenEqs
          , Implication -> Bool
    ic_warn_inaccessible Implication
    implic
              -- Don't bother doing this if -Winaccessible-code isn't enabled.
              -- See Note [Avoid -Winaccessible-code when deriving] in GHC.Tc.TyCl.Instance.
          = Bool
    True
          | Bool
    otherwise
          = [Implication] -> Bool
    has_gadt_match [Implication]
    implics

    ---------------
    isSkolemTy :: TcLevel -> Type -> Bool
    -- The type is a skolem tyvar
    isSkolemTy :: TcLevel -> TcType -> Bool
    isSkolemTy TcLevel
    tc_lvl TcType
    ty
      | Just TcId
    tv <- TcType -> Maybe TcId
    getTyVar_maybe TcType
    ty
      =  TcId -> Bool
    isSkolemTyVar TcId
    tv
      Bool -> Bool -> Bool
    || (TcId -> Bool
    isTyVarTyVar TcId
    tv Bool -> Bool -> Bool
    && TcLevel -> TcId -> Bool
    isTouchableMetaTyVar TcLevel
    tc_lvl TcId
    tv)
         -- The last case is for touchable TyVarTvs
         -- we postpone untouchables to a latter test (too obscure)

      | Bool
    otherwise
      = Bool
    False

    isTyFun_maybe :: Type -> Maybe TyCon
    isTyFun_maybe :: TcType -> Maybe TyCon
    isTyFun_maybe TcType
    ty = case HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty of
                          Just (TyCon
    tc,[TcType]
    _) | TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc -> TyCon -> Maybe TyCon
    forall a. a -> Maybe a
    Just TyCon
    tc
                          Maybe (TyCon, [TcType])
    _ -> Maybe TyCon
    forall a. Maybe a
    Nothing

    --------------------------------------------
    --      Reporters
    --------------------------------------------

    type Reporter
      = ReportErrCtxt -> [Ct] -> TcM ()
    type ReporterSpec
      = ( String                     -- Name
        , Ct -> Pred -> Bool         -- Pick these ones
        , Bool                       -- True <=> suppress subsequent reporters
        , Reporter)                  -- The reporter itself

    mkSkolReporter :: Reporter
    -- Suppress duplicates with either the same LHS, or same location
    mkSkolReporter :: Reporter
    mkSkolReporter ReportErrCtxt
    ctxt [Ct]
    cts
      = ([Ct] -> TcM ()) -> [[Ct]] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    reportGroup ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr ReportErrCtxt
    ctxt) ([Ct] -> [[Ct]]
    group [Ct]
    cts)
      where
         group :: [Ct] -> [[Ct]]
    group [] = []
         group (Ct
    ct:[Ct]
    cts) = (Ct
    ct Ct -> [Ct] -> [Ct]
    forall a. a -> [a] -> [a]
    : [Ct]
    yeses) [Ct] -> [[Ct]] -> [[Ct]]
    forall a. a -> [a] -> [a]
    : [Ct] -> [[Ct]]
    group [Ct]
    noes
            where
              ([Ct]
    yeses, [Ct]
    noes) = (Ct -> Bool) -> [Ct] -> ([Ct], [Ct])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Ct -> Ct -> Bool
    group_with Ct
    ct) [Ct]
    cts

         group_with :: Ct -> Ct -> Bool
    group_with Ct
    ct1 Ct
    ct2
           | Ordering
    EQ <- Ct -> Ct -> Ordering
    cmp_loc Ct
    ct1 Ct
    ct2 = Bool
    True
           | Ct -> Ct -> Bool
    eq_lhs_type   Ct
    ct1 Ct
    ct2 = Bool
    True
           | Bool
    otherwise             = Bool
    False

    reportHoles :: [Ct]  -- other (tidied) constraints
                -> ReportErrCtxt -> [Hole] -> TcM ()
    reportHoles :: [Ct] -> ReportErrCtxt -> [Hole] -> TcM ()
    reportHoles [Ct]
    tidy_cts ReportErrCtxt
    ctxt
      = (Hole -> TcM ()) -> [Hole] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Hole -> TcM ()) -> [Hole] -> TcM ())
    -> (Hole -> TcM ()) -> [Hole] -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ \Hole
    hole -> Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (ReportErrCtxt -> Hole -> Bool
    ignoreThisHole ReportErrCtxt
    ctxt Hole
    hole) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
                         do { MsgEnvelope DecoratedSDoc
    err <- [Ct] -> ReportErrCtxt -> Hole -> TcM (MsgEnvelope DecoratedSDoc)
    mkHoleError [Ct]
    tidy_cts ReportErrCtxt
    ctxt Hole
    hole
                            ; ReportErrCtxt -> Hole -> MsgEnvelope DecoratedSDoc -> TcM ()
    maybeReportHoleError ReportErrCtxt
    ctxt Hole
    hole MsgEnvelope DecoratedSDoc
    err
                            ; ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Hole -> TcM ()
    maybeAddDeferredHoleBinding ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err Hole
    hole }

    ignoreThisHole :: ReportErrCtxt -> Hole -> Bool
    -- See Note [Skip type holes rapidly]
    ignoreThisHole :: ReportErrCtxt -> Hole -> Bool
    ignoreThisHole ReportErrCtxt
    ctxt Hole
    hole
      = case Hole -> HoleSort
    hole_sort Hole
    hole of
           ExprHole {}    -> Bool
    False
           HoleSort
    TypeHole       -> Bool
    ignore_type_hole
           HoleSort
    ConstraintHole -> Bool
    ignore_type_hole
      where
        ignore_type_hole :: Bool
    ignore_type_hole = case ReportErrCtxt -> HoleChoice
    cec_type_holes ReportErrCtxt
    ctxt of
                             HoleChoice
    HoleDefer -> Bool
    True
                             HoleChoice
    _         -> Bool
    False

    {- Note [Skip type holes rapidly]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we have module with a /lot/ of partial type signatures, and we
    compile it while suppressing partial-type-signature warnings.  Then
    we don't want to spend ages constructing error messages and lists of
    relevant bindings that we never display! This happened in #14766, in
    which partial type signatures in a Happy-generated parser cause a huge
    increase in compile time.

    The function ignoreThisHole short-circuits the error/warning generation
    machinery, in cases where it is definitely going to be a no-op.
    -}

    mkUserTypeErrorReporter :: Reporter
    mkUserTypeErrorReporter :: Reporter
    mkUserTypeErrorReporter ReportErrCtxt
    ctxt
      = (Ct -> TcM ()) -> [Ct] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((Ct -> TcM ()) -> [Ct] -> TcM ())
    -> (Ct -> TcM ()) -> [Ct] -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ \Ct
    ct -> do { MsgEnvelope DecoratedSDoc
    err <- ReportErrCtxt -> Ct -> TcM (MsgEnvelope DecoratedSDoc)
    mkUserTypeError ReportErrCtxt
    ctxt Ct
    ct
                          ; ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> TcM ()
    maybeReportError ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err
                          ; ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Ct -> TcM ()
    addDeferredBinding ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err Ct
    ct }

    mkUserTypeError :: ReportErrCtxt -> Ct -> TcM (MsgEnvelope DecoratedSDoc)
    mkUserTypeError :: ReportErrCtxt -> Ct -> TcM (MsgEnvelope DecoratedSDoc)
    mkUserTypeError ReportErrCtxt
    ctxt Ct
    ct = ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct
                            (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Report
    important
                            (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $ TcType -> SDoc
    pprUserTypeErrorTy
                            (TcType -> SDoc) -> TcType -> SDoc
    forall a b. (a -> b) -> a -> b
    $ case Ct -> Maybe TcType
    getUserTypeErrorMsg Ct
    ct of
                                Just TcType
    msg -> TcType
    msg
                                Maybe TcType
    Nothing  -> String -> SDoc -> TcType
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "mkUserTypeError" (Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct)

    mkGivenErrorReporter :: Reporter
    -- See Note [Given errors]
    mkGivenErrorReporter :: Reporter
    mkGivenErrorReporter ReportErrCtxt
    ctxt [Ct]
    cts
      = do { (ReportErrCtxt
    ctxt, SDoc
    binds_msg, Ct
    ct) <- Bool -> ReportErrCtxt -> Ct -> TcM (ReportErrCtxt, SDoc, Ct)
    relevantBindings Bool
    True ReportErrCtxt
    ctxt Ct
    ct
           ; DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; let (Implication
    implic:[Implication]
    _) = ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt
                     -- Always non-empty when mkGivenErrorReporter is called
                 ct' :: Ct
    ct' = Ct -> CtLoc -> Ct
    setCtLoc Ct
    ct (CtLoc -> TcLclEnv -> CtLoc
    setCtLocEnv (Ct -> CtLoc
    ctLoc Ct
    ct) (Implication -> TcLclEnv
    ic_env Implication
    implic))
                       -- For given constraints we overwrite the env (and hence src-loc)
                       -- with one from the immediately-enclosing implication.
                       -- See Note [Inaccessible code]

                 inaccessible_msg :: SDoc
    inaccessible_msg = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Inaccessible code in")
                                       Int
    2 (SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Implication -> SkolemInfo
    ic_info Implication
    implic))
                 report :: Report
    report = SDoc -> Report
    important SDoc
    inaccessible_msg Report -> Report -> Report
    forall a. Monoid a => a -> a -> a
    `mappend`
                          SDoc -> Report
    mk_relevant_bindings SDoc
    binds_msg

           ; MsgEnvelope DecoratedSDoc
    err <- DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcType
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr_help DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct' TcType
    ty1 TcType
    ty2

           ; String -> SDoc -> TcM ()
    traceTc String
    "mkGivenErrorReporter" (Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct)
           ; WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnInaccessibleCode) MsgEnvelope DecoratedSDoc
    err }
      where
        (Ct
    ct : [Ct]
    _ )  = [Ct]
    cts    -- Never empty
        (TcType
    ty1, TcType
    ty2) = TcType -> (TcType, TcType)
    getEqPredTys (Ct -> TcType
    ctPred Ct
    ct)

    ignoreErrorReporter :: Reporter
    -- Discard Given errors that don't come from
    -- a pattern match; maybe we should warn instead?
    ignoreErrorReporter :: Reporter
    ignoreErrorReporter ReportErrCtxt
    ctxt [Ct]
    cts
      = do { String -> SDoc -> TcM ()
    traceTc String
    "mkGivenErrorReporter no" ([Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    cts SDoc -> SDoc -> SDoc
    $$ [Implication] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt))
           ; () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return () }

    {- Note [Given errors]
    ~~~~~~~~~~~~~~~~~~~~~~
    Given constraints represent things for which we have (or will have)
    evidence, so they aren't errors.  But if a Given constraint is
    insoluble, this code is inaccessible, and we might want to at least
    warn about that.  A classic case is

       data T a where
         T1 :: T Int
         T2 :: T a
         T3 :: T Bool

       f :: T Int -> Bool
       f T1 = ...
       f T2 = ...
       f T3 = ...  -- We want to report this case as inaccessible

    We'd like to point out that the T3 match is inaccessible. It
    will have a Given constraint [G] Int ~ Bool.

    But we don't want to report ALL insoluble Given constraints.  See Trac
    #12466 for a long discussion.  For example, if we aren't careful
    we'll complain about
       f :: ((Int ~ Bool) => a -> a) -> Int
    which arguably is OK.  It's more debatable for
       g :: (Int ~ Bool) => Int -> Int
    but it's tricky to distinguish these cases so we don't report
    either.

    The bottom line is this: has_gadt_match looks for an enclosing
    pattern match which binds some equality constraints.  If we
    find one, we report the insoluble Given.
    -}

    mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
                                 -- Make error message for a group
                    -> Reporter  -- Deal with lots of constraints
    -- Group together errors from same location,
    -- and report only the first (to avoid a cascade)
    mkGroupReporter :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkGroupReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt [Ct]
    cts
      = (NonEmpty Ct -> TcM ()) -> [NonEmpty Ct] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    reportGroup ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt ([Ct] -> TcM ()) -> (NonEmpty Ct -> [Ct]) -> NonEmpty Ct -> TcM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty Ct -> [Ct]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList) ((Ct -> Ct -> Ordering) -> [Ct] -> [NonEmpty Ct]
    forall a. (a -> a -> Ordering) -> [a] -> [NonEmpty a]
    equivClasses Ct -> Ct -> Ordering
    cmp_loc [Ct]
    cts)

    -- Like mkGroupReporter, but doesn't actually print error messages
    mkSuppressReporter :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)) -> Reporter
    mkSuppressReporter :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    mkSuppressReporter ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt [Ct]
    cts
      = (NonEmpty Ct -> TcM ()) -> [NonEmpty Ct] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ ((ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    suppressGroup ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt ([Ct] -> TcM ()) -> (NonEmpty Ct -> [Ct]) -> NonEmpty Ct -> TcM ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . NonEmpty Ct -> [Ct]
    forall (t :: * -> *) a. Foldable t => t a -> [a]
    toList) ((Ct -> Ct -> Ordering) -> [Ct] -> [NonEmpty Ct]
    forall a. (a -> a -> Ordering) -> [a] -> [NonEmpty a]
    equivClasses Ct -> Ct -> Ordering
    cmp_loc [Ct]
    cts)

    eq_lhs_type :: Ct -> Ct -> Bool
    eq_lhs_type :: Ct -> Ct -> Bool
    eq_lhs_type Ct
    ct1 Ct
    ct2
      = case (TcType -> Pred
    classifyPredType (Ct -> TcType
    ctPred Ct
    ct1), TcType -> Pred
    classifyPredType (Ct -> TcType
    ctPred Ct
    ct2)) of
           (EqPred EqRel
    eq_rel1 TcType
    ty1 TcType
    _, EqPred EqRel
    eq_rel2 TcType
    ty2 TcType
    _) ->
             (EqRel
    eq_rel1 EqRel -> EqRel -> Bool
    forall a. Eq a => a -> a -> Bool
    == EqRel
    eq_rel2) Bool -> Bool -> Bool
    && (TcType
    ty1 TcType -> TcType -> Bool
    `eqType` TcType
    ty2)
           (Pred, Pred)
    _ -> String -> SDoc -> Bool
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "mkSkolReporter" (Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct1 SDoc -> SDoc -> SDoc
    $$ Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct2)

    cmp_loc :: Ct -> Ct -> Ordering
    cmp_loc :: Ct -> Ct -> Ordering
    cmp_loc Ct
    ct1 Ct
    ct2 = Ct -> RealSrcLoc
    get Ct
    ct1 RealSrcLoc -> RealSrcLoc -> Ordering
    forall a. Ord a => a -> a -> Ordering
    `compare` Ct -> RealSrcLoc
    get Ct
    ct2
      where
        get :: Ct -> RealSrcLoc
    get Ct
    ct = RealSrcSpan -> RealSrcLoc
    realSrcSpanStart (CtLoc -> RealSrcSpan
    ctLocSpan (Ct -> CtLoc
    ctLoc Ct
    ct))
                 -- Reduce duplication by reporting only one error from each
                 -- /starting/ location even if the end location differs

    reportGroup :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)) -> Reporter
    reportGroup :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    reportGroup ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt [Ct]
    cts =
      ASSERT( not (null cts))
      do { MsgEnvelope DecoratedSDoc
    err <- ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt [Ct]
    cts
         ; String -> SDoc -> TcM ()
    traceTc String
    "About to maybeReportErr" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
           [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Constraint:"             SDoc -> SDoc -> SDoc
    <+> [Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    cts
                , String -> SDoc
    text String
    "cec_suppress ="          SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt)
                , String -> SDoc
    text String
    "cec_defer_type_errors =" SDoc -> SDoc -> SDoc
    <+> TypeErrorChoice -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ReportErrCtxt -> TypeErrorChoice
    cec_defer_type_errors ReportErrCtxt
    ctxt) ]
         ; ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> TcM ()
    maybeReportError ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err
             -- But see Note [Always warn with -fdefer-type-errors]
         ; String -> SDoc -> TcM ()
    traceTc String
    "reportGroup" ([Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    cts)
         ; (Ct -> TcM ()) -> [Ct] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Ct -> TcM ()
    addDeferredBinding ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err) [Ct]
    cts }
             -- Add deferred bindings for all
             -- Redundant if we are going to abort compilation,
             -- but that's hard to know for sure, and if we don't
             -- abort, we need bindings for all (e.g. #12156)

    -- like reportGroup, but does not actually report messages. It still adds
    -- -fdefer-type-errors bindings, though.
    suppressGroup :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)) -> Reporter
    suppressGroup :: (ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc))
    -> Reporter
    suppressGroup ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt [Ct]
    cts
     = do { MsgEnvelope DecoratedSDoc
    err <- ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mk_err ReportErrCtxt
    ctxt [Ct]
    cts
          ; String -> SDoc -> TcM ()
    traceTc String
    "Suppressing errors for" ([Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    cts)
          ; (Ct -> TcM ()) -> [Ct] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Ct -> TcM ()
    addDeferredBinding ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err) [Ct]
    cts }

    maybeReportHoleError :: ReportErrCtxt -> Hole -> MsgEnvelope DecoratedSDoc -> TcM ()
    maybeReportHoleError :: ReportErrCtxt -> Hole -> MsgEnvelope DecoratedSDoc -> TcM ()
    maybeReportHoleError ReportErrCtxt
    ctxt Hole
    hole MsgEnvelope DecoratedSDoc
    err
      | Hole -> Bool
    isOutOfScopeHole Hole
    hole
      -- Always report an error for out-of-scope variables
      -- Unless -fdefer-out-of-scope-variables is on,
      -- in which case the messages are discarded.
      -- See #12170, #12406
      = -- If deferring, report a warning only if -Wout-of-scope-variables is on
        case ReportErrCtxt -> HoleChoice
    cec_out_of_scope_holes ReportErrCtxt
    ctxt of
          HoleChoice
    HoleError -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportError MsgEnvelope DecoratedSDoc
    err
          HoleChoice
    HoleWarn  ->
            WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnDeferredOutOfScopeVariables) MsgEnvelope DecoratedSDoc
    err
          HoleChoice
    HoleDefer -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- Unlike maybeReportError, these "hole" errors are
    -- /not/ suppressed by cec_suppress.  We want to see them!
    maybeReportHoleError ReportErrCtxt
    ctxt (Hole { hole_sort :: Hole -> HoleSort
    hole_sort = HoleSort
    hole_sort }) MsgEnvelope DecoratedSDoc
    err
      | case HoleSort
    hole_sort of HoleSort
    TypeHole       -> Bool
    True
                          HoleSort
    ConstraintHole -> Bool
    True
                          HoleSort
    _              -> Bool
    False
      -- When -XPartialTypeSignatures is on, warnings (instead of errors) are
      -- generated for holes in partial type signatures.
      -- Unless -fwarn-partial-type-signatures is not on,
      -- in which case the messages are discarded.
      = -- For partial type signatures, generate warnings only, and do that
        -- only if -fwarn-partial-type-signatures is on
        case ReportErrCtxt -> HoleChoice
    cec_type_holes ReportErrCtxt
    ctxt of
           HoleChoice
    HoleError -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportError MsgEnvelope DecoratedSDoc
    err
           HoleChoice
    HoleWarn  -> WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnPartialTypeSignatures) MsgEnvelope DecoratedSDoc
    err
           HoleChoice
    HoleDefer -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    maybeReportHoleError ReportErrCtxt
    ctxt Hole
    hole MsgEnvelope DecoratedSDoc
    err
      -- Otherwise this is a typed hole in an expression,
      -- but not for an out-of-scope variable (because that goes through a
      -- different function)
      = -- If deferring, report a warning only if -Wtyped-holes is on
        ASSERT( not (isOutOfScopeHole hole) )
        case ReportErrCtxt -> HoleChoice
    cec_expr_holes ReportErrCtxt
    ctxt of
           HoleChoice
    HoleError -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportError MsgEnvelope DecoratedSDoc
    err
           HoleChoice
    HoleWarn  -> WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnTypedHoles) MsgEnvelope DecoratedSDoc
    err
           HoleChoice
    HoleDefer -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    maybeReportError :: ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> TcM ()
    -- Report the error and/or make a deferred binding for it
    maybeReportError :: ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> TcM ()
    maybeReportError ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err
      | ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt    -- Some worse error has occurred;
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()            -- so suppress this error/warning

      | Bool
    otherwise
      = case ReportErrCtxt -> TypeErrorChoice
    cec_defer_type_errors ReportErrCtxt
    ctxt of
          TypeErrorChoice
    TypeDefer       -> () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
          TypeWarn WarnReason
    reason -> WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning WarnReason
    reason MsgEnvelope DecoratedSDoc
    err
          TypeErrorChoice
    TypeError       -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportError MsgEnvelope DecoratedSDoc
    err

    addDeferredBinding :: ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Ct -> TcM ()
    -- See Note [Deferring coercion errors to runtime]
    addDeferredBinding :: ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Ct -> TcM ()
    addDeferredBinding ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err Ct
    ct
      | ReportErrCtxt -> Bool
    deferringAnyBindings ReportErrCtxt
    ctxt
      , CtWanted { ctev_pred :: CtEvidence -> TcType
    ctev_pred = TcType
    pred, ctev_dest :: CtEvidence -> TcEvDest
    ctev_dest = TcEvDest
    dest } <- Ct -> CtEvidence
    ctEvidence Ct
    ct
        -- Only add deferred bindings for Wanted constraints
      = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; let err_tm :: EvTerm
    err_tm       = DynFlags -> TcType -> MsgEnvelope DecoratedSDoc -> EvTerm
    mkErrorTerm DynFlags
    dflags TcType
    pred MsgEnvelope DecoratedSDoc
    err
                 ev_binds_var :: EvBindsVar
    ev_binds_var = ReportErrCtxt -> EvBindsVar
    cec_binds ReportErrCtxt
    ctxt

           ; case TcEvDest
    dest of
               EvVarDest TcId
    evar
                 -> EvBindsVar -> EvBind -> TcM ()
    addTcEvBind EvBindsVar
    ev_binds_var (EvBind -> TcM ()) -> EvBind -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ TcId -> EvTerm -> EvBind
    mkWantedEvBind TcId
    evar EvTerm
    err_tm
               HoleDest CoercionHole
    hole
                 -> do { -- See Note [Deferred errors for coercion holes]
                         let co_var :: TcId
    co_var = CoercionHole -> TcId
    coHoleCoVar CoercionHole
    hole
                       ; EvBindsVar -> EvBind -> TcM ()
    addTcEvBind EvBindsVar
    ev_binds_var (EvBind -> TcM ()) -> EvBind -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ TcId -> EvTerm -> EvBind
    mkWantedEvBind TcId
    co_var EvTerm
    err_tm
                       ; CoercionHole -> Coercion -> TcM ()
    fillCoercionHole CoercionHole
    hole (TcId -> Coercion
    mkTcCoVarCo TcId
    co_var) }}

      | Bool
    otherwise   -- Do not set any evidence for Given/Derived
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    mkErrorTerm :: DynFlags -> Type  -- of the error term
                -> MsgEnvelope DecoratedSDoc -> EvTerm
    mkErrorTerm :: DynFlags -> TcType -> MsgEnvelope DecoratedSDoc -> EvTerm
    mkErrorTerm DynFlags
    dflags TcType
    ty MsgEnvelope DecoratedSDoc
    err = TcType -> FastString -> EvTerm
    evDelayedError TcType
    ty FastString
    err_fs
      where
        err_msg :: SDoc
    err_msg = MsgEnvelope DecoratedSDoc -> SDoc
    forall e. RenderableDiagnostic e => MsgEnvelope e -> SDoc
    pprLocMsgEnvelope MsgEnvelope DecoratedSDoc
    err
        err_fs :: FastString
    err_fs  = String -> FastString
    mkFastString (String -> FastString) -> String -> FastString
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (SDoc -> String) -> SDoc -> String
    forall a b. (a -> b) -> a -> b
    $
                  SDoc
    err_msg SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "(deferred type error)"

    maybeAddDeferredHoleBinding :: ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Hole -> TcM ()
    maybeAddDeferredHoleBinding :: ReportErrCtxt -> MsgEnvelope DecoratedSDoc -> Hole -> TcM ()
    maybeAddDeferredHoleBinding ReportErrCtxt
    ctxt MsgEnvelope DecoratedSDoc
    err (Hole { hole_sort :: Hole -> HoleSort
    hole_sort = ExprHole (HER IORef EvTerm
    ref TcType
    ref_ty Unique
    _) })
    -- Only add bindings for holes in expressions
    -- not for holes in partial type signatures
    -- cf. addDeferredBinding
      | ReportErrCtxt -> Bool
    deferringAnyBindings ReportErrCtxt
    ctxt
      = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; let err_tm :: EvTerm
    err_tm = DynFlags -> TcType -> MsgEnvelope DecoratedSDoc -> EvTerm
    mkErrorTerm DynFlags
    dflags TcType
    ref_ty MsgEnvelope DecoratedSDoc
    err
               -- NB: ref_ty, not hole_ty. hole_ty might be rewritten.
               -- See Note [Holes] in GHC.Tc.Types.Constraint
           ; IORef EvTerm -> EvTerm -> TcM ()
    forall a env. IORef a -> a -> IOEnv env ()
    writeMutVar IORef EvTerm
    ref EvTerm
    err_tm }
      | Bool
    otherwise
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    maybeAddDeferredHoleBinding ReportErrCtxt
    _ MsgEnvelope DecoratedSDoc
    _ (Hole { hole_sort :: Hole -> HoleSort
    hole_sort = HoleSort
    TypeHole })
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    maybeAddDeferredHoleBinding ReportErrCtxt
    _ MsgEnvelope DecoratedSDoc
    _ (Hole { hole_sort :: Hole -> HoleSort
    hole_sort = HoleSort
    ConstraintHole })
      = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    tryReporters :: ReportErrCtxt -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    -- Use the first reporter in the list whose predicate says True
    tryReporters :: ReportErrCtxt
    -> [ReporterSpec] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    tryReporters ReportErrCtxt
    ctxt [ReporterSpec]
    reporters [Ct]
    cts
      = do { let ([Ct]
    vis_cts, [Ct]
    invis_cts) = (Ct -> Bool) -> [Ct] -> ([Ct], [Ct])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (CtOrigin -> Bool
    isVisibleOrigin (CtOrigin -> Bool) -> (Ct -> CtOrigin) -> Ct -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Ct -> CtOrigin
    ctOrigin) [Ct]
    cts
           ; String -> SDoc -> TcM ()
    traceTc String
    "tryReporters {" ([Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    vis_cts SDoc -> SDoc -> SDoc
    $$ [Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    invis_cts)
           ; (ReportErrCtxt
    ctxt', [Ct]
    cts') <- ReportErrCtxt
    -> [ReporterSpec] -> [Ct] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    go ReportErrCtxt
    ctxt [ReporterSpec]
    reporters [Ct]
    vis_cts [Ct]
    invis_cts
           ; String -> SDoc -> TcM ()
    traceTc String
    "tryReporters }" ([Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    cts')
           ; (ReportErrCtxt, [Ct]) -> TcM (ReportErrCtxt, [Ct])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt', [Ct]
    cts') }
      where
        go :: ReportErrCtxt
    -> [ReporterSpec] -> [Ct] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    go ReportErrCtxt
    ctxt [] [Ct]
    vis_cts [Ct]
    invis_cts
          = (ReportErrCtxt, [Ct]) -> TcM (ReportErrCtxt, [Ct])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt, [Ct]
    vis_cts [Ct] -> [Ct] -> [Ct]
    forall a. [a] -> [a] -> [a]
    ++ [Ct]
    invis_cts)

        go ReportErrCtxt
    ctxt (ReporterSpec
    r : [ReporterSpec]
    rs) [Ct]
    vis_cts [Ct]
    invis_cts
           -- always look at *visible* Origins before invisible ones
           -- this is the whole point of isVisibleOrigin
          = do { (ReportErrCtxt
    ctxt', [Ct]
    vis_cts') <- ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    tryReporter ReportErrCtxt
    ctxt ReporterSpec
    r [Ct]
    vis_cts
               ; (ReportErrCtxt
    ctxt'', [Ct]
    invis_cts') <- ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    tryReporter ReportErrCtxt
    ctxt' ReporterSpec
    r [Ct]
    invis_cts
               ; ReportErrCtxt
    -> [ReporterSpec] -> [Ct] -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    go ReportErrCtxt
    ctxt'' [ReporterSpec]
    rs [Ct]
    vis_cts' [Ct]
    invis_cts' }
                    -- Carry on with the rest, because we must make
                    -- deferred bindings for them if we have -fdefer-type-errors
                    -- But suppress their error messages

    tryReporter :: ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    tryReporter :: ReportErrCtxt -> ReporterSpec -> [Ct] -> TcM (ReportErrCtxt, [Ct])
    tryReporter ReportErrCtxt
    ctxt (String
    str, Ct -> Pred -> Bool
    keep_me,  Bool
    suppress_after, Reporter
    reporter) [Ct]
    cts
      | [Ct] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Ct]
    yeses
      = (ReportErrCtxt, [Ct]) -> TcM (ReportErrCtxt, [Ct])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt, [Ct]
    cts)
      | Bool
    otherwise
      = do { String -> SDoc -> TcM ()
    traceTc String
    "tryReporter{ " (String -> SDoc
    text String
    str SDoc -> SDoc -> SDoc
    <+> [Ct] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Ct]
    yeses)
           ; (()
    _, Bool
    no_errs) <- TcM () -> TcRn ((), Bool)
    forall a. TcRn a -> TcRn (a, Bool)
    askNoErrs (Reporter
    reporter ReportErrCtxt
    ctxt [Ct]
    yeses)
           ; let suppress_now :: Bool
    suppress_now = Bool -> Bool
    not Bool
    no_errs Bool -> Bool -> Bool
    && Bool
    suppress_after
                                -- See Note [Suppressing error messages]
                 ctxt' :: ReportErrCtxt
    ctxt' = ReportErrCtxt
    ctxt { cec_suppress :: Bool
    cec_suppress = Bool
    suppress_now Bool -> Bool -> Bool
    || ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt }
           ; String -> SDoc -> TcM ()
    traceTc String
    "tryReporter end }" (String -> SDoc
    text String
    str SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (ReportErrCtxt -> Bool
    cec_suppress ReportErrCtxt
    ctxt) SDoc -> SDoc -> SDoc
    <+> Bool -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bool
    suppress_after)
           ; (ReportErrCtxt, [Ct]) -> TcM (ReportErrCtxt, [Ct])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt', [Ct]
    nos) }
      where
        ([Ct]
    yeses, [Ct]
    nos) = (Ct -> Bool) -> [Ct] -> ([Ct], [Ct])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (\Ct
    ct -> Ct -> Pred -> Bool
    keep_me Ct
    ct (TcType -> Pred
    classifyPredType (Ct -> TcType
    ctPred Ct
    ct))) [Ct]
    cts

    pprArising :: CtOrigin -> SDoc
    -- Used for the main, top-level error message
    -- We've done special processing for TypeEq, KindEq, Given
    pprArising :: CtOrigin -> SDoc
    pprArising (TypeEqOrigin {}) = SDoc
    empty
    pprArising (KindEqOrigin {}) = SDoc
    empty
    pprArising (GivenOrigin {})  = SDoc
    empty
    pprArising CtOrigin
    orig              = CtOrigin -> SDoc
    pprCtOrigin CtOrigin
    orig

    -- Add the "arising from..." part to a message about bunch of dicts
    addArising :: CtOrigin -> SDoc -> SDoc
    addArising :: CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig SDoc
    msg = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    msg Int
    2 (CtOrigin -> SDoc
    pprArising CtOrigin
    orig)

    pprWithArising :: [Ct] -> (CtLoc, SDoc)
    -- Print something like
    --    (Eq a) arising from a use of x at y
    --    (Show a) arising from a use of p at q
    -- Also return a location for the error message
    -- Works for Wanted/Derived only
    pprWithArising :: [Ct] -> (CtLoc, SDoc)
    pprWithArising []
      = String -> (CtLoc, SDoc)
    forall a. String -> a
    panic String
    "pprWithArising"
    pprWithArising (Ct
    ct:[Ct]
    cts)
      | [Ct] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Ct]
    cts
      = (CtLoc
    loc, CtOrigin -> SDoc -> SDoc
    addArising (CtLoc -> CtOrigin
    ctLocOrigin CtLoc
    loc)
                         ([TcType] -> SDoc
    pprTheta [Ct -> TcType
    ctPred Ct
    ct]))
      | Bool
    otherwise
      = (CtLoc
    loc, [SDoc] -> SDoc
    vcat ((Ct -> SDoc) -> [Ct] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map Ct -> SDoc
    ppr_one (Ct
    ctCt -> [Ct] -> [Ct]
    forall a. a -> [a] -> [a]
    :[Ct]
    cts)))
      where
        loc :: CtLoc
    loc = Ct -> CtLoc
    ctLoc Ct
    ct
        ppr_one :: Ct -> SDoc
    ppr_one Ct
    ct' = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    parens (TcType -> SDoc
    pprType (Ct -> TcType
    ctPred Ct
    ct')))
                         Int
    2 (CtLoc -> SDoc
    pprCtLoc (Ct -> CtLoc
    ctLoc Ct
    ct'))

    mkErrorMsgFromCt :: ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt :: ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct Report
    report
      = ReportErrCtxt
    -> TcLclEnv -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorReport ReportErrCtxt
    ctxt (CtLoc -> TcLclEnv
    ctLocEnv (Ct -> CtLoc
    ctLoc Ct
    ct)) Report
    report

    mkErrorReport :: ReportErrCtxt -> TcLclEnv -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorReport :: ReportErrCtxt
    -> TcLclEnv -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorReport ReportErrCtxt
    ctxt TcLclEnv
    tcl_env (Report [SDoc]
    important [SDoc]
    relevant_bindings [SDoc]
    valid_subs)
      = do { SDoc
    context <- TidyEnv -> [ErrCtxt] -> TcM SDoc
    mkErrInfo (ReportErrCtxt -> TidyEnv
    cec_tidy ReportErrCtxt
    ctxt) (TcLclEnv -> [ErrCtxt]
    tcl_ctxt TcLclEnv
    tcl_env)
           ; SrcSpan -> SDoc -> SDoc -> SDoc -> TcM (MsgEnvelope DecoratedSDoc)
    mkDecoratedSDocAt (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (TcLclEnv -> RealSrcSpan
    tcl_loc TcLclEnv
    tcl_env) Maybe BufSpan
    forall a. Maybe a
    Nothing)
                               ([SDoc] -> SDoc
    vcat [SDoc]
    important)
                               SDoc
    context
                               ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc]
    relevant_bindings [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    valid_subs)
           }

    type UserGiven = Implication

    getUserGivens :: ReportErrCtxt -> [UserGiven]
    -- One item for each enclosing implication
    getUserGivens :: ReportErrCtxt -> [Implication]
    getUserGivens (CEC {cec_encl :: ReportErrCtxt -> [Implication]
    cec_encl = [Implication]
    implics}) = [Implication] -> [Implication]
    getUserGivensFromImplics [Implication]
    implics

    getUserGivensFromImplics :: [Implication] -> [UserGiven]
    getUserGivensFromImplics :: [Implication] -> [Implication]
    getUserGivensFromImplics [Implication]
    implics
      = [Implication] -> [Implication]
    forall a. [a] -> [a]
    reverse ((Implication -> Bool) -> [Implication] -> [Implication]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut ([TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([TcId] -> Bool) -> (Implication -> [TcId]) -> Implication -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Implication -> [TcId]
    ic_given) [Implication]
    implics)

    {- Note [Always warn with -fdefer-type-errors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When -fdefer-type-errors is on we warn about *all* type errors, even
    if cec_suppress is on.  This can lead to a lot more warnings than you
    would get errors without -fdefer-type-errors, but if we suppress any of
    them you might get a runtime error that wasn't warned about at compile
    time.

    This is an easy design choice to change; just flip the order of the
    first two equations for maybeReportError

    To be consistent, we should also report multiple warnings from a single
    location in mkGroupReporter, when -fdefer-type-errors is on.  But that
    is perhaps a bit *over*-consistent! Again, an easy choice to change.

    With #10283, you can now opt out of deferred type error warnings.

    Note [Deferred errors for coercion holes]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Suppose we need to defer a type error where the destination for the evidence
    is a coercion hole. We can't just put the error in the hole, because we can't
    make an erroneous coercion. (Remember that coercions are erased for runtime.)
    Instead, we invent a new EvVar, bind it to an error and then make a coercion
    from that EvVar, filling the hole with that coercion. Because coercions'
    types are unlifted, the error is guaranteed to be hit before we get to the
    coercion.

    Note [Do not report derived but soluble errors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The wc_simples include Derived constraints that have not been solved,
    but are not insoluble (in that case they'd be reported by 'report1').
    We do not want to report these as errors:

    * Superclass constraints. If we have an unsolved [W] Ord a, we'll also have
      an unsolved [D] Eq a, and we do not want to report that; it's just noise.

    * Functional dependencies.  For givens, consider
          class C a b | a -> b
          data T a where
             MkT :: C a d => [d] -> T a
          f :: C a b => T a -> F Int
          f (MkT xs) = length xs
      Then we get a [D] b~d.  But there *is* a legitimate call to
      f, namely   f (MkT [True]) :: T Bool, in which b=d.  So we should
      not reject the program.

      For wanteds, something similar
          data T a where
            MkT :: C Int b => a -> b -> T a
          g :: C Int c => c -> ()
          f :: T a -> ()
          f (MkT x y) = g x
      Here we get [G] C Int b, [W] C Int a, hence [D] a~b.
      But again f (MkT True True) is a legitimate call.

    (We leave the Deriveds in wc_simple until reportErrors, so that we don't lose
    derived superclasses between iterations of the solver.)

    For functional dependencies, here is a real example,
    stripped off from libraries/utf8-string/Codec/Binary/UTF8/Generic.hs

      class C a b | a -> b
      g :: C a b => a -> b -> ()
      f :: C a b => a -> b -> ()
      f xa xb =
          let loop = g xa
          in loop xb

    We will first try to infer a type for loop, and we will succeed:
        C a b' => b' -> ()
    Subsequently, we will type check (loop xb) and all is good. But,
    recall that we have to solve a final implication constraint:
        C a b => (C a b' => .... cts from body of loop .... ))
    And now we have a problem as we will generate an equality b ~ b' and fail to
    solve it.

    ************************************************************************
    *                                                                      *
                    Irreducible predicate errors
    *                                                                      *
    ************************************************************************
    -}

    mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkIrredErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkIrredErr ReportErrCtxt
    ctxt [Ct]
    cts
      = do { (ReportErrCtxt
    ctxt, SDoc
    binds_msg, Ct
    ct1) <- Bool -> ReportErrCtxt -> Ct -> TcM (ReportErrCtxt, SDoc, Ct)
    relevantBindings Bool
    True ReportErrCtxt
    ctxt Ct
    ct1
           ; let orig :: CtOrigin
    orig = Ct -> CtOrigin
    ctOrigin Ct
    ct1
                 msg :: Report
    msg  = [Implication] -> ([TcType], CtOrigin) -> Report
    couldNotDeduce (ReportErrCtxt -> [Implication]
    getUserGivens ReportErrCtxt
    ctxt) ((Ct -> TcType) -> [Ct] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Ct -> TcType
    ctPred [Ct]
    cts, CtOrigin
    orig)
           ; ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct1 (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $
             Report
    msg Report -> Report -> Report
    forall a. Monoid a => a -> a -> a
    `mappend` SDoc -> Report
    mk_relevant_bindings SDoc
    binds_msg }
      where
        (Ct
    ct1:[Ct]
    _) = [Ct]
    cts

    ----------------
    mkHoleError :: [Ct] -> ReportErrCtxt -> Hole -> TcM (MsgEnvelope DecoratedSDoc)
    mkHoleError :: [Ct] -> ReportErrCtxt -> Hole -> TcM (MsgEnvelope DecoratedSDoc)
    mkHoleError [Ct]
    _tidy_simples ReportErrCtxt
    _ctxt hole :: Hole
    hole@(Hole { hole_occ :: Hole -> OccName
    hole_occ = OccName
    occ
                                               , hole_ty :: Hole -> TcType
    hole_ty = TcType
    hole_ty
                                               , hole_loc :: Hole -> CtLoc
    hole_loc = CtLoc
    ct_loc })
      | Hole -> Bool
    isOutOfScopeHole Hole
    hole
      = do { DynFlags
    dflags  <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; GlobalRdrEnv
    rdr_env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
           ; ImportAvails
    imp_info <- TcRn ImportAvails
    getImports
           ; Module
    curr_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
           ; HomePackageTable
    hpt <- TcRnIf TcGblEnv TcLclEnv HomePackageTable
    forall gbl lcl. TcRnIf gbl lcl HomePackageTable
    getHpt
           ; SrcSpan -> SDoc -> SDoc -> SDoc -> TcM (MsgEnvelope DecoratedSDoc)
    mkDecoratedSDocAt (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (TcLclEnv -> RealSrcSpan
    tcl_loc TcLclEnv
    lcl_env) Maybe BufSpan
    forall a. Maybe a
    Nothing)
                               SDoc
    out_of_scope_msg SDoc
    O.empty
                               (DynFlags
    -> HomePackageTable
    -> Module
    -> GlobalRdrEnv
    -> LocalRdrEnv
    -> ImportAvails
    -> RdrName
    -> SDoc
    unknownNameSuggestions DynFlags
    dflags HomePackageTable
    hpt Module
    curr_mod GlobalRdrEnv
    rdr_env
                                (TcLclEnv -> LocalRdrEnv
    tcl_rdr TcLclEnv
    lcl_env) ImportAvails
    imp_info (OccName -> RdrName
    mkRdrUnqual OccName
    occ)) }
      where
        herald :: SDoc
    herald | OccName -> Bool
    isDataOcc OccName
    occ = String -> SDoc
    text String
    "Data constructor not in scope:"
               | Bool
    otherwise     = String -> SDoc
    text String
    "Variable not in scope:"

        out_of_scope_msg :: SDoc
    out_of_scope_msg -- Print v :: ty only if the type has structure
          | Bool
    boring_type = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ)
          | Bool
    otherwise   = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald Int
    2 (OccName -> TcType -> SDoc
    pp_occ_with_type OccName
    occ TcType
    hole_ty)

        lcl_env :: TcLclEnv
    lcl_env     = CtLoc -> TcLclEnv
    ctLocEnv CtLoc
    ct_loc
        boring_type :: Bool
    boring_type = TcType -> Bool
    isTyVarTy TcType
    hole_ty

     -- general case: not an out-of-scope error
    mkHoleError [Ct]
    tidy_simples ReportErrCtxt
    ctxt hole :: Hole
    hole@(Hole { hole_occ :: Hole -> OccName
    hole_occ = OccName
    occ
                                             , hole_ty :: Hole -> TcType
    hole_ty = TcType
    hole_ty
                                             , hole_sort :: Hole -> HoleSort
    hole_sort = HoleSort
    sort
                                             , hole_loc :: Hole -> CtLoc
    hole_loc = CtLoc
    ct_loc })
      = do { (ReportErrCtxt
    ctxt, SDoc
    binds_msg)
               <- Bool
    -> ReportErrCtxt
    -> TcLclEnv
    -> TyCoVarSet
    -> TcM (ReportErrCtxt, SDoc)
    relevant_bindings Bool
    False ReportErrCtxt
    ctxt TcLclEnv
    lcl_env (TcType -> TyCoVarSet
    tyCoVarsOfType TcType
    hole_ty)
                   -- The 'False' means "don't filter the bindings"; see Trac #8191

           ; Bool
    show_hole_constraints <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_ShowHoleConstraints
           ; let constraints_msg :: SDoc
    constraints_msg
                   | ExprHole HoleExprRef
    _ <- HoleSort
    sort, Bool
    show_hole_constraints
                   = ReportErrCtxt -> SDoc
    givenConstraintsMsg ReportErrCtxt
    ctxt
                   | Bool
    otherwise
                   = SDoc
    empty

           ; Bool
    show_valid_hole_fits <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    Opt_ShowValidHoleFits
           ; (ReportErrCtxt
    ctxt, SDoc
    sub_msg) <- if Bool
    show_valid_hole_fits
                                then ReportErrCtxt -> [Ct] -> Hole -> TcM (ReportErrCtxt, SDoc)
    validHoleFits ReportErrCtxt
    ctxt [Ct]
    tidy_simples Hole
    hole
                                else (ReportErrCtxt, SDoc) -> TcM (ReportErrCtxt, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt, SDoc
    empty)

           ; ReportErrCtxt
    -> TcLclEnv -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorReport ReportErrCtxt
    ctxt TcLclEnv
    lcl_env (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $
                SDoc -> Report
    important SDoc
    hole_msg Report -> Report -> Report
    forall a. Monoid a => a -> a -> a
    `mappend`
                SDoc -> Report
    mk_relevant_bindings (SDoc
    binds_msg SDoc -> SDoc -> SDoc
    $$ SDoc
    constraints_msg) Report -> Report -> Report
    forall a. Monoid a => a -> a -> a
    `mappend`
                SDoc -> Report
    valid_hole_fits SDoc
    sub_msg }

      where
        lcl_env :: TcLclEnv
    lcl_env     = CtLoc -> TcLclEnv
    ctLocEnv CtLoc
    ct_loc
        hole_kind :: TcType
    hole_kind   = HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind TcType
    hole_ty
        tyvars :: [TcId]
    tyvars      = TcType -> [TcId]
    tyCoVarsOfTypeList TcType
    hole_ty

        hole_msg :: SDoc
    hole_msg = case HoleSort
    sort of
          ExprHole HoleExprRef
    _ -> [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Found hole:")
                                Int
    2 (OccName -> TcType -> SDoc
    pp_occ_with_type OccName
    occ TcType
    hole_ty)
                             , SDoc
    tyvars_msg, SDoc
    expr_hole_hint ]
          HoleSort
    TypeHole -> [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Found type wildcard" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ))
                                Int
    2 (String -> SDoc
    text String
    "standing for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    pp_hole_type_with_kind)
                           , SDoc
    tyvars_msg, SDoc
    type_hole_hint ]
          HoleSort
    ConstraintHole -> [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Found extra-constraints wildcard standing for")
                                      Int
    2 (SDoc -> SDoc
    quotes (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ TcType -> SDoc
    pprType TcType
    hole_ty)  -- always kind constraint
                                 , SDoc
    tyvars_msg, SDoc
    type_hole_hint ]

        pp_hole_type_with_kind :: SDoc
    pp_hole_type_with_kind
          | TcType -> Bool
    isLiftedTypeKind TcType
    hole_kind
            Bool -> Bool -> Bool
    || TcType -> Bool
    isCoVarType TcType
    hole_ty -- Don't print the kind of unlifted
                                   -- equalities (#15039)
          = TcType -> SDoc
    pprType TcType
    hole_ty
          | Bool
    otherwise
          = TcType -> SDoc
    pprType TcType
    hole_ty SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprKind TcType
    hole_kind

        tyvars_msg :: SDoc
    tyvars_msg = Bool -> SDoc -> SDoc
    ppUnless ([TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    tyvars) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                     String -> SDoc
    text String
    "Where:" SDoc -> SDoc -> SDoc
    <+> ([SDoc] -> SDoc
    vcat ((TcId -> SDoc) -> [TcId] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map TcId -> SDoc
    loc_msg [TcId]
    other_tvs)
                                        SDoc -> SDoc -> SDoc
    $$ ReportErrCtxt -> [TcId] -> SDoc
    pprSkols ReportErrCtxt
    ctxt [TcId]
    skol_tvs)
           where
             ([TcId]
    skol_tvs, [TcId]
    other_tvs) = (TcId -> Bool) -> [TcId] -> ([TcId], [TcId])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition TcId -> Bool
    is_skol [TcId]
    tyvars
             is_skol :: TcId -> Bool
    is_skol TcId
    tv = TcId -> Bool
    isTcTyVar TcId
    tv Bool -> Bool -> Bool
    && TcId -> Bool
    isSkolemTyVar TcId
    tv
                          -- Coercion variables can be free in the
                          -- hole, via kind casts

        type_hole_hint :: SDoc
    type_hole_hint
             | HoleChoice
    HoleError <- ReportErrCtxt -> HoleChoice
    cec_type_holes ReportErrCtxt
    ctxt
             = String -> SDoc
    text String
    "To use the inferred type, enable PartialTypeSignatures"
             | Bool
    otherwise
             = SDoc
    empty

        expr_hole_hint :: SDoc
    expr_hole_hint                       -- Give hint for, say,   f x = _x
             | FastString -> Int
    lengthFS (OccName -> FastString
    occNameFS OccName
    occ) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1  -- Don't give this hint for plain "_"
             = String -> SDoc
    text String
    "Or perhaps" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (OccName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr OccName
    occ)
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is mis-spelled, or not in scope"
             | Bool
    otherwise
             = SDoc
    empty

        loc_msg :: TcId -> SDoc
    loc_msg TcId
    tv
           | TcId -> Bool
    isTyVar TcId
    tv
           = case TcId -> TcTyVarDetails
    tcTyVarDetails TcId
    tv of
               MetaTv {} -> SDoc -> SDoc
    quotes (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is an ambiguous type variable"
               TcTyVarDetails
    _         -> SDoc
    empty  -- Skolems dealt with already
           | Bool
    otherwise  -- A coercion variable can be free in the hole type
           = (SDocContext -> Bool) -> SDoc -> SDoc
    ppWhenOption SDocContext -> Bool
    sdocPrintExplicitCoercions (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
               SDoc -> SDoc
    quotes (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is a coercion variable"

    pp_occ_with_type :: OccName -> Type -> SDoc
    pp_occ_with_type :: OccName -> TcType -> SDoc
    pp_occ_with_type OccName
    occ TcType
    hole_ty = SDoc -> Int -> SDoc -> SDoc
    hang (OccName -> SDoc
    forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc OccName
    occ) Int
    2 (SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprType TcType
    hole_ty)

    -- We unwrap the ReportErrCtxt here, to avoid introducing a loop in module
    -- imports
    validHoleFits :: ReportErrCtxt -- The context we're in, i.e. the
                                            -- implications and the tidy environment
                           -> [Ct]          -- Unsolved simple constraints
                           -> Hole          -- The hole
                           -> TcM (ReportErrCtxt, SDoc) -- We return the new context
                                                        -- with a possibly updated
                                                        -- tidy environment, and
                                                        -- the message.
    validHoleFits :: ReportErrCtxt -> [Ct] -> Hole -> TcM (ReportErrCtxt, SDoc)
    validHoleFits ctxt :: ReportErrCtxt
    ctxt@(CEC {cec_encl :: ReportErrCtxt -> [Implication]
    cec_encl = [Implication]
    implics
                                 , cec_tidy :: ReportErrCtxt -> TidyEnv
    cec_tidy = TidyEnv
    lcl_env}) [Ct]
    simps Hole
    hole
      = do { (TidyEnv
    tidy_env, SDoc
    msg) <- TidyEnv -> [Implication] -> [Ct] -> Hole -> TcM (TidyEnv, SDoc)
    findValidHoleFits TidyEnv
    lcl_env [Implication]
    implics [Ct]
    simps Hole
    hole
           ; (ReportErrCtxt, SDoc) -> TcM (ReportErrCtxt, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt {cec_tidy :: TidyEnv
    cec_tidy = TidyEnv
    tidy_env}, SDoc
    msg) }

    -- See Note [Constraints include ...]
    givenConstraintsMsg :: ReportErrCtxt -> SDoc
    givenConstraintsMsg :: ReportErrCtxt -> SDoc
    givenConstraintsMsg ReportErrCtxt
    ctxt =
        let constraints :: [(Type, RealSrcSpan)]
            constraints :: [(TcType, RealSrcSpan)]
    constraints =
              do { implic :: Implication
    implic@Implic{ ic_given :: Implication -> [TcId]
    ic_given = [TcId]
    given } <- ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt
                 ; TcId
    constraint <- [TcId]
    given
                 ; (TcType, RealSrcSpan) -> [(TcType, RealSrcSpan)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcId -> TcType
    varType TcId
    constraint, TcLclEnv -> RealSrcSpan
    tcl_loc (Implication -> TcLclEnv
    ic_env Implication
    implic)) }

            pprConstraint :: (a, a) -> SDoc
    pprConstraint (a
    constraint, a
    loc) =
              a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    constraint SDoc -> SDoc -> SDoc
    <+> Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc
    parens (String -> SDoc
    text String
    "from" SDoc -> SDoc -> SDoc
    <+> a -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr a
    loc))

        in Bool -> SDoc -> SDoc
    ppUnless ([(TcType, RealSrcSpan)] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [(TcType, RealSrcSpan)]
    constraints) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
             SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Constraints include")
                Int
    2 ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ ((TcType, RealSrcSpan) -> SDoc)
    -> [(TcType, RealSrcSpan)] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (TcType, RealSrcSpan) -> SDoc
    forall {a} {a}. (Outputable a, Outputable a) => (a, a) -> SDoc
    pprConstraint [(TcType, RealSrcSpan)]
    constraints)

    ----------------
    mkIPErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkIPErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkIPErr ReportErrCtxt
    ctxt [Ct]
    cts
      = do { (ReportErrCtxt
    ctxt, SDoc
    binds_msg, Ct
    ct1) <- Bool -> ReportErrCtxt -> Ct -> TcM (ReportErrCtxt, SDoc, Ct)
    relevantBindings Bool
    True ReportErrCtxt
    ctxt Ct
    ct1
           ; let orig :: CtOrigin
    orig    = Ct -> CtOrigin
    ctOrigin Ct
    ct1
                 preds :: [TcType]
    preds   = (Ct -> TcType) -> [Ct] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map Ct -> TcType
    ctPred [Ct]
    cts
                 givens :: [Implication]
    givens  = ReportErrCtxt -> [Implication]
    getUserGivens ReportErrCtxt
    ctxt
                 msg :: Report
    msg | [Implication] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    givens
                     = SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $ CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                       [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Unbound implicit parameter" SDoc -> SDoc -> SDoc
    <> [Ct] -> SDoc
    forall a. [a] -> SDoc
    plural [Ct]
    cts
                           , Int -> SDoc -> SDoc
    nest Int
    2 ([TcType] -> SDoc
    pprParendTheta [TcType]
    preds) ]
                     | Bool
    otherwise
                     = [Implication] -> ([TcType], CtOrigin) -> Report
    couldNotDeduce [Implication]
    givens ([TcType]
    preds, CtOrigin
    orig)

           ; ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct1 (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $
             Report
    msg Report -> Report -> Report
    forall a. Monoid a => a -> a -> a
    `mappend` SDoc -> Report
    mk_relevant_bindings SDoc
    binds_msg }
      where
        (Ct
    ct1:[Ct]
    _) = [Ct]
    cts

    {-
    Note [Constraints include ...]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    'givenConstraintsMsg' returns the "Constraints include ..." message enabled by
    -fshow-hole-constraints. For example, the following hole:

        foo :: (Eq a, Show a) => a -> String
        foo x = _

    would generate the message:

        Constraints include
          Eq a (from foo.hs:1:1-36)
          Show a (from foo.hs:1:1-36)

    Constraints are displayed in order from innermost (closest to the hole) to
    outermost. There's currently no filtering or elimination of duplicates.

    ************************************************************************
    *                                                                      *
                    Equality errors
    *                                                                      *
    ************************************************************************

    Note [Inaccessible code]
    ~~~~~~~~~~~~~~~~~~~~~~~~
    Consider
       data T a where
         T1 :: T a
         T2 :: T Bool

       f :: (a ~ Int) => T a -> Int
       f T1 = 3
       f T2 = 4   -- Unreachable code

    Here the second equation is unreachable. The original constraint
    (a~Int) from the signature gets rewritten by the pattern-match to
    (Bool~Int), so the danger is that we report the error as coming from
    the *signature* (#7293).  So, for Given errors we replace the
    env (and hence src-loc) on its CtLoc with that from the immediately
    enclosing implication.

    Note [Error messages for untouchables]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (#9109)
      data G a where { GBool :: G Bool }
      foo x = case x of GBool -> True

    Here we can't solve (t ~ Bool), where t is the untouchable result
    meta-var 't', because of the (a ~ Bool) from the pattern match.
    So we infer the type
       f :: forall a t. G a -> t
    making the meta-var 't' into a skolem.  So when we come to report
    the unsolved (t ~ Bool), t won't look like an untouchable meta-var
    any more.  So we don't assert that it is.
    -}

    -- Don't have multiple equality errors from the same location
    -- E.g.   (Int,Bool) ~ (Bool,Int)   one error will do!
    mkEqErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr ReportErrCtxt
    ctxt (Ct
    ct:[Ct]
    _) = ReportErrCtxt -> Ct -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr1 ReportErrCtxt
    ctxt Ct
    ct
    mkEqErr ReportErrCtxt
    _ [] = String -> TcM (MsgEnvelope DecoratedSDoc)
    forall a. String -> a
    panic String
    "mkEqErr"

    mkEqErr1 :: ReportErrCtxt -> Ct -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr1 :: ReportErrCtxt -> Ct -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr1 ReportErrCtxt
    ctxt Ct
    ct   -- Wanted or derived;
                       -- givens handled in mkGivenErrorReporter
      = do { (ReportErrCtxt
    ctxt, SDoc
    binds_msg, Ct
    ct) <- Bool -> ReportErrCtxt -> Ct -> TcM (ReportErrCtxt, SDoc, Ct)
    relevantBindings Bool
    True ReportErrCtxt
    ctxt Ct
    ct
           ; GlobalRdrEnv
    rdr_env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
           ; FamInstEnvs
    fam_envs <- TcM FamInstEnvs
    tcGetFamInstEnvs
           ; let coercible_msg :: SDoc
    coercible_msg = case Ct -> EqRel
    ctEqRel Ct
    ct of
                   EqRel
    NomEq  -> SDoc
    empty
                   EqRel
    ReprEq -> GlobalRdrEnv -> FamInstEnvs -> TcType -> TcType -> SDoc
    mkCoercibleExplanation GlobalRdrEnv
    rdr_env FamInstEnvs
    fam_envs TcType
    ty1 TcType
    ty2
           ; DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; String -> SDoc -> TcM ()
    traceTc String
    "mkEqErr1" (Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct SDoc -> SDoc -> SDoc
    $$ CtOrigin -> SDoc
    pprCtOrigin (Ct -> CtOrigin
    ctOrigin Ct
    ct))
           ; let report :: Report
    report = [Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat [ SDoc -> Report
    important SDoc
    coercible_msg
                                  , SDoc -> Report
    mk_relevant_bindings SDoc
    binds_msg]
           ; DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcType
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr_help DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct TcType
    ty1 TcType
    ty2 }
      where
        (TcType
    ty1, TcType
    ty2) = TcType -> (TcType, TcType)
    getEqPredTys (Ct -> TcType
    ctPred Ct
    ct)

    -- | This function tries to reconstruct why a "Coercible ty1 ty2" constraint
    -- is left over.
    mkCoercibleExplanation :: GlobalRdrEnv -> FamInstEnvs
                           -> TcType -> TcType -> SDoc
    mkCoercibleExplanation :: GlobalRdrEnv -> FamInstEnvs -> TcType -> TcType -> SDoc
    mkCoercibleExplanation GlobalRdrEnv
    rdr_env FamInstEnvs
    fam_envs TcType
    ty1 TcType
    ty2
      | Just (TyCon
    tc, [TcType]
    tys) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty1
      , (TyCon
    rep_tc, [TcType]
    _, Coercion
    _) <- FamInstEnvs -> TyCon -> [TcType] -> (TyCon, [TcType], Coercion)
    tcLookupDataFamInst FamInstEnvs
    fam_envs TyCon
    tc [TcType]
    tys
      , Just SDoc
    msg <- TyCon -> Maybe SDoc
    coercible_msg_for_tycon TyCon
    rep_tc
      = SDoc
    msg
      | Just (TyCon
    tc, [TcType]
    tys) <- HasDebugCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    splitTyConApp_maybe TcType
    ty2
      , (TyCon
    rep_tc, [TcType]
    _, Coercion
    _) <- FamInstEnvs -> TyCon -> [TcType] -> (TyCon, [TcType], Coercion)
    tcLookupDataFamInst FamInstEnvs
    fam_envs TyCon
    tc [TcType]
    tys
      , Just SDoc
    msg <- TyCon -> Maybe SDoc
    coercible_msg_for_tycon TyCon
    rep_tc
      = SDoc
    msg
      | Just (TcType
    s1, TcType
    _) <- TcType -> Maybe (TcType, TcType)
    tcSplitAppTy_maybe TcType
    ty1
      , Just (TcType
    s2, TcType
    _) <- TcType -> Maybe (TcType, TcType)
    tcSplitAppTy_maybe TcType
    ty2
      , TcType
    s1 TcType -> TcType -> Bool
    `eqType` TcType
    s2
      , TcType -> Bool
    has_unknown_roles TcType
    s1
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "NB: We cannot know what roles the parameters to" SDoc -> SDoc -> SDoc
    <+>
              SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    s1) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "have;")
           Int
    2 (String -> SDoc
    text String
    "we must assume that the role is nominal")
      | Bool
    otherwise
      = SDoc
    empty
      where
        coercible_msg_for_tycon :: TyCon -> Maybe SDoc
    coercible_msg_for_tycon TyCon
    tc
            | TyCon -> Bool
    isAbstractTyCon TyCon
    tc
            = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "NB: The type constructor"
                          , SDoc -> SDoc
    quotes (TyCon -> SDoc
    pprSourceTyCon TyCon
    tc)
                          , String -> SDoc
    text String
    "is abstract" ]
            | TyCon -> Bool
    isNewTyCon TyCon
    tc
            , [DataCon
    data_con] <- TyCon -> [DataCon]
    tyConDataCons TyCon
    tc
            , let dc_name :: Name
    dc_name = DataCon -> Name
    dataConName DataCon
    data_con
            , Maybe GlobalRdrElt -> Bool
    forall a. Maybe a -> Bool
    isNothing (GlobalRdrEnv -> Name -> Maybe GlobalRdrElt
    lookupGRE_Name GlobalRdrEnv
    rdr_env Name
    dc_name)
            = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "The data constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    dc_name))
                        Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "of newtype" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    pprSourceTyCon TyCon
    tc)
                               , String -> SDoc
    text String
    "is not in scope" ])
            | Bool
    otherwise = Maybe SDoc
    forall a. Maybe a
    Nothing

        has_unknown_roles :: TcType -> Bool
    has_unknown_roles TcType
    ty
          | Just (TyCon
    tc, [TcType]
    tys) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty
          = [TcType]
    tys [TcType] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthAtLeast` TyCon -> Int
    tyConArity TyCon
    tc  -- oversaturated tycon
          | Just (TcType
    s, TcType
    _) <- TcType -> Maybe (TcType, TcType)
    tcSplitAppTy_maybe TcType
    ty
          = TcType -> Bool
    has_unknown_roles TcType
    s
          | TcType -> Bool
    isTyVarTy TcType
    ty
          = Bool
    True
          | Bool
    otherwise
          = Bool
    False

    mkEqErr_help :: DynFlags -> ReportErrCtxt -> Report
                 -> Ct
                 -> TcType -> TcType -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr_help :: DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcType
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkEqErr_help DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct TcType
    ty1 TcType
    ty2
      | Just (TcId
    tv1, Coercion
    _) <- TcType -> Maybe (TcId, Coercion)
    tcGetCastedTyVar_maybe TcType
    ty1
      = DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcId
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkTyVarEqErr DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct TcId
    tv1 TcType
    ty2
      | Just (TcId
    tv2, Coercion
    _) <- TcType -> Maybe (TcId, Coercion)
    tcGetCastedTyVar_maybe TcType
    ty2
      = DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcId
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkTyVarEqErr DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct TcId
    tv2 TcType
    ty1
      | Bool
    otherwise
      = ReportErrCtxt
    -> Report
    -> Ct
    -> TcType
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    reportEqErr ReportErrCtxt
    ctxt Report
    report Ct
    ct TcType
    ty1 TcType
    ty2

    reportEqErr :: ReportErrCtxt -> Report
                -> Ct
                -> TcType -> TcType -> TcM (MsgEnvelope DecoratedSDoc)
    reportEqErr :: ReportErrCtxt
    -> Report
    -> Ct
    -> TcType
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    reportEqErr ReportErrCtxt
    ctxt Report
    report Ct
    ct TcType
    ty1 TcType
    ty2
      = ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct ([Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat [Report
    misMatch, Report
    report, Report
    eqInfo])
      where
        misMatch :: Report
    misMatch = Bool -> ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchOrCND Bool
    False ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2
        eqInfo :: Report
    eqInfo   = Ct -> TcType -> TcType -> Report
    mkEqInfoMsg Ct
    ct TcType
    ty1 TcType
    ty2

    mkTyVarEqErr, mkTyVarEqErr'
      :: DynFlags -> ReportErrCtxt -> Report -> Ct
                 -> TcTyVar -> TcType -> TcM (MsgEnvelope DecoratedSDoc)
    -- tv1 and ty2 are already tidied
    mkTyVarEqErr :: DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcId
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkTyVarEqErr DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct TcId
    tv1 TcType
    ty2
      = do { String -> SDoc -> TcM ()
    traceTc String
    "mkTyVarEqErr" (Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct SDoc -> SDoc -> SDoc
    $$ TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv1 SDoc -> SDoc -> SDoc
    $$ TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2)
           ; DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcId
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkTyVarEqErr' DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct TcId
    tv1 TcType
    ty2 }

    mkTyVarEqErr' :: DynFlags
    -> ReportErrCtxt
    -> Report
    -> Ct
    -> TcId
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    mkTyVarEqErr' DynFlags
    dflags ReportErrCtxt
    ctxt Report
    report Ct
    ct TcId
    tv1 TcType
    ty2
         -- impredicativity is a simple error to understand; try it first
      | CheckTyEqResult
    check_eq_result CheckTyEqResult -> CheckTyEqProblem -> Bool
    `cterHasProblem` CheckTyEqProblem
    cteImpredicative
      = let msg :: SDoc
    msg = [SDoc] -> SDoc
    vcat [ (if TcId -> Bool
    isSkolemTyVar TcId
    tv1
                          then String -> SDoc
    text String
    "Cannot equate type variable"
                          else String -> SDoc
    text String
    "Cannot instantiate unification variable")
                         SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv1)
                       , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "with a" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "involving polytypes:") Int
    2 (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2) ]
        in
           -- Unlike the other reports, this discards the old 'report_important'
           -- instead of augmenting it.  This is because the details are not likely
           -- to be helpful since this is just an unimplemented feature.
        ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $ [Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat
            [ Report
    headline_msg
            , SDoc -> Report
    important SDoc
    msg
            , if TcId -> Bool
    isSkolemTyVar TcId
    tv1 then ReportErrCtxt -> TcId -> TcType -> Report
    extraTyVarEqInfo ReportErrCtxt
    ctxt TcId
    tv1 TcType
    ty2 else Report
    forall a. Monoid a => a
    mempty
            , Report
    report ]

      | TcId -> Bool
    isSkolemTyVar TcId
    tv1  -- ty2 won't be a meta-tyvar; we would have
                           -- swapped in Solver.Canonical.canEqTyVarHomo
        Bool -> Bool -> Bool
    || TcId -> Bool
    isTyVarTyVar TcId
    tv1 Bool -> Bool -> Bool
    && Bool -> Bool
    not (TcType -> Bool
    isTyVarTy TcType
    ty2)
        Bool -> Bool -> Bool
    || Ct -> EqRel
    ctEqRel Ct
    ct EqRel -> EqRel -> Bool
    forall a. Eq a => a -> a -> Bool
    == EqRel
    ReprEq
         -- The cases below don't really apply to ReprEq (except occurs check)
      = ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $ [Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat
            [ Report
    headline_msg
            , ReportErrCtxt -> TcId -> TcType -> Report
    extraTyVarEqInfo ReportErrCtxt
    ctxt TcId
    tv1 TcType
    ty2
            , ReportErrCtxt -> TcType -> TcType -> Report
    suggestAddSig ReportErrCtxt
    ctxt TcType
    ty1 TcType
    ty2
            , Report
    report
            ]

      | CheckTyEqResult -> Bool
    cterHasOccursCheck CheckTyEqResult
    check_eq_result
        -- We report an "occurs check" even for  a ~ F t a, where F is a type
        -- function; it's not insoluble (because in principle F could reduce)
        -- but we have certainly been unable to solve it
        -- See Note [Occurs check error] in GHC.Tc.Solver.Canonical
      = do { let extra2 :: Report
    extra2   = Ct -> TcType -> TcType -> Report
    mkEqInfoMsg Ct
    ct TcType
    ty1 TcType
    ty2

                 interesting_tyvars :: [TcId]
    interesting_tyvars = (TcId -> Bool) -> [TcId] -> [TcId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (TcId -> Bool) -> TcId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcType -> Bool
    noFreeVarsOfType (TcType -> Bool) -> (TcId -> TcType) -> TcId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcId -> TcType
    tyVarKind) ([TcId] -> [TcId]) -> [TcId] -> [TcId]
    forall a b. (a -> b) -> a -> b
    $
                                      (TcId -> Bool) -> [TcId] -> [TcId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter TcId -> Bool
    isTyVar ([TcId] -> [TcId]) -> [TcId] -> [TcId]
    forall a b. (a -> b) -> a -> b
    $
                                      FV -> [TcId]
    fvVarList (FV -> [TcId]) -> FV -> [TcId]
    forall a b. (a -> b) -> a -> b
    $
                                      TcType -> FV
    tyCoFVsOfType TcType
    ty1 FV -> FV -> FV
    `unionFV` TcType -> FV
    tyCoFVsOfType TcType
    ty2
                 extra3 :: Report
    extra3 = SDoc -> Report
    mk_relevant_bindings (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $
                          Bool -> SDoc -> SDoc
    ppWhen (Bool -> Bool
    not ([TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    interesting_tyvars)) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                          SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Type variable kinds:") Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                          [SDoc] -> SDoc
    vcat ((TcId -> SDoc) -> [TcId] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (TcId -> SDoc
    tyvar_binding (TcId -> SDoc) -> (TcId -> TcId) -> TcId -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TidyEnv -> TcId -> TcId
    tidyTyCoVarOcc (ReportErrCtxt -> TidyEnv
    cec_tidy ReportErrCtxt
    ctxt))
                                    [TcId]
    interesting_tyvars)

                 tyvar_binding :: TcId -> SDoc
    tyvar_binding TcId
    tv = TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcId -> TcType
    tyVarKind TcId
    tv)
           ; ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $
             [Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat [Report
    headline_msg, Report
    extra2, Report
    extra3, Report
    report] }

      -- If the immediately-enclosing implication has 'tv' a skolem, and
      -- we know by now its an InferSkol kind of skolem, then presumably
      -- it started life as a TyVarTv, else it'd have been unified, given
      -- that there's no occurs-check or forall problem
      | (Implication
    implic:[Implication]
    _) <- ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt
      , Implic { ic_skols :: Implication -> [TcId]
    ic_skols = [TcId]
    skols } <- Implication
    implic
      , TcId
    tv1 TcId -> [TcId] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [TcId]
    skols
      = ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $ [Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat
            [ ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchMsg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2
            , ReportErrCtxt -> TcId -> TcType -> Report
    extraTyVarEqInfo ReportErrCtxt
    ctxt TcId
    tv1 TcType
    ty2
            , Report
    report
            ]

      -- Check for skolem escape
      | (Implication
    implic:[Implication]
    _) <- ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt   -- Get the innermost context
      , Implic { ic_skols :: Implication -> [TcId]
    ic_skols = [TcId]
    skols, ic_info :: Implication -> SkolemInfo
    ic_info = SkolemInfo
    skol_info } <- Implication
    implic
      , let esc_skols :: [TcId]
    esc_skols = (TcId -> Bool) -> [TcId] -> [TcId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (TcId -> TyCoVarSet -> Bool
    `elemVarSet` (TcType -> TyCoVarSet
    tyCoVarsOfType TcType
    ty2)) [TcId]
    skols
      , Bool -> Bool
    not ([TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    esc_skols)
      = do { let msg :: Report
    msg = ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchMsg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2
                 esc_doc :: SDoc
    esc_doc = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "because" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable" SDoc -> SDoc -> SDoc
    <> [TcId] -> SDoc
    forall a. [a] -> SDoc
    plural [TcId]
    esc_skols
                                 SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcId]
    esc_skols
                               , String -> SDoc
    text String
    "would escape" SDoc -> SDoc -> SDoc
    <+>
                                 if [TcId] -> Bool
    forall a. [a] -> Bool
    isSingleton [TcId]
    esc_skols then String -> SDoc
    text String
    "its scope"
                                                          else String -> SDoc
    text String
    "their scope" ]
                 tv_extra :: Report
    tv_extra = SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $
                            [SDoc] -> SDoc
    vcat [ Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc
    esc_doc
                                 , [SDoc] -> SDoc
    sep [ (if [TcId] -> Bool
    forall a. [a] -> Bool
    isSingleton [TcId]
    esc_skols
                                          then String -> SDoc
    text String
    "This (rigid, skolem)" SDoc -> SDoc -> SDoc
    <+>
                                               SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable is"
                                          else String -> SDoc
    text String
    "These (rigid, skolem)" SDoc -> SDoc -> SDoc
    <+>
                                               SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variables are")
                                   SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "bound by"
                                 , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info
                                 , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+>
                                   RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    tcl_loc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ] ]
           ; ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct ([Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat [Report
    msg, Report
    tv_extra, Report
    report]) }

      -- Nastiest case: attempt to unify an untouchable variable
      -- So tv is a meta tyvar (or started that way before we
      -- generalised it).  So presumably it is an *untouchable*
      -- meta tyvar or a TyVarTv, else it'd have been unified
      -- See Note [Error messages for untouchables]
      | (Implication
    implic:[Implication]
    _) <- ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt   -- Get the innermost context
      , Implic { ic_given :: Implication -> [TcId]
    ic_given = [TcId]
    given, ic_tclvl :: Implication -> TcLevel
    ic_tclvl = TcLevel
    lvl, ic_info :: Implication -> SkolemInfo
    ic_info = SkolemInfo
    skol_info } <- Implication
    implic
      = ASSERT2( not (isTouchableMetaTyVar lvl tv1)
               , ppr tv1 $$ ppr lvl )  -- See Note [Error messages for untouchables]
        do { let msg :: Report
    msg = ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchMsg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2
                 tclvl_extra :: Report
    tclvl_extra = SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $
                      Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                      [SDoc] -> SDoc
    sep [ SDoc -> SDoc
    quotes (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv1) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is untouchable"
                          , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "inside the constraints:" SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    pprEvVarTheta [TcId]
    given
                          , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "bound by" SDoc -> SDoc -> SDoc
    <+> SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info
                          , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+>
                            RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    tcl_loc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ]
                 tv_extra :: Report
    tv_extra = ReportErrCtxt -> TcId -> TcType -> Report
    extraTyVarEqInfo ReportErrCtxt
    ctxt TcId
    tv1 TcType
    ty2
                 add_sig :: Report
    add_sig  = ReportErrCtxt -> TcType -> TcType -> Report
    suggestAddSig ReportErrCtxt
    ctxt TcType
    ty1 TcType
    ty2
           ; ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct (Report -> TcM (MsgEnvelope DecoratedSDoc))
    -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $ [Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat
                [Report
    msg, Report
    tclvl_extra, Report
    tv_extra, Report
    add_sig, Report
    report] }

      | Bool
    otherwise
      = ReportErrCtxt
    -> Report
    -> Ct
    -> TcType
    -> TcType
    -> TcM (MsgEnvelope DecoratedSDoc)
    reportEqErr ReportErrCtxt
    ctxt Report
    report Ct
    ct (TcId -> TcType
    mkTyVarTy TcId
    tv1) TcType
    ty2
            -- This *can* happen (#6123)
            -- Consider an ambiguous top-level constraint (a ~ F a)
            -- Not an occurs check, because F is a type function.
      where
        headline_msg :: Report
    headline_msg = Bool -> ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchOrCND Bool
    insoluble_occurs_check ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2

        ty1 :: TcType
    ty1 = TcId -> TcType
    mkTyVarTy TcId
    tv1

        check_eq_result :: CheckTyEqResult
    check_eq_result = case Ct
    ct of
          CIrredCan { cc_reason :: Ct -> CtIrredReason
    cc_reason = NonCanonicalReason CheckTyEqResult
    result } -> CheckTyEqResult
    result
          CIrredCan { cc_reason :: Ct -> CtIrredReason
    cc_reason = HoleBlockerReason {} }      -> CheckTyEqProblem -> CheckTyEqResult
    cteProblem CheckTyEqProblem
    cteHoleBlocker
          Ct
    _ -> DynFlags -> TcId -> TcType -> CheckTyEqResult
    checkTyVarEq DynFlags
    dflags TcId
    tv1 TcType
    ty2
            -- in T2627b, we report an error for F (F a0) ~ a0. Note that the type
            -- variable is on the right, so we don't get useful info for the CIrredCan,
            -- and have to compute the result of checkTyVarEq here.

        insoluble_occurs_check :: Bool
    insoluble_occurs_check = CheckTyEqResult
    check_eq_result CheckTyEqResult -> CheckTyEqProblem -> Bool
    `cterHasProblem` CheckTyEqProblem
    cteInsolubleOccurs

        what :: SDoc
    what = String -> SDoc
    text (String -> SDoc) -> String -> SDoc
    forall a b. (a -> b) -> a -> b
    $ TypeOrKind -> String
    levelString (TypeOrKind -> String) -> TypeOrKind -> String
    forall a b. (a -> b) -> a -> b
    $
               CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe (Ct -> CtLoc
    ctLoc Ct
    ct) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel

    levelString :: TypeOrKind -> String
    levelString :: TypeOrKind -> String
    levelString TypeOrKind
    TypeLevel = String
    "type"
    levelString TypeOrKind
    KindLevel = String
    "kind"

    mkEqInfoMsg :: Ct -> TcType -> TcType -> Report
    -- Report (a) ambiguity if either side is a type function application
    --            e.g. F a0 ~ Int
    --        (b) warning about injectivity if both sides are the same
    --            type function application   F a ~ F b
    --            See Note [Non-injective type functions]
    mkEqInfoMsg :: Ct -> TcType -> TcType -> Report
    mkEqInfoMsg Ct
    ct TcType
    ty1 TcType
    ty2
      = SDoc -> Report
    important (SDoc
    tyfun_msg SDoc -> SDoc -> SDoc
    $$ SDoc
    ambig_msg)
      where
        mb_fun1 :: Maybe TyCon
    mb_fun1 = TcType -> Maybe TyCon
    isTyFun_maybe TcType
    ty1
        mb_fun2 :: Maybe TyCon
    mb_fun2 = TcType -> Maybe TyCon
    isTyFun_maybe TcType
    ty2

        ambig_msg :: SDoc
    ambig_msg | Maybe TyCon -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe TyCon
    mb_fun1 Bool -> Bool -> Bool
    || Maybe TyCon -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe TyCon
    mb_fun2
                  = (Bool, SDoc) -> SDoc
    forall a b. (a, b) -> b
    snd (Bool -> Ct -> (Bool, SDoc)
    mkAmbigMsg Bool
    False Ct
    ct)
                  | Bool
    otherwise = SDoc
    empty

        tyfun_msg :: SDoc
    tyfun_msg | Just TyCon
    tc1 <- Maybe TyCon
    mb_fun1
                  , Just TyCon
    tc2 <- Maybe TyCon
    mb_fun2
                  , TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
                  , Bool -> Bool
    not (TyCon -> Role -> Bool
    isInjectiveTyCon TyCon
    tc1 Role
    Nominal)
                  = String -> SDoc
    text String
    "NB:" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TyCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCon
    tc1)
                    SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is a non-injective type family"
                  | Bool
    otherwise = SDoc
    empty

    misMatchOrCND :: Bool -> ReportErrCtxt -> Ct
                  -> TcType -> TcType -> Report
    -- If oriented then ty1 is actual, ty2 is expected
    misMatchOrCND :: Bool -> ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchOrCND Bool
    insoluble_occurs_check ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2
      | Bool
    insoluble_occurs_check  -- See Note [Insoluble occurs check]
        Bool -> Bool -> Bool
    || (TcType -> Bool
    isRigidTy TcType
    ty1 Bool -> Bool -> Bool
    && TcType -> Bool
    isRigidTy TcType
    ty2)
        Bool -> Bool -> Bool
    || Ct -> Bool
    isGivenCt Ct
    ct
        Bool -> Bool -> Bool
    || [Implication] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    givens
      = -- If the equality is unconditionally insoluble
        -- or there is no context, don't report the context
        ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchMsg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2

      | Bool
    otherwise
      = [Report] -> Report
    forall a. Monoid a => [a] -> a
    mconcat [ [Implication] -> ([TcType], CtOrigin) -> Report
    couldNotDeduce [Implication]
    givens ([TcType
    eq_pred], CtOrigin
    orig)
                , SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $ ReportErrCtxt -> TypeOrKind -> TcType -> TcType -> CtOrigin -> SDoc
    mk_supplementary_ea_msg ReportErrCtxt
    ctxt TypeOrKind
    level TcType
    ty1 TcType
    ty2 CtOrigin
    orig ]
      where
        ev :: CtEvidence
    ev      = Ct -> CtEvidence
    ctEvidence Ct
    ct
        eq_pred :: TcType
    eq_pred = CtEvidence -> TcType
    ctEvPred CtEvidence
    ev
        orig :: CtOrigin
    orig    = CtEvidence -> CtOrigin
    ctEvOrigin CtEvidence
    ev
        level :: TypeOrKind
    level   = CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe (CtEvidence -> CtLoc
    ctEvLoc CtEvidence
    ev) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel
        givens :: [Implication]
    givens  = [ Implication
    given | Implication
    given <- ReportErrCtxt -> [Implication]
    getUserGivens ReportErrCtxt
    ctxt, Implication -> HasGivenEqs
    ic_given_eqs Implication
    given HasGivenEqs -> HasGivenEqs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HasGivenEqs
    NoGivenEqs ]
                  -- Keep only UserGivens that have some equalities.
                  -- See Note [Suppress redundant givens during error reporting]

    couldNotDeduce :: [UserGiven] -> (ThetaType, CtOrigin) -> Report
    couldNotDeduce :: [Implication] -> ([TcType], CtOrigin) -> Report
    couldNotDeduce [Implication]
    givens ([TcType]
    wanteds, CtOrigin
    orig)
      = SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $
        [SDoc] -> SDoc
    vcat [ CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (String -> SDoc
    text String
    "Could not deduce:" SDoc -> SDoc -> SDoc
    <+> [TcType] -> SDoc
    pprTheta [TcType]
    wanteds)
             , [SDoc] -> SDoc
    vcat ([Implication] -> [SDoc]
    pp_givens [Implication]
    givens)]

    pp_givens :: [UserGiven] -> [SDoc]
    pp_givens :: [Implication] -> [SDoc]
    pp_givens [Implication]
    givens
       = case [Implication]
    givens of
             []     -> []
             (Implication
    g:[Implication]
    gs) ->      SDoc -> Implication -> SDoc
    ppr_given (String -> SDoc
    text String
    "from the context:") Implication
    g
                     SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (Implication -> SDoc) -> [Implication] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SDoc -> Implication -> SDoc
    ppr_given (String -> SDoc
    text String
    "or from:")) [Implication]
    gs
        where
           ppr_given :: SDoc -> Implication -> SDoc
    ppr_given SDoc
    herald implic :: Implication
    implic@(Implic { ic_given :: Implication -> [TcId]
    ic_given = [TcId]
    gs, ic_info :: Implication -> SkolemInfo
    ic_info = SkolemInfo
    skol_info })
               = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc
    herald SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    pprEvVarTheta ((TcId -> TcType) -> [TcId] -> [TcId]
    forall a. (a -> TcType) -> [a] -> [a]
    mkMinimalBySCs TcId -> TcType
    evVarPred [TcId]
    gs))
                 -- See Note [Suppress redundant givens during error reporting]
                 -- for why we use mkMinimalBySCs above.
                    Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "bound by" SDoc -> SDoc -> SDoc
    <+> SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info
                           , String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+> RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    tcl_loc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ])

    -- These are for the "blocked" equalities, as described in TcCanonical
    -- Note [Equalities with incompatible kinds], wrinkle (2). There should
    -- always be another unsolved wanted around, which will ordinarily suppress
    -- this message. But this can still be printed out with -fdefer-type-errors
    -- (sigh), so we must produce a message.
    mkBlockedEqErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkBlockedEqErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkBlockedEqErr ReportErrCtxt
    ctxt (Ct
    ct:[Ct]
    _) = ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct Report
    report
      where
        report :: Report
    report = SDoc -> Report
    important SDoc
    msg
        msg :: SDoc
    msg = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Cannot use equality for substitution:")
                       Int
    2 (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Ct -> TcType
    ctPred Ct
    ct))
                   , String -> SDoc
    text String
    "Doing so would be ill-kinded." ]
              -- This is a terrible message. Perhaps worse, if the user
              -- has -fprint-explicit-kinds on, they will see that the two
              -- sides have the same kind, as there is an invisible cast.
              -- I really don't know how to do better.
    mkBlockedEqErr ReportErrCtxt
    _ [] = String -> TcM (MsgEnvelope DecoratedSDoc)
    forall a. String -> a
    panic String
    "mkBlockedEqErr no constraints"

    {-
    Note [Suppress redundant givens during error reporting]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When GHC is unable to solve a constraint and prints out an error message, it
    will print out what given constraints are in scope to provide some context to
    the programmer. But we shouldn't print out /every/ given, since some of them
    are not terribly helpful to diagnose type errors. Consider this example:

      foo :: Int :~: Int -> a :~: b -> a :~: c
      foo Refl Refl = Refl

    When reporting that GHC can't solve (a ~ c), there are two givens in scope:
    (Int ~ Int) and (a ~ b). But (Int ~ Int) is trivially soluble (i.e.,
    redundant), so it's not terribly useful to report it in an error message.
    To accomplish this, we discard any Implications that do not bind any
    equalities by filtering the `givens` selected in `misMatchOrCND` (based on
    the `ic_given_eqs` field of the Implication). Note that we discard givens
    that have no equalities whatsoever, but we want to keep ones with only *local*
    equalities, as these may be helpful to the user in understanding what went
    wrong.

    But this is not enough to avoid all redundant givens! Consider this example,
    from #15361:

      goo :: forall (a :: Type) (b :: Type) (c :: Type).
             a :~~: b -> a :~~: c
      goo HRefl = HRefl

    Matching on HRefl brings the /single/ given (* ~ *, a ~ b) into scope.
    The (* ~ *) part arises due the kinds of (:~~:) being unified. More
    importantly, (* ~ *) is redundant, so we'd like not to report it. However,
    the Implication (* ~ *, a ~ b) /does/ bind an equality (as reported by its
    ic_given_eqs field), so the test above will keep it wholesale.

    To refine this given, we apply mkMinimalBySCs on it to extract just the (a ~ b)
    part. This works because mkMinimalBySCs eliminates reflexive equalities in
    addition to superclasses (see Note [Remove redundant provided dicts]
    in GHC.Tc.TyCl.PatSyn).
    -}

    extraTyVarEqInfo :: ReportErrCtxt -> TcTyVar -> TcType -> Report
    -- Add on extra info about skolem constants
    -- NB: The types themselves are already tidied
    extraTyVarEqInfo :: ReportErrCtxt -> TcId -> TcType -> Report
    extraTyVarEqInfo ReportErrCtxt
    ctxt TcId
    tv1 TcType
    ty2
      = SDoc -> Report
    important (ReportErrCtxt -> TcId -> SDoc
    extraTyVarInfo ReportErrCtxt
    ctxt TcId
    tv1 SDoc -> SDoc -> SDoc
    $$ TcType -> SDoc
    ty_extra TcType
    ty2)
      where
        ty_extra :: TcType -> SDoc
    ty_extra TcType
    ty = case TcType -> Maybe (TcId, Coercion)
    tcGetCastedTyVar_maybe TcType
    ty of
                        Just (TcId
    tv, Coercion
    _) -> ReportErrCtxt -> TcId -> SDoc
    extraTyVarInfo ReportErrCtxt
    ctxt TcId
    tv
                        Maybe (TcId, Coercion)
    Nothing      -> SDoc
    empty

    extraTyVarInfo :: ReportErrCtxt -> TcTyVar -> SDoc
    extraTyVarInfo :: ReportErrCtxt -> TcId -> SDoc
    extraTyVarInfo ReportErrCtxt
    ctxt TcId
    tv
      = ASSERT2( isTyVar tv, ppr tv )
        case TcId -> TcTyVarDetails
    tcTyVarDetails TcId
    tv of
              SkolemTv {}   -> ReportErrCtxt -> [TcId] -> SDoc
    pprSkols ReportErrCtxt
    ctxt [TcId
    tv]
              RuntimeUnk {} -> SDoc -> SDoc
    quotes (TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    tv) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is an interactive-debugger skolem"
              MetaTv {}     -> SDoc
    empty

    suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Report
    -- See Note [Suggest adding a type signature]
    suggestAddSig :: ReportErrCtxt -> TcType -> TcType -> Report
    suggestAddSig ReportErrCtxt
    ctxt TcType
    ty1 TcType
    _ty2
      | [Name] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Name]
    inferred_bndrs   -- No let-bound inferred binders in context
      = Report
    forall a. Monoid a => a
    mempty
      | [Name
    bndr] <- [Name]
    inferred_bndrs
      = SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Possible fix: add a type signature for" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    bndr)
      | Bool
    otherwise
      = SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Possible fix: add type signatures for some or all of" SDoc -> SDoc -> SDoc
    <+> ([Name] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Name]
    inferred_bndrs)
      where
        inferred_bndrs :: [Name]
    inferred_bndrs = case TcType -> Maybe TcId
    tcGetTyVar_maybe TcType
    ty1 of
                           Just TcId
    tv | TcId -> Bool
    isSkolemTyVar TcId
    tv -> [Implication] -> Bool -> TcId -> [Name]
    find (ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt) Bool
    False TcId
    tv
                           Maybe TcId
    _                          -> []

        -- 'find' returns the binders of an InferSkol for 'tv',
        -- provided there is an intervening implication with
        -- ic_given_eqs /= NoGivenEqs (i.e. a GADT match)
        find :: [Implication] -> Bool -> TcId -> [Name]
    find [] Bool
    _ TcId
    _ = []
        find (Implication
    implic:[Implication]
    implics) Bool
    seen_eqs TcId
    tv
           | TcId
    tv TcId -> [TcId] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Implication -> [TcId]
    ic_skols Implication
    implic
           , InferSkol [(Name, TcType)]
    prs <- Implication -> SkolemInfo
    ic_info Implication
    implic
           , Bool
    seen_eqs
           = ((Name, TcType) -> Name) -> [(Name, TcType)] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name, TcType) -> Name
    forall a b. (a, b) -> a
    fst [(Name, TcType)]
    prs
           | Bool
    otherwise
           = [Implication] -> Bool -> TcId -> [Name]
    find [Implication]
    implics (Bool
    seen_eqs Bool -> Bool -> Bool
    || Implication -> HasGivenEqs
    ic_given_eqs Implication
    implic HasGivenEqs -> HasGivenEqs -> Bool
    forall a. Eq a => a -> a -> Bool
    /= HasGivenEqs
    NoGivenEqs) TcId
    tv

    --------------------
    misMatchMsg :: ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    -- Types are already tidy
    -- If oriented then ty1 is actual, ty2 is expected
    misMatchMsg :: ReportErrCtxt -> Ct -> TcType -> TcType -> Report
    misMatchMsg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2
      = SDoc -> Report
    important (SDoc -> Report) -> SDoc -> Report
    forall a b. (a -> b) -> a -> b
    $
        CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
        TcType -> TcType -> CtOrigin -> SDoc -> SDoc
    pprWithExplicitKindsWhenMismatch TcType
    ty1 TcType
    ty2 CtOrigin
    orig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
        [SDoc] -> SDoc
    sep [ case CtOrigin
    orig of
                TypeEqOrigin {} -> ReportErrCtxt -> Ct -> TcType -> TcType -> CtOrigin -> SDoc
    tk_eq_msg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2 CtOrigin
    orig
                KindEqOrigin {} -> ReportErrCtxt -> Ct -> TcType -> TcType -> CtOrigin -> SDoc
    tk_eq_msg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2 CtOrigin
    orig
                CtOrigin
    _ -> Bool -> Ct -> TcType -> TcType -> SDoc
    headline_eq_msg Bool
    False Ct
    ct TcType
    ty1 TcType
    ty2
            , TcType -> TcType -> SDoc
    sameOccExtra TcType
    ty2 TcType
    ty1 ]
      where
        orig :: CtOrigin
    orig = Ct -> CtOrigin
    ctOrigin Ct
    ct

    headline_eq_msg :: Bool -> Ct -> Type -> Type -> SDoc
    -- Generates the main "Could't match 't1' against 't2'
    -- headline message
    headline_eq_msg :: Bool -> Ct -> TcType -> TcType -> SDoc
    headline_eq_msg Bool
    add_ea Ct
    ct TcType
    ty1 TcType
    ty2

      | (TcType -> Bool
    isLiftedRuntimeRep TcType
    ty1 Bool -> Bool -> Bool
    && TcType -> Bool
    isUnliftedRuntimeRep TcType
    ty2) Bool -> Bool -> Bool
    ||
        (TcType -> Bool
    isLiftedRuntimeRep TcType
    ty2 Bool -> Bool -> Bool
    && TcType -> Bool
    isUnliftedRuntimeRep TcType
    ty1) Bool -> Bool -> Bool
    ||
        (TcType -> Bool
    isLiftedLevity TcType
    ty1 Bool -> Bool -> Bool
    && TcType -> Bool
    isUnliftedLevity TcType
    ty2) Bool -> Bool -> Bool
    ||
        (TcType -> Bool
    isLiftedLevity TcType
    ty2 Bool -> Bool -> Bool
    && TcType -> Bool
    isUnliftedLevity TcType
    ty1)
      = String -> SDoc
    text String
    "Couldn't match a lifted type with an unlifted type"

      | TcType -> Bool
    isAtomicTy TcType
    ty1 Bool -> Bool -> Bool
    || TcType -> Bool
    isAtomicTy TcType
    ty2
      = -- Print with quotes
        [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    herald1 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty1)
            , Int -> SDoc -> SDoc
    nest Int
    padding (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
              String -> SDoc
    text String
    herald2 SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2) ]

      | Bool
    otherwise
      = -- Print with vertical layout
        [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    herald1 SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty1
             , Int -> SDoc -> SDoc
    nest Int
    padding (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
               String -> SDoc
    text String
    herald2 SDoc -> SDoc -> SDoc
    <> SDoc
    colon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty2 ]
      where
        herald1 :: String
    herald1 = [String] -> String
    conc [ String
    "Couldn't match"
                       , if Bool
    is_repr then String
    "representation of" else String
    ""
                       , if Bool
    add_ea then String
    "expected"          else String
    ""
                       , String
    what ]
        herald2 :: String
    herald2 = [String] -> String
    conc [ String
    "with"
                       , if Bool
    is_repr then String
    "that of"          else String
    ""
                       , if Bool
    add_ea then (String
    "actual " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    what) else String
    "" ]

        padding :: Int
    padding = String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    herald1 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    herald2

        is_repr :: Bool
    is_repr = case Ct -> EqRel
    ctEqRel Ct
    ct of { EqRel
    ReprEq -> Bool
    True; EqRel
    NomEq -> Bool
    False }

        what :: String
    what = TypeOrKind -> String
    levelString (CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe (Ct -> CtLoc
    ctLoc Ct
    ct) Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel)

        conc :: [String] -> String
        conc :: [String] -> String
    conc = (String -> String -> String) -> [String] -> String
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 String -> String -> String
    add_space

        add_space :: String -> String -> String
        add_space :: String -> String -> String
    add_space String
    s1 String
    s2 | String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s1   = String
    s2
                        | String -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null String
    s2   = String
    s1
                        | Bool
    otherwise = String
    s1 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ (Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    : String
    s2)

    tk_eq_msg :: ReportErrCtxt
              -> Ct -> Type -> Type -> CtOrigin -> SDoc
    tk_eq_msg :: ReportErrCtxt -> Ct -> TcType -> TcType -> CtOrigin -> SDoc
    tk_eq_msg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2 orig :: CtOrigin
    orig@(TypeEqOrigin { uo_actual :: CtOrigin -> TcType
    uo_actual = TcType
    act
                                                 , uo_expected :: CtOrigin -> TcType
    uo_expected = TcType
    exp
                                                 , uo_thing :: CtOrigin -> Maybe SDoc
    uo_thing = Maybe SDoc
    mb_thing })
      -- We can use the TypeEqOrigin to
      -- improve the error message quite a lot

      | TcType -> Bool
    isUnliftedTypeKind TcType
    act, TcType -> Bool
    isLiftedTypeKind TcType
    exp
      = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Expecting a lifted type, but"
            , Maybe SDoc -> SDoc -> SDoc -> SDoc
    thing_msg Maybe SDoc
    mb_thing (String -> SDoc
    text String
    "an") (String -> SDoc
    text String
    "unlifted") ]

      | TcType -> Bool
    isLiftedTypeKind TcType
    act, TcType -> Bool
    isUnliftedTypeKind TcType
    exp
      = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Expecting an unlifted type, but"
            , Maybe SDoc -> SDoc -> SDoc -> SDoc
    thing_msg Maybe SDoc
    mb_thing (String -> SDoc
    text String
    "a") (String -> SDoc
    text String
    "lifted") ]

      | TcType -> Bool
    tcIsLiftedTypeKind TcType
    exp
      = SDoc
    maybe_num_args_msg SDoc -> SDoc -> SDoc
    $$
        [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Expected a type, but"
            , case Maybe SDoc
    mb_thing of
                Maybe SDoc
    Nothing    -> String -> SDoc
    text String
    "found something with kind"
                Just SDoc
    thing -> SDoc -> SDoc
    quotes SDoc
    thing SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has kind"
            , SDoc -> SDoc
    quotes (TcType -> SDoc
    pprWithTYPE TcType
    act) ]

      | Just SDoc
    nargs_msg <- Maybe SDoc
    num_args_msg
      = SDoc
    nargs_msg SDoc -> SDoc -> SDoc
    $$
        ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
    mk_ea_msg ReportErrCtxt
    ctxt (Ct -> Maybe Ct
    forall a. a -> Maybe a
    Just Ct
    ct) TypeOrKind
    level CtOrigin
    orig

      | -- pprTrace "check" (ppr ea_looks_same $$ ppr exp $$ ppr act $$ ppr ty1 $$ ppr ty2) $
        TcType -> TcType -> TcType -> TcType -> Bool
    ea_looks_same TcType
    ty1 TcType
    ty2 TcType
    exp TcType
    act
      = ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
    mk_ea_msg ReportErrCtxt
    ctxt (Ct -> Maybe Ct
    forall a. a -> Maybe a
    Just Ct
    ct) TypeOrKind
    level CtOrigin
    orig

      | Bool
    otherwise  -- The mismatched types are /inside/ exp and act
      = [SDoc] -> SDoc
    vcat [ Bool -> Ct -> TcType -> TcType -> SDoc
    headline_eq_msg Bool
    False Ct
    ct TcType
    ty1 TcType
    ty2
             , ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
    mk_ea_msg ReportErrCtxt
    ctxt Maybe Ct
    forall a. Maybe a
    Nothing TypeOrKind
    level CtOrigin
    orig ]

      where
        ct_loc :: CtLoc
    ct_loc = Ct -> CtLoc
    ctLoc Ct
    ct
        level :: TypeOrKind
    level  = CtLoc -> Maybe TypeOrKind
    ctLocTypeOrKind_maybe CtLoc
    ct_loc Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel

        thing_msg :: Maybe SDoc -> SDoc -> SDoc -> SDoc
    thing_msg (Just SDoc
    thing) SDoc
    _  SDoc
    levity = SDoc -> SDoc
    quotes SDoc
    thing SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is" SDoc -> SDoc -> SDoc
    <+> SDoc
    levity
        thing_msg Maybe SDoc
    Nothing      SDoc
    an SDoc
    levity = String -> SDoc
    text String
    "got" SDoc -> SDoc -> SDoc
    <+> SDoc
    an SDoc -> SDoc -> SDoc
    <+> SDoc
    levity SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "type"

        num_args_msg :: Maybe SDoc
    num_args_msg = case TypeOrKind
    level of
          TypeOrKind
    KindLevel
            | Bool -> Bool
    not (TcType -> Bool
    isMetaTyVarTy TcType
    exp) Bool -> Bool -> Bool
    && Bool -> Bool
    not (TcType -> Bool
    isMetaTyVarTy TcType
    act)
               -- if one is a meta-tyvar, then it's possible that the user
               -- has asked for something impredicative, and we couldn't unify.
               -- Don't bother with counting arguments.
            -> let n_act :: Int
    n_act = TcType -> Int
    count_args TcType
    act
                   n_exp :: Int
    n_exp = TcType -> Int
    count_args TcType
    exp in
               case Int
    n_act Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    n_exp of
                 Int
    n | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0   -- we don't know how many args there are, so don't
                             -- recommend removing args that aren't
                   , Just SDoc
    thing <- Maybe SDoc
    mb_thing
                   -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Expecting" SDoc -> SDoc -> SDoc
    <+> Int -> SDoc
    speakN (Int -> Int
    forall a. Num a => a -> a
    abs Int
    n) SDoc -> SDoc -> SDoc
    <+>
                             SDoc
    more SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    thing
                   where
                     more :: SDoc
    more
                      | Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1    = String -> SDoc
    text String
    "more argument to"
                      | Bool
    otherwise = String -> SDoc
    text String
    "more arguments to"  -- n > 1
                 Int
    _ -> Maybe SDoc
    forall a. Maybe a
    Nothing

          TypeOrKind
    _ -> Maybe SDoc
    forall a. Maybe a
    Nothing

        maybe_num_args_msg :: SDoc
    maybe_num_args_msg = Maybe SDoc
    num_args_msg Maybe SDoc -> SDoc -> SDoc
    forall a. Maybe a -> a -> a
    `orElse` SDoc
    empty

        count_args :: TcType -> Int
    count_args TcType
    ty = (TyCoBinder -> Bool) -> [TyCoBinder] -> Int
    forall a. (a -> Bool) -> [a] -> Int
    count TyCoBinder -> Bool
    isVisibleBinder ([TyCoBinder] -> Int) -> [TyCoBinder] -> Int
    forall a b. (a -> b) -> a -> b
    $ ([TyCoBinder], TcType) -> [TyCoBinder]
    forall a b. (a, b) -> a
    fst (([TyCoBinder], TcType) -> [TyCoBinder])
    -> ([TyCoBinder], TcType) -> [TyCoBinder]
    forall a b. (a -> b) -> a -> b
    $ TcType -> ([TyCoBinder], TcType)
    splitPiTys TcType
    ty

    tk_eq_msg ReportErrCtxt
    ctxt Ct
    ct TcType
    ty1 TcType
    ty2
              (KindEqOrigin TcType
    cty1 TcType
    cty2 CtOrigin
    sub_o Maybe TypeOrKind
    mb_sub_t_or_k)
      = [SDoc] -> SDoc
    vcat [ Bool -> Ct -> TcType -> TcType -> SDoc
    headline_eq_msg Bool
    False Ct
    ct TcType
    ty1 TcType
    ty2
             , SDoc
    supplementary_msg ]
      where
        sub_t_or_k :: TypeOrKind
    sub_t_or_k = Maybe TypeOrKind
    mb_sub_t_or_k Maybe TypeOrKind -> TypeOrKind -> TypeOrKind
    forall a. Maybe a -> a -> a
    `orElse` TypeOrKind
    TypeLevel
        sub_whats :: SDoc
    sub_whats  = String -> SDoc
    text (TypeOrKind -> String
    levelString TypeOrKind
    sub_t_or_k) SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    's'
                     -- "types" or "kinds"

        supplementary_msg :: SDoc
    supplementary_msg
          = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintExplicitCoercions ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Bool
    printExplicitCoercions ->
            if Bool
    printExplicitCoercions
               Bool -> Bool -> Bool
    || Bool -> Bool
    not (TcType
    cty1 TcType -> TcType -> Bool
    `pickyEqType` TcType
    cty2)
              then [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "When matching" SDoc -> SDoc -> SDoc
    <+> SDoc
    sub_whats)
                              Int
    2 ([SDoc] -> SDoc
    vcat [ TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    cty1 SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+>
                                       TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind TcType
    cty1)
                                     , TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    cty2 SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+>
                                       TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind TcType
    cty2) ])
                        , ReportErrCtxt -> TypeOrKind -> TcType -> TcType -> CtOrigin -> SDoc
    mk_supplementary_ea_msg ReportErrCtxt
    ctxt TypeOrKind
    sub_t_or_k TcType
    cty1 TcType
    cty2 CtOrigin
    sub_o ]
              else String -> SDoc
    text String
    "When matching the kind of" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    cty1)

    tk_eq_msg ReportErrCtxt
    _ Ct
    _ TcType
    _ TcType
    _ CtOrigin
    _ = String -> SDoc
    forall a. String -> a
    panic String
    "typeeq_mismatch_msg"

    ea_looks_same :: Type -> Type -> Type -> Type -> Bool
    -- True if the faulting types (ty1, ty2) look the same as
    -- the expected/actual types (exp, act).
    -- If so, we don't want to redundantly report the latter
    ea_looks_same :: TcType -> TcType -> TcType -> TcType -> Bool
    ea_looks_same TcType
    ty1 TcType
    ty2 TcType
    exp TcType
    act
      = (TcType
    act TcType -> TcType -> Bool
    `looks_same` TcType
    ty1 Bool -> Bool -> Bool
    && TcType
    exp TcType -> TcType -> Bool
    `looks_same` TcType
    ty2) Bool -> Bool -> Bool
    ||
        (TcType
    exp TcType -> TcType -> Bool
    `looks_same` TcType
    ty1 Bool -> Bool -> Bool
    && TcType
    act TcType -> TcType -> Bool
    `looks_same` TcType
    ty2)
      where
        looks_same :: TcType -> TcType -> Bool
    looks_same TcType
    t1 TcType
    t2 = TcType
    t1 TcType -> TcType -> Bool
    `pickyEqType` TcType
    t2
                        Bool -> Bool -> Bool
    || TcType
    t1 TcType -> TcType -> Bool
    `eqType` TcType
    liftedTypeKind Bool -> Bool -> Bool
    && TcType
    t2 TcType -> TcType -> Bool
    `eqType` TcType
    liftedTypeKind
          -- pickyEqType is sensitive to synonyms, so only replies True
          -- when the types really look the same.  However,
          -- (TYPE 'LiftedRep) and Type both print the same way.

    mk_supplementary_ea_msg :: ReportErrCtxt -> TypeOrKind
                            -> Type -> Type -> CtOrigin -> SDoc
    mk_supplementary_ea_msg :: ReportErrCtxt -> TypeOrKind -> TcType -> TcType -> CtOrigin -> SDoc
    mk_supplementary_ea_msg ReportErrCtxt
    ctxt TypeOrKind
    level TcType
    ty1 TcType
    ty2 CtOrigin
    orig
      | TypeEqOrigin { uo_expected :: CtOrigin -> TcType
    uo_expected = TcType
    exp, uo_actual :: CtOrigin -> TcType
    uo_actual = TcType
    act } <- CtOrigin
    orig
      , Bool -> Bool
    not (TcType -> TcType -> TcType -> TcType -> Bool
    ea_looks_same TcType
    ty1 TcType
    ty2 TcType
    exp TcType
    act)
      = ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
    mk_ea_msg ReportErrCtxt
    ctxt Maybe Ct
    forall a. Maybe a
    Nothing TypeOrKind
    level CtOrigin
    orig
      | Bool
    otherwise
      = SDoc
    empty

    mk_ea_msg :: ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
    -- Constructs a "Couldn't match" message
    -- The (Maybe Ct) says whether this is the main top-level message (Just)
    --     or a supplementary message (Nothing)
    mk_ea_msg :: ReportErrCtxt -> Maybe Ct -> TypeOrKind -> CtOrigin -> SDoc
    mk_ea_msg ReportErrCtxt
    ctxt Maybe Ct
    at_top TypeOrKind
    level
              (TypeEqOrigin { uo_actual :: CtOrigin -> TcType
    uo_actual = TcType
    act, uo_expected :: CtOrigin -> TcType
    uo_expected = TcType
    exp, uo_thing :: CtOrigin -> Maybe SDoc
    uo_thing = Maybe SDoc
    mb_thing })
      | Just SDoc
    thing <- Maybe SDoc
    mb_thing
      , TypeOrKind
    KindLevel <- TypeOrKind
    level
      = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Expected" SDoc -> SDoc -> SDoc
    <+> SDoc
    kind_desc SDoc -> SDoc -> SDoc
    <> SDoc
    comma)
           Int
    2 (String -> SDoc
    text String
    "but" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes SDoc
    thing SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "has kind" SDoc -> SDoc -> SDoc
    <+>
              SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    act))

      | Bool
    otherwise
      = [SDoc] -> SDoc
    vcat [ case Maybe Ct
    at_top of
                  Just Ct
    ct -> Bool -> Ct -> TcType -> TcType -> SDoc
    headline_eq_msg Bool
    True Ct
    ct TcType
    exp TcType
    act
                  Maybe Ct
    Nothing -> SDoc
    supplementary_ea_msg
             , Bool -> SDoc -> SDoc
    ppWhen Bool
    expand_syns SDoc
    expandedTys ]

      where
        supplementary_ea_msg :: SDoc
    supplementary_ea_msg = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Expected:" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    exp
                                    , String -> SDoc
    text String
    "  Actual:" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    act ]

        kind_desc :: SDoc
    kind_desc | TcType -> Bool
    tcIsConstraintKind TcType
    exp = String -> SDoc
    text String
    "a constraint"
                  | Just TcType
    arg <- HasDebugCallStack => TcType -> Maybe TcType
    TcType -> Maybe TcType
    kindRep_maybe TcType
    exp  -- TYPE t0
                  , TcType -> Bool
    tcIsTyVarTy TcType
    arg = (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintExplicitRuntimeReps ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \case
                                       Bool
    True  -> String -> SDoc
    text String
    "kind" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    exp)
                                       Bool
    False -> String -> SDoc
    text String
    "a type"
                  | Bool
    otherwise       = String -> SDoc
    text String
    "kind" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    exp)

        expand_syns :: Bool
    expand_syns = ReportErrCtxt -> Bool
    cec_expand_syns ReportErrCtxt
    ctxt

        expandedTys :: SDoc
    expandedTys = Bool -> SDoc -> SDoc
    ppUnless (TcType
    expTy1 TcType -> TcType -> Bool
    `pickyEqType` TcType
    exp Bool -> Bool -> Bool
    && TcType
    expTy2 TcType -> TcType -> Bool
    `pickyEqType` TcType
    act) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [SDoc] -> SDoc
    vcat
                      [ String -> SDoc
    text String
    "Type synonyms expanded:"
                      , String -> SDoc
    text String
    "Expected type:" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    expTy1
                      , String -> SDoc
    text String
    "  Actual type:" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    expTy2 ]

        (TcType
    expTy1, TcType
    expTy2) = TcType -> TcType -> (TcType, TcType)
    expandSynonymsToMatch TcType
    exp TcType
    act

    mk_ea_msg ReportErrCtxt
    _ Maybe Ct
    _ TypeOrKind
    _ CtOrigin
    _ = SDoc
    empty

    -- | Prints explicit kinds (with @-fprint-explicit-kinds@) in an 'SDoc' when a
    -- type mismatch occurs to due invisible kind arguments.
    --
    -- This function first checks to see if the 'CtOrigin' argument is a
    -- 'TypeEqOrigin', and if so, uses the expected/actual types from that to
    -- check for a kind mismatch (as these types typically have more surrounding
    -- types and are likelier to be able to glean information about whether a
    -- mismatch occurred in an invisible argument position or not). If the
    -- 'CtOrigin' is not a 'TypeEqOrigin', fall back on the actual mismatched types
    -- themselves.
    pprWithExplicitKindsWhenMismatch :: Type -> Type -> CtOrigin
                                     -> SDoc -> SDoc
    pprWithExplicitKindsWhenMismatch :: TcType -> TcType -> CtOrigin -> SDoc -> SDoc
    pprWithExplicitKindsWhenMismatch TcType
    ty1 TcType
    ty2 CtOrigin
    ct
      = Bool -> SDoc -> SDoc
    pprWithExplicitKindsWhen Bool
    show_kinds
      where
        (TcType
    act_ty, TcType
    exp_ty) = case CtOrigin
    ct of
          TypeEqOrigin { uo_actual :: CtOrigin -> TcType
    uo_actual = TcType
    act
                       , uo_expected :: CtOrigin -> TcType
    uo_expected = TcType
    exp } -> (TcType
    act, TcType
    exp)
          CtOrigin
    _                                  -> (TcType
    ty1, TcType
    ty2)
        show_kinds :: Bool
    show_kinds = TcType -> TcType -> Bool
    tcEqTypeVis TcType
    act_ty TcType
    exp_ty
                     -- True when the visible bit of the types look the same,
                     -- so we want to show the kinds in the displayed type

    {- Note [Insoluble occurs check]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider [G] a ~ [a],  [W] a ~ [a] (#13674).  The Given is insoluble
    so we don't use it for rewriting.  The Wanted is also insoluble, and
    we don't solve it from the Given.  It's very confusing to say
        Cannot solve a ~ [a] from given constraints a ~ [a]

    And indeed even thinking about the Givens is silly; [W] a ~ [a] is
    just as insoluble as Int ~ Bool.

    Conclusion: if there's an insoluble occurs check (cteInsolubleOccurs)
    then report it directly, not in the "cannot deduce X from Y" form.
    This is done in misMatchOrCND (via the insoluble_occurs_check arg)

    (NB: there are potentially-soluble ones, like (a ~ F a b), and we don't
    want to be as draconian with them.)

    Note [Expanding type synonyms to make types similar]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    In type error messages, if -fprint-expanded-types is used, we want to expand
    type synonyms to make expected and found types as similar as possible, but we
    shouldn't expand types too much to make type messages even more verbose and
    harder to understand. The whole point here is to make the difference in expected
    and found types clearer.

    `expandSynonymsToMatch` does this, it takes two types, and expands type synonyms
    only as much as necessary. Given two types t1 and t2:

      * If they're already same, it just returns the types.

      * If they're in form `C1 t1_1 .. t1_n` and `C2 t2_1 .. t2_m` (C1 and C2 are
        type constructors), it expands C1 and C2 if they're different type synonyms.
        Then it recursively does the same thing on expanded types. If C1 and C2 are
        same, then it applies the same procedure to arguments of C1 and arguments of
        C2 to make them as similar as possible.

        Most important thing here is to keep number of synonym expansions at
        minimum. For example, if t1 is `T (T3, T5, Int)` and t2 is `T (T5, T3,
        Bool)` where T5 = T4, T4 = T3, ..., T1 = X, it returns `T (T3, T3, Int)` and
        `T (T3, T3, Bool)`.

      * Otherwise types don't have same shapes and so the difference is clearly
        visible. It doesn't do any expansions and show these types.

    Note that we only expand top-layer type synonyms. Only when top-layer
    constructors are the same we start expanding inner type synonyms.

    Suppose top-layer type synonyms of t1 and t2 can expand N and M times,
    respectively. If their type-synonym-expanded forms will meet at some point (i.e.
    will have same shapes according to `sameShapes` function), it's possible to find
    where they meet in O(N+M) top-layer type synonym expansions and O(min(N,M))
    comparisons. We first collect all the top-layer expansions of t1 and t2 in two
    lists, then drop the prefix of the longer list so that they have same lengths.
    Then we search through both lists in parallel, and return the first pair of
    types that have same shapes. Inner types of these two types with same shapes
    are then expanded using the same algorithm.

    In case they don't meet, we return the last pair of types in the lists, which
    has top-layer type synonyms completely expanded. (in this case the inner types
    are not expanded at all, as the current form already shows the type error)
    -}

    -- | Expand type synonyms in given types only enough to make them as similar as
    -- possible. Returned types are the same in terms of used type synonyms.
    --
    -- To expand all synonyms, see 'Type.expandTypeSynonyms'.
    --
    -- See `ExpandSynsFail` tests in tests testsuite/tests/typecheck/should_fail for
    -- some examples of how this should work.
    expandSynonymsToMatch :: Type -> Type -> (Type, Type)
    expandSynonymsToMatch :: TcType -> TcType -> (TcType, TcType)
    expandSynonymsToMatch TcType
    ty1 TcType
    ty2 = (TcType
    ty1_ret, TcType
    ty2_ret)
      where
        (TcType
    ty1_ret, TcType
    ty2_ret) = TcType -> TcType -> (TcType, TcType)
    go TcType
    ty1 TcType
    ty2

        -- | Returns (type synonym expanded version of first type,
        --            type synonym expanded version of second type)
        go :: Type -> Type -> (Type, Type)
        go :: TcType -> TcType -> (TcType, TcType)
    go TcType
    t1 TcType
    t2
          | TcType
    t1 TcType -> TcType -> Bool
    `pickyEqType` TcType
    t2 =
            -- Types are same, nothing to do
            (TcType
    t1, TcType
    t2)

        go (TyConApp TyCon
    tc1 [TcType]
    tys1) (TyConApp TyCon
    tc2 [TcType]
    tys2)
          | TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
          , [TcType]
    tys1 [TcType] -> [TcType] -> Bool
    forall a b. [a] -> [b] -> Bool
    `equalLength` [TcType]
    tys2 =
            -- Type constructors are same. They may be synonyms, but we don't
            -- expand further. The lengths of tys1 and tys2 must be equal;
            -- for example, with type S a = a, we don't want
            -- to zip (S Monad Int) and (S Bool).
            let ([TcType]
    tys1', [TcType]
    tys2') =
                  [(TcType, TcType)] -> ([TcType], [TcType])
    forall a b. [(a, b)] -> ([a], [b])
    unzip (String
    -> (TcType -> TcType -> (TcType, TcType))
    -> [TcType]
    -> [TcType]
    -> [(TcType, TcType)]
    forall a b c. String -> (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithEqual String
    "expandSynonymsToMatch" TcType -> TcType -> (TcType, TcType)
    go [TcType]
    tys1 [TcType]
    tys2)
             in (TyCon -> [TcType] -> TcType
    TyConApp TyCon
    tc1 [TcType]
    tys1', TyCon -> [TcType] -> TcType
    TyConApp TyCon
    tc2 [TcType]
    tys2')

        go (AppTy TcType
    t1_1 TcType
    t1_2) (AppTy TcType
    t2_1 TcType
    t2_2) =
          let (TcType
    t1_1', TcType
    t2_1') = TcType -> TcType -> (TcType, TcType)
    go TcType
    t1_1 TcType
    t2_1
              (TcType
    t1_2', TcType
    t2_2') = TcType -> TcType -> (TcType, TcType)
    go TcType
    t1_2 TcType
    t2_2
           in (TcType -> TcType -> TcType
    mkAppTy TcType
    t1_1' TcType
    t1_2', TcType -> TcType -> TcType
    mkAppTy TcType
    t2_1' TcType
    t2_2')

        go ty1 :: TcType
    ty1@(FunTy AnonArgFlag
    _ TcType
    w1 TcType
    t1_1 TcType
    t1_2) ty2 :: TcType
    ty2@(FunTy AnonArgFlag
    _ TcType
    w2 TcType
    t2_1 TcType
    t2_2) | TcType
    w1 TcType -> TcType -> Bool
    `eqType` TcType
    w2 =
          let (TcType
    t1_1', TcType
    t2_1') = TcType -> TcType -> (TcType, TcType)
    go TcType
    t1_1 TcType
    t2_1
              (TcType
    t1_2', TcType
    t2_2') = TcType -> TcType -> (TcType, TcType)
    go TcType
    t1_2 TcType
    t2_2
           in ( TcType
    ty1 { ft_arg :: TcType
    ft_arg = TcType
    t1_1', ft_res :: TcType
    ft_res = TcType
    t1_2' }
              , TcType
    ty2 { ft_arg :: TcType
    ft_arg = TcType
    t2_1', ft_res :: TcType
    ft_res = TcType
    t2_2' })

        go (ForAllTy TyCoVarBinder
    b1 TcType
    t1) (ForAllTy TyCoVarBinder
    b2 TcType
    t2) =
          -- NOTE: We may have a bug here, but we just can't reproduce it easily.
          -- See D1016 comments for details and our attempts at producing a test
          -- case. Short version: We probably need RnEnv2 to really get this right.
          let (TcType
    t1', TcType
    t2') = TcType -> TcType -> (TcType, TcType)
    go TcType
    t1 TcType
    t2
           in (TyCoVarBinder -> TcType -> TcType
    ForAllTy TyCoVarBinder
    b1 TcType
    t1', TyCoVarBinder -> TcType -> TcType
    ForAllTy TyCoVarBinder
    b2 TcType
    t2')

        go (CastTy TcType
    ty1 Coercion
    _) TcType
    ty2 = TcType -> TcType -> (TcType, TcType)
    go TcType
    ty1 TcType
    ty2
        go TcType
    ty1 (CastTy TcType
    ty2 Coercion
    _) = TcType -> TcType -> (TcType, TcType)
    go TcType
    ty1 TcType
    ty2

        go TcType
    t1 TcType
    t2 =
          -- See Note [Expanding type synonyms to make types similar] for how this
          -- works
          let
            t1_exp_tys :: [TcType]
    t1_exp_tys = TcType
    t1 TcType -> [TcType] -> [TcType]
    forall a. a -> [a] -> [a]
    : TcType -> [TcType]
    tyExpansions TcType
    t1
            t2_exp_tys :: [TcType]
    t2_exp_tys = TcType
    t2 TcType -> [TcType] -> [TcType]
    forall a. a -> [a] -> [a]
    : TcType -> [TcType]
    tyExpansions TcType
    t2
            t1_exps :: Int
    t1_exps    = [TcType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TcType]
    t1_exp_tys
            t2_exps :: Int
    t2_exps    = [TcType] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TcType]
    t2_exp_tys
            dif :: Int
    dif        = Int -> Int
    forall a. Num a => a -> a
    abs (Int
    t1_exps Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    t2_exps)
          in
            [(TcType, TcType)] -> (TcType, TcType)
    followExpansions ([(TcType, TcType)] -> (TcType, TcType))
    -> [(TcType, TcType)] -> (TcType, TcType)
    forall a b. (a -> b) -> a -> b
    $
              String -> [TcType] -> [TcType] -> [(TcType, TcType)]
    forall a b. String -> [a] -> [b] -> [(a, b)]
    zipEqual String
    "expandSynonymsToMatch.go"
                (if Int
    t1_exps Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    t2_exps then Int -> [TcType] -> [TcType]
    forall a. Int -> [a] -> [a]
    drop Int
    dif [TcType]
    t1_exp_tys else [TcType]
    t1_exp_tys)
                (if Int
    t2_exps Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    t1_exps then Int -> [TcType] -> [TcType]
    forall a. Int -> [a] -> [a]
    drop Int
    dif [TcType]
    t2_exp_tys else [TcType]
    t2_exp_tys)

        -- | Expand the top layer type synonyms repeatedly, collect expansions in a
        -- list. The list does not include the original type.
        --
        -- Example, if you have:
        --
        --   type T10 = T9
        --   type T9  = T8
        --   ...
        --   type T0  = Int
        --
        -- `tyExpansions T10` returns [T9, T8, T7, ... Int]
        --
        -- This only expands the top layer, so if you have:
        --
        --   type M a = Maybe a
        --
        -- `tyExpansions (M T10)` returns [Maybe T10] (T10 is not expanded)
        tyExpansions :: Type -> [Type]
        tyExpansions :: TcType -> [TcType]
    tyExpansions = (TcType -> Maybe (TcType, TcType)) -> TcType -> [TcType]
    forall b a. (b -> Maybe (a, b)) -> b -> [a]
    unfoldr (\TcType
    t -> (\TcType
    x -> (TcType
    x, TcType
    x)) (TcType -> (TcType, TcType))
    -> Maybe TcType -> Maybe (TcType, TcType)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` TcType -> Maybe TcType
    tcView TcType
    t)

        -- | Drop the type pairs until types in a pair look alike (i.e. the outer
        -- constructors are the same).
        followExpansions :: [(Type, Type)] -> (Type, Type)
        followExpansions :: [(TcType, TcType)] -> (TcType, TcType)
    followExpansions [] = String -> SDoc -> (TcType, TcType)
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "followExpansions" SDoc
    empty
        followExpansions [(TcType
    t1, TcType
    t2)]
          | TcType -> TcType -> Bool
    sameShapes TcType
    t1 TcType
    t2 = TcType -> TcType -> (TcType, TcType)
    go TcType
    t1 TcType
    t2 -- expand subtrees
          | Bool
    otherwise        = (TcType
    t1, TcType
    t2) -- the difference is already visible
        followExpansions ((TcType
    t1, TcType
    t2) : [(TcType, TcType)]
    tss)
          -- Traverse subtrees when the outer shapes are the same
          | TcType -> TcType -> Bool
    sameShapes TcType
    t1 TcType
    t2 = TcType -> TcType -> (TcType, TcType)
    go TcType
    t1 TcType
    t2
          -- Otherwise follow the expansions until they look alike
          | Bool
    otherwise = [(TcType, TcType)] -> (TcType, TcType)
    followExpansions [(TcType, TcType)]
    tss

        sameShapes :: Type -> Type -> Bool
        sameShapes :: TcType -> TcType -> Bool
    sameShapes AppTy{}          AppTy{}          = Bool
    True
        sameShapes (TyConApp TyCon
    tc1 [TcType]
    _) (TyConApp TyCon
    tc2 [TcType]
    _) = TyCon
    tc1 TyCon -> TyCon -> Bool
    forall a. Eq a => a -> a -> Bool
    == TyCon
    tc2
        sameShapes (FunTy {})       (FunTy {})       = Bool
    True
        sameShapes (ForAllTy {})    (ForAllTy {})    = Bool
    True
        sameShapes (CastTy TcType
    ty1 Coercion
    _)   TcType
    ty2              = TcType -> TcType -> Bool
    sameShapes TcType
    ty1 TcType
    ty2
        sameShapes TcType
    ty1              (CastTy TcType
    ty2 Coercion
    _)   = TcType -> TcType -> Bool
    sameShapes TcType
    ty1 TcType
    ty2
        sameShapes TcType
    _                TcType
    _                = Bool
    False

    sameOccExtra :: TcType -> TcType -> SDoc
    -- See Note [Disambiguating (X ~ X) errors]
    sameOccExtra :: TcType -> TcType -> SDoc
    sameOccExtra TcType
    ty1 TcType
    ty2
      | Just (TyCon
    tc1, [TcType]
    _) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty1
      , Just (TyCon
    tc2, [TcType]
    _) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty2
      , let n1 :: Name
    n1 = TyCon -> Name
    tyConName TyCon
    tc1
            n2 :: Name
    n2 = TyCon -> Name
    tyConName TyCon
    tc2
            same_occ :: Bool
    same_occ = Name -> OccName
    nameOccName Name
    n1                   OccName -> OccName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> OccName
    nameOccName Name
    n2
            same_pkg :: Bool
    same_pkg = Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit (HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    n1) Unit -> Unit -> Bool
    forall a. Eq a => a -> a -> Bool
    == Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit (HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    n2)
      , Name
    n1 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name
    n2   -- Different Names
      , Bool
    same_occ   -- but same OccName
      = String -> SDoc
    text String
    "NB:" SDoc -> SDoc -> SDoc
    <+> (Bool -> Name -> SDoc
    ppr_from Bool
    same_pkg Name
    n1 SDoc -> SDoc -> SDoc
    $$ Bool -> Name -> SDoc
    ppr_from Bool
    same_pkg Name
    n2)
      | Bool
    otherwise
      = SDoc
    empty
      where
        ppr_from :: Bool -> Name -> SDoc
    ppr_from Bool
    same_pkg Name
    nm
          | SrcSpan -> Bool
    isGoodSrcSpan SrcSpan
    loc
          = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    nm) SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "is defined at")
               Int
    2 (SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    loc)
          | Bool
    otherwise  -- Imported things have an UnhelpfulSrcSpan
          = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc -> SDoc
    quotes (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    nm))
               Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "is defined in" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (ModuleName -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod))
                      , Bool -> SDoc -> SDoc
    ppUnless (Bool
    same_pkg Bool -> Bool -> Bool
    || Unit
    pkg Unit -> Unit -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unit
    mainUnit) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                        Int -> SDoc -> SDoc
    nest Int
    4 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "in package" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (Unit -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unit
    pkg) ])
           where
             pkg :: Unit
    pkg = Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod
             mod :: Module
    mod = HasDebugCallStack => Name -> Module
    Name -> Module
    nameModule Name
    nm
             loc :: SrcSpan
    loc = Name -> SrcSpan
    nameSrcSpan Name
    nm

    {- Note [Suggest adding a type signature]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The OutsideIn algorithm rejects GADT programs that don't have a principal
    type, and indeed some that do.  Example:
       data T a where
         MkT :: Int -> T Int

       f (MkT n) = n

    Does this have type f :: T a -> a, or f :: T a -> Int?
    The error that shows up tends to be an attempt to unify an
    untouchable type variable.  So suggestAddSig sees if the offending
    type variable is bound by an *inferred* signature, and suggests
    adding a declared signature instead.

    More specifically, we suggest adding a type sig if we have p ~ ty, and
    p is a skolem bound by an InferSkol.  Those skolems were created from
    unification variables in simplifyInfer.  Why didn't we unify?  It must
    have been because of an intervening GADT or existential, making it
    untouchable. Either way, a type signature would help.  For GADTs, it
    might make it typeable; for existentials the attempt to write a
    signature will fail -- or at least will produce a better error message
    next time

    This initially came up in #8968, concerning pattern synonyms.

    Note [Disambiguating (X ~ X) errors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    See #8278

    Note [Reporting occurs-check errors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Given (a ~ [a]), if 'a' is a rigid type variable bound by a user-supplied
    type signature, then the best thing is to report that we can't unify
    a with [a], because a is a skolem variable.  That avoids the confusing
    "occur-check" error message.

    But nowadays when inferring the type of a function with no type signature,
    even if there are errors inside, we still generalise its signature and
    carry on. For example
       f x = x:x
    Here we will infer something like
       f :: forall a. a -> [a]
    with a deferred error of (a ~ [a]).  So in the deferred unsolved constraint
    'a' is now a skolem, but not one bound by the programmer in the context!
    Here we really should report an occurs check.

    So isUserSkolem distinguishes the two.

    Note [Non-injective type functions]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It's very confusing to get a message like
         Couldn't match expected type `Depend s'
                against inferred type `Depend s1'
    so mkTyFunInfoMsg adds:
           NB: `Depend' is type function, and hence may not be injective

    Warn of loopy local equalities that were dropped.

    ************************************************************************
    *                                                                      *
                     Type-class errors
    *                                                                      *
    ************************************************************************
    -}

    mkDictErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkDictErr :: ReportErrCtxt -> [Ct] -> TcM (MsgEnvelope DecoratedSDoc)
    mkDictErr ReportErrCtxt
    ctxt [Ct]
    cts
      = ASSERT( not (null cts) )
        do { InstEnvs
    inst_envs <- TcM InstEnvs
    tcGetInstEnvs
           ; let (Ct
    ct1:[Ct]
    _) = [Ct]
    cts  -- ct1 just for its location
                 min_cts :: [Ct]
    min_cts = [Ct] -> [Ct]
    elim_superclasses [Ct]
    cts
                 lookups :: [(Ct, ClsInstLookupResult)]
    lookups = (Ct -> (Ct, ClsInstLookupResult))
    -> [Ct] -> [(Ct, ClsInstLookupResult)]
    forall a b. (a -> b) -> [a] -> [b]
    map (InstEnvs -> Ct -> (Ct, ClsInstLookupResult)
    lookup_cls_inst InstEnvs
    inst_envs) [Ct]
    min_cts
                 ([(Ct, ClsInstLookupResult)]
    no_inst_cts, [(Ct, ClsInstLookupResult)]
    overlap_cts) = ((Ct, ClsInstLookupResult) -> Bool)
    -> [(Ct, ClsInstLookupResult)]
    -> ([(Ct, ClsInstLookupResult)], [(Ct, ClsInstLookupResult)])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (Ct, ClsInstLookupResult) -> Bool
    is_no_inst [(Ct, ClsInstLookupResult)]
    lookups

           -- Report definite no-instance errors,
           -- or (iff there are none) overlap errors
           -- But we report only one of them (hence 'head') because they all
           -- have the same source-location origin, to try avoid a cascade
           -- of error from one location
           ; (ReportErrCtxt
    ctxt, SDoc
    err) <- ReportErrCtxt
    -> (Ct, ClsInstLookupResult) -> TcM (ReportErrCtxt, SDoc)
    mk_dict_err ReportErrCtxt
    ctxt ([(Ct, ClsInstLookupResult)] -> (Ct, ClsInstLookupResult)
    forall a. [a] -> a
    head ([(Ct, ClsInstLookupResult)]
    no_inst_cts [(Ct, ClsInstLookupResult)]
    -> [(Ct, ClsInstLookupResult)] -> [(Ct, ClsInstLookupResult)]
    forall a. [a] -> [a] -> [a]
    ++ [(Ct, ClsInstLookupResult)]
    overlap_cts))
           ; ReportErrCtxt -> Ct -> Report -> TcM (MsgEnvelope DecoratedSDoc)
    mkErrorMsgFromCt ReportErrCtxt
    ctxt Ct
    ct1 (SDoc -> Report
    important SDoc
    err) }
      where
        no_givens :: Bool
    no_givens = [Implication] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (ReportErrCtxt -> [Implication]
    getUserGivens ReportErrCtxt
    ctxt)

        is_no_inst :: (Ct, ClsInstLookupResult) -> Bool
    is_no_inst (Ct
    ct, ([InstMatch]
    matches, [ClsInst]
    unifiers, [InstMatch]
    _))
          =  Bool
    no_givens
          Bool -> Bool -> Bool
    && [InstMatch] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [InstMatch]
    matches
          Bool -> Bool -> Bool
    && ([ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers Bool -> Bool -> Bool
    || (TcId -> Bool) -> [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all (Bool -> Bool
    not (Bool -> Bool) -> (TcId -> Bool) -> TcId -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcId -> Bool
    isAmbiguousTyVar) (Ct -> [TcId]
    tyCoVarsOfCtList Ct
    ct))

        lookup_cls_inst :: InstEnvs -> Ct -> (Ct, ClsInstLookupResult)
    lookup_cls_inst InstEnvs
    inst_envs Ct
    ct
                    -- Note [Flattening in error message generation]
          = (Ct
    ct, Bool -> InstEnvs -> Class -> [TcType] -> ClsInstLookupResult
    lookupInstEnv Bool
    True InstEnvs
    inst_envs Class
    clas (InScopeSet -> [TcType] -> [TcType]
    flattenTys InScopeSet
    emptyInScopeSet [TcType]
    tys))
          where
            (Class
    clas, [TcType]
    tys) = HasDebugCallStack => TcType -> (Class, [TcType])
    TcType -> (Class, [TcType])
    getClassPredTys (Ct -> TcType
    ctPred Ct
    ct)

        -- When simplifying [W] Ord (Set a), we need
        --    [W] Eq a, [W] Ord a
        -- but we really only want to report the latter
        elim_superclasses :: [Ct] -> [Ct]
    elim_superclasses [Ct]
    cts = (Ct -> TcType) -> [Ct] -> [Ct]
    forall a. (a -> TcType) -> [a] -> [a]
    mkMinimalBySCs Ct -> TcType
    ctPred [Ct]
    cts

    mk_dict_err :: ReportErrCtxt -> (Ct, ClsInstLookupResult)
                -> TcM (ReportErrCtxt, SDoc)
    -- Report an overlap error if this class constraint results
    -- from an overlap (returning Left clas), otherwise return (Right pred)
    mk_dict_err :: ReportErrCtxt
    -> (Ct, ClsInstLookupResult) -> TcM (ReportErrCtxt, SDoc)
    mk_dict_err ctxt :: ReportErrCtxt
    ctxt@(CEC {cec_encl :: ReportErrCtxt -> [Implication]
    cec_encl = [Implication]
    implics}) (Ct
    ct, ([InstMatch]
    matches, [ClsInst]
    unifiers, [InstMatch]
    unsafe_overlapped))
      | [InstMatch] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [InstMatch]
    matches  -- No matches but perhaps several unifiers
      = do { (ReportErrCtxt
    ctxt, SDoc
    binds_msg, Ct
    ct) <- Bool -> ReportErrCtxt -> Ct -> TcM (ReportErrCtxt, SDoc, Ct)
    relevantBindings Bool
    True ReportErrCtxt
    ctxt Ct
    ct
           ; [ClsInst]
    candidate_insts <- TcM [ClsInst]
    get_candidate_instances
           ; (ReportErrCtxt, SDoc) -> TcM (ReportErrCtxt, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt, Ct -> [ClsInst] -> SDoc -> SDoc
    cannot_resolve_msg Ct
    ct [ClsInst]
    candidate_insts SDoc
    binds_msg) }

      | [InstMatch] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [InstMatch]
    unsafe_overlapped   -- Some matches => overlap errors
      = (ReportErrCtxt, SDoc) -> TcM (ReportErrCtxt, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt, SDoc
    overlap_msg)

      | Bool
    otherwise
      = (ReportErrCtxt, SDoc) -> TcM (ReportErrCtxt, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt, SDoc
    safe_haskell_msg)
      where
        orig :: CtOrigin
    orig          = Ct -> CtOrigin
    ctOrigin Ct
    ct
        pred :: TcType
    pred          = Ct -> TcType
    ctPred Ct
    ct
        (Class
    clas, [TcType]
    tys)   = HasDebugCallStack => TcType -> (Class, [TcType])
    TcType -> (Class, [TcType])
    getClassPredTys TcType
    pred
        ispecs :: [ClsInst]
    ispecs        = [ClsInst
    ispec | (ClsInst
    ispec, [Maybe TcType]
    _) <- [InstMatch]
    matches]
        unsafe_ispecs :: [ClsInst]
    unsafe_ispecs = [ClsInst
    ispec | (ClsInst
    ispec, [Maybe TcType]
    _) <- [InstMatch]
    unsafe_overlapped]
        useful_givens :: [Implication]
    useful_givens = CtOrigin -> [Implication] -> [Implication]
    discardProvCtxtGivens CtOrigin
    orig ([Implication] -> [Implication]
    getUserGivensFromImplics [Implication]
    implics)
             -- useful_givens are the enclosing implications with non-empty givens,
             -- modulo the horrid discardProvCtxtGivens

        get_candidate_instances :: TcM [ClsInst]
        -- See Note [Report candidate instances]
        get_candidate_instances :: TcM [ClsInst]
    get_candidate_instances
          | [TcType
    ty] <- [TcType]
    tys   -- Only try for single-parameter classes
          = do { InstEnvs
    instEnvs <- TcM InstEnvs
    tcGetInstEnvs
               ; [ClsInst] -> TcM [ClsInst]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((ClsInst -> Bool) -> [ClsInst] -> [ClsInst]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (TcType -> ClsInst -> Bool
    is_candidate_inst TcType
    ty)
                                (InstEnvs -> Class -> [ClsInst]
    classInstances InstEnvs
    instEnvs Class
    clas)) }
          | Bool
    otherwise = [ClsInst] -> TcM [ClsInst]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []

        is_candidate_inst :: TcType -> ClsInst -> Bool
    is_candidate_inst TcType
    ty ClsInst
    inst -- See Note [Report candidate instances]
          | [TcType
    other_ty] <- ClsInst -> [TcType]
    is_tys ClsInst
    inst
          , Just (TyCon
    tc1, [TcType]
    _) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty
          , Just (TyCon
    tc2, [TcType]
    _) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    other_ty
          = let n1 :: Name
    n1 = TyCon -> Name
    tyConName TyCon
    tc1
                n2 :: Name
    n2 = TyCon -> Name
    tyConName TyCon
    tc2
                different_names :: Bool
    different_names = Name
    n1 Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Name
    n2
                same_occ_names :: Bool
    same_occ_names = Name -> OccName
    nameOccName Name
    n1 OccName -> OccName -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name -> OccName
    nameOccName Name
    n2
            in Bool
    different_names Bool -> Bool -> Bool
    && Bool
    same_occ_names
          | Bool
    otherwise = Bool
    False

        cannot_resolve_msg :: Ct -> [ClsInst] -> SDoc -> SDoc
        cannot_resolve_msg :: Ct -> [ClsInst] -> SDoc -> SDoc
    cannot_resolve_msg Ct
    ct [ClsInst]
    candidate_insts SDoc
    binds_msg
          = [SDoc] -> SDoc
    vcat [ SDoc
    no_inst_msg
                 , Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    extra_note
                 , [SDoc] -> SDoc
    vcat ([Implication] -> [SDoc]
    pp_givens [Implication]
    useful_givens)
                 , Maybe SDoc
    mb_patsyn_prov Maybe SDoc -> SDoc -> SDoc
    forall a. Maybe a -> a -> a
    `orElse` SDoc
    empty
                 , Bool -> SDoc -> SDoc
    ppWhen (Bool
    has_ambig_tvs Bool -> Bool -> Bool
    && Bool -> Bool
    not ([ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers Bool -> Bool -> Bool
    && [Implication] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    useful_givens))
                   ([SDoc] -> SDoc
    vcat [ Bool -> SDoc -> SDoc
    ppUnless Bool
    lead_with_ambig SDoc
    ambig_msg, SDoc
    binds_msg, SDoc
    potential_msg ])

                 , Bool -> SDoc -> SDoc
    ppWhen (Maybe SDoc -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe SDoc
    mb_patsyn_prov) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                       -- Don't suggest fixes for the provided context of a pattern
                       -- synonym; the right fix is to bind more in the pattern
                   [SDoc] -> SDoc
    show_fixes (Bool -> TcType -> [Implication] -> [SDoc]
    ctxtFixes Bool
    has_ambig_tvs TcType
    pred [Implication]
    implics
                               [SDoc] -> [SDoc] -> [SDoc]
    forall a. [a] -> [a] -> [a]
    ++ [SDoc]
    drv_fixes)
                 , Bool -> SDoc -> SDoc
    ppWhen (Bool -> Bool
    not ([ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    candidate_insts))
                   (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "There are instances for similar types:")
                       Int
    2 ([SDoc] -> SDoc
    vcat ((ClsInst -> SDoc) -> [ClsInst] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [ClsInst]
    candidate_insts))) ]
                       -- See Note [Report candidate instances]
          where
            orig :: CtOrigin
    orig = Ct -> CtOrigin
    ctOrigin Ct
    ct
            -- See Note [Highlighting ambiguous type variables]
            lead_with_ambig :: Bool
    lead_with_ambig = Bool
    has_ambig_tvs Bool -> Bool -> Bool
    && Bool -> Bool
    not ((TcId -> Bool) -> [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcId -> Bool
    isRuntimeUnkSkol [TcId]
    ambig_tvs)
                            Bool -> Bool -> Bool
    && Bool -> Bool
    not ([ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers) Bool -> Bool -> Bool
    && [Implication] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    useful_givens

            (Bool
    has_ambig_tvs, SDoc
    ambig_msg) = Bool -> Ct -> (Bool, SDoc)
    mkAmbigMsg Bool
    lead_with_ambig Ct
    ct
            ambig_tvs :: [TcId]
    ambig_tvs = ([TcId] -> [TcId] -> [TcId]) -> ([TcId], [TcId]) -> [TcId]
    forall a b c. (a -> b -> c) -> (a, b) -> c
    uncurry [TcId] -> [TcId] -> [TcId]
    forall a. [a] -> [a] -> [a]
    (++) (Ct -> ([TcId], [TcId])
    getAmbigTkvs Ct
    ct)

            no_inst_msg :: SDoc
    no_inst_msg
              | Bool
    lead_with_ambig
              = SDoc
    ambig_msg SDoc -> SDoc -> SDoc
    <+> CtOrigin -> SDoc
    pprArising CtOrigin
    orig
                  SDoc -> SDoc -> SDoc
    $$ String -> SDoc
    text String
    "prevents the constraint" SDoc -> SDoc -> SDoc
    <+>  SDoc -> SDoc
    quotes (TcType -> SDoc
    pprParendType TcType
    pred)
                  SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "from being solved."

              | [Implication] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Implication]
    useful_givens
              = CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "No instance for"
                SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprParendType TcType
    pred

              | Bool
    otherwise
              = CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ String -> SDoc
    text String
    "Could not deduce"
                SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprParendType TcType
    pred

            potential_msg :: SDoc
    potential_msg
              = Bool -> SDoc -> SDoc
    ppWhen (Bool -> Bool
    not ([ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers) Bool -> Bool -> Bool
    && CtOrigin -> Bool
    want_potential CtOrigin
    orig) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintPotentialInstances ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Bool
    print_insts ->
                (PprStyle -> SDoc) -> SDoc
    getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \PprStyle
    sty ->
                PrintPotentialInstances -> PprStyle -> SDoc -> [ClsInst] -> SDoc
    pprPotentials (Bool -> PrintPotentialInstances
    PrintPotentialInstances Bool
    print_insts) PprStyle
    sty SDoc
    potential_hdr [ClsInst]
    unifiers

            potential_hdr :: SDoc
    potential_hdr
              = [SDoc] -> SDoc
    vcat [ Bool -> SDoc -> SDoc
    ppWhen Bool
    lead_with_ambig (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                         String -> SDoc
    text String
    "Probable fix: use a type annotation to specify what"
                         SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcId]
    ambig_tvs SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "should be."
                     , String -> SDoc
    text String
    "These potential instance" SDoc -> SDoc -> SDoc
    <> [ClsInst] -> SDoc
    forall a. [a] -> SDoc
    plural [ClsInst]
    unifiers
                       SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "exist:"]

            mb_patsyn_prov :: Maybe SDoc
            mb_patsyn_prov :: Maybe SDoc
    mb_patsyn_prov
              | Bool -> Bool
    not Bool
    lead_with_ambig
              , ProvCtxtOrigin PSB{ psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
    psb_def = L SrcSpanAnnA
    _ Pat GhcRn
    pat } <- CtOrigin
    orig
              = SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "In other words, a successful match on the pattern"
                           , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Pat GhcRn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Pat GhcRn
    pat
                           , String -> SDoc
    text String
    "does not provide the constraint" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprParendType TcType
    pred ])
              | Bool
    otherwise = Maybe SDoc
    forall a. Maybe a
    Nothing

        -- Report "potential instances" only when the constraint arises
        -- directly from the user's use of an overloaded function
        want_potential :: CtOrigin -> Bool
    want_potential (TypeEqOrigin {}) = Bool
    False
        want_potential CtOrigin
    _                 = Bool
    True

        extra_note :: SDoc
    extra_note | (TcType -> Bool) -> [TcType] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcType -> Bool
    isFunTy (TyCon -> [TcType] -> [TcType]
    filterOutInvisibleTypes (Class -> TyCon
    classTyCon Class
    clas) [TcType]
    tys)
                   = String -> SDoc
    text String
    "(maybe you haven't applied a function to enough arguments?)"
                   | Class -> Name
    className Class
    clas Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    typeableClassName  -- Avoid mysterious "No instance for (Typeable T)
                   , [TcType
    _,TcType
    ty] <- [TcType]
    tys                        -- Look for (Typeable (k->*) (T k))
                   , Just (TyCon
    tc,[TcType]
    _) <- HasCallStack => TcType -> Maybe (TyCon, [TcType])
    TcType -> Maybe (TyCon, [TcType])
    tcSplitTyConApp_maybe TcType
    ty
                   , Bool -> Bool
    not (TyCon -> Bool
    isTypeFamilyTyCon TyCon
    tc)
                   = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "GHC can't yet do polykinded")
                        Int
    2 (String -> SDoc
    text String
    "Typeable" SDoc -> SDoc -> SDoc
    <+>
                           SDoc -> SDoc
    parens (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    ty SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (HasDebugCallStack => TcType -> TcType
    TcType -> TcType
    tcTypeKind TcType
    ty)))
                   | Bool
    otherwise
                   = SDoc
    empty

        drv_fixes :: [SDoc]
    drv_fixes = case CtOrigin
    orig of
                       CtOrigin
    DerivClauseOrigin                  -> [Bool -> SDoc
    drv_fix Bool
    False]
                       CtOrigin
    StandAloneDerivOrigin              -> [Bool -> SDoc
    drv_fix Bool
    True]
                       DerivOriginDC DataCon
    _ Int
    _       Bool
    standalone -> [Bool -> SDoc
    drv_fix Bool
    standalone]
                       DerivOriginCoerce TcId
    _ TcType
    _ TcType
    _ Bool
    standalone -> [Bool -> SDoc
    drv_fix Bool
    standalone]
                       CtOrigin
    _                -> []

        drv_fix :: Bool -> SDoc
    drv_fix Bool
    standalone_wildcard
          | Bool
    standalone_wildcard
          = String -> SDoc
    text String
    "fill in the wildcard constraint yourself"
          | Bool
    otherwise
          = SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "use a standalone 'deriving instance' declaration,")
               Int
    2 (String -> SDoc
    text String
    "so you can specify the instance context yourself")

        -- Normal overlap error
        overlap_msg :: SDoc
    overlap_msg
          = ASSERT( not (null matches) )
            [SDoc] -> SDoc
    vcat [  CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (String -> SDoc
    text String
    "Overlapping instances for"
                                    SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprType (Class -> [TcType] -> TcType
    mkClassPred Class
    clas [TcType]
    tys))

                 ,  Bool -> SDoc -> SDoc
    ppUnless ([SDoc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SDoc]
    matching_givens) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                      [SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "Matching givens (or their superclasses):"
                          , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat [SDoc]
    matching_givens)]

                 ,  (SDocContext -> Bool) -> (Bool -> SDoc) -> SDoc
    forall a. (SDocContext -> a) -> (a -> SDoc) -> SDoc
    sdocOption SDocContext -> Bool
    sdocPrintPotentialInstances ((Bool -> SDoc) -> SDoc) -> (Bool -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \Bool
    print_insts ->
                    (PprStyle -> SDoc) -> SDoc
    getPprStyle ((PprStyle -> SDoc) -> SDoc) -> (PprStyle -> SDoc) -> SDoc
    forall a b. (a -> b) -> a -> b
    $ \PprStyle
    sty ->
                    PrintPotentialInstances -> PprStyle -> SDoc -> [ClsInst] -> SDoc
    pprPotentials (Bool -> PrintPotentialInstances
    PrintPotentialInstances Bool
    print_insts) PprStyle
    sty (String -> SDoc
    text String
    "Matching instances:") ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    [ClsInst]
    ispecs [ClsInst] -> [ClsInst] -> [ClsInst]
    forall a. [a] -> [a] -> [a]
    ++ [ClsInst]
    unifiers

                 ,  Bool -> SDoc -> SDoc
    ppWhen ([SDoc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SDoc]
    matching_givens Bool -> Bool -> Bool
    && [InstMatch] -> Bool
    forall a. [a] -> Bool
    isSingleton [InstMatch]
    matches Bool -> Bool -> Bool
    && [ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    unifiers) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    -- Intuitively, some given matched the wanted in their
                    -- flattened or rewritten (from given equalities) form
                    -- but the matcher can't figure that out because the
                    -- constraints are non-flat and non-rewritten so we
                    -- simply report back the whole given
                    -- context. Accelerate Smart.hs showed this problem.
                      [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "There exists a (perhaps superclass) match:"
                          , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat ([Implication] -> [SDoc]
    pp_givens [Implication]
    useful_givens))]

                 ,  Bool -> SDoc -> SDoc
    ppWhen ([InstMatch] -> Bool
    forall a. [a] -> Bool
    isSingleton [InstMatch]
    matches) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    SDoc -> SDoc
    parens ([SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "The choice depends on the instantiation of" SDoc -> SDoc -> SDoc
    <+>
                                      SDoc -> SDoc
    quotes ((TcId -> SDoc) -> [TcId] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([TcType] -> [TcId]
    tyCoVarsOfTypesList [TcType]
    tys))
                                 , Bool -> SDoc -> SDoc
    ppWhen ([SDoc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null ([SDoc]
    matching_givens)) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                                   [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "To pick the first instance above, use IncoherentInstances"
                                        , String -> SDoc
    text String
    "when compiling the other instance declarations"]
                            ])]

        matching_givens :: [SDoc]
    matching_givens = (Implication -> Maybe SDoc) -> [Implication] -> [SDoc]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Implication -> Maybe SDoc
    matchable [Implication]
    useful_givens

        matchable :: Implication -> Maybe SDoc
    matchable implic :: Implication
    implic@(Implic { ic_given :: Implication -> [TcId]
    ic_given = [TcId]
    evvars, ic_info :: Implication -> SkolemInfo
    ic_info = SkolemInfo
    skol_info })
          = case [TcType]
    ev_vars_matching of
                 [] -> Maybe SDoc
    forall a. Maybe a
    Nothing
                 [TcType]
    _  -> SDoc -> Maybe SDoc
    forall a. a -> Maybe a
    Just (SDoc -> Maybe SDoc) -> SDoc -> Maybe SDoc
    forall a b. (a -> b) -> a -> b
    $ SDoc -> Int -> SDoc -> SDoc
    hang ([TcType] -> SDoc
    pprTheta [TcType]
    ev_vars_matching)
                                Int
    2 ([SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "bound by" SDoc -> SDoc -> SDoc
    <+> SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info
                                       , String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+>
                                         RealSrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcLclEnv -> RealSrcSpan
    tcl_loc (Implication -> TcLclEnv
    ic_env Implication
    implic)) ])
            where ev_vars_matching :: [TcType]
    ev_vars_matching = [ TcType
    pred
                                     | TcId
    ev_var <- [TcId]
    evvars
                                     , let pred :: TcType
    pred = TcId -> TcType
    evVarPred TcId
    ev_var
                                     , (TcType -> Bool) -> [TcType] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcType -> Bool
    can_match (TcType
    pred TcType -> [TcType] -> [TcType]
    forall a. a -> [a] -> [a]
    : TcType -> [TcType]
    transSuperClasses TcType
    pred) ]
                  can_match :: TcType -> Bool
    can_match TcType
    pred
                     = case TcType -> Maybe (Class, [TcType])
    getClassPredTys_maybe TcType
    pred of
                         Just (Class
    clas', [TcType]
    tys') -> Class
    clas' Class -> Class -> Bool
    forall a. Eq a => a -> a -> Bool
    == Class
    clas
                                              Bool -> Bool -> Bool
    && Maybe TCvSubst -> Bool
    forall a. Maybe a -> Bool
    isJust ([TcType] -> [TcType] -> Maybe TCvSubst
    tcMatchTys [TcType]
    tys [TcType]
    tys')
                         Maybe (Class, [TcType])
    Nothing -> Bool
    False

        -- Overlap error because of Safe Haskell (first
        -- match should be the most specific match)
        safe_haskell_msg :: SDoc
    safe_haskell_msg
         = ASSERT( matches `lengthIs` 1 && not (null unsafe_ispecs) )
           [SDoc] -> SDoc
    vcat [ CtOrigin -> SDoc -> SDoc
    addArising CtOrigin
    orig (String -> SDoc
    text String
    "Unsafe overlapping instances for"
                           SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprType (Class -> [TcType] -> TcType
    mkClassPred Class
    clas [TcType]
    tys))
                , [SDoc] -> SDoc
    sep [String -> SDoc
    text String
    "The matching instance is:",
                       Int -> SDoc -> SDoc
    nest Int
    2 (ClsInst -> SDoc
    pprInstance (ClsInst -> SDoc) -> ClsInst -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [ClsInst] -> ClsInst
    forall a. [a] -> a
    head [ClsInst]
    ispecs)]
                , [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "It is compiled in a Safe module and as such can only"
                       , String -> SDoc
    text String
    "overlap instances from the same module, however it"
                       , String -> SDoc
    text String
    "overlaps the following instances from different" SDoc -> SDoc -> SDoc
    <+>
                         String -> SDoc
    text String
    "modules:"
                       , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat [[ClsInst] -> SDoc
    pprInstances ([ClsInst] -> SDoc) -> [ClsInst] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ [ClsInst]
    unsafe_ispecs])
                       ]
                ]

    ctxtFixes :: Bool -> PredType -> [Implication] -> [SDoc]
    ctxtFixes :: Bool -> TcType -> [Implication] -> [SDoc]
    ctxtFixes Bool
    has_ambig_tvs TcType
    pred [Implication]
    implics
      | Bool -> Bool
    not Bool
    has_ambig_tvs
      , TcType -> Bool
    isTyVarClassPred TcType
    pred
      , (SkolemInfo
    skol:[SkolemInfo]
    skols) <- [Implication] -> TcType -> [SkolemInfo]
    usefulContext [Implication]
    implics TcType
    pred
      , let what :: SDoc
    what | [SkolemInfo] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SkolemInfo]
    skols
                 , SigSkol (PatSynCtxt {}) TcType
    _ [(Name, TcId)]
    _ <- SkolemInfo
    skol
                 = String -> SDoc
    text String
    "\"required\""
                 | Bool
    otherwise
                 = SDoc
    empty
      = [[SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "add" SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    pprParendType TcType
    pred
               SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "to the" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "context of"
             , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $ SkolemInfo -> SDoc
    ppr_skol SkolemInfo
    skol SDoc -> SDoc -> SDoc
    $$
                        [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "or" SDoc -> SDoc -> SDoc
    <+> SkolemInfo -> SDoc
    ppr_skol SkolemInfo
    skol
                             | SkolemInfo
    skol <- [SkolemInfo]
    skols ] ] ]
      | Bool
    otherwise = []
      where
        ppr_skol :: SkolemInfo -> SDoc
    ppr_skol (PatSkol (RealDataCon DataCon
    dc) HsMatchContext GhcRn
    _) = String -> SDoc
    text String
    "the data constructor" SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (DataCon -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr DataCon
    dc)
        ppr_skol (PatSkol (PatSynCon PatSyn
    ps)   HsMatchContext GhcRn
    _) = String -> SDoc
    text String
    "the pattern synonym"  SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    quotes (PatSyn -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr PatSyn
    ps)
        ppr_skol SkolemInfo
    skol_info = SkolemInfo -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SkolemInfo
    skol_info

    discardProvCtxtGivens :: CtOrigin -> [UserGiven] -> [UserGiven]
    discardProvCtxtGivens :: CtOrigin -> [Implication] -> [Implication]
    discardProvCtxtGivens CtOrigin
    orig [Implication]
    givens  -- See Note [discardProvCtxtGivens]
      | ProvCtxtOrigin (PSB {psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
    psb_id = L SrcSpanAnnN
    _ Name
    name}) <- CtOrigin
    orig
      = (Implication -> Bool) -> [Implication] -> [Implication]
    forall a. (a -> Bool) -> [a] -> [a]
    filterOut (Name -> Implication -> Bool
    discard Name
    name) [Implication]
    givens
      | Bool
    otherwise
      = [Implication]
    givens
      where
        discard :: Name -> Implication -> Bool
    discard Name
    n (Implic { ic_info :: Implication -> SkolemInfo
    ic_info = SigSkol (PatSynCtxt Name
    n') TcType
    _ [(Name, TcId)]
    _ }) = Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == Name
    n'
        discard Name
    _ Implication
    _                                                  = Bool
    False

    usefulContext :: [Implication] -> PredType -> [SkolemInfo]
    -- usefulContext picks out the implications whose context
    -- the programmer might plausibly augment to solve 'pred'
    usefulContext :: [Implication] -> TcType -> [SkolemInfo]
    usefulContext [Implication]
    implics TcType
    pred
      = [Implication] -> [SkolemInfo]
    go [Implication]
    implics
      where
        pred_tvs :: TyCoVarSet
    pred_tvs = TcType -> TyCoVarSet
    tyCoVarsOfType TcType
    pred
        go :: [Implication] -> [SkolemInfo]
    go [] = []
        go (Implication
    ic : [Implication]
    ics)
           | Implication -> Bool
    implausible Implication
    ic = [SkolemInfo]
    rest
           | Bool
    otherwise      = Implication -> SkolemInfo
    ic_info Implication
    ic SkolemInfo -> [SkolemInfo] -> [SkolemInfo]
    forall a. a -> [a] -> [a]
    : [SkolemInfo]
    rest
           where
              -- Stop when the context binds a variable free in the predicate
              rest :: [SkolemInfo]
    rest | (TcId -> Bool) -> [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (TcId -> TyCoVarSet -> Bool
    `elemVarSet` TyCoVarSet
    pred_tvs) (Implication -> [TcId]
    ic_skols Implication
    ic) = []
                   | Bool
    otherwise                                 = [Implication] -> [SkolemInfo]
    go [Implication]
    ics

        implausible :: Implication -> Bool
    implausible Implication
    ic
          | [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null (Implication -> [TcId]
    ic_skols Implication
    ic)            = Bool
    True
          | SkolemInfo -> Bool
    implausible_info (Implication -> SkolemInfo
    ic_info Implication
    ic) = Bool
    True
          | Bool
    otherwise                     = Bool
    False

        implausible_info :: SkolemInfo -> Bool
    implausible_info (SigSkol (InfSigCtxt {}) TcType
    _ [(Name, TcId)]
    _) = Bool
    True
        implausible_info SkolemInfo
    _                             = Bool
    False
        -- Do not suggest adding constraints to an *inferred* type signature

    {- Note [Report candidate instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    If we have an unsolved (Num Int), where `Int` is not the Prelude Int,
    but comes from some other module, then it may be helpful to point out
    that there are some similarly named instances elsewhere.  So we get
    something like
        No instance for (Num Int) arising from the literal ‘3’
        There are instances for similar types:
          instance Num GHC.Types.Int -- Defined in ‘GHC.Num’
    Discussion in #9611.

    Note [Highlighting ambiguous type variables]
    ~-------------------------------------------
    When we encounter ambiguous type variables (i.e. type variables
    that remain metavariables after type inference), we need a few more
    conditions before we can reason that *ambiguity* prevents constraints
    from being solved:
      - We can't have any givens, as encountering a typeclass error
        with given constraints just means we couldn't deduce
        a solution satisfying those constraints and as such couldn't
        bind the type variable to a known type.
      - If we don't have any unifiers, we don't even have potential
        instances from which an ambiguity could arise.
      - Lastly, I don't want to mess with error reporting for
        unknown runtime types so we just fall back to the old message there.
    Once these conditions are satisfied, we can safely say that ambiguity prevents
    the constraint from being solved.

    Note [discardProvCtxtGivens]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In most situations we call all enclosing implications "useful". There is one
    exception, and that is when the constraint that causes the error is from the
    "provided" context of a pattern synonym declaration:

      pattern Pat :: (Num a, Eq a) => Show a   => a -> Maybe a
                 --  required      => provided => type
      pattern Pat x <- (Just x, 4)

    When checking the pattern RHS we must check that it does actually bind all
    the claimed "provided" constraints; in this case, does the pattern (Just x, 4)
    bind the (Show a) constraint.  Answer: no!

    But the implication we generate for this will look like
       forall a. (Num a, Eq a) => [W] Show a
    because when checking the pattern we must make the required
    constraints available, since they are needed to match the pattern (in
    this case the literal '4' needs (Num a, Eq a)).

    BUT we don't want to suggest adding (Show a) to the "required" constraints
    of the pattern synonym, thus:
      pattern Pat :: (Num a, Eq a, Show a) => Show a => a -> Maybe a
    It would then typecheck but it's silly.  We want the /pattern/ to bind
    the alleged "provided" constraints, Show a.

    So we suppress that Implication in discardProvCtxtGivens.  It's
    painfully ad-hoc but the truth is that adding it to the "required"
    constraints would work.  Suppressing it solves two problems.  First,
    we never tell the user that we could not deduce a "provided"
    constraint from the "required" context. Second, we never give a
    possible fix that suggests to add a "provided" constraint to the
    "required" context.

    For example, without this distinction the above code gives a bad error
    message (showing both problems):

      error: Could not deduce (Show a) ... from the context: (Eq a)
             ... Possible fix: add (Show a) to the context of
             the signature for pattern synonym `Pat' ...

    -}

    show_fixes :: [SDoc] -> SDoc
    show_fixes :: [SDoc] -> SDoc
    show_fixes []     = SDoc
    empty
    show_fixes (SDoc
    f:[SDoc]
    fs) = [SDoc] -> SDoc
    sep [ String -> SDoc
    text String
    "Possible fix:"
                            , Int -> SDoc -> SDoc
    nest Int
    2 ([SDoc] -> SDoc
    vcat (SDoc
    f SDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    : (SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> SDoc
    text String
    "or" SDoc -> SDoc -> SDoc
    <+>) [SDoc]
    fs))]

    -- Avoid boolean blindness
    newtype PrintPotentialInstances = PrintPotentialInstances Bool

    pprPotentials :: PrintPotentialInstances -> PprStyle -> SDoc -> [ClsInst] -> SDoc
    -- See Note [Displaying potential instances]
    pprPotentials :: PrintPotentialInstances -> PprStyle -> SDoc -> [ClsInst] -> SDoc
    pprPotentials (PrintPotentialInstances Bool
    show_potentials) PprStyle
    sty SDoc
    herald [ClsInst]
    insts
      | [ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    insts
      = SDoc
    empty

      | [ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    show_these
      = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald
           Int
    2 ([SDoc] -> SDoc
    vcat [ SDoc -> SDoc
    not_in_scope_msg SDoc
    empty
                   , SDoc
    flag_hint ])

      | Bool
    otherwise
      = SDoc -> Int -> SDoc -> SDoc
    hang SDoc
    herald
           Int
    2 ([SDoc] -> SDoc
    vcat [ [ClsInst] -> SDoc
    pprInstances [ClsInst]
    show_these
                   , Bool -> SDoc -> SDoc
    ppWhen (Int
    n_in_scope_hidden Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                     String -> SDoc
    text String
    "...plus"
                       SDoc -> SDoc -> SDoc
    <+> Int -> SDoc -> SDoc
    speakNOf Int
    n_in_scope_hidden (String -> SDoc
    text String
    "other")
                   , SDoc -> SDoc
    not_in_scope_msg (String -> SDoc
    text String
    "...plus")
                   , SDoc
    flag_hint ])
      where
        n_show :: Int
    n_show = Int
    3 :: Int

        ([ClsInst]
    in_scope, [ClsInst]
    not_in_scope) = (ClsInst -> Bool) -> [ClsInst] -> ([ClsInst], [ClsInst])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition ClsInst -> Bool
    inst_in_scope [ClsInst]
    insts
        sorted :: [ClsInst]
    sorted = (ClsInst -> ClsInst -> Ordering) -> [ClsInst] -> [ClsInst]
    forall a. (a -> a -> Ordering) -> [a] -> [a]
    sortBy ClsInst -> ClsInst -> Ordering
    fuzzyClsInstCmp [ClsInst]
    in_scope
        show_these :: [ClsInst]
    show_these | Bool
    show_potentials = [ClsInst]
    sorted
                   | Bool
    otherwise       = Int -> [ClsInst] -> [ClsInst]
    forall a. Int -> [a] -> [a]
    take Int
    n_show [ClsInst]
    sorted
        n_in_scope_hidden :: Int
    n_in_scope_hidden = [ClsInst] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    sorted Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - [ClsInst] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    show_these

           -- "in scope" means that all the type constructors
           -- are lexically in scope; these instances are likely
           -- to be more useful
        inst_in_scope :: ClsInst -> Bool
        inst_in_scope :: ClsInst -> Bool
    inst_in_scope ClsInst
    cls_inst = (Name -> Bool) -> NameSet -> Bool
    nameSetAll Name -> Bool
    name_in_scope (NameSet -> Bool) -> NameSet -> Bool
    forall a b. (a -> b) -> a -> b
    $
                                 [TcType] -> NameSet
    orphNamesOfTypes (ClsInst -> [TcType]
    is_tys ClsInst
    cls_inst)

        name_in_scope :: Name -> Bool
    name_in_scope Name
    name
          | Name -> Bool
    isBuiltInSyntax Name
    name
          = Bool
    True -- E.g. (->)
          | Just Module
    mod <- Name -> Maybe Module
    nameModule_maybe Name
    name
          = QualifyName -> Bool
    qual_in_scope (PprStyle -> QueryQualifyName
    qualName PprStyle
    sty Module
    mod (Name -> OccName
    nameOccName Name
    name))
          | Bool
    otherwise
          = Bool
    True

        qual_in_scope :: QualifyName -> Bool
        qual_in_scope :: QualifyName -> Bool
    qual_in_scope QualifyName
    NameUnqual    = Bool
    True
        qual_in_scope (NameQual {}) = Bool
    True
        qual_in_scope QualifyName
    _             = Bool
    False

        not_in_scope_msg :: SDoc -> SDoc
    not_in_scope_msg SDoc
    herald
          | [ClsInst] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ClsInst]
    not_in_scope
          = SDoc
    empty
          | Bool
    otherwise
          = SDoc -> Int -> SDoc -> SDoc
    hang (SDoc
    herald SDoc -> SDoc -> SDoc
    <+> Int -> SDoc -> SDoc
    speakNOf ([ClsInst] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [ClsInst]
    not_in_scope) (String -> SDoc
    text String
    "instance")
                         SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "involving out-of-scope types")
               Int
    2 (Bool -> SDoc -> SDoc
    ppWhen Bool
    show_potentials ([ClsInst] -> SDoc
    pprInstances [ClsInst]
    not_in_scope))

        flag_hint :: SDoc
    flag_hint = Bool -> SDoc -> SDoc
    ppUnless (Bool
    show_potentials Bool -> Bool -> Bool
    || [ClsInst] -> [ClsInst] -> Bool
    forall a b. [a] -> [b] -> Bool
    equalLength [ClsInst]
    show_these [ClsInst]
    insts) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                    String -> SDoc
    text String
    "(use -fprint-potential-instances to see them all)"

    {- Note [Displaying potential instances]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    When showing a list of instances for
      - overlapping instances (show ones that match)
      - no such instance (show ones that could match)
    we want to give it a bit of structure.  Here's the plan

    * Say that an instance is "in scope" if all of the
      type constructors it mentions are lexically in scope.
      These are the ones most likely to be useful to the programmer.

    * Show at most n_show in-scope instances,
      and summarise the rest ("plus 3 others")

    * Summarise the not-in-scope instances ("plus 4 not in scope")

    * Add the flag -fshow-potential-instances which replaces the
      summary with the full list
    -}

    {-
    Note [Flattening in error message generation]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider (C (Maybe (F x))), where F is a type function, and we have
    instances
                    C (Maybe Int) and C (Maybe a)
    Since (F x) might turn into Int, this is an overlap situation, and
    indeed the main solver will have refrained
    from solving.  But by the time we get to error message generation, we've
    un-flattened the constraint.  So we must *re*-flatten it before looking
    up in the instance environment, lest we only report one matching
    instance when in fact there are two.

    Note [Kind arguments in error messages]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    It can be terribly confusing to get an error message like (#9171)

        Couldn't match expected type ‘GetParam Base (GetParam Base Int)’
                    with actual type ‘GetParam Base (GetParam Base Int)’

    The reason may be that the kinds don't match up.  Typically you'll get
    more useful information, but not when it's as a result of ambiguity.

    To mitigate this, GHC attempts to enable the -fprint-explicit-kinds flag
    whenever any error message arises due to a kind mismatch. This means that
    the above error message would instead be displayed as:

        Couldn't match expected type
                      ‘GetParam @* @k2 @* Base (GetParam @* @* @k2 Base Int)’
                    with actual type
                      ‘GetParam @* @k20 @* Base (GetParam @* @* @k20 Base Int)’

    Which makes it clearer that the culprit is the mismatch between `k2` and `k20`.
    -}

    mkAmbigMsg :: Bool -- True when message has to be at beginning of sentence
               -> Ct -> (Bool, SDoc)
    mkAmbigMsg :: Bool -> Ct -> (Bool, SDoc)
    mkAmbigMsg Bool
    prepend_msg Ct
    ct
      | [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    ambig_kvs Bool -> Bool -> Bool
    && [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    ambig_tvs = (Bool
    False, SDoc
    empty)
      | Bool
    otherwise                        = (Bool
    True,  SDoc
    msg)
      where
        ([TcId]
    ambig_kvs, [TcId]
    ambig_tvs) = Ct -> ([TcId], [TcId])
    getAmbigTkvs Ct
    ct

        msg :: SDoc
    msg |  (TcId -> Bool) -> [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcId -> Bool
    isRuntimeUnkSkol [TcId]
    ambig_kvs  -- See Note [Runtime skolems]
            Bool -> Bool -> Bool
    || (TcId -> Bool) -> [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any TcId -> Bool
    isRuntimeUnkSkol [TcId]
    ambig_tvs
            = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Cannot resolve unknown runtime type"
                     SDoc -> SDoc -> SDoc
    <> [TcId] -> SDoc
    forall a. [a] -> SDoc
    plural [TcId]
    ambig_tvs SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcId]
    ambig_tvs
                   , String -> SDoc
    text String
    "Use :print or :force to determine these types"]

            | Bool -> Bool
    not ([TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    ambig_tvs)
            = SDoc -> [TcId] -> SDoc
    pp_ambig (String -> SDoc
    text String
    "type") [TcId]
    ambig_tvs

            | Bool
    otherwise
            = SDoc -> [TcId] -> SDoc
    pp_ambig (String -> SDoc
    text String
    "kind") [TcId]
    ambig_kvs

        pp_ambig :: SDoc -> [TcId] -> SDoc
    pp_ambig SDoc
    what [TcId]
    tkvs
          | Bool
    prepend_msg -- "Ambiguous type variable 't0'"
          = String -> SDoc
    text String
    "Ambiguous" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable"
            SDoc -> SDoc -> SDoc
    <> [TcId] -> SDoc
    forall a. [a] -> SDoc
    plural [TcId]
    tkvs SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcId]
    tkvs

          | Bool
    otherwise -- "The type variable 't0' is ambiguous"
          = String -> SDoc
    text String
    "The" SDoc -> SDoc -> SDoc
    <+> SDoc
    what SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "variable" SDoc -> SDoc -> SDoc
    <> [TcId] -> SDoc
    forall a. [a] -> SDoc
    plural [TcId]
    tkvs
            SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [TcId]
    tkvs SDoc -> SDoc -> SDoc
    <+> [TcId] -> SDoc
    forall a. [a] -> SDoc
    isOrAre [TcId]
    tkvs SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "ambiguous"

    pprSkols :: ReportErrCtxt -> [TcTyVar] -> SDoc
    pprSkols :: ReportErrCtxt -> [TcId] -> SDoc
    pprSkols ReportErrCtxt
    ctxt [TcId]
    tvs
      = [SDoc] -> SDoc
    vcat (((SkolemInfo, [TcId]) -> SDoc) -> [(SkolemInfo, [TcId])] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (SkolemInfo, [TcId]) -> SDoc
    forall {a}.
    (Outputable a, NamedThing a) =>
    (SkolemInfo, [a]) -> SDoc
    pp_one ([Implication] -> [TcId] -> [(SkolemInfo, [TcId])]
    getSkolemInfo (ReportErrCtxt -> [Implication]
    cec_encl ReportErrCtxt
    ctxt) [TcId]
    tvs))
      where
        pp_one :: (SkolemInfo, [a]) -> SDoc
    pp_one (SkolemInfo
    UnkSkol, [a]
    tvs)
          = SDoc -> Int -> SDoc -> SDoc
    hang ([a] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [a]
    tvs)
               Int
    2 ([a] -> String -> String -> SDoc
    forall {a}. [a] -> String -> String -> SDoc
    is_or_are [a]
    tvs String
    "an" String
    "unknown")
        pp_one (SkolemInfo
    RuntimeUnkSkol, [a]
    tvs)
          = SDoc -> Int -> SDoc -> SDoc
    hang ([a] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [a]
    tvs)
               Int
    2 ([a] -> String -> String -> SDoc
    forall {a}. [a] -> String -> String -> SDoc
    is_or_are [a]
    tvs String
    "an" String
    "unknown runtime")
        pp_one (SkolemInfo
    skol_info, [a]
    tvs)
          = [SDoc] -> SDoc
    vcat [ SDoc -> Int -> SDoc -> SDoc
    hang ([a] -> SDoc
    forall a. Outputable a => [a] -> SDoc
    pprQuotedList [a]
    tvs)
                      Int
    2 ([a] -> String -> String -> SDoc
    forall {a}. [a] -> String -> String -> SDoc
    is_or_are [a]
    tvs String
    "a"  String
    "rigid" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "bound by")
                 , Int -> SDoc -> SDoc
    nest Int
    2 (SkolemInfo -> SDoc
    pprSkolInfo SkolemInfo
    skol_info)
                 , Int -> SDoc -> SDoc
    nest Int
    2 (String -> SDoc
    text String
    "at" SDoc -> SDoc -> SDoc
    <+> SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ((SrcSpan -> SrcSpan -> SrcSpan) -> [SrcSpan] -> SrcSpan
    forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
    foldr1 SrcSpan -> SrcSpan -> SrcSpan
    combineSrcSpans ((a -> SrcSpan) -> [a] -> [SrcSpan]
    forall a b. (a -> b) -> [a] -> [b]
    map a -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan [a]
    tvs))) ]

        is_or_are :: [a] -> String -> String -> SDoc
    is_or_are [a
    _] String
    article String
    adjective = String -> SDoc
    text String
    "is" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    article SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    adjective
                                          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "type variable"
        is_or_are [a]
    _   String
    _       String
    adjective = String -> SDoc
    text String
    "are" SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    adjective
                                          SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "type variables"

    getAmbigTkvs :: Ct -> ([Var],[Var])
    getAmbigTkvs :: Ct -> ([TcId], [TcId])
    getAmbigTkvs Ct
    ct
      = (TcId -> Bool) -> [TcId] -> ([TcId], [TcId])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (TcId -> TyCoVarSet -> Bool
    `elemVarSet` TyCoVarSet
    dep_tkv_set) [TcId]
    ambig_tkvs
      where
        tkvs :: [TcId]
    tkvs       = Ct -> [TcId]
    tyCoVarsOfCtList Ct
    ct
        ambig_tkvs :: [TcId]
    ambig_tkvs = (TcId -> Bool) -> [TcId] -> [TcId]
    forall a. (a -> Bool) -> [a] -> [a]
    filter TcId -> Bool
    isAmbiguousTyVar [TcId]
    tkvs
        dep_tkv_set :: TyCoVarSet
    dep_tkv_set = [TcType] -> TyCoVarSet
    tyCoVarsOfTypes ((TcId -> TcType) -> [TcId] -> [TcType]
    forall a b. (a -> b) -> [a] -> [b]
    map TcId -> TcType
    tyVarKind [TcId]
    tkvs)

    getSkolemInfo :: [Implication] -> [TcTyVar]
                  -> [(SkolemInfo, [TcTyVar])]                    -- #14628
    -- Get the skolem info for some type variables
    -- from the implication constraints that bind them.
    --
    -- In the returned (skolem, tvs) pairs, the 'tvs' part is non-empty
    getSkolemInfo :: [Implication] -> [TcId] -> [(SkolemInfo, [TcId])]
    getSkolemInfo [Implication]
    _ []
      = []

    getSkolemInfo [] [TcId]
    tvs
      | (TcId -> Bool) -> [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    all TcId -> Bool
    isRuntimeUnkSkol [TcId]
    tvs = [(SkolemInfo
    RuntimeUnkSkol, [TcId]
    tvs)]        -- #14628
      | Bool
    otherwise = String -> SDoc -> [(SkolemInfo, [TcId])]
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "No skolem info:" ([TcId] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [TcId]
    tvs)

    getSkolemInfo (Implication
    implic:[Implication]
    implics) [TcId]
    tvs
      | [TcId] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TcId]
    tvs_here =                            [Implication] -> [TcId] -> [(SkolemInfo, [TcId])]
    getSkolemInfo [Implication]
    implics [TcId]
    tvs
      | Bool
    otherwise   = (Implication -> SkolemInfo
    ic_info Implication
    implic, [TcId]
    tvs_here) (SkolemInfo, [TcId])
    -> [(SkolemInfo, [TcId])] -> [(SkolemInfo, [TcId])]
    forall a. a -> [a] -> [a]
    : [Implication] -> [TcId] -> [(SkolemInfo, [TcId])]
    getSkolemInfo [Implication]
    implics [TcId]
    tvs_other
      where
        ([TcId]
    tvs_here, [TcId]
    tvs_other) = (TcId -> Bool) -> [TcId] -> ([TcId], [TcId])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    partition (TcId -> [TcId] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` Implication -> [TcId]
    ic_skols Implication
    implic) [TcId]
    tvs

    -----------------------
    -- relevantBindings looks at the value environment and finds values whose
    -- types mention any of the offending type variables.  It has to be
    -- careful to zonk the Id's type first, so it has to be in the monad.
    -- We must be careful to pass it a zonked type variable, too.
    --
    -- We always remove closed top-level bindings, though,
    -- since they are never relevant (cf #8233)

    relevantBindings :: Bool  -- True <=> filter by tyvar; False <=> no filtering
                              -- See #8191
                     -> ReportErrCtxt -> Ct
                     -> TcM (ReportErrCtxt, SDoc, Ct)
    -- Also returns the zonked and tidied CtOrigin of the constraint
    relevantBindings :: Bool -> ReportErrCtxt -> Ct -> TcM (ReportErrCtxt, SDoc, Ct)
    relevantBindings Bool
    want_filtering ReportErrCtxt
    ctxt Ct
    ct
      = do { String -> SDoc -> TcM ()
    traceTc String
    "relevantBindings" (Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct)
           ; (TidyEnv
    env1, CtOrigin
    tidy_orig) <- TidyEnv -> CtOrigin -> TcM (TidyEnv, CtOrigin)
    zonkTidyOrigin (ReportErrCtxt -> TidyEnv
    cec_tidy ReportErrCtxt
    ctxt) (CtLoc -> CtOrigin
    ctLocOrigin CtLoc
    loc)

                 -- For *kind* errors, report the relevant bindings of the
                 -- enclosing *type* equality, because that's more useful for the programmer
           ; let extra_tvs :: TyCoVarSet
    extra_tvs = case CtOrigin
    tidy_orig of
                                 KindEqOrigin TcType
    t1 TcType
    t2 CtOrigin
    _ Maybe TypeOrKind
    _ -> [TcType] -> TyCoVarSet
    tyCoVarsOfTypes [TcType
    t1,TcType
    t2]
                                 CtOrigin
    _                        -> TyCoVarSet
    emptyVarSet
                 ct_fvs :: TyCoVarSet
    ct_fvs = Ct -> TyCoVarSet
    tyCoVarsOfCt Ct
    ct TyCoVarSet -> TyCoVarSet -> TyCoVarSet
    `unionVarSet` TyCoVarSet
    extra_tvs

                 -- Put a zonked, tidied CtOrigin into the Ct
                 loc' :: CtLoc
    loc'   = CtLoc -> CtOrigin -> CtLoc
    setCtLocOrigin CtLoc
    loc CtOrigin
    tidy_orig
                 ct' :: Ct
    ct'    = Ct -> CtLoc -> Ct
    setCtLoc Ct
    ct CtLoc
    loc'
                 ctxt1 :: ReportErrCtxt
    ctxt1  = ReportErrCtxt
    ctxt { cec_tidy :: TidyEnv
    cec_tidy = TidyEnv
    env1 }

           ; (ReportErrCtxt
    ctxt2, SDoc
    doc) <- Bool
    -> ReportErrCtxt
    -> TcLclEnv
    -> TyCoVarSet
    -> TcM (ReportErrCtxt, SDoc)
    relevant_bindings Bool
    want_filtering ReportErrCtxt
    ctxt1 TcLclEnv
    lcl_env TyCoVarSet
    ct_fvs
           ; (ReportErrCtxt, SDoc, Ct) -> TcM (ReportErrCtxt, SDoc, Ct)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt2, SDoc
    doc, Ct
    ct') }
      where
        loc :: CtLoc
    loc     = Ct -> CtLoc
    ctLoc Ct
    ct
        lcl_env :: TcLclEnv
    lcl_env = CtLoc -> TcLclEnv
    ctLocEnv CtLoc
    loc

    -- slightly more general version, to work also with holes
    relevant_bindings :: Bool
                      -> ReportErrCtxt
                      -> TcLclEnv
                      -> TyCoVarSet
                      -> TcM (ReportErrCtxt, SDoc)
    relevant_bindings :: Bool
    -> ReportErrCtxt
    -> TcLclEnv
    -> TyCoVarSet
    -> TcM (ReportErrCtxt, SDoc)
    relevant_bindings Bool
    want_filtering ReportErrCtxt
    ctxt TcLclEnv
    lcl_env TyCoVarSet
    ct_tvs
      = do { DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; String -> SDoc -> TcM ()
    traceTc String
    "relevant_bindings" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
               [SDoc] -> SDoc
    vcat [ TyCoVarSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TyCoVarSet
    ct_tvs
                    , (SDoc -> SDoc) -> [SDoc] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas SDoc -> SDoc
    forall a. a -> a
    id [ TcId -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcId
    id SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (TcId -> TcType
    idType TcId
    id)
                                       | TcIdBndr TcId
    id TopLevelFlag
    _ <- TcLclEnv -> TcBinderStack
    tcl_bndrs TcLclEnv
    lcl_env ]
                    , (SDoc -> SDoc) -> [SDoc] -> SDoc
    forall a. (a -> SDoc) -> [a] -> SDoc
    pprWithCommas SDoc -> SDoc
    forall a. a -> a
    id
                        [ Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    id | TcIdBndr_ExpType Name
    id ExpType
    _ TopLevelFlag
    _ <- TcLclEnv -> TcBinderStack
    tcl_bndrs TcLclEnv
    lcl_env ] ]

           ; (TidyEnv
    tidy_env', [SDoc]
    docs, Bool
    discards)
                  <- DynFlags
    -> TidyEnv
    -> Maybe Int
    -> TyCoVarSet
    -> [SDoc]
    -> Bool
    -> TcBinderStack
    -> TcM (TidyEnv, [SDoc], Bool)
    go DynFlags
    dflags (ReportErrCtxt -> TidyEnv
    cec_tidy ReportErrCtxt
    ctxt) (DynFlags -> Maybe Int
    maxRelevantBinds DynFlags
    dflags)
                        TyCoVarSet
    emptyVarSet [] Bool
    False
                        (TcBinderStack -> TcBinderStack
    forall a. HasOccName a => [a] -> [a]
    removeBindingShadowing (TcBinderStack -> TcBinderStack) -> TcBinderStack -> TcBinderStack
    forall a b. (a -> b) -> a -> b
    $ TcLclEnv -> TcBinderStack
    tcl_bndrs TcLclEnv
    lcl_env)
             -- tcl_bndrs has the innermost bindings first,
             -- which are probably the most relevant ones

           ; let doc :: SDoc
    doc = Bool -> SDoc -> SDoc
    ppUnless ([SDoc] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [SDoc]
    docs) (SDoc -> SDoc) -> SDoc -> SDoc
    forall a b. (a -> b) -> a -> b
    $
                       SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "Relevant bindings include")
                          Int
    2 ([SDoc] -> SDoc
    vcat [SDoc]
    docs SDoc -> SDoc -> SDoc
    $$ Bool -> SDoc -> SDoc
    ppWhen Bool
    discards SDoc
    discardMsg)

                 ctxt' :: ReportErrCtxt
    ctxt' = ReportErrCtxt
    ctxt { cec_tidy :: TidyEnv
    cec_tidy = TidyEnv
    tidy_env' }

           ; (ReportErrCtxt, SDoc) -> TcM (ReportErrCtxt, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ReportErrCtxt
    ctxt', SDoc
    doc) }
      where
        run_out :: Maybe Int -> Bool
        run_out :: Maybe Int -> Bool
    run_out Maybe Int
    Nothing = Bool
    False
        run_out (Just Int
    n) = Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    0

        dec_max :: Maybe Int -> Maybe Int
        dec_max :: Maybe Int -> Maybe Int
    dec_max = (Int -> Int) -> Maybe Int -> Maybe Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (\Int
    n -> Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)

        go :: DynFlags -> TidyEnv -> Maybe Int -> TcTyVarSet -> [SDoc]
           -> Bool                          -- True <=> some filtered out due to lack of fuel
           -> [TcBinder]
           -> TcM (TidyEnv, [SDoc], Bool)   -- The bool says if we filtered any out
                                            -- because of lack of fuel
        go :: DynFlags
    -> TidyEnv
    -> Maybe Int
    -> TyCoVarSet
    -> [SDoc]
    -> Bool
    -> TcBinderStack
    -> TcM (TidyEnv, [SDoc], Bool)
    go DynFlags
    _ TidyEnv
    tidy_env Maybe Int
    _ TyCoVarSet
    _ [SDoc]
    docs Bool
    discards []
          = (TidyEnv, [SDoc], Bool) -> TcM (TidyEnv, [SDoc], Bool)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    tidy_env, [SDoc] -> [SDoc]
    forall a. [a] -> [a]
    reverse [SDoc]
    docs, Bool
    discards)
        go DynFlags
    dflags TidyEnv
    tidy_env Maybe Int
    n_left TyCoVarSet
    tvs_seen [SDoc]
    docs Bool
    discards (TcBinder
    tc_bndr : TcBinderStack
    tc_bndrs)
          = case TcBinder
    tc_bndr of
              TcTvBndr {} -> TcM (TidyEnv, [SDoc], Bool)
    discard_it
              TcIdBndr TcId
    id TopLevelFlag
    top_lvl -> Name -> TcType -> TopLevelFlag -> TcM (TidyEnv, [SDoc], Bool)
    go2 (TcId -> Name
    idName TcId
    id) (TcId -> TcType
    idType TcId
    id) TopLevelFlag
    top_lvl
              TcIdBndr_ExpType Name
    name ExpType
    et TopLevelFlag
    top_lvl ->
                do { Maybe TcType
    mb_ty <- ExpType -> TcM (Maybe TcType)
    readExpType_maybe ExpType
    et
                       -- et really should be filled in by now. But there's a chance
                       -- it hasn't, if, say, we're reporting a kind error en route to
                       -- checking a term. See test indexed-types/should_fail/T8129
                       -- Or we are reporting errors from the ambiguity check on
                       -- a local type signature
                   ; case Maybe TcType
    mb_ty of
                       Just TcType
    ty -> Name -> TcType -> TopLevelFlag -> TcM (TidyEnv, [SDoc], Bool)
    go2 Name
    name TcType
    ty TopLevelFlag
    top_lvl
                       Maybe TcType
    Nothing -> TcM (TidyEnv, [SDoc], Bool)
    discard_it  -- No info; discard
                   }
          where
            discard_it :: TcM (TidyEnv, [SDoc], Bool)
    discard_it = DynFlags
    -> TidyEnv
    -> Maybe Int
    -> TyCoVarSet
    -> [SDoc]
    -> Bool
    -> TcBinderStack
    -> TcM (TidyEnv, [SDoc], Bool)
    go DynFlags
    dflags TidyEnv
    tidy_env Maybe Int
    n_left TyCoVarSet
    tvs_seen [SDoc]
    docs
                            Bool
    discards TcBinderStack
    tc_bndrs
            go2 :: Name -> TcType -> TopLevelFlag -> TcM (TidyEnv, [SDoc], Bool)
    go2 Name
    id_name TcType
    id_type TopLevelFlag
    top_lvl
              = do { (TidyEnv
    tidy_env', TcType
    tidy_ty) <- TidyEnv -> TcType -> TcM (TidyEnv, TcType)
    zonkTidyTcType TidyEnv
    tidy_env TcType
    id_type
                   ; String -> SDoc -> TcM ()
    traceTc String
    "relevantBindings 1" (Name -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Name
    id_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    tidy_ty)
                   ; let id_tvs :: TyCoVarSet
    id_tvs = TcType -> TyCoVarSet
    tyCoVarsOfType TcType
    tidy_ty
                         doc :: SDoc
    doc = [SDoc] -> SDoc
    sep [ Name -> SDoc
    forall a. OutputableBndr a => a -> SDoc
    pprPrefixOcc Name
    id_name SDoc -> SDoc -> SDoc
    <+> SDoc
    dcolon SDoc -> SDoc -> SDoc
    <+> TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    tidy_ty
                                   , Int -> SDoc -> SDoc
    nest Int
    2 (SDoc -> SDoc
    parens (String -> SDoc
    text String
    "bound at"
                                        SDoc -> SDoc -> SDoc
    <+> SrcLoc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Name -> SrcLoc
    forall a. NamedThing a => a -> SrcLoc
    getSrcLoc Name
    id_name)))]
                         new_seen :: TyCoVarSet
    new_seen = TyCoVarSet
    tvs_seen TyCoVarSet -> TyCoVarSet -> TyCoVarSet
    `unionVarSet` TyCoVarSet
    id_tvs

                   ; if (Bool
    want_filtering Bool -> Bool -> Bool
    && Bool -> Bool
    not (DynFlags -> Bool
    hasPprDebug DynFlags
    dflags)
                                        Bool -> Bool -> Bool
    && TyCoVarSet
    id_tvs TyCoVarSet -> TyCoVarSet -> Bool
    `disjointVarSet` TyCoVarSet
    ct_tvs)
                              -- We want to filter out this binding anyway
                              -- so discard it silently
                     then TcM (TidyEnv, [SDoc], Bool)
    discard_it

                     else if TopLevelFlag -> Bool
    isTopLevel TopLevelFlag
    top_lvl Bool -> Bool -> Bool
    && Bool -> Bool
    not (Maybe Int -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe Int
    n_left)
                              -- It's a top-level binding and we have not specified
                              -- -fno-max-relevant-bindings, so discard it silently
                     then TcM (TidyEnv, [SDoc], Bool)
    discard_it

                     else if Maybe Int -> Bool
    run_out Maybe Int
    n_left Bool -> Bool -> Bool
    && TyCoVarSet
    id_tvs TyCoVarSet -> TyCoVarSet -> Bool
    `subVarSet` TyCoVarSet
    tvs_seen
                              -- We've run out of n_left fuel and this binding only
                              -- mentions already-seen type variables, so discard it
                     then DynFlags
    -> TidyEnv
    -> Maybe Int
    -> TyCoVarSet
    -> [SDoc]
    -> Bool
    -> TcBinderStack
    -> TcM (TidyEnv, [SDoc], Bool)
    go DynFlags
    dflags TidyEnv
    tidy_env Maybe Int
    n_left TyCoVarSet
    tvs_seen [SDoc]
    docs
                             Bool
    True      -- Record that we have now discarded something
                             TcBinderStack
    tc_bndrs

                              -- Keep this binding, decrement fuel
                     else DynFlags
    -> TidyEnv
    -> Maybe Int
    -> TyCoVarSet
    -> [SDoc]
    -> Bool
    -> TcBinderStack
    -> TcM (TidyEnv, [SDoc], Bool)
    go DynFlags
    dflags TidyEnv
    tidy_env' (Maybe Int -> Maybe Int
    dec_max Maybe Int
    n_left) TyCoVarSet
    new_seen
                             (SDoc
    docSDoc -> [SDoc] -> [SDoc]
    forall a. a -> [a] -> [a]
    :[SDoc]
    docs) Bool
    discards TcBinderStack
    tc_bndrs }

    discardMsg :: SDoc
    discardMsg :: SDoc
    discardMsg = String -> SDoc
    text String
    "(Some bindings suppressed;" SDoc -> SDoc -> SDoc
    <+>
                 String -> SDoc
    text String
    "use -fmax-relevant-binds=N or -fno-max-relevant-binds)"

    -----------------------
    warnDefaulting :: [Ct] -> Type -> TcM ()
    warnDefaulting :: [Ct] -> TcType -> TcM ()
    warnDefaulting [Ct]
    wanteds TcType
    default_ty
      = do { Bool
    warn_default <- WarningFlag -> TcRnIf TcGblEnv TcLclEnv Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    Opt_WarnTypeDefaults
           ; TidyEnv
    env0 <- TcM TidyEnv
    tcInitTidyEnv
           ; let tidy_env :: TidyEnv
    tidy_env = TidyEnv -> [TcId] -> TidyEnv
    tidyFreeTyCoVars TidyEnv
    env0 ([TcId] -> TidyEnv) -> [TcId] -> TidyEnv
    forall a b. (a -> b) -> a -> b
    $
                            Cts -> [TcId]
    tyCoVarsOfCtsList ([Ct] -> Cts
    forall a. [a] -> Bag a
    listToBag [Ct]
    wanteds)
                 tidy_wanteds :: [Ct]
    tidy_wanteds = (Ct -> Ct) -> [Ct] -> [Ct]
    forall a b. (a -> b) -> [a] -> [b]
    map (TidyEnv -> Ct -> Ct
    tidyCt TidyEnv
    tidy_env) [Ct]
    wanteds
                 (CtLoc
    loc, SDoc
    ppr_wanteds) = [Ct] -> (CtLoc, SDoc)
    pprWithArising [Ct]
    tidy_wanteds
                 warn_msg :: SDoc
    warn_msg =
                    SDoc -> Int -> SDoc -> SDoc
    hang ([SDoc] -> SDoc
    hsep [ String -> SDoc
    text String
    "Defaulting the following"
                               , String -> SDoc
    text String
    "constraint" SDoc -> SDoc -> SDoc
    <> [Ct] -> SDoc
    forall a. [a] -> SDoc
    plural [Ct]
    tidy_wanteds
                               , String -> SDoc
    text String
    "to type"
                               , SDoc -> SDoc
    quotes (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    default_ty) ])
                         Int
    2
                         SDoc
    ppr_wanteds
           ; CtLoc -> TcM () -> TcM ()
    forall a. CtLoc -> TcM a -> TcM a
    setCtLocM CtLoc
    loc (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ WarnReason -> Bool -> SDoc -> TcM ()
    warnTc (WarningFlag -> WarnReason
    Reason WarningFlag
    Opt_WarnTypeDefaults) Bool
    warn_default SDoc
    warn_msg }

    {-
    Note [Runtime skolems]
    ~~~~~~~~~~~~~~~~~~~~~~
    We want to give a reasonably helpful error message for ambiguity
    arising from *runtime* skolems in the debugger.  These
    are created by in GHC.Runtime.Heap.Inspect.zonkRTTIType.

    ************************************************************************
    *                                                                      *
                     Error from the canonicaliser
             These ones are called *during* constraint simplification
    *                                                                      *
    ************************************************************************
    -}

    solverDepthErrorTcS :: CtLoc -> TcType -> TcM a
    solverDepthErrorTcS :: forall a. CtLoc -> TcType -> TcM a
    solverDepthErrorTcS CtLoc
    loc TcType
    ty
      = CtLoc -> TcM a -> TcM a
    forall a. CtLoc -> TcM a -> TcM a
    setCtLocM CtLoc
    loc (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
        do { TcType
    ty <- TcType -> TcM TcType
    zonkTcType TcType
    ty
           ; TidyEnv
    env0 <- TcM TidyEnv
    tcInitTidyEnv
           ; let tidy_env :: TidyEnv
    tidy_env     = TidyEnv -> [TcId] -> TidyEnv
    tidyFreeTyCoVars TidyEnv
    env0 (TcType -> [TcId]
    tyCoVarsOfTypeList TcType
    ty)
                 tidy_ty :: TcType
    tidy_ty      = TidyEnv -> TcType -> TcType
    tidyType TidyEnv
    tidy_env TcType
    ty
                 msg :: SDoc
    msg
                   = [SDoc] -> SDoc
    vcat [ String -> SDoc
    text String
    "Reduction stack overflow; size =" SDoc -> SDoc -> SDoc
    <+> SubGoalDepth -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SubGoalDepth
    depth
                          , SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    "When simplifying the following type:")
                               Int
    2 (TcType -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcType
    tidy_ty)
                          , SDoc
    note ]
           ; (TidyEnv, SDoc) -> TcM a
    forall a. (TidyEnv, SDoc) -> TcM a
    failWithTcM (TidyEnv
    tidy_env, SDoc
    msg) }
      where
        depth :: SubGoalDepth
    depth = CtLoc -> SubGoalDepth
    ctLocDepth CtLoc
    loc
        note :: SDoc
    note = [SDoc] -> SDoc
    vcat
          [ String -> SDoc
    text String
    "Use -freduction-depth=0 to disable this check"
          , String -> SDoc
    text String
    "(any upper bound you could choose might fail unpredictably with"
          , String -> SDoc
    text String
    " minor updates to GHC, so disabling the check is recommended if"
          , String -> SDoc
    text String
    " you're sure that type checking should terminate)" ]