    {-# 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, newSysLocalDsNoLP, newSysLocalDs,
            newSysLocalsDsNoLP, 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, warnDs, warnIfSetDs, errDs, errDsCoreExpr,
            failWithDs, failDs, discardWarningsDs,
            askNoErrsDs,

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

            -- Levity polymorphism
            dsNoLevPoly, dsNoLevPolyExpr, dsWhenNoErrs,

            -- Trace injection
            pprRuntimeTrace
        ) where

    import GHC.Prelude

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

    import GHC.Hs

    import GHC.HsToCore.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, isExprLevPoly )
    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.Tc.Utils.TcMType ( checkForLevPolyX, formatLevPolyErr )

    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.Outputable
    import GHC.Utils.Panic
    import GHC.Utils.Error

    import Data.IORef

    {-
    ************************************************************************
    *                                                                      *
                    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) = forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    ss SDoc -> SDoc -> 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
    _) = 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 -> 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
    <$ :: forall a b. a -> MatchResult b -> MatchResult a
    $c<$ :: forall a b. a -> MatchResult b -> MatchResult a
    fmap :: forall a b. (a -> b) -> MatchResult a -> MatchResult b
    $cfmap :: forall a b. (a -> b) -> MatchResult a -> MatchResult b
    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 = forall a. DsM a -> MatchResult a
    MR_Infallible (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 = forall a. DsM a -> MatchResult a
    MR_Infallible (DsM (a -> b)
    f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> DsM a
    x)
      MatchResult (a -> b)
    f <*> MatchResult a
    x = forall a. (CoreExpr -> DsM a) -> MatchResult a
    MR_Fallible forall a b. (a -> b) -> a -> b
    $ \CoreExpr
    fail -> forall a. CoreExpr -> MatchResult a -> DsM a
    runMatchResult CoreExpr
    fail MatchResult (a -> b)
    f forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> 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    = 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 a
    initDsTc :: forall a. DsM a -> TcM a
    initDsTc DsM a
    thing_inside
      = do { TcGblEnv
    tcg_env  <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; TcRef (Messages DecoratedSDoc)
    msg_var  <- TcRn (TcRef (Messages DecoratedSDoc))
    getErrsVar
           ; HscEnv
    hsc_env  <- forall gbl lcl. TcRnIf gbl lcl HscEnv
    getTopEnv
           ; (DsGblEnv, DsLclEnv)
    envs     <- forall (m :: * -> *).
    MonadIO m =>
    HscEnv
    -> TcRef (Messages DecoratedSDoc)
    -> TcGblEnv
    -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl HscEnv
    hsc_env TcRef (Messages DecoratedSDoc)
    msg_var TcGblEnv
    tcg_env
           ; forall gbl' lcl' a gbl lcl.
    (gbl', lcl') -> TcRnIf gbl' lcl' a -> TcRnIf gbl lcl a
    setEnvs (DsGblEnv, DsLclEnv)
    envs DsM a
    thing_inside
           }

    -- | Run a 'DsM' action inside the 'IO' monad.
    initDs :: HscEnv -> TcGblEnv -> DsM a -> IO (Messages DecoratedSDoc, Maybe a)
    initDs :: forall a.
    HscEnv -> TcGblEnv -> DsM a -> IO (Messages DecoratedSDoc, Maybe a)
    initDs HscEnv
    hsc_env TcGblEnv
    tcg_env DsM a
    thing_inside
      = do { TcRef (Messages DecoratedSDoc)
    msg_var <- forall a. a -> IO (IORef a)
    newIORef forall e. Messages e
    emptyMessages
           ; (DsGblEnv, DsLclEnv)
    envs <- forall (m :: * -> *).
    MonadIO m =>
    HscEnv
    -> TcRef (Messages DecoratedSDoc)
    -> TcGblEnv
    -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl HscEnv
    hsc_env TcRef (Messages DecoratedSDoc)
    msg_var TcGblEnv
    tcg_env
           ; forall a.
    HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DecoratedSDoc, 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 DecoratedSDoc) -> TcGblEnv
                      -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl :: forall (m :: * -> *).
    MonadIO m =>
    HscEnv
    -> TcRef (Messages DecoratedSDoc)
    -> TcGblEnv
    -> m (DsGblEnv, DsLclEnv)
    mkDsEnvsFromTcGbl HscEnv
    hsc_env TcRef (Messages DecoratedSDoc)
    msg_var TcGblEnv
    tcg_env
      = do { IORef CostCentreState
    cc_st_var   <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall a. a -> IO (IORef a)
    newIORef CostCentreState
    newCostCentreState
           ; ExternalPackageState
    eps <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO 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
                                    forall a. [a] -> [a] -> [a]
    ++ TcGblEnv -> [CompleteMatch]
    tcg_complete_matches TcGblEnv
    tcg_env -- from the current module
                                    forall a. [a] -> [a] -> [a]
    ++ ExternalPackageState -> [CompleteMatch]
    eps_complete_matches ExternalPackageState
    eps     -- from imports
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> TcRef (Messages DecoratedSDoc)
    -> IORef CostCentreState
    -> [CompleteMatch]
    -> (DsGblEnv, DsLclEnv)
    mkDsEnvs UnitEnv
    unit_env Module
    this_mod GlobalRdrEnv
    rdr_env TypeEnv
    type_env FamInstEnv
    fam_inst_env
                               TcRef (Messages DecoratedSDoc)
    msg_var IORef CostCentreState
    cc_st_var [CompleteMatch]
    complete_matches
           }

    runDs :: HscEnv -> (DsGblEnv, DsLclEnv) -> DsM a -> IO (Messages DecoratedSDoc, Maybe a)
    runDs :: forall a.
    HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DecoratedSDoc, Maybe a)
    runDs HscEnv
    hsc_env (DsGblEnv
    ds_gbl, DsLclEnv
    ds_lcl) DsM a
    thing_inside
      = do { Either IOEnvFailure a
    res    <- 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
                                  (forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM DsM a
    thing_inside)
           ; Messages DecoratedSDoc
    msgs   <- forall a. IORef a -> IO a
    readIORef (DsGblEnv -> TcRef (Messages DecoratedSDoc)
    ds_msgs DsGblEnv
    ds_gbl)
           ; let final_res :: Maybe a
    final_res
                   | forall e. Messages e -> Bool
    errorsFound Messages DecoratedSDoc
    msgs = forall a. Maybe a
    Nothing
                   | Right a
    r <- Either IOEnvFailure a
    res   = forall a. a -> Maybe a
    Just a
    r
                   | Bool
    otherwise        = forall a. String -> a
    panic String
    "initDs"
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Messages DecoratedSDoc
    msgs, Maybe a
    final_res)
           }

    -- | Run a 'DsM' action in the context of an existing 'ModGuts'
    initDsWithModGuts :: HscEnv -> ModGuts -> DsM a -> IO (Messages DecoratedSDoc, Maybe a)
    initDsWithModGuts :: forall a.
    HscEnv -> ModGuts -> DsM a -> IO (Messages DecoratedSDoc, 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   <- forall a. a -> IO (IORef a)
    newIORef CostCentreState
    newCostCentreState
           ; TcRef (Messages DecoratedSDoc)
    msg_var <- forall a. a -> IO (IORef a)
    newIORef forall e. Messages e
    emptyMessages
           ; ExternalPackageState
    eps <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO 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
                                    forall a. [a] -> [a] -> [a]
    ++ [CompleteMatch]
    local_complete_matches  -- from the current module
                                    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) = forall a b. (a -> b) -> [a] -> [b]
    map forall a b. (a, b) -> a
    fst [(a, Expr a)]
    binds
                 ids :: [Id]
    ids = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap forall {a}. Bind a -> [a]
    bindsToIds CoreProgram
    binds

                 envs :: (DsGblEnv, DsLclEnv)
    envs  = UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> TcRef (Messages DecoratedSDoc)
    -> IORef CostCentreState
    -> [CompleteMatch]
    -> (DsGblEnv, DsLclEnv)
    mkDsEnvs UnitEnv
    unit_env Module
    this_mod GlobalRdrEnv
    rdr_env TypeEnv
    type_env
                                  FamInstEnv
    fam_inst_env TcRef (Messages DecoratedSDoc)
    msg_var IORef CostCentreState
    cc_st_var
                                  [CompleteMatch]
    complete_matches
           ; forall a.
    HscEnv
    -> (DsGblEnv, DsLclEnv)
    -> DsM a
    -> IO (Messages DecoratedSDoc, 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) <- forall gbl lcl. TcRnIf gbl lcl (gbl, lcl)
    getEnvs
           ; HscEnv
    hsc_env    <- 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 DecoratedSDoc
    msgs, Maybe a
    mb_ret) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO forall a b. (a -> b) -> a -> b
    $ forall r.
    HscEnv
    -> HscSource
    -> Bool
    -> Module
    -> RealSrcSpan
    -> TcM r
    -> IO (Messages DecoratedSDoc, Maybe r)
    initTc HscEnv
    hsc_env HscSource
    HsSrcFile Bool
    False Module
    mod RealSrcSpan
    loc forall a b. (a -> b) -> a -> b
    $
             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 }) forall a b. (a -> b) -> a -> b
    $
             TcM a
    thing_inside
           ; case Maybe a
    mb_ret of
               Just a
    ret -> forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    ret
               Maybe a
    Nothing  -> forall a. HasCallStack => String -> SDoc -> a
    pprPanic String
    "initTcDsForSolver" ([SDoc] -> SDoc
    vcat forall a b. (a -> b) -> a -> b
    $ Bag (MsgEnvelope DecoratedSDoc) -> [SDoc]
    pprMsgEnvelopeBagWithLoc (forall e. Messages e -> Bag (MsgEnvelope e)
    getErrorMessages Messages DecoratedSDoc
    msgs)) }

    mkDsEnvs :: UnitEnv -> Module -> GlobalRdrEnv -> TypeEnv -> FamInstEnv
             -> IORef (Messages DecoratedSDoc) -> IORef CostCentreState -> CompleteMatches
             -> (DsGblEnv, DsLclEnv)
    mkDsEnvs :: UnitEnv
    -> Module
    -> GlobalRdrEnv
    -> TypeEnv
    -> FamInstEnv
    -> TcRef (Messages DecoratedSDoc)
    -> IORef CostCentreState
    -> [CompleteMatch]
    -> (DsGblEnv, DsLclEnv)
    mkDsEnvs UnitEnv
    unit_env Module
    mod GlobalRdrEnv
    rdr_env TypeEnv
    type_env FamInstEnv
    fam_inst_env TcRef (Messages DecoratedSDoc)
    msg_var IORef CostCentreState
    cc_st_var
             [CompleteMatch]
    complete_matches
      = let if_genv :: IfGblEnv
    if_genv = IfGblEnv { if_doc :: SDoc
    if_doc       = String -> SDoc
    text String
    "mkDsEnvs",
                                 if_rec_types :: Maybe (Module, IfG TypeEnv)
    if_rec_types = forall a. a -> Maybe a
    Just (Module
    mod, forall (m :: * -> *) a. Monad m => a -> m a
    return TypeEnv
    type_env) }
            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
    <+> 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 (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 :: TcRef (Messages DecoratedSDoc)
    ds_msgs    = TcRef (Messages DecoratedSDoc)
    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
                               }
            lcl_env :: DsLclEnv
    lcl_env = DsLclEnv { dsl_meta :: DsMetaEnv
    dsl_meta    = 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.

    Note [Levity polymorphism checking]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    According to the "Levity Polymorphism" paper (PLDI '17), levity
    polymorphism is forbidden in precisely two places: in the type of a bound
    term-level argument and in the type of an argument to a function. The paper
    explains it more fully, but briefly: expressions in these contexts need to be
    stored in registers, and it's hard (read, impossible) to store something
    that's levity polymorphic.

    We cannot check for bad levity polymorphism conveniently in the type checker,
    because we can't tell, a priori, which levity metavariables will be solved.
    At one point, I (Richard) thought we could check in the zonker, but it's hard
    to know where precisely are the abstracted variables and the arguments. So
    we check in the desugarer, the only place where we can see the Core code and
    still report respectable syntax to the user. This covers the vast majority
    of cases; see calls to GHC.HsToCore.Monad.dsNoLevPoly and friends.

    Levity polymorphism is also prohibited in the types of binders, and the
    desugarer checks for this in GHC-generated Ids. (The zonker handles
    the user-writted ids in zonkIdBndr.) This is done in newSysLocalDsNoLP.
    The newSysLocalDs variant is used in the vast majority of cases where
    the binder is obviously not levity polymorphic, omitting the check.
    It would be nice to ASSERT that there is no levity polymorphism here,
    but we can't, because of the fixM in GHC.HsToCore.Arrows. It's all OK, though:
    Core Lint will catch an error here.

    However, the desugarer is the wrong place for certain checks. In particular,
    the desugarer can't report a sensible error message if an HsWrapper is malformed.
    After all, GHC itself produced the HsWrapper. So we store some message text
    in the appropriate HsWrappers (e.g. WpFun) that we can print out in the
    desugarer.

    There are a few more checks in places where Core is generated outside the
    desugarer. For example, in datatype and class declarations, where levity
    polymorphism is checked for during validity checking. It would be nice to
    have one central place for all this, but that doesn't seem possible while
    still reporting nice error messages.

    -}

    -- Make a new Id with the same print name, but different type, and new unique
    newUniqueId :: Id -> Mult -> Type -> DsM Id
    newUniqueId :: Id -> Type -> Type -> DsM Id
    newUniqueId Id
    id = FastString -> Type -> Type -> DsM Id
    mk_local (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 <- forall gbl lcl. TcRnIf gbl lcl Unique
    newUnique
            ; forall (m :: * -> *) a. Monad m => a -> m a
    return (Id -> Unique -> Id
    setIdUnique Id
    old_local Unique
    uniq) }

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

    newSysLocalDsNoLP, newSysLocalDs, newFailLocalDs :: Mult -> Type -> DsM Id
    newSysLocalDsNoLP :: Type -> Type -> DsM Id
    newSysLocalDsNoLP  = FastString -> Type -> Type -> DsM Id
    mk_local (String -> FastString
    fsLit String
    "ds")

    -- this variant should be used when the caller can be sure that the variable type
    -- is not levity-polymorphic. It is necessary when the type is knot-tied because
    -- of the fixM used in GHC.HsToCore.Arrows. See Note [Levity polymorphism checking]
    newSysLocalDs :: Type -> Type -> DsM Id
    newSysLocalDs = forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Type -> Type -> m Id
    mkSysLocalM (String -> FastString
    fsLit String
    "ds")
    newFailLocalDs :: Type -> Type -> DsM Id
    newFailLocalDs = forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Type -> Type -> m Id
    mkSysLocalM (String -> FastString
    fsLit String
    "fail")
      -- the fail variable is used only in a situation where we can tell that
      -- levity-polymorphism is impossible.

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

    mk_local :: FastString -> Mult -> Type -> DsM Id
    mk_local :: FastString -> Type -> Type -> DsM Id
    mk_local FastString
    fs Type
    w Type
    ty = do { Type -> SDoc -> DsM ()
    dsNoLevPoly Type
    ty (String -> SDoc
    text String
    "When trying to create a variable of type:" SDoc -> SDoc -> SDoc
    <+>
                                            forall a. Outputable a => a -> SDoc
    ppr Type
    ty)  -- could improve the msg with another
                                                     -- parameter indicating context
                          ; forall (m :: * -> *).
    MonadUnique m =>
    FastString -> Type -> Type -> m Id
    mkSysLocalOrCoVarM FastString
    fs Type
    w Type
    ty }

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

    getGhcModeDs :: DsM GhcMode
    getGhcModeDs :: DsM GhcMode
    getGhcModeDs =  forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= forall (m :: * -> *) a. Monad m => a -> m a
    return 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 <- forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; 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 = 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 <- forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv
                      ; forall (m :: * -> *) a. Monad m => a -> m a
    return (RealSrcSpan -> Maybe BufSpan -> SrcSpan
    RealSrcSpan (DsLclEnv -> RealSrcSpan
    dsl_loc DsLclEnv
    env) forall a. Maybe a
    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
      = 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 = forall a. SrcSpan -> DsM a -> DsM a
    putSrcSpanDs (forall a. SrcSpanAnn' a -> SrcSpan
    locA SrcSpanAnn' ann
    loc)

    -- | Emit a warning for the current source location
    -- NB: Warns whether or not -Wxyz is set
    warnDs :: WarnReason -> SDoc -> DsM ()
    warnDs :: WarnReason -> SDoc -> DsM ()
    warnDs WarnReason
    reason SDoc
    warn
      = do { DsGblEnv
    env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; SrcSpan
    loc <- DsM SrcSpan
    getSrcSpanDs
           ; let msg :: MsgEnvelope DecoratedSDoc
    msg = forall e. WarnReason -> MsgEnvelope e -> MsgEnvelope e
    makeIntoWarning WarnReason
    reason forall a b. (a -> b) -> a -> b
    $
                       SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkWarnMsg SrcSpan
    loc (DsGblEnv -> PrintUnqualified
    ds_unqual DsGblEnv
    env) SDoc
    warn
           ; forall a env. IORef a -> (a -> a) -> IOEnv env ()
    updMutVar (DsGblEnv -> TcRef (Messages DecoratedSDoc)
    ds_msgs DsGblEnv
    env) (\ Messages DecoratedSDoc
    msgs -> MsgEnvelope DecoratedSDoc
    msg forall e. MsgEnvelope e -> Messages e -> Messages e
    `addMessage` Messages DecoratedSDoc
    msgs) }

    -- | Emit a warning only if the correct WarnReason is set in the DynFlags
    warnIfSetDs :: WarningFlag -> SDoc -> DsM ()
    warnIfSetDs :: WarningFlag -> SDoc -> DsM ()
    warnIfSetDs WarningFlag
    flag SDoc
    warn
      = forall gbl lcl.
    WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
    whenWOptM WarningFlag
    flag forall a b. (a -> b) -> a -> b
    $
        WarnReason -> SDoc -> DsM ()
    warnDs (WarningFlag -> WarnReason
    Reason WarningFlag
    flag) SDoc
    warn

    errDs :: SDoc -> DsM ()
    errDs :: SDoc -> DsM ()
    errDs SDoc
    err
      = do  { DsGblEnv
    env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; SrcSpan
    loc <- DsM SrcSpan
    getSrcSpanDs
            ; let msg :: MsgEnvelope DecoratedSDoc
    msg = SrcSpan -> PrintUnqualified -> SDoc -> MsgEnvelope DecoratedSDoc
    mkMsgEnvelope SrcSpan
    loc (DsGblEnv -> PrintUnqualified
    ds_unqual DsGblEnv
    env) SDoc
    err
            ; forall a env. IORef a -> (a -> a) -> IOEnv env ()
    updMutVar (DsGblEnv -> TcRef (Messages DecoratedSDoc)
    ds_msgs DsGblEnv
    env) (\ Messages DecoratedSDoc
    msgs -> MsgEnvelope DecoratedSDoc
    msg forall e. MsgEnvelope e -> Messages e -> Messages e
    `addMessage` Messages DecoratedSDoc
    msgs) }

    -- | Issue an error, but return the expression for (), so that we can continue
    -- reporting errors.
    errDsCoreExpr :: SDoc -> DsM CoreExpr
    errDsCoreExpr :: SDoc -> DsM CoreExpr
    errDsCoreExpr SDoc
    err
      = do { SDoc -> DsM ()
    errDs SDoc
    err
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return CoreExpr
    unitExpr }

    failWithDs :: SDoc -> DsM a
    failWithDs :: forall a. SDoc -> DsM a
    failWithDs SDoc
    err
      = do  { SDoc -> DsM ()
    errDs SDoc
    err
            ; forall env a. IOEnv env a
    failM }

    failDs :: DsM a
    failDs :: forall a. DsM a
    failDs = forall env a. IOEnv env a
    failM

    -- (askNoErrsDs m) runs m
    -- If m fails,
    --    then (askNoErrsDs m) fails
    -- If m succeeds with result r,
    --    then (askNoErrsDs m) succeeds with result (r, b),
    --         where b is True iff m generated no errors
    -- Regardless of success or failure,
    --   propagate any errors/warnings generated by m
    --
    -- c.f. GHC.Tc.Utils.Monad.askNoErrs
    askNoErrsDs :: DsM a -> DsM (a, Bool)
    askNoErrsDs :: forall a. DsM a -> DsM (a, Bool)
    askNoErrsDs DsM a
    thing_inside
     = do { TcRef (Messages DecoratedSDoc)
    errs_var <- forall a env. a -> IOEnv env (IORef a)
    newMutVar forall e. Messages e
    emptyMessages
          ; DsGblEnv
    env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
          ; Either IOEnvFailure a
    mb_res <- forall env r. IOEnv env r -> IOEnv env (Either IOEnvFailure r)
    tryM forall a b. (a -> b) -> a -> b
    $  -- Be careful to catch exceptions
                              -- so that we propagate errors correctly
                              -- (#13642)
                      forall gbl lcl a. gbl -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
    setGblEnv (DsGblEnv
    env { ds_msgs :: TcRef (Messages DecoratedSDoc)
    ds_msgs = TcRef (Messages DecoratedSDoc)
    errs_var }) forall a b. (a -> b) -> a -> b
    $
                      DsM a
    thing_inside

          -- Propagate errors
          ; Messages DecoratedSDoc
    msgs <- forall a env. IORef a -> IOEnv env a
    readMutVar TcRef (Messages DecoratedSDoc)
    errs_var
          ; forall a env. IORef a -> (a -> a) -> IOEnv env ()
    updMutVar (DsGblEnv -> TcRef (Messages DecoratedSDoc)
    ds_msgs DsGblEnv
    env) (forall e. Messages e -> Messages e -> Messages e
    unionMessages Messages DecoratedSDoc
    msgs)

          -- And return
          ; case Either IOEnvFailure a
    mb_res of
               Left IOEnvFailure
    _    -> forall env a. IOEnv env a
    failM
               Right a
    res -> do { let errs_found :: Bool
    errs_found = forall e. Messages e -> Bool
    errorsFound Messages DecoratedSDoc
    msgs
                               ; forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    res, Bool -> Bool
    not Bool
    errs_found) } }

    mkPrintUnqualifiedDs :: DsM PrintUnqualified
    mkPrintUnqualifiedDs :: DsM PrintUnqualified
    mkPrintUnqualifiedDs = DsGblEnv -> PrintUnqualified
    ds_unqual forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> 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 <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; 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 -> IfL TyThing
    tcIfaceGlobal Name
    name) }

    dsLookupGlobalId :: Name -> DsM Id
    dsLookupGlobalId :: Name -> DsM Id
    dsLookupGlobalId Name
    name
      = HasDebugCallStack => TyThing -> Id
    tyThingId 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
    tyThingTyCon 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
    tyThingDataCon 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
    tyThingConLike 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 <- forall gbl lcl. TcRnIf gbl lcl ExternalPackageState
    getEps; DsGblEnv
    env <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
           ; 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 <- forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv

    dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
    dsLookupMetaEnv :: Name -> DsM (Maybe DsMetaVal)
    dsLookupMetaEnv Name
    name = do { DsLclEnv
    env <- forall gbl lcl. TcRnIf gbl lcl lcl
    getLclEnv; forall (m :: * -> *) a. Monad m => a -> m a
    return (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
      = 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 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 <- forall gbl lcl. TcRnIf gbl lcl gbl
    getGblEnv
            ; Messages DecoratedSDoc
    old_msgs <- forall a gbl lcl. TcRef a -> TcRnIf gbl lcl a
    readTcRef (DsGblEnv -> TcRef (Messages DecoratedSDoc)
    ds_msgs DsGblEnv
    env)

            ; a
    result <- DsM a
    thing_inside

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

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

    -- | Fail with an error message if the type is levity polymorphic.
    dsNoLevPoly :: Type -> SDoc -> DsM ()
    -- See Note [Levity polymorphism checking]
    dsNoLevPoly :: Type -> SDoc -> DsM ()
    dsNoLevPoly Type
    ty SDoc
    doc = forall (m :: * -> *).
    Monad m =>
    (SDoc -> m ()) -> SDoc -> Type -> m ()
    checkForLevPolyX forall a. SDoc -> DsM a
    failWithDs SDoc
    doc Type
    ty

    -- | Check an expression for levity polymorphism, failing if it is
    -- levity polymorphic.
    dsNoLevPolyExpr :: CoreExpr -> SDoc -> DsM ()
    -- See Note [Levity polymorphism checking]
    dsNoLevPolyExpr :: CoreExpr -> SDoc -> DsM ()
    dsNoLevPolyExpr CoreExpr
    e SDoc
    doc
      | CoreExpr -> Bool
    isExprLevPoly CoreExpr
    e = SDoc -> DsM ()
    errDs (Type -> SDoc
    formatLevPolyErr (CoreExpr -> Type
    exprType CoreExpr
    e) SDoc -> SDoc -> SDoc
    $$ SDoc
    doc)
      | Bool
    otherwise       = forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    -- | Runs the thing_inside. If there are no errors, then returns the expr
    -- given. Otherwise, returns unitExpr. This is useful for doing a bunch
    -- of levity polymorphism checks and then avoiding making a core App.
    -- (If we make a core App on a levity polymorphic argument, detecting how
    -- to handle the let/app invariant might call isUnliftedType, which panics
    -- on a levity polymorphic type.)
    -- See #12709 for an example of why this machinery is necessary.
    dsWhenNoErrs :: DsM a -> (a -> CoreExpr) -> DsM CoreExpr
    dsWhenNoErrs :: forall a. DsM a -> (a -> CoreExpr) -> DsM CoreExpr
    dsWhenNoErrs DsM a
    thing_inside a -> CoreExpr
    mk_expr
      = do { (a
    result, Bool
    no_errs) <- forall a. DsM a -> DsM (a, Bool)
    askNoErrsDs DsM a
    thing_inside
           ; forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ if Bool
    no_errs
                      then a -> CoreExpr
    mk_expr a
    result
                      else CoreExpr
    unitExpr }

    -- | 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 <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      let message :: CoreExpr
          message :: CoreExpr
    message = forall b. Expr b -> Expr b -> Expr b
    App (forall b. Id -> Expr b
    Var Id
    unpackCStringId) forall a b. (a -> b) -> a -> b
    $
                    forall b. Literal -> Expr b
    Lit forall a b. (a -> b) -> a -> b
    $ String -> Literal
    mkLitString 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)
      forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ forall b. Expr b -> [Expr b] -> Expr b
    mkApps (forall b. Id -> Expr b
    Var Id
    traceId) [forall b. Type -> Expr b
    Type (CoreExpr -> Type
    exprType CoreExpr
    expr), CoreExpr
    message, CoreExpr
    expr]

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