    {-# LANGUAGE RecordWildCards   #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}

    {-
    (c) The University of Glasgow 2006

    -}

    -- | Functions for working with the typechecker environment (setters,
    -- getters...).
    module GHC.Tc.Utils.Monad(
      -- * Initialisation
      initTc, initTcWithGbl, initTcInteractive, initTcRnIf,

      -- * Simple accessors
      discardResult,
      getTopEnv, updTopEnv, updTopEnvIO, getGblEnv, updGblEnv,
      setGblEnv, getLclEnv, updLclEnv, updLclCtxt, setLclEnv, restoreLclEnv,
      updTopFlags,
      getEnvs, setEnvs, updEnvs, restoreEnvs,
      xoptM, doptM, goptM, woptM,
      setXOptM, setWOptM,
      unsetXOptM, unsetGOptM, unsetWOptM,
      whenDOptM, whenGOptM, whenWOptM,
      whenXOptM, unlessXOptM,
      getGhcMode,
      withoutDynamicNow,
      getEpsVar,
      getEps,
      updateEps, updateEps_,
      getHpt, getEpsAndHug,

      -- * Arrow scopes
      newArrowScope, escapeArrowScope,

      -- * Unique supply
      newUnique, newUniqueSupply, newName, newNameAt, cloneLocalName,
      newSysName, newSysLocalId, newSysLocalIds,

      -- * Accessing input/output
      newTcRef, readTcRef, writeTcRef, updTcRef, updTcRefM,

      -- * Debugging
      traceTc, traceRn, traceOptTcRn, dumpOptTcRn,
      dumpTcRn,
      getNamePprCtx,
      printForUserTcRn,
      traceIf, traceOptIf,
      debugTc,

      -- * Typechecker global environment
      getIsGHCi, getGHCiMonad, getInteractivePrintName,
      tcHscSource, tcIsHsBootOrSig, tcIsHsig, tcSelfBootInfo, getGlobalRdrEnv,
      getRdrEnvs, getImports,
      getFixityEnv, extendFixityEnv,
      getDeclaredDefaultTys,
      addDependentFiles,

      -- * Error management
      getSrcSpanM, setSrcSpan, setSrcSpanA, addLocM,
      inGeneratedCode, setInGeneratedCode,
      wrapLocM, wrapLocFstM, wrapLocFstMA, wrapLocSndM, wrapLocSndMA, wrapLocM_,
      wrapLocMA_,wrapLocMA,
      getErrsVar, setErrsVar,
      addErr,
      failWith, failAt,
      addErrAt, addErrs,
      checkErr, checkErrAt,
      addMessages,
      discardWarnings, mkDetailedMessage,

      -- * Usage environment
      tcCollectingUsage, tcScalingUsage, tcEmitBindingUsage,

      -- * Shared error message stuff: renamer and typechecker
      recoverM, mapAndRecoverM, mapAndReportM, foldAndRecoverM,
      attemptM, tryTc,
      askNoErrs, discardErrs,
      tryTcDiscardingErrs,
      tryTcDiscardingErrs',
      checkNoErrs, whenNoErrs,
      ifErrsM, failIfErrsM,

      -- * Context management for the type checker
      getErrCtxt, setErrCtxt, addErrCtxt, addErrCtxtM, addLandmarkErrCtxt,
      addLandmarkErrCtxtM, popErrCtxt, getCtLocM, setCtLocM, mkCtLocEnv,

      -- * Diagnostic message generation (type checker)
      addErrTc,
      addErrTcM,
      failWithTc, failWithTcM,
      checkTc, checkTcM,
      checkJustTc, checkJustTcM,
      failIfTc, failIfTcM,
      mkErrCtxt,
      addTcRnDiagnostic, addDetailedDiagnostic,
      mkTcRnMessage, reportDiagnostic, reportDiagnostics,
      warnIf, diagnosticTc, diagnosticTcM,
      addDiagnosticTc, addDiagnosticTcM, addDiagnostic, addDiagnosticAt,

      -- * Type constraints
      newTcEvBinds, newNoTcEvBinds, cloneEvBindsVar,
      addTcEvBind, addTcEvBinds, addTopEvBinds,
      getTcEvBindsMap, setTcEvBindsMap, updTcEvBinds,
      getTcEvTyCoVars, chooseUniqueOccTc,
      getConstraintVar, setConstraintVar,
      emitConstraints, emitStaticConstraints, emitSimple, emitSimples,
      emitImplication, emitImplications, ensureReflMultiplicityCo,
      emitDelayedErrors, emitHole, emitHoles, emitNotConcreteError,
      discardConstraints, captureConstraints, tryCaptureConstraints,
      pushLevelAndCaptureConstraints,
      pushTcLevelM_, pushTcLevelM,
      getTcLevel, setTcLevel, isTouchableTcM,
      getLclTypeEnv, setLclTypeEnv,
      traceTcConstraints,
      emitNamedTypeHole, IsExtraConstraint(..), emitAnonTypeHole,

      -- * Template Haskell context
      recordThUse, recordThNeededRuntimeDeps,
      keepAlive, getThLevel, getCurrentAndBindLevel, setThLevel,
      addModFinalizersWithLclEnv,

      -- * Safe Haskell context
      recordUnsafeInfer, finalSafeMode, fixSafeInstances,

      -- * Stuff for the renamer's local env
      getLocalRdrEnv, setLocalRdrEnv,

      -- * Stuff for interface decls
      mkIfLclEnv,
      initIfaceTcRn,
      initIfaceCheck,
      initIfaceLcl,
      initIfaceLclWithSubst,
      initIfaceLoad,
      initIfaceLoadModule,
      getIfModule,
      failIfM,
      forkM,
      setImplicitEnvM,

      withException, withIfaceErr,

      -- * Stuff for cost centres.
      getCCIndexM, getCCIndexTcM,

      -- * Zonking
      liftZonkM, newZonkAnyType,

      -- * Complete matches
      localAndImportedCompleteMatches, getCompleteMatchesTcM,

      -- * Types etc.
      module GHC.Tc.Types,
      module GHC.Data.IOEnv
      ) where

    import GHC.Prelude

    import GHC.Builtin.Names
    import GHC.Builtin.Types( zonkAnyTyCon )

    import GHC.Tc.Errors.Types
    import GHC.Tc.Types     -- Re-export all
    import GHC.Tc.Types.Constraint
    import GHC.Tc.Types.CtLoc
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Types.LclEnv
    import GHC.Tc.Types.Origin
    import GHC.Tc.Types.TcRef
    import GHC.Tc.Types.TH
    import GHC.Tc.Utils.TcType
    import GHC.Tc.Zonk.TcType

    import GHC.Hs hiding (LIE)

    import GHC.Unit
    import GHC.Unit.Env
    import GHC.Unit.External
    import GHC.Unit.Module.Warnings
    import GHC.Unit.Home.PackageTable

    import GHC.Core.UsageEnv
    import GHC.Core.Multiplicity
    import GHC.Core.InstEnv
    import GHC.Core.FamInstEnv
    import GHC.Core.Type( mkNumLitTy )

    import GHC.Driver.Env
    import GHC.Driver.Env.KnotVars
    import GHC.Driver.Session
    import GHC.Driver.Config.Diagnostic

    import GHC.Iface.Errors.Types
    import GHC.Iface.Errors.Ppr

    import GHC.Linker.Types

    import GHC.Runtime.Context

    import GHC.Data.IOEnv -- Re-export all
    import GHC.Data.Bag
    import GHC.Data.FastString
    import GHC.Data.Maybe

    import GHC.Utils.Outputable as Outputable
    import GHC.Utils.Error
    import GHC.Utils.Panic
    import GHC.Utils.Constants (debugIsOn)
    import GHC.Utils.Logger
    import qualified GHC.Data.Strict as Strict
    import qualified Data.Set as Set

    import GHC.Types.Error
    import GHC.Types.DefaultEnv ( DefaultEnv, emptyDefaultEnv )
    import GHC.Types.Fixity.Env
    import GHC.Types.Name.Reader
    import GHC.Types.Name
    import GHC.Types.SafeHaskell
    import GHC.Types.Id
    import GHC.Types.TypeEnv
    import GHC.Types.Var.Env
    import GHC.Types.SrcLoc
    import GHC.Types.Name.Env
    import GHC.Types.Name.Set
    import GHC.Types.Name.Ppr
    import GHC.Types.Unique.FM ( emptyUFM )
    import GHC.Types.Unique.DFM
    import GHC.Types.Unique.Supply
    import GHC.Types.Annotations
    import GHC.Types.Basic( TopLevelFlag(..), TypeOrKind(..) )
    import GHC.Types.CostCentre.State
    import GHC.Types.SourceFile

    import qualified GHC.LanguageExtensions as LangExt

    import Data.IORef
    import Control.Monad

    import qualified Data.Map as Map
    import GHC.Core.Coercion (isReflCo)

    {-
    ************************************************************************
    *                                                                      *
                            initTc
    *                                                                      *
    ************************************************************************
    -}

    -- | Setup the initial typechecking environment
    initTc :: HscEnv
           -> HscSource
           -> Bool          -- True <=> retain renamed syntax trees
           -> Module
           -> RealSrcSpan
           -> TcM r
           -> IO (Messages TcRnMessage, Maybe r)
                    -- Nothing => error thrown by the thing inside
                    -- (error messages should have been printed already)

    initTc :: forall r.
    HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages TcRnMessage, Maybe r)
    initTc HscEnv
    hsc_env HscSource
    hsc_src Bool
    keep_rn_syntax Module
    mod RealSrcSpan
    loc TcM r
    do_this
     = do { keep_var     <- NameSet -> IO (IORef NameSet)
    forall a. a -> IO (IORef a)
    newIORef NameSet
    emptyNameSet ;
            used_gre_var <- newIORef [] ;
            th_var       <- newIORef False ;
            infer_var    <- newIORef True ;
            infer_reasons_var <- newIORef emptyMessages ;
            dfun_n_var   <- newIORef emptyOccSet ;
            zany_n_var   <- newIORef 0 ;
            let { type_env_var = HscEnv -> KnotVars (IORef TypeEnv)
    hsc_type_env_vars HscEnv
    hsc_env };

            dependent_files_var <- newIORef [] ;
            static_wc_var       <- newIORef emptyWC ;
            cc_st_var           <- newIORef newCostCentreState ;
            th_topdecls_var      <- newIORef [] ;
            th_foreign_files_var <- newIORef [] ;
            th_topnames_var      <- newIORef emptyNameSet ;
            th_modfinalizers_var <- newIORef [] ;
            th_coreplugins_var <- newIORef [] ;
            th_state_var         <- newIORef Map.empty ;
            th_remote_state_var  <- newIORef Nothing ;
            th_docs_var          <- newIORef Map.empty ;
            th_needed_deps_var   <- newIORef ([], emptyUDFM) ;
            next_wrapper_num     <- newIORef emptyModuleEnv ;
            let {
                 -- bangs to avoid leaking the env (#19356)
                 !dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env ;
                 !mhome_unit = HscEnv -> Maybe HomeUnit
    hsc_home_unit_maybe HscEnv
    hsc_env;
                 !logger = HscEnv -> Logger
    hsc_logger HscEnv
    hsc_env ;

                 maybe_rn_syntax :: forall a. a -> Maybe a ;
                 maybe_rn_syntax a
    empty_val
                    | Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_rn_ast = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    empty_val

                    | GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_WriteHie DynFlags
    dflags       = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    empty_val

                      -- We want to serialize the documentation in the .hi-files,
                      -- and need to extract it from the renamed syntax first.
                      -- See 'GHC.HsToCore.Docs.extractDocs'.
                    | GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_Haddock DynFlags
    dflags       = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    empty_val

                    | Bool
    keep_rn_syntax                = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    empty_val
                    | Bool
    otherwise                     = Maybe a
    forall a. Maybe a
    Nothing ;

                 gbl_env = TcGblEnv {
                    tcg_th_topdecls :: TcRef [LHsDecl GhcPs]
    tcg_th_topdecls      = TcRef [LHsDecl GhcPs]
    IORef [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    th_topdecls_var,
                    tcg_th_foreign_files :: IORef [(ForeignSrcLang, FilePath)]
    tcg_th_foreign_files = IORef [(ForeignSrcLang, FilePath)]
    th_foreign_files_var,
                    tcg_th_topnames :: IORef NameSet
    tcg_th_topnames      = IORef NameSet
    th_topnames_var,
                    tcg_th_modfinalizers :: IORef [(TcLclEnv, ThModFinalizers)]
    tcg_th_modfinalizers = IORef [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers_var,
                    tcg_th_coreplugins :: IORef [FilePath]
    tcg_th_coreplugins = IORef [FilePath]
    th_coreplugins_var,
                    tcg_th_state :: IORef (Map TypeRep Dynamic)
    tcg_th_state         = IORef (Map TypeRep Dynamic)
    th_state_var,
                    tcg_th_remote_state :: IORef (Maybe (ForeignRef (IORef QState)))
    tcg_th_remote_state  = IORef (Maybe (ForeignRef (IORef QState)))
    th_remote_state_var,
                    tcg_th_docs :: IORef (Map DocLoc (HsDoc GhcRn))
    tcg_th_docs          = IORef (Map DocLoc (HsDoc GhcRn))
    th_docs_var,

                    tcg_mod :: Module
    tcg_mod            = Module
    mod,
                    tcg_semantic_mod :: Module
    tcg_semantic_mod   = Maybe HomeUnit -> Module -> Module
    homeModuleInstantiation Maybe HomeUnit
    mhome_unit Module
    mod,
                    tcg_src :: HscSource
    tcg_src            = HscSource
    hsc_src,
                    tcg_rdr_env :: GlobalRdrEnv
    tcg_rdr_env        = GlobalRdrEnv
    forall info. GlobalRdrEnvX info
    emptyGlobalRdrEnv,
                    tcg_fix_env :: FixityEnv
    tcg_fix_env        = FixityEnv
    forall a. NameEnv a
    emptyNameEnv,
                    tcg_default :: DefaultEnv
    tcg_default        = DefaultEnv
    emptyDefaultEnv,
                    tcg_default_exports :: DefaultEnv
    tcg_default_exports = DefaultEnv
    emptyDefaultEnv,
                    tcg_type_env :: TypeEnv
    tcg_type_env       = TypeEnv
    forall a. NameEnv a
    emptyNameEnv,
                    tcg_type_env_var :: KnotVars (IORef TypeEnv)
    tcg_type_env_var   = KnotVars (IORef TypeEnv)
    type_env_var,
                    tcg_inst_env :: InstEnv
    tcg_inst_env       = InstEnv
    emptyInstEnv,
                    tcg_fam_inst_env :: FamInstEnv
    tcg_fam_inst_env   = FamInstEnv
    emptyFamInstEnv,
                    tcg_ann_env :: AnnEnv
    tcg_ann_env        = AnnEnv
    emptyAnnEnv,
                    tcg_complete_match_env :: CompleteMatches
    tcg_complete_match_env = [],
                    tcg_th_used :: IORef Bool
    tcg_th_used        = IORef Bool
    th_var,
                    tcg_th_needed_deps :: IORef ([Linkable], UniqDFM UnitId LoadedPkgInfo)
    tcg_th_needed_deps = IORef ([Linkable], UniqDFM UnitId LoadedPkgInfo)
    th_needed_deps_var,
                    tcg_exports :: [AvailInfo]
    tcg_exports        = [],
                    tcg_imports :: ImportAvails
    tcg_imports        = ImportAvails
    emptyImportAvails,
                    tcg_import_decls :: [ImportUserSpec]
    tcg_import_decls   = [],
                    tcg_used_gres :: IORef [GlobalRdrElt]
    tcg_used_gres     = IORef [GlobalRdrElt]
    used_gre_var,
                    tcg_dus :: DefUses
    tcg_dus            = DefUses
    emptyDUs,

                    tcg_rn_imports :: [LImportDecl GhcRn]
    tcg_rn_imports     = [],
                    tcg_rn_exports :: Maybe [(LIE GhcRn, [AvailInfo])]
    tcg_rn_exports     =
                        if HscSource
    hsc_src HscSource -> HscSource -> Bool
    forall a. Eq a => a -> a -> Bool
    == HscSource
    HsigFile
                            -- Always retain renamed syntax, so that we can give
                            -- better errors.  (TODO: how?)
                            then [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
    -> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
    forall a. a -> Maybe a
    Just []
                            else [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
    -> Maybe [(GenLocated SrcSpanAnnA (IE GhcRn), [AvailInfo])]
    forall a. a -> Maybe a
    maybe_rn_syntax [],
                    tcg_rn_decls :: Maybe (HsGroup GhcRn)
    tcg_rn_decls       = HsGroup GhcRn -> Maybe (HsGroup GhcRn)
    forall a. a -> Maybe a
    maybe_rn_syntax HsGroup GhcRn
    forall (p :: Pass). HsGroup (GhcPass p)
    emptyRnGroup,
                    tcg_tr_module :: Maybe Id
    tcg_tr_module      = Maybe Id
    forall a. Maybe a
    Nothing,
                    tcg_binds :: LHsBinds GhcTc
    tcg_binds          = LHsBinds GhcTc
    forall (idL :: Pass) idR. LHsBindsLR (GhcPass idL) idR
    emptyLHsBinds,
                    tcg_imp_specs :: [LTcSpecPrag]
    tcg_imp_specs      = [],
                    tcg_sigs :: NameSet
    tcg_sigs           = NameSet
    emptyNameSet,
                    tcg_ksigs :: NameSet
    tcg_ksigs          = NameSet
    emptyNameSet,
                    tcg_ev_binds :: Bag EvBind
    tcg_ev_binds       = Bag EvBind
    forall a. Bag a
    emptyBag,
                    tcg_warns :: Warnings GhcRn
    tcg_warns          = Warnings GhcRn
    forall p. Warnings p
    emptyWarn,
                    tcg_anns :: [Annotation]
    tcg_anns           = [],
                    tcg_tcs :: [TyCon]
    tcg_tcs            = [],
                    tcg_insts :: [ClsInst]
    tcg_insts          = [],
                    tcg_fam_insts :: [FamInst]
    tcg_fam_insts      = [],
                    tcg_rules :: [LRuleDecl GhcTc]
    tcg_rules          = [],
                    tcg_fords :: [LForeignDecl GhcTc]
    tcg_fords          = [],
                    tcg_patsyns :: [PatSyn]
    tcg_patsyns        = [],
                    tcg_merged :: [(Module, Fingerprint)]
    tcg_merged         = [],
                    tcg_dfun_n :: IORef OccSet
    tcg_dfun_n         = IORef OccSet
    dfun_n_var,
                    tcg_zany_n :: IORef Integer
    tcg_zany_n         = IORef Integer
    zany_n_var,
                    tcg_keep :: IORef NameSet
    tcg_keep           = IORef NameSet
    keep_var,
                    tcg_hdr_info :: (Maybe (LHsDoc GhcRn), Maybe (XRec GhcRn ModuleName))
    tcg_hdr_info        = (Maybe (LHsDoc GhcRn)
    forall a. Maybe a
    Nothing,Maybe (XRec GhcRn ModuleName)
    Maybe (GenLocated SrcSpanAnnA ModuleName)
    forall a. Maybe a
    Nothing),
                    tcg_main :: Maybe Name
    tcg_main           = Maybe Name
    forall a. Maybe a
    Nothing,
                    tcg_self_boot :: SelfBootInfo
    tcg_self_boot      = SelfBootInfo
    NoSelfBoot,
                    tcg_safe_infer :: IORef Bool
    tcg_safe_infer     = IORef Bool
    infer_var,
                    tcg_safe_infer_reasons :: IORef (Messages TcRnMessage)
    tcg_safe_infer_reasons = IORef (Messages TcRnMessage)
    infer_reasons_var,
                    tcg_dependent_files :: IORef [FilePath]
    tcg_dependent_files = IORef [FilePath]
    dependent_files_var,
                    tcg_tc_plugin_solvers :: [TcPluginSolver]
    tcg_tc_plugin_solvers   = [],
                    tcg_tc_plugin_rewriters :: UniqFM TyCon [TcPluginRewriter]
    tcg_tc_plugin_rewriters = UniqFM TyCon [TcPluginRewriter]
    forall {k} (key :: k) elt. UniqFM key elt
    emptyUFM,
                    tcg_defaulting_plugins :: [FillDefaulting]
    tcg_defaulting_plugins  = [],
                    tcg_hf_plugins :: [HoleFitPlugin]
    tcg_hf_plugins     = [],
                    tcg_top_loc :: RealSrcSpan
    tcg_top_loc        = RealSrcSpan
    loc,
                    tcg_static_wc :: IORef WantedConstraints
    tcg_static_wc      = IORef WantedConstraints
    static_wc_var,
                    tcg_complete_matches :: CompleteMatches
    tcg_complete_matches = [],
                    tcg_cc_st :: IORef CostCentreState
    tcg_cc_st          = IORef CostCentreState
    cc_st_var,
                    tcg_next_wrapper_num :: IORef (ModuleEnv Int)
    tcg_next_wrapper_num = IORef (ModuleEnv Int)
    next_wrapper_num
                 } ;
            } ;

            -- OK, here's the business end!
            initTcWithGbl hsc_env gbl_env loc do_this
        }

    -- | Run a 'TcM' action in the context of an existing 'GblEnv'.
    initTcWithGbl :: HscEnv
                  -> TcGblEnv
                  -> RealSrcSpan
                  -> TcM r
                  -> IO (Messages TcRnMessage, Maybe r)
    initTcWithGbl :: forall r.
    HscEnv
    -> TcGblEnv
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages TcRnMessage, Maybe r)
    initTcWithGbl HscEnv
    hsc_env TcGblEnv
    gbl_env RealSrcSpan
    loc TcM r
    do_this
     = do { lie_var      <- WantedConstraints -> IO (IORef WantedConstraints)
    forall a. a -> IO (IORef a)
    newIORef WantedConstraints
    emptyWC
          ; errs_var     <- newIORef emptyMessages
          ; usage_var    <- newIORef zeroUE
          ; let lcl_env = TcLclEnv {
                    tcl_lcl_ctxt :: TcLclCtxt
    tcl_lcl_ctxt   = TcLclCtxt {
                    tcl_loc :: RealSrcSpan
    tcl_loc        = RealSrcSpan
    loc,
                    -- tcl_loc should be over-ridden very soon!
                    tcl_in_gen_code :: Bool
    tcl_in_gen_code = Bool
    False,
                    tcl_ctxt :: [ErrCtxt]
    tcl_ctxt       = [],
                    tcl_rdr :: LocalRdrEnv
    tcl_rdr        = LocalRdrEnv
    emptyLocalRdrEnv,
                    tcl_th_ctxt :: ThLevel
    tcl_th_ctxt    = ThLevel
    topLevel,
                    tcl_th_bndrs :: ThBindEnv
    tcl_th_bndrs   = ThBindEnv
    forall a. NameEnv a
    emptyNameEnv,
                    tcl_arrow_ctxt :: ArrowCtxt
    tcl_arrow_ctxt = ArrowCtxt
    NoArrowCtxt,
                    tcl_env :: TcTypeEnv
    tcl_env        = TcTypeEnv
    forall a. NameEnv a
    emptyNameEnv,
                    tcl_bndrs :: TcBinderStack
    tcl_bndrs      = [],
                    tcl_tclvl :: TcLevel
    tcl_tclvl      = TcLevel
    topTcLevel
                    },
                    tcl_usage :: IORef UsageEnv
    tcl_usage      = IORef UsageEnv
    usage_var,
                    tcl_lie :: IORef WantedConstraints
    tcl_lie        = IORef WantedConstraints
    lie_var,
                    tcl_errs :: IORef (Messages TcRnMessage)
    tcl_errs       = IORef (Messages TcRnMessage)
    errs_var
                    }

          ; maybe_res <- initTcRnIf 'a' hsc_env gbl_env lcl_env $
                         do { r <- tryM do_this
                            ; case r of
                              Right r
    res -> Maybe r -> TcRnIf TcGblEnv TcLclEnv (Maybe r)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (r -> Maybe r
    forall a. a -> Maybe a
    Just r
    res)
                              Left IOEnvFailure
    _    -> Maybe r -> TcRnIf TcGblEnv TcLclEnv (Maybe r)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe r
    forall a. Maybe a
    Nothing }

          -- Check for unsolved constraints
          -- If we succeed (maybe_res = Just r), there should be
          -- no unsolved constraints.  But if we exit via an
          -- exception (maybe_res = Nothing), we may have skipped
          -- solving, so don't panic then (#13466)
          ; lie <- readIORef (tcl_lie lcl_env)
          ; when (isJust maybe_res && not (isEmptyWC lie)) $
            pprPanic "initTc: unsolved constraints" (ppr lie)

            -- Collect any error messages
          ; msgs <- readIORef (tcl_errs lcl_env)

          ; let { final_res | Messages TcRnMessage -> Bool
    forall e. Diagnostic e => Messages e -> Bool
    errorsFound Messages TcRnMessage
    msgs = Maybe r
    forall a. Maybe a
    Nothing
                            | Bool
    otherwise        = Maybe r
    maybe_res }

          ; return (msgs, final_res)
          }

    initTcInteractive :: HscEnv -> TcM a -> IO (Messages TcRnMessage, Maybe a)
    -- Initialise the type checker monad for use in GHCi
    initTcInteractive :: forall a. HscEnv -> TcM a -> IO (Messages TcRnMessage, Maybe a)
    initTcInteractive HscEnv
    hsc_env TcM a
    thing_inside
      = HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM a
    -> IO (Messages TcRnMessage, Maybe a)
    forall r.
    HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages TcRnMessage, Maybe r)
    initTc HscEnv
    hsc_env HscSource
    HsSrcFile Bool
    False
               (InteractiveContext -> Module
    icInteractiveModule (HscEnv -> InteractiveContext
    hsc_IC HscEnv
    hsc_env))
               (RealSrcLoc -> RealSrcSpan
    realSrcLocSpan RealSrcLoc
    interactive_src_loc)
               TcM a
    thing_inside
      where
        interactive_src_loc :: RealSrcLoc
    interactive_src_loc = FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (FilePath -> FastString
    fsLit FilePath
    "<interactive>") Int
    1 Int
    1

    initTcRnIf :: Char              -- ^ Tag for unique supply
               -> HscEnv
               -> gbl -> lcl
               -> TcRnIf gbl lcl a
               -> IO a
    initTcRnIf :: forall gbl lcl a.
    Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
    initTcRnIf Char
    uniq_tag HscEnv
    hsc_env gbl
    gbl_env lcl
    lcl_env TcRnIf gbl lcl a
    thing_inside
       = do { let { env :: Env gbl lcl
    env = Env { env_top :: HscEnv
    env_top = HscEnv
    hsc_env,
                                env_ut :: Char
    env_ut  = Char
    uniq_tag,
                                env_gbl :: gbl
    env_gbl = gbl
    gbl_env,
                                env_lcl :: lcl
    env_lcl = lcl
    lcl_env} }

            ; Env gbl lcl -> TcRnIf gbl lcl a -> IO a
    forall env a. env -> IOEnv env a -> IO a
    runIOEnv Env gbl lcl
    env TcRnIf gbl lcl a
    thing_inside
            }

    {-
    ************************************************************************
    *                                                                      *
                    Simple accessors
    *                                                                      *
    ************************************************************************
    -}

    discardResult :: TcM a -> TcM ()
    discardResult :: forall a. TcM a -> TcM ()
    discardResult TcM a
    a = TcM a
    a TcM a -> TcM () -> TcM ()
    forall a b.
    IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    getTopEnv :: TcRnIf gbl lcl HscEnv
    getTopEnv :: forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv = do { env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; return (env_top env) }

    updTopEnv :: (HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopEnv :: forall gbl lcl a.
    (HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopEnv HscEnv -> HscEnv
    upd = (Env gbl lcl -> Env gbl lcl)
    -> IOEnv (Env gbl lcl) a -> IOEnv (Env gbl lcl) a
    forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv (\ env :: Env gbl lcl
    env@(Env { env_top :: forall gbl lcl. Env gbl lcl -> HscEnv
    env_top = HscEnv
    top }) ->
                              Env gbl lcl
    env { env_top = upd top })

    updTopEnvIO :: (HscEnv -> IO HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopEnvIO :: forall gbl lcl a.
    (HscEnv -> IO HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopEnvIO HscEnv -> IO HscEnv
    upd = (Env gbl lcl -> IO (Env gbl lcl))
    -> IOEnv (Env gbl lcl) a -> IOEnv (Env gbl lcl) a
    forall env env' a. (env -> IO env') -> IOEnv env' a -> IOEnv env a
    updEnvIO (\ env :: Env gbl lcl
    env@(Env { env_top :: forall gbl lcl. Env gbl lcl -> HscEnv
    env_top = HscEnv
    top }) ->
                                    HscEnv -> IO HscEnv
    upd HscEnv
    top IO HscEnv -> (HscEnv -> IO (Env gbl lcl)) -> IO (Env gbl lcl)
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \HscEnv
    t' ->
                                    Env gbl lcl -> IO (Env gbl lcl)
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Env gbl lcl
    env{ env_top = t' })

    getGblEnv :: TcRnIf gbl lcl gbl
    getGblEnv :: forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv = do { Env{..} <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; return env_gbl }

    updGblEnv :: (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv :: forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv gbl -> gbl
    upd = (Env gbl lcl -> Env gbl lcl)
    -> IOEnv (Env gbl lcl) a -> IOEnv (Env gbl lcl) a
    forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv (\ env :: Env gbl lcl
    env@(Env { env_gbl :: forall gbl lcl. Env gbl lcl -> gbl
    env_gbl = gbl
    gbl }) ->
                              Env gbl lcl
    env { env_gbl = upd gbl })

    setGblEnv :: gbl' -> TcRnIf gbl' lcl a -> TcRnIf gbl lcl a
    setGblEnv :: forall gbl' lcl a gbl.
    gbl' -> TcRnIf gbl' lcl a -> TcRnIf gbl lcl a
    setGblEnv gbl'
    gbl_env = (Env gbl lcl -> Env gbl' lcl)
    -> IOEnv (Env gbl' lcl) a -> IOEnv (Env gbl lcl) a
    forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv (\ Env gbl lcl
    env -> Env gbl lcl
    env { env_gbl = gbl_env })

    getLclEnv :: TcRnIf gbl lcl lcl
    getLclEnv :: forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv = do { Env{..} <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; return env_lcl }

    updLclEnv :: (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv :: forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv lcl -> lcl
    upd = (Env gbl lcl -> Env gbl lcl)
    -> IOEnv (Env gbl lcl) a -> IOEnv (Env gbl lcl) a
    forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv (\ env :: Env gbl lcl
    env@(Env { env_lcl :: forall gbl lcl. Env gbl lcl -> lcl
    env_lcl = lcl
    lcl }) ->
                              Env gbl lcl
    env { env_lcl = upd lcl })

    updLclCtxt :: (TcLclCtxt -> TcLclCtxt) -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    updLclCtxt :: forall gbl a.
    (TcLclCtxt -> TcLclCtxt)
    -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    updLclCtxt TcLclCtxt -> TcLclCtxt
    upd = (TcLclEnv -> TcLclEnv)
    -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv ((TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
    modifyLclCtxt TcLclCtxt -> TcLclCtxt
    upd)

    setLclEnv :: lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv :: forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv lcl'
    lcl_env = (Env gbl lcl -> Env gbl lcl')
    -> IOEnv (Env gbl lcl') a -> IOEnv (Env gbl lcl) a
    forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv (\ Env gbl lcl
    env -> Env gbl lcl
    env { env_lcl = lcl_env })

    restoreLclEnv :: TcLclEnv -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    -- See Note [restoreLclEnv vs setLclEnv]
    restoreLclEnv :: forall gbl a.
    TcLclEnv -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    restoreLclEnv TcLclEnv
    new_lcl_env = (TcLclEnv -> TcLclEnv)
    -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv TcLclEnv -> TcLclEnv
    upd
      where
        upd :: TcLclEnv -> TcLclEnv
    upd TcLclEnv
    old_lcl_env =  TcLclEnv
    new_lcl_env { tcl_errs  = tcl_errs  old_lcl_env
                                       , tcl_lie   = tcl_lie   old_lcl_env
                                       , tcl_usage = tcl_usage old_lcl_env }

    getEnvs :: TcRnIf gbl lcl (gbl, lcl)
    getEnvs :: forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs = do { env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; return (env_gbl env, env_lcl env) }

    setEnvs :: (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs :: forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (gbl'
    gbl_env, lcl'
    lcl_env) = gbl' -> TcRnIf gbl' lcl a -> TcRnIf gbl lcl a
    forall gbl' lcl a gbl.
    gbl' -> TcRnIf gbl' lcl a -> TcRnIf gbl lcl a
    setGblEnv gbl'
    gbl_env (TcRnIf gbl' lcl a -> TcRnIf gbl lcl a)
    -> (TcRnIf gbl' lcl' a -> TcRnIf gbl' lcl a)
    -> TcRnIf gbl' lcl' a
    -> TcRnIf gbl lcl a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . lcl' -> TcRnIf gbl' lcl' a -> TcRnIf gbl' lcl a
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv lcl'
    lcl_env

    updEnvs :: ((gbl,lcl) -> (gbl, lcl)) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updEnvs :: forall gbl lcl a.
    ((gbl, lcl) -> (gbl, lcl)) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updEnvs (gbl, lcl) -> (gbl, lcl)
    upd_envs = (Env gbl lcl -> Env gbl lcl)
    -> IOEnv (Env gbl lcl) a -> IOEnv (Env gbl lcl) a
    forall env env' a. (env -> env') -> IOEnv env' a -> IOEnv env a
    updEnv Env gbl lcl -> Env gbl lcl
    upd
      where
        upd :: Env gbl lcl -> Env gbl lcl
    upd env :: Env gbl lcl
    env@(Env { env_gbl :: forall gbl lcl. Env gbl lcl -> gbl
    env_gbl = gbl
    gbl, env_lcl :: forall gbl lcl. Env gbl lcl -> lcl
    env_lcl = lcl
    lcl })
          = Env gbl lcl
    env { env_gbl = gbl', env_lcl = lcl' }
          where
            !(gbl
    gbl', lcl
    lcl') = (gbl, lcl) -> (gbl, lcl)
    upd_envs (gbl
    gbl, lcl
    lcl)

    restoreEnvs :: (TcGblEnv, TcLclEnv) -> TcRn a -> TcRn a
    -- See Note [restoreLclEnv vs setLclEnv]
    restoreEnvs :: forall a. (TcGblEnv, TcLclEnv) -> TcRn a -> TcRn a
    restoreEnvs (TcGblEnv
    gbl, TcLclEnv
    lcl) = TcGblEnv
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall gbl' lcl a gbl.
    gbl' -> TcRnIf gbl' lcl a -> TcRnIf gbl lcl a
    setGblEnv TcGblEnv
    gbl (TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a)
    -> (TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a)
    -> TcRnIf TcGblEnv TcLclEnv a
    -> TcRnIf TcGblEnv TcLclEnv a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TcLclEnv
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall gbl a.
    TcLclEnv -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    restoreLclEnv TcLclEnv
    lcl

    {- Note [restoreLclEnv vs setLclEnv]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In the typechecker we use this idiom quite a lot
       do { (gbl_env, lcl_env) <- tcRnSrcDecls ...
          ; setGblEnv gbl_env $ setLclEnv lcl_env $
            more_stuff }

    The `tcRnSrcDecls` extends the environments in `gbl_env` and `lcl_env`
    which we then want to be in scope in `more stuff`.

    The problem is that `lcl_env :: TcLclEnv` has an IORef for error
    messages `tcl_errs`, and another for constraints (`tcl_lie`), and
    another for Linear Haskell usage information (`tcl_usage`).  Now
    suppose we change it a tiny bit
       do { (gbl_env, lcl_env) <- checkNoErrs $
                                  tcRnSrcDecls ...
          ; setGblEnv gbl_env $ setLclEnv lcl_env $
            more_stuff }

    That should be innocuous.  But *alas*, `checkNoErrs` gathers errors in
    a fresh IORef *which is then captured in the returned `lcl_env`.  When
    we do the `setLclEnv` we'll make that captured IORef into the place
    where we gather error messages -- but no one is going to look at that!!!
    This led to #19470 and #20981.

    Solution: instead of setLclEnv use restoreLclEnv, which preserves from
    the /parent/ context these mutable collection IORefs:
          tcl_errs, tcl_lie, tcl_usage
    -}

    -- Command-line flags

    xoptM :: LangExt.Extension -> TcRnIf gbl lcl Bool
    xoptM :: forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    flag = Extension -> DynFlags -> Bool
    xopt Extension
    flag (DynFlags -> Bool)
    -> IOEnv (Env gbl lcl) DynFlags -> IOEnv (Env gbl lcl) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

    doptM :: DumpFlag -> TcRnIf gbl lcl Bool
    doptM :: forall gbl lcl. DumpFlag -> TcRnIf gbl lcl Bool
    doptM DumpFlag
    flag = do
      logger <- IOEnv (Env gbl lcl) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
      return (logHasDumpFlag logger flag)

    goptM :: GeneralFlag -> TcRnIf gbl lcl Bool
    goptM :: forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    flag = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    flag (DynFlags -> Bool)
    -> IOEnv (Env gbl lcl) DynFlags -> IOEnv (Env gbl lcl) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

    woptM :: WarningFlag -> TcRnIf gbl lcl Bool
    woptM :: forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    flag = WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    flag (DynFlags -> Bool)
    -> IOEnv (Env gbl lcl) DynFlags -> IOEnv (Env gbl lcl) Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

    setXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM :: forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setXOptM Extension
    flag = (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    forall gbl lcl a.
    (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags (\DynFlags
    dflags -> DynFlags -> Extension -> DynFlags
    xopt_set DynFlags
    dflags Extension
    flag)

    setWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setWOptM :: forall gbl lcl a.
    WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setWOptM WarningFlag
    flag = (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    forall gbl lcl a.
    (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags (\DynFlags
    dflags -> DynFlags -> WarningFlag -> DynFlags
    wopt_set DynFlags
    dflags WarningFlag
    flag)

    unsetXOptM :: LangExt.Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetXOptM :: forall gbl lcl a. Extension -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetXOptM Extension
    flag = (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    forall gbl lcl a.
    (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags (\DynFlags
    dflags -> DynFlags -> Extension -> DynFlags
    xopt_unset DynFlags
    dflags Extension
    flag)

    unsetGOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetGOptM :: forall gbl lcl a.
    GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetGOptM GeneralFlag
    flag = (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    forall gbl lcl a.
    (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags (\DynFlags
    dflags -> DynFlags -> GeneralFlag -> DynFlags
    gopt_unset DynFlags
    dflags GeneralFlag
    flag)

    unsetWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetWOptM :: forall gbl lcl a.
    WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    unsetWOptM WarningFlag
    flag = (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    forall gbl lcl a.
    (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags (\DynFlags
    dflags -> DynFlags -> WarningFlag -> DynFlags
    wopt_unset DynFlags
    dflags WarningFlag
    flag)

    -- | Do it flag is true
    whenDOptM :: DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenDOptM :: forall gbl lcl. DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenDOptM DumpFlag
    flag TcRnIf gbl lcl ()
    thing_inside = do b <- DumpFlag -> TcRnIf gbl lcl Bool
    forall gbl lcl. DumpFlag -> TcRnIf gbl lcl Bool
    doptM DumpFlag
    flag
                                     when b thing_inside
    {-# INLINE whenDOptM #-} -- see Note [INLINE conditional tracing utilities]

    whenGOptM :: GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenGOptM :: forall gbl lcl.
    GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenGOptM GeneralFlag
    flag TcRnIf gbl lcl ()
    thing_inside = do b <- GeneralFlag -> TcRnIf gbl lcl Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    flag
                                     when b thing_inside
    {-# INLINE whenGOptM #-} -- see Note [INLINE conditional tracing utilities]

    whenWOptM :: WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenWOptM :: forall gbl lcl.
    WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenWOptM WarningFlag
    flag TcRnIf gbl lcl ()
    thing_inside = do b <- WarningFlag -> TcRnIf gbl lcl Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    flag
                                     when b thing_inside
    {-# INLINE whenWOptM #-} -- see Note [INLINE conditional tracing utilities]

    whenXOptM :: LangExt.Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenXOptM :: forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenXOptM Extension
    flag TcRnIf gbl lcl ()
    thing_inside = do b <- Extension -> TcRnIf gbl lcl Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    flag
                                     when b thing_inside
    {-# INLINE whenXOptM #-} -- see Note [INLINE conditional tracing utilities]

    unlessXOptM :: LangExt.Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    unlessXOptM :: forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    unlessXOptM Extension
    flag TcRnIf gbl lcl ()
    thing_inside = do b <- Extension -> TcRnIf gbl lcl Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    flag
                                       unless b thing_inside
    {-# INLINE unlessXOptM #-} -- see Note [INLINE conditional tracing utilities]

    getGhcMode :: TcRnIf gbl lcl GhcMode
    getGhcMode :: forall gbl lcl. TcRnIf gbl lcl GhcMode
    getGhcMode = DynFlags -> GhcMode
    ghcMode (DynFlags -> GhcMode)
    -> IOEnv (Env gbl lcl) DynFlags -> IOEnv (Env gbl lcl) GhcMode
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

    withoutDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    withoutDynamicNow :: forall gbl lcl a. TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    withoutDynamicNow = (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    forall gbl lcl a.
    (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags (\DynFlags
    dflags -> DynFlags
    dflags { dynamicNow = False})

    updTopFlags :: (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags :: forall gbl lcl a.
    (DynFlags -> DynFlags) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopFlags DynFlags -> DynFlags
    f = (HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    forall gbl lcl a.
    (HscEnv -> HscEnv) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updTopEnv ((DynFlags -> DynFlags) -> HscEnv -> HscEnv
    hscUpdateFlags DynFlags -> DynFlags
    f)

    getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState)
    getEpsVar :: forall gbl lcl. TcRnIf gbl lcl (TcRef ExternalPackageState)
    getEpsVar = do
      env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
      return (euc_eps (ue_eps (hsc_unit_env env)))

    getEps :: TcRnIf gbl lcl ExternalPackageState
    getEps :: forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
    getEps = do { env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; liftIO $ hscEPS env }

    -- | Update the external package state.  Returns the second result of the
    -- modifier function.
    --
    -- This is an atomic operation and forces evaluation of the modified EPS in
    -- order to avoid space leaks.
    updateEps :: (ExternalPackageState -> (ExternalPackageState, a))
              -> TcRnIf gbl lcl a
    updateEps :: forall a gbl lcl.
    (ExternalPackageState -> (ExternalPackageState, a))
    -> TcRnIf gbl lcl a
    updateEps ExternalPackageState -> (ExternalPackageState, a)
    upd_fn = do
      SDoc -> TcRnIf gbl lcl ()
    forall m n. SDoc -> TcRnIf m n ()
    traceIf (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "updating EPS")
      eps_var <- TcRnIf gbl lcl (TcRef ExternalPackageState)
    forall gbl lcl. TcRnIf gbl lcl (TcRef ExternalPackageState)
    getEpsVar
      atomicUpdMutVar' eps_var upd_fn

    -- | Update the external package state.
    --
    -- This is an atomic operation and forces evaluation of the modified EPS in
    -- order to avoid space leaks.
    updateEps_ :: (ExternalPackageState -> ExternalPackageState)
               -> TcRnIf gbl lcl ()
    updateEps_ :: forall gbl lcl.
    (ExternalPackageState -> ExternalPackageState) -> TcRnIf gbl lcl ()
    updateEps_ ExternalPackageState -> ExternalPackageState
    upd_fn = (ExternalPackageState -> (ExternalPackageState, ()))
    -> TcRnIf gbl lcl ()
    forall a gbl lcl.
    (ExternalPackageState -> (ExternalPackageState, a))
    -> TcRnIf gbl lcl a
    updateEps (\ExternalPackageState
    eps -> (ExternalPackageState -> ExternalPackageState
    upd_fn ExternalPackageState
    eps, ()))

    getHpt :: TcRnIf gbl lcl HomePackageTable
    getHpt :: forall gbl lcl. TcRnIf gbl lcl HomePackageTable
    getHpt = do { env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; return (hsc_HPT env) }

    getEpsAndHug :: TcRnIf gbl lcl (ExternalPackageState, HomeUnitGraph)
    getEpsAndHug :: forall gbl lcl.
    TcRnIf gbl lcl (ExternalPackageState, HomeUnitGraph)
    getEpsAndHug = do { env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; eps <- liftIO $ hscEPS env
                      ; return (eps, hsc_HUG env) }

    -- | A convenient wrapper for taking a @MaybeErr SDoc a@ and throwing
    -- an exception if it is an error.
    withException :: MonadIO m => SDocContext -> m (MaybeErr SDoc a) -> m a
    withException :: forall (m :: * -> *) a.
    MonadIO m =>
    SDocContext -> m (MaybeErr SDoc a) -> m a
    withException SDocContext
    ctx m (MaybeErr SDoc a)
    do_this = do
        r <- m (MaybeErr SDoc a)
    do_this
        case r of
            Failed SDoc
    err -> IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ GhcException -> IO a
    forall a. GhcException -> IO a
    throwGhcExceptionIO (FilePath -> GhcException
    ProgramError (SDocContext -> SDoc -> FilePath
    renderWithContext SDocContext
    ctx SDoc
    err))
            Succeeded a
    result -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result

    withIfaceErr :: MonadIO m => SDocContext -> m (MaybeErr MissingInterfaceError a) -> m a
    withIfaceErr :: forall (m :: * -> *) a.
    MonadIO m =>
    SDocContext -> m (MaybeErr MissingInterfaceError a) -> m a
    withIfaceErr SDocContext
    ctx m (MaybeErr MissingInterfaceError a)
    do_this = do
        r <- m (MaybeErr MissingInterfaceError a)
    do_this
        case r of
            Failed MissingInterfaceError
    err -> do
              let opts :: DiagnosticOpts IfaceMessage
    opts = forall opts.
    HasDefaultDiagnosticOpts (DiagnosticOpts opts) =>
    DiagnosticOpts opts
    defaultDiagnosticOpts @IfaceMessage
                  msg :: SDoc
    msg   = IfaceMessageOpts -> MissingInterfaceError -> SDoc
    missingInterfaceErrorDiagnostic IfaceMessageOpts
    opts MissingInterfaceError
    err
              IO a -> m a
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> m a) -> IO a -> m a
    forall a b. (a -> b) -> a -> b
    $ GhcException -> IO a
    forall a. GhcException -> IO a
    throwGhcExceptionIO (FilePath -> GhcException
    ProgramError (SDocContext -> SDoc -> FilePath
    renderWithContext SDocContext
    ctx SDoc
    msg))
            Succeeded a
    result -> a -> m a
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result

    {-
    ************************************************************************
    *                                                                      *
                    Arrow scopes
    *                                                                      *
    ************************************************************************
    -}

    newArrowScope :: TcM a -> TcM a
    newArrowScope :: forall a. TcM a -> TcM a
    newArrowScope
      = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv ((TcLclEnv -> TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a)
    -> (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a
    -> TcRnIf TcGblEnv TcLclEnv a
    forall a b. (a -> b) -> a -> b
    $ \TcLclEnv
    env ->
          (TcLclCtxt -> TcLclCtxt) -> TcLclEnv -> TcLclEnv
    modifyLclCtxt (\TcLclCtxt
    ctx -> TcLclCtxt
    ctx { tcl_arrow_ctxt = ArrowCtxt (getLclEnvRdrEnv env) (tcl_lie env) } ) TcLclEnv
    env

    -- Return to the stored environment (from the enclosing proc)
    escapeArrowScope :: TcM a -> TcM a
    escapeArrowScope :: forall a. TcM a -> TcM a
    escapeArrowScope
      = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv ((TcLclEnv -> TcLclEnv)
     -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a)
    -> (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a
    -> TcRnIf TcGblEnv TcLclEnv a
    forall a b. (a -> b) -> a -> b
    $ \ TcLclEnv
    env ->
        case TcLclEnv -> ArrowCtxt
    getLclEnvArrowCtxt TcLclEnv
    env of
          ArrowCtxt
    NoArrowCtxt       -> TcLclEnv
    env
          ArrowCtxt LocalRdrEnv
    rdr_env IORef WantedConstraints
    lie -> TcLclEnv
    env { tcl_lcl_ctxt = (tcl_lcl_ctxt env) { tcl_arrow_ctxt = NoArrowCtxt
                                                                           , tcl_rdr = rdr_env }
                                       , tcl_lie = lie }

    {-
    ************************************************************************
    *                                                                      *
                    Unique supply
    *                                                                      *
    ************************************************************************
    -}

    newUnique :: TcRnIf gbl lcl Unique
    newUnique :: forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
     = do { env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv
          ; let tag = Env gbl lcl -> Char
    forall gbl lcl. Env gbl lcl -> Char
    env_ut Env gbl lcl
    env
          ; liftIO $! uniqFromTag tag }

    newUniqueSupply :: TcRnIf gbl lcl UniqSupply
    newUniqueSupply :: forall gbl lcl. TcRnIf gbl lcl UniqSupply
    newUniqueSupply
     = do { env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv
          ; let tag = Env gbl lcl -> Char
    forall gbl lcl. Env gbl lcl -> Char
    env_ut Env gbl lcl
    env
          ; liftIO $! mkSplitUniqSupply tag }

    cloneLocalName :: Name -> TcM Name
    -- Make a fresh Internal name with the same OccName and SrcSpan
    cloneLocalName :: Name -> TcM Name
    cloneLocalName Name
    name = OccName -> SrcSpan -> TcM Name
    newNameAt (Name -> OccName
    nameOccName Name
    name) (Name -> SrcSpan
    nameSrcSpan Name
    name)

    newName :: OccName -> TcM Name
    newName :: OccName -> TcM Name
    newName OccName
    occ = do { loc  <- TcRn SrcSpan
    getSrcSpanM
                     ; newNameAt occ loc }

    newNameAt :: OccName -> SrcSpan -> TcM Name
    newNameAt :: OccName -> SrcSpan -> TcM Name
    newNameAt OccName
    occ SrcSpan
    span
      = do { uniq <- TcRnIf TcGblEnv TcLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
           ; return (mkInternalName uniq occ span) }

    newSysName :: OccName -> TcRnIf gbl lcl Name
    newSysName :: forall gbl lcl. OccName -> TcRnIf gbl lcl Name
    newSysName OccName
    occ
      = do { uniq <- TcRnIf gbl lcl Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
           ; return (mkSystemName uniq occ) }

    newSysLocalId :: FastString -> Mult -> TcType -> TcRnIf gbl lcl TcId
    newSysLocalId :: forall gbl lcl. FastString -> Mult -> Mult -> TcRnIf gbl lcl Id
    newSysLocalId FastString
    fs Mult
    w Mult
    ty
      = do  { u <- TcRnIf gbl lcl Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
            ; return (mkSysLocal fs u w ty) }

    newSysLocalIds :: FastString -> [Scaled TcType] -> TcRnIf gbl lcl [TcId]
    newSysLocalIds :: forall gbl lcl. FastString -> [Scaled Mult] -> TcRnIf gbl lcl [Id]
    newSysLocalIds FastString
    fs [Scaled Mult]
    tys
      = do  { us <- IOEnv (Env gbl lcl) [Unique]
    forall (m :: * -> *). MonadUnique m => m [Unique]
    getUniquesM
            ; let mkId' Unique
    n (Scaled Mult
    w Mult
    t) = FastString -> Unique -> Mult -> Mult -> Id
    mkSysLocal FastString
    fs Unique
    n Mult
    w Mult
    t
            ; return (zipWith mkId' us tys) }

    instance MonadUnique (IOEnv (Env gbl lcl)) where
            getUniqueM :: IOEnv (Env gbl lcl) Unique
    getUniqueM = IOEnv (Env gbl lcl) Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
            getUniqueSupplyM :: IOEnv (Env gbl lcl) UniqSupply
    getUniqueSupplyM = IOEnv (Env gbl lcl) UniqSupply
    forall gbl lcl. TcRnIf gbl lcl UniqSupply
    newUniqueSupply

    {-
    ************************************************************************
    *                                                                      *
                    Debugging
    *                                                                      *
    ************************************************************************
    -}

    {- Note [INLINE conditional tracing utilities]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    In general we want to optimise for the case where tracing is not enabled.
    To ensure this happens, we ensure that traceTc and friends are inlined; this
    ensures that the allocation of the document can be pushed into the tracing
    path, keeping the non-traced path free of this extraneous work. For
    instance, if we don't inline traceTc, we'll get

        let stuff_to_print = ...
        in traceTc "wombat" stuff_to_print

    and the stuff_to_print thunk will be allocated in the "hot path", regardless
    of tracing.  But if we INLINE traceTc we get

        let stuff_to_print = ...
        in if doTracing
             then emitTraceMsg "wombat" stuff_to_print
             else return ()

    and then we float in:

        if doTracing
          then let stuff_to_print = ...
               in emitTraceMsg "wombat" stuff_to_print
          else return ()

    Now stuff_to_print is allocated only in the "cold path".

    Moreover, on the "cold" path, after the conditional, we want to inline
    as /little/ as possible.  Performance doesn't matter here, and we'd like
    to bloat the caller's code as little as possible.  So we put a NOINLINE
    on 'emitTraceMsg'

    See #18168.
    -}

    -- Typechecker trace
    traceTc :: String -> SDoc -> TcRn ()
    traceTc :: FilePath -> SDoc -> TcM ()
    traceTc FilePath
    herald SDoc
    doc =
        DumpFlag -> FilePath -> SDoc -> TcM ()
    labelledTraceOptTcRn DumpFlag
    Opt_D_dump_tc_trace FilePath
    herald SDoc
    doc
    {-# INLINE traceTc #-} -- see Note [INLINE conditional tracing utilities]

    -- Renamer Trace
    traceRn :: String -> SDoc -> TcRn ()
    traceRn :: FilePath -> SDoc -> TcM ()
    traceRn FilePath
    herald SDoc
    doc =
        DumpFlag -> FilePath -> SDoc -> TcM ()
    labelledTraceOptTcRn DumpFlag
    Opt_D_dump_rn_trace FilePath
    herald SDoc
    doc
    {-# INLINE traceRn #-} -- see Note [INLINE conditional tracing utilities]

    -- | Trace when a certain flag is enabled. This is like `traceOptTcRn`
    -- but accepts a string as a label and formats the trace message uniformly.
    labelledTraceOptTcRn :: DumpFlag -> String -> SDoc -> TcRn ()
    labelledTraceOptTcRn :: DumpFlag -> FilePath -> SDoc -> TcM ()
    labelledTraceOptTcRn DumpFlag
    flag FilePath
    herald SDoc
    doc =
      DumpFlag -> SDoc -> TcM ()
    traceOptTcRn DumpFlag
    flag (FilePath -> SDoc -> SDoc
    formatTraceMsg FilePath
    herald SDoc
    doc)
    {-# INLINE labelledTraceOptTcRn #-} -- see Note [INLINE conditional tracing utilities]

    formatTraceMsg :: String -> SDoc -> SDoc
    formatTraceMsg :: FilePath -> SDoc -> SDoc
    formatTraceMsg FilePath
    herald SDoc
    doc = SDoc -> Int -> SDoc -> SDoc
    hang (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    herald) Int
    2 SDoc
    doc

    traceOptTcRn :: DumpFlag -> SDoc -> TcRn ()
    traceOptTcRn :: DumpFlag -> SDoc -> TcM ()
    traceOptTcRn DumpFlag
    flag SDoc
    doc =
      DumpFlag -> TcM () -> TcM ()
    forall gbl lcl. DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenDOptM DumpFlag
    flag (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        Bool -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> TcM ()
    dumpTcRn Bool
    False DumpFlag
    flag FilePath
    "" DumpFormat
    FormatText SDoc
    doc
    {-# INLINE traceOptTcRn #-} -- see Note [INLINE conditional tracing utilities]

    -- | Dump if the given 'DumpFlag' is set.
    dumpOptTcRn :: DumpFlag -> String -> DumpFormat -> SDoc -> TcRn ()
    dumpOptTcRn :: DumpFlag -> FilePath -> DumpFormat -> SDoc -> TcM ()
    dumpOptTcRn DumpFlag
    flag FilePath
    title DumpFormat
    fmt SDoc
    doc =
      DumpFlag -> TcM () -> TcM ()
    forall gbl lcl. DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenDOptM DumpFlag
    flag (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        Bool -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> TcM ()
    dumpTcRn Bool
    False DumpFlag
    flag FilePath
    title DumpFormat
    fmt SDoc
    doc
    {-# INLINE dumpOptTcRn #-} -- see Note [INLINE conditional tracing utilities]

    -- | Unconditionally dump some trace output
    --
    -- Certain tests (T3017, Roles3, T12763 etc.) expect part of the
    -- output generated by `-ddump-types` to be in 'PprUser' style. However,
    -- generally we want all other debugging output to use 'PprDump'
    -- style. We 'PprUser' style if 'useUserStyle' is True.
    --
    dumpTcRn :: Bool -> DumpFlag -> String -> DumpFormat -> SDoc -> TcRn ()
    dumpTcRn :: Bool -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> TcM ()
    dumpTcRn Bool
    useUserStyle DumpFlag
    flag FilePath
    title DumpFormat
    fmt SDoc
    doc = do
      logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
      name_ppr_ctx <- getNamePprCtx
      real_doc <- wrapDocLoc doc
      let sty = if Bool
    useUserStyle
                  then NamePprCtx -> Depth -> PprStyle
    mkUserStyle NamePprCtx
    name_ppr_ctx Depth
    AllTheWay
                  else NamePprCtx -> PprStyle
    mkDumpStyle NamePprCtx
    name_ppr_ctx
      liftIO $ logDumpFile logger sty flag title fmt real_doc

    -- | Add current location if -dppr-debug
    -- (otherwise the full location is usually way too much)
    wrapDocLoc :: SDoc -> TcRn SDoc
    wrapDocLoc :: SDoc -> TcRn SDoc
    wrapDocLoc SDoc
    doc = do
      logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
      if logHasDumpFlag logger Opt_D_ppr_debug
        then do
          loc <- getSrcSpanM
          return (mkLocMessage MCOutput loc doc)
        else
          return doc

    getNamePprCtx :: TcRn NamePprCtx
    getNamePprCtx :: TcRn NamePprCtx
    getNamePprCtx
      = do { ptc <- DynFlags -> PromotionTickContext
    initPromotionTickContext (DynFlags -> PromotionTickContext)
    -> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    -> IOEnv (Env TcGblEnv TcLclEnv) PromotionTickContext
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; rdr_env <- getGlobalRdrEnv
           ; hsc_env <- getTopEnv
           ; return $ mkNamePprCtx ptc (hsc_unit_env hsc_env) rdr_env }

    -- | Like logInfoTcRn, but for user consumption
    printForUserTcRn :: SDoc -> TcRn ()
    printForUserTcRn :: SDoc -> TcM ()
    printForUserTcRn SDoc
    doc = do
        logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        name_ppr_ctx <- getNamePprCtx
        liftIO (printOutputForUser logger name_ppr_ctx doc)

    {-
    traceIf works in the TcRnIf monad, where no RdrEnv is
    available.  Alas, they behave inconsistently with the other stuff;
    e.g. are unaffected by -dump-to-file.
    -}

    traceIf :: SDoc -> TcRnIf m n ()
    traceIf :: forall m n. SDoc -> TcRnIf m n ()
    traceIf = DumpFlag -> SDoc -> TcRnIf m n ()
    forall m n. DumpFlag -> SDoc -> TcRnIf m n ()
    traceOptIf DumpFlag
    Opt_D_dump_if_trace
    {-# INLINE traceIf #-}
      -- see Note [INLINE conditional tracing utilities]

    traceOptIf :: DumpFlag -> SDoc -> TcRnIf m n ()
    traceOptIf :: forall m n. DumpFlag -> SDoc -> TcRnIf m n ()
    traceOptIf DumpFlag
    flag SDoc
    doc
      = DumpFlag -> TcRnIf m n () -> TcRnIf m n ()
    forall gbl lcl. DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenDOptM DumpFlag
    flag (TcRnIf m n () -> TcRnIf m n ()) -> TcRnIf m n () -> TcRnIf m n ()
    forall a b. (a -> b) -> a -> b
    $ do   -- No RdrEnv available, so qualify everything
            logger <- IOEnv (Env m n) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
            liftIO (putMsg logger doc)
    {-# INLINE traceOptIf #-}  -- see Note [INLINE conditional tracing utilities]

    {-
    ************************************************************************
    *                                                                      *
                    Typechecker global environment
    *                                                                      *
    ************************************************************************
    -}

    getIsGHCi :: TcRn Bool
    getIsGHCi :: TcRn Bool
    getIsGHCi = do { mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
    forall (m :: * -> *). HasModule m => m Module
    getModule
                   ; return (isInteractiveModule mod) }

    getGHCiMonad :: TcRn Name
    getGHCiMonad :: TcM Name
    getGHCiMonad = do { hsc <- TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; return (ic_monad $ hsc_IC hsc) }

    getInteractivePrintName :: TcRn Name
    getInteractivePrintName :: TcM Name
    getInteractivePrintName = do { hsc <- TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; return (ic_int_print $ hsc_IC hsc) }

    tcIsHsBootOrSig :: TcRn Bool
    tcIsHsBootOrSig :: TcRn Bool
    tcIsHsBootOrSig = HscSource -> Bool
    isHsBootOrSig (HscSource -> Bool)
    -> IOEnv (Env TcGblEnv TcLclEnv) HscSource -> TcRn Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env TcGblEnv TcLclEnv) HscSource
    tcHscSource

    tcHscSource :: TcRn HscSource
    tcHscSource :: IOEnv (Env TcGblEnv TcLclEnv) HscSource
    tcHscSource = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; return (tcg_src env)}

    tcIsHsig :: TcRn Bool
    tcIsHsig :: TcRn Bool
    tcIsHsig = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; return (isHsigFile (tcg_src env)) }

    tcSelfBootInfo :: TcRn SelfBootInfo
    tcSelfBootInfo :: TcRn SelfBootInfo
    tcSelfBootInfo = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; return (tcg_self_boot env) }

    getGlobalRdrEnv :: TcRn GlobalRdrEnv
    getGlobalRdrEnv :: TcRn GlobalRdrEnv
    getGlobalRdrEnv = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; return (tcg_rdr_env env) }

    getRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv)
    getRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv)
    getRdrEnvs = do { (gbl,lcl) <- TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs; return (tcg_rdr_env gbl, getLclEnvRdrEnv lcl) }

    getImports :: TcRn ImportAvails
    getImports :: TcRn ImportAvails
    getImports = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; return (tcg_imports env) }

    getFixityEnv :: TcRn FixityEnv
    getFixityEnv :: TcRn FixityEnv
    getFixityEnv = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; return (tcg_fix_env env) }

    extendFixityEnv :: [(Name,FixItem)] -> RnM a -> RnM a
    extendFixityEnv :: forall a. [(Name, FixItem)] -> RnM a -> RnM a
    extendFixityEnv [(Name, FixItem)]
    new_bit
      = (TcGblEnv -> TcGblEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv (\env :: TcGblEnv
    env@(TcGblEnv { tcg_fix_env :: TcGblEnv -> FixityEnv
    tcg_fix_env = FixityEnv
    old_fix_env }) ->
                    TcGblEnv
    env {tcg_fix_env = extendNameEnvList old_fix_env new_bit})

    getDeclaredDefaultTys :: TcRn DefaultEnv
    getDeclaredDefaultTys :: TcRn DefaultEnv
    getDeclaredDefaultTys = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; return (tcg_default env) }

    addDependentFiles :: [FilePath] -> TcRn ()
    addDependentFiles :: [FilePath] -> TcM ()
    addDependentFiles [FilePath]
    fs = do
      ref <- (TcGblEnv -> IORef [FilePath])
    -> TcRnIf TcGblEnv TcLclEnv TcGblEnv
    -> IOEnv (Env TcGblEnv TcLclEnv) (IORef [FilePath])
    forall a b.
    (a -> b)
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TcGblEnv -> IORef [FilePath]
    tcg_dependent_files TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
      dep_files <- readTcRef ref
      writeTcRef ref (fs ++ dep_files)

    {-
    ************************************************************************
    *                                                                      *
                    Error management
    *                                                                      *
    ************************************************************************
    -}

    getSrcSpanM :: TcRn SrcSpan
            -- Avoid clash with Name.getSrcLoc
    getSrcSpanM :: TcRn SrcSpan
    getSrcSpanM = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (RealSrcSpan (getLclEnvLoc env) Strict.Nothing) }

    -- See Note [Error contexts in generated code]
    inGeneratedCode :: TcRn Bool
    inGeneratedCode :: TcRn Bool
    inGeneratedCode = TcLclEnv -> Bool
    lclEnvInGeneratedCode (TcLclEnv -> Bool)
    -> TcRnIf TcGblEnv TcLclEnv TcLclEnv -> TcRn Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv

    setSrcSpan :: SrcSpan -> TcRn a -> TcRn a
    -- See Note [Error contexts in generated code]
    -- for the tcl_in_gen_code manipulation
    setSrcSpan :: forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (RealSrcSpan RealSrcSpan
    loc Maybe BufSpan
    _) TcRn a
    thing_inside
      = (TcLclCtxt -> TcLclCtxt) -> TcRn a -> TcRn a
    forall gbl a.
    (TcLclCtxt -> TcLclCtxt)
    -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    updLclCtxt (\TcLclCtxt
    env -> TcLclCtxt
    env { tcl_loc = loc, tcl_in_gen_code = False })
                  TcRn a
    thing_inside

    setSrcSpan loc :: SrcSpan
    loc@(UnhelpfulSpan UnhelpfulSpanReason
    _) TcRn a
    thing_inside
      | SrcSpan -> Bool
    isGeneratedSrcSpan SrcSpan
    loc
      = TcRn a -> TcRn a
    forall a. TcM a -> TcM a
    setInGeneratedCode TcRn a
    thing_inside

      | Bool
    otherwise
      = TcRn a
    thing_inside

    -- | Mark the inner computation as being done inside generated code.
    --
    -- See Note [Error contexts in generated code]
    setInGeneratedCode :: TcRn a -> TcRn a
    setInGeneratedCode :: forall a. TcM a -> TcM a
    setInGeneratedCode TcRn a
    thing_inside =
      (TcLclCtxt -> TcLclCtxt) -> TcRn a -> TcRn a
    forall gbl a.
    (TcLclCtxt -> TcLclCtxt)
    -> TcRnIf gbl TcLclEnv a -> TcRnIf gbl TcLclEnv a
    updLclCtxt (\TcLclCtxt
    env -> TcLclCtxt
    env { tcl_in_gen_code = True }) TcRn a
    thing_inside

    setSrcSpanA :: EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA :: forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA EpAnn ann
    l = SrcSpan -> TcRn a -> TcRn a
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (EpAnn ann -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA EpAnn ann
    l)

    addLocM :: (HasLoc t) => (a -> TcM b) -> GenLocated t a -> TcM b
    addLocM :: forall t a b. HasLoc t => (a -> TcM b) -> GenLocated t a -> TcM b
    addLocM a -> TcM b
    fn (L t
    loc a
    a) = SrcSpan -> TcM b -> TcM b
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (t -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    getHasLoc t
    loc) (TcM b -> TcM b) -> TcM b -> TcM b
    forall a b. (a -> b) -> a -> b
    $ a -> TcM b
    fn a
    a

    wrapLocM :: (HasLoc t) =>  (a -> TcM b) -> GenLocated t a -> TcM (Located b)
    wrapLocM :: forall t a b.
    HasLoc t =>
    (a -> TcM b) -> GenLocated t a -> TcM (Located b)
    wrapLocM a -> TcM b
    fn (L t
    loc a
    a) =
      let
        loc' :: SrcSpan
    loc' = t -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    getHasLoc t
    loc
      in SrcSpan -> TcRn (Located b) -> TcRn (Located b)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc' (TcRn (Located b) -> TcRn (Located b))
    -> TcRn (Located b) -> TcRn (Located b)
    forall a b. (a -> b) -> a -> b
    $ do { b <- a -> TcM b
    fn a
    a
                              ; return (L loc' b) }

    wrapLocMA :: (a -> TcM b) -> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
    wrapLocMA :: forall a b ann.
    (a -> TcM b)
    -> GenLocated (EpAnn ann) a -> TcRn (GenLocated (EpAnn ann) b)
    wrapLocMA a -> TcM b
    fn (L EpAnn ann
    loc a
    a) = EpAnn ann
    -> TcRn (GenLocated (EpAnn ann) b)
    -> TcRn (GenLocated (EpAnn ann) b)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA EpAnn ann
    loc (TcRn (GenLocated (EpAnn ann) b)
     -> TcRn (GenLocated (EpAnn ann) b))
    -> TcRn (GenLocated (EpAnn ann) b)
    -> TcRn (GenLocated (EpAnn ann) b)
    forall a b. (a -> b) -> a -> b
    $ do { b <- a -> TcM b
    fn a
    a
                                                  ; return (L loc b) }

    wrapLocFstM :: (a -> TcM (b,c)) -> Located a -> TcM (Located b, c)
    wrapLocFstM :: forall a b c. (a -> TcM (b, c)) -> Located a -> TcM (Located b, c)
    wrapLocFstM a -> TcM (b, c)
    fn (L SrcSpan
    loc a
    a) =
      SrcSpan -> TcRn (Located b, c) -> TcRn (Located b, c)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcRn (Located b, c) -> TcRn (Located b, c))
    -> TcRn (Located b, c) -> TcRn (Located b, c)
    forall a b. (a -> b) -> a -> b
    $ do
        (b,c) <- a -> TcM (b, c)
    fn a
    a
        return (L loc b, c)

    -- Possible instantiations:
    --    wrapLocFstMA :: (a -> TcM (b,c)) -> LocatedA    a -> TcM (LocatedA    b, c)
    --    wrapLocFstMA :: (a -> TcM (b,c)) -> LocatedN    a -> TcM (LocatedN    b, c)
    --    wrapLocFstMA :: (a -> TcM (b,c)) -> LocatedAn t a -> TcM (LocatedAn t b, c)
    -- and so on.
    wrapLocFstMA :: (a -> TcM (b,c)) -> GenLocated (EpAnn ann) a -> TcM (GenLocated (EpAnn ann) b, c)
    wrapLocFstMA :: forall a b c ann.
    (a -> TcM (b, c))
    -> GenLocated (EpAnn ann) a -> TcM (GenLocated (EpAnn ann) b, c)
    wrapLocFstMA a -> TcM (b, c)
    fn (L EpAnn ann
    loc a
    a) =
      EpAnn ann
    -> TcRn (GenLocated (EpAnn ann) b, c)
    -> TcRn (GenLocated (EpAnn ann) b, c)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA EpAnn ann
    loc (TcRn (GenLocated (EpAnn ann) b, c)
     -> TcRn (GenLocated (EpAnn ann) b, c))
    -> TcRn (GenLocated (EpAnn ann) b, c)
    -> TcRn (GenLocated (EpAnn ann) b, c)
    forall a b. (a -> b) -> a -> b
    $ do
        (b,c) <- a -> TcM (b, c)
    fn a
    a
        return (L loc b, c)

    wrapLocSndM :: (a -> TcM (b, c)) -> Located a -> TcM (b, Located c)
    wrapLocSndM :: forall a b c. (a -> TcM (b, c)) -> Located a -> TcM (b, Located c)
    wrapLocSndM a -> TcM (b, c)
    fn (L SrcSpan
    loc a
    a) =
      SrcSpan -> TcRn (b, Located c) -> TcRn (b, Located c)
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (TcRn (b, Located c) -> TcRn (b, Located c))
    -> TcRn (b, Located c) -> TcRn (b, Located c)
    forall a b. (a -> b) -> a -> b
    $ do
        (b,c) <- a -> TcM (b, c)
    fn a
    a
        return (b, L loc c)

    -- Possible instantiations:
    --    wrapLocSndMA :: (a -> TcM (b, c)) -> LocatedA    a -> TcM (b, LocatedA    c)
    --    wrapLocSndMA :: (a -> TcM (b, c)) -> LocatedN    a -> TcM (b, LocatedN    c)
    --    wrapLocSndMA :: (a -> TcM (b, c)) -> LocatedAn t a -> TcM (b, LocatedAn t c)
    -- and so on.
    wrapLocSndMA :: (a -> TcM (b, c)) -> GenLocated (EpAnn ann) a -> TcM (b, GenLocated (EpAnn ann) c)
    wrapLocSndMA :: forall a b c ann.
    (a -> TcM (b, c))
    -> GenLocated (EpAnn ann) a -> TcM (b, GenLocated (EpAnn ann) c)
    wrapLocSndMA a -> TcM (b, c)
    fn (L EpAnn ann
    loc a
    a) =
      EpAnn ann
    -> TcRn (b, GenLocated (EpAnn ann) c)
    -> TcRn (b, GenLocated (EpAnn ann) c)
    forall ann a. EpAnn ann -> TcRn a -> TcRn a
    setSrcSpanA EpAnn ann
    loc (TcRn (b, GenLocated (EpAnn ann) c)
     -> TcRn (b, GenLocated (EpAnn ann) c))
    -> TcRn (b, GenLocated (EpAnn ann) c)
    -> TcRn (b, GenLocated (EpAnn ann) c)
    forall a b. (a -> b) -> a -> b
    $ do
        (b,c) <- a -> TcM (b, c)
    fn a
    a
        return (b, L loc c)

    wrapLocM_ :: (a -> TcM ()) -> Located a -> TcM ()
    wrapLocM_ :: forall a. (a -> TcM ()) -> Located a -> TcM ()
    wrapLocM_ a -> TcM ()
    fn (L SrcSpan
    loc a
    a) = SrcSpan -> TcM () -> TcM ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan SrcSpan
    loc (a -> TcM ()
    fn a
    a)

    wrapLocMA_ :: (a -> TcM ()) -> LocatedA a -> TcM ()
    wrapLocMA_ :: forall a. (a -> TcM ()) -> LocatedA a -> TcM ()
    wrapLocMA_ a -> TcM ()
    fn (L SrcSpanAnnA
    loc a
    a) = SrcSpan -> TcM () -> TcM ()
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (SrcSpanAnnA -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA SrcSpanAnnA
    loc) (a -> TcM ()
    fn a
    a)

    -- Reporting errors

    getErrsVar :: TcRn (TcRef (Messages TcRnMessage))
    getErrsVar :: TcRn (IORef (Messages TcRnMessage))
    getErrsVar = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (tcl_errs env) }

    setErrsVar :: TcRef (Messages TcRnMessage) -> TcRn a -> TcRn a
    setErrsVar :: forall a. IORef (Messages TcRnMessage) -> TcRn a -> TcRn a
    setErrsVar IORef (Messages TcRnMessage)
    v = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\ TcLclEnv
    env -> TcLclEnv
    env { tcl_errs =  v })

    addErr :: TcRnMessage -> TcRn ()
    addErr :: TcRnMessage -> TcM ()
    addErr TcRnMessage
    msg = do { loc <- TcRn SrcSpan
    getSrcSpanM; addErrAt loc msg }

    failWith :: TcRnMessage -> TcRn a
    failWith :: forall a. TcRnMessage -> TcRn a
    failWith TcRnMessage
    msg = TcRnMessage -> TcM ()
    addErr TcRnMessage
    msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall a b.
    IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IOEnv (Env TcGblEnv TcLclEnv) a
    forall env a. IOEnv env a
    failM

    failAt :: SrcSpan -> TcRnMessage -> TcRn a
    failAt :: forall a. SrcSpan -> TcRnMessage -> TcRn a
    failAt SrcSpan
    loc TcRnMessage
    msg = SrcSpan -> TcRnMessage -> TcM ()
    addErrAt SrcSpan
    loc TcRnMessage
    msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall a b.
    IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IOEnv (Env TcGblEnv TcLclEnv) a
    forall env a. IOEnv env a
    failM

    addErrAt :: SrcSpan -> TcRnMessage -> TcRn ()
    -- addErrAt is mainly (exclusively?) used by the renamer, where
    -- tidying is not an issue, but it's all lazy so the extra
    -- work doesn't matter
    addErrAt :: SrcSpan -> TcRnMessage -> TcM ()
    addErrAt SrcSpan
    loc TcRnMessage
    msg = do { ctxt <- TcM [ErrCtxt]
    getErrCtxt
                          ; tidy_env <- liftZonkM $ tcInitTidyEnv
                          ; err_ctxt <- mkErrCtxt tidy_env ctxt
                          ; let detailed_msg = ErrInfo -> TcRnMessage -> TcRnMessageDetailed
    mkDetailedMessage ([ErrCtxtMsg]
    -> Maybe (HoleFitDispConfig, [SupplementaryInfo])
    -> [GhcHint]
    -> ErrInfo
    ErrInfo [ErrCtxtMsg]
    err_ctxt Maybe (HoleFitDispConfig, [SupplementaryInfo])
    forall a. Maybe a
    Nothing [GhcHint]
    noHints) TcRnMessage
    msg
                          ; add_long_err_at loc detailed_msg }

    mkDetailedMessage :: ErrInfo-> TcRnMessage -> TcRnMessageDetailed
    mkDetailedMessage :: ErrInfo -> TcRnMessage -> TcRnMessageDetailed
    mkDetailedMessage ErrInfo
    err_info TcRnMessage
    msg =
      ErrInfo -> TcRnMessage -> TcRnMessageDetailed
    TcRnMessageDetailed ErrInfo
    err_info TcRnMessage
    msg

    addErrs :: [(SrcSpan,TcRnMessage)] -> TcRn ()
    addErrs :: [(SrcSpan, TcRnMessage)] -> TcM ()
    addErrs [(SrcSpan, TcRnMessage)]
    msgs = ((SrcSpan, TcRnMessage) -> TcM ())
    -> [(SrcSpan, TcRnMessage)] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (SrcSpan, TcRnMessage) -> TcM ()
    add [(SrcSpan, TcRnMessage)]
    msgs
                 where
                   add :: (SrcSpan, TcRnMessage) -> TcM ()
    add (SrcSpan
    loc,TcRnMessage
    msg) = SrcSpan -> TcRnMessage -> TcM ()
    addErrAt SrcSpan
    loc TcRnMessage
    msg

    checkErr :: Bool -> TcRnMessage -> TcRn ()
    -- Add the error if the bool is False
    checkErr :: Bool -> TcRnMessage -> TcM ()
    checkErr Bool
    ok TcRnMessage
    msg = Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    ok (TcRnMessage -> TcM ()
    addErr TcRnMessage
    msg)

    checkErrAt :: SrcSpan -> Bool -> TcRnMessage -> TcRn ()
    checkErrAt :: SrcSpan -> Bool -> TcRnMessage -> TcM ()
    checkErrAt SrcSpan
    loc Bool
    ok TcRnMessage
    msg = Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    ok (SrcSpan -> TcRnMessage -> TcM ()
    addErrAt SrcSpan
    loc TcRnMessage
    msg)

    addMessages :: Messages TcRnMessage -> TcRn ()
    addMessages :: Messages TcRnMessage -> TcM ()
    addMessages Messages TcRnMessage
    msgs1
      = do { errs_var <- TcRn (IORef (Messages TcRnMessage))
    getErrsVar
           ; msgs0    <- readTcRef errs_var
           ; writeTcRef errs_var (msgs0 `unionMessages` msgs1) }

    discardWarnings :: TcRn a -> TcRn a
    -- Ignore warnings inside the thing inside;
    -- used to ignore-unused-variable warnings inside derived code
    discardWarnings :: forall a. TcM a -> TcM a
    discardWarnings TcRn a
    thing_inside
      = do  { errs_var <- TcRn (IORef (Messages TcRnMessage))
    getErrsVar
            ; old_warns <- getWarningMessages <$> readTcRef errs_var

            ; result <- thing_inside

            -- Revert warnings to old_warns
            ; new_errs <- getErrorMessages <$> readTcRef errs_var
            ; writeTcRef errs_var $ mkMessages (old_warns `unionBags` new_errs)

            ; return result }

    {-
    ************************************************************************
    *                                                                      *
            Shared error message stuff: renamer and typechecker
    *                                                                      *
    ************************************************************************
    -}

    add_long_err_at :: SrcSpan -> TcRnMessageDetailed -> TcRn ()
    add_long_err_at :: SrcSpan -> TcRnMessageDetailed -> TcM ()
    add_long_err_at SrcSpan
    loc TcRnMessageDetailed
    msg = SrcSpan -> TcRnMessageDetailed -> TcRn (MsgEnvelope TcRnMessage)
    mk_long_err_at SrcSpan
    loc TcRnMessageDetailed
    msg TcRn (MsgEnvelope TcRnMessage)
    -> (MsgEnvelope TcRnMessage -> TcM ()) -> TcM ()
    forall a b.
    IOEnv (Env TcGblEnv TcLclEnv) a
    -> (a -> IOEnv (Env TcGblEnv TcLclEnv) b)
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MsgEnvelope TcRnMessage -> TcM ()
    reportDiagnostic
      where
        mk_long_err_at :: SrcSpan -> TcRnMessageDetailed -> TcRn (MsgEnvelope TcRnMessage)
        mk_long_err_at :: SrcSpan -> TcRnMessageDetailed -> TcRn (MsgEnvelope TcRnMessage)
    mk_long_err_at SrcSpan
    loc TcRnMessageDetailed
    msg
          = do { name_ppr_ctx <- TcRn NamePprCtx
    getNamePprCtx ;
                 unit_state <- hsc_units <$> getTopEnv ;
                 return $ mkErrorMsgEnvelope loc name_ppr_ctx
                        $ TcRnMessageWithInfo unit_state msg
                        }

    mkTcRnMessage :: SrcSpan
                  -> TcRnMessage
                  -> TcRn (MsgEnvelope TcRnMessage)
    mkTcRnMessage :: SrcSpan -> TcRnMessage -> TcRn (MsgEnvelope TcRnMessage)
    mkTcRnMessage SrcSpan
    loc TcRnMessage
    msg
      = do { name_ppr_ctx <- TcRn NamePprCtx
    getNamePprCtx ;
             diag_opts <- initDiagOpts <$> getDynFlags ;
             return $ mkMsgEnvelope diag_opts loc name_ppr_ctx msg }

    reportDiagnostics :: [MsgEnvelope TcRnMessage] -> TcM ()
    reportDiagnostics :: [MsgEnvelope TcRnMessage] -> TcM ()
    reportDiagnostics = (MsgEnvelope TcRnMessage -> TcM ())
    -> [MsgEnvelope TcRnMessage] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ MsgEnvelope TcRnMessage -> TcM ()
    reportDiagnostic

    reportDiagnostic :: MsgEnvelope TcRnMessage -> TcRn ()
    reportDiagnostic :: MsgEnvelope TcRnMessage -> TcM ()
    reportDiagnostic MsgEnvelope TcRnMessage
    msg
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "Adding diagnostic:" (MsgEnvelope TcRnMessage -> SDoc
    forall e. Diagnostic e => MsgEnvelope e -> SDoc
    pprLocMsgEnvelopeDefault MsgEnvelope TcRnMessage
    msg) ;
             errs_var <- TcRn (IORef (Messages TcRnMessage))
    getErrsVar ;
             msgs     <- readTcRef errs_var ;
             writeTcRef errs_var (msg `addMessage` msgs) }

    -----------------------
    checkNoErrs :: TcM r -> TcM r
    -- (checkNoErrs m) succeeds iff m succeeds and generates no errors
    -- If m fails then (checkNoErrs m) fails.
    -- If m succeeds, it checks whether m generated any errors messages
    --      (it might have recovered internally)
    --      If so, it fails too.
    -- Regardless, any errors generated by m are propagated to the enclosing context.
    checkNoErrs :: forall a. TcM a -> TcM a
    checkNoErrs TcM r
    main
      = do  { (res, no_errs) <- TcM r -> TcRn (r, Bool)
    forall a. TcRn a -> TcRn (a, Bool)
    askNoErrs TcM r
    main
            ; unless no_errs failM
            ; return res }

    -----------------------
    whenNoErrs :: TcM () -> TcM ()
    whenNoErrs :: TcM () -> TcM ()
    whenNoErrs TcM ()
    thing = TcM () -> TcM () -> TcM ()
    forall r. TcRn r -> TcRn r -> TcRn r
    ifErrsM (() -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()) TcM ()
    thing

    ifErrsM :: TcRn r -> TcRn r -> TcRn r
    --      ifErrsM bale_out normal
    -- does 'bale_out' if there are errors in errors collection
    -- otherwise does 'normal'
    ifErrsM :: forall r. TcRn r -> TcRn r -> TcRn r
    ifErrsM TcRn r
    bale_out TcRn r
    normal
     = do { errs_var <- TcRn (IORef (Messages TcRnMessage))
    getErrsVar ;
            msgs <- readTcRef errs_var ;
            if errorsFound msgs then
               bale_out
            else
               normal }

    failIfErrsM :: TcRn ()
    -- Useful to avoid error cascades
    failIfErrsM :: TcM ()
    failIfErrsM = TcM () -> TcM () -> TcM ()
    forall r. TcRn r -> TcRn r -> TcRn r
    ifErrsM TcM ()
    forall env a. IOEnv env a
    failM (() -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())

    {- *********************************************************************
    *                                                                      *
            Context management for the type checker
    *                                                                      *
    ************************************************************************
    -}

    {- Note [Inlining addErrCtxt]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    You will notice a bunch of INLINE pragamas on addErrCtxt and friends.
    The reason is to promote better eta-expansion in client modules.
    Consider
        \e s. addErrCtxt c (tc_foo x) e s
    It looks as if tc_foo is applied to only two arguments, but if we
    inline addErrCtxt it'll turn into something more like
        \e s. tc_foo x (munge c e) s
    This is much better because Called Arity analysis can see that tc_foo
    is applied to four arguments.  See #18379 for a concrete example.

    This reliance on delicate inlining and Called Arity is not good.
    See #18202 for a more general approach.  But meanwhile, these
    inlinings seem unobjectional, and they solve the immediate
    problem.

    Note [Error contexts in generated code]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    * setSrcSpan sets tcl_in_gen_code to True if the SrcSpan is GeneratedSrcSpan,
      and back to False when we get a useful SrcSpan

    * When tcl_in_gen_code is True, addErrCtxt becomes a no-op.

    So typically it's better to do setSrcSpan /before/ addErrCtxt.

    See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr for
    more discussion of this fancy footwork, as well as
    Note [Generated code and pattern-match checking] in GHC.Types.Basic for the
    relation with pattern-match checks.
    -}

    getErrCtxt :: TcM [ErrCtxt]
    getErrCtxt :: TcM [ErrCtxt]
    getErrCtxt = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (getLclEnvErrCtxt env) }

    setErrCtxt :: [ErrCtxt] -> TcM a -> TcM a
    {-# INLINE setErrCtxt #-}   -- Note [Inlining addErrCtxt]
    setErrCtxt :: forall a. [ErrCtxt] -> TcM a -> TcM a
    setErrCtxt [ErrCtxt]
    ctxt = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv ([ErrCtxt] -> TcLclEnv -> TcLclEnv
    setLclEnvErrCtxt [ErrCtxt]
    ctxt)

    -- | Add a fixed message to the error context. This message should not
    -- do any tidying.
    addErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a
    {-# INLINE addErrCtxt #-}   -- Note [Inlining addErrCtxt]
    addErrCtxt :: forall a. ErrCtxtMsg -> TcM a -> TcM a
    addErrCtxt ErrCtxtMsg
    msg = (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    forall a.
    (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    addErrCtxtM (\TidyEnv
    env -> (TidyEnv, ErrCtxtMsg) -> ZonkM (TidyEnv, ErrCtxtMsg)
    forall a. a -> ZonkM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    env, ErrCtxtMsg
    msg))

    -- | Add a message to the error context. This message may do tidying.
    addErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    {-# INLINE addErrCtxtM #-}  -- Note [Inlining addErrCtxt]
    addErrCtxtM :: forall a.
    (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    addErrCtxtM TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)
    ctxt = ErrCtxt -> TcM a -> TcM a
    forall a. ErrCtxt -> TcM a -> TcM a
    pushCtxt (Bool
    False, TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)
    ctxt)

    -- | Add a fixed landmark message to the error context. A landmark
    -- message is always sure to be reported, even if there is a lot of
    -- context. It also doesn't count toward the maximum number of contexts
    -- reported.
    addLandmarkErrCtxt :: ErrCtxtMsg -> TcM a -> TcM a
    {-# INLINE addLandmarkErrCtxt #-}  -- Note [Inlining addErrCtxt]
    addLandmarkErrCtxt :: forall a. ErrCtxtMsg -> TcM a -> TcM a
    addLandmarkErrCtxt ErrCtxtMsg
    msg = (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    forall a.
    (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    addLandmarkErrCtxtM (\TidyEnv
    env -> (TidyEnv, ErrCtxtMsg) -> ZonkM (TidyEnv, ErrCtxtMsg)
    forall a. a -> ZonkM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    env, ErrCtxtMsg
    msg))

    -- | Variant of 'addLandmarkErrCtxt' that allows for monadic operations
    -- and tidying.
    addLandmarkErrCtxtM :: (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    {-# INLINE addLandmarkErrCtxtM #-}  -- Note [Inlining addErrCtxt]
    addLandmarkErrCtxtM :: forall a.
    (TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)) -> TcM a -> TcM a
    addLandmarkErrCtxtM TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)
    ctxt = ErrCtxt -> TcM a -> TcM a
    forall a. ErrCtxt -> TcM a -> TcM a
    pushCtxt (Bool
    True, TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)
    ctxt)

    pushCtxt :: ErrCtxt -> TcM a -> TcM a
    {-# INLINE pushCtxt #-} -- Note [Inlining addErrCtxt]
    pushCtxt :: forall a. ErrCtxt -> TcM a -> TcM a
    pushCtxt ErrCtxt
    ctxt = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (ErrCtxt -> TcLclEnv -> TcLclEnv
    updCtxt ErrCtxt
    ctxt)

    updCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv
    -- Do not update the context if we are in generated code
    -- See Note [Rebindable syntax and XXExprGhcRn] in GHC.Hs.Expr
    updCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv
    updCtxt ErrCtxt
    ctxt TcLclEnv
    env
      | TcLclEnv -> Bool
    lclEnvInGeneratedCode TcLclEnv
    env = TcLclEnv
    env
      | Bool
    otherwise = ErrCtxt -> TcLclEnv -> TcLclEnv
    addLclEnvErrCtxt ErrCtxt
    ctxt TcLclEnv
    env

    popErrCtxt :: TcM a -> TcM a
    popErrCtxt :: forall a. TcM a -> TcM a
    popErrCtxt TcM a
    thing_inside = (TcLclEnv -> TcLclEnv) -> TcM a -> TcM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\TcLclEnv
    env -> [ErrCtxt] -> TcLclEnv -> TcLclEnv
    setLclEnvErrCtxt ([ErrCtxt] -> [ErrCtxt]
    forall {a}. [a] -> [a]
    pop ([ErrCtxt] -> [ErrCtxt]) -> [ErrCtxt] -> [ErrCtxt]
    forall a b. (a -> b) -> a -> b
    $ TcLclEnv -> [ErrCtxt]
    getLclEnvErrCtxt TcLclEnv
    env) TcLclEnv
    env) (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
                              TcM a
    thing_inside
               where
                 pop :: [a] -> [a]
    pop []       = []
                 pop (a
    _:[a]
    msgs) = [a]
    msgs

    getCtLocM :: CtOrigin -> Maybe TypeOrKind -> TcM CtLoc
    getCtLocM :: CtOrigin -> Maybe TypeOrKind -> TcM CtLoc
    getCtLocM CtOrigin
    origin Maybe TypeOrKind
    t_or_k
      = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; return (CtLoc { ctl_origin   = origin
                           , ctl_env      = mkCtLocEnv env
                           , ctl_t_or_k   = t_or_k
                           , ctl_depth    = initialSubGoalDepth }) }

    mkCtLocEnv :: TcLclEnv -> CtLocEnv
    mkCtLocEnv :: TcLclEnv -> CtLocEnv
    mkCtLocEnv TcLclEnv
    lcl_env =
      CtLocEnv { ctl_bndrs :: TcBinderStack
    ctl_bndrs = TcLclEnv -> TcBinderStack
    getLclEnvBinderStack TcLclEnv
    lcl_env
               , ctl_ctxt :: [ErrCtxt]
    ctl_ctxt  = TcLclEnv -> [ErrCtxt]
    getLclEnvErrCtxt TcLclEnv
    lcl_env
               , ctl_loc :: RealSrcSpan
    ctl_loc = TcLclEnv -> RealSrcSpan
    getLclEnvLoc TcLclEnv
    lcl_env
               , ctl_tclvl :: TcLevel
    ctl_tclvl = TcLclEnv -> TcLevel
    getLclEnvTcLevel TcLclEnv
    lcl_env
               , ctl_in_gen_code :: Bool
    ctl_in_gen_code = TcLclEnv -> Bool
    lclEnvInGeneratedCode TcLclEnv
    lcl_env
               , ctl_rdr :: LocalRdrEnv
    ctl_rdr = TcLclEnv -> LocalRdrEnv
    getLclEnvRdrEnv TcLclEnv
    lcl_env
               }

    setCtLocM :: CtLoc -> TcM a -> TcM a
    -- Set the SrcSpan and error context from the CtLoc
    setCtLocM :: forall a. CtLoc -> TcM a -> TcM a
    setCtLocM (CtLoc { ctl_env :: CtLoc -> CtLocEnv
    ctl_env = CtLocEnv
    lcl }) TcM a
    thing_inside
      = (TcLclEnv -> TcLclEnv) -> TcM a -> TcM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\TcLclEnv
    env -> RealSrcSpan -> TcLclEnv -> TcLclEnv
    setLclEnvLoc (CtLocEnv -> RealSrcSpan
    ctl_loc CtLocEnv
    lcl)
                         (TcLclEnv -> TcLclEnv) -> TcLclEnv -> TcLclEnv
    forall a b. (a -> b) -> a -> b
    $ [ErrCtxt] -> TcLclEnv -> TcLclEnv
    setLclEnvErrCtxt (CtLocEnv -> [ErrCtxt]
    ctl_ctxt CtLocEnv
    lcl)
                         (TcLclEnv -> TcLclEnv) -> TcLclEnv -> TcLclEnv
    forall a b. (a -> b) -> a -> b
    $ TcBinderStack -> TcLclEnv -> TcLclEnv
    setLclEnvBinderStack (CtLocEnv -> TcBinderStack
    ctl_bndrs CtLocEnv
    lcl)
                         (TcLclEnv -> TcLclEnv) -> TcLclEnv -> TcLclEnv
    forall a b. (a -> b) -> a -> b
    $ TcLclEnv
    env) TcM a
    thing_inside

    {- *********************************************************************
    *                                                                      *
                 Error recovery and exceptions
    *                                                                      *
    ********************************************************************* -}

    tcTryM :: TcRn r -> TcRn (Maybe r)
    -- The most basic function: catch the exception
    --   Nothing => an exception happened
    --   Just r  => no exception, result R
    -- Errors and constraints are propagated in both cases
    -- Never throws an exception
    tcTryM :: forall r. TcRn r -> TcRn (Maybe r)
    tcTryM TcRn r
    thing_inside
      = do { either_res <- TcRn r -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure r)
    forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM TcRn r
    thing_inside
           ; return (case either_res of
                        Left IOEnvFailure
    _  -> Maybe r
    forall a. Maybe a
    Nothing
                        Right r
    r -> r -> Maybe r
    forall a. a -> Maybe a
    Just r
    r) }
             -- In the Left case the exception is always the IOEnv
             -- built-in in exception; see IOEnv.failM

    -----------------------
    capture_constraints :: TcM r -> TcM (r, WantedConstraints)
    -- capture_constraints simply captures and returns the
    --                     constraints generated by thing_inside
    -- Precondition: thing_inside must not throw an exception!
    -- Reason for precondition: an exception would blow past the place
    -- where we read the lie_var, and we'd lose the constraints altogether
    capture_constraints :: forall r. TcM r -> TcM (r, WantedConstraints)
    capture_constraints TcM r
    thing_inside
      = do { lie_var <- WantedConstraints
    -> IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef WantedConstraints
    emptyWC
           ; res <- updLclEnv (\ TcLclEnv
    env -> TcLclEnv
    env { tcl_lie = lie_var }) $
                    thing_inside
           ; lie <- readTcRef lie_var
           ; return (res, lie) }

    capture_messages :: TcM r -> TcM (r, Messages TcRnMessage)
    -- capture_messages simply captures and returns the
    --                  errors and warnings generated by thing_inside
    -- Precondition: thing_inside must not throw an exception!
    -- Reason for precondition: an exception would blow past the place
    -- where we read the msg_var, and we'd lose the constraints altogether
    capture_messages :: forall r. TcM r -> TcM (r, Messages TcRnMessage)
    capture_messages TcM r
    thing_inside
      = do { msg_var <- Messages TcRnMessage -> TcRn (IORef (Messages TcRnMessage))
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef Messages TcRnMessage
    forall e. Messages e
    emptyMessages
           ; res     <- setErrsVar msg_var thing_inside
           ; msgs    <- readTcRef msg_var
           ; return (res, msgs) }

    -----------------------
    -- (askNoErrs m) runs m
    -- If m fails,
    --    then (askNoErrs m) fails, propagating only
    --         insoluble constraints
    --
    -- If m succeeds with result r,
    --    then (askNoErrs m) succeeds with result (r, b),
    --         where b is True iff m generated no errors
    --
    -- Regardless of success or failure,
    --   propagate any errors/warnings generated by m
    askNoErrs :: TcRn a -> TcRn (a, Bool)
    askNoErrs :: forall a. TcRn a -> TcRn (a, Bool)
    askNoErrs TcRn a
    thing_inside
      = do { ((mb_res, lie), msgs) <- TcM (Maybe a, WantedConstraints)
    -> TcM ((Maybe a, WantedConstraints), Messages TcRnMessage)
    forall r. TcM r -> TcM (r, Messages TcRnMessage)
    capture_messages    (TcM (Maybe a, WantedConstraints)
     -> TcM ((Maybe a, WantedConstraints), Messages TcRnMessage))
    -> TcM (Maybe a, WantedConstraints)
    -> TcM ((Maybe a, WantedConstraints), Messages TcRnMessage)
    forall a b. (a -> b) -> a -> b
    $
                                      TcM (Maybe a) -> TcM (Maybe a, WantedConstraints)
    forall r. TcM r -> TcM (r, WantedConstraints)
    capture_constraints (TcM (Maybe a) -> TcM (Maybe a, WantedConstraints))
    -> TcM (Maybe a) -> TcM (Maybe a, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                      TcRn a -> TcM (Maybe a)
    forall r. TcRn r -> TcRn (Maybe r)
    tcTryM TcRn a
    thing_inside
           ; addMessages msgs

           ; case mb_res of
               Maybe a
    Nothing  -> do { WantedConstraints -> TcM ()
    emitConstraints (WantedConstraints -> WantedConstraints
    dropMisleading WantedConstraints
    lie)
                              ; IOEnv (Env TcGblEnv TcLclEnv) (a, Bool)
    forall env a. IOEnv env a
    failM }

               Just a
    res -> do { WantedConstraints -> TcM ()
    emitConstraints WantedConstraints
    lie
                              ; let errs_found :: Bool
    errs_found = Messages TcRnMessage -> Bool
    forall e. Diagnostic e => Messages e -> Bool
    errorsFound Messages TcRnMessage
    msgs
                                              Bool -> Bool -> Bool
    || WantedConstraints -> Bool
    insolubleWC WantedConstraints
    lie
                              ; (a, Bool) -> IOEnv (Env TcGblEnv TcLclEnv) (a, Bool)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    res, Bool -> Bool
    not Bool
    errs_found) } }

    -----------------------
    tryCaptureConstraints :: TcM a -> TcM (Maybe a, WantedConstraints)
    -- (tryCaptureConstraints_maybe m) runs m,
    --   and returns the type constraints it generates
    -- It never throws an exception; instead if thing_inside fails,
    --   it returns Nothing and the /insoluble/ constraints
    -- Error messages are propagated
    tryCaptureConstraints :: forall a. TcM a -> TcM (Maybe a, WantedConstraints)
    tryCaptureConstraints TcM a
    thing_inside
      = do { (mb_res, lie) <- TcM (Maybe a) -> TcM (Maybe a, WantedConstraints)
    forall r. TcM r -> TcM (r, WantedConstraints)
    capture_constraints (TcM (Maybe a) -> TcM (Maybe a, WantedConstraints))
    -> TcM (Maybe a) -> TcM (Maybe a, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                              TcM a -> TcM (Maybe a)
    forall r. TcRn r -> TcRn (Maybe r)
    tcTryM TcM a
    thing_inside

           -- See Note [Constraints and errors]
           ; case mb_res of
                Just {} -> (Maybe a, WantedConstraints) -> TcM (Maybe a, WantedConstraints)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a
    mb_res, WantedConstraints
    lie)
                Maybe a
    Nothing -> do { let pruned_lie :: WantedConstraints
    pruned_lie = WantedConstraints -> WantedConstraints
    dropMisleading WantedConstraints
    lie
                              ; FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "tryCaptureConstraints" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
                                [SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat [ FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "lie:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    lie
                                     , FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "dropMisleading lie:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    pruned_lie ]
                              ; (Maybe a, WantedConstraints) -> TcM (Maybe a, WantedConstraints)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a
    forall a. Maybe a
    Nothing, WantedConstraints
    pruned_lie) } }

    captureConstraints :: TcM a -> TcM (a, WantedConstraints)
    -- (captureConstraints m) runs m, and returns the type constraints it generates
    -- If thing_inside fails (throwing an exception),
    --   then (captureConstraints thing_inside) fails too
    --   propagating the insoluble constraints only
    -- Error messages are propagated in either case
    captureConstraints :: forall r. TcM r -> TcM (r, WantedConstraints)
    captureConstraints TcM a
    thing_inside
      = do { (mb_res, lie) <- TcM a -> TcM (Maybe a, WantedConstraints)
    forall a. TcM a -> TcM (Maybe a, WantedConstraints)
    tryCaptureConstraints TcM a
    thing_inside

                -- See Note [Constraints and errors]
                -- If the thing_inside threw an exception, emit the insoluble
                -- constraints only (returned by tryCaptureConstraints)
                -- so that they are not lost
           ; case mb_res of
               Maybe a
    Nothing  -> do { WantedConstraints -> TcM ()
    emitConstraints WantedConstraints
    lie; IOEnv (Env TcGblEnv TcLclEnv) (a, WantedConstraints)
    forall env a. IOEnv env a
    failM }
               Just a
    res -> (a, WantedConstraints)
    -> IOEnv (Env TcGblEnv TcLclEnv) (a, WantedConstraints)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    res, WantedConstraints
    lie) }

    -----------------------
    -- | @tcCollectingUsage thing_inside@ runs @thing_inside@ and returns the usage
    -- information which was collected as part of the execution of
    -- @thing_inside@. Careful: @tcCollectingUsage thing_inside@ itself does not
    -- report any usage information, it's up to the caller to incorporate the
    -- returned usage information into the larger context appropriately.
    tcCollectingUsage :: TcM a -> TcM (UsageEnv,a)
    tcCollectingUsage :: forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage TcM a
    thing_inside
      = do { local_usage_ref <- UsageEnv -> IOEnv (Env TcGblEnv TcLclEnv) (IORef UsageEnv)
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef UsageEnv
    zeroUE
           ; result <- updLclEnv (\TcLclEnv
    env -> TcLclEnv
    env { tcl_usage = local_usage_ref }) thing_inside
           ; local_usage <- readTcRef local_usage_ref
           ; return (local_usage,result) }

    -- | @tcScalingUsage mult thing_inside@ runs @thing_inside@ and scales all the
    -- usage information by @mult@.
    tcScalingUsage :: Mult -> TcM a -> TcM a
    tcScalingUsage :: forall a. Mult -> TcM a -> TcM a
    tcScalingUsage Mult
    mult TcM a
    thing_inside
      = do { (usage, result) <- TcM a -> TcM (UsageEnv, a)
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage TcM a
    thing_inside
           ; traceTc "tcScalingUsage" $ vcat [ppr mult, ppr usage]
           ; tcEmitBindingUsage $ scaleUE mult usage
           ; return result }

    tcEmitBindingUsage :: UsageEnv -> TcM ()
    tcEmitBindingUsage :: UsageEnv -> TcM ()
    tcEmitBindingUsage UsageEnv
    ue
      = do { lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; let usage = TcLclEnv -> IORef UsageEnv
    tcl_usage TcLclEnv
    lcl_env
           ; updTcRef usage (addUE ue) }

    -----------------------
    attemptM :: TcRn r -> TcRn (Maybe r)
    -- (attemptM thing_inside) runs thing_inside
    -- If thing_inside succeeds, returning r,
    --   we return (Just r), and propagate all constraints and errors
    -- If thing_inside fail, throwing an exception,
    --   we return Nothing, propagating insoluble constraints,
    --                      and all errors
    -- attemptM never throws an exception
    attemptM :: forall r. TcRn r -> TcRn (Maybe r)
    attemptM TcRn r
    thing_inside
      = do { (mb_r, lie) <- TcRn r -> TcM (Maybe r, WantedConstraints)
    forall a. TcM a -> TcM (Maybe a, WantedConstraints)
    tryCaptureConstraints TcRn r
    thing_inside
           ; emitConstraints lie

           -- Debug trace
           ; when (isNothing mb_r) $
             traceTc "attemptM recovering with insoluble constraints" $
                     (ppr lie)

           ; return mb_r }

    -----------------------
    recoverM :: TcRn r      -- Recovery action; do this if the main one fails
             -> TcRn r      -- Main action: do this first;
                            --  if it generates errors, propagate them all
             -> TcRn r
    -- (recoverM recover thing_inside) runs thing_inside
    -- If thing_inside fails, propagate its errors and insoluble constraints
    --                        and run 'recover'
    -- If thing_inside succeeds, propagate all its errors and constraints
    --
    -- Can fail, if 'recover' fails
    recoverM :: forall r. TcRn r -> TcRn r -> TcRn r
    recoverM TcRn r
    recover TcRn r
    thing
      = do { mb_res <- TcRn r -> TcRn (Maybe r)
    forall r. TcRn r -> TcRn (Maybe r)
    attemptM TcRn r
    thing ;
             case mb_res of
               Maybe r
    Nothing  -> TcRn r
    recover
               Just r
    res -> r -> TcRn r
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    res }

    -----------------------

    -- | Drop elements of the input that fail, so the result
    -- list can be shorter than the argument list
    mapAndRecoverM :: (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndRecoverM :: forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndRecoverM a -> TcRn b
    f [a]
    xs
      = do { mb_rs <- (a -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b))
    -> [a] -> IOEnv (Env TcGblEnv TcLclEnv) [Maybe b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (TcRn b -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b)
    forall r. TcRn r -> TcRn (Maybe r)
    attemptM (TcRn b -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b))
    -> (a -> TcRn b) -> a -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> TcRn b
    f) [a]
    xs
           ; return [r | Just r <- mb_rs] }

    -- | Apply the function to all elements on the input list
    -- If all succeed, return the list of results
    -- Otherwise fail, propagating all errors
    mapAndReportM :: (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndReportM :: forall a b. (a -> TcRn b) -> [a] -> TcRn [b]
    mapAndReportM a -> TcRn b
    f [a]
    xs
      = do { mb_rs <- (a -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b))
    -> [a] -> IOEnv (Env TcGblEnv TcLclEnv) [Maybe b]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (TcRn b -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b)
    forall r. TcRn r -> TcRn (Maybe r)
    attemptM (TcRn b -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b))
    -> (a -> TcRn b) -> a -> IOEnv (Env TcGblEnv TcLclEnv) (Maybe b)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> TcRn b
    f) [a]
    xs
           ; when (any isNothing mb_rs) failM
           ; return [r | Just r <- mb_rs] }

    -- | The accumulator is not updated if the action fails
    foldAndRecoverM :: (b -> a -> TcRn b) -> b -> [a] -> TcRn b
    foldAndRecoverM :: forall b a. (b -> a -> TcRn b) -> b -> [a] -> TcRn b
    foldAndRecoverM b -> a -> TcRn b
    _ b
    acc []     = b -> TcRn b
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return b
    acc
    foldAndRecoverM b -> a -> TcRn b
    f b
    acc (a
    x:[a]
    xs) =
                              do { mb_r <- TcRn b -> TcRn (Maybe b)
    forall r. TcRn r -> TcRn (Maybe r)
    attemptM (b -> a -> TcRn b
    f b
    acc a
    x)
                                 ; case mb_r of
                                    Maybe b
    Nothing   -> (b -> a -> TcRn b) -> b -> [a] -> TcRn b
    forall b a. (b -> a -> TcRn b) -> b -> [a] -> TcRn b
    foldAndRecoverM b -> a -> TcRn b
    f b
    acc [a]
    xs
                                    Just b
    acc' -> (b -> a -> TcRn b) -> b -> [a] -> TcRn b
    forall b a. (b -> a -> TcRn b) -> b -> [a] -> TcRn b
    foldAndRecoverM b -> a -> TcRn b
    f b
    acc' [a]
    xs  }

    -----------------------
    tryTc :: TcRn a -> TcRn (Maybe a, Messages TcRnMessage)
    -- (tryTc m) executes m, and returns
    --      Just r,  if m succeeds (returning r)
    --      Nothing, if m fails
    -- It also returns all the errors and warnings accumulated by m
    -- It always succeeds (never raises an exception)
    tryTc :: forall a. TcRn a -> TcRn (Maybe a, Messages TcRnMessage)
    tryTc TcRn a
    thing_inside
     = TcM (Maybe a) -> TcM (Maybe a, Messages TcRnMessage)
    forall r. TcM r -> TcM (r, Messages TcRnMessage)
    capture_messages (TcRn a -> TcM (Maybe a)
    forall r. TcRn r -> TcRn (Maybe r)
    attemptM TcRn a
    thing_inside)

    -----------------------
    discardErrs :: TcRn a -> TcRn a
    -- (discardErrs m) runs m,
    --   discarding all error messages and warnings generated by m
    -- If m fails, discardErrs fails, and vice versa
    discardErrs :: forall a. TcM a -> TcM a
    discardErrs TcRn a
    m
     = do { errs_var <- Messages TcRnMessage -> TcRn (IORef (Messages TcRnMessage))
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef Messages TcRnMessage
    forall e. Messages e
    emptyMessages
          ; setErrsVar errs_var m }

    -----------------------
    tryTcDiscardingErrs :: TcM r -> TcM r -> TcM r
    -- (tryTcDiscardingErrs recover thing_inside) tries 'thing_inside';
    --      if 'main' succeeds with no error messages, it's the answer
    --      otherwise discard everything from 'main', including errors,
    --          and try 'recover' instead.
    tryTcDiscardingErrs :: forall r. TcRn r -> TcRn r -> TcRn r
    tryTcDiscardingErrs TcM r
    recover =
      (WantedConstraints -> Messages TcRnMessage -> r -> Bool)
    -> TcM r -> TcM r -> TcM r -> TcM r
    forall r.
    (WantedConstraints -> Messages TcRnMessage -> r -> Bool)
    -> TcM r -> TcM r -> TcM r -> TcM r
    tryTcDiscardingErrs'
        (\WantedConstraints
    _ Messages TcRnMessage
    _ r
    _ -> Bool
    True)     -- No validation
        TcM r
    recover TcM r
    recover      -- Discard all errors and warnings
                             -- and unsolved constraints entirely

    tryTcDiscardingErrs' :: (WantedConstraints -> Messages TcRnMessage -> r -> Bool)  -- Validation
                         -> TcM r  -- Recover from validation error
                         -> TcM r  -- Recover from failure
                         -> TcM r  -- Action to try
                         -> TcM r
    -- (tryTcDiscardingErrs' validate recover_invalid recover_error thing_inside) tries 'thing_inside';
    --      if 'thing_inside' succeeds and validation produces no errors, it's the answer
    --      otherwise discard everything from 'thing_inside', including errors,
    --          and try 'recover' instead.
    tryTcDiscardingErrs' :: forall r.
    (WantedConstraints -> Messages TcRnMessage -> r -> Bool)
    -> TcM r -> TcM r -> TcM r -> TcM r
    tryTcDiscardingErrs' WantedConstraints -> Messages TcRnMessage -> r -> Bool
    validate TcM r
    recover_invalid TcM r
    recover_error TcM r
    thing_inside
      = do { ((mb_res, lie), msgs) <- TcM (Maybe r, WantedConstraints)
    -> TcM ((Maybe r, WantedConstraints), Messages TcRnMessage)
    forall r. TcM r -> TcM (r, Messages TcRnMessage)
    capture_messages    (TcM (Maybe r, WantedConstraints)
     -> TcM ((Maybe r, WantedConstraints), Messages TcRnMessage))
    -> TcM (Maybe r, WantedConstraints)
    -> TcM ((Maybe r, WantedConstraints), Messages TcRnMessage)
    forall a b. (a -> b) -> a -> b
    $
                                      TcM (Maybe r) -> TcM (Maybe r, WantedConstraints)
    forall r. TcM r -> TcM (r, WantedConstraints)
    capture_constraints (TcM (Maybe r) -> TcM (Maybe r, WantedConstraints))
    -> TcM (Maybe r) -> TcM (Maybe r, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                                      TcM r -> TcM (Maybe r)
    forall r. TcRn r -> TcRn (Maybe r)
    tcTryM TcM r
    thing_inside
            ; case mb_res of
                Just r
    res | Bool -> Bool
    not (Messages TcRnMessage -> Bool
    forall e. Diagnostic e => Messages e -> Bool
    errorsFound Messages TcRnMessage
    msgs)
                         , Bool -> Bool
    not (WantedConstraints -> Bool
    insolubleWC WantedConstraints
    lie)
                        -- 'thing_inside' succeeded with no errors
                  -> if WantedConstraints -> Messages TcRnMessage -> r -> Bool
    validate WantedConstraints
    lie Messages TcRnMessage
    msgs r
    res
                     then do { Messages TcRnMessage -> TcM ()
    addMessages Messages TcRnMessage
    msgs  -- msgs might still have warnings
                             ; WantedConstraints -> TcM ()
    emitConstraints WantedConstraints
    lie
                             ; r -> TcM r
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    res }
                     else TcM r
    recover_invalid

                Maybe r
    _ -> -- 'thing_inside' failed, or produced an error message
                     TcM r
    recover_error
            }

    {-
    ************************************************************************
    *                                                                      *
                 Error message generation (type checker)
    *                                                                      *
    ************************************************************************

        The addErrTc functions add an error message, but do not cause failure.
        The 'M' variants pass a TidyEnv that has already been used to
        tidy up the message; we then use it to tidy the context messages
    -}

    {-

    Note [Reporting warning diagnostics]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    We use functions below to report warnings.  For the most part,
    we do /not/ need to check any warning flags before doing so.
    See https://gitlab.haskell.org/ghc/ghc/-/wikis/Errors-as-(structured)-values
    for the design.

    -}

    addErrTc :: TcRnMessage -> TcM ()
    addErrTc :: TcRnMessage -> TcM ()
    addErrTc TcRnMessage
    err_msg = do { env0 <- ZonkM TidyEnv -> TcM TidyEnv
    forall a. ZonkM a -> TcM a
    liftZonkM ZonkM TidyEnv
    tcInitTidyEnv
                          ; addErrTcM (env0, err_msg) }

    addErrTcM :: (TidyEnv, TcRnMessage) -> TcM ()
    addErrTcM :: (TidyEnv, TcRnMessage) -> TcM ()
    addErrTcM (TidyEnv
    tidy_env, TcRnMessage
    err_msg)
      = do { ctxt <- TcM [ErrCtxt]
    getErrCtxt ;
             loc  <- getSrcSpanM ;
             add_err_tcm tidy_env err_msg loc ctxt }

    -- The failWith functions add an error message and cause failure

    failWithTc :: TcRnMessage -> TcM a               -- Add an error message and fail
    failWithTc :: forall a. TcRnMessage -> TcRn a
    failWithTc TcRnMessage
    err_msg
      = TcRnMessage -> TcM ()
    addErrTc TcRnMessage
    err_msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall a b.
    IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IOEnv (Env TcGblEnv TcLclEnv) a
    forall env a. IOEnv env a
    failM

    failWithTcM :: (TidyEnv, TcRnMessage) -> TcM a   -- Add an error message and fail
    failWithTcM :: forall a. (TidyEnv, TcRnMessage) -> TcM a
    failWithTcM (TidyEnv, TcRnMessage)
    local_and_msg
      = (TidyEnv, TcRnMessage) -> TcM ()
    addErrTcM (TidyEnv, TcRnMessage)
    local_and_msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall a b.
    IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IOEnv (Env TcGblEnv TcLclEnv) a
    forall env a. IOEnv env a
    failM

    checkTc :: Bool -> TcRnMessage -> TcM ()         -- Check that the boolean is true
    checkTc :: Bool -> TcRnMessage -> TcM ()
    checkTc Bool
    True  TcRnMessage
    _   = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkTc Bool
    False TcRnMessage
    err = TcRnMessage -> TcM ()
    forall a. TcRnMessage -> TcRn a
    failWithTc TcRnMessage
    err

    checkTcM :: Bool -> (TidyEnv, TcRnMessage) -> TcM ()
    checkTcM :: Bool -> (TidyEnv, TcRnMessage) -> TcM ()
    checkTcM Bool
    True  (TidyEnv, TcRnMessage)
    _   = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkTcM Bool
    False (TidyEnv, TcRnMessage)
    err = (TidyEnv, TcRnMessage) -> TcM ()
    forall a. (TidyEnv, TcRnMessage) -> TcM a
    failWithTcM (TidyEnv, TcRnMessage)
    err

    checkJustTc :: TcRnMessage -> Maybe a -> TcM a
    checkJustTc :: forall a. TcRnMessage -> Maybe a -> TcM a
    checkJustTc TcRnMessage
    err = TcM a -> (a -> TcM a) -> Maybe a -> TcM a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (TcRnMessage -> TcM a
    forall a. TcRnMessage -> TcRn a
    failWithTc TcRnMessage
    err) a -> TcM a
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    checkJustTcM :: (TidyEnv, TcRnMessage) -> Maybe a -> TcM a
    checkJustTcM :: forall a. (TidyEnv, TcRnMessage) -> Maybe a -> TcM a
    checkJustTcM (TidyEnv, TcRnMessage)
    err = TcM a -> (a -> TcM a) -> Maybe a -> TcM a
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ((TidyEnv, TcRnMessage) -> TcM a
    forall a. (TidyEnv, TcRnMessage) -> TcM a
    failWithTcM (TidyEnv, TcRnMessage)
    err) a -> TcM a
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure

    failIfTc :: Bool -> TcRnMessage -> TcM ()         -- Check that the boolean is false
    failIfTc :: Bool -> TcRnMessage -> TcM ()
    failIfTc Bool
    False TcRnMessage
    _   = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    failIfTc Bool
    True  TcRnMessage
    err = TcRnMessage -> TcM ()
    forall a. TcRnMessage -> TcRn a
    failWithTc TcRnMessage
    err

    failIfTcM :: Bool -> (TidyEnv, TcRnMessage) -> TcM ()
       -- Check that the boolean is false
    failIfTcM :: Bool -> (TidyEnv, TcRnMessage) -> TcM ()
    failIfTcM Bool
    False (TidyEnv, TcRnMessage)
    _   = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    failIfTcM Bool
    True  (TidyEnv, TcRnMessage)
    err = (TidyEnv, TcRnMessage) -> TcM ()
    forall a. (TidyEnv, TcRnMessage) -> TcM a
    failWithTcM (TidyEnv, TcRnMessage)
    err

    --         Warnings have no 'M' variant, nor failure

    -- | Display a warning if a condition is met.
    warnIf :: Bool -> TcRnMessage -> TcRn ()
    warnIf :: Bool -> TcRnMessage -> TcM ()
    warnIf Bool
    is_bad TcRnMessage
    msg -- No need to check any flag here, it will be done in 'diagReasonSeverity'.
      = Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    is_bad (TcRnMessage -> TcM ()
    addDiagnostic TcRnMessage
    msg)

    -- | Display a warning if a condition is met.
    diagnosticTc :: Bool -> TcRnMessage -> TcM ()
    diagnosticTc :: Bool -> TcRnMessage -> TcM ()
    diagnosticTc Bool
    should_report TcRnMessage
    warn_msg
      | Bool
    should_report = TcRnMessage -> TcM ()
    addDiagnosticTc TcRnMessage
    warn_msg
      | Bool
    otherwise     = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Display a diagnostic if a condition is met.
    diagnosticTcM :: Bool -> (TidyEnv, TcRnMessage) -> TcM ()
    diagnosticTcM :: Bool -> (TidyEnv, TcRnMessage) -> TcM ()
    diagnosticTcM Bool
    should_report (TidyEnv, TcRnMessage)
    warn_msg
      | Bool
    should_report = (TidyEnv, TcRnMessage) -> TcM ()
    addDiagnosticTcM (TidyEnv, TcRnMessage)
    warn_msg
      | Bool
    otherwise     = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Display a diagnostic in the current context.
    addDiagnosticTc :: TcRnMessage -> TcM ()
    addDiagnosticTc :: TcRnMessage -> TcM ()
    addDiagnosticTc TcRnMessage
    msg
     = do { env0 <- ZonkM TidyEnv -> TcM TidyEnv
    forall a. ZonkM a -> TcM a
    liftZonkM ZonkM TidyEnv
    tcInitTidyEnv
          ; addDiagnosticTcM (env0, msg) }

    -- | Display a diagnostic in a given context.
    addDiagnosticTcM :: (TidyEnv, TcRnMessage) -> TcM ()
    addDiagnosticTcM :: (TidyEnv, TcRnMessage) -> TcM ()
    addDiagnosticTcM (TidyEnv
    env0, TcRnMessage
    msg)
     = do { ctxt <- TcM [ErrCtxt]
    getErrCtxt
          ; extra <- mkErrCtxt env0 ctxt
          ; let detailed_msg = ErrInfo -> TcRnMessage -> TcRnMessageDetailed
    mkDetailedMessage ([ErrCtxtMsg]
    -> Maybe (HoleFitDispConfig, [SupplementaryInfo])
    -> [GhcHint]
    -> ErrInfo
    ErrInfo [ErrCtxtMsg]
    extra Maybe (HoleFitDispConfig, [SupplementaryInfo])
    forall a. Maybe a
    Nothing [GhcHint]
    noHints) TcRnMessage
    msg
          ; add_diagnostic detailed_msg }

    -- | A variation of 'addDiagnostic' that takes a function to produce a 'TcRnDsMessage'
    -- given some additional context about the diagnostic.
    addDetailedDiagnostic :: ([ErrCtxtMsg] -> TcRnMessage) -> TcM ()
    addDetailedDiagnostic :: ([ErrCtxtMsg] -> TcRnMessage) -> TcM ()
    addDetailedDiagnostic [ErrCtxtMsg] -> TcRnMessage
    mkMsg = do
      loc <- TcRn SrcSpan
    getSrcSpanM
      name_ppr_ctx <- getNamePprCtx
      !diag_opts  <- initDiagOpts <$> getDynFlags
      env0 <- liftZonkM tcInitTidyEnv
      ctxt <- getErrCtxt
      err_info <- mkErrCtxt env0 ctxt
      reportDiagnostic $
        mkMsgEnvelope diag_opts loc name_ppr_ctx $
          mkMsg err_info

    addTcRnDiagnostic :: TcRnMessage -> TcM ()
    addTcRnDiagnostic :: TcRnMessage -> TcM ()
    addTcRnDiagnostic TcRnMessage
    msg = do
      loc <- TcRn SrcSpan
    getSrcSpanM
      mkTcRnMessage loc msg >>= reportDiagnostic

    -- | Display a diagnostic for the current source location, taken from
    -- the 'TcRn' monad.
    addDiagnostic :: TcRnMessage -> TcRn ()
    addDiagnostic :: TcRnMessage -> TcM ()
    addDiagnostic TcRnMessage
    msg = TcRnMessageDetailed -> TcM ()
    add_diagnostic (ErrInfo -> TcRnMessage -> TcRnMessageDetailed
    mkDetailedMessage ([ErrCtxtMsg]
    -> Maybe (HoleFitDispConfig, [SupplementaryInfo])
    -> [GhcHint]
    -> ErrInfo
    ErrInfo [] Maybe (HoleFitDispConfig, [SupplementaryInfo])
    forall a. Maybe a
    Nothing [GhcHint]
    noHints) TcRnMessage
    msg)

    -- | Display a diagnostic for a given source location.
    addDiagnosticAt :: SrcSpan -> TcRnMessage -> TcRn ()
    addDiagnosticAt :: SrcSpan -> TcRnMessage -> TcM ()
    addDiagnosticAt SrcSpan
    loc TcRnMessage
    msg = do
      unit_state <- HasDebugCallStack => HscEnv -> UnitState
    HscEnv -> UnitState
    hsc_units (HscEnv -> UnitState)
    -> TcRnIf TcGblEnv TcLclEnv HscEnv
    -> IOEnv (Env TcGblEnv TcLclEnv) UnitState
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
      let detailed_msg = ErrInfo -> TcRnMessage -> TcRnMessageDetailed
    mkDetailedMessage ([ErrCtxtMsg]
    -> Maybe (HoleFitDispConfig, [SupplementaryInfo])
    -> [GhcHint]
    -> ErrInfo
    ErrInfo [] Maybe (HoleFitDispConfig, [SupplementaryInfo])
    forall a. Maybe a
    Nothing [GhcHint]
    noHints) TcRnMessage
    msg
      mkTcRnMessage loc (TcRnMessageWithInfo unit_state detailed_msg) >>= reportDiagnostic

    -- | Display a diagnostic, with an optional flag, for the current source
    -- location.
    add_diagnostic :: TcRnMessageDetailed -> TcRn ()
    add_diagnostic :: TcRnMessageDetailed -> TcM ()
    add_diagnostic TcRnMessageDetailed
    msg
      = do { loc <- TcRn SrcSpan
    getSrcSpanM
           ; unit_state <- hsc_units <$> getTopEnv
           ; mkTcRnMessage loc (TcRnMessageWithInfo unit_state msg) >>= reportDiagnostic
           }

    {-
    -----------------------------------
            Other helper functions
    -}

    add_err_tcm :: TidyEnv -> TcRnMessage -> SrcSpan
                -> [ErrCtxt]
                -> TcM ()
    add_err_tcm :: TidyEnv -> TcRnMessage -> SrcSpan -> [ErrCtxt] -> TcM ()
    add_err_tcm TidyEnv
    tidy_env TcRnMessage
    msg SrcSpan
    loc [ErrCtxt]
    ctxt
     = do { err_ctxt <- TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
    mkErrCtxt TidyEnv
    tidy_env [ErrCtxt]
    ctxt
          ; add_long_err_at loc $
              mkDetailedMessage (ErrInfo err_ctxt Nothing noHints) msg }

    mkErrCtxt :: TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
    -- Tidy the error info, trimming excessive contexts
    mkErrCtxt :: TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
    mkErrCtxt TidyEnv
    env [ErrCtxt]
    ctxts
    --  = do
    --       dbg <- hasPprDebug <$> getDynFlags
    --       if dbg                -- In -dppr-debug style the output
    --          then return empty  -- just becomes too voluminous
    --          else go dbg 0 env ctxts
     = Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
    go Bool
    False Int
    0 TidyEnv
    env [ErrCtxt]
    ctxts
     where
       go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
       go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
    go Bool
    _ Int
    _ TidyEnv
    _   [] = [ErrCtxtMsg] -> TcM [ErrCtxtMsg]
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
       go Bool
    dbg Int
    n TidyEnv
    env ((Bool
    is_landmark, TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)
    ctxt) : [ErrCtxt]
    ctxts)
         | Bool
    is_landmark Bool -> Bool -> Bool
    || Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    mAX_CONTEXTS -- Too verbose || dbg
         = do { (env', msg) <- ZonkM (TidyEnv, ErrCtxtMsg) -> TcM (TidyEnv, ErrCtxtMsg)
    forall a. ZonkM a -> TcM a
    liftZonkM (ZonkM (TidyEnv, ErrCtxtMsg) -> TcM (TidyEnv, ErrCtxtMsg))
    -> ZonkM (TidyEnv, ErrCtxtMsg) -> TcM (TidyEnv, ErrCtxtMsg)
    forall a b. (a -> b) -> a -> b
    $ TidyEnv -> ZonkM (TidyEnv, ErrCtxtMsg)
    ctxt TidyEnv
    env
              ; let n' = if Bool
    is_landmark then Int
    n else Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1
              ; rest <- go dbg n' env' ctxts
              ; return (msg : rest) }
         | Bool
    otherwise
         = Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM [ErrCtxtMsg]
    go Bool
    dbg Int
    n TidyEnv
    env [ErrCtxt]
    ctxts

    mAX_CONTEXTS :: Int     -- No more than this number of non-landmark contexts
    mAX_CONTEXTS :: Int
    mAX_CONTEXTS = Int
    3

    -- debugTc is useful for monadic debugging code

    debugTc :: TcM () -> TcM ()
    debugTc :: TcM () -> TcM ()
    debugTc TcM ()
    thing
     | Bool
    debugIsOn = TcM ()
    thing
     | Bool
    otherwise = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    {-
    ************************************************************************
    *                                                                      *
                 Type constraints
    *                                                                      *
    ************************************************************************
    -}

    addTopEvBinds :: Bag EvBind -> TcM a -> TcM a
    addTopEvBinds :: forall a. Bag EvBind -> TcM a -> TcM a
    addTopEvBinds Bag EvBind
    new_ev_binds TcM a
    thing_inside
      =(TcGblEnv -> TcGblEnv) -> TcM a -> TcM a
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv TcGblEnv -> TcGblEnv
    upd_env TcM a
    thing_inside
      where
        upd_env :: TcGblEnv -> TcGblEnv
    upd_env TcGblEnv
    tcg_env = TcGblEnv
    tcg_env { tcg_ev_binds = tcg_ev_binds tcg_env
                                                   `unionBags` new_ev_binds }

    newTcEvBinds :: TcM EvBindsVar
    newTcEvBinds :: TcM EvBindsVar
    newTcEvBinds = do { binds_ref <- EvBindMap -> IOEnv (Env TcGblEnv TcLclEnv) (TcRef EvBindMap)
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef EvBindMap
    emptyEvBindMap
                      ; tcvs_ref  <- newTcRef []
                      ; uniq <- newUnique
                      ; traceTc "newTcEvBinds" (text "unique =" <+> ppr uniq)
                      ; return (EvBindsVar { ebv_binds = binds_ref
                                           , ebv_tcvs = tcvs_ref
                                           , ebv_uniq = uniq }) }

    -- | Creates an EvBindsVar incapable of holding any bindings. It still
    -- tracks covar usages (see comments on ebv_tcvs in "GHC.Tc.Types.Evidence"), thus
    -- must be made monadically
    newNoTcEvBinds :: TcM EvBindsVar
    newNoTcEvBinds :: TcM EvBindsVar
    newNoTcEvBinds
      = do { tcvs_ref  <- [TcCoercion] -> IOEnv (Env TcGblEnv TcLclEnv) (TcRef [TcCoercion])
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef []
           ; uniq <- newUnique
           ; traceTc "newNoTcEvBinds" (text "unique =" <+> ppr uniq)
           ; return (CoEvBindsVar { ebv_tcvs = tcvs_ref
                                  , ebv_uniq = uniq }) }

    cloneEvBindsVar :: EvBindsVar -> TcM EvBindsVar
    -- Clone the refs, so that any binding created when
    -- solving don't pollute the original
    cloneEvBindsVar :: EvBindsVar -> TcM EvBindsVar
    cloneEvBindsVar ebv :: EvBindsVar
    ebv@(EvBindsVar {})
      = do { binds_ref <- EvBindMap -> IOEnv (Env TcGblEnv TcLclEnv) (TcRef EvBindMap)
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef EvBindMap
    emptyEvBindMap
           ; tcvs_ref  <- newTcRef []
           ; return (ebv { ebv_binds = binds_ref
                         , ebv_tcvs = tcvs_ref }) }
    cloneEvBindsVar ebv :: EvBindsVar
    ebv@(CoEvBindsVar {})
      = do { tcvs_ref  <- [TcCoercion] -> IOEnv (Env TcGblEnv TcLclEnv) (TcRef [TcCoercion])
    forall (m :: * -> *) a. MonadIO m => a -> m (TcRef a)
    newTcRef []
           ; return (ebv { ebv_tcvs = tcvs_ref }) }

    getTcEvTyCoVars :: EvBindsVar -> TcM [TcCoercion]
    getTcEvTyCoVars :: EvBindsVar -> TcM [TcCoercion]
    getTcEvTyCoVars EvBindsVar
    ev_binds_var
      = TcRef [TcCoercion] -> TcM [TcCoercion]
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef (EvBindsVar -> TcRef [TcCoercion]
    ebv_tcvs EvBindsVar
    ev_binds_var)

    getTcEvBindsMap :: EvBindsVar -> TcM EvBindMap
    getTcEvBindsMap :: EvBindsVar -> TcM EvBindMap
    getTcEvBindsMap (EvBindsVar { ebv_binds :: EvBindsVar -> TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    ev_ref })
      = TcRef EvBindMap -> TcM EvBindMap
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef TcRef EvBindMap
    ev_ref
    getTcEvBindsMap (CoEvBindsVar {})
      = EvBindMap -> TcM EvBindMap
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return EvBindMap
    emptyEvBindMap

    setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcM ()
    setTcEvBindsMap :: EvBindsVar -> EvBindMap -> TcM ()
    setTcEvBindsMap (EvBindsVar { ebv_binds :: EvBindsVar -> TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    ev_ref }) EvBindMap
    binds
      = TcRef EvBindMap -> EvBindMap -> TcM ()
    forall (m :: * -> *) a. MonadIO m => TcRef a -> a -> m ()
    writeTcRef TcRef EvBindMap
    ev_ref EvBindMap
    binds
    setTcEvBindsMap v :: EvBindsVar
    v@(CoEvBindsVar {}) EvBindMap
    ev_binds
      | EvBindMap -> Bool
    isEmptyEvBindMap EvBindMap
    ev_binds
      = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise
      = FilePath -> SDoc -> TcM ()
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "setTcEvBindsMap" (EvBindsVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindsVar
    v SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ EvBindMap -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindMap
    ev_binds)

    updTcEvBinds :: EvBindsVar -> EvBindsVar -> TcM ()
    updTcEvBinds :: EvBindsVar -> EvBindsVar -> TcM ()
    updTcEvBinds (EvBindsVar { ebv_binds :: EvBindsVar -> TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    old_ebv_ref, ebv_tcvs :: EvBindsVar -> TcRef [TcCoercion]
    ebv_tcvs = TcRef [TcCoercion]
    old_tcv_ref })
                 (EvBindsVar { ebv_binds :: EvBindsVar -> TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    new_ebv_ref, ebv_tcvs :: EvBindsVar -> TcRef [TcCoercion]
    ebv_tcvs = TcRef [TcCoercion]
    new_tcv_ref })
      = do { new_ebvs <- TcRef EvBindMap -> TcM EvBindMap
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef TcRef EvBindMap
    new_ebv_ref
           ; updTcRef old_ebv_ref (`unionEvBindMap` new_ebvs)
           ; new_tcvs <- readTcRef new_tcv_ref
           ; updTcRef old_tcv_ref (new_tcvs ++) }
    updTcEvBinds (EvBindsVar { ebv_tcvs :: EvBindsVar -> TcRef [TcCoercion]
    ebv_tcvs = TcRef [TcCoercion]
    old_tcv_ref })
                 (CoEvBindsVar { ebv_tcvs :: EvBindsVar -> TcRef [TcCoercion]
    ebv_tcvs = TcRef [TcCoercion]
    new_tcv_ref })
      = do { new_tcvs <- TcRef [TcCoercion] -> TcM [TcCoercion]
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef TcRef [TcCoercion]
    new_tcv_ref
           ; updTcRef old_tcv_ref (new_tcvs ++) }
    updTcEvBinds (CoEvBindsVar { ebv_tcvs :: EvBindsVar -> TcRef [TcCoercion]
    ebv_tcvs = TcRef [TcCoercion]
    old_tcv_ref })
                 (CoEvBindsVar { ebv_tcvs :: EvBindsVar -> TcRef [TcCoercion]
    ebv_tcvs = TcRef [TcCoercion]
    new_tcv_ref })
      = do { new_tcvs <- TcRef [TcCoercion] -> TcM [TcCoercion]
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef TcRef [TcCoercion]
    new_tcv_ref
           ; updTcRef old_tcv_ref (new_tcvs ++) }
    updTcEvBinds EvBindsVar
    old_var EvBindsVar
    new_var
      = FilePath -> SDoc -> TcM ()
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "updTcEvBinds" (EvBindsVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindsVar
    old_var SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ EvBindsVar -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindsVar
    new_var)
        -- Terms inside types, no good

    addTcEvBind :: EvBindsVar -> EvBind -> TcM ()
    -- Add a binding to the TcEvBinds by side effect
    addTcEvBind :: EvBindsVar -> EvBind -> TcM ()
    addTcEvBind (EvBindsVar { ebv_binds :: EvBindsVar -> TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    ev_ref, ebv_uniq :: EvBindsVar -> Unique
    ebv_uniq = Unique
    u }) EvBind
    ev_bind
      = do { bnds <- TcRef EvBindMap -> TcM EvBindMap
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef TcRef EvBindMap
    ev_ref
           ; let bnds' = EvBindMap -> EvBind -> EvBindMap
    extendEvBinds EvBindMap
    bnds EvBind
    ev_bind
           ; traceTc "addTcEvBind" $
             vcat [ text "EvBindsVar:" <+> ppr u
                  , text "ev_bind:" <+> ppr ev_bind
                  , text "bnds:" <+> ppr bnds
                  , text "bnds':" <+> ppr bnds' ]
           ; writeTcRef ev_ref bnds' }
    addTcEvBind (CoEvBindsVar { ebv_uniq :: EvBindsVar -> Unique
    ebv_uniq = Unique
    u }) EvBind
    ev_bind
      = FilePath -> SDoc -> TcM ()
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "addTcEvBind CoEvBindsVar" (EvBind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBind
    ev_bind SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unique
    u)

    addTcEvBinds :: EvBindsVar -> EvBindMap -> TcM ()
    -- ^ Add a collection of binding to the TcEvBinds by side effect
    addTcEvBinds :: EvBindsVar -> EvBindMap -> TcM ()
    addTcEvBinds EvBindsVar
    _ EvBindMap
    new_ev_binds
      | EvBindMap -> Bool
    isEmptyEvBindMap EvBindMap
    new_ev_binds
      = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    addTcEvBinds (EvBindsVar { ebv_binds :: EvBindsVar -> TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    ev_ref, ebv_uniq :: EvBindsVar -> Unique
    ebv_uniq = Unique
    u }) EvBindMap
    new_ev_binds
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "addTcEvBinds" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unique
    u SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$
                                      EvBindMap -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindMap
    new_ev_binds
           ; old_bnds <- TcRef EvBindMap -> TcM EvBindMap
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef TcRef EvBindMap
    ev_ref
           ; writeTcRef ev_ref (old_bnds `unionEvBindMap` new_ev_binds) }
    addTcEvBinds (CoEvBindsVar { ebv_uniq :: EvBindsVar -> Unique
    ebv_uniq = Unique
    u }) EvBindMap
    new_ev_binds
      = FilePath -> SDoc -> TcM ()
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "addTcEvBinds CoEvBindsVar" (EvBindMap -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindMap
    new_ev_binds SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unique
    u)

    chooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName
    chooseUniqueOccTc :: (OccSet -> OccName) -> TcM OccName
    chooseUniqueOccTc OccSet -> OccName
    fn =
      do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
         ; let dfun_n_var = TcGblEnv -> IORef OccSet
    tcg_dfun_n TcGblEnv
    env
         ; set <- readTcRef dfun_n_var
         ; let occ = OccSet -> OccName
    fn OccSet
    set
         ; writeTcRef dfun_n_var (extendOccSet set occ)
         ; return occ }

    newZonkAnyType :: Kind -> TcM Type
    -- Return a type (ZonkAny @k n), where n is fresh
    -- Recall  ZonkAny :: forall k. Natural -> k
    -- See Note [Any types] in GHC.Builtin.Types, wrinkle (Any4)
    newZonkAnyType :: Mult -> TcM Mult
    newZonkAnyType Mult
    kind
      = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; let zany_n_var = TcGblEnv -> IORef Integer
    tcg_zany_n TcGblEnv
    env
           ; i <- readTcRef zany_n_var
           ; let !i2 = Integer
    iInteger -> Integer -> Integer
    forall a. Num a => a -> a -> a
    +Integer
    1
           ; writeTcRef zany_n_var i2
           ; return (mkTyConApp zonkAnyTyCon [kind, mkNumLitTy i]) }

    getConstraintVar :: TcM (TcRef WantedConstraints)
    getConstraintVar :: IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (tcl_lie env) }

    setConstraintVar :: TcRef WantedConstraints -> TcM a -> TcM a
    setConstraintVar :: forall a. IORef WantedConstraints -> TcM a -> TcM a
    setConstraintVar IORef WantedConstraints
    lie_var = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\ TcLclEnv
    env -> TcLclEnv
    env { tcl_lie = lie_var })

    emitStaticConstraints :: WantedConstraints -> TcM ()
    emitStaticConstraints :: WantedConstraints -> TcM ()
    emitStaticConstraints WantedConstraints
    static_lie
      = do { gbl_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; updTcRef (tcg_static_wc gbl_env) (`andWC` static_lie) }

    emitConstraints :: WantedConstraints -> TcM ()
    emitConstraints :: WantedConstraints -> TcM ()
    emitConstraints WantedConstraints
    ct
      | WantedConstraints -> Bool
    isEmptyWC WantedConstraints
    ct
      = () -> TcM ()
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      | Bool
    otherwise
      = do { lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar ;
             updTcRef lie_var (`andWC` ct) }

    emitSimple :: Ct -> TcM ()
    emitSimple :: Ct -> TcM ()
    emitSimple Ct
    ct
      = do { lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar ;
             updTcRef lie_var (`addSimples` unitBag ct) }

    emitSimples :: Cts -> TcM ()
    emitSimples :: Bag Ct -> TcM ()
    emitSimples Bag Ct
    cts
      = do { lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar ;
             updTcRef lie_var (`addSimples` cts) }

    emitImplication :: Implication -> TcM ()
    emitImplication :: Implication -> TcM ()
    emitImplication Implication
    ct
      = do { lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar ;
             updTcRef lie_var (`addImplics` unitBag ct) }

    emitImplications :: Bag Implication -> TcM ()
    emitImplications :: Bag Implication -> TcM ()
    emitImplications Bag Implication
    ct
      = Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (Bag Implication -> Bool
    forall a. Bag a -> Bool
    isEmptyBag Bag Implication
    ct) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
        do { lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar ;
             updTcRef lie_var (`addImplics` ct) }

    emitDelayedErrors :: Bag DelayedError -> TcM ()
    emitDelayedErrors :: Bag DelayedError -> TcM ()
    emitDelayedErrors Bag DelayedError
    errs
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "emitDelayedErrors" (Bag DelayedError -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bag DelayedError
    errs)
           ; lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar
           ; updTcRef lie_var (`addDelayedErrors` errs)}

    emitHole :: Hole -> TcM ()
    emitHole :: Hole -> TcM ()
    emitHole Hole
    hole
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "emitHole" (Hole -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Hole
    hole)
           ; lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar
           ; updTcRef lie_var (`addHoles` unitBag hole) }

    emitHoles :: Bag Hole -> TcM ()
    emitHoles :: Bag Hole -> TcM ()
    emitHoles Bag Hole
    holes
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "emitHoles" (Bag Hole -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Bag Hole
    holes)
           ; lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar
           ; updTcRef lie_var (`addHoles` holes) }

    emitNotConcreteError :: NotConcreteError -> TcM ()
    emitNotConcreteError :: NotConcreteError -> TcM ()
    emitNotConcreteError NotConcreteError
    err
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "emitNotConcreteError" (NotConcreteError -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr NotConcreteError
    err)
           ; lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar
           ; updTcRef lie_var (`addNotConcreteError` err) }

    -- See Note [Coercion errors in tcSubMult] in GHC.Tc.Utils.Unify.
    ensureReflMultiplicityCo :: TcCoercion -> CtOrigin -> TcM ()
    ensureReflMultiplicityCo :: TcCoercion -> CtOrigin -> TcM ()
    ensureReflMultiplicityCo TcCoercion
    mult_co CtOrigin
    origin
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "ensureReflMultiplicityCo" (TcCoercion -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcCoercion
    mult_co)
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless (TcCoercion -> Bool
    isReflCo TcCoercion
    mult_co) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ do
               { loc <- CtOrigin -> Maybe TypeOrKind -> TcM CtLoc
    getCtLocM CtOrigin
    origin Maybe TypeOrKind
    forall a. Maybe a
    Nothing
               ; lie_var <- getConstraintVar
               ; updTcRef lie_var (\WantedConstraints
    w -> WantedConstraints -> TcCoercion -> CtLoc -> WantedConstraints
    addMultiplicityCoercionError WantedConstraints
    w TcCoercion
    mult_co CtLoc
    loc) } }

    -- | Throw out any constraints emitted by the thing_inside
    discardConstraints :: TcM a -> TcM a
    discardConstraints :: forall a. TcM a -> TcM a
    discardConstraints TcM a
    thing_inside = (a, WantedConstraints) -> a
    forall a b. (a, b) -> a
    fst ((a, WantedConstraints) -> a)
    -> IOEnv (Env TcGblEnv TcLclEnv) (a, WantedConstraints) -> TcM a
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TcM a -> IOEnv (Env TcGblEnv TcLclEnv) (a, WantedConstraints)
    forall r. TcM r -> TcM (r, WantedConstraints)
    captureConstraints TcM a
    thing_inside

    -- | The name says it all. The returned TcLevel is the *inner* TcLevel.
    pushLevelAndCaptureConstraints :: TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints :: forall a. TcM a -> TcM (TcLevel, WantedConstraints, a)
    pushLevelAndCaptureConstraints TcM a
    thing_inside
      = do { tclvl <- TcM TcLevel
    getTcLevel
           ; let tclvl' = TcLevel -> TcLevel
    pushTcLevel TcLevel
    tclvl
           ; traceTc "pushLevelAndCaptureConstraints {" (ppr tclvl')
           ; (res, lie) <- updLclEnv (setLclEnvTcLevel tclvl') $
                           captureConstraints thing_inside
           ; traceTc "pushLevelAndCaptureConstraints }" (ppr tclvl')
           ; return (tclvl', lie, res) }

    pushTcLevelM_ :: TcM a -> TcM a
    pushTcLevelM_ :: forall a. TcM a -> TcM a
    pushTcLevelM_ = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv ((TcLevel -> TcLevel) -> TcLclEnv -> TcLclEnv
    modifyLclEnvTcLevel TcLevel -> TcLevel
    pushTcLevel)

    pushTcLevelM :: TcM a -> TcM (TcLevel, a)
    -- See Note [TcLevel assignment] in GHC.Tc.Utils.TcType
    pushTcLevelM :: forall a. TcM a -> TcM (TcLevel, a)
    pushTcLevelM TcM a
    thing_inside
      = do { tclvl <- TcM TcLevel
    getTcLevel
           ; let tclvl' = TcLevel -> TcLevel
    pushTcLevel TcLevel
    tclvl
           ; res <- updLclEnv (setLclEnvTcLevel tclvl') thing_inside
           ; return (tclvl', res) }

    getTcLevel :: TcM TcLevel
    getTcLevel :: TcM TcLevel
    getTcLevel = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
                    ; return $! getLclEnvTcLevel env }

    setTcLevel :: TcLevel -> TcM a -> TcM a
    setTcLevel :: forall a. TcLevel -> TcM a -> TcM a
    setTcLevel TcLevel
    tclvl TcM a
    thing_inside
      = (TcLclEnv -> TcLclEnv) -> TcM a -> TcM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (TcLevel -> TcLclEnv -> TcLclEnv
    setLclEnvTcLevel TcLevel
    tclvl) TcM a
    thing_inside

    isTouchableTcM :: TcTyVar -> TcM Bool
    isTouchableTcM :: Id -> TcRn Bool
    isTouchableTcM Id
    tv
      = do { lvl <- TcM TcLevel
    getTcLevel
           ; return (isTouchableMetaTyVar lvl tv) }

    getLclTypeEnv :: TcM TcTypeEnv
    getLclTypeEnv :: TcM TcTypeEnv
    getLclTypeEnv = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (getLclEnvTypeEnv env) }

    setLclTypeEnv :: TcLclEnv -> TcM a -> TcM a
    -- Set the local type envt, but do *not* disturb other fields,
    -- notably the lie_var
    setLclTypeEnv :: forall a. TcLclEnv -> TcM a -> TcM a
    setLclTypeEnv TcLclEnv
    lcl_env TcM a
    thing_inside
      = (TcLclEnv -> TcLclEnv) -> TcM a -> TcM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (TcTypeEnv -> TcLclEnv -> TcLclEnv
    setLclEnvTypeEnv (TcLclEnv -> TcTypeEnv
    getLclEnvTypeEnv TcLclEnv
    lcl_env)) TcM a
    thing_inside

    traceTcConstraints :: String -> TcM ()
    traceTcConstraints :: FilePath -> TcM ()
    traceTcConstraints FilePath
    msg
      = do { lie_var <- IOEnv (Env TcGblEnv TcLclEnv) (IORef WantedConstraints)
    getConstraintVar
           ; lie     <- readTcRef lie_var
           ; traceOptTcRn Opt_D_dump_tc_trace $
             hang (text (msg ++ ": LIE:")) 2 (ppr lie)
           }

    data IsExtraConstraint = YesExtraConstraint
                           | NoExtraConstraint

    instance Outputable IsExtraConstraint where
      ppr :: IsExtraConstraint -> SDoc
    ppr IsExtraConstraint
    YesExtraConstraint = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "YesExtraConstraint"
      ppr IsExtraConstraint
    NoExtraConstraint  = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "NoExtraConstraint"

    emitAnonTypeHole :: IsExtraConstraint
                     -> TcTyVar -> TcM ()
    emitAnonTypeHole :: IsExtraConstraint -> Id -> TcM ()
    emitAnonTypeHole IsExtraConstraint
    extra_constraints Id
    tv
      = do { ct_loc <- CtOrigin -> Maybe TypeOrKind -> TcM CtLoc
    getCtLocM (OccName -> CtOrigin
    TypeHoleOrigin OccName
    occ) Maybe TypeOrKind
    forall a. Maybe a
    Nothing
           ; let hole = Hole { hole_sort :: HoleSort
    hole_sort = HoleSort
    sort
                             , hole_occ :: RdrName
    hole_occ  = OccName -> RdrName
    mkRdrUnqual OccName
    occ
                             , hole_ty :: Mult
    hole_ty   = Id -> Mult
    mkTyVarTy Id
    tv
                             , hole_loc :: CtLoc
    hole_loc  = CtLoc
    ct_loc }
           ; emitHole hole }
      where
        occ :: OccName
    occ = FastString -> OccName
    mkTyVarOccFS (FilePath -> FastString
    fsLit FilePath
    "_")
        sort :: HoleSort
    sort | IsExtraConstraint
    YesExtraConstraint <- IsExtraConstraint
    extra_constraints = HoleSort
    ConstraintHole
             | Bool
    otherwise                               = HoleSort
    TypeHole

    emitNamedTypeHole :: (Name, TcTyVar) -> TcM ()
    emitNamedTypeHole :: (Name, Id) -> TcM ()
    emitNamedTypeHole (Name
    name, Id
    tv)
      = do { ct_loc <- SrcSpan -> TcM CtLoc -> TcM CtLoc
    forall a. SrcSpan -> TcRn a -> TcRn a
    setSrcSpan (Name -> SrcSpan
    nameSrcSpan Name
    name) (TcM CtLoc -> TcM CtLoc) -> TcM CtLoc -> TcM CtLoc
    forall a b. (a -> b) -> a -> b
    $
                       CtOrigin -> Maybe TypeOrKind -> TcM CtLoc
    getCtLocM (OccName -> CtOrigin
    TypeHoleOrigin OccName
    occ) Maybe TypeOrKind
    forall a. Maybe a
    Nothing
           ; let hole = Hole { hole_sort :: HoleSort
    hole_sort = HoleSort
    TypeHole
                             , hole_occ :: RdrName
    hole_occ  = Name -> RdrName
    nameRdrName Name
    name
                             , hole_ty :: Mult
    hole_ty   = Id -> Mult
    mkTyVarTy Id
    tv
                             , hole_loc :: CtLoc
    hole_loc  = CtLoc
    ct_loc }
           ; emitHole hole }
      where
        occ :: OccName
    occ       = Name -> OccName
    nameOccName Name
    name

    {- Note [Constraints and errors]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    Consider this (#12124):

      foo :: Maybe Int
      foo = return (case Left 3 of
                      Left -> 1  -- Hard error here!
                      _    -> 0)

    The call to 'return' will generate a (Monad m) wanted constraint; but
    then there'll be "hard error" (i.e. an exception in the TcM monad), from
    the unsaturated Left constructor pattern.

    We'll recover in tcPolyBinds, using recoverM.  But then the final
    tcSimplifyTop will see that (Monad m) constraint, with 'm' utterly
    un-filled-in, and will emit a misleading error message.

    The underlying problem is that an exception interrupts the constraint
    gathering process. Bottom line: if we have an exception, it's best
    simply to discard any gathered constraints.  Hence in 'attemptM' we
    capture the constraints in a fresh variable, and only emit them into
    the surrounding context if we exit normally.  If an exception is
    raised, simply discard the collected constraints... we have a hard
    error to report.  So this capture-the-emit dance isn't as stupid as it
    looks :-).

    However suppose we throw an exception inside an invocation of
    captureConstraints, and discard all the constraints. Some of those
    constraints might be "variable out of scope" Hole constraints, and that
    might have been the actual original cause of the exception!  For
    example (#12529):
       f = p @ Int
    Here 'p' is out of scope, so we get an insoluble Hole constraint. But
    the visible type application fails in the monad (throws an exception).
    We must not discard the out-of-scope error.

    It's distressingly delicate though:

    * If we discard too /many/ constraints we may fail to report the error
      that led us to interrupt the constraint gathering process.

      One particular example "variable out of scope" Hole constraints. For
      example (#12529):
       f = p @ Int
      Here 'p' is out of scope, so we get an insoluble Hole constraint. But
      the visible type application fails in the monad (throws an exception).
      We must not discard the out-of-scope error.

      Also GHC.Tc.Solver.simplifyAndEmitFlatConstraints may fail having
      emitted some constraints with skolem-escape problems.

    * If we discard too /few/ constraints, we may get the misleading
      class constraints mentioned above.

      We may /also/ end up taking constraints built at some inner level, and
      emitting them (via the exception catching in `tryCaptureConstraints` at some
      outer level, and then breaking the TcLevel invariants See Note [TcLevel
      invariants] in GHC.Tc.Utils.TcType

    So `dropMisleading` has a horridly ad-hoc structure:

    * It keeps only /insoluble/ flat constraints (which are unlikely to very visibly
      trip up on the TcLevel invariant

    * But it keeps all /implication/ constraints (except the class constraints
      inside them).  The implication constraints are OK because they set the ambient
      level before attempting to solve any inner constraints.

    Ugh! I hate this. But it seems to work.

    Other wrinkles

    (CERR1) Note that freshly-generated constraints like (Int ~ Bool), or
        ((a -> b) ~ Int) are all CNonCanonical, and hence won't be flagged as
        insoluble.  The constraint solver does that.  So they'll be discarded.
        That's probably ok; but see th/5358 as a not-so-good example:
           t1 :: Int
           t1 x = x   -- Manifestly wrong

           foo = $(...raises exception...)
        We report the exception, but not the bug in t1.  Oh well.  Possible
        solution: make GHC.Tc.Utils.Unify.uType spot manifestly-insoluble constraints.

    (CERR2) In #26015 I found that from the constraints
               [W] alpha ~ Int      -- A class constraint
               [W] F alpha ~# Bool  -- An equality constraint
      we were dropping the first (becuase it's a class constraint) but not the
      second, and then getting a misleading error message from the second.  As
      #25607 shows, we can get not just one but a zillion bogus messages, which
      conceal the one genuine error.  Boo.

      For now I have added an even more ad-hoc "drop class constraints except
      equality classes (~) and (~~)"; see `dropMisleading`.  That just kicks the can
      down the road; but this problem seems somewhat rare anyway.  The code in
      `dropMisleading` hasn't changed for years.

    It would be great to have a more systematic solution to this entire mess.

    ************************************************************************
    *                                                                      *
                 Template Haskell context
    *                                                                      *
    ************************************************************************
    -}

    recordThUse :: TcM ()
    recordThUse :: TcM ()
    recordThUse = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; writeTcRef (tcg_th_used env) True }

    recordThNeededRuntimeDeps :: [Linkable] -> PkgsLoaded -> TcM ()
    recordThNeededRuntimeDeps :: [Linkable] -> UniqDFM UnitId LoadedPkgInfo -> TcM ()
    recordThNeededRuntimeDeps [Linkable]
    new_links UniqDFM UnitId LoadedPkgInfo
    new_pkgs
      = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; updTcRef (tcg_th_needed_deps env) $ \([Linkable]
    needed_links, UniqDFM UnitId LoadedPkgInfo
    needed_pkgs) ->
               let links :: [Linkable]
    links = [Linkable]
    new_links [Linkable] -> [Linkable] -> [Linkable]
    forall a. [a] -> [a] -> [a]
    ++ [Linkable]
    needed_links
                   !pkgs :: UniqDFM UnitId LoadedPkgInfo
    pkgs = UniqDFM UnitId LoadedPkgInfo
    -> UniqDFM UnitId LoadedPkgInfo -> UniqDFM UnitId LoadedPkgInfo
    forall {k} (key :: k) elt.
    UniqDFM key elt -> UniqDFM key elt -> UniqDFM key elt
    plusUDFM UniqDFM UnitId LoadedPkgInfo
    needed_pkgs UniqDFM UnitId LoadedPkgInfo
    new_pkgs
                   in ([Linkable]
    links, UniqDFM UnitId LoadedPkgInfo
    pkgs)
           }

    keepAlive :: Name -> TcRn ()     -- Record the name in the keep-alive set
    keepAlive :: Name -> TcM ()
    keepAlive Name
    name
      = do { env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; traceRn "keep alive" (ppr name)
           ; updTcRef (tcg_keep env) (`extendNameSet` name) }

    getThLevel :: TcM ThLevel
    getThLevel :: TcM ThLevel
    getThLevel = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (getLclEnvThLevel env) }

    getCurrentAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Set.Set ThLevelIndex, ThLevel))
    getCurrentAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Set ThLevelIndex, ThLevel))
    getCurrentAndBindLevel Name
    name
      = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv;
           ; case lookupNameEnv (getLclEnvThBndrs env) name of
               Maybe (TopLevelFlag, ThLevelIndex)
    Nothing                  -> do
                  lvls <- Name -> TcRn (Set ThLevelIndex)
    getExternalBindLvl Name
    name
                  if Set.empty == lvls
                    -- This case happens when code is generated for identifiers which are not
                    -- in scope.
                    --
                    -- TODO: What happens if someone generates [|| GHC.Magic.dataToTag# ||]
                    then do
                      return Nothing
                    else return (Just (TopLevel, lvls, getLclEnvThLevel env))
               Just (TopLevelFlag
    top_lvl, ThLevelIndex
    bind_lvl) -> Maybe (TopLevelFlag, Set ThLevelIndex, ThLevel)
    -> TcRn (Maybe (TopLevelFlag, Set ThLevelIndex, ThLevel))
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((TopLevelFlag, Set ThLevelIndex, ThLevel)
    -> Maybe (TopLevelFlag, Set ThLevelIndex, ThLevel)
    forall a. a -> Maybe a
    Just (TopLevelFlag
    top_lvl, ThLevelIndex -> Set ThLevelIndex
    forall a. a -> Set a
    Set.singleton ThLevelIndex
    bind_lvl, TcLclEnv -> ThLevel
    getLclEnvThLevel TcLclEnv
    env)) }

    getExternalBindLvl :: Name -> TcRn (Set.Set ThLevelIndex)
    getExternalBindLvl :: Name -> TcRn (Set ThLevelIndex)
    getExternalBindLvl Name
    name = do
      env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
      mod <- getModule
      case lookupGRE_Name env name of
        Just GlobalRdrElt
    gre -> Set ThLevelIndex -> TcRn (Set ThLevelIndex)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Set ThLevelIndex -> TcRn (Set ThLevelIndex))
    -> Set ThLevelIndex -> TcRn (Set ThLevelIndex)
    forall a b. (a -> b) -> a -> b
    $ ((ImportLevel -> ThLevelIndex)
    -> Set ImportLevel -> Set ThLevelIndex
    forall b a. Ord b => (a -> b) -> Set a -> Set b
    Set.map ImportLevel -> ThLevelIndex
    thLevelIndexFromImportLevel (GlobalRdrElt -> Set ImportLevel
    forall info. GlobalRdrEltX info -> Set ImportLevel
    greLevels GlobalRdrElt
    gre))
        Maybe GlobalRdrElt
    Nothing ->
          if Module -> Name -> Bool
    nameIsLocalOrFrom Module
    mod Name
    name
            then Set ThLevelIndex -> TcRn (Set ThLevelIndex)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Set ThLevelIndex -> TcRn (Set ThLevelIndex))
    -> Set ThLevelIndex -> TcRn (Set ThLevelIndex)
    forall a b. (a -> b) -> a -> b
    $ ThLevelIndex -> Set ThLevelIndex
    forall a. a -> Set a
    Set.singleton ThLevelIndex
    topLevelIndex
            else Set ThLevelIndex -> TcRn (Set ThLevelIndex)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Set ThLevelIndex
    forall a. Set a
    Set.empty

    setThLevel :: ThLevel -> TcM a -> TcRn a
    setThLevel :: forall a. ThLevel -> TcM a -> TcM a
    setThLevel ThLevel
    l = (TcLclEnv -> TcLclEnv)
    -> TcRnIf TcGblEnv TcLclEnv a -> TcRnIf TcGblEnv TcLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (ThLevel -> TcLclEnv -> TcLclEnv
    setLclEnvThLevel ThLevel
    l)

    -- | Adds the given modFinalizers to the global environment and set them to use
    -- the current local environment.
    addModFinalizersWithLclEnv :: ThModFinalizers -> TcM ()
    addModFinalizersWithLclEnv :: ThModFinalizers -> TcM ()
    addModFinalizersWithLclEnv ThModFinalizers
    mod_finalizers
      = do lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv
           updTcRef th_modfinalizers_var $ \[(TcLclEnv, ThModFinalizers)]
    fins ->
             (TcLclEnv
    lcl_env, ThModFinalizers
    mod_finalizers) (TcLclEnv, ThModFinalizers)
    -> [(TcLclEnv, ThModFinalizers)] -> [(TcLclEnv, ThModFinalizers)]
    forall a. a -> [a] -> [a]
    : [(TcLclEnv, ThModFinalizers)]
    fins

    {-
    ************************************************************************
    *                                                                      *
                 Safe Haskell context
    *                                                                      *
    ************************************************************************
    -}

    -- | Mark that safe inference has failed
    -- See Note [Safe Haskell Overlapping Instances Implementation]
    -- although this is used for more than just that failure case.
    recordUnsafeInfer :: Messages TcRnMessage -> TcM ()
    recordUnsafeInfer :: Messages TcRnMessage -> TcM ()
    recordUnsafeInfer Messages TcRnMessage
    msgs =
        TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv TcRnIf TcGblEnv TcLclEnv TcGblEnv -> (TcGblEnv -> TcM ()) -> TcM ()
    forall a b.
    IOEnv (Env TcGblEnv TcLclEnv) a
    -> (a -> IOEnv (Env TcGblEnv TcLclEnv) b)
    -> IOEnv (Env TcGblEnv TcLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \TcGblEnv
    env -> do IORef Bool -> Bool -> TcM ()
    forall (m :: * -> *) a. MonadIO m => TcRef a -> a -> m ()
    writeTcRef (TcGblEnv -> IORef Bool
    tcg_safe_infer TcGblEnv
    env) Bool
    False
                                 IORef (Messages TcRnMessage) -> Messages TcRnMessage -> TcM ()
    forall (m :: * -> *) a. MonadIO m => TcRef a -> a -> m ()
    writeTcRef (TcGblEnv -> IORef (Messages TcRnMessage)
    tcg_safe_infer_reasons TcGblEnv
    env) Messages TcRnMessage
    msgs

    -- | Figure out the final correct safe haskell mode
    finalSafeMode :: DynFlags -> TcGblEnv -> IO SafeHaskellMode
    finalSafeMode :: DynFlags -> TcGblEnv -> IO SafeHaskellMode
    finalSafeMode DynFlags
    dflags TcGblEnv
    tcg_env = do
        safeInf <- IORef Bool -> IO Bool
    forall a. IORef a -> IO a
    readIORef (TcGblEnv -> IORef Bool
    tcg_safe_infer TcGblEnv
    tcg_env)
        return $ case safeHaskell dflags of
            SafeHaskellMode
    Sf_None | DynFlags -> Bool
    safeInferOn DynFlags
    dflags Bool -> Bool -> Bool
    && Bool
    safeInf -> SafeHaskellMode
    Sf_SafeInferred
                    | Bool
    otherwise                     -> SafeHaskellMode
    Sf_None
            SafeHaskellMode
    s -> SafeHaskellMode
    s

    -- | Switch instances to safe instances if we're in Safe mode.
    fixSafeInstances :: SafeHaskellMode -> [ClsInst] -> [ClsInst]
    fixSafeInstances :: SafeHaskellMode -> [ClsInst] -> [ClsInst]
    fixSafeInstances SafeHaskellMode
    sfMode | SafeHaskellMode
    sfMode SafeHaskellMode -> SafeHaskellMode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= SafeHaskellMode
    Sf_Safe Bool -> Bool -> Bool
    && SafeHaskellMode
    sfMode SafeHaskellMode -> SafeHaskellMode -> Bool
    forall a. Eq a => a -> a -> Bool
    /= SafeHaskellMode
    Sf_SafeInferred = [ClsInst] -> [ClsInst]
    forall a. a -> a
    id
    fixSafeInstances SafeHaskellMode
    _ = (ClsInst -> ClsInst) -> [ClsInst] -> [ClsInst]
    forall a b. (a -> b) -> [a] -> [b]
    map ClsInst -> ClsInst
    fixSafe
      where fixSafe :: ClsInst -> ClsInst
    fixSafe ClsInst
    inst = let new_flag :: OverlapFlag
    new_flag = (ClsInst -> OverlapFlag
    is_flag ClsInst
    inst) { isSafeOverlap = True }
                           in ClsInst
    inst { is_flag = new_flag }

    {-
    ************************************************************************
    *                                                                      *
                 Stuff for the renamer's local env
    *                                                                      *
    ************************************************************************
    -}

    getLocalRdrEnv :: RnM LocalRdrEnv
    getLocalRdrEnv :: RnM LocalRdrEnv
    getLocalRdrEnv = do { env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (getLclEnvRdrEnv env) }

    setLocalRdrEnv :: LocalRdrEnv -> RnM a -> RnM a
    setLocalRdrEnv :: forall a. LocalRdrEnv -> RnM a -> RnM a
    setLocalRdrEnv LocalRdrEnv
    rdr_env RnM a
    thing_inside
      = (TcLclEnv -> TcLclEnv) -> RnM a -> RnM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (LocalRdrEnv -> TcLclEnv -> TcLclEnv
    setLclEnvRdrEnv LocalRdrEnv
    rdr_env) RnM a
    thing_inside

    {-
    ************************************************************************
    *                                                                      *
                 Stuff for interface decls
    *                                                                      *
    ************************************************************************
    -}

    mkIfLclEnv :: Module -> SDoc -> IsBootInterface -> IfLclEnv
    mkIfLclEnv :: Module -> SDoc -> IsBootInterface -> IfLclEnv
    mkIfLclEnv Module
    mod SDoc
    loc IsBootInterface
    boot
                       = IfLclEnv { if_mod :: Module
    if_mod     = Module
    mod,
                                    if_loc :: SDoc
    if_loc     = SDoc
    loc,
                                    if_boot :: IsBootInterface
    if_boot    = IsBootInterface
    boot,
                                    if_nsubst :: Maybe NameShape
    if_nsubst  = Maybe NameShape
    forall a. Maybe a
    Nothing,
                                    if_implicits_env :: Maybe TypeEnv
    if_implicits_env = Maybe TypeEnv
    forall a. Maybe a
    Nothing,
                                    if_tv_env :: FastStringEnv Id
    if_tv_env  = FastStringEnv Id
    forall a. FastStringEnv a
    emptyFsEnv,
                                    if_id_env :: FastStringEnv Id
    if_id_env  = FastStringEnv Id
    forall a. FastStringEnv a
    emptyFsEnv }

    -- | Run an 'IfG' (top-level interface monad) computation inside an existing
    -- 'TcRn' (typecheck-renaming monad) computation by initializing an 'IfGblEnv'
    -- based on 'TcGblEnv'.
    initIfaceTcRn :: IfG a -> TcRn a
    initIfaceTcRn :: forall a. IfG a -> TcRn a
    initIfaceTcRn IfG a
    thing_inside
      = do  { tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; hsc_env <- getTopEnv
              -- bangs to avoid leaking the envs (#19356)
            ; let !mhome_unit = HscEnv -> Maybe HomeUnit
    hsc_home_unit_maybe HscEnv
    hsc_env
                  !knot_vars = TcGblEnv -> KnotVars (IORef TypeEnv)
    tcg_type_env_var TcGblEnv
    tcg_env
                  -- When we are instantiating a signature, we DEFINITELY
                  -- do not want to knot tie.
                  is_instantiate = Bool -> Maybe Bool -> Bool
    forall a. a -> Maybe a -> a
    fromMaybe Bool
    False (HomeUnit -> Bool
    forall u. GenHomeUnit u -> Bool
    isHomeUnitInstantiating (HomeUnit -> Bool) -> Maybe HomeUnit -> Maybe Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe HomeUnit
    mhome_unit)
            ; let { if_env = IfGblEnv {
                                if_doc :: SDoc
    if_doc = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "initIfaceTcRn",
                                if_rec_types :: KnotVars (IfG TypeEnv)
    if_rec_types =
                                    if Bool
    is_instantiate
                                        then KnotVars (IfG TypeEnv)
    forall a. KnotVars a
    emptyKnotVars
                                        else IORef TypeEnv -> IfG TypeEnv
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef (IORef TypeEnv -> IfG TypeEnv)
    -> KnotVars (IORef TypeEnv) -> KnotVars (IfG TypeEnv)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> KnotVars (IORef TypeEnv)
    knot_vars
                                }
                             }
            ; setEnvs (if_env, ()) thing_inside }

    -- | 'initIfaceLoad' can be used when there's no chance that the action will
    -- call 'typecheckIface' when inside a module loop and hence 'tcIfaceGlobal'.
    initIfaceLoad :: HscEnv -> IfG a -> IO a
    initIfaceLoad :: forall a. HscEnv -> IfG a -> IO a
    initIfaceLoad HscEnv
    hsc_env IfG a
    do_this
     = do let gbl_env :: IfGblEnv
    gbl_env = IfGblEnv {
                            if_doc :: SDoc
    if_doc = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "initIfaceLoad",
                            if_rec_types :: KnotVars (IfG TypeEnv)
    if_rec_types = KnotVars (IfG TypeEnv)
    forall a. KnotVars a
    emptyKnotVars
                        }
          Char -> HscEnv -> IfGblEnv -> () -> IfG a -> IO a
    forall gbl lcl a.
    Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
    initTcRnIf Char
    'i' (HscEnv
    hsc_env { hsc_type_env_vars = emptyKnotVars }) IfGblEnv
    gbl_env () IfG a
    do_this

    -- | This is used when we are doing to call 'typecheckModule' on an 'ModIface',
    -- if it's part of a loop with some other modules then we need to use their
    -- IORef TypeEnv vars when typechecking but crucially not our own.
    initIfaceLoadModule :: HscEnv -> Module -> IfG a -> IO a
    initIfaceLoadModule :: forall a. HscEnv -> Module -> IfG a -> IO a
    initIfaceLoadModule HscEnv
    hsc_env Module
    this_mod IfG a
    do_this
     = do let gbl_env :: IfGblEnv
    gbl_env = IfGblEnv {
                            if_doc :: SDoc
    if_doc = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "initIfaceLoadModule",
                            if_rec_types :: KnotVars (IfG TypeEnv)
    if_rec_types = IORef TypeEnv -> IfG TypeEnv
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef (IORef TypeEnv -> IfG TypeEnv)
    -> KnotVars (IORef TypeEnv) -> KnotVars (IfG TypeEnv)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Module -> KnotVars (IORef TypeEnv) -> KnotVars (IORef TypeEnv)
    forall a. Module -> KnotVars a -> KnotVars a
    knotVarsWithout Module
    this_mod (HscEnv -> KnotVars (IORef TypeEnv)
    hsc_type_env_vars HscEnv
    hsc_env)
                        }
          Char -> HscEnv -> IfGblEnv -> () -> IfG a -> IO a
    forall gbl lcl a.
    Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
    initTcRnIf Char
    'i' HscEnv
    hsc_env IfGblEnv
    gbl_env () IfG a
    do_this

    initIfaceCheck :: SDoc -> HscEnv -> IfG a -> IO a
    -- Used when checking the up-to-date-ness of the old Iface
    -- Initialise the environment with no useful info at all
    initIfaceCheck :: forall a. SDoc -> HscEnv -> IfG a -> IO a
    initIfaceCheck SDoc
    doc HscEnv
    hsc_env IfG a
    do_this
     = do let gbl_env :: IfGblEnv
    gbl_env = IfGblEnv {
                            if_doc :: SDoc
    if_doc = FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "initIfaceCheck" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc,
                            if_rec_types :: KnotVars (IfG TypeEnv)
    if_rec_types = IORef TypeEnv -> IfG TypeEnv
    forall (m :: * -> *) a. MonadIO m => TcRef a -> m a
    readTcRef (IORef TypeEnv -> IfG TypeEnv)
    -> KnotVars (IORef TypeEnv) -> KnotVars (IfG TypeEnv)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> HscEnv -> KnotVars (IORef TypeEnv)
    hsc_type_env_vars HscEnv
    hsc_env
                        }
          Char -> HscEnv -> IfGblEnv -> () -> IfG a -> IO a
    forall gbl lcl a.
    Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
    initTcRnIf Char
    'i' HscEnv
    hsc_env IfGblEnv
    gbl_env () IfG a
    do_this

    initIfaceLcl :: Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
    initIfaceLcl :: forall a lcl.
    Module -> SDoc -> IsBootInterface -> IfL a -> IfM lcl a
    initIfaceLcl Module
    mod SDoc
    loc_doc IsBootInterface
    hi_boot_file IfL a
    thing_inside
      = IfLclEnv -> IfL a -> TcRnIf IfGblEnv lcl a
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv (Module -> SDoc -> IsBootInterface -> IfLclEnv
    mkIfLclEnv Module
    mod SDoc
    loc_doc IsBootInterface
    hi_boot_file) IfL a
    thing_inside

    -- | Initialize interface typechecking, but with a 'NameShape'
    -- to apply when typechecking top-level 'OccName's (see
    -- 'lookupIfaceTop')
    initIfaceLclWithSubst :: Module -> SDoc -> IsBootInterface -> NameShape -> IfL a -> IfM lcl a
    initIfaceLclWithSubst :: forall a lcl.
    Module
    -> SDoc -> IsBootInterface -> NameShape -> IfL a -> IfM lcl a
    initIfaceLclWithSubst Module
    mod SDoc
    loc_doc IsBootInterface
    hi_boot_file NameShape
    nsubst IfL a
    thing_inside
      = IfLclEnv -> IfL a -> TcRnIf IfGblEnv lcl a
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv ((Module -> SDoc -> IsBootInterface -> IfLclEnv
    mkIfLclEnv Module
    mod SDoc
    loc_doc IsBootInterface
    hi_boot_file) { if_nsubst = Just nsubst }) IfL a
    thing_inside

    getIfModule :: IfL Module
    getIfModule :: IfL Module
    getIfModule = do { env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (if_mod env) }

    --------------------
    failIfM :: SDoc -> IfL a
    -- The Iface monad doesn't have a place to accumulate errors, so we
    -- just fall over fast if one happens; it "shouldn't happen".
    -- We use IfL here so that we can get context info out of the local env
    failIfM :: forall a. SDoc -> IfL a
    failIfM SDoc
    msg = do
        env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
        let full_msg = (IfLclEnv -> SDoc
    if_loc IfLclEnv
    env SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <> SDoc
    forall doc. IsLine doc => doc
    colon) SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    msg
        logger <- getLogger
        liftIO (logMsg logger MCFatal
                 noSrcSpan $ withPprStyle defaultErrStyle full_msg)
        failM

    --------------------

    -- | Run thing_inside in an interleaved thread.
    -- It shares everything with the parent thread, so this is DANGEROUS.
    --
    -- It throws an error if the computation fails
    --
    -- It's used for lazily type-checking interface
    -- signatures, which is pretty benign.
    --
    -- See Note [Masking exceptions in forkM]
    forkM :: SDoc -> IfL a -> IfL a
    forkM :: forall a. SDoc -> IfL a -> IfL a
    forkM SDoc
    doc IfL a
    thing_inside
     = IfL a -> IfL a
    forall env a. IOEnv env a -> IOEnv env a
    unsafeInterleaveM (IfL a -> IfL a) -> IfL a -> IfL a
    forall a b. (a -> b) -> a -> b
    $ IfL a -> IfL a
    forall env a. IOEnv env a -> IOEnv env a
    uninterruptibleMaskM_ (IfL a -> IfL a) -> IfL a -> IfL a
    forall a b. (a -> b) -> a -> b
    $
        do { SDoc -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall m n. SDoc -> TcRnIf m n ()
    traceIf (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "Starting fork {" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc)
           ; mb_res <- IfL a -> IOEnv (Env IfGblEnv IfLclEnv) (Either IOEnvFailure a)
    forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM (IfL a -> IOEnv (Env IfGblEnv IfLclEnv) (Either IOEnvFailure a))
    -> IfL a -> IOEnv (Env IfGblEnv IfLclEnv) (Either IOEnvFailure a)
    forall a b. (a -> b) -> a -> b
    $
                       (IfLclEnv -> IfLclEnv) -> IfL a -> IfL a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\IfLclEnv
    env -> IfLclEnv
    env { if_loc = if_loc env $$ doc }) (IfL a -> IfL a) -> IfL a -> IfL a
    forall a b. (a -> b) -> a -> b
    $
                       IfL a
    thing_inside
           ; case mb_res of
                Right a
    r  -> do  { SDoc -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall m n. SDoc -> TcRnIf m n ()
    traceIf (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "} ending fork" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc)
                                ; a -> IfL a
    forall a. a -> IOEnv (Env IfGblEnv IfLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    r }
                Left IOEnvFailure
    exn -> do {
                    -- Bleat about errors in the forked thread, if -ddump-if-trace is on
                    -- Otherwise we silently discard errors. Errors can legitimately
                    -- happen when compiling interface signatures.
                      DumpFlag
    -> IOEnv (Env IfGblEnv IfLclEnv) ()
    -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall gbl lcl. DumpFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenDOptM DumpFlag
    Opt_D_dump_if_trace (IOEnv (Env IfGblEnv IfLclEnv) ()
     -> IOEnv (Env IfGblEnv IfLclEnv) ())
    -> IOEnv (Env IfGblEnv IfLclEnv) ()
    -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $ do
                          logger <- IOEnv (Env IfGblEnv IfLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
                          let msg = SDoc -> Int -> SDoc -> SDoc
    hang (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "forkM failed:" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc)
                                       Int
    2 (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text (IOEnvFailure -> FilePath
    forall a. Show a => a -> FilePath
    show IOEnvFailure
    exn))
                          liftIO $ logMsg logger
                                             MCFatal
                                             noSrcSpan
                                             $ withPprStyle defaultErrStyle msg
                    ; SDoc -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall m n. SDoc -> TcRnIf m n ()
    traceIf (FilePath -> SDoc
    forall doc. IsLine doc => FilePath -> doc
    text FilePath
    "} ending fork (badly)" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> SDoc
    doc)
                    ; FilePath -> IfL a
    forall a. HasCallStack => FilePath -> a
    pgmError FilePath
    "Cannot continue after interface file error" }
        }

    setImplicitEnvM :: TypeEnv -> IfL a -> IfL a
    setImplicitEnvM :: forall a. TypeEnv -> IfL a -> IfL a
    setImplicitEnvM TypeEnv
    tenv IfL a
    m = (IfLclEnv -> IfLclEnv) -> IfL a -> IfL a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\IfLclEnv
    lcl -> IfLclEnv
    lcl
                                         { if_implicits_env = Just tenv }) IfL a
    m

    {-
    Note [Masking exceptions in forkM]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~

    When using GHC-as-API it must be possible to interrupt snippets of code
    executed using runStmt (#1381). Since commit 02c4ab04 this is almost possible
    by throwing an asynchronous interrupt to the GHC thread. However, there is a
    subtle problem: runStmt first typechecks the code before running it, and the
    exception might interrupt the type checker rather than the code. Moreover, the
    typechecker might be inside an unsafeInterleaveIO (through forkM), and
    more importantly might be inside an exception handler inside that
    unsafeInterleaveIO. If that is the case, the exception handler will rethrow the
    asynchronous exception as a synchronous exception, and the exception will end
    up as the value of the unsafeInterleaveIO thunk (see #8006 for a detailed
    discussion).  We don't currently know a general solution to this problem, but
    we can use uninterruptibleMask_ to avoid the situation.
    -}

    -- | Get the next cost centre index associated with a given name.
    getCCIndexM :: (gbl -> TcRef CostCentreState) -> FastString -> TcRnIf gbl lcl CostCentreIndex
    getCCIndexM :: forall gbl lcl.
    (gbl -> IORef CostCentreState)
    -> FastString -> TcRnIf gbl lcl CostCentreIndex
    getCCIndexM gbl -> IORef CostCentreState
    get_ccs FastString
    nm = do
      env <- TcRnIf gbl lcl gbl
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
      let cc_st_ref = gbl -> IORef CostCentreState
    get_ccs gbl
    env
      cc_st <- readTcRef cc_st_ref
      let (idx, cc_st') = getCCIndex nm cc_st
      writeTcRef cc_st_ref cc_st'
      return idx

    -- | See 'getCCIndexM'.
    getCCIndexTcM :: FastString -> TcM CostCentreIndex
    getCCIndexTcM :: FastString -> TcM CostCentreIndex
    getCCIndexTcM = (TcGblEnv -> IORef CostCentreState)
    -> FastString -> TcM CostCentreIndex
    forall gbl lcl.
    (gbl -> IORef CostCentreState)
    -> FastString -> TcRnIf gbl lcl CostCentreIndex
    getCCIndexM TcGblEnv -> IORef CostCentreState
    tcg_cc_st

    --------------------------------------------------------------------------------

    -- | Lift a computation from the dedicated zonking monad 'ZonkM' to the
    -- full-fledged 'TcM' monad.
    liftZonkM :: ZonkM a -> TcM a
    liftZonkM :: forall a. ZonkM a -> TcM a
    liftZonkM (ZonkM ZonkGblEnv -> IO a
    f) =
      do { logger       <- IOEnv (Env TcGblEnv TcLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
         ; name_ppr_ctx <- getNamePprCtx
         ; lvl          <- getTcLevel
         ; src_span     <- getSrcSpanM
         ; bndrs        <- getLclEnvBinderStack <$> getLclEnv
         ; let zge = ZonkGblEnv { zge_logger :: Logger
    zge_logger = Logger
    logger
                                , zge_name_ppr_ctx :: NamePprCtx
    zge_name_ppr_ctx = NamePprCtx
    name_ppr_ctx
                                , zge_src_span :: SrcSpan
    zge_src_span = SrcSpan
    src_span
                                , zge_tc_level :: TcLevel
    zge_tc_level = TcLevel
    lvl
                                , zge_binder_stack :: TcBinderStack
    zge_binder_stack = TcBinderStack
    bndrs }
         ; liftIO $ f zge }
    {-# INLINE liftZonkM #-}

    --------------------------------------------------------------------------------

    getCompleteMatchesTcM :: TcM CompleteMatches
    getCompleteMatchesTcM :: TcM CompleteMatches
    getCompleteMatchesTcM
      = do { hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
           ; eps <- liftIO $ hscEPS hsc_env
           ; tcg_env <- getGblEnv
           ; let tcg_comps = TcGblEnv -> CompleteMatches
    tcg_complete_match_env TcGblEnv
    tcg_env
           ; liftIO $ localAndImportedCompleteMatches tcg_comps eps
           }

    localAndImportedCompleteMatches :: CompleteMatches -> ExternalPackageState -> IO CompleteMatches
    localAndImportedCompleteMatches :: CompleteMatches -> ExternalPackageState -> IO CompleteMatches
    localAndImportedCompleteMatches CompleteMatches
    tcg_comps ExternalPackageState
    eps = do
      CompleteMatches -> IO CompleteMatches
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CompleteMatches -> IO CompleteMatches)
    -> CompleteMatches -> IO CompleteMatches
    forall a b. (a -> b) -> a -> b
    $
           CompleteMatches
    tcg_comps                -- from the current modulea and from the home package
        CompleteMatches -> CompleteMatches -> CompleteMatches
    forall a. [a] -> [a] -> [a]
    ++ ExternalPackageState -> CompleteMatches
    eps_complete_matches ExternalPackageState
    eps -- from external packages