diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2020-11-18 11:55:55 +0000 |
---|---|---|
committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-03-03 19:09:34 +0000 |
commit | a7aac008f69ca48e5ab3d4186fdcb3214c6e1463 (patch) | |
tree | b41d57ca638eddfad54d9cfedf9b47c66106e34a /compiler/GHC/StgToCmm/Utils.hs | |
parent | 4b297979d25740d31241a9000e36068db112545a (diff) | |
download | haskell-a7aac008f69ca48e5ab3d4186fdcb3214c6e1463.tar.gz |
Add option to give each usage of a data constructor its own info table
The `-fdistinct-constructor-tables` flag will generate a fresh info
table for the usage of any data constructor. This is useful for
debugging as now by inspecting the info table, you can determine which
usage of a constructor caused that allocation rather than the old
situation where the info table always mapped to the definition site of
the data constructor which is useless.
In conjunction with `-hi` and `-finfo-table-map` this gives a more fine
grained understanding of where constructor allocations arise from in a
program.
Diffstat (limited to 'compiler/GHC/StgToCmm/Utils.hs')
-rw-r--r-- | compiler/GHC/StgToCmm/Utils.hs | 18 |
1 files changed, 15 insertions, 3 deletions
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs index bc10eaf4ea..8472711753 100644 --- a/compiler/GHC/StgToCmm/Utils.hs +++ b/compiler/GHC/StgToCmm/Utils.hs @@ -92,6 +92,10 @@ import Data.Ord import GHC.Types.Unique.Map import Data.Maybe import GHC.Driver.Ppr +import qualified Data.List.NonEmpty as NE +import GHC.Core.DataCon +import GHC.Types.Unique.FM +import GHC.Data.Maybe ------------------------------------------------------------------------- -- @@ -294,7 +298,8 @@ emitRODataLits :: CLabel -> [CmmLit] -> FCode () emitRODataLits lbl lits = emitDecl (mkRODataLits lbl lits) emitDataCon :: CLabel -> CmmInfoTable -> CostCentreStack -> [CmmLit] -> FCode () -emitDataCon lbl itbl ccs payload = emitDecl (CmmData (Section Data lbl) (CmmStatics lbl itbl ccs payload)) +emitDataCon lbl itbl ccs payload = + emitDecl (CmmData (Section Data lbl) (CmmStatics lbl itbl ccs payload)) newStringCLit :: String -> FCode CmmLit -- Make a global definition for the string, @@ -647,7 +652,7 @@ cmmInfoTableToInfoProvEnt this_mod cmit = -- | Convert source information collected about identifiers in 'GHC.STG.Debug' -- to entries suitable for placing into the info table provenenance table. convertInfoProvMap :: DynFlags -> [CmmInfoTable] -> Module -> InfoTableProvMap -> [InfoProvEnt] -convertInfoProvMap dflags defns this_mod (InfoTableProvMap denv) = +convertInfoProvMap dflags defns this_mod (InfoTableProvMap (UniqMap dcenv) denv) = map (\cmit -> let cl = cit_lbl cmit cn = rtsClosureType (cit_rep cmit) @@ -660,8 +665,15 @@ convertInfoProvMap dflags defns this_mod (InfoTableProvMap denv) = Just (ty, ss, l) -> Just (InfoProvEnt cl cn (tyString ty) this_mod (Just (ss, l))) Nothing -> Nothing + lookupDataConMap = do + UsageSite _ n <- hasIdLabelInfo cl >>= getConInfoTableLocation + -- This is a bit grimy, relies on the DataCon and Name having the same Unique, which they do + (dc, ns) <- (hasHaskellName cl >>= lookupUFM_Directly dcenv . getUnique) + -- Lookup is linear but lists will be small (< 100) + return $ InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (lookup n (NE.toList ns)) + -- This catches things like prim closure types and anything else which doesn't have a -- source location simpleFallback = cmmInfoTableToInfoProvEnt this_mod cmit - in fromMaybe simpleFallback lookupClosureMap) defns + in fromMaybe simpleFallback (lookupDataConMap `firstJust` lookupClosureMap)) defns |