    {-# LANGUAGE PatternSynonyms #-}
    {-
    (c) The AQUA Project, Glasgow University, 1993-1998

    \section[GHC.Core.Opt.Simplify.Monad]{The simplifier Monad}
    -}

    {-# LANGUAGE DeriveFunctor #-}
    module GHC.Core.Opt.Simplify.Monad (
            -- The monad
            SimplM,
            initSmpl, traceSmpl,
            getSimplRules, getFamEnvs, getOptCoercionOpts,

            -- Unique supply
            MonadUnique(..), newId, newJoinId,

            -- Counting
            SimplCount, tick, freeTick, checkedTick,
            getSimplCount, zeroSimplCount, pprSimplCount,
            plusSimplCount, isZeroSimplCount
        ) where

    import GHC.Prelude

    import GHC.Types.Var       ( Var, isId, mkLocalVar )
    import GHC.Types.Name      ( mkSystemVarName )
    import GHC.Types.Id        ( Id, mkSysLocalOrCoVar )
    import GHC.Types.Id.Info   ( IdDetails(..), vanillaIdInfo, setArityInfo )
    import GHC.Core.Type       ( Type, Mult )
    import GHC.Core.FamInstEnv ( FamInstEnv )
    import GHC.Core            ( RuleEnv(..) )
    import GHC.Core.Utils      ( mkLamTypes )
    import GHC.Core.Coercion.Opt
    import GHC.Types.Unique.Supply
    import GHC.Driver.Session
    import GHC.Driver.Config
    import GHC.Core.Opt.Monad
    import GHC.Utils.Outputable
    import GHC.Data.FastString
    import GHC.Utils.Monad
    import GHC.Utils.Logger as Logger
    import GHC.Utils.Misc      ( count )
    import GHC.Utils.Panic     (throwGhcExceptionIO, GhcException (..))
    import GHC.Types.Basic     ( IntWithInf, treatZeroAsInf, mkIntWithInf )
    import Control.Monad       ( ap )
    import GHC.Core.Multiplicity        ( pattern Many )
    import GHC.Exts( oneShot )

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Monad plumbing}
    *                                                                      *
    ************************************************************************

    For the simplifier monad, we want to {\em thread} a unique supply and a counter.
    (Command-line switches move around through the explicitly-passed SimplEnv.)
    -}

    newtype SimplM result
      =  SM'  { forall result.
    SimplM result
    -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    unSM :: SimplTopEnv  -- Envt that does not change much
                     -> SimplCount
                     -> IO (result, SimplCount)}
        -- We only need IO here for dump output, but since we already have it
        -- we might as well use it for uniques.

    pattern SM :: (SimplTopEnv -> SimplCount
                   -> IO (result, SimplCount))
              -> SimplM result
    -- This pattern synonym makes the simplifier monad eta-expand,
    -- which as a very beneficial effect on compiler performance
    -- (worth a 1-2% reduction in bytes-allocated).  See #18202.
    -- See Note [The one-shot state monad trick] in GHC.Utils.Monad
    pattern $mSM :: forall {r} {result}.
    SimplM result
    -> ((SimplTopEnv -> SimplCount -> IO (result, SimplCount)) -> r)
    -> ((# #) -> r)
    -> r
    $bSM :: forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM m <- SM' m
      where
        SM SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    m = (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM' ((SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    oneShot ((SimplTopEnv -> SimplCount -> IO (result, SimplCount))
     -> SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplTopEnv
    -> SimplCount
    -> IO (result, SimplCount)
    forall a b. (a -> b) -> a -> b
    $ \SimplTopEnv
    env -> (SimplCount -> IO (result, SimplCount))
    -> SimplCount -> IO (result, SimplCount)
    oneShot ((SimplCount -> IO (result, SimplCount))
     -> SimplCount -> IO (result, SimplCount))
    -> (SimplCount -> IO (result, SimplCount))
    -> SimplCount
    -> IO (result, SimplCount)
    forall a b. (a -> b) -> a -> b
    $ \SimplCount
    ct -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    m SimplTopEnv
    env SimplCount
    ct)

    data SimplTopEnv
      = STE { SimplTopEnv -> DynFlags
    st_flags     :: DynFlags
            , SimplTopEnv -> Logger
    st_logger    :: !Logger
            , SimplTopEnv -> IntWithInf
    st_max_ticks :: IntWithInf  -- ^ Max #ticks in this simplifier run
            , SimplTopEnv -> RuleEnv
    st_rules     :: RuleEnv
            , SimplTopEnv -> (FamInstEnv, FamInstEnv)
    st_fams      :: (FamInstEnv, FamInstEnv)

            , SimplTopEnv -> OptCoercionOpts
    st_co_opt_opts :: !OptCoercionOpts
                -- ^ Coercion optimiser options
            }

    initSmpl :: Logger -> DynFlags -> RuleEnv -> (FamInstEnv, FamInstEnv)
             -> Int                 -- Size of the bindings, used to limit
                                    -- the number of ticks we allow
             -> SimplM a
             -> IO (a, SimplCount)

    initSmpl :: forall a.
    Logger
    -> DynFlags
    -> RuleEnv
    -> (FamInstEnv, FamInstEnv)
    -> Int
    -> SimplM a
    -> IO (a, SimplCount)
    initSmpl Logger
    logger DynFlags
    dflags RuleEnv
    rules (FamInstEnv, FamInstEnv)
    fam_envs Int
    size SimplM a
    m
      = do -- No init count; set to 0
           let simplCount :: SimplCount
    simplCount = DynFlags -> SimplCount
    zeroSimplCount DynFlags
    dflags
           (a
    result, SimplCount
    count) <- SimplM a -> SimplTopEnv -> SimplCount -> IO (a, SimplCount)
    forall result.
    SimplM result
    -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    unSM SimplM a
    m SimplTopEnv
    env SimplCount
    simplCount
           (a, SimplCount) -> IO (a, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    result, SimplCount
    count)
      where
        env :: SimplTopEnv
    env = STE { st_flags :: DynFlags
    st_flags = DynFlags
    dflags
                  , st_logger :: Logger
    st_logger = Logger
    logger
                  , st_rules :: RuleEnv
    st_rules = RuleEnv
    rules
                  , st_max_ticks :: IntWithInf
    st_max_ticks = DynFlags -> Int -> IntWithInf
    computeMaxTicks DynFlags
    dflags Int
    size
                  , st_fams :: (FamInstEnv, FamInstEnv)
    st_fams = (FamInstEnv, FamInstEnv)
    fam_envs
                  , st_co_opt_opts :: OptCoercionOpts
    st_co_opt_opts = DynFlags -> OptCoercionOpts
    initOptCoercionOpts DynFlags
    dflags
                  }

    computeMaxTicks :: DynFlags -> Int -> IntWithInf
    -- Compute the max simplifier ticks as
    --     (base-size + pgm-size) * magic-multiplier * tick-factor/100
    -- where
    --    magic-multiplier is a constant that gives reasonable results
    --    base-size is a constant to deal with size-zero programs
    computeMaxTicks :: DynFlags -> Int -> IntWithInf
    computeMaxTicks DynFlags
    dflags Int
    size
      = Int -> IntWithInf
    treatZeroAsInf (Int -> IntWithInf) -> Int -> IntWithInf
    forall a b. (a -> b) -> a -> b
    $
        Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger ((Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    size Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    base_size)
                      Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    * Int -> Integer
    forall a. Integral a => a -> Integer
    toInteger (Int
    tick_factor Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    magic_multiplier))
              Integer -> Integer -> Integer
    forall a. Integral a => a -> a -> a
    `div` Integer
    100)
      where
        tick_factor :: Int
    tick_factor      = DynFlags -> Int
    simplTickFactor DynFlags
    dflags
        base_size :: Int
    base_size        = Int
    100
        magic_multiplier :: Int
    magic_multiplier = Int
    40
            -- MAGIC NUMBER, multiplies the simplTickFactor
            -- We can afford to be generous; this is really
            -- just checking for loops, and shouldn't usually fire
            -- A figure of 20 was too small: see #5539.

    {-# INLINE thenSmpl #-}
    {-# INLINE thenSmpl_ #-}
    {-# INLINE returnSmpl #-}
    {-# INLINE mapSmpl #-}

    instance Functor SimplM where
      fmap :: forall a b. (a -> b) -> SimplM a -> SimplM b
    fmap = (a -> b) -> SimplM a -> SimplM b
    forall a b. (a -> b) -> SimplM a -> SimplM b
    mapSmpl

    instance Applicative SimplM where
        pure :: forall a. a -> SimplM a
    pure  = a -> SimplM a
    forall a. a -> SimplM a
    returnSmpl
        <*> :: forall a b. SimplM (a -> b) -> SimplM a -> SimplM b
    (<*>) = SimplM (a -> b) -> SimplM a -> SimplM b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap
        *> :: forall a b. SimplM a -> SimplM b -> SimplM b
    (*>)  = SimplM a -> SimplM b -> SimplM b
    forall a b. SimplM a -> SimplM b -> SimplM b
    thenSmpl_

    instance Monad SimplM where
       >> :: forall a b. SimplM a -> SimplM b -> SimplM b
    (>>)   = SimplM a -> SimplM b -> SimplM b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    (*>)
       >>= :: forall a b. SimplM a -> (a -> SimplM b) -> SimplM b
    (>>=)  = SimplM a -> (a -> SimplM b) -> SimplM b
    forall a b. SimplM a -> (a -> SimplM b) -> SimplM b
    thenSmpl

    mapSmpl :: (a -> b) -> SimplM a -> SimplM b
    mapSmpl :: forall a b. (a -> b) -> SimplM a -> SimplM b
    mapSmpl a -> b
    f SimplM a
    m = SimplM a -> (a -> SimplM b) -> SimplM b
    forall a b. SimplM a -> (a -> SimplM b) -> SimplM b
    thenSmpl SimplM a
    m (b -> SimplM b
    forall a. a -> SimplM a
    returnSmpl (b -> SimplM b) -> (a -> b) -> a -> SimplM b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> b
    f)

    returnSmpl :: a -> SimplM a
    returnSmpl :: forall a. a -> SimplM a
    returnSmpl a
    e = (SimplTopEnv -> SimplCount -> IO (a, SimplCount)) -> SimplM a
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    _st_env SimplCount
    sc -> (a, SimplCount) -> IO (a, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    e, SimplCount
    sc))

    thenSmpl  :: SimplM a -> (a -> SimplM b) -> SimplM b
    thenSmpl_ :: SimplM a -> SimplM b -> SimplM b

    thenSmpl :: forall a b. SimplM a -> (a -> SimplM b) -> SimplM b
    thenSmpl SimplM a
    m a -> SimplM b
    k
      = (SimplTopEnv -> SimplCount -> IO (b, SimplCount)) -> SimplM b
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM ((SimplTopEnv -> SimplCount -> IO (b, SimplCount)) -> SimplM b)
    -> (SimplTopEnv -> SimplCount -> IO (b, SimplCount)) -> SimplM b
    forall a b. (a -> b) -> a -> b
    $ \SimplTopEnv
    st_env SimplCount
    sc0 -> do
          (a
    m_result, SimplCount
    sc1) <- SimplM a -> SimplTopEnv -> SimplCount -> IO (a, SimplCount)
    forall result.
    SimplM result
    -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    unSM SimplM a
    m SimplTopEnv
    st_env SimplCount
    sc0
          SimplM b -> SimplTopEnv -> SimplCount -> IO (b, SimplCount)
    forall result.
    SimplM result
    -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    unSM (a -> SimplM b
    k a
    m_result) SimplTopEnv
    st_env SimplCount
    sc1

    thenSmpl_ :: forall a b. SimplM a -> SimplM b -> SimplM b
    thenSmpl_ SimplM a
    m SimplM b
    k
      = (SimplTopEnv -> SimplCount -> IO (b, SimplCount)) -> SimplM b
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM ((SimplTopEnv -> SimplCount -> IO (b, SimplCount)) -> SimplM b)
    -> (SimplTopEnv -> SimplCount -> IO (b, SimplCount)) -> SimplM b
    forall a b. (a -> b) -> a -> b
    $ \SimplTopEnv
    st_env SimplCount
    sc0 -> do
          (a
    _, SimplCount
    sc1) <- SimplM a -> SimplTopEnv -> SimplCount -> IO (a, SimplCount)
    forall result.
    SimplM result
    -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    unSM SimplM a
    m SimplTopEnv
    st_env SimplCount
    sc0
          SimplM b -> SimplTopEnv -> SimplCount -> IO (b, SimplCount)
    forall result.
    SimplM result
    -> SimplTopEnv -> SimplCount -> IO (result, SimplCount)
    unSM SimplM b
    k SimplTopEnv
    st_env SimplCount
    sc1

    -- TODO: this specializing is not allowed
    -- {-# SPECIALIZE mapM         :: (a -> SimplM b) -> [a] -> SimplM [b] #-}
    -- {-# SPECIALIZE mapAndUnzipM :: (a -> SimplM (b, c)) -> [a] -> SimplM ([b],[c]) #-}
    -- {-# SPECIALIZE mapAccumLM   :: (acc -> b -> SimplM (acc,c)) -> acc -> [b] -> SimplM (acc, [c]) #-}

    traceSmpl :: String -> SDoc -> SimplM ()
    traceSmpl :: String -> SDoc -> SimplM ()
    traceSmpl String
    herald SDoc
    doc
      = do DynFlags
    dflags <- SimplM DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
           Logger
    logger <- SimplM Logger
    forall (m :: * -> *). HasLogger m => m Logger
    getLogger
           IO () -> SimplM ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> SimplM ()) -> IO () -> SimplM ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> DynFlags -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    Logger.dumpIfSet_dyn Logger
    logger DynFlags
    dflags DumpFlag
    Opt_D_dump_simpl_trace String
    "Simpl Trace"
             DumpFormat
    FormatText
             (SDoc -> Int -> SDoc -> SDoc
    hang (String -> SDoc
    text String
    herald) Int
    2 SDoc
    doc)
    {-# INLINE traceSmpl #-}  -- see Note [INLINE conditional tracing utilities]

    {-
    ************************************************************************
    *                                                                      *
    \subsection{The unique supply}
    *                                                                      *
    ************************************************************************
    -}

    -- See Note [Uniques for wired-in prelude things and known masks] in GHC.Builtin.Uniques
    simplMask :: Char
    simplMask :: Char
    simplMask = Char
    's'

    instance MonadUnique SimplM where
        getUniqueSupplyM :: SimplM UniqSupply
    getUniqueSupplyM = IO UniqSupply -> SimplM UniqSupply
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO UniqSupply -> SimplM UniqSupply)
    -> IO UniqSupply -> SimplM UniqSupply
    forall a b. (a -> b) -> a -> b
    $ Char -> IO UniqSupply
    mkSplitUniqSupply Char
    simplMask
        getUniqueM :: SimplM Unique
    getUniqueM = IO Unique -> SimplM Unique
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO Unique -> SimplM Unique) -> IO Unique -> SimplM Unique
    forall a b. (a -> b) -> a -> b
    $ Char -> IO Unique
    uniqFromMask Char
    simplMask

    instance HasDynFlags SimplM where
        getDynFlags :: SimplM DynFlags
    getDynFlags = (SimplTopEnv -> SimplCount -> IO (DynFlags, SimplCount))
    -> SimplM DynFlags
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    st_env SimplCount
    sc -> (DynFlags, SimplCount) -> IO (DynFlags, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplTopEnv -> DynFlags
    st_flags SimplTopEnv
    st_env, SimplCount
    sc))

    instance HasLogger SimplM where
        getLogger :: SimplM Logger
    getLogger = (SimplTopEnv -> SimplCount -> IO (Logger, SimplCount))
    -> SimplM Logger
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    st_env SimplCount
    sc -> (Logger, SimplCount) -> IO (Logger, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplTopEnv -> Logger
    st_logger SimplTopEnv
    st_env, SimplCount
    sc))

    instance MonadIO SimplM where
        liftIO :: forall a. IO a -> SimplM a
    liftIO IO a
    m = (SimplTopEnv -> SimplCount -> IO (a, SimplCount)) -> SimplM a
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM ((SimplTopEnv -> SimplCount -> IO (a, SimplCount)) -> SimplM a)
    -> (SimplTopEnv -> SimplCount -> IO (a, SimplCount)) -> SimplM a
    forall a b. (a -> b) -> a -> b
    $ \SimplTopEnv
    _ SimplCount
    sc -> do
          a
    x <- IO a
    m
          (a, SimplCount) -> IO (a, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a
    x, SimplCount
    sc)

    getSimplRules :: SimplM RuleEnv
    getSimplRules :: SimplM RuleEnv
    getSimplRules = (SimplTopEnv -> SimplCount -> IO (RuleEnv, SimplCount))
    -> SimplM RuleEnv
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    st_env SimplCount
    sc -> (RuleEnv, SimplCount) -> IO (RuleEnv, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplTopEnv -> RuleEnv
    st_rules SimplTopEnv
    st_env, SimplCount
    sc))

    getFamEnvs :: SimplM (FamInstEnv, FamInstEnv)
    getFamEnvs :: SimplM (FamInstEnv, FamInstEnv)
    getFamEnvs = (SimplTopEnv
     -> SimplCount -> IO ((FamInstEnv, FamInstEnv), SimplCount))
    -> SimplM (FamInstEnv, FamInstEnv)
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    st_env SimplCount
    sc -> ((FamInstEnv, FamInstEnv), SimplCount)
    -> IO ((FamInstEnv, FamInstEnv), SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplTopEnv -> (FamInstEnv, FamInstEnv)
    st_fams SimplTopEnv
    st_env, SimplCount
    sc))

    getOptCoercionOpts :: SimplM OptCoercionOpts
    getOptCoercionOpts :: SimplM OptCoercionOpts
    getOptCoercionOpts = (SimplTopEnv -> SimplCount -> IO (OptCoercionOpts, SimplCount))
    -> SimplM OptCoercionOpts
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    st_env SimplCount
    sc -> (OptCoercionOpts, SimplCount) -> IO (OptCoercionOpts, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplTopEnv -> OptCoercionOpts
    st_co_opt_opts SimplTopEnv
    st_env, SimplCount
    sc))

    newId :: FastString -> Mult -> Type -> SimplM Id
    newId :: FastString -> Mult -> Mult -> SimplM Id
    newId FastString
    fs Mult
    w Mult
    ty = do Unique
    uniq <- SimplM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
                       Id -> SimplM Id
    forall (m :: * -> *) a. Monad m => a -> m a
    return (FastString -> Unique -> Mult -> Mult -> Id
    mkSysLocalOrCoVar FastString
    fs Unique
    uniq Mult
    w Mult
    ty)

    newJoinId :: [Var] -> Type -> SimplM Id
    newJoinId :: [Id] -> Mult -> SimplM Id
    newJoinId [Id]
    bndrs Mult
    body_ty
      = do { Unique
    uniq <- SimplM Unique
    forall (m :: * -> *). MonadUnique m => m Unique
    getUniqueM
           ; let name :: Name
    name       = Unique -> FastString -> Name
    mkSystemVarName Unique
    uniq (String -> FastString
    fsLit String
    "$j")
                 join_id_ty :: Mult
    join_id_ty = [Id] -> Mult -> Mult
    mkLamTypes [Id]
    bndrs Mult
    body_ty  -- Note [Funky mkLamTypes]
                 arity :: Int
    arity      = (Id -> Bool) -> [Id] -> Int
    forall a. (a -> Bool) -> [a] -> Int
    count Id -> Bool
    isId [Id]
    bndrs
                 -- arity: See Note [Invariants on join points] invariant 2b, in GHC.Core
                 join_arity :: Int
    join_arity = [Id] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Id]
    bndrs
                 details :: IdDetails
    details    = Int -> IdDetails
    JoinId Int
    join_arity
                 id_info :: IdInfo
    id_info    = IdInfo
    vanillaIdInfo IdInfo -> Int -> IdInfo
    `setArityInfo` Int
    arity
    --                                        `setOccInfo` strongLoopBreaker

           ; Id -> SimplM Id
    forall (m :: * -> *) a. Monad m => a -> m a
    return (IdDetails -> Name -> Mult -> Mult -> IdInfo -> Id
    mkLocalVar IdDetails
    details Name
    name Mult
    Many Mult
    join_id_ty IdInfo
    id_info) }

    {-
    ************************************************************************
    *                                                                      *
    \subsection{Counting up what we've done}
    *                                                                      *
    ************************************************************************
    -}

    getSimplCount :: SimplM SimplCount
    getSimplCount :: SimplM SimplCount
    getSimplCount = (SimplTopEnv -> SimplCount -> IO (SimplCount, SimplCount))
    -> SimplM SimplCount
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    _st_env SimplCount
    sc -> (SimplCount, SimplCount) -> IO (SimplCount, SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SimplCount
    sc, SimplCount
    sc))

    tick :: Tick -> SimplM ()
    tick :: Tick -> SimplM ()
    tick Tick
    t = (SimplTopEnv -> SimplCount -> IO ((), SimplCount)) -> SimplM ()
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    st_env SimplCount
    sc -> let sc' :: SimplCount
    sc' = DynFlags -> Tick -> SimplCount -> SimplCount
    doSimplTick (SimplTopEnv -> DynFlags
    st_flags SimplTopEnv
    st_env) Tick
    t SimplCount
    sc
                                  in SimplCount
    sc' SimplCount -> IO ((), SimplCount) -> IO ((), SimplCount)
    `seq` ((), SimplCount) -> IO ((), SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((), SimplCount
    sc'))

    checkedTick :: Tick -> SimplM ()
    -- Try to take a tick, but fail if too many
    checkedTick :: Tick -> SimplM ()
    checkedTick Tick
    t
      = (SimplTopEnv -> SimplCount -> IO ((), SimplCount)) -> SimplM ()
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    st_env SimplCount
    sc ->
               if SimplTopEnv -> IntWithInf
    st_max_ticks SimplTopEnv
    st_env IntWithInf -> IntWithInf -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int -> IntWithInf
    mkIntWithInf (SimplCount -> Int
    simplCountN SimplCount
    sc)
               then GhcException -> IO ((), SimplCount)
    forall a. GhcException -> IO a
    throwGhcExceptionIO (GhcException -> IO ((), SimplCount))
    -> GhcException -> IO ((), SimplCount)
    forall a b. (a -> b) -> a -> b
    $
                      String -> SDoc -> GhcException
    PprProgramError String
    "Simplifier ticks exhausted" (SimplCount -> SDoc
    msg SimplCount
    sc)
               else let sc' :: SimplCount
    sc' = DynFlags -> Tick -> SimplCount -> SimplCount
    doSimplTick (SimplTopEnv -> DynFlags
    st_flags SimplTopEnv
    st_env) Tick
    t SimplCount
    sc
                    in SimplCount
    sc' SimplCount -> IO ((), SimplCount) -> IO ((), SimplCount)
    `seq` ((), SimplCount) -> IO ((), SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((), SimplCount
    sc'))
      where
        msg :: SimplCount -> SDoc
    msg SimplCount
    sc = [SDoc] -> SDoc
    vcat
          [ String -> SDoc
    text String
    "When trying" SDoc -> SDoc -> SDoc
    <+> Tick -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Tick
    t
          , String -> SDoc
    text String
    "To increase the limit, use -fsimpl-tick-factor=N (default 100)."
          , SDoc
    space
          , String -> SDoc
    text String
    "In addition try adjusting -funfolding-case-threshold=N and"
          , String -> SDoc
    text String
    "-funfolding-case-scaling=N for the module in question."
          , String -> SDoc
    text String
    "Using threshold=1 and scaling=5 should break most inlining loops."
          , SDoc
    space
          , String -> SDoc
    text String
    "If you need to increase the tick factor substantially, while also"
          , String -> SDoc
    text String
    "adjusting unfolding parameters please file a bug report and"
          , String -> SDoc
    text String
    "indicate the factor you needed."
          , SDoc
    space
          , String -> SDoc
    text String
    "If GHC was unable to complete compilation even"
                   SDoc -> SDoc -> SDoc
    <+> String -> SDoc
    text String
    "with a very large factor"
          , String -> SDoc
    text String
    "(a thousand or more), please consult the"
                    SDoc -> SDoc -> SDoc
    <+> SDoc -> SDoc
    doubleQuotes (String -> SDoc
    text String
    "Known bugs or infelicities")
          , String -> SDoc
    text String
    "section in the Users Guide before filing a report. There are a"
          , String -> SDoc
    text String
    "few situations unlikely to occur in practical programs for which"
          , String -> SDoc
    text String
    "simplifier non-termination has been judged acceptable."
          , SDoc
    space
          , SimplCount -> SDoc
    pp_details SimplCount
    sc
          , SimplCount -> SDoc
    pprSimplCount SimplCount
    sc ]
        pp_details :: SimplCount -> SDoc
    pp_details SimplCount
    sc
          | SimplCount -> Bool
    hasDetailedCounts SimplCount
    sc = SDoc
    empty
          | Bool
    otherwise = String -> SDoc
    text String
    "To see detailed counts use -ddump-simpl-stats"

    freeTick :: Tick -> SimplM ()
    -- Record a tick, but don't add to the total tick count, which is
    -- used to decide when nothing further has happened
    freeTick :: Tick -> SimplM ()
    freeTick Tick
    t
       = (SimplTopEnv -> SimplCount -> IO ((), SimplCount)) -> SimplM ()
    forall result.
    (SimplTopEnv -> SimplCount -> IO (result, SimplCount))
    -> SimplM result
    SM (\SimplTopEnv
    _st_env SimplCount
    sc -> let sc' :: SimplCount
    sc' = Tick -> SimplCount -> SimplCount
    doFreeSimplTick Tick
    t SimplCount
    sc
                               in SimplCount
    sc' SimplCount -> IO ((), SimplCount) -> IO ((), SimplCount)
    `seq` ((), SimplCount) -> IO ((), SimplCount)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((), SimplCount
    sc'))