X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprofiling%2FSCCfinal.lhs;h=256984ad91b0cecf9ac76ab6d87a3bdbed548960;hb=022fc24719ba4b98b8d9f19bfe7f75dd0f19d585;hp=7aaf1096978115f19d8de7a2af73dc78b376b90c;hpb=e07e2550074ddc7d96e2092e56add418403bd29a;p=ghc-hetmet.git diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index 7aaf109..256984a 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -39,7 +39,6 @@ import UniqSupply ( splitUniqSupply, UniqSupply ) #ifdef PROF_DO_BOXING import UniqSupply ( uniqFromSupply ) #endif -import Unique ( Unique ) import VarSet import ListSetOps ( removeDups ) import Outputable @@ -137,7 +136,7 @@ stgMassageForProfiling this_pkg mod_name us stg_binds modl | Just m <- nameModule_maybe (idName binder) = m | otherwise = mod_name in - collectCC cc `thenMM_` + collectNewCC cc `thenMM_` collectCCS ccs `thenMM_` returnMM ccs else @@ -418,6 +417,14 @@ collectCC cc mod_name scope_cc us ids (local_ccs, extern_ccs, ccss) else -- must declare it "extern" ((local_ccs, cc : extern_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 +-- module name (eg. the special :Main module) see bug #249, #1472, +-- test prof001,prof002. +collectNewCC :: CostCentre -> MassageM () +collectNewCC cc mod_name scope_cc us ids (local_ccs, extern_ccs, ccss) + = ((cc : local_ccs, extern_ccs, ccss), ()) + collectCCS :: CostCentreStack -> MassageM () collectCCS ccs mod_name scope_cc us ids (local_ccs, extern_ccs, ccss)