X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fprofiling%2FSCCfinal.lhs;h=7aaf1096978115f19d8de7a2af73dc78b376b90c;hb=e07e2550074ddc7d96e2092e56add418403bd29a;hp=d27a3a0c4af4f059014f274965b522d659b1fe14;hpb=d5934bbb856aa0aa620c9b2e0fa51c90a1a5a048;p=ghc-hetmet.git diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index d27a3a0..7aaf109 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -32,7 +32,8 @@ import StgSyn import PackageConfig ( PackageId ) import StaticFlags ( opt_AutoSccsOnIndividualCafs ) import CostCentre -- lots of things -import Id ( Id ) +import Id +import Name import Module ( Module ) import UniqSupply ( splitUniqSupply, UniqSupply ) #ifdef PROF_DO_BOXING @@ -128,8 +129,13 @@ stgMassageForProfiling this_pkg mod_name us stg_binds -- Top level CAF without a cost centre attached -- Attach CAF cc (collect if individual CAF ccs) = (if opt_AutoSccsOnIndividualCafs - then let cc = mkAutoCC binder mod_name CafCC + then let cc = mkAutoCC binder modl CafCC ccs = mkSingletonCCS cc + -- careful: the binder might be :Main.main, + -- which doesn't belong to module mod_name. + -- bug #249, tests prof001, prof002 + modl | Just m <- nameModule_maybe (idName binder) = m + | otherwise = mod_name in collectCC cc `thenMM_` collectCCS ccs `thenMM_`