    {-# 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,
            mkPrintUnqualifiedDs,
            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,

            -- Get COMPLETE sets of a TyCon
            dsGetCompleteMatches,

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

            -- Data types
            DsMatchContext(..),
            EquationInfo(..), MatchResult (..), runMatchResult, DsWrapper, idDsWrapper,

            -- Trace injection
            pprRuntimeTrace
        ) where

    import GHC.Prelude

    import GHC.Driver.Env
    import GHC.Driver.Session
    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.Basic ( Origin )
    import GHC.Types.SourceFile
    import GHC.Types.Id
    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

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

    data DsMatchContext
      = DsMatchContext (HsMatchContext GhcRn) SrcSpan
      deriving ()

    instance Outputable DsMatchContext where
      ppr :: DsMatchContext -> SDoc
    ppr (DsMatchContext HsMatchContext GhcRn
    hs_match SrcSpan
    ss) = SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    ss SDoc -> SDoc -> SDoc
    <+> HsMatchContext GhcRn -> SDoc
    forall p.
    (Outputable (IdP p), UnXRec p) =>
    HsMatchContext p -> SDoc
    pprMatchContext HsMatchContext GhcRn
    hs_match

    data EquationInfo
      = EqnInfo { EquationInfo -> [Pat GhcTc]
    eqn_pats :: [Pat GhcTc]
                  -- ^ The patterns for an equation
                  --
                  -- NB: We have /already/ applied 'decideBangHood' to
                  -- these patterns.  See Note [decideBangHood] in "GHC.HsToCore.Utils"

                , EquationInfo -> Origin
    eqn_orig :: Origin
                  -- ^ Was this equation present in the user source?
                  --
                  -- This helps us avoid warnings on patterns that GHC elaborated.
                  --
                  -- For instance, the pattern @-1 :: Word@ gets desugared into
                  -- @W# -1## :: Word@, but we shouldn't warn about an overflowed
                  -- literal for /both/ of these cases.

                , EquationInfo -> MatchResult CoreExpr
    eqn_rhs  :: MatchResult CoreExpr
                  -- ^ What to do after match
                }

    instance Outputable EquationInfo where
        ppr :: EquationInfo -> SDoc
    ppr (EqnInfo [Pat GhcTc]
    pats Origin
    _ MatchResult CoreExpr
    _) = [Pat GhcTc] -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr [Pat GhcTc]
    pats

    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 falliblity---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 falliblity 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 print_unqual 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 { TcGblEnv
    tcg_env  <- TcRnIf TcGblEnv TcLclEnv TcGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; IORef (Messages DsMessage)
    msg_var  <- IO (IORef (Messages DsMessage))
    -> IOEnv (Env TcGblEnv TcLclEnv) (IORef (Messages DsMessage))
    forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (IORef (Messages DsMessage))
     -> IOEnv (Env TcGblEnv TcLclEnv) (IORef (Messages DsMessage)))
    -> IO (IORef (Messages DsMessage))
    -> IOEnv (Env TcGblEnv TcLclEnv) (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
           ; HscEnv
    hsc_env  <- TcRnIf TcGblEnv TcLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
           ; (DsGblEnv, DsLclEnv)
    envs     <- HscEnv
    -> IORef (Messages DsMessage)
    -> TcGblEnv
    -> IOEnv (Env TcGblEnv TcLclEnv) (DsGblEnv, DsLclEnv)
    forall (m :: * -> *).
    MonadIO m =>
    HscEnv
    -> IORef (Messages DsMessage) -> TcGblEnv -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl HscEnv
    hsc_env IORef (Messages DsMessage)
    msg_var TcGblEnv
    tcg_env
           ; Either IOEnvFailure a
    e_result <- IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a)
    forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM (IOEnv (Env TcGblEnv TcLclEnv) a
     -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a))
    -> IOEnv (Env TcGblEnv TcLclEnv) a
    -> IOEnv (Env TcGblEnv TcLclEnv) (Either IOEnvFailure a)
    forall a b. (a -> b) -> a -> b
    $  -- need to tryM so that we don't discard
                                 -- DsMessages
                         (DsGblEnv, DsLclEnv) -> DsM a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (DsGblEnv, DsLclEnv)
    envs DsM a
    thing_inside
           ; Messages DsMessage
    msgs     <- IO (Messages DsMessage)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Messages DsMessage)
    forall a. IO a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Messages DsMessage)
     -> IOEnv (Env TcGblEnv TcLclEnv) (Messages DsMessage))
    -> IO (Messages DsMessage)
    -> IOEnv (Env TcGblEnv TcLclEnv) (Messages DsMessage)
    forall a b. (a -> b) -> a -> b
    $ IORef (Messages DsMessage) -> IO (Messages DsMessage)
    forall a. IORef a -> IO a
    readIORef IORef (Messages DsMessage)
    msg_var
           ; (Messages DsMessage, Maybe a) -> TcM (Messages DsMessage, Maybe a)
    forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages DsMessage
    msgs, case Either IOEnvFailure a
    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 { IORef (Messages DsMessage)
    msg_var <- Messages DsMessage -> IO (IORef (Messages DsMessage))
    forall a. a -> IO (IORef a)
    newIORef Messages DsMessage
    forall e. Messages e
    emptyMessages
           ; (DsGblEnv, DsLclEnv)
    envs <- HscEnv
    -> IORef (Messages DsMessage)
    -> TcGblEnv
    -> IO (DsGblEnv, DsLclEnv)
    forall (m :: * -> *).
    MonadIO m =>
    HscEnv
    -> IORef (Messages DsMessage) -> TcGblEnv -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl HscEnv
    hsc_env IORef (Messages DsMessage)
    msg_var TcGblEnv
    tcg_env
           ; HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DsMessage, Maybe a)
    forall a.
    HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DsMessage, Maybe a)
    runDs HscEnv
    hsc_env (DsGblEnv, DsLclEnv)
    envs DsM a
    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 { IORef CostCentreState
    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
           ; ExternalPackageState
    eps <- IO ExternalPackageState -> m ExternalPackageState
    forall a. IO a -> m a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ExternalPackageState -> m ExternalPackageState)
    -> IO ExternalPackageState -> m ExternalPackageState
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO ExternalPackageState
    hscEPS HscEnv
    hsc_env
           ; let unit_env :: UnitEnv
    unit_env = HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env
                 this_mod :: Module
    this_mod = TcGblEnv -> Module
    tcg_mod TcGblEnv
    tcg_env
                 type_env :: TypeEnv
    type_env = TcGblEnv -> TypeEnv
    tcg_type_env TcGblEnv
    tcg_env
                 rdr_env :: GlobalRdrEnv
    rdr_env  = TcGblEnv -> GlobalRdrEnv
    tcg_rdr_env TcGblEnv
    tcg_env
                 fam_inst_env :: FamInstEnv
    fam_inst_env = TcGblEnv -> FamInstEnv
    tcg_fam_inst_env TcGblEnv
    tcg_env
                 complete_matches :: [CompleteMatch]
    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 :: TcRef (ModuleEnv Int)
    next_wrapper_num_var = TcGblEnv -> TcRef (ModuleEnv Int)
    tcg_next_wrapper_num TcGblEnv
    tcg_env
           ; (DsGblEnv, DsLclEnv) -> m (DsGblEnv, DsLclEnv)
    forall a. a -> m a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((DsGblEnv, DsLclEnv) -> m (DsGblEnv, DsLclEnv))
    -> (DsGblEnv, DsLclEnv) -> m (DsGblEnv, DsLclEnv)
    forall a b. (a -> b) -> a -> b
    $ UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> 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
                               IORef (Messages DsMessage)
    msg_var IORef CostCentreState
    cc_st_var TcRef (ModuleEnv Int)
    next_wrapper_num_var [CompleteMatch]
    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 { Either IOEnvFailure a
    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)
           ; Messages DsMessage
    msgs   <- IORef (Messages DsMessage) -> IO (Messages DsMessage)
    forall a. IORef a -> IO a
    readIORef (DsGblEnv -> IORef (Messages DsMessage)
    ds_msgs DsGblEnv
    ds_gbl)
           ; let final_res :: Maybe a
    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. String -> a
    panic String
    "initDs"
           ; (Messages DsMessage, Maybe a) -> IO (Messages DsMessage, Maybe a)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages DsMessage
    msgs, Maybe a
    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 { IORef CostCentreState
    cc_st_var   <- CostCentreState -> IO (IORef CostCentreState)
    forall a. a -> IO (IORef a)
    newIORef CostCentreState
    newCostCentreState
           ; TcRef (ModuleEnv Int)
    next_wrapper_num <- ModuleEnv Int -> IO (TcRef (ModuleEnv Int))
    forall a. a -> IO (IORef a)
    newIORef ModuleEnv Int
    forall a. ModuleEnv a
    emptyModuleEnv
           ; IORef (Messages DsMessage)
    msg_var <- Messages DsMessage -> IO (IORef (Messages DsMessage))
    forall a. a -> IO (IORef a)
    newIORef Messages DsMessage
    forall e. Messages e
    emptyMessages
           ; ExternalPackageState
    eps <- IO ExternalPackageState -> IO ExternalPackageState
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ExternalPackageState -> IO ExternalPackageState)
    -> IO ExternalPackageState -> IO ExternalPackageState
    forall a b. (a -> b) -> a -> b
    $ HscEnv -> IO ExternalPackageState
    hscEPS HscEnv
    hsc_env
           ; let unit_env :: UnitEnv
    unit_env = HscEnv -> UnitEnv
    hsc_unit_env HscEnv
    hsc_env
                 type_env :: TypeEnv
    type_env = [Id] -> [TyCon] -> [PatSyn] -> [FamInst] -> TypeEnv
    typeEnvFromEntities [Id]
    ids [TyCon]
    tycons [PatSyn]
    patsyns [FamInst]
    fam_insts
                 complete_matches :: [CompleteMatch]
    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 :: Bind a -> [a]
    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 :: [Id]
    ids = (Bind Id -> [Id]) -> CoreProgram -> [Id]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Bind Id -> [Id]
    forall {a}. Bind a -> [a]
    bindsToIds CoreProgram
    binds

                 envs :: (DsGblEnv, DsLclEnv)
    envs  = UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> 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 IORef (Messages DsMessage)
    msg_var IORef CostCentreState
    cc_st_var
                                  TcRef (ModuleEnv Int)
    next_wrapper_num [CompleteMatch]
    complete_matches
           ; HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DsMessage, Maybe a)
    forall a.
    HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DsMessage, Maybe a)
    runDs HscEnv
    hsc_env (DsGblEnv, DsLclEnv)
    envs DsM a
    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 { (DsGblEnv
    gbl, DsLclEnv
    lcl) <- TcRnIf DsGblEnv DsLclEnv (DsGblEnv, DsLclEnv)
    forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs
           ; HscEnv
    hsc_env    <- TcRnIf DsGblEnv DsLclEnv HscEnv
    forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv

           ; let DsGblEnv { ds_mod :: DsGblEnv -> Module
    ds_mod = Module
    mod
                          , ds_fam_inst_env :: DsGblEnv -> FamInstEnv
    ds_fam_inst_env = FamInstEnv
    fam_inst_env
                          , ds_gbl_rdr_env :: DsGblEnv -> GlobalRdrEnv
    ds_gbl_rdr_env  = GlobalRdrEnv
    rdr_env }      = DsGblEnv
    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 :: DsLclEnv -> RealSrcSpan
    dsl_loc = RealSrcSpan
    loc }                  = DsLclEnv
    lcl

           ; (Messages TcRnMessage
    msgs, Maybe a
    mb_ret) <- IO (Messages TcRnMessage, Maybe a)
    -> IOEnv (Env DsGblEnv DsLclEnv) (Messages TcRnMessage, Maybe a)
    forall a. IO a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO (Messages TcRnMessage, Maybe a)
     -> IOEnv (Env DsGblEnv DsLclEnv) (Messages TcRnMessage, Maybe a))
    -> IO (Messages TcRnMessage, Maybe a)
    -> IOEnv (Env DsGblEnv DsLclEnv) (Messages TcRnMessage, Maybe a)
    forall a b. (a -> b) -> a -> b
    $ HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM a
    -> IO (Messages TcRnMessage, Maybe a)
    forall r.
    HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages TcRnMessage, Maybe r)
    initTc HscEnv
    hsc_env HscSource
    HsSrcFile Bool
    False Module
    mod RealSrcSpan
    loc (TcM a -> IO (Messages TcRnMessage, Maybe a))
    -> TcM a -> IO (Messages TcRnMessage, Maybe a)
    forall a b. (a -> b) -> a -> b
    $
             (TcGblEnv -> TcGblEnv) -> TcM a -> TcM a
    forall gbl lcl a.
    (gbl -> gbl) -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    updGblEnv (\TcGblEnv
    tc_gbl -> TcGblEnv
    tc_gbl { tcg_fam_inst_env :: FamInstEnv
    tcg_fam_inst_env = FamInstEnv
    fam_inst_env
                                          , tcg_rdr_env :: GlobalRdrEnv
    tcg_rdr_env      = GlobalRdrEnv
    rdr_env }) (TcM a -> TcM a) -> TcM a -> TcM a
    forall a b. (a -> b) -> a -> b
    $
             TcM a
    thing_inside
           ; case Maybe a
    mb_ret of
               Just a
    ret -> a -> DsM 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 -> DsM a
    forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "initTcDsForSolver" ([SDoc] -> SDoc
    vcat ([SDoc] -> SDoc) -> [SDoc] -> SDoc
    forall a b. (a -> b) -> a -> b
    $ Bag (MsgEnvelope TcRnMessage) -> [SDoc]
    forall e. Diagnostic e => Bag (MsgEnvelope e) -> [SDoc]
    pprMsgEnvelopeBagWithLoc (Messages TcRnMessage -> Bag (MsgEnvelope TcRnMessage)
    forall e. Diagnostic e => Messages e -> Bag (MsgEnvelope e)
    getErrorMessages Messages TcRnMessage
    msgs)) }

    mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
             -> IORef (Messages DsMessage) -> IORef CostCentreState
             -> IORef (ModuleEnv Int) -> CompleteMatches
             -> (DsGblEnv, DsLclEnv)
    mkDsEnvs :: UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> 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 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
    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
    text String
    "GHC error in desugarer lookup in" SDoc -> SDoc -> SDoc
    <+> 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_unqual :: PrintUnqualified
    ds_unqual  = UnitEnv -> GlobalRdrEnv -> PrintUnqualified
    mkPrintUnqualified 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
                               }
        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 :: Id -> Mult -> Mult -> DsM Id
    newUniqueId Id
    id = FastString -> Mult -> Mult -> DsM Id
    forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Mult -> Mult -> m Id
    mkSysLocalOrCoVarM (OccName -> FastString
    occNameFS (Name -> OccName
    nameOccName (Id -> Name
    idName Id
    id)))

    duplicateLocalDs :: Id -> DsM Id
    duplicateLocalDs :: Id -> DsM Id
    duplicateLocalDs Id
    old_local
      = do  { Unique
    uniq <- TcRnIf DsGblEnv DsLclEnv Unique
    forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
            ; Id -> DsM Id
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> Unique -> Id
    setIdUnique Id
    old_local Unique
    uniq) }

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

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

    newSysLocalsDs :: [Scaled Type] -> DsM [Id]
    newSysLocalsDs :: [Scaled Mult] -> DsM [Id]
    newSysLocalsDs = (Scaled Mult -> DsM Id) -> [Scaled Mult] -> DsM [Id]
    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 Id
    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 { DsLclEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; Nablas -> DsM Nablas
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DsLclEnv -> Nablas
    dsl_nablas DsLclEnv
    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
    dsl_nablas = Nablas
    nablas })

    getSrcSpanDs :: DsM SrcSpan
    getSrcSpanDs :: DsM SrcSpan
    getSrcSpanDs = do { DsLclEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
                      ; SrcSpan -> DsM SrcSpan
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (DsLclEnv -> RealSrcSpan
    dsl_loc DsLclEnv
    env) Maybe BufSpan
    forall a. Maybe a
    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 :: RealSrcSpan
    dsl_loc = RealSrcSpan
    real_span}) DsM a
    thing_inside

    putSrcSpanDsA :: SrcSpanAnn' ann -> DsM a -> DsM a
    putSrcSpanDsA :: forall ann a. SrcSpanAnn' ann -> DsM a -> DsM a
    putSrcSpanDsA SrcSpanAnn' ann
    loc = SrcSpan -> DsM a -> DsM a
    forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (SrcSpanAnn' ann -> SrcSpan
    forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnn' 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 { DsGblEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; SrcSpan
    loc <- DsM SrcSpan
    getSrcSpanDs
           ; !DiagOpts
    diag_opts <- DynFlags -> DiagOpts
    initDiagOpts (DynFlags -> DiagOpts)
    -> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    -> IOEnv (Env DsGblEnv DsLclEnv) DiagOpts
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           ; let msg :: MsgEnvelope DsMessage
    msg = DiagOpts
    -> SrcSpan
    -> PrintUnqualified
    -> DsMessage
    -> MsgEnvelope DsMessage
    forall e.
    Diagnostic e =>
    DiagOpts -> SrcSpan -> PrintUnqualified -> e -> MsgEnvelope e
    mkMsgEnvelope DiagOpts
    diag_opts SrcSpan
    loc (DsGblEnv -> PrintUnqualified
    ds_unqual DsGblEnv
    env) DsMessage
    dsMessage
           ; IORef (Messages DsMessage)
    -> (Messages DsMessage -> Messages DsMessage) -> DsM ()
    forall a env. IORef a -> (a -> a) -> IOEnv env ()
    updMutVar (DsGblEnv -> IORef (Messages DsMessage)
    ds_msgs DsGblEnv
    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) }

    -- | 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
            ; DsM 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

    mkPrintUnqualifiedDs :: DsM PrintUnqualified
    mkPrintUnqualifiedDs :: DsM PrintUnqualified
    mkPrintUnqualifiedDs = DsGblEnv -> PrintUnqualified
    ds_unqual (DsGblEnv -> PrintUnqualified)
    -> TcRnIf DsGblEnv DsLclEnv DsGblEnv -> DsM PrintUnqualified
    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  { DsGblEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; (IfGblEnv, IfLclEnv)
    -> TcRnIf IfGblEnv IfLclEnv TyThing
    -> IOEnv (Env DsGblEnv DsLclEnv) TyThing
    forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (DsGblEnv -> (IfGblEnv, IfLclEnv)
    ds_if_env DsGblEnv
    env)
                      (Name -> TcRnIf IfGblEnv IfLclEnv TyThing
    tcIfaceGlobal Name
    name) }

    dsLookupGlobalId :: Name -> DsM Id
    dsLookupGlobalId :: Name -> DsM Id
    dsLookupGlobalId Name
    name
      = (() :: Constraint) => TyThing -> Id
    TyThing -> Id
    tyThingId (TyThing -> Id) -> IOEnv (Env DsGblEnv DsLclEnv) TyThing -> DsM Id
    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
      = (() :: Constraint) => 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
      = (() :: Constraint) => 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
      = (() :: Constraint) => 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 { ExternalPackageState
    eps <- TcRnIf DsGblEnv DsLclEnv ExternalPackageState
    forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
    getEps; DsGblEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; FamInstEnvs -> DsM FamInstEnvs
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ExternalPackageState -> FamInstEnv
    eps_fam_inst_env ExternalPackageState
    eps, DsGblEnv -> FamInstEnv
    ds_fam_inst_env DsGblEnv
    env) }

    dsGetMetaEnv :: DsM (NameEnv DsMetaVal)
    dsGetMetaEnv :: DsM DsMetaEnv
    dsGetMetaEnv = do { DsLclEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; DsMetaEnv -> DsM DsMetaEnv
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DsLclEnv -> DsMetaEnv
    dsl_meta DsLclEnv
    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 { DsLclEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsLclEnv
    forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; Maybe DsMetaVal -> DsM (Maybe DsMetaVal)
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (DsMetaEnv -> Name -> Maybe DsMetaVal
    forall a. NameEnv a -> Name -> Maybe a
    lookupNameEnv (DsLclEnv -> DsMetaEnv
    dsl_meta DsLclEnv
    env) Name
    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 :: DsMetaEnv
    dsl_meta = DsLclEnv -> DsMetaEnv
    dsl_meta DsLclEnv
    env DsMetaEnv -> DsMetaEnv -> DsMetaEnv
    forall a. NameEnv a -> NameEnv a -> NameEnv a
    `plusNameEnv` DsMetaEnv
    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  { DsGblEnv
    env <- TcRnIf DsGblEnv DsLclEnv DsGblEnv
    forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; Messages DsMessage
    old_msgs <- IORef (Messages DsMessage)
    -> TcRnIf DsGblEnv DsLclEnv (Messages DsMessage)
    forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef (DsGblEnv -> IORef (Messages DsMessage)
    ds_msgs DsGblEnv
    env)

            ; a
    result <- DsM a
    thing_inside

            -- Revert messages to old_msgs
            ; IORef (Messages DsMessage) -> Messages DsMessage -> DsM ()
    forall a gbl lcl. TcRef a -> a -> TcRnIf gbl lcl ()
    writeTcRef (DsGblEnv -> IORef (Messages DsMessage)
    ds_msgs DsGblEnv
    env) Messages DsMessage
    old_msgs

            ; a -> DsM a
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return a
    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
      Id
    traceId <- Name -> DsM Id
    dsLookupGlobalId Name
    traceName
      Id
    unpackCStringId <- Name -> DsM Id
    dsLookupGlobalId Name
    unpackCStringName
      DynFlags
    dflags <- IOEnv (Env DsGblEnv DsLclEnv) DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      let message :: CoreExpr
          message :: CoreExpr
    message = CoreExpr -> DsWrapper
    forall b. Expr b -> Expr b -> Expr b
    App (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    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
    text String
    str) Int
    4 SDoc
    doc)
      CoreExpr -> DsM CoreExpr
    forall a. a -> IOEnv (Env DsGblEnv DsLclEnv) a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CoreExpr -> DsM CoreExpr) -> CoreExpr -> DsM CoreExpr
    forall a b. (a -> b) -> a -> b
    $ CoreExpr -> [CoreExpr] -> CoreExpr
    forall b. Expr b -> [Expr b] -> Expr b
    mkApps (Id -> CoreExpr
    forall b. Id -> Expr b
    Var Id
    traceId) [Mult -> CoreExpr
    forall b. Mult -> Expr b
    Type ((() :: Constraint) => CoreExpr -> Mult
    CoreExpr -> Mult
    exprType CoreExpr
    expr), CoreExpr
    message, CoreExpr
    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