Commit 2a78cf77 authored by Ömer Sinan Ağacan's avatar Ömer Sinan Ağacan Committed by Ben Gamari
Browse files

Remove unused extern cost centre collection

Reviewers: bgamari, simonmar

Reviewed By: simonmar

Subscribers: alexbiehl, rwbarton, thomie, carter

Differential Revision: https://phabricator.haskell.org/D4309
parent 33358113
...@@ -209,7 +209,7 @@ ifProfilingL dflags xs ...@@ -209,7 +209,7 @@ ifProfilingL dflags xs
initCostCentres :: CollectedCCs -> FCode () initCostCentres :: CollectedCCs -> FCode ()
-- Emit the declarations -- Emit the declarations
initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs) initCostCentres (local_CCs, singleton_CCSs)
= do dflags <- getDynFlags = do dflags <- getDynFlags
when (gopt Opt_SccProfilingOn dflags) $ when (gopt Opt_SccProfilingOn dflags) $
do mapM_ emitCostCentreDecl local_CCs do mapM_ emitCostCentreDecl local_CCs
......
...@@ -182,7 +182,6 @@ data CostCentreStack ...@@ -182,7 +182,6 @@ data CostCentreStack
-- code for a module. -- code for a module.
type CollectedCCs type CollectedCCs
= ( [CostCentre] -- local cost-centres that need to be decl'd = ( [CostCentre] -- local cost-centres that need to be decl'd
, [CostCentre] -- "extern" cost-centres
, [CostCentreStack] -- pre-defined "singleton" cost centre stacks , [CostCentreStack] -- pre-defined "singleton" cost centre stacks
) )
......
...@@ -23,7 +23,7 @@ import Module ...@@ -23,7 +23,7 @@ import Module
-- module; -- module;
profilingInitCode :: Module -> CollectedCCs -> SDoc profilingInitCode :: Module -> CollectedCCs -> SDoc
profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs) profilingInitCode this_mod (local_CCs, singleton_CCSs)
= sdocWithDynFlags $ \dflags -> = sdocWithDynFlags $ \dflags ->
if not (gopt Opt_SccProfilingOn dflags) if not (gopt Opt_SccProfilingOn dflags)
then empty then empty
......
...@@ -30,7 +30,6 @@ import Id ...@@ -30,7 +30,6 @@ import Id
import Name import Name
import Module import Module
import UniqSupply ( UniqSupply ) import UniqSupply ( UniqSupply )
import ListSetOps ( removeDups )
import Outputable import Outputable
import DynFlags import DynFlags
import CoreSyn ( Tickish(..) ) import CoreSyn ( Tickish(..) )
...@@ -49,7 +48,7 @@ stgMassageForProfiling ...@@ -49,7 +48,7 @@ stgMassageForProfiling
stgMassageForProfiling dflags mod_name _us stg_binds stgMassageForProfiling dflags mod_name _us stg_binds
= let = let
((local_ccs, extern_ccs, cc_stacks), ((local_ccs, cc_stacks),
stg_binds2) stg_binds2)
= initMM mod_name (do_top_bindings stg_binds) = initMM mod_name (do_top_bindings stg_binds)
...@@ -58,11 +57,9 @@ stgMassageForProfiling dflags mod_name _us stg_binds ...@@ -58,11 +57,9 @@ stgMassageForProfiling dflags mod_name _us stg_binds
then ([],[]) -- don't need "all CAFs" CC then ([],[]) -- don't need "all CAFs" CC
else ([all_cafs_cc], [all_cafs_ccs]) else ([all_cafs_cc], [all_cafs_ccs])
local_ccs_no_dups = fst (removeDups cmpCostCentre local_ccs) local_ccs_no_dups = nubSort local_ccs
extern_ccs_no_dups = fst (removeDups cmpCostCentre extern_ccs)
in in
((fixed_ccs ++ local_ccs_no_dups, ((fixed_ccs ++ local_ccs_no_dups,
extern_ccs_no_dups,
fixed_cc_stacks ++ cc_stacks), stg_binds2) fixed_cc_stacks ++ cc_stacks), stg_binds2)
where where
...@@ -248,7 +245,7 @@ initMM :: Module -- module name, which we may consult ...@@ -248,7 +245,7 @@ initMM :: Module -- module name, which we may consult
-> MassageM a -> MassageM a
-> (CollectedCCs, 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 -> (a -> MassageM b) -> MassageM b
thenMM_ :: MassageM a -> (MassageM b) -> MassageM b thenMM_ :: MassageM a -> (MassageM b) -> MassageM b
...@@ -264,11 +261,11 @@ thenMM_ expr cont = MassageM $ \mod ccs -> ...@@ -264,11 +261,11 @@ thenMM_ expr cont = MassageM $ \mod ccs ->
collectCC :: CostCentre -> MassageM () collectCC :: CostCentre -> MassageM ()
collectCC cc collectCC cc
= MassageM $ \mod_name (local_ccs, extern_ccs, ccss) = MassageM $ \mod_name (local_ccs, ccss)
-> if (cc `ccFromThisModule` mod_name) then -> if (cc `ccFromThisModule` mod_name) then
((cc : local_ccs, extern_ccs, ccss), ()) ((cc : local_ccs, ccss), ())
else -- must declare it "extern" else
((local_ccs, cc : extern_ccs, ccss), ()) ((local_ccs, ccss), ())
-- Version of collectCC used when we definitely want to declare this -- 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 -- CC as local, even if its module name is not the same as the current
...@@ -276,12 +273,12 @@ collectCC cc ...@@ -276,12 +273,12 @@ collectCC cc
-- test prof001,prof002. -- test prof001,prof002.
collectNewCC :: CostCentre -> MassageM () collectNewCC :: CostCentre -> MassageM ()
collectNewCC cc collectNewCC cc
= MassageM $ \_mod_name (local_ccs, extern_ccs, ccss) = MassageM $ \_mod_name (local_ccs, ccss)
-> ((cc : local_ccs, extern_ccs, ccss), ()) -> ((cc : local_ccs, ccss), ())
collectCCS :: CostCentreStack -> MassageM () collectCCS :: CostCentreStack -> MassageM ()
collectCCS ccs collectCCS ccs
= MassageM $ \_mod_name (local_ccs, extern_ccs, ccss) = MassageM $ \_mod_name (local_ccs, ccss)
-> ASSERT(not (noCCSAttached ccs)) -> ASSERT(not (noCCSAttached ccs))
((local_ccs, extern_ccs, ccs : ccss), ()) ((local_ccs, ccs : ccss), ())
...@@ -43,7 +43,7 @@ stg2stg dflags module_name binds ...@@ -43,7 +43,7 @@ stg2stg dflags module_name binds
(putLogMsg dflags NoReason SevDump noSrcSpan (putLogMsg dflags NoReason SevDump noSrcSpan
(defaultDumpStyle dflags) (text "VERBOSE STG-TO-STG:")) (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! -- Do the main business!
; let (us0, us1) = splitUniqSupply us' ; let (us0, us1) = splitUniqSupply us'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment