compiler/GHC/Driver/GenerateCgIPEStub.hs

@@ -36,6 +36,7 @@ import GHC.Unit.Module (moduleNameString)
 import qualified GHC.Utils.Logger as Logger
 import GHC.Utils.Outputable (ppr)
 import GHC.Types.Unique.DSM
+import GHC.Cmm.UniqueRenamer
 
 {-
 Note [Stacktraces from Info Table Provenance Entries (IPE based stack unwinding)]
@@ -199,9 +200,10 @@ generateCgIPEStub
      , Map CmmInfoTable (Maybe IpeSourceLocation)
      , IPEStats
      , DUniqSupply
+     , DetUniqFM
      )
   -> Stream IO CmmGroupSRTs CmmCgInfos
-generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesWithTickishes, initStats, dus) = do
+generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesWithTickishes, initStats, dus, detRnEnv) = do
   let dflags   = hsc_dflags hsc_env
       platform = targetPlatform dflags
       logger   = hsc_logger hsc_env
@@ -213,9 +215,9 @@ generateCgIPEStub hsc_env this_mod denv (nonCaffySet, moduleLFInfos, infoTablesW
   let denv' = denv {provInfoTables = Map.mapKeys cit_lbl infoTablesWithTickishes}
       ((mIpeStub, ipeCmmGroup), _) = runC (initStgToCmmConfig dflags this_mod) fstate cgState $ getCmm (initInfoTableProv initStats (Map.keys infoTablesWithTickishes) denv')
 
-  -- TODO: Renaming here
+      (_detRnEnv', rn_ipeCmmGroup) = detRenameCmmGroup detRnEnv ipeCmmGroup
 
-  (_, _, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) dus (removeDeterm ipeCmmGroup)
+  (_, _, ipeCmmGroupSRTs) <- liftIO $ cmmPipeline logger cmm_cfg (emptySRT this_mod) dus rn_ipeCmmGroup
   Stream.yield ipeCmmGroupSRTs
 
   ipeStub <-

compiler/GHC/Driver/Main.hs

@@ -215,6 +215,7 @@ import GHC.Cmm.Info.Build
 import GHC.Cmm.Pipeline
 import GHC.Cmm.Info
 import GHC.Cmm.Parser
+import GHC.Cmm.UniqueRenamer
 
 import GHC.Unit
 import GHC.Unit.Env
@@ -299,7 +300,6 @@ import GHC.Stg.InferTags.TagSig (seqTagSig)
 import GHC.StgToCmm.Utils (IPEStats)
 import GHC.Types.Unique.FM
 import GHC.Types.Unique.DFM
-import GHC.Types.Unique.DSM
 import GHC.Cmm.Config (CmmConfig)
 
 {- **********************************************************************
@@ -2172,11 +2172,11 @@ doCodeGen hsc_env this_mod denv data_tycons
     putDumpFileMaybe logger Opt_D_dump_stg_final "Final STG:" FormatSTG
         (pprGenStgTopBindings stg_ppr_opts stg_binds_w_fvs)
 
-    let stg_to_cmm dflags mod = case stgToCmmHook hooks of
-                        Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod)
-                        Just h  -> h                             (initStgToCmmConfig dflags mod)
+    let stg_to_cmm dflags mod a b c d e = case stgToCmmHook hooks of
+          Nothing -> StgToCmm.codeGen logger tmpfs (initStgToCmmConfig dflags mod) a b c d e
+          Just h  -> (,emptyDetUFM) <$> h          (initStgToCmmConfig dflags mod) a b c d e
 
-    let cmm_stream :: Stream IO CmmGroup ModuleLFInfos
+    let cmm_stream :: Stream IO CmmGroup (ModuleLFInfos, DetUniqFM)
         -- See Note [Forcing of stg_binds]
         cmm_stream = stg_binds_w_fvs `seqList` {-# SCC "StgToCmm" #-}
             stg_to_cmm dflags this_mod denv data_tycons cost_centre_info stg_binds_w_fvs hpc_info
@@ -2198,11 +2198,11 @@ doCodeGen hsc_env this_mod denv data_tycons
 
         pipeline_stream :: Stream IO CmmGroupSRTs CmmCgInfos
         pipeline_stream = do
-          ((mod_srt_info, ipes, ipe_stats, dus), lf_infos) <-
+          ((mod_srt_info, ipes, ipe_stats, dus), (lf_infos, detRnEnv)) <-
             {-# SCC "cmmPipeline" #-}
             Stream.mapAccumL_ (pipeline_action logger cmm_config) (emptySRT this_mod, M.empty, mempty, initDUniqSupply 'u' 1) ppr_stream1
           let nonCaffySet = srtMapNonCAFs (moduleSRTMap mod_srt_info)
-          cmmCgInfos <- generateCgIPEStub hsc_env this_mod denv (nonCaffySet, lf_infos, ipes, ipe_stats, dus)
+          cmmCgInfos <- generateCgIPEStub hsc_env this_mod denv (nonCaffySet, lf_infos, ipes, ipe_stats, dus, detRnEnv)
           return cmmCgInfos
 
         pipeline_action

compiler/GHC/Stg/Debug.hs

@@ -11,6 +11,7 @@ import GHC.Prelude
 
 import GHC.Stg.Syntax
 
+import GHC.Types.Unique.DFM
 import GHC.Types.Id
 import GHC.Types.Tickish
 import GHC.Core.DataCon
@@ -166,13 +167,13 @@ numberDataCon dc ts = do
     env <- lift get
     mcc <- asks rSpan
     let !mbest_span = (\(SpanWithLabel rss l) -> (rss, l)) <$> (selectTick ts <|> mcc)
-    let !dcMap' = alterUniqMap (maybe (Just ((0, mbest_span) :| [] ))
-                        (\xs@((k, _):|_) -> Just $! ((k + 1, mbest_span) `NE.cons` xs))) (provDC env) dc
+    let !dcMap' = alterUDFM (maybe (Just (dc, (0, mbest_span) :| [] ))
+                        (\(_dc, xs@((k, _):|_)) -> Just $! (dc, (k + 1, mbest_span) `NE.cons` xs))) (provDC env) dc
     lift $ put (env { provDC = dcMap' })
-    let r = lookupUniqMap dcMap' dc
+    let r = lookupUDFM dcMap' dc
     return $ case r of
       Nothing -> NoNumber
-      Just res -> Numbered (fst (NE.head res))
+      Just (_, res) -> Numbered (fst (NE.head res))
 
 selectTick :: [StgTickish] -> Maybe SpanWithLabel
 selectTick [] = Nothing

compiler/GHC/StgToCmm.hs

@@ -43,6 +43,7 @@ import GHC.Types.Id.Info
 import GHC.Types.RepType
 import GHC.Types.Basic
 import GHC.Types.Var.Set ( isEmptyDVarSet )
+import GHC.Types.Unique.DFM
 import GHC.Types.Unique.FM
 import GHC.Types.Name.Env
 
@@ -60,7 +61,6 @@ import GHC.Utils.TmpFs
 
 import GHC.Data.Stream
 import GHC.Data.OrdList
-import GHC.Types.Unique.Map
 
 import Control.Monad (when,void, forM_)
 import GHC.Utils.Misc
@@ -77,10 +77,11 @@ codeGen :: Logger
         -> CollectedCCs                -- (Local/global) cost-centres needing declaring/registering.
         -> [CgStgTopBinding]           -- Bindings to convert
         -> HpcInfo
-        -> Stream IO CmmGroup ModuleLFInfos       -- Output as a stream, so codegen can
+        -> Stream IO CmmGroup (ModuleLFInfos, DetUniqFM)
+                                       -- Output as a stream, so codegen can
                                        -- be interleaved with output
 
-codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
+codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons
         cost_centre_info stg_binds hpc_info
   = do  {     -- cg: run the code generator, and yield the resulting CmmGroup
               -- Using an IORef to store the state is a bit crude, but otherwise
@@ -139,7 +140,7 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
 
         -- Emit special info tables for everything used in this module
         -- This will only do something if  `-fdistinct-info-tables` is turned on.
-        ; mapM_ (\(dc, ns) -> forM_ ns $ \(k, _ss) -> cg (cgDataCon (UsageSite (stgToCmmThisModule cfg) k) dc)) (nonDetEltsUFM denv)
+        ; mapM_ (\(dc, ns) -> forM_ ns $ \(k, _ss) -> cg (cgDataCon (UsageSite (stgToCmmThisModule cfg) k) dc)) (eltsUDFM denv)
 
         ; final_state <- liftIO (readIORef cgref)
         ; let cg_id_infos = cgs_binds final_state
@@ -160,7 +161,7 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
         ; rn_mapping <- liftIO (readIORef uniqRnRef)
         ; liftIO $ debugTraceMsg logger 3 (text "DetRnM mapping:" <+> ppr rn_mapping)
 
-        ; return generatedInfo
+        ; return (generatedInfo, rn_mapping)
         }
 
 ---------------------------------------------------------------

compiler/GHC/StgToCmm/Utils.hs

@@ -90,7 +90,7 @@ import GHC.Types.Unique.Map
 import Data.Maybe
 import qualified Data.List.NonEmpty as NE
 import GHC.Core.DataCon
-import GHC.Types.Unique.FM
+import GHC.Types.Unique.DFM
 import GHC.Data.Maybe
 import Control.Monad
 import qualified Data.Map.Strict as Map
@@ -673,7 +673,7 @@ pprIPEStats (IPEStats{..}) =
 -- for stack info tables skipped during 'generateCgIPEStub'. As the fold
 -- progresses, counts of tables per closure type will be accumulated.
 convertInfoProvMap :: StgToCmmConfig -> Module -> InfoTableProvMap -> IPEStats -> [CmmInfoTable] -> (IPEStats, [InfoProvEnt])
-convertInfoProvMap cfg this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTableToSourceLocationMap) initStats cmits =
+convertInfoProvMap cfg this_mod (InfoTableProvMap dcenv denv infoTableToSourceLocationMap) initStats cmits =
     foldl' convertInfoProvMap' (initStats, []) cmits
   where
     convertInfoProvMap' :: (IPEStats, [InfoProvEnt]) -> CmmInfoTable -> (IPEStats, [InfoProvEnt])
@@ -694,7 +694,7 @@ convertInfoProvMap cfg this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTable
         lookupDataConMap = (closureIpeStats cn,) <$> 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
+            (dc, ns) <- hasHaskellName cl >>= lookupUDFM_Directly dcenv . getUnique
             -- Lookup is linear but lists will be small (< 100)
             return $ (InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns)))
 

compiler/GHC/Types/IPE.hs

@@ -13,6 +13,7 @@ import GHC.Data.FastString
 import GHC.Types.SrcLoc
 import GHC.Core.DataCon
 
+import GHC.Types.Unique.DFM
 import GHC.Types.Unique.Map
 import GHC.Core.Type
 import Data.List.NonEmpty
@@ -38,7 +39,7 @@ type ClosureMap = UniqMap Name  -- The binding
 -- the constructor was used at, if possible and a string which names
 -- the source location. This is the same information as is the payload
 -- for the 'GHC.Core.SourceNote' constructor.
-type DCMap = UniqMap DataCon (NonEmpty (Int, Maybe IpeSourceLocation))
+type DCMap = UniqDFM DataCon (DataCon, NonEmpty (Int, Maybe IpeSourceLocation))
 
 type InfoTableToSourceLocationMap = Map.Map CLabel (Maybe IpeSourceLocation)
 
@@ -49,4 +50,4 @@ data InfoTableProvMap = InfoTableProvMap
                           }
 
 emptyInfoTableProvMap :: InfoTableProvMap
-emptyInfoTableProvMap = InfoTableProvMap emptyUniqMap emptyUniqMap Map.empty
+emptyInfoTableProvMap = InfoTableProvMap emptyUDFM emptyUniqMap Map.empty