X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fprofiling%2FSCCfinal.lhs;h=8c3b62574d0158802c4b94cd6dd250eeb48697af;hp=b24840d6fb7c572e93a084d526d57851b8e59363;hb=5289f5d85610f71625a439747a09384876655eb5;hpb=f5d4c3239e57b0396672ffc302961f84398d730e diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index b24840d..8c3b625 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -5,22 +5,21 @@ This is now a sort-of-normal STG-to-STG pass (WDP 94/06), run by stg2stg. -* Traverses the STG program collecting the cost centres. These are - required to declare the cost centres at the start of code - generation. + - Traverses the STG program collecting the cost centres. These are required + to declare the cost centres at the start of code generation. - Note: because of cross-module unfolding, some of these cost centres - may be from other modules. But will still have to give them - "extern" declarations. + Note: because of cross-module unfolding, some of these cost centres may be + from other modules. But will still have to give them "extern" + declarations. -* Puts on CAF cost-centres if the user has asked for individual CAF - cost-centres. + - Puts on CAF cost-centres if the user has asked for individual CAF + cost-centres. -* Ditto for individual DICT cost-centres. + - Ditto for individual DICT cost-centres. -* Boxes top-level inherited functions passed as arguments. + - Boxes top-level inherited functions passed as arguments. -* "Distributes" given cost-centres to all as-yet-unmarked RHSs. + - "Distributes" given cost-centres to all as-yet-unmarked RHSs. \begin{code} module SCCfinal ( stgMassageForProfiling ) where @@ -29,7 +28,6 @@ module SCCfinal ( stgMassageForProfiling ) where import StgSyn -import StaticFlags ( opt_AutoSccsOnIndividualCafs ) import CostCentre -- lots of things import Id import Name @@ -41,24 +39,26 @@ import UniqSupply ( uniqFromSupply ) import VarSet import ListSetOps ( removeDups ) import Outputable +import DynFlags \end{code} \begin{code} stgMassageForProfiling - :: PackageId + :: DynFlags + -> PackageId -> Module -- module name -> UniqSupply -- unique supply -> [StgBinding] -- input -> (CollectedCCs, [StgBinding]) -stgMassageForProfiling this_pkg mod_name us stg_binds +stgMassageForProfiling dflags this_pkg mod_name us stg_binds = let ((local_ccs, extern_ccs, cc_stacks), stg_binds2) = initMM mod_name us (do_top_bindings stg_binds) (fixed_ccs, fixed_cc_stacks) - = if opt_AutoSccsOnIndividualCafs + = if dopt Opt_AutoSccsOnIndividualCafs dflags then ([],[]) -- don't need "all CAFs" CC -- (for Prelude, we use PreludeCC) else ([all_cafs_cc], [all_cafs_ccs]) @@ -122,7 +122,7 @@ stgMassageForProfiling this_pkg mod_name us stg_binds | noCCSAttached no_cc || currentOrSubsumedCCS no_cc = do -- Top level CAF without a cost centre attached -- Attach CAF cc (collect if individual CAF ccs) - caf_ccs <- if opt_AutoSccsOnIndividualCafs + caf_ccs <- if dopt Opt_AutoSccsOnIndividualCafs dflags then let cc = mkAutoCC binder modl CafCC ccs = mkSingletonCCS cc -- careful: the binder might be :Main.main,