- do_top_rhs :: Id -> PlainStgRhs -> MassageM PlainStgRhs
-
- do_top_rhs binder (StgRhsClosure rhs_cc bi fv u [] (StgSCC ty cc (StgConApp con args lvs)))
- -- top-level _scc_ around nothing but static data; toss it -- it's pointless
- = returnMM (StgRhsCon dontCareCostCentre con args)
-
- do_top_rhs binder (StgRhsClosure rhs_cc bi fv u [] (StgSCC ty cc expr))
--- OLD:
--- | noCostCentreAttached rhs_cc || currentOrSubsumedCosts rhs_cc
--- -- doubtful guard... ToDo?
- -- Top level CAF with explicit scc expression. Attach CAF
- -- cost centre to StgRhsClosure and collect.
- = let
- calved_cc = cafifyCC cc
- in
- collectCC calved_cc `thenMM_`
- set_prevailing_cc calved_cc (
- do_expr expr
- ) `thenMM` \ expr' ->
- returnMM (StgRhsClosure calved_cc bi fv u [] expr')
+ do_top_rhs :: Id -> StgRhs -> MassageM StgRhs
+
+ do_top_rhs binder (StgRhsClosure _ bi fv u [] (StgSCC cc (StgConApp con args)))
+ | not (isSccCountCostCentre cc) && not (isDllConApp con args)
+ -- Trivial _scc_ around nothing but static data
+ -- Eliminate _scc_ ... and turn into StgRhsCon
+
+ -- isDllConApp checks for LitLit args too
+ = returnMM (StgRhsCon dontCareCCS con args)
+
+{- Can't do this one with cost-centre stacks: --SDM
+ do_top_rhs binder (StgRhsClosure no_cc bi fv u [] (StgSCC ty cc expr))
+ | (noCCSAttached no_cc || currentOrSubsumedCCS no_cc)
+ && not (isSccCountCostCentre cc)
+ -- Top level CAF without a cost centre attached
+ -- Attach and collect cc of trivial _scc_ in body
+ = collectCC cc `thenMM_`
+ set_prevailing_cc cc (do_expr expr) `thenMM` \ expr' ->
+ returnMM (StgRhsClosure cc bi fv u [] expr')
+-}
+
+ do_top_rhs binder (StgRhsClosure no_cc bi fv u [] body)
+ | noCCSAttached no_cc || currentOrSubsumedCCS no_cc
+ -- 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
+ ccs = mkSingletonCCS cc
+ in
+ collectCC cc `thenMM_`
+ collectCCS ccs `thenMM_`
+ returnMM ccs
+ else
+ returnMM all_cafs_ccs) `thenMM` \ caf_ccs ->
+ set_prevailing_cc caf_ccs (do_expr body) `thenMM` \ body' ->
+ returnMM (StgRhsClosure caf_ccs bi fv u [] body')