diff options
| -rw-r--r-- | compiler/codeGen/StgCmmProf.hs | 2 | ||||
| -rw-r--r-- | compiler/profiling/CostCentre.hs | 1 | ||||
| -rw-r--r-- | compiler/profiling/ProfInit.hs | 2 | ||||
| -rw-r--r-- | compiler/profiling/SCCfinal.hs | 25 | ||||
| -rw-r--r-- | compiler/simplStg/SimplStg.hs | 2 |
5 files changed, 14 insertions, 18 deletions
diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index a91c4c0ed1..e5e1379877 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -209,7 +209,7 @@ ifProfilingL dflags xs initCostCentres :: CollectedCCs -> FCode () -- Emit the declarations -initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs) +initCostCentres (local_CCs, singleton_CCSs) = do dflags <- getDynFlags when (gopt Opt_SccProfilingOn dflags) $ do mapM_ emitCostCentreDecl local_CCs diff --git a/compiler/profiling/CostCentre.hs b/compiler/profiling/CostCentre.hs index d1452ad576..f89654dc00 100644 --- a/compiler/profiling/CostCentre.hs +++ b/compiler/profiling/CostCentre.hs @@ -182,7 +182,6 @@ data CostCentreStack -- code for a module. type CollectedCCs = ( [CostCentre] -- local cost-centres that need to be decl'd - , [CostCentre] -- "extern" cost-centres , [CostCentreStack] -- pre-defined "singleton" cost centre stacks ) diff --git a/compiler/profiling/ProfInit.hs b/compiler/profiling/ProfInit.hs index 557bdf0ea4..931299a655 100644 --- a/compiler/profiling/ProfInit.hs +++ b/compiler/profiling/ProfInit.hs @@ -23,7 +23,7 @@ import Module -- module; profilingInitCode :: Module -> CollectedCCs -> SDoc -profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs) +profilingInitCode this_mod (local_CCs, singleton_CCSs) = sdocWithDynFlags $ \dflags -> if not (gopt Opt_SccProfilingOn dflags) then empty diff --git a/compiler/profiling/SCCfinal.hs b/compiler/profiling/SCCfinal.hs index 4c582f4d28..8a2513fd16 100644 --- a/compiler/profiling/SCCfinal.hs +++ b/compiler/profiling/SCCfinal.hs @@ -30,7 +30,6 @@ import Id import Name import Module import UniqSupply ( UniqSupply ) -import ListSetOps ( removeDups ) import Outputable import DynFlags import CoreSyn ( Tickish(..) ) @@ -49,7 +48,7 @@ stgMassageForProfiling stgMassageForProfiling dflags mod_name _us stg_binds = let - ((local_ccs, extern_ccs, cc_stacks), + ((local_ccs, cc_stacks), stg_binds2) = initMM mod_name (do_top_bindings stg_binds) @@ -58,11 +57,9 @@ stgMassageForProfiling dflags mod_name _us stg_binds then ([],[]) -- don't need "all CAFs" CC else ([all_cafs_cc], [all_cafs_ccs]) - local_ccs_no_dups = fst (removeDups cmpCostCentre local_ccs) - extern_ccs_no_dups = fst (removeDups cmpCostCentre extern_ccs) + local_ccs_no_dups = nubSort local_ccs in ((fixed_ccs ++ local_ccs_no_dups, - extern_ccs_no_dups, fixed_cc_stacks ++ cc_stacks), stg_binds2) where @@ -248,7 +245,7 @@ initMM :: Module -- module name, which we may consult -> MassageM a -> (CollectedCCs, a) -initMM mod_name (MassageM m) = m mod_name ([],[],[]) +initMM mod_name (MassageM m) = m mod_name ([],[]) thenMM :: MassageM a -> (a -> MassageM b) -> MassageM b thenMM_ :: MassageM a -> (MassageM b) -> MassageM b @@ -264,11 +261,11 @@ thenMM_ expr cont = MassageM $ \mod ccs -> collectCC :: CostCentre -> MassageM () collectCC cc - = MassageM $ \mod_name (local_ccs, extern_ccs, ccss) + = MassageM $ \mod_name (local_ccs, ccss) -> if (cc `ccFromThisModule` mod_name) then - ((cc : local_ccs, extern_ccs, ccss), ()) - else -- must declare it "extern" - ((local_ccs, cc : extern_ccs, ccss), ()) + ((cc : local_ccs, ccss), ()) + else + ((local_ccs, ccss), ()) -- Version of collectCC used when we definitely want to declare this -- CC as local, even if its module name is not the same as the current @@ -276,12 +273,12 @@ collectCC cc -- test prof001,prof002. collectNewCC :: CostCentre -> MassageM () collectNewCC cc - = MassageM $ \_mod_name (local_ccs, extern_ccs, ccss) - -> ((cc : local_ccs, extern_ccs, ccss), ()) + = MassageM $ \_mod_name (local_ccs, ccss) + -> ((cc : local_ccs, ccss), ()) collectCCS :: CostCentreStack -> MassageM () collectCCS ccs - = MassageM $ \_mod_name (local_ccs, extern_ccs, ccss) + = MassageM $ \_mod_name (local_ccs, ccss) -> ASSERT(not (noCCSAttached ccs)) - ((local_ccs, extern_ccs, ccs : ccss), ()) + ((local_ccs, ccs : ccss), ()) diff --git a/compiler/simplStg/SimplStg.hs b/compiler/simplStg/SimplStg.hs index ad714ea4c8..2af53e4877 100644 --- a/compiler/simplStg/SimplStg.hs +++ b/compiler/simplStg/SimplStg.hs @@ -43,7 +43,7 @@ stg2stg dflags module_name binds (putLogMsg dflags NoReason SevDump noSrcSpan (defaultDumpStyle dflags) (text "VERBOSE STG-TO-STG:")) - ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[],[]) binds + ; (binds', us', ccs) <- end_pass us "Stg2Stg" ([],[]) binds -- Do the main business! ; let (us0, us1) = splitUniqSupply us' |