module GHC.Core.Opt.Pipeline.Types (
    -- * Configuration of the core-to-core passes
    CorePluginPass, CoreToDo(..),
    bindsOnlyPass, pprPassDetails,
  ) where

import GHC.Prelude

import GHC.Core ( CoreProgram )
import GHC.Core.Opt.Monad ( CoreM, FloatOutSwitches )
import GHC.Core.Opt.Simplify ( SimplifyOpts(..) )

import GHC.Types.Basic  ( CompilerPhase(..) )
import GHC.Unit.Module.ModGuts
import GHC.Utils.Outputable as Outputable

{-
************************************************************************
*                                                                      *
              The CoreToDo type and related types
          Abstraction of core-to-core passes to run.
*                                                                      *
************************************************************************
-}

-- | A description of the plugin pass itself
type CorePluginPass = ModGuts -> CoreM ModGuts

bindsOnlyPass :: (CoreProgram -> CoreM CoreProgram) -> ModGuts -> CoreM ModGuts
bindsOnlyPass :: (CoreProgram -> CoreM CoreProgram) -> ModGuts -> CoreM ModGuts
bindsOnlyPass CoreProgram -> CoreM CoreProgram
pass ModGuts
guts
  = do { CoreProgram
binds' <- CoreProgram -> CoreM CoreProgram
pass (ModGuts -> CoreProgram
mg_binds ModGuts
guts)
       ; ModGuts -> CoreM ModGuts
forall a. a -> CoreM a
forall (m :: * -> *) a. Monad m => a -> m a
return (ModGuts
guts { mg_binds = binds' }) }

data CoreToDo           -- These are diff core-to-core passes,
                        -- which may be invoked in any order,
                        -- as many times as you like.

  = CoreDoSimplify !SimplifyOpts
  -- ^ The core-to-core simplifier.
  | CoreDoPluginPass String CorePluginPass
  | CoreDoFloatInwards
  | CoreDoFloatOutwards FloatOutSwitches
  | CoreLiberateCase
  | CoreDoPrintCore
  | CoreDoStaticArgs
  | CoreDoCallArity
  | CoreDoExitify
  | CoreDoDemand Bool  -- Bool: Do worker/wrapper afterwards?
                       -- See Note [Don't change boxity without worker/wrapper]
  | CoreDoCpr
  | CoreDoWorkerWrapper
  | CoreDoSpecialising
  | CoreDoSpecConstr
  | CoreCSE
  | CoreDoRuleCheck CompilerPhase String   -- Check for non-application of rules
                                           -- matching this string
  | CoreDoNothing                -- Useful when building up
  | CoreDoPasses [CoreToDo]      -- lists of these things

  | CoreDesugar    -- Right after desugaring, no simple optimisation yet!
  | CoreDesugarOpt -- CoreDesugarXXX: Not strictly a core-to-core pass, but produces
                       --                 Core output, and hence useful to pass to endPass

  | CoreTidy
  | CorePrep
  | CoreAddCallerCcs
  | CoreAddLateCcs

instance Outputable CoreToDo where
  ppr :: CoreToDo -> SDoc
ppr (CoreDoSimplify SimplifyOpts
_)       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Simplifier"
  ppr (CoreDoPluginPass String
s ModGuts -> CoreM ModGuts
_)   = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Core plugin: " SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> String -> SDoc
forall doc. IsLine doc => String -> doc
text String
s
  ppr CoreToDo
CoreDoFloatInwards       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Float inwards"
  ppr (CoreDoFloatOutwards FloatOutSwitches
f)  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Float out" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc
parens (FloatOutSwitches -> SDoc
forall a. Outputable a => a -> SDoc
ppr FloatOutSwitches
f)
  ppr CoreToDo
CoreLiberateCase         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Liberate case"
  ppr CoreToDo
CoreDoStaticArgs         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Static argument"
  ppr CoreToDo
CoreDoCallArity          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Called arity analysis"
  ppr CoreToDo
CoreDoExitify            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Exitification transformation"
  ppr (CoreDoDemand Bool
True)      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Demand analysis (including Boxity)"
  ppr (CoreDoDemand Bool
False)     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Demand analysis"
  ppr CoreToDo
CoreDoCpr                = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Constructed Product Result analysis"
  ppr CoreToDo
CoreDoWorkerWrapper      = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Worker Wrapper binds"
  ppr CoreToDo
CoreDoSpecialising       = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Specialise"
  ppr CoreToDo
CoreDoSpecConstr         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"SpecConstr"
  ppr CoreToDo
CoreCSE                  = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Common sub-expression"
  ppr CoreToDo
CoreDesugar              = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Desugar (before optimization)"
  ppr CoreToDo
CoreDesugarOpt           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Desugar (after optimization)"
  ppr CoreToDo
CoreTidy                 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Tidy Core"
  ppr CoreToDo
CoreAddCallerCcs         = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Add caller cost-centres"
  ppr CoreToDo
CoreAddLateCcs           = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Add late core cost-centres"
  ppr CoreToDo
CorePrep                 = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CorePrep"
  ppr CoreToDo
CoreDoPrintCore          = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Print core"
  ppr (CoreDoRuleCheck {})     = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Rule check"
  ppr CoreToDo
CoreDoNothing            = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CoreDoNothing"
  ppr (CoreDoPasses [CoreToDo]
passes)    = String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"CoreDoPasses" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> [CoreToDo] -> SDoc
forall a. Outputable a => a -> SDoc
ppr [CoreToDo]
passes

pprPassDetails :: CoreToDo -> SDoc
pprPassDetails :: CoreToDo -> SDoc
pprPassDetails (CoreDoSimplify SimplifyOpts
cfg) = [SDoc] -> SDoc
forall doc. IsDoc doc => [doc] -> doc
vcat [ String -> SDoc
forall doc. IsLine doc => String -> doc
text String
"Max iterations =" SDoc -> SDoc -> SDoc
forall doc. IsLine doc => doc -> doc -> doc
<+> Int -> SDoc
forall doc. IsLine doc => Int -> doc
int Int
n
                                           , SimplMode -> SDoc
forall a. Outputable a => a -> SDoc
ppr SimplMode
md ]
  where
    n :: Int
n = SimplifyOpts -> Int
so_iterations SimplifyOpts
cfg
    md :: SimplMode
md = SimplifyOpts -> SimplMode
so_mode SimplifyOpts
cfg

pprPassDetails CoreToDo
_ = SDoc
forall doc. IsOutput doc => doc
Outputable.empty