    {-# LANGUAGE BangPatterns      #-}
    {-# LANGUAGE CPP               #-}
    {-# LANGUAGE ExplicitForAll    #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE RecordWildCards   #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}
    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    {-
    (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, getGblEnv, updGblEnv,
      setGblEnv, getLclEnv, updLclEnv, setLclEnv,
      getEnvs, setEnvs,
      xoptM, doptM, goptM, woptM,
      setXOptM, unsetXOptM, unsetGOptM, unsetWOptM,
      whenDOptM, whenGOptM, whenWOptM,
      whenXOptM, unlessXOptM,
      getGhcMode,
      withDynamicNow, withoutDynamicNow,
      getEpsVar,
      getEps,
      updateEps, updateEps_,
      getHpt, getEpsAndHpt,

      -- * Arrow scopes
      newArrowScope, escapeArrowScope,

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

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

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

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

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

      -- * Usage environment
      tcCollectingUsage, tcScalingUsage, tcEmitBindingUsage,

      -- * Shared error message stuff: renamer and typechecker
      mkLongErrAt, mkDecoratedSDocAt, addLongErrAt, reportErrors, reportError,
      reportWarning, recoverM, mapAndRecoverM, mapAndReportM, foldAndRecoverM,
      attemptM, tryTc,
      askNoErrs, discardErrs, tryTcDiscardingErrs,
      checkNoErrs, whenNoErrs,
      ifErrsM, failIfErrsM,

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

      -- * Error message generation (type checker)
      addErrTc,
      addErrTcM,
      failWithTc, failWithTcM,
      checkTc, checkTcM,
      failIfTc, failIfTcM,
      warnIfFlag, warnIf, warnTc, warnTcM,
      addWarnTc, addWarnTcM, addWarn, addWarnAt, add_warn,
      mkErrInfo,

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

      -- * Template Haskell context
      recordThUse, recordThSpliceUse,
      keepAlive, getStage, getStageAndBindLevel, setStage,
      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,
      getIfModule,
      failIfM,
      forkM_maybe,
      forkM,
      setImplicitEnvM,

      withException,

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

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

    #include "HsVersions.h"

    import GHC.Prelude

    import GHC.Builtin.Names

    import GHC.Tc.Types     -- Re-export all
    import GHC.Tc.Types.Constraint
    import GHC.Tc.Types.Evidence
    import GHC.Tc.Types.Origin
    import GHC.Tc.Utils.TcType

    import GHC.Hs hiding (LIE)

    import GHC.Unit
    import GHC.Unit.External
    import GHC.Unit.Module.Warnings
    import GHC.Unit.Home.ModInfo

    import GHC.Core.UsageEnv
    import GHC.Core.Multiplicity
    import GHC.Core.InstEnv
    import GHC.Core.FamInstEnv

    import GHC.Driver.Env
    import GHC.Driver.Ppr
    import GHC.Driver.Session

    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.Misc
    import GHC.Utils.Logger

    import GHC.Types.Error
    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.Set
    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.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 {-# SOURCE #-} GHC.Tc.Utils.Env    ( tcInitTidyEnv )

    import qualified Data.Map as Map

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

    -- | Setup the initial typechecking environment
    initTc :: HscEnv
           -> HscSource
           -> Bool          -- True <=> retain renamed syntax trees
           -> Module
           -> RealSrcSpan
           -> TcM r
           -> IO (Messages DecoratedSDoc, 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 DecoratedSDoc, Maybe r)
    initTc HscEnv
    hsc_env HscSource
    hsc_src Bool
    keep_rn_syntax Module
    mod RealSrcSpan
    loc TcM r
    do_this
     = do { IORef NameSet
    keep_var     <- NameSet -> IO (IORef NameSet)
    forall a. a -> IO (IORef a)
    newIORef NameSet
    emptyNameSet ;
            IORef [GlobalRdrElt]
    used_gre_var <- [GlobalRdrElt] -> IO (IORef [GlobalRdrElt])
    forall a. a -> IO (IORef a)
    newIORef [] ;
            IORef Bool
    th_var       <- Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    newIORef Bool
    False ;
            IORef Bool
    th_splice_var<- Bool -> IO (IORef Bool)
    forall a. a -> IO (IORef a)
    newIORef Bool
    False ;
            IORef (Bool, Bag (MsgEnvelope DecoratedSDoc))
    infer_var    <- (Bool, Bag (MsgEnvelope DecoratedSDoc))
    -> IO (IORef (Bool, Bag (MsgEnvelope DecoratedSDoc)))
    forall a. a -> IO (IORef a)
    newIORef (Bool
    True, Bag (MsgEnvelope DecoratedSDoc)
    forall a. Bag a
    emptyBag) ;
            IORef OccSet
    dfun_n_var   <- OccSet -> IO (IORef OccSet)
    forall a. a -> IO (IORef a)
    newIORef OccSet
    emptyOccSet ;
            IORef TypeEnv
    type_env_var <- case HscEnv -> Maybe (Module, IORef TypeEnv)
    hsc_type_env_var HscEnv
    hsc_env of {
                               Just (Module
    _mod, IORef TypeEnv
    te_var) -> IORef TypeEnv -> IO (IORef TypeEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return IORef TypeEnv
    te_var ;
                               Maybe (Module, IORef TypeEnv)
    Nothing             -> TypeEnv -> IO (IORef TypeEnv)
    forall a. a -> IO (IORef a)
    newIORef TypeEnv
    forall a. NameEnv a
    emptyNameEnv } ;

            IORef [FilePath]
    dependent_files_var <- [FilePath] -> IO (IORef [FilePath])
    forall a. a -> IO (IORef a)
    newIORef [] ;
            IORef WantedConstraints
    static_wc_var       <- WantedConstraints -> IO (IORef WantedConstraints)
    forall a. a -> IO (IORef a)
    newIORef WantedConstraints
    emptyWC ;
            IORef CostCentreState
    cc_st_var           <- CostCentreState -> IO (IORef CostCentreState)
    forall a. a -> IO (IORef a)
    newIORef CostCentreState
    newCostCentreState ;
            IORef [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    th_topdecls_var      <- [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    -> IO (IORef [GenLocated SrcSpanAnnA (HsDecl GhcPs)])
    forall a. a -> IO (IORef a)
    newIORef [] ;
            IORef [(ForeignSrcLang, FilePath)]
    th_foreign_files_var <- [(ForeignSrcLang, FilePath)]
    -> IO (IORef [(ForeignSrcLang, FilePath)])
    forall a. a -> IO (IORef a)
    newIORef [] ;
            IORef NameSet
    th_topnames_var      <- NameSet -> IO (IORef NameSet)
    forall a. a -> IO (IORef a)
    newIORef NameSet
    emptyNameSet ;
            IORef [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers_var <- [(TcLclEnv, ThModFinalizers)]
    -> IO (IORef [(TcLclEnv, ThModFinalizers)])
    forall a. a -> IO (IORef a)
    newIORef [] ;
            IORef [FilePath]
    th_coreplugins_var <- [FilePath] -> IO (IORef [FilePath])
    forall a. a -> IO (IORef a)
    newIORef [] ;
            IORef (Map TypeRep Dynamic)
    th_state_var         <- Map TypeRep Dynamic -> IO (IORef (Map TypeRep Dynamic))
    forall a. a -> IO (IORef a)
    newIORef Map TypeRep Dynamic
    forall k a. Map k a
    Map.empty ;
            IORef (Maybe (ForeignRef (IORef QState)))
    th_remote_state_var  <- Maybe (ForeignRef (IORef QState))
    -> IO (IORef (Maybe (ForeignRef (IORef QState))))
    forall a. a -> IO (IORef a)
    newIORef Maybe (ForeignRef (IORef QState))
    forall a. Maybe a
    Nothing ;
            IORef (Map DocLoc FilePath)
    th_docs_var          <- Map DocLoc FilePath -> IO (IORef (Map DocLoc FilePath))
    forall a. a -> IO (IORef a)
    newIORef Map DocLoc FilePath
    forall k a. Map k a
    Map.empty ;
            let {
                 -- bangs to avoid leaking the env (#19356)
                 !dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env ;
                 !home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env ;

                 maybe_rn_syntax :: forall a. a -> Maybe a ;
                 maybe_rn_syntax :: forall a. a -> Maybe a
    maybe_rn_syntax a
    empty_val
                    | DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    Opt_D_dump_rn_ast DynFlags
    dflags = 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
    gbl_env = TcGblEnv {
                    tcg_th_topdecls :: TcRef [LHsDecl GhcPs]
    tcg_th_topdecls      = IORef [GenLocated SrcSpanAnnA (HsDecl GhcPs)]
    TcRef [LHsDecl 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 FilePath)
    tcg_th_docs          = IORef (Map DocLoc FilePath)
    th_docs_var,

                    tcg_mod :: Module
    tcg_mod            = Module
    mod,
                    tcg_semantic_mod :: Module
    tcg_semantic_mod   = HomeUnit -> Module -> Module
    homeModuleInstantiation HomeUnit
    home_unit Module
    mod,
                    tcg_src :: HscSource
    tcg_src            = HscSource
    hsc_src,
                    tcg_rdr_env :: GlobalRdrEnv
    tcg_rdr_env        = GlobalRdrEnv
    emptyGlobalRdrEnv,
                    tcg_fix_env :: FixityEnv
    tcg_fix_env        = FixityEnv
    forall a. NameEnv a
    emptyNameEnv,
                    tcg_field_env :: RecFieldEnv
    tcg_field_env      = RecFieldEnv
    forall a. NameEnv a
    emptyNameEnv,
                    tcg_default :: Maybe [Type]
    tcg_default        = if Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod Unit -> Unit -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unit
    primUnit
                                         Bool -> Bool -> Bool
    || Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod Unit -> Unit -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unit
    bignumUnit
                                         then [Type] -> Maybe [Type]
    forall a. a -> Maybe a
    Just []  -- See Note [Default types]
                                         else Maybe [Type]
    forall a. Maybe a
    Nothing,
                    tcg_type_env :: TypeEnv
    tcg_type_env       = TypeEnv
    forall a. NameEnv a
    emptyNameEnv,
                    tcg_type_env_var :: IORef TypeEnv
    tcg_type_env_var   = 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_th_used :: IORef Bool
    tcg_th_used        = IORef Bool
    th_var,
                    tcg_th_splice_used :: IORef Bool
    tcg_th_splice_used = IORef Bool
    th_splice_var,
                    tcg_exports :: [AvailInfo]
    tcg_exports        = [],
                    tcg_imports :: ImportAvails
    tcg_imports        = ImportAvails
    emptyImportAvails,
                    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
    tcg_warns          = Warnings
    NoWarnings,
                    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_keep :: IORef NameSet
    tcg_keep           = IORef NameSet
    keep_var,
                    tcg_doc_hdr :: Maybe LHsDocString
    tcg_doc_hdr        = Maybe LHsDocString
    forall a. Maybe a
    Nothing,
                    tcg_hpc :: Bool
    tcg_hpc            = Bool
    False,
                    tcg_main :: Maybe Name
    tcg_main           = Maybe Name
    forall a. Maybe a
    Nothing,
                    tcg_self_boot :: SelfBootInfo
    tcg_self_boot      = SelfBootInfo
    NoSelfBoot,
                    tcg_safeInfer :: IORef (Bool, Bag (MsgEnvelope DecoratedSDoc))
    tcg_safeInfer      = IORef (Bool, Bag (MsgEnvelope DecoratedSDoc))
    infer_var,
                    tcg_dependent_files :: IORef [FilePath]
    tcg_dependent_files = IORef [FilePath]
    dependent_files_var,
                    tcg_tc_plugins :: [TcPluginSolver]
    tcg_tc_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
                 } ;
            } ;

            -- OK, here's the business end!
            HscEnv
    -> TcGblEnv
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages DecoratedSDoc, Maybe r)
    forall r.
    HscEnv
    -> TcGblEnv
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages DecoratedSDoc, Maybe r)
    initTcWithGbl HscEnv
    hsc_env TcGblEnv
    gbl_env RealSrcSpan
    loc TcM r
    do_this
        }

    -- | Run a 'TcM' action in the context of an existing 'GblEnv'.
    initTcWithGbl :: HscEnv
                  -> TcGblEnv
                  -> RealSrcSpan
                  -> TcM r
                  -> IO (Messages DecoratedSDoc, Maybe r)
    initTcWithGbl :: forall r.
    HscEnv
    -> TcGblEnv
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages DecoratedSDoc, Maybe r)
    initTcWithGbl HscEnv
    hsc_env TcGblEnv
    gbl_env RealSrcSpan
    loc TcM r
    do_this
     = do { IORef WantedConstraints
    lie_var      <- WantedConstraints -> IO (IORef WantedConstraints)
    forall a. a -> IO (IORef a)
    newIORef WantedConstraints
    emptyWC
          ; IORef (Messages DecoratedSDoc)
    errs_var     <- Messages DecoratedSDoc -> IO (IORef (Messages DecoratedSDoc))
    forall a. a -> IO (IORef a)
    newIORef Messages DecoratedSDoc
    forall e. Messages e
    emptyMessages
          ; IORef UsageEnv
    usage_var    <- UsageEnv -> IO (IORef UsageEnv)
    forall a. a -> IO (IORef a)
    newIORef UsageEnv
    zeroUE
          ; let lcl_env :: TcLclEnv
    lcl_env = TcLclEnv {
                    tcl_errs :: IORef (Messages DecoratedSDoc)
    tcl_errs       = IORef (Messages DecoratedSDoc)
    errs_var,
                    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 :: ThStage
    tcl_th_ctxt    = ThStage
    topStage,
                    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_usage :: IORef UsageEnv
    tcl_usage      = IORef UsageEnv
    usage_var,
                    tcl_bndrs :: TcBinderStack
    tcl_bndrs      = [],
                    tcl_lie :: IORef WantedConstraints
    tcl_lie        = IORef WantedConstraints
    lie_var,
                    tcl_tclvl :: TcLevel
    tcl_tclvl      = TcLevel
    topTcLevel
                    }

          ; Maybe r
    maybe_res <- Char
    -> HscEnv
    -> TcGblEnv
    -> TcLclEnv
    -> TcRnIf TcGblEnv TcLclEnv (Maybe r)
    -> IO (Maybe r)
    forall gbl lcl a.
    Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
    initTcRnIf Char
    'a' HscEnv
    hsc_env TcGblEnv
    gbl_env TcLclEnv
    lcl_env (TcRnIf TcGblEnv TcLclEnv (Maybe r) -> IO (Maybe r))
    -> TcRnIf TcGblEnv TcLclEnv (Maybe r) -> IO (Maybe r)
    forall a b. (a -> b) -> a -> b
    $
                         do { Either IOEnvFailure r
    r <- TcM r -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure r)
    forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM TcM r
    do_this
                            ; case Either IOEnvFailure r
    r of
                              Right r
    res -> Maybe r -> TcRnIf TcGblEnv TcLclEnv (Maybe r)
    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 (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)
          ; WantedConstraints
    lie <- IORef WantedConstraints -> IO WantedConstraints
    forall a. IORef a -> IO a
    readIORef (TcLclEnv -> IORef WantedConstraints
    tcl_lie TcLclEnv
    lcl_env)
          ; Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe r -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe r
    maybe_res Bool -> Bool -> Bool
    && Bool -> Bool
    not (WantedConstraints -> Bool
    isEmptyWC WantedConstraints
    lie)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            FilePath -> SDoc -> IO ()
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "initTc: unsolved constraints" (WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    lie)

            -- Collect any error messages
          ; Messages DecoratedSDoc
    msgs <- IORef (Messages DecoratedSDoc) -> IO (Messages DecoratedSDoc)
    forall a. IORef a -> IO a
    readIORef (TcLclEnv -> IORef (Messages DecoratedSDoc)
    tcl_errs TcLclEnv
    lcl_env)

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

          ; (Messages DecoratedSDoc, Maybe r)
    -> IO (Messages DecoratedSDoc, Maybe r)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages DecoratedSDoc
    msgs, Maybe r
    final_res)
          }

    initTcInteractive :: HscEnv -> TcM a -> IO (Messages DecoratedSDoc, Maybe a)
    -- Initialise the type checker monad for use in GHCi
    initTcInteractive :: forall a. HscEnv -> TcM a -> IO (Messages DecoratedSDoc, Maybe a)
    initTcInteractive HscEnv
    hsc_env TcM a
    thing_inside
      = HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM a
    -> IO (Messages DecoratedSDoc, Maybe a)
    forall r.
    HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages DecoratedSDoc, 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

    {- Note [Default types]
    ~~~~~~~~~~~~~~~~~~~~~~~
    The Integer type is simply not available in ghc-prim and ghc-bignum packages (it
    is declared in ghc-bignum). So we set the defaulting types to (Just []), meaning
    there are no default types, rather than Nothing, which means "use the default
    default types of Integer, Double".

    If you don't do this, attempted defaulting in package ghc-prim causes
    an actual crash (attempting to look up the Integer type).

    ************************************************************************
    *                                                                      *
                    Initialisation
    *                                                                      *
    ************************************************************************
    -}

    initTcRnIf :: Char              -- ^ Mask 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_mask 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_um :: Char
    env_um  = Char
    uniq_mask,
                                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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> () -> TcM ()
    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 gbl lcl
    env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; HscEnv -> TcRnIf gbl lcl HscEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Env gbl lcl -> HscEnv
    forall gbl lcl. Env gbl lcl -> HscEnv
    env_top Env gbl lcl
    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 :: HscEnv
    env_top = HscEnv -> HscEnv
    upd HscEnv
    top })

    getGblEnv :: TcRnIf gbl lcl gbl
    getGblEnv :: forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv = do { Env{gbl
    lcl
    Char
    HscEnv
    env_lcl :: lcl
    env_gbl :: gbl
    env_um :: Char
    env_top :: HscEnv
    env_lcl :: forall gbl lcl. Env gbl lcl -> lcl
    env_gbl :: forall gbl lcl. Env gbl lcl -> gbl
    env_um :: forall gbl lcl. Env gbl lcl -> Char
    env_top :: forall gbl lcl. Env gbl lcl -> HscEnv
    ..} <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; gbl -> TcRnIf gbl lcl gbl
    forall (m :: * -> *) a. Monad m => a -> m a
    return gbl
    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 :: gbl
    env_gbl = gbl -> gbl
    upd gbl
    gbl })

    setGblEnv :: gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv :: forall gbl lcl a. 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_gbl = gbl
    gbl_env })

    getLclEnv :: TcRnIf gbl lcl lcl
    getLclEnv :: forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv = do { Env{gbl
    lcl
    Char
    HscEnv
    env_lcl :: lcl
    env_gbl :: gbl
    env_um :: Char
    env_top :: HscEnv
    env_lcl :: forall gbl lcl. Env gbl lcl -> lcl
    env_gbl :: forall gbl lcl. Env gbl lcl -> gbl
    env_um :: forall gbl lcl. Env gbl lcl -> Char
    env_top :: forall gbl lcl. Env gbl lcl -> HscEnv
    ..} <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; lcl -> TcRnIf gbl lcl lcl
    forall (m :: * -> *) a. Monad m => a -> m a
    return lcl
    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 :: lcl
    env_lcl = lcl -> lcl
    upd lcl
    lcl })

    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_lcl = lcl'
    lcl_env })

    getEnvs :: TcRnIf gbl lcl (gbl, lcl)
    getEnvs :: forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs = do { Env gbl lcl
    env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv; (gbl, lcl) -> TcRnIf gbl lcl (gbl, lcl)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Env gbl lcl -> gbl
    forall gbl lcl. Env gbl lcl -> gbl
    env_gbl Env gbl lcl
    env, Env gbl lcl -> lcl
    forall gbl lcl. Env gbl lcl -> lcl
    env_lcl Env gbl 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) = (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_gbl = gbl'
    gbl_env, env_lcl :: lcl'
    env_lcl = lcl'
    lcl_env })

    -- Command-line flags

    xoptM :: LangExt.Extension -> TcRnIf gbl lcl Bool
    xoptM :: forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    flag = do { DynFlags
    dflags <- IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags; Bool -> TcRnIf gbl lcl Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Extension -> DynFlags -> Bool
    xopt Extension
    flag DynFlags
    dflags) }

    doptM :: DumpFlag -> TcRnIf gbl lcl Bool
    doptM :: forall gbl lcl. DumpFlag -> TcRnIf gbl lcl Bool
    doptM DumpFlag
    flag = do { DynFlags
    dflags <- IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags; Bool -> TcRnIf gbl lcl Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DumpFlag -> DynFlags -> Bool
    dopt DumpFlag
    flag DynFlags
    dflags) }

    goptM :: GeneralFlag -> TcRnIf gbl lcl Bool
    goptM :: forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    flag = do { DynFlags
    dflags <- IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags; Bool -> TcRnIf gbl lcl Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    flag DynFlags
    dflags) }

    woptM :: WarningFlag -> TcRnIf gbl lcl Bool
    woptM :: forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    flag = do { DynFlags
    dflags <- IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags; Bool -> TcRnIf gbl lcl Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (WarningFlag -> DynFlags -> Bool
    wopt WarningFlag
    flag DynFlags
    dflags) }

    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 =
      (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 (\HscEnv
    top -> HscEnv
    top { hsc_dflags :: DynFlags
    hsc_dflags = DynFlags -> Extension -> DynFlags
    xopt_set (HscEnv -> DynFlags
    hsc_dflags HscEnv
    top) Extension
    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 =
      (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 (\HscEnv
    top -> HscEnv
    top { hsc_dflags :: DynFlags
    hsc_dflags = DynFlags -> Extension -> DynFlags
    xopt_unset (HscEnv -> DynFlags
    hsc_dflags HscEnv
    top) 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 =
      (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 (\HscEnv
    top -> HscEnv
    top { hsc_dflags :: DynFlags
    hsc_dflags = DynFlags -> GeneralFlag -> DynFlags
    gopt_unset (HscEnv -> DynFlags
    hsc_dflags HscEnv
    top) 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 =
      (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 (\HscEnv
    top -> HscEnv
    top { hsc_dflags :: DynFlags
    hsc_dflags = DynFlags -> WarningFlag -> DynFlags
    wopt_unset (HscEnv -> DynFlags
    hsc_dflags HscEnv
    top) 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 Bool
    b <- DumpFlag -> TcRnIf gbl lcl Bool
    forall gbl lcl. DumpFlag -> TcRnIf gbl lcl Bool
    doptM DumpFlag
    flag
                                     Bool -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    b TcRnIf gbl lcl ()
    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 Bool
    b <- GeneralFlag -> TcRnIf gbl lcl Bool
    forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
    goptM GeneralFlag
    flag
                                     Bool -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    b TcRnIf gbl lcl ()
    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 Bool
    b <- WarningFlag -> TcRnIf gbl lcl Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    flag
                                     Bool -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    b TcRnIf gbl lcl ()
    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 Bool
    b <- Extension -> TcRnIf gbl lcl Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    flag
                                     Bool -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    b TcRnIf gbl lcl ()
    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 Bool
    b <- Extension -> TcRnIf gbl lcl Bool
    forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
    xoptM Extension
    flag
                                       Bool -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    b TcRnIf gbl lcl ()
    thing_inside
    {-# INLINE unlessXOptM #-} -- see Note [INLINE conditional tracing utilities]

    getGhcMode :: TcRnIf gbl lcl GhcMode
    getGhcMode :: forall gbl lcl. TcRnIf gbl lcl GhcMode
    getGhcMode = do { HscEnv
    env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; GhcMode -> TcRnIf gbl lcl GhcMode
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DynFlags -> GhcMode
    ghcMode (HscEnv -> DynFlags
    hsc_dflags HscEnv
    env)) }

    withDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    withDynamicNow :: forall gbl lcl a. TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    withDynamicNow =
      (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 (\top :: HscEnv
    top@(HscEnv { hsc_dflags :: HscEnv -> DynFlags
    hsc_dflags = DynFlags
    dflags }) ->
                  HscEnv
    top { hsc_dflags :: DynFlags
    hsc_dflags = DynFlags -> DynFlags
    setDynamicNow DynFlags
    dflags })

    withoutDynamicNow :: TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    withoutDynamicNow :: forall gbl lcl a. TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    withoutDynamicNow =
      (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 (\top :: HscEnv
    top@(HscEnv { hsc_dflags :: HscEnv -> DynFlags
    hsc_dflags = DynFlags
    dflags }) ->
                  HscEnv
    top { hsc_dflags :: DynFlags
    hsc_dflags = DynFlags
    dflags { dynamicNow :: Bool
    dynamicNow = Bool
    False} })

    getEpsVar :: TcRnIf gbl lcl (TcRef ExternalPackageState)
    getEpsVar :: forall gbl lcl. TcRnIf gbl lcl (TcRef ExternalPackageState)
    getEpsVar = do { HscEnv
    env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; TcRef ExternalPackageState
    -> TcRnIf gbl lcl (TcRef ExternalPackageState)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscEnv -> TcRef ExternalPackageState
    hsc_EPS HscEnv
    env) }

    getEps :: TcRnIf gbl lcl ExternalPackageState
    getEps :: forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
    getEps = do { HscEnv
    env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; TcRef ExternalPackageState -> TcRnIf gbl lcl ExternalPackageState
    forall a env. IORef a -> IOEnv env a
    readMutVar (HscEnv -> TcRef ExternalPackageState
    hsc_EPS HscEnv
    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
    text FilePath
    "updating EPS")
      TcRef ExternalPackageState
    eps_var <- TcRnIf gbl lcl (TcRef ExternalPackageState)
    forall gbl lcl. TcRnIf gbl lcl (TcRef ExternalPackageState)
    getEpsVar
      TcRef ExternalPackageState
    -> (ExternalPackageState -> (ExternalPackageState, a))
    -> TcRnIf gbl lcl a
    forall a b env. IORef a -> (a -> (a, b)) -> IOEnv env b
    atomicUpdMutVar' TcRef ExternalPackageState
    eps_var ExternalPackageState -> (ExternalPackageState, a)
    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 { HscEnv
    env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; HomePackageTable -> TcRnIf gbl lcl HomePackageTable
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    env) }

    getEpsAndHpt :: TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
    getEpsAndHpt :: forall gbl lcl.
    TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
    getEpsAndHpt = do { HscEnv
    env <- TcRnIf gbl lcl HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv; ExternalPackageState
    eps <- TcRef ExternalPackageState
    -> IOEnv (Env gbl lcl) ExternalPackageState
    forall a env. IORef a -> IOEnv env a
    readMutVar (HscEnv -> TcRef ExternalPackageState
    hsc_EPS HscEnv
    env)
                      ; (ExternalPackageState, HomePackageTable)
    -> TcRnIf gbl lcl (ExternalPackageState, HomePackageTable)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExternalPackageState
    eps, HscEnv -> HomePackageTable
    hsc_HPT HscEnv
    env) }

    -- | A convenient wrapper for taking a @MaybeErr SDoc a@ and throwing
    -- an exception if it is an error.
    withException :: TcRnIf gbl lcl (MaybeErr SDoc a) -> TcRnIf gbl lcl a
    withException :: forall gbl lcl a.
    TcRnIf gbl lcl (MaybeErr SDoc a) -> TcRnIf gbl lcl a
    withException TcRnIf gbl lcl (MaybeErr SDoc a)
    do_this = do
        MaybeErr SDoc a
    r <- TcRnIf gbl lcl (MaybeErr SDoc a)
    do_this
        DynFlags
    dflags <- IOEnv (Env gbl lcl) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        case MaybeErr SDoc a
    r of
            Failed SDoc
    err -> IO a -> TcRnIf gbl lcl a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO a -> TcRnIf gbl lcl a) -> IO a -> TcRnIf gbl lcl a
    forall a b. (a -> b) -> a -> b
    $ GhcException -> IO a
    forall a. GhcException -> IO a
    throwGhcExceptionIO (FilePath -> GhcException
    ProgramError (DynFlags -> SDoc -> FilePath
    showSDoc DynFlags
    dflags SDoc
    err))
            Succeeded a
    result -> a -> TcRnIf gbl lcl 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 -> TcLclEnv
    env { tcl_arrow_ctxt :: ArrowCtxt
    tcl_arrow_ctxt = LocalRdrEnv -> IORef WantedConstraints -> ArrowCtxt
    ArrowCtxt (TcLclEnv -> LocalRdrEnv
    tcl_rdr TcLclEnv
    env) (TcLclEnv -> IORef WantedConstraints
    tcl_lie 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
    tcl_arrow_ctxt TcLclEnv
    env of
          ArrowCtxt
    NoArrowCtxt       -> TcLclEnv
    env
          ArrowCtxt LocalRdrEnv
    rdr_env IORef WantedConstraints
    lie -> TcLclEnv
    env { tcl_arrow_ctxt :: ArrowCtxt
    tcl_arrow_ctxt = ArrowCtxt
    NoArrowCtxt
                                       , tcl_lie :: IORef WantedConstraints
    tcl_lie = IORef WantedConstraints
    lie
                                       , tcl_rdr :: LocalRdrEnv
    tcl_rdr = LocalRdrEnv
    rdr_env }

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

    newUnique :: TcRnIf gbl lcl Unique
    newUnique :: forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
     = do { Env gbl lcl
    env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv
          ; let mask :: Char
    mask = Env gbl lcl -> Char
    forall gbl lcl. Env gbl lcl -> Char
    env_um Env gbl lcl
    env
          ; IO Unique -> TcRnIf gbl lcl Unique
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Unique -> TcRnIf gbl lcl Unique)
    -> IO Unique -> TcRnIf gbl lcl Unique
    forall a b. (a -> b) -> a -> b
    $! Char -> IO Unique
    uniqFromMask Char
    mask }

    newUniqueSupply :: TcRnIf gbl lcl UniqSupply
    newUniqueSupply :: forall gbl lcl. TcRnIf gbl lcl UniqSupply
    newUniqueSupply
     = do { Env gbl lcl
    env <- IOEnv (Env gbl lcl) (Env gbl lcl)
    forall env. IOEnv env env
    getEnv
          ; let mask :: Char
    mask = Env gbl lcl -> Char
    forall gbl lcl. Env gbl lcl -> Char
    env_um Env gbl lcl
    env
          ; IO UniqSupply -> TcRnIf gbl lcl UniqSupply
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO UniqSupply -> TcRnIf gbl lcl UniqSupply)
    -> IO UniqSupply -> TcRnIf gbl lcl UniqSupply
    forall a b. (a -> b) -> a -> b
    $! Char -> IO UniqSupply
    mkSplitUniqSupply Char
    mask }

    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 { SrcSpan
    loc  <- TcRn SrcSpan
    getSrcSpanM
                     ; OccName -> SrcSpan -> TcM Name
    newNameAt OccName
    occ SrcSpan
    loc }

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

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

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

    newSysLocalIds :: FastString -> [Scaled TcType] -> TcRnIf gbl lcl [TcId]
    newSysLocalIds :: forall gbl lcl. FastString -> [Scaled Type] -> TcRnIf gbl lcl [Id]
    newSysLocalIds FastString
    fs [Scaled Type]
    tys
      = do  { UniqSupply
    us <- TcRnIf gbl lcl UniqSupply
    forall gbl lcl. TcRnIf gbl lcl UniqSupply
    newUniqueSupply
            ; let mkId' :: Unique -> Scaled Type -> Id
    mkId' Unique
    n (Scaled Type
    w Type
    t) = FastString -> Unique -> Type -> Type -> Id
    mkSysLocal FastString
    fs Unique
    n Type
    w Type
    t
            ; [Id] -> TcRnIf gbl lcl [Id]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Unique -> Scaled Type -> Id) -> [Unique] -> [Scaled Type] -> [Id]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Unique -> Scaled Type -> Id
    mkId' (UniqSupply -> [Unique]
    uniqsFromSupply UniqSupply
    us) [Scaled Type]
    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

    {-
    ************************************************************************
    *                                                                      *
                    Accessing input/output
    *                                                                      *
    ************************************************************************
    -}

    newTcRef :: a -> TcRnIf gbl lcl (TcRef a)
    newTcRef :: forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef = a -> IOEnv (Env gbl lcl) (IORef a)
    forall a env. a -> IOEnv env (IORef a)
    newMutVar

    readTcRef :: TcRef a -> TcRnIf gbl lcl a
    readTcRef :: forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef = IORef a -> IOEnv (Env gbl lcl) a
    forall a env. IORef a -> IOEnv env a
    readMutVar

    writeTcRef :: TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef :: forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef = IORef a -> a -> IOEnv (Env gbl lcl) ()
    forall a env. IORef a -> a -> IOEnv env ()
    writeMutVar

    updTcRef :: TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    -- Returns ()
    updTcRef :: forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef TcRef a
    ref a -> a
    fn = IO () -> IOEnv (Env gbl lcl) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IOEnv (Env gbl lcl) ())
    -> IO () -> IOEnv (Env gbl lcl) ()
    forall a b. (a -> b) -> a -> b
    $ do { a
    old <- TcRef a -> IO a
    forall a. IORef a -> IO a
    readIORef TcRef a
    ref
                                  ; TcRef a -> a -> IO ()
    forall a. IORef a -> a -> IO ()
    writeIORef TcRef a
    ref (a -> a
    fn a
    old) }

    {-
    ************************************************************************
    *                                                                      *
                    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, instead of
    --
    --     let thunk = ...
    --     in if doTracing
    --          then emitTraceMsg thunk
    --          else return ()
    --
    -- where the conditional is buried in a non-inlined utility function (e.g.
    -- traceTc), we would rather have:
    --
    --     if doTracing
    --       then let thunk = ...
    --            in emitTraceMsg thunk
    --       else return ()
    --
    -- 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
    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
      DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      Logger
    logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
      PrintUnqualified
    printer <- TcRn PrintUnqualified
    getPrintUnqualified
      SDoc
    real_doc <- SDoc -> TcRn SDoc
    wrapDocLoc SDoc
    doc
      let sty :: PprStyle
    sty = if Bool
    useUserStyle
                  then PrintUnqualified -> Depth -> PprStyle
    mkUserStyle PrintUnqualified
    printer Depth
    AllTheWay
                  else PrintUnqualified -> PprStyle
    mkDumpStyle PrintUnqualified
    printer
      IO () -> TcM ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> TcM ()) -> IO () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> DumpAction
    putDumpMsg Logger
    logger DynFlags
    dflags PprStyle
    sty DumpFlag
    flag FilePath
    title DumpFormat
    fmt SDoc
    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
      DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      if DynFlags -> Bool
    hasPprDebug DynFlags
    dflags
        then do
          SrcSpan
    loc <- TcRn SrcSpan
    getSrcSpanM
          SDoc -> TcRn SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Severity -> SrcSpan -> SDoc -> SDoc
    mkLocMessage Severity
    SevOutput SrcSpan
    loc SDoc
    doc)
        else
          SDoc -> TcRn SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return SDoc
    doc

    getPrintUnqualified :: TcRn PrintUnqualified
    getPrintUnqualified :: TcRn PrintUnqualified
    getPrintUnqualified
      = do { GlobalRdrEnv
    rdr_env <- TcRn GlobalRdrEnv
    getGlobalRdrEnv
           ; HscEnv
    hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
           ; PrintUnqualified -> TcRn PrintUnqualified
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PrintUnqualified -> TcRn PrintUnqualified)
    -> PrintUnqualified -> TcRn PrintUnqualified
    forall a b. (a -> b) -> a -> b
    $ UnitEnv -> GlobalRdrEnv -> PrintUnqualified
    mkPrintUnqualified (HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env) GlobalRdrEnv
    rdr_env }

    -- | Like logInfoTcRn, but for user consumption
    printForUserTcRn :: SDoc -> TcRn ()
    printForUserTcRn :: SDoc -> TcM ()
    printForUserTcRn SDoc
    doc = do
        DynFlags
    dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- IOEnv (Env TcGblEnv TcLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        PrintUnqualified
    printer <- TcRn PrintUnqualified
    getPrintUnqualified
        IO () -> TcM ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Logger -> DynFlags -> PrintUnqualified -> SDoc -> IO ()
    printOutputForUser Logger
    logger DynFlags
    dflags PrintUnqualified
    printer SDoc
    doc)

    {-
    traceIf and traceHiDiffs work 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, traceHiDiffs :: 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
    traceHiDiffs :: forall m n. SDoc -> TcRnIf m n ()
    traceHiDiffs = DumpFlag -> SDoc -> TcRnIf m n ()
    forall m n. DumpFlag -> SDoc -> TcRnIf m n ()
    traceOptIf DumpFlag
    Opt_D_dump_hi_diffs
    {-# INLINE traceIf #-}
    {-# INLINE traceHiDiffs #-}
      -- 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
            DynFlags
    dflags <- IOEnv (Env m n) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
            Logger
    logger <- IOEnv (Env m n) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
            IO () -> TcRnIf m n ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Logger -> DynFlags -> SDoc -> IO ()
    putMsg Logger
    logger DynFlags
    dflags SDoc
    doc)
    {-# INLINE traceOptIf #-}  -- see Note [INLINE conditional tracing utilities]

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

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

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

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

    tcIsHsBootOrSig :: TcRn Bool
    tcIsHsBootOrSig :: TcRn Bool
    tcIsHsBootOrSig = do { TcGblEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; Bool -> TcRn Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HscSource -> Bool
    isHsBootOrSig (TcGblEnv -> HscSource
    tcg_src TcGblEnv
    env)) }

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

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

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

    getRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv)
    getRdrEnvs :: TcRn (GlobalRdrEnv, LocalRdrEnv)
    getRdrEnvs = do { (TcGblEnv
    gbl,TcLclEnv
    lcl) <- TcRnIf TcGblEnv TcLclEnv (TcGblEnv, TcLclEnv)
    forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs; (GlobalRdrEnv, LocalRdrEnv) -> TcRn (GlobalRdrEnv, LocalRdrEnv)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv -> GlobalRdrEnv
    tcg_rdr_env TcGblEnv
    gbl, TcLclEnv -> LocalRdrEnv
    tcl_rdr TcLclEnv
    lcl) }

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

    getFixityEnv :: TcRn FixityEnv
    getFixityEnv :: TcRn FixityEnv
    getFixityEnv = do { TcGblEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; FixityEnv -> TcRn FixityEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv -> FixityEnv
    tcg_fix_env TcGblEnv
    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 :: FixityEnv
    tcg_fix_env = FixityEnv -> [(Name, FixItem)] -> FixityEnv
    forall a. NameEnv a -> [(Name, a)] -> NameEnv a
    extendNameEnvList FixityEnv
    old_fix_env [(Name, FixItem)]
    new_bit})

    getRecFieldEnv :: TcRn RecFieldEnv
    getRecFieldEnv :: TcRn RecFieldEnv
    getRecFieldEnv = do { TcGblEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; RecFieldEnv -> TcRn RecFieldEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv -> RecFieldEnv
    tcg_field_env TcGblEnv
    env) }

    getDeclaredDefaultTys :: TcRn (Maybe [Type])
    getDeclaredDefaultTys :: TcRn (Maybe [Type])
    getDeclaredDefaultTys = do { TcGblEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; Maybe [Type] -> TcRn (Maybe [Type])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcGblEnv -> Maybe [Type]
    tcg_default TcGblEnv
    env) }

    addDependentFiles :: [FilePath] -> TcRn ()
    addDependentFiles :: [FilePath] -> TcM ()
    addDependentFiles [FilePath]
    fs = do
      IORef [FilePath]
    ref <- (TcGblEnv -> IORef [FilePath])
    -> TcRnIf TcGblEnv TcLclEnv TcGblEnv
    -> IOEnv (Env TcGblEnv TcLclEnv) (IORef [FilePath])
    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
      [FilePath]
    dep_files <- IORef [FilePath] -> TcRnIf TcGblEnv TcLclEnv [FilePath]
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef [FilePath]
    ref
      IORef [FilePath] -> [FilePath] -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef IORef [FilePath]
    ref ([FilePath]
    fs [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [FilePath]
    dep_files)

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

    getSrcSpanM :: TcRn SrcSpan
            -- Avoid clash with Name.getSrcLoc
    getSrcSpanM :: TcRn SrcSpan
    getSrcSpanM = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; SrcSpan -> TcRn SrcSpan
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (TcLclEnv -> RealSrcSpan
    tcl_loc TcLclEnv
    env) Maybe BufSpan
    forall a. Maybe a
    Nothing) }

    -- See Note [Error contexts in generated code]
    inGeneratedCode :: TcRn Bool
    inGeneratedCode :: TcRn Bool
    inGeneratedCode = TcLclEnv -> Bool
    tcl_in_gen_code (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
      = (TcLclEnv -> TcLclEnv) -> TcRn a -> TcRn a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\TcLclEnv
    env -> TcLclEnv
    env { tcl_loc :: RealSrcSpan
    tcl_loc = RealSrcSpan
    loc, tcl_in_gen_code :: Bool
    tcl_in_gen_code = Bool
    False })
                  TcRn a
    thing_inside

    setSrcSpan loc :: SrcSpan
    loc@(UnhelpfulSpan UnhelpfulSpanReason
    _) TcRn a
    thing_inside
      | SrcSpan -> Bool
    isGeneratedSrcSpan SrcSpan
    loc
      = (TcLclEnv -> TcLclEnv) -> TcRn a -> TcRn a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\TcLclEnv
    env -> TcLclEnv
    env { tcl_in_gen_code :: Bool
    tcl_in_gen_code = Bool
    True }) TcRn a
    thing_inside

      | Bool
    otherwise
      = TcRn a
    thing_inside

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

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

    addLocMA :: (a -> TcM b) -> GenLocated (SrcSpanAnn' ann) a -> TcM b
    addLocMA :: forall a b ann.
    (a -> TcM b) -> GenLocated (SrcSpanAnn' ann) a -> TcM b
    addLocMA a -> TcM b
    fn (L SrcSpanAnn' ann
    loc a
    a) = SrcSpanAnn' ann -> TcM b -> TcM b
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnn' ann
    loc (TcM b -> TcM b) -> TcM b -> TcM b
    forall a b. (a -> b) -> a -> b
    $ a -> TcM b
    fn a
    a

    wrapLocM :: (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM :: forall a b. (a -> TcM b) -> Located a -> TcM (Located b)
    wrapLocM a -> TcM b
    fn (L SrcSpan
    loc a
    a) = 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
    b <- a -> TcM b
    fn a
    a
                                                ; Located b -> TcRn (Located b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> b -> Located b
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc b
    b) }

    wrapLocAM :: (a -> TcM b) -> LocatedAn an a -> TcM (Located b)
    wrapLocAM :: forall a b an. (a -> TcM b) -> LocatedAn an a -> TcM (Located b)
    wrapLocAM a -> TcM b
    fn (L SrcAnn an
    loc a
    a) = SrcAnn an -> TcRn (Located b) -> TcRn (Located b)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcAnn an
    loc (TcRn (Located b) -> TcRn (Located b))
    -> TcRn (Located b) -> TcRn (Located b)
    forall a b. (a -> b) -> a -> b
    $ do { b
    b <- a -> TcM b
    fn a
    a
                                                  ; Located b -> TcRn (Located b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> b -> Located b
    forall l e. l -> e -> GenLocated l e
    L (SrcAnn an -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcAnn an
    loc) b
    b) }

    wrapLocMA :: (a -> TcM b) -> GenLocated (SrcSpanAnn' ann) a -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    wrapLocMA :: forall a b ann.
    (a -> TcM b)
    -> GenLocated (SrcSpanAnn' ann) a
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    wrapLocMA a -> TcM b
    fn (L SrcSpanAnn' ann
    loc a
    a) = SrcSpanAnn' ann
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnn' ann
    loc (TcRn (GenLocated (SrcSpanAnn' ann) b)
     -> TcRn (GenLocated (SrcSpanAnn' ann) b))
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    forall a b. (a -> b) -> a -> b
    $ do { b
    b <- a -> TcM b
    fn a
    a
                                                  ; GenLocated (SrcSpanAnn' ann) b
    -> TcRn (GenLocated (SrcSpanAnn' ann) b)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnn' ann -> b -> GenLocated (SrcSpanAnn' ann) b
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnn' ann
    loc b
    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
    b,c
    c) <- a -> TcM (b, c)
    fn a
    a
        (Located b, c) -> TcRn (Located b, c)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> b -> Located b
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc b
    b, c
    c)

    wrapLocFstMA :: (a -> TcM (b,c)) -> LocatedA a -> TcM (LocatedA b, c)
    wrapLocFstMA :: forall a b c.
    (a -> TcM (b, c)) -> LocatedA a -> TcM (LocatedA b, c)
    wrapLocFstMA a -> TcM (b, c)
    fn (L SrcSpanAnnA
    loc a
    a) =
      SrcSpanAnnA -> TcRn (LocatedA b, c) -> TcRn (LocatedA b, c)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcRn (LocatedA b, c) -> TcRn (LocatedA b, c))
    -> TcRn (LocatedA b, c) -> TcRn (LocatedA b, c)
    forall a b. (a -> b) -> a -> b
    $ do
        (b
    b,c
    c) <- a -> TcM (b, c)
    fn a
    a
        (LocatedA b, c) -> TcRn (LocatedA b, c)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpanAnnA -> b -> LocatedA b
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc b
    b, c
    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
    b,c
    c) <- a -> TcM (b, c)
    fn a
    a
        (b, Located c) -> TcRn (b, Located c)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b
    b, SrcSpan -> c -> Located c
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    loc c
    c)

    wrapLocSndMA :: (a -> TcM (b, c)) -> LocatedA a -> TcM (b, LocatedA c)
    wrapLocSndMA :: forall a b c.
    (a -> TcM (b, c)) -> LocatedA a -> TcM (b, LocatedA c)
    wrapLocSndMA a -> TcM (b, c)
    fn (L SrcSpanAnnA
    loc a
    a) =
      SrcSpanAnnA -> TcRn (b, LocatedA c) -> TcRn (b, LocatedA c)
    forall ann a. SrcSpanAnn' ann -> TcRn a -> TcRn a
    setSrcSpanA SrcSpanAnnA
    loc (TcRn (b, LocatedA c) -> TcRn (b, LocatedA c))
    -> TcRn (b, LocatedA c) -> TcRn (b, LocatedA c)
    forall a b. (a -> b) -> a -> b
    $ do
        (b
    b,c
    c) <- a -> TcM (b, c)
    fn a
    a
        (b, LocatedA c) -> TcRn (b, LocatedA c)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (b
    b, SrcSpanAnnA -> c -> LocatedA c
    forall l e. l -> e -> GenLocated l e
    L SrcSpanAnnA
    loc c
    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. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnnA
    loc) (a -> TcM ()
    fn a
    a)

    -- Reporting errors

    getErrsVar :: TcRn (TcRef (Messages DecoratedSDoc))
    getErrsVar :: TcRn (IORef (Messages DecoratedSDoc))
    getErrsVar = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; IORef (Messages DecoratedSDoc)
    -> TcRn (IORef (Messages DecoratedSDoc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLclEnv -> IORef (Messages DecoratedSDoc)
    tcl_errs TcLclEnv
    env) }

    setErrsVar :: TcRef (Messages DecoratedSDoc) -> TcRn a -> TcRn a
    setErrsVar :: forall a. IORef (Messages DecoratedSDoc) -> TcRn a -> TcRn a
    setErrsVar IORef (Messages DecoratedSDoc)
    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 :: IORef (Messages DecoratedSDoc)
    tcl_errs =  IORef (Messages DecoratedSDoc)
    v })

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

    failWith :: SDoc -> TcRn a
    failWith :: forall a. SDoc -> TcRn a
    failWith SDoc
    msg = SDoc -> TcM ()
    addErr SDoc
    msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    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 -> SDoc -> TcRn a
    failAt :: forall a. SrcSpan -> SDoc -> TcRn a
    failAt SrcSpan
    loc SDoc
    msg = SrcSpan -> SDoc -> TcM ()
    addErrAt SrcSpan
    loc SDoc
    msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    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 -> SDoc -> 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 -> SDoc -> TcM ()
    addErrAt SrcSpan
    loc SDoc
    msg = do { [ErrCtxt]
    ctxt <- TcM [ErrCtxt]
    getErrCtxt
                          ; TidyEnv
    tidy_env <- TcM TidyEnv
    tcInitTidyEnv
                          ; SDoc
    err_info <- TidyEnv -> [ErrCtxt] -> TcRn SDoc
    mkErrInfo TidyEnv
    tidy_env [ErrCtxt]
    ctxt
                          ; SrcSpan -> SDoc -> SDoc -> TcM ()
    addLongErrAt SrcSpan
    loc SDoc
    msg SDoc
    err_info }

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

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

    addMessages :: Messages DecoratedSDoc -> TcRn ()
    addMessages :: Messages DecoratedSDoc -> TcM ()
    addMessages Messages DecoratedSDoc
    msgs1
      = do { IORef (Messages DecoratedSDoc)
    errs_var <- TcRn (IORef (Messages DecoratedSDoc))
    getErrsVar ;
             Messages DecoratedSDoc
    msgs0 <- IORef (Messages DecoratedSDoc)
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef (Messages DecoratedSDoc)
    errs_var ;
             IORef (Messages DecoratedSDoc) -> Messages DecoratedSDoc -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef IORef (Messages DecoratedSDoc)
    errs_var (Messages DecoratedSDoc
    -> Messages DecoratedSDoc -> Messages DecoratedSDoc
    forall e. Messages e -> Messages e -> Messages e
    unionMessages Messages DecoratedSDoc
    msgs0 Messages DecoratedSDoc
    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  { IORef (Messages DecoratedSDoc)
    errs_var <- TcRn (IORef (Messages DecoratedSDoc))
    getErrsVar
            ; Bag (MsgEnvelope DecoratedSDoc)
    old_warns <- Messages DecoratedSDoc -> Bag (MsgEnvelope DecoratedSDoc)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getWarningMessages (Messages DecoratedSDoc -> Bag (MsgEnvelope DecoratedSDoc))
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Bag (MsgEnvelope DecoratedSDoc))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Messages DecoratedSDoc)
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef (Messages DecoratedSDoc)
    errs_var

            ; a
    result <- TcRn a
    thing_inside

            -- Revert warnings to old_warns
            ; Bag (MsgEnvelope DecoratedSDoc)
    new_errs <- Messages DecoratedSDoc -> Bag (MsgEnvelope DecoratedSDoc)
    forall e. Messages e -> Bag (MsgEnvelope e)
    getErrorMessages (Messages DecoratedSDoc -> Bag (MsgEnvelope DecoratedSDoc))
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Bag (MsgEnvelope DecoratedSDoc))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Messages DecoratedSDoc)
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef (Messages DecoratedSDoc)
    errs_var
            ; IORef (Messages DecoratedSDoc) -> Messages DecoratedSDoc -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef IORef (Messages DecoratedSDoc)
    errs_var (Messages DecoratedSDoc -> TcM ())
    -> Messages DecoratedSDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ Bag (MsgEnvelope DecoratedSDoc) -> Messages DecoratedSDoc
    forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages (Bag (MsgEnvelope DecoratedSDoc)
    old_warns Bag (MsgEnvelope DecoratedSDoc)
    -> Bag (MsgEnvelope DecoratedSDoc)
    -> Bag (MsgEnvelope DecoratedSDoc)
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag (MsgEnvelope DecoratedSDoc)
    new_errs)

            ; a -> TcRn a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result }

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

    mkLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    mkLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    mkLongErrAt SrcSpan
    loc SDoc
    msg SDoc
    extra
      = do { PrintUnqualified
    printer <- TcRn PrintUnqualified
    getPrintUnqualified ;
             UnitState
    unit_state <- 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 msg' :: SDoc
    msg' = UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    unit_state SDoc
    msg in
             MsgEnvelope DecoratedSDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MsgEnvelope DecoratedSDoc -> TcRn (MsgEnvelope DecoratedSDoc))
    -> MsgEnvelope DecoratedSDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> PrintUnqualified -> SDoc -> SDoc -> MsgEnvelope DecoratedSDoc
    mkLongMsgEnvelope SrcSpan
    loc PrintUnqualified
    printer SDoc
    msg' SDoc
    extra }

    mkDecoratedSDocAt :: SrcSpan
                      -> SDoc
                      -- ^ The important part of the message
                      -> SDoc
                      -- ^ The context of the message
                      -> SDoc
                      -- ^ Any supplementary information.
                      -> TcRn (MsgEnvelope DecoratedSDoc)
    mkDecoratedSDocAt :: SrcSpan -> SDoc -> SDoc -> SDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    mkDecoratedSDocAt SrcSpan
    loc SDoc
    important SDoc
    context SDoc
    extra
      = do { PrintUnqualified
    printer <- TcRn PrintUnqualified
    getPrintUnqualified ;
             UnitState
    unit_state <- 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 f :: SDoc -> SDoc
    f = UnitState -> SDoc -> SDoc
    pprWithUnitState UnitState
    unit_state
                 errDoc :: [SDoc]
    errDoc  = [SDoc
    important, SDoc
    context, SDoc
    extra]
                 errDoc' :: DecoratedSDoc
    errDoc' = [SDoc] -> DecoratedSDoc
    mkDecorated ([SDoc] -> DecoratedSDoc) -> [SDoc] -> DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ (SDoc -> SDoc) -> [SDoc] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map SDoc -> SDoc
    f [SDoc]
    errDoc
             in
             MsgEnvelope DecoratedSDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MsgEnvelope DecoratedSDoc -> TcRn (MsgEnvelope DecoratedSDoc))
    -> MsgEnvelope DecoratedSDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> PrintUnqualified -> DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall e. SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mkErr SrcSpan
    loc PrintUnqualified
    printer DecoratedSDoc
    errDoc' }

    addLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcRn ()
    addLongErrAt :: SrcSpan -> SDoc -> SDoc -> TcM ()
    addLongErrAt SrcSpan
    loc SDoc
    msg SDoc
    extra = SrcSpan -> SDoc -> SDoc -> TcRn (MsgEnvelope DecoratedSDoc)
    mkLongErrAt SrcSpan
    loc SDoc
    msg SDoc
    extra TcRn (MsgEnvelope DecoratedSDoc)
    -> (MsgEnvelope DecoratedSDoc -> TcM ()) -> TcM ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= MsgEnvelope DecoratedSDoc -> TcM ()
    reportError

    reportErrors :: [MsgEnvelope DecoratedSDoc] -> TcM ()
    reportErrors :: [MsgEnvelope DecoratedSDoc] -> TcM ()
    reportErrors = (MsgEnvelope DecoratedSDoc -> TcM ())
    -> [MsgEnvelope DecoratedSDoc] -> TcM ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ MsgEnvelope DecoratedSDoc -> TcM ()
    reportError

    reportError :: MsgEnvelope DecoratedSDoc -> TcRn ()
    reportError :: MsgEnvelope DecoratedSDoc -> TcM ()
    reportError MsgEnvelope DecoratedSDoc
    err
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "Adding error:" (MsgEnvelope DecoratedSDoc -> SDoc
    forall e. RenderableDiagnostic e => MsgEnvelope e -> SDoc
    pprLocMsgEnvelope MsgEnvelope DecoratedSDoc
    err) ;
             IORef (Messages DecoratedSDoc)
    errs_var <- TcRn (IORef (Messages DecoratedSDoc))
    getErrsVar ;
             Messages DecoratedSDoc
    msgs     <- IORef (Messages DecoratedSDoc)
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef (Messages DecoratedSDoc)
    errs_var ;
             IORef (Messages DecoratedSDoc) -> Messages DecoratedSDoc -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef IORef (Messages DecoratedSDoc)
    errs_var (MsgEnvelope DecoratedSDoc
    err MsgEnvelope DecoratedSDoc
    -> Messages DecoratedSDoc -> Messages DecoratedSDoc
    forall e. MsgEnvelope e -> Messages e -> Messages e
    `addMessage` Messages DecoratedSDoc
    msgs) }

    reportWarning :: WarnReason -> MsgEnvelope DecoratedSDoc -> TcRn ()
    reportWarning :: WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning WarnReason
    reason MsgEnvelope DecoratedSDoc
    err
      = do { let warn :: MsgEnvelope DecoratedSDoc
    warn = WarnReason
    -> MsgEnvelope DecoratedSDoc -> MsgEnvelope DecoratedSDoc
    forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning WarnReason
    reason MsgEnvelope DecoratedSDoc
    err
                        -- 'err' was built by mkLongMsgEnvelope or something like that,
                        -- so it's of error severity.  For a warning we downgrade
                        -- its severity to SevWarning

           ; FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "Adding warning:" (MsgEnvelope DecoratedSDoc -> SDoc
    forall e. RenderableDiagnostic e => MsgEnvelope e -> SDoc
    pprLocMsgEnvelope MsgEnvelope DecoratedSDoc
    warn)
           ; IORef (Messages DecoratedSDoc)
    errs_var <- TcRn (IORef (Messages DecoratedSDoc))
    getErrsVar
           ; (Bag (MsgEnvelope DecoratedSDoc)
    warns, Bag (MsgEnvelope DecoratedSDoc)
    errs) <- Messages DecoratedSDoc
    -> (Bag (MsgEnvelope DecoratedSDoc),
        Bag (MsgEnvelope DecoratedSDoc))
    forall e. Messages e -> (Bag (MsgEnvelope e), Bag (MsgEnvelope e))
    partitionMessages (Messages DecoratedSDoc
     -> (Bag (MsgEnvelope DecoratedSDoc),
         Bag (MsgEnvelope DecoratedSDoc)))
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    -> IOEnv
         (Env TcGblEnv TcLclEnv)
         (Bag (MsgEnvelope DecoratedSDoc), Bag (MsgEnvelope DecoratedSDoc))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Messages DecoratedSDoc)
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef (Messages DecoratedSDoc)
    errs_var
           ; IORef (Messages DecoratedSDoc) -> Messages DecoratedSDoc -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef IORef (Messages DecoratedSDoc)
    errs_var (Bag (MsgEnvelope DecoratedSDoc) -> Messages DecoratedSDoc
    forall e. Bag (MsgEnvelope e) -> Messages e
    mkMessages (Bag (MsgEnvelope DecoratedSDoc) -> Messages DecoratedSDoc)
    -> Bag (MsgEnvelope DecoratedSDoc) -> Messages DecoratedSDoc
    forall a b. (a -> b) -> a -> b
    $ (Bag (MsgEnvelope DecoratedSDoc)
    warns Bag (MsgEnvelope DecoratedSDoc)
    -> MsgEnvelope DecoratedSDoc -> Bag (MsgEnvelope DecoratedSDoc)
    forall a. Bag a -> a -> Bag a
    `snocBag` MsgEnvelope DecoratedSDoc
    warn) Bag (MsgEnvelope DecoratedSDoc)
    -> Bag (MsgEnvelope DecoratedSDoc)
    -> Bag (MsgEnvelope DecoratedSDoc)
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag (MsgEnvelope DecoratedSDoc)
    errs) }

    -----------------------
    checkNoErrs :: TcM r -> TcM r
    -- (checkNoErrs m) succeeds iff m succeeds and generates no errors
    -- If m fails then (checkNoErrsTc 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  { (r
    res, Bool
    no_errs) <- TcM r -> TcRn (r, Bool)
    forall a. TcRn a -> TcRn (a, Bool)
    askNoErrs TcM r
    main
            ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    unless Bool
    no_errs TcM ()
    forall env a. IOEnv env a
    failM
            ; r -> TcM r
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    res }

    -----------------------
    whenNoErrs :: TcM () -> TcM ()
    whenNoErrs :: TcM () -> TcM ()
    whenNoErrs TcM ()
    thing = TcM () -> TcM () -> TcM ()
    forall r. TcRn r -> TcRn r -> TcRn r
    ifErrsM (() -> TcM ()
    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 { IORef (Messages DecoratedSDoc)
    errs_var <- TcRn (IORef (Messages DecoratedSDoc))
    getErrsVar ;
            Messages DecoratedSDoc
    msgs <- IORef (Messages DecoratedSDoc)
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef (Messages DecoratedSDoc)
    errs_var ;
            if Messages DecoratedSDoc -> Bool
    forall e. Messages e -> Bool
    errorsFound Messages DecoratedSDoc
    msgs then
               TcRn r
    bale_out
            else
               TcRn r
    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 (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
    ininings seem unobjectional, and they solve the immediate
    problem.

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

    * When tc_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 HsExpansion] in GHC.Hs.Expr for
    more discussion of this fancy footwork.
    -}

    getErrCtxt :: TcM [ErrCtxt]
    getErrCtxt :: TcM [ErrCtxt]
    getErrCtxt = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; [ErrCtxt] -> TcM [ErrCtxt]
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLclEnv -> [ErrCtxt]
    tcl_ctxt TcLclEnv
    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 (\ TcLclEnv
    env -> TcLclEnv
    env { tcl_ctxt :: [ErrCtxt]
    tcl_ctxt = [ErrCtxt]
    ctxt })

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

    -- | Add a message to the error context. This message may do tidying.
    addErrCtxtM :: (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    {-# INLINE addErrCtxtM #-}  -- Note [Inlining addErrCtxt]
    addErrCtxtM :: forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addErrCtxtM TidyEnv -> TcM (TidyEnv, SDoc)
    ctxt = ErrCtxt -> TcM a -> TcM a
    forall a. ErrCtxt -> TcM a -> TcM a
    pushCtxt (Bool
    False, TidyEnv -> TcM (TidyEnv, SDoc)
    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 :: SDoc -> TcM a -> TcM a
    {-# INLINE addLandmarkErrCtxt #-}  -- Note [Inlining addErrCtxt]
    addLandmarkErrCtxt :: forall a. SDoc -> TcM a -> TcM a
    addLandmarkErrCtxt SDoc
    msg = (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addLandmarkErrCtxtM (\TidyEnv
    env -> (TidyEnv, SDoc) -> TcM (TidyEnv, SDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TidyEnv
    env, SDoc
    msg))

    -- | Variant of 'addLandmarkErrCtxt' that allows for monadic operations
    -- and tidying.
    addLandmarkErrCtxtM :: (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    {-# INLINE addLandmarkErrCtxtM #-}  -- Note [Inlining addErrCtxt]
    addLandmarkErrCtxtM :: forall a. (TidyEnv -> TcM (TidyEnv, SDoc)) -> TcM a -> TcM a
    addLandmarkErrCtxtM TidyEnv -> TcM (TidyEnv, SDoc)
    ctxt = ErrCtxt -> TcM a -> TcM a
    forall a. ErrCtxt -> TcM a -> TcM a
    pushCtxt (Bool
    True, TidyEnv -> TcM (TidyEnv, SDoc)
    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 HsExpansion] in GHC.Hs.Expr
    updCtxt :: ErrCtxt -> TcLclEnv -> TcLclEnv
    updCtxt ErrCtxt
    ctxt env :: TcLclEnv
    env@(TcLclEnv { tcl_ctxt :: TcLclEnv -> [ErrCtxt]
    tcl_ctxt = [ErrCtxt]
    ctxts, tcl_in_gen_code :: TcLclEnv -> Bool
    tcl_in_gen_code = Bool
    in_gen })
      | Bool
    in_gen    = TcLclEnv
    env
      | Bool
    otherwise = TcLclEnv
    env { tcl_ctxt :: [ErrCtxt]
    tcl_ctxt = ErrCtxt
    ctxt ErrCtxt -> [ErrCtxt] -> [ErrCtxt]
    forall a. a -> [a] -> [a]
    : [ErrCtxt]
    ctxts }

    popErrCtxt :: TcM a -> TcM a
    popErrCtxt :: forall a. TcM a -> TcM a
    popErrCtxt = (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 (\ env :: TcLclEnv
    env@(TcLclEnv { tcl_ctxt :: TcLclEnv -> [ErrCtxt]
    tcl_ctxt = [ErrCtxt]
    ctxt }) ->
                              TcLclEnv
    env { tcl_ctxt :: [ErrCtxt]
    tcl_ctxt = [ErrCtxt] -> [ErrCtxt]
    forall {a}. [a] -> [a]
    pop [ErrCtxt]
    ctxt })
               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 { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; CtLoc -> TcM CtLoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CtLoc { ctl_origin :: CtOrigin
    ctl_origin = CtOrigin
    origin
                           , ctl_env :: TcLclEnv
    ctl_env    = TcLclEnv
    env
                           , ctl_t_or_k :: Maybe TypeOrKind
    ctl_t_or_k = Maybe TypeOrKind
    t_or_k
                           , ctl_depth :: SubGoalDepth
    ctl_depth  = SubGoalDepth
    initialSubGoalDepth }) }

    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 -> TcLclEnv
    ctl_env = TcLclEnv
    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 -> TcLclEnv
    env { tcl_loc :: RealSrcSpan
    tcl_loc   = TcLclEnv -> RealSrcSpan
    tcl_loc TcLclEnv
    lcl
                               , tcl_bndrs :: TcBinderStack
    tcl_bndrs = TcLclEnv -> TcBinderStack
    tcl_bndrs TcLclEnv
    lcl
                               , tcl_ctxt :: [ErrCtxt]
    tcl_ctxt  = TcLclEnv -> [ErrCtxt]
    tcl_ctxt TcLclEnv
    lcl })
                  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 IOEnvFailure r
    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
           ; Maybe r -> TcRn (Maybe r)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (case Either IOEnvFailure r
    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 { IORef WantedConstraints
    lie_var <- WantedConstraints
    -> TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef WantedConstraints
    emptyWC
           ; r
    res <- (TcLclEnv -> TcLclEnv) -> TcM r -> TcM r
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\ TcLclEnv
    env -> TcLclEnv
    env { tcl_lie :: IORef WantedConstraints
    tcl_lie = IORef WantedConstraints
    lie_var }) (TcM r -> TcM r) -> TcM r -> TcM r
    forall a b. (a -> b) -> a -> b
    $
                    TcM r
    thing_inside
           ; WantedConstraints
    lie <- IORef WantedConstraints
    -> TcRnIf TcGblEnv TcLclEnv WantedConstraints
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef WantedConstraints
    lie_var
           ; (r, WantedConstraints) -> TcM (r, WantedConstraints)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (r
    res, WantedConstraints
    lie) }

    capture_messages :: TcM r -> TcM (r, Messages DecoratedSDoc)
    -- capture_messages simply captures and returns the
    --                  errors arnd 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 DecoratedSDoc)
    capture_messages TcM r
    thing_inside
      = do { IORef (Messages DecoratedSDoc)
    msg_var <- Messages DecoratedSDoc -> TcRn (IORef (Messages DecoratedSDoc))
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef Messages DecoratedSDoc
    forall e. Messages e
    emptyMessages
           ; r
    res     <- IORef (Messages DecoratedSDoc) -> TcM r -> TcM r
    forall a. IORef (Messages DecoratedSDoc) -> TcRn a -> TcRn a
    setErrsVar IORef (Messages DecoratedSDoc)
    msg_var TcM r
    thing_inside
           ; Messages DecoratedSDoc
    msgs    <- IORef (Messages DecoratedSDoc)
    -> TcRnIf TcGblEnv TcLclEnv (Messages DecoratedSDoc)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef (Messages DecoratedSDoc)
    msg_var
           ; (r, Messages DecoratedSDoc) -> TcM (r, Messages DecoratedSDoc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (r
    res, Messages DecoratedSDoc
    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 { ((Maybe a
    mb_res, WantedConstraints
    lie), Messages DecoratedSDoc
    msgs) <- TcM (Maybe a, WantedConstraints)
    -> TcM ((Maybe a, WantedConstraints), Messages DecoratedSDoc)
    forall r. TcM r -> TcM (r, Messages DecoratedSDoc)
    capture_messages    (TcM (Maybe a, WantedConstraints)
     -> TcM ((Maybe a, WantedConstraints), Messages DecoratedSDoc))
    -> TcM (Maybe a, WantedConstraints)
    -> TcM ((Maybe a, WantedConstraints), Messages DecoratedSDoc)
    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
           ; Messages DecoratedSDoc -> TcM ()
    addMessages Messages DecoratedSDoc
    msgs

           ; case Maybe a
    mb_res of
               Maybe a
    Nothing  -> do { WantedConstraints -> TcM ()
    emitConstraints (WantedConstraints -> WantedConstraints
    dropMisleading WantedConstraints
    lie)
                              ; TcRn (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 DecoratedSDoc -> Bool
    forall e. Messages e -> Bool
    errorsFound Messages DecoratedSDoc
    msgs
                                              Bool -> Bool -> Bool
    || WantedConstraints -> Bool
    insolubleWC WantedConstraints
    lie
                              ; (a, Bool) -> TcRn (a, Bool)
    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 { (Maybe a
    mb_res, WantedConstraints
    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]
           ; let lie_to_keep :: WantedConstraints
    lie_to_keep = case Maybe a
    mb_res of
                                 Maybe a
    Nothing -> WantedConstraints -> WantedConstraints
    dropMisleading WantedConstraints
    lie
                                 Just {} -> WantedConstraints
    lie

           ; (Maybe a, WantedConstraints) -> TcM (Maybe a, WantedConstraints)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe a
    mb_res, WantedConstraints
    lie_to_keep) }

    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 { (Maybe a
    mb_res, WantedConstraints
    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 Maybe a
    mb_res of
               Maybe a
    Nothing  -> do { WantedConstraints -> TcM ()
    emitConstraints WantedConstraints
    lie; TcM (a, WantedConstraints)
    forall env a. IOEnv env a
    failM }
               Just a
    res -> (a, WantedConstraints) -> TcM (a, WantedConstraints)
    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 { TcLclEnv
    env0 <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; IORef UsageEnv
    local_usage_ref <- UsageEnv -> TcRnIf TcGblEnv TcLclEnv (IORef UsageEnv)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef UsageEnv
    zeroUE
           ; let env1 :: TcLclEnv
    env1 = TcLclEnv
    env0 { tcl_usage :: IORef UsageEnv
    tcl_usage = IORef UsageEnv
    local_usage_ref }
           ; a
    result <- TcLclEnv -> TcM a -> TcM a
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv TcLclEnv
    env1 TcM a
    thing_inside
           ; UsageEnv
    local_usage <- IORef UsageEnv -> TcRnIf TcGblEnv TcLclEnv UsageEnv
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef UsageEnv
    local_usage_ref
           ; (UsageEnv, a) -> TcM (UsageEnv, a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UsageEnv
    local_usage,a
    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. Type -> TcM a -> TcM a
    tcScalingUsage Type
    mult TcM a
    thing_inside
      = do { (UsageEnv
    usage, a
    result) <- TcM a -> TcM (UsageEnv, a)
    forall a. TcM a -> TcM (UsageEnv, a)
    tcCollectingUsage TcM a
    thing_inside
           ; FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "tcScalingUsage" (Type -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Type
    mult)
           ; UsageEnv -> TcM ()
    tcEmitBindingUsage (UsageEnv -> TcM ()) -> UsageEnv -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ Type -> UsageEnv -> UsageEnv
    scaleUE Type
    mult UsageEnv
    usage
           ; a -> TcM a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    result }

    tcEmitBindingUsage :: UsageEnv -> TcM ()
    tcEmitBindingUsage :: UsageEnv -> TcM ()
    tcEmitBindingUsage UsageEnv
    ue
      = do { TcLclEnv
    lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; let usage :: IORef UsageEnv
    usage = TcLclEnv -> IORef UsageEnv
    tcl_usage TcLclEnv
    lcl_env
           ; IORef UsageEnv -> (UsageEnv -> UsageEnv) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef UsageEnv
    usage (UsageEnv -> UsageEnv -> UsageEnv
    addUE UsageEnv
    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 { (Maybe r
    mb_r, WantedConstraints
    lie) <- TcRn r -> TcM (Maybe r, WantedConstraints)
    forall a. TcM a -> TcM (Maybe a, WantedConstraints)
    tryCaptureConstraints TcRn r
    thing_inside
           ; WantedConstraints -> TcM ()
    emitConstraints WantedConstraints
    lie

           -- Debug trace
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Maybe r -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe r
    mb_r) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "attemptM recovering with insoluble constraints" (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
                     (WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    lie)

           ; Maybe r -> TcRn (Maybe r)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe r
    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 { Maybe r
    mb_res <- TcRn r -> TcRn (Maybe r)
    forall r. TcRn r -> TcRn (Maybe r)
    attemptM TcRn r
    thing ;
             case Maybe r
    mb_res of
               Maybe r
    Nothing  -> TcRn r
    recover
               Just r
    res -> r -> TcRn r
    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 { [Maybe b]
    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)
    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
           ; [b] -> TcRn [b]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [b
    r | Just b
    r <- [Maybe b]
    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 { [Maybe b]
    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)
    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
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ((Maybe b -> Bool) -> [Maybe b] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any Maybe b -> Bool
    forall a. Maybe a -> Bool
    isNothing [Maybe b]
    mb_rs) TcM ()
    forall env a. IOEnv env a
    failM
           ; [b] -> TcRn [b]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [b
    r | Just b
    r <- [Maybe b]
    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 (m :: * -> *) a. Monad m => a -> m a
    return b
    acc
    foldAndRecoverM b -> a -> TcRn b
    f b
    acc (a
    x:[a]
    xs) =
                              do { Maybe b
    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 Maybe b
    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 DecoratedSDoc)
    -- (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 DecoratedSDoc)
    tryTc TcRn a
    thing_inside
     = TcM (Maybe a) -> TcM (Maybe a, Messages DecoratedSDoc)
    forall r. TcM r -> TcM (r, Messages DecoratedSDoc)
    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 { IORef (Messages DecoratedSDoc)
    errs_var <- Messages DecoratedSDoc -> TcRn (IORef (Messages DecoratedSDoc))
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef Messages DecoratedSDoc
    forall e. Messages e
    emptyMessages
          ; IORef (Messages DecoratedSDoc) -> TcRn a -> TcRn a
    forall a. IORef (Messages DecoratedSDoc) -> TcRn a -> TcRn a
    setErrsVar IORef (Messages DecoratedSDoc)
    errs_var TcRn a
    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 TcM r
    thing_inside
      = do { ((Maybe r
    mb_res, WantedConstraints
    lie), Messages DecoratedSDoc
    msgs) <- TcM (Maybe r, WantedConstraints)
    -> TcM ((Maybe r, WantedConstraints), Messages DecoratedSDoc)
    forall r. TcM r -> TcM (r, Messages DecoratedSDoc)
    capture_messages    (TcM (Maybe r, WantedConstraints)
     -> TcM ((Maybe r, WantedConstraints), Messages DecoratedSDoc))
    -> TcM (Maybe r, WantedConstraints)
    -> TcM ((Maybe r, WantedConstraints), Messages DecoratedSDoc)
    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 Maybe r
    mb_res of
                Just r
    res | Bool -> Bool
    not (Messages DecoratedSDoc -> Bool
    forall e. Messages e -> Bool
    errorsFound Messages DecoratedSDoc
    msgs)
                         , Bool -> Bool
    not (WantedConstraints -> Bool
    insolubleWC WantedConstraints
    lie)
                  -> -- 'main' succeeded with no errors
                     do { Messages DecoratedSDoc -> TcM ()
    addMessages Messages DecoratedSDoc
    msgs  -- msgs might still have warnings
                        ; WantedConstraints -> TcM ()
    emitConstraints WantedConstraints
    lie
                        ; r -> TcM r
    forall (m :: * -> *) a. Monad m => a -> m a
    return r
    res }

                Maybe r
    _ -> -- 'main' failed, or produced an error message
                     TcM r
    recover     -- Discard all errors and warnings
                                 -- and unsolved constraints entirely
            }

    {-
    ************************************************************************
    *                                                                      *
                 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
    -}

    addErrTc :: SDoc -> TcM ()
    addErrTc :: SDoc -> TcM ()
    addErrTc SDoc
    err_msg = do { TidyEnv
    env0 <- TcM TidyEnv
    tcInitTidyEnv
                          ; (TidyEnv, SDoc) -> TcM ()
    addErrTcM (TidyEnv
    env0, SDoc
    err_msg) }

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

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

    failWithTc :: SDoc -> TcM a               -- Add an error message and fail
    failWithTc :: forall a. SDoc -> TcRn a
    failWithTc SDoc
    err_msg
      = SDoc -> TcM ()
    addErrTc SDoc
    err_msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    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, SDoc) -> TcM a   -- Add an error message and fail
    failWithTcM :: forall a. (TidyEnv, SDoc) -> TcM a
    failWithTcM (TidyEnv, SDoc)
    local_and_msg
      = (TidyEnv, SDoc) -> TcM ()
    addErrTcM (TidyEnv, SDoc)
    local_and_msg TcM ()
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    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 -> SDoc -> TcM ()         -- Check that the boolean is true
    checkTc :: Bool -> SDoc -> TcM ()
    checkTc Bool
    True  SDoc
    _   = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkTc Bool
    False SDoc
    err = SDoc -> TcM ()
    forall a. SDoc -> TcRn a
    failWithTc SDoc
    err

    checkTcM :: Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM :: Bool -> (TidyEnv, SDoc) -> TcM ()
    checkTcM Bool
    True  (TidyEnv, SDoc)
    _   = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
    checkTcM Bool
    False (TidyEnv, SDoc)
    err = (TidyEnv, SDoc) -> TcM ()
    forall a. (TidyEnv, SDoc) -> TcM a
    failWithTcM (TidyEnv, SDoc)
    err

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

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

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

    -- | Display a warning if a condition is met,
    --   and the warning is enabled
    warnIfFlag :: WarningFlag -> Bool -> SDoc -> TcRn ()
    warnIfFlag :: WarningFlag -> Bool -> SDoc -> TcM ()
    warnIfFlag WarningFlag
    warn_flag Bool
    is_bad SDoc
    msg
      = do { Bool
    warn_on <- WarningFlag -> TcRn Bool
    forall gbl lcl. WarningFlag -> TcRnIf gbl lcl Bool
    woptM WarningFlag
    warn_flag
           ; Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool
    warn_on Bool -> Bool -> Bool
    && Bool
    is_bad) (TcM () -> TcM ()) -> TcM () -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             WarnReason -> SDoc -> TcM ()
    addWarn (WarningFlag -> WarnReason
    Reason WarningFlag
    warn_flag) SDoc
    msg }

    -- | Display a warning if a condition is met.
    warnIf :: Bool -> SDoc -> TcRn ()
    warnIf :: Bool -> SDoc -> TcM ()
    warnIf Bool
    is_bad SDoc
    msg
      = Bool -> TcM () -> TcM ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    is_bad (WarnReason -> SDoc -> TcM ()
    addWarn WarnReason
    NoReason SDoc
    msg)

    -- | Display a warning if a condition is met.
    warnTc :: WarnReason -> Bool -> SDoc -> TcM ()
    warnTc :: WarnReason -> Bool -> SDoc -> TcM ()
    warnTc WarnReason
    reason Bool
    warn_if_true SDoc
    warn_msg
      | Bool
    warn_if_true = WarnReason -> SDoc -> TcM ()
    addWarnTc WarnReason
    reason SDoc
    warn_msg
      | Bool
    otherwise    = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Display a warning if a condition is met.
    warnTcM :: WarnReason -> Bool -> (TidyEnv, SDoc) -> TcM ()
    warnTcM :: WarnReason -> Bool -> (TidyEnv, SDoc) -> TcM ()
    warnTcM WarnReason
    reason Bool
    warn_if_true (TidyEnv, SDoc)
    warn_msg
      | Bool
    warn_if_true = WarnReason -> (TidyEnv, SDoc) -> TcM ()
    addWarnTcM WarnReason
    reason (TidyEnv, SDoc)
    warn_msg
      | Bool
    otherwise    = () -> TcM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Display a warning in the current context.
    addWarnTc :: WarnReason -> SDoc -> TcM ()
    addWarnTc :: WarnReason -> SDoc -> TcM ()
    addWarnTc WarnReason
    reason SDoc
    msg
     = do { TidyEnv
    env0 <- TcM TidyEnv
    tcInitTidyEnv ;
          WarnReason -> (TidyEnv, SDoc) -> TcM ()
    addWarnTcM WarnReason
    reason (TidyEnv
    env0, SDoc
    msg) }

    -- | Display a warning in a given context.
    addWarnTcM :: WarnReason -> (TidyEnv, SDoc) -> TcM ()
    addWarnTcM :: WarnReason -> (TidyEnv, SDoc) -> TcM ()
    addWarnTcM WarnReason
    reason (TidyEnv
    env0, SDoc
    msg)
     = do { [ErrCtxt]
    ctxt <- TcM [ErrCtxt]
    getErrCtxt ;
            SDoc
    err_info <- TidyEnv -> [ErrCtxt] -> TcRn SDoc
    mkErrInfo TidyEnv
    env0 [ErrCtxt]
    ctxt ;
            WarnReason -> SDoc -> SDoc -> TcM ()
    add_warn WarnReason
    reason SDoc
    msg SDoc
    err_info }

    -- | Display a warning for the current source location.
    addWarn :: WarnReason -> SDoc -> TcRn ()
    addWarn :: WarnReason -> SDoc -> TcM ()
    addWarn WarnReason
    reason SDoc
    msg = WarnReason -> SDoc -> SDoc -> TcM ()
    add_warn WarnReason
    reason SDoc
    msg SDoc
    Outputable.empty

    -- | Display a warning for a given source location.
    addWarnAt :: WarnReason -> SrcSpan -> SDoc -> TcRn ()
    addWarnAt :: WarnReason -> SrcSpan -> SDoc -> TcM ()
    addWarnAt WarnReason
    reason SrcSpan
    loc SDoc
    msg = WarnReason -> SrcSpan -> SDoc -> SDoc -> TcM ()
    add_warn_at WarnReason
    reason SrcSpan
    loc SDoc
    msg SDoc
    Outputable.empty

    -- | Display a warning, with an optional flag, for the current source
    -- location.
    add_warn :: WarnReason -> SDoc -> SDoc -> TcRn ()
    add_warn :: WarnReason -> SDoc -> SDoc -> TcM ()
    add_warn WarnReason
    reason SDoc
    msg SDoc
    extra_info
      = do { SrcSpan
    loc <- TcRn SrcSpan
    getSrcSpanM
           ; WarnReason -> SrcSpan -> SDoc -> SDoc -> TcM ()
    add_warn_at WarnReason
    reason SrcSpan
    loc SDoc
    msg SDoc
    extra_info }

    -- | Display a warning, with an optional flag, for a given location.
    add_warn_at :: WarnReason -> SrcSpan -> SDoc -> SDoc -> TcRn ()
    add_warn_at :: WarnReason -> SrcSpan -> SDoc -> SDoc -> TcM ()
    add_warn_at WarnReason
    reason SrcSpan
    loc SDoc
    msg SDoc
    extra_info
      = do { PrintUnqualified
    printer <- TcRn PrintUnqualified
    getPrintUnqualified ;
             let { warn :: MsgEnvelope DecoratedSDoc
    warn = SrcSpan
    -> PrintUnqualified -> SDoc -> SDoc -> MsgEnvelope DecoratedSDoc
    mkLongWarnMsg SrcSpan
    loc PrintUnqualified
    printer
                                        SDoc
    msg SDoc
    extra_info } ;
             WarnReason -> MsgEnvelope DecoratedSDoc -> TcM ()
    reportWarning WarnReason
    reason MsgEnvelope DecoratedSDoc
    warn }

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

    add_err_tcm :: TidyEnv -> SDoc -> SrcSpan
                -> [ErrCtxt]
                -> TcM ()
    add_err_tcm :: TidyEnv -> SDoc -> SrcSpan -> [ErrCtxt] -> TcM ()
    add_err_tcm TidyEnv
    tidy_env SDoc
    err_msg SrcSpan
    loc [ErrCtxt]
    ctxt
     = do { SDoc
    err_info <- TidyEnv -> [ErrCtxt] -> TcRn SDoc
    mkErrInfo TidyEnv
    tidy_env [ErrCtxt]
    ctxt ;
            SrcSpan -> SDoc -> SDoc -> TcM ()
    addLongErrAt SrcSpan
    loc SDoc
    err_msg SDoc
    err_info }

    mkErrInfo :: TidyEnv -> [ErrCtxt] -> TcM SDoc
    -- Tidy the error info, trimming excessive contexts
    mkErrInfo :: TidyEnv -> [ErrCtxt] -> TcRn SDoc
    mkErrInfo 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] -> TcRn SDoc
    go Bool
    False Int
    0 TidyEnv
    env [ErrCtxt]
    ctxts
     where
       go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcM SDoc
       go :: Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcRn SDoc
    go Bool
    _ Int
    _ TidyEnv
    _   [] = SDoc -> TcRn SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return SDoc
    empty
       go Bool
    dbg Int
    n TidyEnv
    env ((Bool
    is_landmark, TidyEnv -> TcM (TidyEnv, SDoc)
    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 { (TidyEnv
    env', SDoc
    msg) <- TidyEnv -> TcM (TidyEnv, SDoc)
    ctxt TidyEnv
    env
              ; let n' :: Int
    n' = if Bool
    is_landmark then Int
    n else Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1
              ; SDoc
    rest <- Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcRn SDoc
    go Bool
    dbg Int
    n' TidyEnv
    env' [ErrCtxt]
    ctxts
              ; SDoc -> TcRn SDoc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SDoc
    msg SDoc -> SDoc -> SDoc
    $$ SDoc
    rest) }
         | Bool
    otherwise
         = Bool -> Int -> TidyEnv -> [ErrCtxt] -> TcRn SDoc
    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 (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 :: Bag EvBind
    tcg_ev_binds = TcGblEnv -> Bag EvBind
    tcg_ev_binds TcGblEnv
    tcg_env
                                                   Bag EvBind -> Bag EvBind -> Bag EvBind
    forall a. Bag a -> Bag a -> Bag a
    `unionBags` Bag EvBind
    new_ev_binds }

    newTcEvBinds :: TcM EvBindsVar
    newTcEvBinds :: TcM EvBindsVar
    newTcEvBinds = do { TcRef EvBindMap
    binds_ref <- EvBindMap -> TcRnIf TcGblEnv TcLclEnv (TcRef EvBindMap)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef EvBindMap
    emptyEvBindMap
                      ; TcRef VarSet
    tcvs_ref  <- VarSet -> TcRnIf TcGblEnv TcLclEnv (TcRef VarSet)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef VarSet
    emptyVarSet
                      ; Unique
    uniq <- TcRnIf TcGblEnv TcLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
                      ; FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "newTcEvBinds" (FilePath -> SDoc
    text FilePath
    "unique =" SDoc -> SDoc -> SDoc
    <+> Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unique
    uniq)
                      ; EvBindsVar -> TcM EvBindsVar
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvBindsVar { ebv_binds :: TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    binds_ref
                                           , ebv_tcvs :: TcRef VarSet
    ebv_tcvs = TcRef VarSet
    tcvs_ref
                                           , ebv_uniq :: Unique
    ebv_uniq = Unique
    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 { TcRef VarSet
    tcvs_ref  <- VarSet -> TcRnIf TcGblEnv TcLclEnv (TcRef VarSet)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef VarSet
    emptyVarSet
           ; Unique
    uniq <- TcRnIf TcGblEnv TcLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
           ; FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "newNoTcEvBinds" (FilePath -> SDoc
    text FilePath
    "unique =" SDoc -> SDoc -> SDoc
    <+> Unique -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Unique
    uniq)
           ; EvBindsVar -> TcM EvBindsVar
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoEvBindsVar { ebv_tcvs :: TcRef VarSet
    ebv_tcvs = TcRef VarSet
    tcvs_ref
                                  , ebv_uniq :: Unique
    ebv_uniq = Unique
    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 { TcRef EvBindMap
    binds_ref <- EvBindMap -> TcRnIf TcGblEnv TcLclEnv (TcRef EvBindMap)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef EvBindMap
    emptyEvBindMap
           ; TcRef VarSet
    tcvs_ref  <- VarSet -> TcRnIf TcGblEnv TcLclEnv (TcRef VarSet)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef VarSet
    emptyVarSet
           ; EvBindsVar -> TcM EvBindsVar
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvBindsVar
    ebv { ebv_binds :: TcRef EvBindMap
    ebv_binds = TcRef EvBindMap
    binds_ref
                         , ebv_tcvs :: TcRef VarSet
    ebv_tcvs = TcRef VarSet
    tcvs_ref }) }
    cloneEvBindsVar ebv :: EvBindsVar
    ebv@(CoEvBindsVar {})
      = do { TcRef VarSet
    tcvs_ref  <- VarSet -> TcRnIf TcGblEnv TcLclEnv (TcRef VarSet)
    forall a gbl lcl. a -> TcRnIf gbl lcl (TcRef a)
    newTcRef VarSet
    emptyVarSet
           ; EvBindsVar -> TcM EvBindsVar
    forall (m :: * -> *) a. Monad m => a -> m a
    return (EvBindsVar
    ebv { ebv_tcvs :: TcRef VarSet
    ebv_tcvs = TcRef VarSet
    tcvs_ref }) }

    getTcEvTyCoVars :: EvBindsVar -> TcM TyCoVarSet
    getTcEvTyCoVars :: EvBindsVar -> TcM VarSet
    getTcEvTyCoVars EvBindsVar
    ev_binds_var
      = TcRef VarSet -> TcM VarSet
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef (EvBindsVar -> TcRef VarSet
    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 a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef TcRef EvBindMap
    ev_ref
    getTcEvBindsMap (CoEvBindsVar {})
      = EvBindMap -> TcM EvBindMap
    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 a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef TcRef EvBindMap
    ev_ref EvBindMap
    binds
    setTcEvBindsMap v :: EvBindsVar
    v@(CoEvBindsVar {}) EvBindMap
    ev_binds
      | EvBindMap -> Bool
    isEmptyEvBindMap EvBindMap
    ev_binds
      = () -> TcM ()
    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
    $$ EvBindMap -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBindMap
    ev_binds)

    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 { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "addTcEvBind" (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
    $$
                                     EvBind -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr EvBind
    ev_bind
           ; EvBindMap
    bnds <- TcRef EvBindMap -> TcM EvBindMap
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef TcRef EvBindMap
    ev_ref
           ; TcRef EvBindMap -> EvBindMap -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef TcRef EvBindMap
    ev_ref (EvBindMap -> EvBind -> EvBindMap
    extendEvBinds EvBindMap
    bnds EvBind
    ev_bind) }
    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
    $$ 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 { TcGblEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
         ; let dfun_n_var :: IORef OccSet
    dfun_n_var = TcGblEnv -> IORef OccSet
    tcg_dfun_n TcGblEnv
    env
         ; OccSet
    set <- IORef OccSet -> TcRnIf TcGblEnv TcLclEnv OccSet
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef OccSet
    dfun_n_var
         ; let occ :: OccName
    occ = OccSet -> OccName
    fn OccSet
    set
         ; IORef OccSet -> OccSet -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef IORef OccSet
    dfun_n_var (OccSet -> OccName -> OccSet
    extendOccSet OccSet
    set OccName
    occ)
         ; OccName -> TcM OccName
    forall (m :: * -> *) a. Monad m => a -> m a
    return OccName
    occ }

    getConstraintVar :: TcM (TcRef WantedConstraints)
    getConstraintVar :: TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; IORef WantedConstraints
    -> TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLclEnv -> IORef WantedConstraints
    tcl_lie TcLclEnv
    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 :: IORef WantedConstraints
    tcl_lie = IORef WantedConstraints
    lie_var })

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

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

    emitSimple :: Ct -> TcM ()
    emitSimple :: Ct -> TcM ()
    emitSimple Ct
    ct
      = do { IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar ;
             IORef WantedConstraints
    -> (WantedConstraints -> WantedConstraints) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef WantedConstraints
    lie_var (WantedConstraints -> Bag Ct -> WantedConstraints
    `addSimples` Ct -> Bag Ct
    forall a. a -> Bag a
    unitBag Ct
    ct) }

    emitSimples :: Cts -> TcM ()
    emitSimples :: Bag Ct -> TcM ()
    emitSimples Bag Ct
    cts
      = do { IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar ;
             IORef WantedConstraints
    -> (WantedConstraints -> WantedConstraints) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef WantedConstraints
    lie_var (WantedConstraints -> Bag Ct -> WantedConstraints
    `addSimples` Bag Ct
    cts) }

    emitImplication :: Implication -> TcM ()
    emitImplication :: Implication -> TcM ()
    emitImplication Implication
    ct
      = do { IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar ;
             IORef WantedConstraints
    -> (WantedConstraints -> WantedConstraints) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef WantedConstraints
    lie_var (WantedConstraints -> Bag Implication -> WantedConstraints
    `addImplics` Implication -> Bag Implication
    forall a. a -> Bag a
    unitBag Implication
    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 { IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar ;
             IORef WantedConstraints
    -> (WantedConstraints -> WantedConstraints) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef WantedConstraints
    lie_var (WantedConstraints -> Bag Implication -> WantedConstraints
    `addImplics` Bag Implication
    ct) }

    emitInsoluble :: Ct -> TcM ()
    emitInsoluble :: Ct -> TcM ()
    emitInsoluble Ct
    ct
      = do { FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "emitInsoluble" (Ct -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Ct
    ct)
           ; IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar
           ; IORef WantedConstraints
    -> (WantedConstraints -> WantedConstraints) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef WantedConstraints
    lie_var (WantedConstraints -> Bag Ct -> WantedConstraints
    `addInsols` Ct -> Bag Ct
    forall a. a -> Bag a
    unitBag Ct
    ct) }

    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)
           ; IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar
           ; IORef WantedConstraints
    -> (WantedConstraints -> WantedConstraints) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef WantedConstraints
    lie_var (WantedConstraints -> Bag Hole -> WantedConstraints
    `addHoles` Hole -> Bag Hole
    forall a. a -> Bag a
    unitBag Hole
    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)
           ; IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar
           ; IORef WantedConstraints
    -> (WantedConstraints -> WantedConstraints) -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef WantedConstraints
    lie_var (WantedConstraints -> Bag Hole -> WantedConstraints
    `addHoles` Bag Hole
    holes) }

    -- | 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 { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; let tclvl' :: TcLevel
    tclvl' = TcLevel -> TcLevel
    pushTcLevel (TcLclEnv -> TcLevel
    tcl_tclvl TcLclEnv
    env)
           ; FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "pushLevelAndCaptureConstraints {" (TcLevel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcLevel
    tclvl')
           ; (a
    res, WantedConstraints
    lie) <- TcLclEnv
    -> TcRnIf TcGblEnv TcLclEnv (a, WantedConstraints)
    -> TcRnIf TcGblEnv TcLclEnv (a, WantedConstraints)
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv (TcLclEnv
    env { tcl_tclvl :: TcLevel
    tcl_tclvl = TcLevel
    tclvl' }) (TcRnIf TcGblEnv TcLclEnv (a, WantedConstraints)
     -> TcRnIf TcGblEnv TcLclEnv (a, WantedConstraints))
    -> TcRnIf TcGblEnv TcLclEnv (a, WantedConstraints)
    -> TcRnIf TcGblEnv TcLclEnv (a, WantedConstraints)
    forall a b. (a -> b) -> a -> b
    $
                           TcM a -> TcRnIf TcGblEnv TcLclEnv (a, WantedConstraints)
    forall r. TcM r -> TcM (r, WantedConstraints)
    captureConstraints TcM a
    thing_inside
           ; FilePath -> SDoc -> TcM ()
    traceTc FilePath
    "pushLevelAndCaptureConstraints }" (TcLevel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr TcLevel
    tclvl')
           ; (TcLevel, WantedConstraints, a)
    -> TcM (TcLevel, WantedConstraints, a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLevel
    tclvl', WantedConstraints
    lie, a
    res) }

    pushTcLevelM_ :: TcM a -> TcM a
    pushTcLevelM_ :: forall a. TcM a -> TcM a
    pushTcLevelM_ TcM a
    x = (TcLclEnv -> TcLclEnv) -> TcM a -> TcM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\ TcLclEnv
    env -> TcLclEnv
    env { tcl_tclvl :: TcLevel
    tcl_tclvl = TcLevel -> TcLevel
    pushTcLevel (TcLclEnv -> TcLevel
    tcl_tclvl TcLclEnv
    env) }) TcM a
    x

    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 { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; let tclvl' :: TcLevel
    tclvl' = TcLevel -> TcLevel
    pushTcLevel (TcLclEnv -> TcLevel
    tcl_tclvl TcLclEnv
    env)
           ; a
    res <- TcLclEnv -> TcM a -> TcM a
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv (TcLclEnv
    env { tcl_tclvl :: TcLevel
    tcl_tclvl = TcLevel
    tclvl' })
                              TcM a
    thing_inside
           ; (TcLevel, a) -> TcM (TcLevel, a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLevel
    tclvl', a
    res) }

    -- Returns pushed TcLevel
    pushTcLevelsM :: Int -> TcM a -> TcM (a, TcLevel)
    pushTcLevelsM :: forall a. Int -> TcM a -> TcM (a, TcLevel)
    pushTcLevelsM Int
    num_levels TcM a
    thing_inside
      = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           ; let tclvl' :: TcLevel
    tclvl' = Int -> (TcLevel -> TcLevel) -> TcLevel -> TcLevel
    forall a. Int -> (a -> a) -> a -> a
    nTimes Int
    num_levels TcLevel -> TcLevel
    pushTcLevel (TcLclEnv -> TcLevel
    tcl_tclvl TcLclEnv
    env)
           ; a
    res <- TcLclEnv -> TcM a -> TcM a
    forall lcl' gbl a lcl.
    lcl' -> TcRnIf gbl lcl' a -> TcRnIf gbl lcl a
    setLclEnv (TcLclEnv
    env { tcl_tclvl :: TcLevel
    tcl_tclvl = TcLevel
    tclvl' }) (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
                    TcM a
    thing_inside
           ; (a, TcLevel) -> TcM (a, TcLevel)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    res, TcLevel
    tclvl') }

    getTcLevel :: TcM TcLevel
    getTcLevel :: TcM TcLevel
    getTcLevel = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
                    ; TcLevel -> TcM TcLevel
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLclEnv -> TcLevel
    tcl_tclvl TcLclEnv
    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 (\TcLclEnv
    env -> TcLclEnv
    env { tcl_tclvl :: TcLevel
    tcl_tclvl = TcLevel
    tclvl }) TcM a
    thing_inside

    isTouchableTcM :: TcTyVar -> TcM Bool
    isTouchableTcM :: Id -> TcRn Bool
    isTouchableTcM Id
    tv
      = do { TcLevel
    lvl <- TcM TcLevel
    getTcLevel
           ; Bool -> TcRn Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLevel -> Id -> Bool
    isTouchableMetaTyVar TcLevel
    lvl Id
    tv) }

    getLclTypeEnv :: TcM TcTypeEnv
    getLclTypeEnv :: TcM TcTypeEnv
    getLclTypeEnv = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; TcTypeEnv -> TcM TcTypeEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLclEnv -> TcTypeEnv
    tcl_env TcLclEnv
    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 TcLclEnv -> TcLclEnv
    upd TcM a
    thing_inside
      where
        upd :: TcLclEnv -> TcLclEnv
    upd TcLclEnv
    env = TcLclEnv
    env { tcl_env :: TcTypeEnv
    tcl_env = TcLclEnv -> TcTypeEnv
    tcl_env TcLclEnv
    lcl_env }

    traceTcConstraints :: String -> TcM ()
    traceTcConstraints :: FilePath -> TcM ()
    traceTcConstraints FilePath
    msg
      = do { IORef WantedConstraints
    lie_var <- TcRnIf TcGblEnv TcLclEnv (IORef WantedConstraints)
    getConstraintVar
           ; WantedConstraints
    lie     <- IORef WantedConstraints
    -> TcRnIf TcGblEnv TcLclEnv WantedConstraints
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef WantedConstraints
    lie_var
           ; DumpFlag -> SDoc -> TcM ()
    traceOptTcRn DumpFlag
    Opt_D_dump_tc_trace (SDoc -> TcM ()) -> SDoc -> TcM ()
    forall a b. (a -> b) -> a -> b
    $
             SDoc -> Int -> SDoc -> SDoc
    hang (FilePath -> SDoc
    text (FilePath
    msg FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    ": LIE:")) Int
    2 (WantedConstraints -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr WantedConstraints
    lie)
           }

    data IsExtraConstraint = YesExtraConstraint
                           | NoExtraConstraint

    instance Outputable IsExtraConstraint where
      ppr :: IsExtraConstraint -> SDoc
    ppr IsExtraConstraint
    YesExtraConstraint = FilePath -> SDoc
    text FilePath
    "YesExtraConstraint"
      ppr IsExtraConstraint
    NoExtraConstraint  = FilePath -> SDoc
    text FilePath
    "NoExtraConstraint"

    emitAnonTypeHole :: IsExtraConstraint
                     -> TcTyVar -> TcM ()
    emitAnonTypeHole :: IsExtraConstraint -> Id -> TcM ()
    emitAnonTypeHole IsExtraConstraint
    extra_constraints Id
    tv
      = do { CtLoc
    ct_loc <- CtOrigin -> Maybe TypeOrKind -> TcM CtLoc
    getCtLocM (OccName -> CtOrigin
    TypeHoleOrigin OccName
    occ) Maybe TypeOrKind
    forall a. Maybe a
    Nothing
           ; let hole :: Hole
    hole = Hole { hole_sort :: HoleSort
    hole_sort = HoleSort
    sort
                             , hole_occ :: OccName
    hole_occ  = OccName
    occ
                             , hole_ty :: Type
    hole_ty   = Id -> Type
    mkTyVarTy Id
    tv
                             , hole_loc :: CtLoc
    hole_loc  = CtLoc
    ct_loc }
           ; Hole -> TcM ()
    emitHole Hole
    hole }
      where
        occ :: OccName
    occ = FilePath -> OccName
    mkTyVarOcc 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 { CtLoc
    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 = Hole { hole_sort :: HoleSort
    hole_sort = HoleSort
    TypeHole
                             , hole_occ :: OccName
    hole_occ  = OccName
    occ
                             , hole_ty :: Type
    hole_ty   = Id -> Type
    mkTyVarTy Id
    tv
                             , hole_loc :: CtLoc
    hole_loc  = CtLoc
    ct_loc }
           ; Hole -> TcM ()
    emitHole Hole
    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 interrupte 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.  But we may /also/ end up taking
      constraints built at some inner level, and emitting them 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 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.

    However 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.

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

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

    recordThSpliceUse :: TcM ()
    recordThSpliceUse :: TcM ()
    recordThSpliceUse = do { TcGblEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv; IORef Bool -> Bool -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef (TcGblEnv -> IORef Bool
    tcg_th_splice_used TcGblEnv
    env) Bool
    True }

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

    getStage :: TcM ThStage
    getStage :: TcM ThStage
    getStage = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; ThStage -> TcM ThStage
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLclEnv -> ThStage
    tcl_th_ctxt TcLclEnv
    env) }

    getStageAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, ThLevel, ThStage))
    getStageAndBindLevel :: Name -> TcRn (Maybe (TopLevelFlag, Int, ThStage))
    getStageAndBindLevel Name
    name
      = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv;
           ; case ThBindEnv -> Name -> Maybe (TopLevelFlag, Int)
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv (TcLclEnv -> ThBindEnv
    tcl_th_bndrs TcLclEnv
    env) Name
    name of
               Maybe (TopLevelFlag, Int)
    Nothing                  -> Maybe (TopLevelFlag, Int, ThStage)
    -> TcRn (Maybe (TopLevelFlag, Int, ThStage))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (TopLevelFlag, Int, ThStage)
    forall a. Maybe a
    Nothing
               Just (TopLevelFlag
    top_lvl, Int
    bind_lvl) -> Maybe (TopLevelFlag, Int, ThStage)
    -> TcRn (Maybe (TopLevelFlag, Int, ThStage))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((TopLevelFlag, Int, ThStage) -> Maybe (TopLevelFlag, Int, ThStage)
    forall a. a -> Maybe a
    Just (TopLevelFlag
    top_lvl, Int
    bind_lvl, TcLclEnv -> ThStage
    tcl_th_ctxt TcLclEnv
    env)) }

    setStage :: ThStage -> TcM a -> TcRn a
    setStage :: forall a. ThStage -> TcM a -> TcM a
    setStage ThStage
    s = (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_th_ctxt :: ThStage
    tcl_th_ctxt = ThStage
    s })

    -- | 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 TcLclEnv
    lcl_env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
           IORef [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers_var <- (TcGblEnv -> IORef [(TcLclEnv, ThModFinalizers)])
    -> TcRnIf TcGblEnv TcLclEnv TcGblEnv
    -> IOEnv
         (Env TcGblEnv TcLclEnv) (IORef [(TcLclEnv, ThModFinalizers)])
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap TcGblEnv -> IORef [(TcLclEnv, ThModFinalizers)]
    tcg_th_modfinalizers TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           IORef [(TcLclEnv, ThModFinalizers)]
    -> ([(TcLclEnv, ThModFinalizers)] -> [(TcLclEnv, ThModFinalizers)])
    -> TcM ()
    forall a gbl lcl. TcRef a -> (a -> a) -> TcRnIf gbl lcl ()
    updTcRef IORef [(TcLclEnv, ThModFinalizers)]
    th_modfinalizers_var (([(TcLclEnv, ThModFinalizers)] -> [(TcLclEnv, ThModFinalizers)])
     -> TcM ())
    -> ([(TcLclEnv, ThModFinalizers)] -> [(TcLclEnv, ThModFinalizers)])
    -> TcM ()
    forall a b. (a -> b) -> a -> b
    $ \[(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 :: WarningMessages -> TcM ()
    recordUnsafeInfer :: Bag (MsgEnvelope DecoratedSDoc) -> TcM ()
    recordUnsafeInfer Bag (MsgEnvelope DecoratedSDoc)
    warns =
        TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv TcRnIf TcGblEnv TcLclEnv TcGblEnv -> (TcGblEnv -> TcM ()) -> TcM ()
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \TcGblEnv
    env -> IORef (Bool, Bag (MsgEnvelope DecoratedSDoc))
    -> (Bool, Bag (MsgEnvelope DecoratedSDoc)) -> TcM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef (TcGblEnv -> IORef (Bool, Bag (MsgEnvelope DecoratedSDoc))
    tcg_safeInfer TcGblEnv
    env) (Bool
    False, Bag (MsgEnvelope DecoratedSDoc)
    warns)

    -- | 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
        Bool
    safeInf <- (Bool, Bag (MsgEnvelope DecoratedSDoc)) -> Bool
    forall a b. (a, b) -> a
    fst ((Bool, Bag (MsgEnvelope DecoratedSDoc)) -> Bool)
    -> IO (Bool, Bag (MsgEnvelope DecoratedSDoc)) -> IO Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IORef (Bool, Bag (MsgEnvelope DecoratedSDoc))
    -> IO (Bool, Bag (MsgEnvelope DecoratedSDoc))
    forall a. IORef a -> IO a
    readIORef (TcGblEnv -> IORef (Bool, Bag (MsgEnvelope DecoratedSDoc))
    tcg_safeInfer TcGblEnv
    tcg_env)
        SafeHaskellMode -> IO SafeHaskellMode
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SafeHaskellMode -> IO SafeHaskellMode)
    -> SafeHaskellMode -> IO SafeHaskellMode
    forall a b. (a -> b) -> a -> b
    $ case DynFlags -> SafeHaskellMode
    safeHaskell DynFlags
    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 :: Bool
    isSafeOverlap = Bool
    True }
                           in ClsInst
    inst { is_flag :: OverlapFlag
    is_flag = OverlapFlag
    new_flag }

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

    getLocalRdrEnv :: RnM LocalRdrEnv
    getLocalRdrEnv :: RnM LocalRdrEnv
    getLocalRdrEnv = do { TcLclEnv
    env <- TcRnIf TcGblEnv TcLclEnv TcLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; LocalRdrEnv -> RnM LocalRdrEnv
    forall (m :: * -> *) a. Monad m => a -> m a
    return (TcLclEnv -> LocalRdrEnv
    tcl_rdr TcLclEnv
    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 (\TcLclEnv
    env -> TcLclEnv
    env {tcl_rdr :: LocalRdrEnv
    tcl_rdr = 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  { TcGblEnv
    tcg_env <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; HscEnv
    hsc_env <- TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
              -- bangs to avoid leaking the envs (#19356)
            ; let !mod :: Module
    mod = TcGblEnv -> Module
    tcg_semantic_mod TcGblEnv
    tcg_env
                  !home_unit :: HomeUnit
    home_unit = HscEnv -> HomeUnit
    hsc_home_unit HscEnv
    hsc_env
                  -- When we are instantiating a signature, we DEFINITELY
                  -- do not want to knot tie.
                  is_instantiate :: Bool
    is_instantiate = HomeUnit -> Bool
    forall u. GenHomeUnit u -> Bool
    isHomeUnitInstantiating HomeUnit
    home_unit
            ; let { if_env :: IfGblEnv
    if_env = IfGblEnv {
                                if_doc :: SDoc
    if_doc = FilePath -> SDoc
    text FilePath
    "initIfaceTcRn",
                                if_rec_types :: Maybe (Module, IfG TypeEnv)
    if_rec_types =
                                    if Bool
    is_instantiate
                                        then Maybe (Module, IfG TypeEnv)
    forall a. Maybe a
    Nothing
                                        else (Module, IfG TypeEnv) -> Maybe (Module, IfG TypeEnv)
    forall a. a -> Maybe a
    Just (Module
    mod, IfG TypeEnv
    get_type_env)
                             }
                  ; get_type_env :: IfG TypeEnv
    get_type_env = IORef TypeEnv -> IfG TypeEnv
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef (TcGblEnv -> IORef TypeEnv
    tcg_type_env_var TcGblEnv
    tcg_env) }
            ; (IfGblEnv, ()) -> IfG a -> TcRn a
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (IfGblEnv
    if_env, ()) IfG a
    thing_inside }

    -- Used when sucking in a ModIface into a ModDetails to put in
    -- the HPT.  Notably, unlike initIfaceCheck, this does NOT use
    -- hsc_type_env_var (since we're not actually going to typecheck,
    -- so this variable will never get updated!)
    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
    text FilePath
    "initIfaceLoad",
                            if_rec_types :: Maybe (Module, IfG TypeEnv)
    if_rec_types = Maybe (Module, IfG TypeEnv)
    forall a. Maybe a
    Nothing
                        }
          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 rec_types :: Maybe (Module, IfG TypeEnv)
    rec_types = case HscEnv -> Maybe (Module, IORef TypeEnv)
    hsc_type_env_var HscEnv
    hsc_env of
                             Just (Module
    mod,IORef TypeEnv
    var) -> (Module, IfG TypeEnv) -> Maybe (Module, IfG TypeEnv)
    forall a. a -> Maybe a
    Just (Module
    mod, IORef TypeEnv -> IfG TypeEnv
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef TypeEnv
    var)
                             Maybe (Module, IORef TypeEnv)
    Nothing        -> Maybe (Module, IfG TypeEnv)
    forall a. Maybe a
    Nothing
              gbl_env :: IfGblEnv
    gbl_env = IfGblEnv {
                            if_doc :: SDoc
    if_doc = FilePath -> SDoc
    text FilePath
    "initIfaceCheck" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc,
                            if_rec_types :: Maybe (Module, IfG TypeEnv)
    if_rec_types = Maybe (Module, IfG TypeEnv)
    rec_types
                        }
          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 :: Maybe NameShape
    if_nsubst = NameShape -> Maybe NameShape
    forall a. a -> Maybe a
    Just NameShape
    nsubst }) IfL a
    thing_inside

    getIfModule :: IfL Module
    getIfModule :: IfL Module
    getIfModule = do { IfLclEnv
    env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; Module -> IfL Module
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IfLclEnv -> Module
    if_mod IfLclEnv
    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
        IfLclEnv
    env <- TcRnIf IfGblEnv IfLclEnv IfLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
        let full_msg :: SDoc
    full_msg = (IfLclEnv -> SDoc
    if_loc IfLclEnv
    env SDoc -> SDoc -> SDoc
    <> SDoc
    colon) SDoc -> SDoc -> SDoc
    $$ Int -> SDoc -> SDoc
    nest Int
    2 SDoc
    msg
        DynFlags
    dflags <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
        Logger
    logger <- IOEnv (Env IfGblEnv IfLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
        IO () -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (Logger -> LogAction
    putLogMsg Logger
    logger DynFlags
    dflags WarnReason
    NoReason Severity
    SevFatal
                 SrcSpan
    noSrcSpan (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    defaultErrStyle SDoc
    full_msg)
        IfL a
    forall env a. IOEnv env a
    failM

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

    -- | Run thing_inside in an interleaved thread.
    -- It shares everything with the parent thread, so this is DANGEROUS.
    --
    -- It returns Nothing if the computation fails
    --
    -- It's used for lazily type-checking interface
    -- signatures, which is pretty benign.
    --
    -- See Note [Masking exceptions in forkM_maybe]
    forkM_maybe :: SDoc -> IfL a -> IfL (Maybe a)
    forkM_maybe :: forall a. SDoc -> IfL a -> IfL (Maybe a)
    forkM_maybe SDoc
    doc IfL a
    thing_inside
     = IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    forall env a. IOEnv env a -> IOEnv env a
    unsafeInterleaveM (IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
     -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a))
    -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    forall a b. (a -> b) -> a -> b
    $ IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    forall env a. IOEnv env a -> IOEnv env a
    uninterruptibleMaskM_ (IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
     -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a))
    -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    forall a b. (a -> b) -> a -> b
    $
        do { SDoc -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall m n. SDoc -> TcRnIf m n ()
    traceIf (FilePath -> SDoc
    text FilePath
    "Starting fork {" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc)
           ; Either IOEnvFailure a
    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 :: SDoc
    if_loc = IfLclEnv -> SDoc
    if_loc IfLclEnv
    env SDoc -> SDoc -> SDoc
    $$ SDoc
    doc }) (IfL a -> IfL a) -> IfL a -> IfL a
    forall a b. (a -> b) -> a -> b
    $
                       IfL a
    thing_inside
           ; case Either IOEnvFailure a
    mb_res of
                Right a
    r  -> do  { SDoc -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall m n. SDoc -> TcRnIf m n ()
    traceIf (FilePath -> SDoc
    text FilePath
    "} ending fork" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc)
                                ; Maybe a -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Maybe a
    forall a. a -> Maybe a
    Just 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 (see tcInterfaceSigs)
                      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
                          DynFlags
    dflags <- IOEnv (Env IfGblEnv IfLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
                          Logger
    logger <- IOEnv (Env IfGblEnv IfLclEnv) Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
                          let msg :: SDoc
    msg = SDoc -> Int -> SDoc -> SDoc
    hang (FilePath -> SDoc
    text FilePath
    "forkM failed:" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc)
                                       Int
    2 (FilePath -> SDoc
    text (IOEnvFailure -> FilePath
    forall a. Show a => a -> FilePath
    show IOEnvFailure
    exn))
                          IO () -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IOEnv (Env IfGblEnv IfLclEnv) ())
    -> IO () -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall a b. (a -> b) -> a -> b
    $ Logger -> LogAction
    putLogMsg Logger
    logger DynFlags
    dflags
                                             WarnReason
    NoReason
                                             Severity
    SevFatal
                                             SrcSpan
    noSrcSpan
                                             (SDoc -> IO ()) -> SDoc -> IO ()
    forall a b. (a -> b) -> a -> b
    $ PprStyle -> SDoc -> SDoc
    withPprStyle PprStyle
    defaultErrStyle SDoc
    msg

                    ; SDoc -> IOEnv (Env IfGblEnv IfLclEnv) ()
    forall m n. SDoc -> TcRnIf m n ()
    traceIf (FilePath -> SDoc
    text FilePath
    "} ending fork (badly)" SDoc -> SDoc -> SDoc
    <+> SDoc
    doc)
                    ; Maybe a -> IOEnv (Env IfGblEnv IfLclEnv) (Maybe a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe a
    forall a. Maybe a
    Nothing }
        }

    forkM :: SDoc -> IfL a -> IfL a
    forkM :: forall a. SDoc -> IfL a -> IfL a
    forkM SDoc
    doc IfL a
    thing_inside
     = do   { Maybe a
    mb_res <- SDoc -> IfL a -> IfL (Maybe a)
    forall a. SDoc -> IfL a -> IfL (Maybe a)
    forkM_maybe SDoc
    doc IfL a
    thing_inside
            ; a -> IfL a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (case Maybe a
    mb_res of
                            Maybe a
    Nothing -> FilePath -> a
    forall a. FilePath -> a
    pgmError FilePath
    "Cannot continue after interface file error"
                                       -- pprPanic "forkM" doc
                            Just a
    r  -> a
    r) }

    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 :: Maybe TypeEnv
    if_implicits_env = TypeEnv -> Maybe TypeEnv
    forall a. a -> Maybe a
    Just TypeEnv
    tenv }) IfL a
    m

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

    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_maybe), 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
      gbl
    env <- TcRnIf gbl lcl gbl
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
      let cc_st_ref :: IORef CostCentreState
    cc_st_ref = gbl -> IORef CostCentreState
    get_ccs gbl
    env
      CostCentreState
    cc_st <- IORef CostCentreState -> TcRnIf gbl lcl CostCentreState
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef IORef CostCentreState
    cc_st_ref
      let (CostCentreIndex
    idx, CostCentreState
    cc_st') = FastString -> CostCentreState -> (CostCentreIndex, CostCentreState)
    getCCIndex FastString
    nm CostCentreState
    cc_st
      IORef CostCentreState -> CostCentreState -> TcRnIf gbl lcl ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef IORef CostCentreState
    cc_st_ref CostCentreState
    cc_st'
      CostCentreIndex -> TcRnIf gbl lcl CostCentreIndex
    forall (m :: * -> *) a. Monad m => a -> m a
    return CostCentreIndex
    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