diff options
Diffstat (limited to 'compiler/profiling')
-rw-r--r-- | compiler/profiling/CostCentre.lhs | 39 | ||||
-rw-r--r-- | compiler/profiling/SCCfinal.lhs | 2 |
2 files changed, 40 insertions, 1 deletions
diff --git a/compiler/profiling/CostCentre.lhs b/compiler/profiling/CostCentre.lhs index 8d9c269305..7e6959baaa 100644 --- a/compiler/profiling/CostCentre.lhs +++ b/compiler/profiling/CostCentre.lhs @@ -29,6 +29,7 @@ module CostCentre ( cmpCostCentre -- used for removing dups in a list ) where +import Binary import Var import Name import Module @@ -294,4 +295,42 @@ costCentreUserNameFS (NormalCC {cc_name = name, cc_is_caf = is_caf}) costCentreSrcSpan :: CostCentre -> SrcSpan costCentreSrcSpan = cc_loc + +instance Binary IsCafCC where + put_ bh CafCC = do + putByte bh 0 + put_ bh NotCafCC = do + putByte bh 1 + get bh = do + h <- getByte bh + case h of + 0 -> do return CafCC + _ -> do return NotCafCC + +instance Binary CostCentre where + put_ bh (NormalCC aa ab ac _ad ae) = do + putByte bh 0 + put_ bh aa + put_ bh ab + put_ bh ac + put_ bh ae + put_ bh (AllCafsCC ae _af) = do + putByte bh 1 + put_ bh ae + get bh = do + h <- getByte bh + case h of + 0 -> do aa <- get bh + ab <- get bh + ac <- get bh + ae <- get bh + return (NormalCC aa ab ac noSrcSpan ae) + _ -> do ae <- get bh + return (AllCafsCC ae noSrcSpan) + + -- We ignore the SrcSpans in CostCentres when we serialise them, + -- and set the SrcSpans to noSrcSpan when deserialising. This is + -- ok, because we only need the SrcSpan when declaring the + -- CostCentre in the original module, it is not used by importing + -- modules. \end{code} diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index 77e2cb78c0..5417ad491e 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -91,7 +91,7 @@ stgMassageForProfiling dflags mod_name _us stg_binds do_top_rhs _ (StgRhsClosure _ _ _ _ _ [] (StgSCC _cc False{-not tick-} _push (StgConApp con args))) - | not (isDllConApp dflags con args) + | not (isDllConApp dflags mod_name con args) -- Trivial _scc_ around nothing but static data -- Eliminate _scc_ ... and turn into StgRhsCon |