[Git][ghc/ghc][wip/romes/12935] 2 commits: distinct-constructor-tables determinism
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Jul 29 15:49:12 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
866f021e by Rodrigo Mesquita at 2024-07-29T15:45:43+01:00
distinct-constructor-tables determinism
- - - - -
3efabb93 by Rodrigo Mesquita at 2024-07-29T16:49:04+01:00
Rename deterministically CmmGroups in generateCgIPEStub
- - - - -
6 changed files:
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/Types/IPE.hs
Changes:
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6081ac247b42abfc13497b06791bf5d8646de72...3efabb930efc29d6d25ccabff8c1c05e25f5d0e8
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/e6081ac247b42abfc13497b06791bf5d8646de72...3efabb930efc29d6d25ccabff8c1c05e25f5d0e8
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20240729/90ace773/attachment-0001.html>
More information about the ghc-commits
mailing list