    {-# LANGUAGE BangPatterns #-}

    module GHC.Cmm.Pipeline (
      cmmPipeline
    ) where

    import GHC.Prelude

    import GHC.Driver.Flags

    import GHC.Cmm
    import GHC.Cmm.Config
    import GHC.Cmm.ContFlowOpt
    import GHC.Cmm.CommonBlockElim
    import GHC.Cmm.Dataflow.Collections
    import GHC.Cmm.Info.Build
    import GHC.Cmm.Lint
    import GHC.Cmm.LayoutStack
    import GHC.Cmm.ProcPoint
    import GHC.Cmm.Sink
    import GHC.Cmm.Switch.Implement
    import GHC.Cmm.ThreadSanitizer

    import GHC.Types.Unique.Supply

    import GHC.Utils.Error
    import GHC.Utils.Logger
    import GHC.Utils.Outputable

    import GHC.Platform

    import Control.Monad
    import Data.Either (partitionEithers)

    -----------------------------------------------------------------------------
    -- | Top level driver for C-- pipeline
    -----------------------------------------------------------------------------

    -- | Converts C-- with an implicit stack and native C-- calls into
    -- optimized, CPS converted and native-call-less C--.  The latter
    -- C-- can be used to generate assembly.
    cmmPipeline
     :: Logger
     -> CmmConfig
     -> ModuleSRTInfo        -- Info about SRTs generated so far
     -> CmmGroup             -- Input C-- with Procedures
     -> IO (ModuleSRTInfo, CmmGroupSRTs) -- Output CPS transformed C--

    cmmPipeline :: Logger
    -> CmmConfig
    -> ModuleSRTInfo
    -> CmmGroup
    -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    cmmPipeline Logger
    logger CmmConfig
    cmm_config ModuleSRTInfo
    srtInfo CmmGroup
    prog = do
      let forceRes :: (a, t a) -> ()
    forceRes (a
    info, t a
    group) = a
    info a -> () -> ()
    forall a b. a -> b -> b
    `seq` (a -> () -> ()) -> () -> t a -> ()
    forall a b. (a -> b -> b) -> b -> t a -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr a -> () -> ()
    forall a b. a -> b -> b
    seq () t a
    group
      let platform :: Platform
    platform = CmmConfig -> Platform
    cmmPlatform CmmConfig
    cmm_config
      Logger
    -> SDoc
    -> ((ModuleSRTInfo, [CmmDeclSRTs]) -> ())
    -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    forall (m :: * -> *) a.
    MonadIO m =>
    Logger -> SDoc -> (a -> ()) -> m a -> m a
    withTimingSilent Logger
    logger (String -> SDoc
    forall doc. IsLine doc => String -> doc
    text String
    "Cmm pipeline") (ModuleSRTInfo, [CmmDeclSRTs]) -> ()
    forall {t :: * -> *} {a} {a}. Foldable t => (a, t a) -> ()
    forceRes (IO (ModuleSRTInfo, [CmmDeclSRTs])
     -> IO (ModuleSRTInfo, [CmmDeclSRTs]))
    -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    forall a b. (a -> b) -> a -> b
    $ do
         [Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)]
    tops <- {-# SCC "tops" #-} (CmmDecl
     -> IO (Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)))
    -> CmmGroup
    -> IO [Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)]
    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 (Logger
    -> Platform
    -> CmmConfig
    -> CmmDecl
    -> IO (Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl))
    cpsTop Logger
    logger Platform
    platform CmmConfig
    cmm_config) CmmGroup
    prog

         let ([(CAFEnv, CmmGroup)]
    procs, [(Set CAFfyLabel, CmmDataDecl)]
    data_) = [Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)]
    -> ([(CAFEnv, CmmGroup)], [(Set CAFfyLabel, CmmDataDecl)])
    forall a b. [Either a b] -> ([a], [b])
    partitionEithers [Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)]
    tops
         (ModuleSRTInfo
    srtInfo, [CmmDeclSRTs]
    cmms) <- {-# SCC "doSRTs" #-} CmmConfig
    -> ModuleSRTInfo
    -> [(CAFEnv, CmmGroup)]
    -> [(Set CAFfyLabel, CmmDataDecl)]
    -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    doSRTs CmmConfig
    cmm_config ModuleSRTInfo
    srtInfo [(CAFEnv, CmmGroup)]
    procs [(Set CAFfyLabel, CmmDataDecl)]
    data_
         Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith Logger
    logger DumpFlag
    Opt_D_dump_cmm_cps String
    "Post CPS Cmm" DumpFormat
    FormatCMM (Platform -> [CmmDeclSRTs] -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform [CmmDeclSRTs]
    cmms)

         (ModuleSRTInfo, [CmmDeclSRTs]) -> IO (ModuleSRTInfo, [CmmDeclSRTs])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (ModuleSRTInfo
    srtInfo, [CmmDeclSRTs]
    cmms)

    -- | The Cmm pipeline for a single 'CmmDecl'. Returns:
    --
    --   - in the case of a 'CmmProc': 'Left' of the resulting (possibly
    --     proc-point-split) 'CmmDecl's and their 'CafEnv'. CAF analysis
    --     necessarily happens *before* proc-point splitting, as described in Note
    --     [SRTs].
    --
    --   - in the case of a `CmmData`, the unmodified 'CmmDecl' and a 'CAFSet' containing
    cpsTop :: Logger -> Platform -> CmmConfig -> CmmDecl -> IO (Either (CAFEnv, [CmmDecl]) (CAFSet, CmmDataDecl))
    cpsTop :: Logger
    -> Platform
    -> CmmConfig
    -> CmmDecl
    -> IO (Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl))
    cpsTop Logger
    _logger Platform
    platform CmmConfig
    _ (CmmData Section
    section GenCmmStatics 'False
    statics) = Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)
    -> IO (Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Set CAFfyLabel, CmmDataDecl)
    -> Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)
    forall a b. b -> Either a b
    Right (Platform -> GenCmmStatics 'False -> Set CAFfyLabel
    cafAnalData Platform
    platform GenCmmStatics 'False
    statics, Section -> GenCmmStatics 'False -> CmmDataDecl
    forall d h g. Section -> d -> GenCmmDecl d h g
    CmmData Section
    section GenCmmStatics 'False
    statics))
    cpsTop Logger
    logger Platform
    platform CmmConfig
    cfg CmmDecl
    proc =
        do
          ----------- Control-flow optimisations ----------------------------------

          -- The first round of control-flow optimisation speeds up the
          -- later passes by removing lots of empty blocks, so we do it
          -- even when optimisation isn't turned on.
          --
          CmmProc CmmTopInfo
    h CLabel
    l [GlobalReg]
    v CmmGraph
    g <- {-# SCC "cmmCfgOpts(1)" #-}
               CmmDecl -> IO CmmDecl
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmDecl -> IO CmmDecl) -> CmmDecl -> IO CmmDecl
    forall a b. (a -> b) -> a -> b
    $ Bool -> CmmDecl -> CmmDecl
    cmmCfgOptsProc Bool
    splitting_proc_points CmmDecl
    proc
          DumpFlag -> String -> CmmGraph -> IO ()
    dump DumpFlag
    Opt_D_dump_cmm_cfg String
    "Post control-flow optimisations" CmmGraph
    g

          let !TopInfo {stack_info :: CmmTopInfo -> CmmStackInfo
    stack_info=StackInfo { arg_space :: CmmStackInfo -> ByteOff
    arg_space = ByteOff
    entry_off
                                             , do_layout :: CmmStackInfo -> Bool
    do_layout = Bool
    do_layout }} = CmmTopInfo
    h

          ----------- Eliminate common blocks -------------------------------------
          CmmGraph
    g <- {-# SCC "elimCommonBlocks" #-}
               Bool
    -> (CmmGraph -> CmmGraph)
    -> CmmGraph
    -> DumpFlag
    -> String
    -> IO CmmGraph
    condPass (CmmConfig -> Bool
    cmmOptElimCommonBlks CmmConfig
    cfg) CmmGraph -> CmmGraph
    elimCommonBlocks CmmGraph
    g
                             DumpFlag
    Opt_D_dump_cmm_cbe String
    "Post common block elimination"

          -- Any work storing block Labels must be performed _after_
          -- elimCommonBlocks

          ----------- Implement switches ------------------------------------------
          CmmGraph
    g <- if CmmConfig -> Bool
    cmmDoCmmSwitchPlans CmmConfig
    cfg
                 then {-# SCC "createSwitchPlans" #-}
                      UniqSM CmmGraph -> IO CmmGraph
    forall a. UniqSM a -> IO a
    runUniqSM (UniqSM CmmGraph -> IO CmmGraph) -> UniqSM CmmGraph -> IO CmmGraph
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmGraph -> UniqSM CmmGraph
    cmmImplementSwitchPlans Platform
    platform CmmGraph
    g
                 else CmmGraph -> IO CmmGraph
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure CmmGraph
    g
          DumpFlag -> String -> CmmGraph -> IO ()
    dump DumpFlag
    Opt_D_dump_cmm_switch String
    "Post switch plan" CmmGraph
    g

          ----------- ThreadSanitizer instrumentation -----------------------------
          CmmGraph
    g <- {-# SCC "annotateTSAN" #-}
              if CmmConfig -> Bool
    cmmOptThreadSanitizer CmmConfig
    cfg
              then UniqSM CmmGraph -> IO CmmGraph
    forall a. UniqSM a -> IO a
    runUniqSM (UniqSM CmmGraph -> IO CmmGraph) -> UniqSM CmmGraph -> IO CmmGraph
    forall a b. (a -> b) -> a -> b
    $ Platform -> CmmGraph -> UniqSM CmmGraph
    annotateTSAN Platform
    platform CmmGraph
    g
              else CmmGraph -> IO CmmGraph
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CmmGraph
    g
          DumpFlag -> String -> CmmGraph -> IO ()
    dump DumpFlag
    Opt_D_dump_cmm_thread_sanitizer String
    "ThreadSanitizer instrumentation" CmmGraph
    g

          ----------- Proc points -------------------------------------------------
          let
            call_pps :: ProcPointSet -- LabelMap
            call_pps :: ProcPointSet
    call_pps = {-# SCC "callProcPoints" #-} CmmGraph -> ProcPointSet
    callProcPoints CmmGraph
    g
          ProcPointSet
    proc_points <-
             if Bool
    splitting_proc_points
                then do
                  ProcPointSet
    pp <- {-# SCC "minimalProcPointSet" #-} UniqSM ProcPointSet -> IO ProcPointSet
    forall a. UniqSM a -> IO a
    runUniqSM (UniqSM ProcPointSet -> IO ProcPointSet)
    -> UniqSM ProcPointSet -> IO ProcPointSet
    forall a b. (a -> b) -> a -> b
    $
                     Platform -> ProcPointSet -> CmmGraph -> UniqSM ProcPointSet
    minimalProcPointSet Platform
    platform ProcPointSet
    call_pps CmmGraph
    g
                  Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith Logger
    logger DumpFlag
    Opt_D_dump_cmm_proc String
    "Proc points"
                        DumpFormat
    FormatCMM (Platform -> CLabel -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CLabel
    l SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ ProcPointSet -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr ProcPointSet
    pp SDoc -> SDoc -> SDoc
    forall doc. IsDoc doc => doc -> doc -> doc
    $$ Platform -> CmmGraph -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmGraph
    g)
                  ProcPointSet -> IO ProcPointSet
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProcPointSet
    pp
                else
                  ProcPointSet -> IO ProcPointSet
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ProcPointSet
    call_pps

          ----------- Layout the stack and manifest Sp ----------------------------
          (CmmGraph
    g, LabelMap StackMap
    stackmaps) <-
               {-# SCC "layoutStack" #-}
               if Bool
    do_layout
                  then UniqSM (CmmGraph, LabelMap StackMap)
    -> IO (CmmGraph, LabelMap StackMap)
    forall a. UniqSM a -> IO a
    runUniqSM (UniqSM (CmmGraph, LabelMap StackMap)
     -> IO (CmmGraph, LabelMap StackMap))
    -> UniqSM (CmmGraph, LabelMap StackMap)
    -> IO (CmmGraph, LabelMap StackMap)
    forall a b. (a -> b) -> a -> b
    $ CmmConfig
    -> ProcPointSet
    -> ByteOff
    -> CmmGraph
    -> UniqSM (CmmGraph, LabelMap StackMap)
    cmmLayoutStack CmmConfig
    cfg ProcPointSet
    proc_points ByteOff
    entry_off CmmGraph
    g
                  else (CmmGraph, LabelMap StackMap) -> IO (CmmGraph, LabelMap StackMap)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmGraph
    g, LabelMap StackMap
    forall a. LabelMap a
    forall (map :: * -> *) a. IsMap map => map a
    mapEmpty)
          DumpFlag -> String -> CmmGraph -> IO ()
    dump DumpFlag
    Opt_D_dump_cmm_sp String
    "Layout Stack" CmmGraph
    g

          ----------- Sink and inline assignments  --------------------------------
          CmmGraph
    g <- {-# SCC "sink" #-} -- See Note [Sinking after stack layout]
               Bool
    -> (CmmGraph -> CmmGraph)
    -> CmmGraph
    -> DumpFlag
    -> String
    -> IO CmmGraph
    condPass (CmmConfig -> Bool
    cmmOptSink CmmConfig
    cfg) (Platform -> CmmGraph -> CmmGraph
    cmmSink Platform
    platform) CmmGraph
    g
                        DumpFlag
    Opt_D_dump_cmm_sink String
    "Sink assignments"

          ------------- CAF analysis ----------------------------------------------
          let cafEnv :: CAFEnv
    cafEnv = {-# SCC "cafAnal" #-} Platform -> ProcPointSet -> CLabel -> CmmGraph -> CAFEnv
    cafAnal Platform
    platform ProcPointSet
    call_pps CLabel
    l CmmGraph
    g
          Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith Logger
    logger DumpFlag
    Opt_D_dump_cmm_caf String
    "CAFEnv" DumpFormat
    FormatText (Platform -> CAFEnv -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CAFEnv
    cafEnv)

          CmmGroup
    g <- if Bool
    splitting_proc_points
               then do
                 ------------- Split into separate procedures -----------------------
                 let pp_map :: LabelMap Status
    pp_map = {-# SCC "procPointAnalysis" #-}
                              ProcPointSet -> CmmGraph -> LabelMap Status
    procPointAnalysis ProcPointSet
    proc_points CmmGraph
    g
                 Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith Logger
    logger DumpFlag
    Opt_D_dump_cmm_procmap String
    "procpoint map"
                    DumpFormat
    FormatCMM (LabelMap Status -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr LabelMap Status
    pp_map)
                 CmmGroup
    g <- {-# SCC "splitAtProcPoints" #-} UniqSM CmmGroup -> IO CmmGroup
    forall a. UniqSM a -> IO a
    runUniqSM (UniqSM CmmGroup -> IO CmmGroup) -> UniqSM CmmGroup -> IO CmmGroup
    forall a b. (a -> b) -> a -> b
    $
                      Platform
    -> CLabel
    -> ProcPointSet
    -> ProcPointSet
    -> LabelMap Status
    -> CmmDecl
    -> UniqSM CmmGroup
    splitAtProcPoints Platform
    platform CLabel
    l ProcPointSet
    call_pps ProcPointSet
    proc_points LabelMap Status
    pp_map
                                        (CmmTopInfo -> CLabel -> [GlobalReg] -> CmmGraph -> CmmDecl
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc CmmTopInfo
    h CLabel
    l [GlobalReg]
    v CmmGraph
    g)
                 DumpFlag -> String -> CmmGroup -> IO ()
    dumps DumpFlag
    Opt_D_dump_cmm_split String
    "Post splitting" CmmGroup
    g
                 CmmGroup -> IO CmmGroup
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CmmGroup
    g
               else
                 -- attach info tables to return points
                 CmmGroup -> IO CmmGroup
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmGroup -> IO CmmGroup) -> CmmGroup -> IO CmmGroup
    forall a b. (a -> b) -> a -> b
    $ [ProcPointSet -> CmmDecl -> CmmDecl
    attachContInfoTables ProcPointSet
    call_pps (CmmTopInfo -> CLabel -> [GlobalReg] -> CmmGraph -> CmmDecl
    forall d h g. h -> CLabel -> [GlobalReg] -> g -> GenCmmDecl d h g
    CmmProc CmmTopInfo
    h CLabel
    l [GlobalReg]
    v CmmGraph
    g)]

          ------------- Populate info tables with stack info -----------------
          CmmGroup
    g <- {-# SCC "setInfoTableStackMap" #-}
               CmmGroup -> IO CmmGroup
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmGroup -> IO CmmGroup) -> CmmGroup -> IO CmmGroup
    forall a b. (a -> b) -> a -> b
    $ (CmmDecl -> CmmDecl) -> CmmGroup -> CmmGroup
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> LabelMap StackMap -> CmmDecl -> CmmDecl
    setInfoTableStackMap Platform
    platform LabelMap StackMap
    stackmaps) CmmGroup
    g
          DumpFlag -> String -> CmmGroup -> IO ()
    dumps DumpFlag
    Opt_D_dump_cmm_info String
    "after setInfoTableStackMap" CmmGroup
    g

          ----------- Control-flow optimisations -----------------------------
          CmmGroup
    g <- {-# SCC "cmmCfgOpts(2)" #-}
               CmmGroup -> IO CmmGroup
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmGroup -> IO CmmGroup) -> CmmGroup -> IO CmmGroup
    forall a b. (a -> b) -> a -> b
    $ if CmmConfig -> Bool
    cmmOptControlFlow CmmConfig
    cfg
                        then (CmmDecl -> CmmDecl) -> CmmGroup -> CmmGroup
    forall a b. (a -> b) -> [a] -> [b]
    map (Bool -> CmmDecl -> CmmDecl
    cmmCfgOptsProc Bool
    splitting_proc_points) CmmGroup
    g
                        else CmmGroup
    g
          CmmGroup
    g <- CmmGroup -> IO CmmGroup
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmGroup -> IO CmmGroup) -> CmmGroup -> IO CmmGroup
    forall a b. (a -> b) -> a -> b
    $ (CmmDecl -> CmmDecl) -> CmmGroup -> CmmGroup
    forall a b. (a -> b) -> [a] -> [b]
    map (Platform -> CmmDecl -> CmmDecl
    removeUnreachableBlocksProc Platform
    platform) CmmGroup
    g
               -- See Note [unreachable blocks]
          DumpFlag -> String -> CmmGroup -> IO ()
    dumps DumpFlag
    Opt_D_dump_cmm_cfg String
    "Post control-flow optimisations" CmmGroup
    g

          Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)
    -> IO (Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((CAFEnv, CmmGroup)
    -> Either (CAFEnv, CmmGroup) (Set CAFfyLabel, CmmDataDecl)
    forall a b. a -> Either a b
    Left (CAFEnv
    cafEnv, CmmGroup
    g))

      where dump :: DumpFlag -> String -> CmmGraph -> IO ()
    dump = Logger
    -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO ()
    dumpGraph Logger
    logger Platform
    platform (CmmConfig -> Bool
    cmmDoLinting CmmConfig
    cfg)

            dumps :: DumpFlag -> String -> CmmGroup -> IO ()
    dumps DumpFlag
    flag String
    name
               = (CmmDecl -> IO ()) -> CmmGroup -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith Logger
    logger DumpFlag
    flag String
    name DumpFormat
    FormatCMM (SDoc -> IO ()) -> (CmmDecl -> SDoc) -> CmmDecl -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Platform -> CmmDecl -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform)

            condPass :: Bool
    -> (CmmGraph -> CmmGraph)
    -> CmmGraph
    -> DumpFlag
    -> String
    -> IO CmmGraph
    condPass Bool
    do_opt CmmGraph -> CmmGraph
    pass CmmGraph
    g DumpFlag
    dumpflag String
    dumpname =
                if Bool
    do_opt
                   then do
                        CmmGraph
    g <- CmmGraph -> IO CmmGraph
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (CmmGraph -> IO CmmGraph) -> CmmGraph -> IO CmmGraph
    forall a b. (a -> b) -> a -> b
    $ CmmGraph -> CmmGraph
    pass CmmGraph
    g
                        DumpFlag -> String -> CmmGraph -> IO ()
    dump DumpFlag
    dumpflag String
    dumpname CmmGraph
    g
                        CmmGraph -> IO CmmGraph
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CmmGraph
    g
                   else CmmGraph -> IO CmmGraph
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return CmmGraph
    g

            -- we don't need to split proc points for the NCG, unless
            -- tablesNextToCode is off.  The latter is because we have no
            -- label to put on info tables for basic blocks that are not
            -- the entry point.
            splitting_proc_points :: Bool
    splitting_proc_points = CmmConfig -> Bool
    cmmSplitProcPoints CmmConfig
    cfg

    -- Note [Sinking after stack layout]
    -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    -- In the past we considered running sinking pass also before stack
    -- layout, but after making some measurements we realized that:
    --
    --   a) running sinking only before stack layout produces slower
    --      code than running sinking only before stack layout
    --
    --   b) running sinking both before and after stack layout produces
    --      code that has the same performance as when running sinking
    --      only after stack layout.
    --
    -- In other words sinking before stack layout doesn't buy as anything.
    --
    -- An interesting question is "why is it better to run sinking after
    -- stack layout"? It seems that the major reason are stores and loads
    -- generated by stack layout. Consider this code before stack layout:
    --
    --  c1E:
    --      _c1C::P64 = R3;
    --      _c1B::P64 = R2;
    --      _c1A::P64 = R1;
    --      I64[(young<c1D> + 8)] = c1D;
    --      call stg_gc_noregs() returns to c1D, args: 8, res: 8, upd: 8;
    --  c1D:
    --      R3 = _c1C::P64;
    --      R2 = _c1B::P64;
    --      R1 = _c1A::P64;
    --      call (P64[(old + 8)])(R3, R2, R1) args: 8, res: 0, upd: 8;
    --
    -- Stack layout pass will save all local variables live across a call
    -- (_c1C, _c1B and _c1A in this example) on the stack just before
    -- making a call and reload them from the stack after returning from a
    -- call:
    --
    --  c1E:
    --      _c1C::P64 = R3;
    --      _c1B::P64 = R2;
    --      _c1A::P64 = R1;
    --      I64[Sp - 32] = c1D;
    --      P64[Sp - 24] = _c1A::P64;
    --      P64[Sp - 16] = _c1B::P64;
    --      P64[Sp - 8] = _c1C::P64;
    --      Sp = Sp - 32;
    --      call stg_gc_noregs() returns to c1D, args: 8, res: 8, upd: 8;
    --  c1D:
    --      _c1A::P64 = P64[Sp + 8];
    --      _c1B::P64 = P64[Sp + 16];
    --      _c1C::P64 = P64[Sp + 24];
    --      R3 = _c1C::P64;
    --      R2 = _c1B::P64;
    --      R1 = _c1A::P64;
    --      Sp = Sp + 32;
    --      call (P64[Sp])(R3, R2, R1) args: 8, res: 0, upd: 8;
    --
    -- If we don't run sinking pass after stack layout we are basically
    -- left with such code. However, running sinking on this code can lead
    -- to significant improvements:
    --
    --  c1E:
    --      I64[Sp - 32] = c1D;
    --      P64[Sp - 24] = R1;
    --      P64[Sp - 16] = R2;
    --      P64[Sp - 8] = R3;
    --      Sp = Sp - 32;
    --      call stg_gc_noregs() returns to c1D, args: 8, res: 8, upd: 8;
    --  c1D:
    --      R3 = P64[Sp + 24];
    --      R2 = P64[Sp + 16];
    --      R1 = P64[Sp + 8];
    --      Sp = Sp + 32;
    --      call (P64[Sp])(R3, R2, R1) args: 8, res: 0, upd: 8;
    --
    -- Now we only have 9 assignments instead of 15.
    --
    -- There is one case when running sinking before stack layout could
    -- be beneficial. Consider this:
    --
    --   L1:
    --      x = y
    --      call f() returns L2
    --   L2: ...x...y...
    --
    -- Since both x and y are live across a call to f, they will be stored
    -- on the stack during stack layout and restored after the call:
    --
    --   L1:
    --      x = y
    --      P64[Sp - 24] = L2
    --      P64[Sp - 16] = x
    --      P64[Sp - 8]  = y
    --      Sp = Sp - 24
    --      call f() returns L2
    --   L2:
    --      y = P64[Sp + 16]
    --      x = P64[Sp + 8]
    --      Sp = Sp + 24
    --      ...x...y...
    --
    -- However, if we run sinking before stack layout we would propagate x
    -- to its usage place (both x and y must be local register for this to
    -- be possible - global registers cannot be floated past a call):
    --
    --   L1:
    --      x = y
    --      call f() returns L2
    --   L2: ...y...y...
    --
    -- Thus making x dead at the call to f(). If we ran stack layout now
    -- we would generate less stores and loads:
    --
    --   L1:
    --      x = y
    --      P64[Sp - 16] = L2
    --      P64[Sp - 8]  = y
    --      Sp = Sp - 16
    --      call f() returns L2
    --   L2:
    --      y = P64[Sp + 8]
    --      Sp = Sp + 16
    --      ...y...y...
    --
    -- But since we don't see any benefits from running sinking before stack
    -- layout, this situation probably doesn't arise too often in practice.
    --

    {- Note [inconsistent-pic-reg]
       ~~~~~~~~~~~~~~~~~~~~~~~~~~~
    On x86/Darwin, PIC is implemented by inserting a sequence like

        call 1f
     1: popl %reg

    at the proc entry point, and then referring to labels as offsets from
    %reg.  If we don't split proc points, then we could have many entry
    points in a proc that would need this sequence, and each entry point
    would then get a different value for %reg.  If there are any join
    points, then at the join point we don't have a consistent value for
    %reg, so we don't know how to refer to labels.

    Hence, on x86/Darwin, we have to split proc points, and then each proc
    point will get its own PIC initialisation sequence.

    This isn't an issue on x86/ELF, where the sequence is

        call 1f
     1: popl %reg
        addl $_GLOBAL_OFFSET_TABLE_+(.-1b), %reg

    so %reg always has a consistent value: the address of
    _GLOBAL_OFFSET_TABLE_, regardless of which entry point we arrived via.

    -}

    {- Note [unreachable blocks]
       ~~~~~~~~~~~~~~~~~~~~~~~~~
    The control-flow optimiser sometimes leaves unreachable blocks behind
    containing junk code.  These aren't necessarily a problem, but
    removing them is good because it might save time in the native code
    generator later.

    -}

    runUniqSM :: UniqSM a -> IO a
    runUniqSM :: forall a. UniqSM a -> IO a
    runUniqSM UniqSM a
    m = do
      UniqSupply
    us <- Char -> IO UniqSupply
    mkSplitUniqSupply Char
    'u'
      a -> IO a
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (UniqSupply -> UniqSM a -> a
    forall a. UniqSupply -> UniqSM a -> a
    initUs_ UniqSupply
    us UniqSM a
    m)

    dumpGraph :: Logger -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO ()
    dumpGraph :: Logger
    -> Platform -> Bool -> DumpFlag -> String -> CmmGraph -> IO ()
    dumpGraph Logger
    logger Platform
    platform Bool
    do_linting DumpFlag
    flag String
    name CmmGraph
    g = do
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    do_linting (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ CmmGraph -> IO ()
    do_lint CmmGraph
    g
      Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith Logger
    logger DumpFlag
    flag String
    name DumpFormat
    FormatCMM (Platform -> CmmGraph -> SDoc
    forall env a. OutputableP env a => env -> a -> SDoc
    pdoc Platform
    platform CmmGraph
    g)
     where
      do_lint :: CmmGraph -> IO ()
    do_lint CmmGraph
    g = case Platform -> CmmGraph -> Maybe SDoc
    cmmLintGraph Platform
    platform CmmGraph
    g of
                     Just SDoc
    err -> do { Logger -> SDoc -> IO ()
    fatalErrorMsg Logger
    logger SDoc
    err
                                    ; Logger -> ByteOff -> IO ()
    ghcExit Logger
    logger ByteOff
    1
                                    }
                     Maybe SDoc
    Nothing  -> () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()

    dumpWith :: Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith :: Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    dumpWith Logger
    logger DumpFlag
    flag String
    txt DumpFormat
    fmt SDoc
    sdoc = do
      Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    putDumpFileMaybe Logger
    logger DumpFlag
    flag String
    txt DumpFormat
    fmt SDoc
    sdoc
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    flag)) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        -- If `-ddump-cmm-verbose -ddump-to-file` is specified,
        -- dump each Cmm pipeline stage output to a separate file.  #16930
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Logger -> DumpFlag -> Bool
    logHasDumpFlag Logger
    logger DumpFlag
    Opt_D_dump_cmm_verbose)
          (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Logger
    -> PprStyle -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    logDumpFile Logger
    logger (NamePprCtx -> PprStyle
    mkDumpStyle NamePprCtx
    alwaysQualify) DumpFlag
    flag String
    txt DumpFormat
    fmt SDoc
    sdoc
      Logger -> DumpFlag -> String -> DumpFormat -> SDoc -> IO ()
    putDumpFileMaybe Logger
    logger DumpFlag
    Opt_D_dump_cmm_verbose_by_proc String
    txt DumpFormat
    fmt SDoc
    sdoc