* "Distributes" given cost-centres to all as-yet-unmarked RHSs.
\begin{code}
-#include "HsVersions.h"
-
module SCCfinal ( stgMassageForProfiling ) where
-IMP_Ubiq(){-uitous-}
+#include "HsVersions.h"
import StgSyn
-import CmdLineOpts ( opt_AutoSccsOnIndividualCafs,
- opt_CompilingGhcInternals
- )
+import CmdLineOpts ( opt_AutoSccsOnIndividualCafs )
import CostCentre -- lots of things
-import Id ( idType, mkSysLocal, emptyIdSet )
-import Maybes ( maybeToBool )
-import PprStyle -- ToDo: rm
+import MkId ( mkSysLocal )
+import Id ( idType, emptyIdSet, Id )
import SrcLoc ( noSrcLoc )
-import Type ( splitSigmaTy, getFunTy_maybe )
-import UniqSupply ( getUnique, splitUniqSupply )
+import Type ( splitSigmaTy, splitFunTy_maybe )
+import UniqSupply ( getUnique, splitUniqSupply, UniqSupply )
+import Unique ( Unique )
import Util ( removeDups, assertPanic )
+import Outputable
+import GlaExts ( trace )
infixr 9 `thenMM`, `thenMM_`
\end{code}
= initMM mod_name us (mapMM do_top_binding stg_binds)
fixed_ccs
- = if do_auto_sccs_on_cafs || doing_prelude
+ = if do_auto_sccs_on_cafs
then [] -- don't need "all CAFs" CC (for Prelude, we use PreludeCC)
else [all_cafs_cc]
((fixed_ccs ++ local_ccs_no_dups, extern_ccs_no_dups), stg_binds2)
where
do_auto_sccs_on_cafs = opt_AutoSccsOnIndividualCafs -- only use!
- doing_prelude = opt_CompilingGhcInternals
- all_cafs_cc = if doing_prelude
- then preludeCafsCostCentre
- else mkAllCafsCC mod_name grp_name
+ all_cafs_cc = mkAllCafsCC mod_name grp_name
----------
do_top_binding :: StgBinding -> MassageM StgBinding
do_top_rhs binder (StgRhsClosure cc bi fv u [] body)
-- Top level CAF with cost centre attached
-- Should this be a CAF cc ??? Does this ever occur ???
- = trace ("SCCfinal: CAF with cc: " ++ showCostCentre PprDebug False cc) $
+ = trace ("SCCfinal: CAF with cc: " ++ showCostCentre False cc) $
collectCC cc `thenMM_`
set_prevailing_cc cc (do_expr body) `thenMM` \ body' ->
returnMM (StgRhsClosure cc bi fv u [] body')