    {-# LANGUAGE DeriveFunctor #-}
    {-# LANGUAGE FlexibleContexts #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE LambdaCase #-}

    {-# OPTIONS_GHC -fno-warn-orphans #-}  -- instance MonadThings is necessarily an orphan

    {-
    (c) The University of Glasgow 2006
    (c) The GRASP/AQUA Project, Glasgow University, 1992-1998

    Monadery used in desugaring
    -}

    module GHC.HsToCore.Monad (
            DsM, mapM, mapAndUnzipM,
            initDs, initDsTc, initTcDsForSolver, initDsWithModGuts, fixDs,
            foldlM, foldrM, whenGOptM, unsetGOptM, unsetWOptM, xoptM,
            Applicative(..),(<$>),

            duplicateLocalDs, newSysLocalDs,
            newSysLocalsDs, newUniqueId,
            newFailLocalDs, newPredVarDs,
            getSrcSpanDs, putSrcSpanDs, putSrcSpanDsA,
            mkNamePprCtxDs,
            newUnique,
            UniqSupply, newUniqueSupply,
            getGhcModeDs, dsGetFamInstEnvs,
            dsLookupGlobal, dsLookupGlobalId, dsLookupTyCon,
            dsLookupDataCon, dsLookupConLike,
            getCCIndexDsM,

            DsMetaEnv, DsMetaVal(..), dsGetMetaEnv, dsLookupMetaEnv, dsExtendMetaEnv,

            -- Getting and setting pattern match oracle states
            getPmNablas, updPmNablas,

            -- Tracking evidence variable coherence
            addUnspecables, getUnspecables,

            -- Get COMPLETE sets of a TyCon
            dsGetCompleteMatches,

            -- Warnings and errors
            DsWarning, diagnosticDs, errDsCoreExpr,
            failWithDs, failDs, discardWarningsDs,
            addMessagesDs, captureMessagesDs,

            -- Data types
            DsMatchContext(..),
            EquationInfo(..), EquationInfoNE, prependPats, mkEqnInfo, eqnMatchResult,
            MatchResult (..), runMatchResult, DsWrapper, idDsWrapper,

            -- Trace injection
            pprRuntimeTrace
        ) where

    import GHC.Prelude

    import GHC.Driver.Env
    import GHC.Driver.DynFlags
    import GHC.Driver.Ppr
    import GHC.Driver.Config.Diagnostic

    import GHC.Hs

    import GHC.HsToCore.Types
    import GHC.HsToCore.Errors.Types
    import GHC.HsToCore.Pmc.Solver.Types (Nablas, initNablas)

    import GHC.Core.FamInstEnv
    import GHC.Core
    import GHC.Core.Make  ( unitExpr )
    import GHC.Core.Utils ( exprType )
    import GHC.Core.DataCon
    import GHC.Core.ConLike
    import GHC.Core.TyCon
    import GHC.Core.Type
    import GHC.Core.Multiplicity

    import GHC.IfaceToCore

    import GHC.Tc.Utils.Monad

    import GHC.Builtin.Names

    import GHC.Data.FastString

    import GHC.Unit.Env
    import GHC.Unit.External
    import GHC.Unit.Module
    import GHC.Unit.Module.ModGuts

    import GHC.Types.Name.Reader
    import GHC.Types.SourceFile
    import GHC.Types.Id
    import GHC.Types.Var (EvId)
    import GHC.Types.SrcLoc
    import GHC.Types.TypeEnv
    import GHC.Types.Unique.Supply
    import GHC.Types.Name
    import GHC.Types.Name.Env
    import GHC.Types.Name.Ppr
    import GHC.Types.Literal ( mkLitString )
    import GHC.Types.CostCentre.State
    import GHC.Types.TyThing
    import GHC.Types.Error

    import GHC.Utils.Error
    import GHC.Utils.Outputable
    import GHC.Utils.Panic
    import qualified GHC.Data.Strict as Strict

    import Data.IORef
    import GHC.Driver.Env.KnotVars
    import qualified Data.Set as S

    {-
    ************************************************************************
    *                                                                      *
                    Data types for the desugarer
    *                                                                      *
    ************************************************************************
    -}

    data DsMatchContext
      = DsMatchContext HsMatchContextRn SrcSpan
      deriving ()

    instance Outputable DsMatchContext where
      ppr :: DsMatchContext -> SDoc
    ppr (DsMatchContext HsMatchContextRn
    hs_match SrcSpan
    ss) = SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    ss SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> HsMatchContext (GenLocated SrcSpanAnnN Name) -> SDoc
    forall fn. Outputable fn => HsMatchContext fn -> SDoc
    pprMatchContext HsMatchContextRn
    HsMatchContext (GenLocated SrcSpanAnnN Name)
    hs_match

    data EquationInfo
      = EqnMatch  { EquationInfo -> LPat GhcTc
    eqn_pat :: LPat GhcTc
                    -- ^ The first pattern of the equation
                    --
                    -- NB: The location info is used to determine whether the
                    -- pattern is generated or not.
                    -- This helps us avoid warnings on patterns that GHC elaborated.
                    --
                    -- NB: We have /already/ applied 'decideBangHood' to this
                    -- pattern. See Note [decideBangHood] in "GHC.HsToCore.Utils"

                  , EquationInfo -> EquationInfo
    eqn_rest :: EquationInfo }
                    -- ^ The rest of the equation after its first pattern

      | EqnDone
      -- The empty tail of an equation having no more patterns
                (MatchResult CoreExpr)
                -- ^ What to do after match

    type EquationInfoNE = EquationInfo
    -- An EquationInfo which has at least one pattern

    prependPats :: [LPat GhcTc] -> EquationInfo -> EquationInfo
    prependPats :: [LPat GhcTc] -> EquationInfo -> EquationInfo
    prependPats [] EquationInfo
    eqn = EquationInfo
    eqn
    prependPats (LPat GhcTc
    pat:[LPat GhcTc]
    pats) EquationInfo
    eqn = EqnMatch { eqn_pat :: LPat GhcTc
    eqn_pat = LPat GhcTc
    pat, eqn_rest :: EquationInfo
    eqn_rest = [LPat GhcTc] -> EquationInfo -> EquationInfo
    prependPats [LPat GhcTc]
    pats EquationInfo
    eqn }

    mkEqnInfo :: [LPat GhcTc] -> MatchResult CoreExpr -> EquationInfo
    mkEqnInfo :: [LPat GhcTc] -> MatchResult CoreExpr -> EquationInfo
    mkEqnInfo [LPat GhcTc]
    pats = [LPat GhcTc] -> EquationInfo -> EquationInfo
    prependPats [LPat GhcTc]
    pats (EquationInfo -> EquationInfo)
    -> (MatchResult CoreExpr -> EquationInfo)
    -> MatchResult CoreExpr
    -> EquationInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . MatchResult CoreExpr -> EquationInfo
    EqnDone

    eqnMatchResult :: EquationInfo -> MatchResult CoreExpr
    eqnMatchResult :: EquationInfo -> MatchResult CoreExpr
    eqnMatchResult (EqnDone MatchResult CoreExpr
    rhs) = MatchResult CoreExpr
    rhs
    eqnMatchResult (EqnMatch { eqn_rest :: EquationInfo -> EquationInfo
    eqn_rest = EquationInfo
    eq }) = EquationInfo -> MatchResult CoreExpr
    eqnMatchResult EquationInfo
    eq

    instance Outputable EquationInfo where
        ppr :: EquationInfo -> SDoc
    ppr = [Pat GhcTc] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ([Pat GhcTc] -> SDoc)
    -> (EquationInfo -> [Pat GhcTc]) -> EquationInfo -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . EquationInfo -> [Pat GhcTc]
    allEqnPats where
          allEqnPats :: EquationInfo -> [Pat GhcTc]
    allEqnPats (EqnDone {}) = []
          allEqnPats (EqnMatch { eqn_pat :: EquationInfo -> LPat GhcTc
    eqn_pat = LPat GhcTc
    pat, eqn_rest :: EquationInfo -> EquationInfo
    eqn_rest = EquationInfo
    eq }) = GenLocated SrcSpanAnnA (Pat GhcTc) -> Pat GhcTc
    forall l e. GenLocated l e -> e
    unLoc LPat GhcTc
    GenLocated SrcSpanAnnA (Pat GhcTc)
    pat Pat GhcTc -> [Pat GhcTc] -> [Pat GhcTc]
    forall a. a -> [a] -> [a]
    : EquationInfo -> [Pat GhcTc]
    allEqnPats EquationInfo
    eq

    type DsWrapper = CoreExpr -> CoreExpr
    idDsWrapper :: DsWrapper
    idDsWrapper :: DsWrapper
    idDsWrapper CoreExpr
    e = CoreExpr
    e

    -- The semantics of (match vs (EqnInfo wrap pats rhs)) is the MatchResult CoreExpr
    --      \fail. wrap (case vs of { pats -> rhs fail })
    -- where vs are not bound by wrap

    -- | This is a value of type a with potentially a CoreExpr-shaped hole in it.
    -- This is used to deal with cases where we are potentially handling pattern
    -- match failure, and want to later specify how failure is handled.
    data MatchResult a
      -- | We represent the case where there is no hole without a function from
      -- 'CoreExpr', like this, because sometimes we have nothing to put in the
      -- hole and so want to be sure there is in fact no hole.
      = MR_Infallible (DsM a)
      | MR_Fallible (CoreExpr -> DsM a)
      deriving ((forall a b. (a -> b) -> MatchResult a -> MatchResult b)
    -> (forall a b. a -> MatchResult b -> MatchResult a)
    -> Functor MatchResult
    forall a b. a -> MatchResult b -> MatchResult a
    forall a b. (a -> b) -> MatchResult a -> MatchResult b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    $cfmap :: forall a b. (a -> b) -> MatchResult a -> MatchResult b
    fmap :: forall a b. (a -> b) -> MatchResult a -> MatchResult b
    $c<$ :: forall a b. a -> MatchResult b -> MatchResult a
    <$ :: forall a b. a -> MatchResult b -> MatchResult a
    Functor)

    -- | Product is an "or" on fallibility---the combined match result is infallible
    -- only if the left and right argument match results both were.
    --
    -- This is useful for combining a bunch of alternatives together and then
    -- getting the overall fallibility of the entire group. See 'mkDataConCase' for
    -- an example.
    instance Applicative MatchResult where
      pure :: forall a. a -> MatchResult a
    pure a
    v = DsM a -> MatchResult a
    forall a. DsM a -> MatchResult a
    MR_Infallible (a -> DsM a
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    v)
      MR_Infallible DsM (a -> b)
    f <*> :: forall a b. MatchResult (a -> b) -> MatchResult a -> MatchResult b
    <*> MR_Infallible DsM a
    x = DsM b -> MatchResult b
    forall a. DsM a -> MatchResult a
    MR_Infallible (DsM (a -> b)
    f DsM (a -> b) -> DsM a -> DsM b
    forall a b.
    IOEnv (Env DsGblEnv DsLclEnv) (a -> b)
    -> IOEnv (Env DsGblEnv DsLclEnv) a
    -> IOEnv (Env DsGblEnv DsLclEnv) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DsM a
    x)
      MatchResult (a -> b)
    f <*> MatchResult a
    x = (CoreExpr -> DsM b) -> MatchResult b
    forall a. (CoreExpr -> DsM a) -> MatchResult a
    MR_Fallible ((CoreExpr -> DsM b) -> MatchResult b)
    -> (CoreExpr -> DsM b) -> MatchResult b
    forall a b. (a -> b) -> a -> b
    $ \CoreExpr
    fail -> CoreExpr -> MatchResult (a -> b) -> DsM (a -> b)
    forall a. CoreExpr -> MatchResult a -> DsM a
    runMatchResult CoreExpr
    fail MatchResult (a -> b)
    f DsM (a -> b) -> DsM a -> DsM b
    forall a b.
    IOEnv (Env DsGblEnv DsLclEnv) (a -> b)
    -> IOEnv (Env DsGblEnv DsLclEnv) a
    -> IOEnv (Env DsGblEnv DsLclEnv) b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> CoreExpr -> MatchResult a -> DsM a
    forall a. CoreExpr -> MatchResult a -> DsM a
    runMatchResult CoreExpr
    fail MatchResult a
    x

    -- Given a fail expression to use, and a MatchResult CoreExpr, compute the filled CoreExpr whether
    -- the MatchResult CoreExpr was failable or not.
    runMatchResult :: CoreExpr -> MatchResult a -> DsM a
    runMatchResult :: forall a. CoreExpr -> MatchResult a -> DsM a
    runMatchResult CoreExpr
    fail = \case
      MR_Infallible DsM a
    body -> DsM a
    body
      MR_Fallible CoreExpr -> DsM a
    body_fn -> CoreExpr -> DsM a
    body_fn CoreExpr
    fail

    {-
    ************************************************************************
    *                                                                      *
                    Monad functions
    *                                                                      *
    ************************************************************************
    -}

    -- Compatibility functions
    fixDs :: (a -> DsM a) -> DsM a
    fixDs :: forall a. (a -> DsM a) -> DsM a
    fixDs    = (a -> IOEnv (Env DsGblEnv DsLclEnv) a)
    -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall a env. (a -> IOEnv env a) -> IOEnv env a
    fixM

    type DsWarning = (SrcSpan, SDoc)
            -- Not quite the same as a WarnMsg, we have an SDoc here
            -- and we'll do the name_ppr_ctx stuff later on to turn it
            -- into a Doc.

    -- | Run a 'DsM' action inside the 'TcM' monad.
    initDsTc :: DsM a -> TcM (Messages DsMessage, Maybe a)
    initDsTc :: forall a. DsM a -> TcM (Messages DsMessage, Maybe a)
    initDsTc DsM a
    thing_inside
      = do { tcg_env  <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; msg_var  <- liftIO $ newIORef emptyMessages
           ; hsc_env  <- getTopEnv
           ; envs     <- mkDsEnvsFromTcGbl hsc_env msg_var tcg_env
           ; e_result <- tryM $  -- need to tryM so that we don't discard
                                 -- DsMessages
                         setEnvs envs thing_inside
           ; msgs     <- liftIO $ readIORef msg_var
           ; return (msgs, case e_result of Left IOEnvFailure
    _  -> Maybe a
    forall a. Maybe a
    Nothing
                                            Right a
    x -> a -> Maybe a
    forall a. a -> Maybe a
    Just a
    x)
           }

    -- | Run a 'DsM' action inside the 'IO' monad.
    initDs :: HscEnv -> TcGblEnv -> DsM a -> IO (Messages DsMessage, Maybe a)
    initDs :: forall a.
    HscEnv -> TcGblEnv -> DsM a -> IO (Messages DsMessage, Maybe a)
    initDs HscEnv
    hsc_env TcGblEnv
    tcg_env DsM a
    thing_inside
      = do { msg_var <- Messages DsMessage -> IO (IORef (Messages DsMessage))
    forall a. a -> IO (IORef a)
    newIORef Messages DsMessage
    forall e. Messages e
    emptyMessages
           ; envs <- mkDsEnvsFromTcGbl hsc_env msg_var tcg_env
           ; runDs hsc_env envs thing_inside
           }

    -- | Build a set of desugarer environments derived from a 'TcGblEnv'.
    mkDsEnvsFromTcGbl :: MonadIO m
                      => HscEnv -> IORef (Messages DsMessage) -> TcGblEnv
                      -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl :: forall (m :: * -> *).
    MonadIO m =>
    HscEnv
    -> IORef (Messages DsMessage) -> TcGblEnv -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl HscEnv
    hsc_env IORef (Messages DsMessage)
    msg_var TcGblEnv
    tcg_env
      = do { cc_st_var   <- IO (IORef CostCentreState) -> m (IORef CostCentreState)
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef CostCentreState) -> m (IORef CostCentreState))
    -> IO (IORef CostCentreState) -> m (IORef CostCentreState)
    forall a b. (a -> b) -> a -> b
    $ CostCentreState -> IO (IORef CostCentreState)
    forall a. a -> IO (IORef a)
    newIORef CostCentreState
    newCostCentreState
           ; eps <- liftIO $ hscEPS hsc_env
           ; let unit_env = HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env
                 this_mod = TcGblEnv -> Module
    tcg_mod TcGblEnv
    tcg_env
                 type_env = TcGblEnv -> TypeEnv
    tcg_type_env TcGblEnv
    tcg_env
                 rdr_env  = TcGblEnv -> GlobalRdrEnv
    tcg_rdr_env TcGblEnv
    tcg_env
                 fam_inst_env = TcGblEnv -> FamInstEnv
    tcg_fam_inst_env TcGblEnv
    tcg_env
                 ptc = DynFlags -> PromotionTickContext
    initPromotionTickContext (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
                 complete_matches = HscEnv -> [CompleteMatch]
    hptCompleteSigs HscEnv
    hsc_env         -- from the home package
                                    [CompleteMatch] -> [CompleteMatch] -> [CompleteMatch]
    forall a. [a] -> [a] -> [a]
    ++ TcGblEnv -> [CompleteMatch]
    tcg_complete_matches TcGblEnv
    tcg_env -- from the current module
                                    [CompleteMatch] -> [CompleteMatch] -> [CompleteMatch]
    forall a. [a] -> [a] -> [a]
    ++ ExternalPackageState -> [CompleteMatch]
    eps_complete_matches ExternalPackageState
    eps     -- from imports
                 -- re-use existing next_wrapper_num to ensure uniqueness
                 next_wrapper_num_var = TcGblEnv -> TcRef (ModuleEnv Int)
    tcg_next_wrapper_num TcGblEnv
    tcg_env
           ; return $ mkDsEnvs unit_env this_mod rdr_env type_env fam_inst_env ptc
                               msg_var cc_st_var next_wrapper_num_var complete_matches
           }

    runDs :: HscEnv -> (DsGblEnv, DsLclEnv) -> DsM a -> IO (Messages DsMessage, Maybe a)
    runDs :: forall a.
    HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DsMessage, Maybe a)
    runDs HscEnv
    hsc_env (DsGblEnv
    ds_gbl, DsLclEnv
    ds_lcl) DsM a
    thing_inside
      = do { res    <- Char
    -> HscEnv
    -> DsGblEnv
    -> DsLclEnv
    -> TcRnIf DsGblEnv DsLclEnv (Either IOEnvFailure a)
    -> IO (Either IOEnvFailure a)
    forall gbl lcl a.
    Char -> HscEnv -> gbl -> lcl -> TcRnIf gbl lcl a -> IO a
    initTcRnIf Char
    'd' HscEnv
    hsc_env DsGblEnv
    ds_gbl DsLclEnv
    ds_lcl
                                  (DsM a -> TcRnIf DsGblEnv DsLclEnv (Either IOEnvFailure a)
    forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM DsM a
    thing_inside)
           ; msgs   <- readIORef (ds_msgs ds_gbl)
           ; let final_res
                   | Messages DsMessage -> Bool
    forall e. Diagnostic e => Messages e -> Bool
    errorsFound Messages DsMessage
    msgs = Maybe a
    forall a. Maybe a
    Nothing
                   | Right a
    r <- Either IOEnvFailure a
    res   = a -> Maybe a
    forall a. a -> Maybe a
    Just a
    r
                   | Bool
    otherwise        = String -> Maybe a
    forall a. HasCallStack => String -> a
    panic String
    "initDs"
           ; return (msgs, final_res)
           }

    -- | Run a 'DsM' action in the context of an existing 'ModGuts'
    initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages DsMessage, Maybe a)
    initDsWithModGuts :: forall a.
    HscEnv -> ModGuts -> DsM a -> IO (Messages DsMessage, Maybe a)
    initDsWithModGuts HscEnv
    hsc_env (ModGuts { mg_module :: ModGuts -> Module
    mg_module = Module
    this_mod, mg_binds :: ModGuts -> CoreProgram
    mg_binds = CoreProgram
    binds
                                       , mg_tcs :: ModGuts -> [TyCon]
    mg_tcs = [TyCon]
    tycons, mg_fam_insts :: ModGuts -> [FamInst]
    mg_fam_insts = [FamInst]
    fam_insts
                                       , mg_patsyns :: ModGuts -> [PatSyn]
    mg_patsyns = [PatSyn]
    patsyns, mg_rdr_env :: ModGuts -> GlobalRdrEnv
    mg_rdr_env = GlobalRdrEnv
    rdr_env
                                       , mg_fam_inst_env :: ModGuts -> FamInstEnv
    mg_fam_inst_env = FamInstEnv
    fam_inst_env
                                       , mg_complete_matches :: ModGuts -> [CompleteMatch]
    mg_complete_matches = [CompleteMatch]
    local_complete_matches
                              }) DsM a
    thing_inside
      = do { cc_st_var   <- CostCentreState -> IO (IORef CostCentreState)
    forall a. a -> IO (IORef a)
    newIORef CostCentreState
    newCostCentreState
           ; next_wrapper_num <- newIORef emptyModuleEnv
           ; msg_var <- newIORef emptyMessages
           ; eps <- liftIO $ hscEPS hsc_env
           ; let unit_env = HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env
                 type_env = [EvVar] -> [TyCon] -> [PatSyn] -> [FamInst] -> TypeEnv
    typeEnvFromEntities [EvVar]
    ids [TyCon]
    tycons [PatSyn]
    patsyns [FamInst]
    fam_insts
                 ptc = DynFlags -> PromotionTickContext
    initPromotionTickContext (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env)
                 complete_matches = HscEnv -> [CompleteMatch]
    hptCompleteSigs HscEnv
    hsc_env     -- from the home package
                                    [CompleteMatch] -> [CompleteMatch] -> [CompleteMatch]
    forall a. [a] -> [a] -> [a]
    ++ [CompleteMatch]
    local_complete_matches  -- from the current module
                                    [CompleteMatch] -> [CompleteMatch] -> [CompleteMatch]
    forall a. [a] -> [a] -> [a]
    ++ ExternalPackageState -> [CompleteMatch]
    eps_complete_matches ExternalPackageState
    eps -- from imports

                 bindsToIds (NonRec a
    v Expr a
    _)   = [a
    v]
                 bindsToIds (Rec    [(a, Expr a)]
    binds) = ((a, Expr a) -> a) -> [(a, Expr a)] -> [a]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, Expr a) -> a
    forall a b. (a, b) -> a
    fst [(a, Expr a)]
    binds
                 ids = (Bind EvVar -> [EvVar]) -> CoreProgram -> [EvVar]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Bind EvVar -> [EvVar]
    forall {a}. Bind a -> [a]
    bindsToIds CoreProgram
    binds

                 envs  = UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> PromotionTickContext
    -> IORef (Messages DsMessage)
    -> IORef CostCentreState
    -> TcRef (ModuleEnv Int)
    -> [CompleteMatch]
    -> (DsGblEnv, DsLclEnv)
    mkDsEnvs UnitEnv
    unit_env Module
    this_mod GlobalRdrEnv
    rdr_env TypeEnv
    type_env
                                  FamInstEnv
    fam_inst_env PromotionTickContext
    ptc IORef (Messages DsMessage)
    msg_var IORef CostCentreState
    cc_st_var
                                  TcRef (ModuleEnv Int)
    next_wrapper_num [CompleteMatch]
    complete_matches
           ; runDs hsc_env envs thing_inside
           }

    initTcDsForSolver :: TcM a -> DsM a
    -- Spin up a TcM context so that we can run the constraint solver
    -- Returns any error messages generated by the constraint solver
    -- and (Just res) if no error happened; Nothing if an error happened
    --
    -- Simon says: I'm not very happy about this.  We spin up a complete TcM monad
    --             only to immediately refine it to a TcS monad.
    -- Better perhaps to make TcS into its own monad, rather than building on TcS
    -- But that may in turn interact with plugins

    initTcDsForSolver :: forall a. TcM a -> DsM a
    initTcDsForSolver TcM a
    thing_inside
      = do { (gbl, lcl) <- TcRnIf DsGblEnv DsLclEnv (DsGblEnv, DsLclEnv)
    forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs
           ; hsc_env    <- getTopEnv

           ; let DsGblEnv { ds_mod = mod
                          , ds_fam_inst_env = fam_inst_env
                          , ds_gbl_rdr_env  = rdr_env }      = gbl
           -- This is *the* use of ds_gbl_rdr_env:
           -- Make sure the solver (used by the pattern-match overlap checker) has
           -- access to the GlobalRdrEnv and FamInstEnv for the module, so that it
           -- knows how to reduce type families, and which newtypes it can unwrap.

                 DsLclEnv { dsl_loc = loc }                  = lcl

           ; (msgs, mb_ret) <- liftIO $ initTc hsc_env HsSrcFile False mod loc $
             updGblEnv (\TcGblEnv
    tc_gbl -> TcGblEnv
    tc_gbl { tcg_fam_inst_env = fam_inst_env
                                          , tcg_rdr_env      = rdr_env }) $
             thing_inside
           ; case mb_ret of
               Just a
    ret -> a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    ret
               Maybe a
    Nothing  -> String -> SDoc -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "initTcDsForSolver" ([SDoc] -> SDoc
    forall doc. IsDoc doc => [doc] -> doc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Bag (MsgEnvelope TcRnMessage) -> [SDoc]
    forall e. Diagnostic e => Bag (MsgEnvelope e) -> [SDoc]
    pprMsgEnvelopeBagWithLocDefault (Messages TcRnMessage -> Bag (MsgEnvelope TcRnMessage)
    forall e. Diagnostic e => Messages e -> Bag (MsgEnvelope e)
    getErrorMessages Messages TcRnMessage
    msgs)) }

    mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
             -> PromotionTickContext
             -> IORef (Messages DsMessage) -> IORef CostCentreState
             -> IORef (ModuleEnv Int) -> CompleteMatches
             -> (DsGblEnv, DsLclEnv)
    mkDsEnvs :: UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> PromotionTickContext
    -> IORef (Messages DsMessage)
    -> IORef CostCentreState
    -> TcRef (ModuleEnv Int)
    -> [CompleteMatch]
    -> (DsGblEnv, DsLclEnv)
    mkDsEnvs UnitEnv
    unit_env Module
    mod GlobalRdrEnv
    rdr_env TypeEnv
    type_env FamInstEnv
    fam_inst_env PromotionTickContext
    ptc IORef (Messages DsMessage)
    msg_var IORef CostCentreState
    cc_st_var
             TcRef (ModuleEnv Int)
    next_wrapper_num [CompleteMatch]
    complete_matches
      = let if_genv :: IfGblEnv
    if_genv = IfGblEnv { if_doc :: SDoc
    if_doc       = String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "mkDsEnvs"
      -- Failing tests here are `ghci` and `T11985` if you get this wrong.
      -- this is very very "at a distance" because the reason for this check is that the type_env in interactive
      -- mode is the smushed together of all the interactive modules.
      -- See Note [Why is KnotVars not a ModuleEnv]
                                 , if_rec_types :: KnotVars (IfG TypeEnv)
    if_rec_types = [Module]
    -> (Module -> Maybe (IfG TypeEnv)) -> KnotVars (IfG TypeEnv)
    forall a. [Module] -> (Module -> Maybe a) -> KnotVars a
    KnotVars [Module
    mod] (\Module
    that_mod -> if Module
    that_mod Module -> Module -> Bool
    forall a. Eq a => a -> a -> Bool
    == Module
    mod Bool -> Bool -> Bool
    || Module -> Bool
    isInteractiveModule Module
    mod
                                                              then IfG TypeEnv -> Maybe (IfG TypeEnv)
    forall a. a -> Maybe a
    Just (TypeEnv -> IfG TypeEnv
    forall a. a -> IOEnv (Env IfGblEnv ()) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return TypeEnv
    type_env)
                                                              else Maybe (IfG TypeEnv)
    forall a. Maybe a
    Nothing) }
            if_lenv :: IfLclEnv
    if_lenv = Module -> SDoc -> IsBootInterface -> IfLclEnv
    mkIfLclEnv Module
    mod (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "GHC error in desugarer lookup in" SDoc -> SDoc -> SDoc
    forall doc. IsLine doc => doc -> doc -> doc
    <+> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    mod)
                                 IsBootInterface
    NotBoot
            real_span :: RealSrcSpan
    real_span = RealSrcLoc -> RealSrcSpan
    realSrcLocSpan (FastString -> Int -> Int -> RealSrcLoc
    mkRealSrcLoc (ModuleName -> FastString
    moduleNameFS (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod)) Int
    1 Int
    1)
            gbl_env :: DsGblEnv
    gbl_env = DsGblEnv { ds_mod :: Module
    ds_mod     = Module
    mod
                               , ds_fam_inst_env :: FamInstEnv
    ds_fam_inst_env = FamInstEnv
    fam_inst_env
                               , ds_gbl_rdr_env :: GlobalRdrEnv
    ds_gbl_rdr_env  = GlobalRdrEnv
    rdr_env
                               , ds_if_env :: (IfGblEnv, IfLclEnv)
    ds_if_env  = (IfGblEnv
    if_genv, IfLclEnv
    if_lenv)
                               , ds_name_ppr_ctx :: NamePprCtx
    ds_name_ppr_ctx = PromotionTickContext -> UnitEnv -> GlobalRdrEnv -> NamePprCtx
    forall info.
    Outputable info =>
    PromotionTickContext -> UnitEnv -> GlobalRdrEnvX info -> NamePprCtx
    mkNamePprCtx PromotionTickContext
    ptc UnitEnv
    unit_env GlobalRdrEnv
    rdr_env
                               , ds_msgs :: IORef (Messages DsMessage)
    ds_msgs    = IORef (Messages DsMessage)
    msg_var
                               , ds_complete_matches :: [CompleteMatch]
    ds_complete_matches = [CompleteMatch]
    complete_matches
                               , ds_cc_st :: IORef CostCentreState
    ds_cc_st   = IORef CostCentreState
    cc_st_var
                               , ds_next_wrapper_num :: TcRef (ModuleEnv Int)
    ds_next_wrapper_num = TcRef (ModuleEnv Int)
    next_wrapper_num
                               }
            lcl_env :: DsLclEnv
    lcl_env = DsLclEnv { dsl_meta :: DsMetaEnv
    dsl_meta        = DsMetaEnv
    forall a. NameEnv a
    emptyNameEnv
                               , dsl_loc :: RealSrcSpan
    dsl_loc         = RealSrcSpan
    real_span
                               , dsl_nablas :: Nablas
    dsl_nablas      = Nablas
    initNablas
                               , dsl_unspecables :: Set EvVar
    dsl_unspecables = Set EvVar
    forall a. Monoid a => a
    mempty
                               }
        in (DsGblEnv
    gbl_env, DsLclEnv
    lcl_env)

    {-
    ************************************************************************
    *                                                                      *
                    Operations in the monad
    *                                                                      *
    ************************************************************************

    And all this mysterious stuff is so we can occasionally reach out and
    grab one or more names.  @newLocalDs@ isn't exported---exported
    functions are defined with it.  The difference in name-strings makes
    it easier to read debugging output.

    -}

    -- Make a new Id with the same print name, but different type, and new unique
    newUniqueId :: Id -> Mult -> Type -> DsM Id
    newUniqueId :: EvVar -> Mult -> Mult -> DsM EvVar
    newUniqueId EvVar
    id = FastString -> Mult -> Mult -> DsM EvVar
    forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Mult -> Mult -> m EvVar
    mkSysLocalOrCoVarM (OccName -> FastString
    occNameFS (Name -> OccName
    nameOccName (EvVar -> Name
    idName EvVar
    id)))

    duplicateLocalDs :: Id -> DsM Id
    duplicateLocalDs :: EvVar -> DsM EvVar
    duplicateLocalDs EvVar
    old_local
      = do  { uniq <- TcRnIf DsGblEnv DsLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
            ; return (setIdUnique old_local uniq) }

    newPredVarDs :: PredType -> DsM Var
    newPredVarDs :: Mult -> DsM EvVar
    newPredVarDs
     = FastString -> Mult -> Mult -> DsM EvVar
    forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Mult -> Mult -> m EvVar
    mkSysLocalOrCoVarM (String -> FastString
    fsLit String
    "ds") Mult
    ManyTy  -- like newSysLocalDs, but we allow covars

    newSysLocalDs, newFailLocalDs :: Mult -> Type -> DsM Id
    newSysLocalDs :: Mult -> Mult -> DsM EvVar
    newSysLocalDs = FastString -> Mult -> Mult -> DsM EvVar
    forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Mult -> Mult -> m EvVar
    mkSysLocalM (String -> FastString
    fsLit String
    "ds")
    newFailLocalDs :: Mult -> Mult -> DsM EvVar
    newFailLocalDs = FastString -> Mult -> Mult -> DsM EvVar
    forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Mult -> Mult -> m EvVar
    mkSysLocalM (String -> FastString
    fsLit String
    "fail")

    newSysLocalsDs :: [Scaled Type] -> DsM [Id]
    newSysLocalsDs :: [Scaled Mult] -> DsM [EvVar]
    newSysLocalsDs = (Scaled Mult -> DsM EvVar) -> [Scaled Mult] -> DsM [EvVar]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (\(Scaled Mult
    w Mult
    t) -> Mult -> Mult -> DsM EvVar
    newSysLocalDs Mult
    w Mult
    t)

    {-
    We can also reach out and either set/grab location information from
    the @SrcSpan@ being carried around.
    -}

    getGhcModeDs :: DsM GhcMode
    getGhcModeDs :: DsM GhcMode
    getGhcModeDs =  IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    -> (DynFlags -> DsM GhcMode) -> DsM GhcMode
    forall a b.
    IOEnv (Env DsGblEnv DsLclEnv) a
    -> (a -> IOEnv (Env DsGblEnv DsLclEnv) b)
    -> IOEnv (Env DsGblEnv DsLclEnv) b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= GhcMode -> DsM GhcMode
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GhcMode -> DsM GhcMode)
    -> (DynFlags -> GhcMode) -> DynFlags -> DsM GhcMode
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DynFlags -> GhcMode
    ghcMode

    -- | Get the current pattern match oracle state. See 'dsl_nablas'.
    getPmNablas :: DsM Nablas
    getPmNablas :: DsM Nablas
    getPmNablas = do { env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (dsl_nablas env) }

    -- | Set the pattern match oracle state within the scope of the given action.
    -- See 'dsl_nablas'.
    updPmNablas :: Nablas -> DsM a -> DsM a
    updPmNablas :: forall a. Nablas -> DsM a -> DsM a
    updPmNablas Nablas
    nablas = (DsLclEnv -> DsLclEnv)
    -> TcRnIf DsGblEnv DsLclEnv a -> TcRnIf DsGblEnv DsLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\DsLclEnv
    env -> DsLclEnv
    env { dsl_nablas = nablas })

    addUnspecables :: S.Set EvId -> DsM a -> DsM a
    addUnspecables :: forall a. Set EvVar -> DsM a -> DsM a
    addUnspecables Set EvVar
    unspecables = (DsLclEnv -> DsLclEnv)
    -> TcRnIf DsGblEnv DsLclEnv a -> TcRnIf DsGblEnv DsLclEnv a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\DsLclEnv
    env -> DsLclEnv
    env{ dsl_unspecables = unspecables `mappend` dsl_unspecables env })

    getUnspecables :: DsM (S.Set EvId)
    getUnspecables :: DsM (Set EvVar)
    getUnspecables = DsLclEnv -> Set EvVar
    dsl_unspecables (DsLclEnv -> Set EvVar)
    -> TcRnIf DsGblEnv DsLclEnv DsLclEnv -> DsM (Set EvVar)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv

    getSrcSpanDs :: DsM SrcSpan
    getSrcSpanDs :: DsM SrcSpan
    getSrcSpanDs = do { env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
                      ; return (RealSrcSpan (dsl_loc env) Strict.Nothing) }

    putSrcSpanDs :: SrcSpan -> DsM a -> DsM a
    putSrcSpanDs :: forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (UnhelpfulSpan {}) DsM a
    thing_inside
      = DsM a
    thing_inside
    putSrcSpanDs (RealSrcSpan RealSrcSpan
    real_span Maybe BufSpan
    _) DsM a
    thing_inside
      = (DsLclEnv -> DsLclEnv) -> DsM a -> DsM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\ DsLclEnv
    env -> DsLclEnv
    env {dsl_loc = real_span}) DsM a
    thing_inside

    putSrcSpanDsA :: EpAnn ann -> DsM a -> DsM a
    putSrcSpanDsA :: forall ann a. EpAnn ann -> DsM a -> DsM a
    putSrcSpanDsA EpAnn ann
    loc = SrcSpan -> DsM a -> DsM a
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (EpAnn ann -> SrcSpan
    forall a. HasLoc a => a -> SrcSpan
    locA EpAnn ann
    loc)

    -- | Emit a diagnostic for the current source location. In case the diagnostic is a warning,
    -- the latter will be ignored and discarded if the relevant 'WarningFlag' is not set in the DynFlags.
    -- See Note [Discarding Messages] in 'GHC.Types.Error'.
    diagnosticDs :: DsMessage -> DsM ()
    diagnosticDs :: DsMessage -> DsM ()
    diagnosticDs DsMessage
    dsMessage
      = do { env <- TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; loc <- getSrcSpanDs
           ; !diag_opts <- initDiagOpts <$> getDynFlags
           ; let msg = DiagOpts
    -> SrcSpan -> NamePprCtx -> DsMessage -> MsgEnvelope DsMessage
    forall e.
    Diagnostic e =>
    DiagOpts -> SrcSpan -> NamePprCtx -> e -> MsgEnvelope e
    mkMsgEnvelope DiagOpts
    diag_opts SrcSpan
    loc (DsGblEnv -> NamePprCtx
    ds_name_ppr_ctx DsGblEnv
    env) DsMessage
    dsMessage
           ; updMutVar (ds_msgs env) (\ Messages DsMessage
    msgs -> MsgEnvelope DsMessage
    msg MsgEnvelope DsMessage -> Messages DsMessage -> Messages DsMessage
    forall e. MsgEnvelope e -> Messages e -> Messages e
    `addMessage` Messages DsMessage
    msgs) }

    addMessagesDs :: Messages DsMessage -> DsM ()
    addMessagesDs :: Messages DsMessage -> DsM ()
    addMessagesDs Messages DsMessage
    msgs1
      = do { msg_var <- DsGblEnv -> IORef (Messages DsMessage)
    ds_msgs (DsGblEnv -> IORef (Messages DsMessage))
    -> TcRnIf DsGblEnv DsLclEnv DsGblEnv
    -> IOEnv (Env DsGblEnv DsLclEnv) (IORef (Messages DsMessage))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; msgs0 <- liftIO $ readIORef msg_var
           ; liftIO $ writeIORef msg_var (msgs0 `unionMessages` msgs1) }

    -- | Issue an error, but return the expression for (), so that we can continue
    -- reporting errors.
    errDsCoreExpr :: DsMessage -> DsM CoreExpr
    errDsCoreExpr :: DsMessage -> DsM CoreExpr
    errDsCoreExpr DsMessage
    msg
      = do { DsMessage -> DsM ()
    diagnosticDs DsMessage
    msg
           ; CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    unitExpr }

    failWithDs :: DsMessage -> DsM a
    failWithDs :: forall a. DsMessage -> DsM a
    failWithDs DsMessage
    msg
      = do  { DsMessage -> DsM ()
    diagnosticDs DsMessage
    msg
            ; IOEnv (Env DsGblEnv DsLclEnv) a
    forall env a. IOEnv env a
    failM }

    failDs :: DsM a
    failDs :: forall a. DsM a
    failDs = IOEnv (Env DsGblEnv DsLclEnv) a
    forall env a. IOEnv env a
    failM

    captureMessagesDs :: DsM a -> DsM (Messages DsMessage, a)
    captureMessagesDs :: forall a. DsM a -> DsM (Messages DsMessage, a)
    captureMessagesDs DsM a
    thing_inside
      = do { msg_var <- IO (IORef (Messages DsMessage))
    -> IOEnv (Env DsGblEnv DsLclEnv) (IORef (Messages DsMessage))
    forall a. IO a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef (Messages DsMessage))
     -> IOEnv (Env DsGblEnv DsLclEnv) (IORef (Messages DsMessage)))
    -> IO (IORef (Messages DsMessage))
    -> IOEnv (Env DsGblEnv DsLclEnv) (IORef (Messages DsMessage))
    forall a b. (a -> b) -> a -> b
    $ Messages DsMessage -> IO (IORef (Messages DsMessage))
    forall a. a -> IO (IORef a)
    newIORef Messages DsMessage
    forall e. Messages e
    emptyMessages
           ; res <- updGblEnv (\DsGblEnv
    gbl -> DsGblEnv
    gbl {ds_msgs = msg_var}) thing_inside
           ; msgs <- liftIO $ readIORef msg_var
           ; return (msgs, res) }

    mkNamePprCtxDs :: DsM NamePprCtx
    mkNamePprCtxDs :: DsM NamePprCtx
    mkNamePprCtxDs = DsGblEnv -> NamePprCtx
    ds_name_ppr_ctx (DsGblEnv -> NamePprCtx)
    -> TcRnIf DsGblEnv DsLclEnv DsGblEnv -> DsM NamePprCtx
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

    instance MonadThings (IOEnv (Env DsGblEnv DsLclEnv)) where
        lookupThing :: Name -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    lookupThing = Name -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    dsLookupGlobal

    dsLookupGlobal :: Name -> DsM TyThing
    -- Very like GHC.Tc.Utils.Env.tcLookupGlobal
    dsLookupGlobal :: Name -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    dsLookupGlobal Name
    name
      = do  { env <- TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; setEnvs (ds_if_env env)
                      (tcIfaceGlobal name) }

    dsLookupGlobalId :: Name -> DsM Id
    dsLookupGlobalId :: Name -> DsM EvVar
    dsLookupGlobalId Name
    name
      = HasDebugCallStack => TyThing -> EvVar
    TyThing -> EvVar
    tyThingId (TyThing -> EvVar)
    -> IOEnv (Env DsGblEnv DsLclEnv) TyThing -> DsM EvVar
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    dsLookupGlobal Name
    name

    dsLookupTyCon :: Name -> DsM TyCon
    dsLookupTyCon :: Name -> IOEnv (Env DsGblEnv DsLclEnv) TyCon
    dsLookupTyCon Name
    name
      = HasDebugCallStack => TyThing -> TyCon
    TyThing -> TyCon
    tyThingTyCon (TyThing -> TyCon)
    -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    -> IOEnv (Env DsGblEnv DsLclEnv) TyCon
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    dsLookupGlobal Name
    name

    dsLookupDataCon :: Name -> DsM DataCon
    dsLookupDataCon :: Name -> IOEnv (Env DsGblEnv DsLclEnv) DataCon
    dsLookupDataCon Name
    name
      = HasDebugCallStack => TyThing -> DataCon
    TyThing -> DataCon
    tyThingDataCon (TyThing -> DataCon)
    -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    -> IOEnv (Env DsGblEnv DsLclEnv) DataCon
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    dsLookupGlobal Name
    name

    dsLookupConLike :: Name -> DsM ConLike
    dsLookupConLike :: Name -> DsM ConLike
    dsLookupConLike Name
    name
      = HasDebugCallStack => TyThing -> ConLike
    TyThing -> ConLike
    tyThingConLike (TyThing -> ConLike)
    -> IOEnv (Env DsGblEnv DsLclEnv) TyThing -> DsM ConLike
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Name -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    dsLookupGlobal Name
    name

    dsGetFamInstEnvs :: DsM FamInstEnvs
    -- Gets both the external-package inst-env
    -- and the home-pkg inst env (includes module being compiled)
    dsGetFamInstEnvs :: DsM FamInstEnvs
    dsGetFamInstEnvs
      = do { eps <- TcRnIf DsGblEnv DsLclEnv ExternalPackageState
    forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
    getEps; env <- getGblEnv
           ; return (eps_fam_inst_env eps, ds_fam_inst_env env) }

    dsGetMetaEnv :: DsM (NameEnv DsMetaVal)
    dsGetMetaEnv :: DsM DsMetaEnv
    dsGetMetaEnv = do { env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (dsl_meta env) }

    -- | The @COMPLETE@ pragmas that are in scope.
    dsGetCompleteMatches :: DsM CompleteMatches
    dsGetCompleteMatches :: DsM [CompleteMatch]
    dsGetCompleteMatches = DsGblEnv -> [CompleteMatch]
    ds_complete_matches (DsGblEnv -> [CompleteMatch])
    -> TcRnIf DsGblEnv DsLclEnv DsGblEnv -> DsM [CompleteMatch]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

    dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
    dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
    dsLookupMetaEnv Name
    name = do { env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; return (lookupNameEnv (dsl_meta env) name) }

    dsExtendMetaEnv :: DsMetaEnv -> DsM a -> DsM a
    dsExtendMetaEnv :: forall a. DsMetaEnv -> DsM a -> DsM a
    dsExtendMetaEnv DsMetaEnv
    menv DsM a
    thing_inside
      = (DsLclEnv -> DsLclEnv) -> DsM a -> DsM a
    forall lcl gbl a.
    (lcl -> lcl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updLclEnv (\DsLclEnv
    env -> DsLclEnv
    env { dsl_meta = dsl_meta env `plusNameEnv` menv }) DsM a
    thing_inside

    discardWarningsDs :: DsM a -> DsM a
    -- Ignore warnings inside the thing inside;
    -- used to ignore inaccessible cases etc. inside generated code
    discardWarningsDs :: forall a. DsM a -> DsM a
    discardWarningsDs DsM a
    thing_inside
      = do  { env <- TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; old_msgs <- readTcRef (ds_msgs env)

            ; result <- thing_inside

            -- Revert messages to old_msgs
            ; writeTcRef (ds_msgs env) old_msgs

            ; return result }

    -- | Inject a trace message into the compiled program. Whereas
    -- pprTrace prints out information *while compiling*, pprRuntimeTrace
    -- captures that information and causes it to be printed *at runtime*
    -- using Debug.Trace.trace.
    --
    --   pprRuntimeTrace hdr doc expr
    --
    -- will produce an expression that looks like
    --
    --   trace (hdr + doc) expr
    --
    -- When using this to debug a module that Debug.Trace depends on,
    -- it is necessary to import {-# SOURCE #-} Debug.Trace () in that
    -- module. We could avoid this inconvenience by wiring in Debug.Trace.trace,
    -- but that doesn't seem worth the effort and maintenance cost.
    pprRuntimeTrace :: String   -- ^ header
                    -> SDoc     -- ^ information to output
                    -> CoreExpr -- ^ expression
                    -> DsM CoreExpr
    pprRuntimeTrace :: String -> SDoc -> CoreExpr -> DsM CoreExpr
    pprRuntimeTrace String
    str SDoc
    doc CoreExpr
    expr = do
      traceId <- Name -> DsM EvVar
    dsLookupGlobalId Name
    traceName
      unpackCStringId <- dsLookupGlobalId unpackCStringName
      dflags <- getDynFlags
      let message :: CoreExpr
          message = CoreExpr -> DsWrapper
    forall b. Expr b -> Expr b -> Expr b
    App (EvVar -> CoreExpr
    forall b. EvVar -> Expr b
    Var EvVar
    unpackCStringId) DsWrapper -> DsWrapper
    forall a b. (a -> b) -> a -> b
    $
                    Literal -> CoreExpr
    forall b. Literal -> Expr b
    Lit (Literal -> CoreExpr) -> Literal -> CoreExpr
    forall a b. (a -> b) -> a -> b
    $ String -> Literal
    mkLitString (String -> Literal) -> String -> Literal
    forall a b. (a -> b) -> a -> b
    $ DynFlags -> SDoc -> String
    showSDoc DynFlags
    dflags (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    str) Int
    4 SDoc
    doc)
      return $ mkApps (Var traceId) [Type (exprType expr), message, expr]

    -- | See 'getCCIndexM'.
    getCCIndexDsM :: FastString -> DsM CostCentreIndex
    getCCIndexDsM :: FastString -> DsM CostCentreIndex
    getCCIndexDsM = (DsGblEnv -> IORef CostCentreState)
    -> FastString -> DsM CostCentreIndex
    forall gbl lcl.
    (gbl -> IORef CostCentreState)
    -> FastString -> TcRnIf gbl lcl CostCentreIndex
    getCCIndexM DsGblEnv -> IORef CostCentreState
    ds_cc_st