content: {-# LANGUAGE RecordWildCards #-}
  
  -- | Adds cost-centers after the core pipline has run.
  module GHC.Core.LateCC
      ( -- * Inserting cost centres
        addLateCostCenters
      ) where
  
  import GHC.Prelude
  
  import GHC.Core
  import GHC.Core.LateCC.OverloadedCalls
  import GHC.Core.LateCC.TopLevelBinds
  import GHC.Core.LateCC.Types
  import GHC.Core.LateCC.Utils
  import GHC.Core.Seq
  import qualified GHC.Data.Strict as Strict
  import GHC.Core.Utils
  import GHC.Tc.Utils.TcType
  import GHC.Types.SrcLoc
  import GHC.Utils.Error
  import GHC.Utils.Logger
  import GHC.Utils.Outputable
  import GHC.Types.RepType (mightBeFunTy)
  
  -- | Late cost center insertion logic used by the driver
  addLateCostCenters ::
       Logger
    -- ^ Logger
    -> LateCCConfig
    -- ^ Late cost center configuration
    -> CoreProgram
    -- ^ The program
    -> IO (CoreProgram, LateCCState (Strict.Maybe SrcSpan))
  addLateCostCenters logger LateCCConfig{..} core_binds = do
  
      -- If top-level late CCs are enabled via either -fprof-late or
      -- -fprof-late-overloaded, add them
      (top_level_cc_binds, top_level_late_cc_state) <-
        case lateCCConfig_whichBinds of
          LateCCNone ->
            return (core_binds, initLateCCState ())
          _ ->
            withTiming
              logger
              (text "LateTopLevelCCs" <+> brackets (ppr this_mod))
              (\(binds, late_cc_state) -> seqBinds binds `seq` late_cc_state `seq` ())
              $ {-# SCC lateTopLevelCCs #-} do
                pure $
                  doLateCostCenters
                    lateCCConfig_env
                    (initLateCCState ())
                    (topLevelBindsCC top_level_cc_pred)
                    core_binds
  
      -- If overloaded call CCs are enabled via -fprof-late-overloaded-calls, add
      -- them
      (late_cc_binds, late_cc_state) <-
        if lateCCConfig_overloadedCalls then
          withTiming
              logger
              (text "LateOverloadedCallsCCs" <+> brackets (ppr this_mod))
              (\(binds, late_cc_state) -> seqBinds binds `seq` late_cc_state `seq` ())
              $ {-# SCC lateoverloadedCallsCCs #-} do
                pure $
                  doLateCostCenters
                    lateCCConfig_env
                    (top_level_late_cc_state { lateCCState_extra = Strict.Nothing })
                    overloadedCallsCC
                    top_level_cc_binds
        else
          return
            ( top_level_cc_binds
            , top_level_late_cc_state { lateCCState_extra = Strict.Nothing }
            )
  
      return (late_cc_binds, late_cc_state)
    where
      top_level_cc_pred :: CoreExpr -> Bool
      top_level_cc_pred =
          case lateCCConfig_whichBinds of
            LateCCBinds -> \rhs ->
              -- Make sure we record any functions. Even if it's something like `f = g`.
              mightBeFunTy (exprType rhs) ||
              -- If the RHS is a CAF doing work also insert a CC.
              not (exprIsWorkFree rhs)
            LateCCOverloadedBinds ->
              isOverloadedTy . exprType
            LateCCNone ->
              -- This is here for completeness, we won't actually use this
              -- predicate in this case since we'll shortcut.
              const False
  
      this_mod = lateCCEnv_module lateCCConfig_env
  