summaryrefslogtreecommitdiff
path: root/compiler/GHC/StgToCmm/Utils.hs
diff options
context:
space:
mode:
authorMatthew Pickering <matthewtpickering@gmail.com>2020-11-18 11:55:55 +0000
committerMatthew Pickering <matthewtpickering@gmail.com>2021-03-03 19:09:34 +0000
commita7aac008f69ca48e5ab3d4186fdcb3214c6e1463 (patch)
treeb41d57ca638eddfad54d9cfedf9b47c66106e34a /compiler/GHC/StgToCmm/Utils.hs
parent4b297979d25740d31241a9000e36068db112545a (diff)
downloadhaskell-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.hs18
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