summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2018-01-18 11:06:30 -0500
committerBen Gamari <ben@smart-cactus.org>2018-01-18 11:06:31 -0500
commit2a78cf773cb447ac91c4a23d7e921e091e499134 (patch)
tree7895eb78cf96ad42051786633fa21310629c65f0
parent33358113175a66f8bfecd13f979aa7508e667271 (diff)
downloadhaskell-2a78cf773cb447ac91c4a23d7e921e091e499134.tar.gz
Remove unused extern cost centre collection
Reviewers: bgamari, simonmar Reviewed By: simonmar Subscribers: alexbiehl, rwbarton, thomie, carter Differential Revision: https://phabricator.haskell.org/D4309
-rw-r--r--compiler/codeGen/StgCmmProf.hs2
-rw-r--r--compiler/profiling/CostCentre.hs1
-rw-r--r--compiler/profiling/ProfInit.hs2
-rw-r--r--compiler/profiling/SCCfinal.hs25
-rw-r--r--compiler/simplStg/SimplStg.hs2
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'