summaryrefslogtreecommitdiff
path: root/compiler/GHC/StgToCmm/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/StgToCmm/Utils.hs')
-rw-r--r--compiler/GHC/StgToCmm/Utils.hs13
1 files changed, 11 insertions, 2 deletions
diff --git a/compiler/GHC/StgToCmm/Utils.hs b/compiler/GHC/StgToCmm/Utils.hs
index 934fd6d726..8c6a40c69d 100644
--- a/compiler/GHC/StgToCmm/Utils.hs
+++ b/compiler/GHC/StgToCmm/Utils.hs
@@ -90,6 +90,7 @@ import GHC.Core.DataCon
import GHC.Types.Unique.FM
import GHC.Data.Maybe
import Control.Monad
+import qualified Data.Map.Strict as Map
--------------------------------------------------------------------------
--
@@ -600,7 +601,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 (UniqMap dcenv) denv) =
+convertInfoProvMap dflags defns this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) =
map (\cmit ->
let cl = cit_lbl cmit
cn = rtsClosureType (cit_rep cmit)
@@ -620,8 +621,16 @@ convertInfoProvMap dflags defns this_mod (InfoTableProvMap (UniqMap dcenv) denv)
-- Lookup is linear but lists will be small (< 100)
return $ InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns))
+ lookupInfoTableToSourceLocation = do
+ sourceNote <- Map.lookup (cit_lbl cmit) infoTableToSourceLocationMap
+ return $ InfoProvEnt cl cn "" this_mod sourceNote
+
-- 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 (lookupDataConMap `firstJust` lookupClosureMap)) defns
+ in
+ if (isStackRep . cit_rep) cmit then
+ fromMaybe simpleFallback lookupInfoTableToSourceLocation
+ else
+ fromMaybe simpleFallback (lookupDataConMap `firstJust` lookupClosureMap)) defns