[project @ 2001-11-23 11:59:21 by simonmar]

Collect up _scc_ expressions on the right hand side of a closure
definition and attach them directly to the closure using PushCC-type
cost centres, so that the allocation of the closure gets attributed to
the right place.

diff --git a/ghc/compiler/profiling/SCCfinal.lhs b/ghc/compiler/profiling/SCCfinal.lhs
index e71a2ff..8ed34ab 100644 (file)
--- a/ghc/compiler/profiling/SCCfinal.lhs
+++ b/ghc/compiler/profiling/SCCfinal.lhs
@@ -246,22 +246,17 @@ stgMassageForProfiling mod_name us stg_binds
        returnMM (StgRhsCon cc con args)
 -}
 
-{-
-    do_rhs (StgRhsClosure _ bi fv u args (StgSCC ty cc expr))
-      | not (isSccCountCostCentre cc)
-      = collectCC cc                           `thenMM_`
-       set_prevailing_cc cc (do_expr expr)     `thenMM` \ expr' ->
-       returnMM (StgRhsClosure cc bi fv u args expr')
--}
-
-    do_rhs (StgRhsClosure cc bi fv u [] body)
-      = do_expr body                           `thenMM` \ body' ->
-       returnMM (StgRhsClosure currentCCS bi fv u [] body')
-
-    do_rhs (StgRhsClosure cc bi fv u args body)
-      = set_lambda_cc (do_expr body)           `thenMM` \ body' ->
-       get_prevailing_cc                       `thenMM` \ prev_ccs ->
-       returnMM (StgRhsClosure currentCCS bi fv u args body')
+    do_rhs (StgRhsClosure _ bi fv u args expr)
+      = slurpSCCs currentCCS expr              `thenMM` \ (expr', ccs) ->
+       do_expr expr'                           `thenMM` \ expr'' ->
+       returnMM (StgRhsClosure ccs bi fv u args expr'')
+      where
+       slurpSCCs ccs (StgSCC cc e) 
+            = collectCC cc                     `thenMM_`
+              slurpSCCs ccs e                  `thenMM` \ (e', ccs')  ->
+              returnMM (e', pushCCOnCCS cc ccs')
+       slurpSCCs ccs e 
+            = returnMM (e, ccs)
 
     do_rhs (StgRhsCon cc con args)
       = returnMM (StgRhsCon currentCCS con args)
@@ -337,7 +332,7 @@ type MassageM result
   =  Module            -- module name
   -> CostCentreStack   -- prevailing CostCentre
                        -- if none, subsumedCosts at top-level
-                       -- useCurrentCostCentre at nested levels
+                       -- currentCostCentre at nested levels
   -> UniqSupply
   -> VarSet            -- toplevel-ish Ids for boxing
   -> CollectedCCs