{-# 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)
cmmPipeline
:: Logger
-> CmmConfig
-> ModuleSRTInfo
-> CmmGroup
-> IO (ModuleSRTInfo, CmmGroupSRTs)
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)
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
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
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"
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
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
let
call_pps :: ProcPointSet
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
(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
CmmGraph
g <- {-# SCC "sink" #-}
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"
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
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
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)]
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
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
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
splitting_proc_points :: Bool
splitting_proc_points = CmmConfig -> Bool
cmmSplitProcPoints CmmConfig
cfg
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
$
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