[Git][ghc/ghc][wip/romes/12935] 6 commits: Don't print unique in pprFullName
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Mon Jul 29 15:52:09 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
eecf110c by Rodrigo Mesquita at 2024-07-26T14:36:34+01:00
Don't print unique in pprFullName
This unique was leaking as part of the profiling description in info tables when profiling was enabled
- - - - -
e6081ac2 by Rodrigo Mesquita at 2024-07-26T15:14:02+01:00
Update abi test with decrementing uniques
- - - - -
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
- - - - -
70a2efdb by Rodrigo Mesquita at 2024-07-29T16:50:35+01:00
fixup! Don't print unique in pprFullName
- - - - -
cb65deac by Rodrigo Mesquita at 2024-07-29T16:50:55+01:00
Twekas to script check
- - - - -
9 changed files:
- .gitlab/ci.sh
- 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
- compiler/GHC/Types/Name.hs
- testsuite/tests/determinism/object/check-standalone.sh
Changes:
=====================================
.gitlab/ci.sh
=====================================
@@ -701,6 +701,12 @@ function cabal_abi_test() {
if [ -z "$OUT" ]; then
fail "OUT not set"
fi
+ if [ -z "$REVERSE_UNIQUES" ]; then
+ EXTRA_OPTS=""
+ else
+ # Count uniques in reverse one of the runs to get more non-determinism exposed
+ EXTRA_OPTS="-dinitial-unique=16777215 -dunique-increment=-1"
+ fi
cp -r libraries/Cabal $DIR
pushd $DIR
@@ -711,6 +717,8 @@ function cabal_abi_test() {
run "$HC" \
-hidir tmp -odir tmp -fforce-recomp -haddock \
-iCabal/Cabal/src -XNoPolyKinds Distribution.Simple -j"$cores" \
+ -fobject-determinism \
+ $EXTRA_OPTS \
"$@" 2>&1 | tee $OUT/log
summarise_hi_files
summarise_o_files
@@ -784,6 +792,8 @@ function check_objects(){
fail "Mismatched object: $dump"
fi
done
+
+ fail "Some objects are mismatched, but theres no diff with --all-headers or --disassemble-all. Perhaps try objdump -s"
fi
}
@@ -798,7 +808,7 @@ function run_abi_test() {
fi
mkdir -p out
OUT="$PWD/out/run1" DIR=$(mktemp -d XXXX-looooooooong) cabal_abi_test -O0
- OUT="$PWD/out/run2" DIR=$(mktemp -d XXXX-short) cabal_abi_test -O0
+ OUT="$PWD/out/run2" DIR=$(mktemp -d XXXX-short) REVERSE_UNIQUES="yes" cabal_abi_test -O0
check_interfaces out/run1 out/run2 abis "Mismatched ABI hash"
check_interfaces out/run1 out/run2 interfaces "Mismatched interface hashes"
check_objects out/run1 out/run2
=====================================
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
=====================================
compiler/GHC/Types/Name.hs
=====================================
@@ -716,9 +716,9 @@ pprName name@(Name {n_sort = sort, n_uniq = uniq, n_occ = occ})
{-# SPECIALISE pprName :: Name -> SDoc #-}
{-# SPECIALISE pprName :: Name -> HLine #-} -- see Note [SPECIALIZE to HDoc] in GHC.Utils.Outputable
--- | Print fully qualified name (with unit-id, module and unique)
+-- | Print fully qualified name (with unit-id, module but no unique)
pprFullName :: Module -> Name -> SDoc
-pprFullName this_mod Name{n_sort = sort, n_uniq = uniq, n_occ = occ} =
+pprFullName this_mod Name{n_sort = sort, n_occ = occ} =
let mod = case sort of
WiredIn m _ _ -> m
External m -> m
@@ -727,8 +727,6 @@ pprFullName this_mod Name{n_sort = sort, n_uniq = uniq, n_occ = occ} =
in ftext (unitIdFS (moduleUnitId mod))
<> colon <> ftext (moduleNameFS $ moduleName mod)
<> dot <> ftext (occNameFS occ)
- <> char '_' <> pprUniqueAlways uniq
-
-- | Print a ticky ticky styled name
--
=====================================
testsuite/tests/determinism/object/check-standalone.sh
=====================================
@@ -8,8 +8,8 @@ fi
rm -rf objs1 objs2
cabal get Cabal-3.12.0.0
-cabal build --enable-profiling -w "$1" --ghc-options="-fforce-recomp -j12 -ddump-to-file -fobject-determinism -dumpdir=dumpout1 -ddump-simpl -ddump-stg-final -ddump-cmm" --ghc-options=-odir=out1 --ghc-options=-hidir=hiout1 Cabal
+cabal build --enable-profiling --profiling-detail=late --enable-debug-info -w "$1" --ghc-options="-finfo-table-map -fdistinct-constructor-tables -fforce-recomp -j12 -ddump-to-file -fobject-determinism -dumpdir=dumpout1 -ddump-simpl -ddump-stg-final -ddump-cmm" --ghc-options=-odir=out1 --ghc-options=-hidir=hiout1 Cabal
# cabal build -w $1 --ghc-options="-fforce-recomp -j4" --ghc-options=-odir=out1 Cabal
-cabal build --enable-profiling -w "$1" --ghc-options="-fforce-recomp -j12 -ddump-to-file -dinitial-unique=16777215 -dunique-increment=-1 -fobject-determinism -dumpdir=dumpout2 -ddump-simpl -ddump-stg-final -ddump-cmm" --ghc-options=-odir=out2 --ghc-options=-hidir=hiout2 Cabal
+cabal build --enable-profiling --profiling-detail=late --enable-debug-info -w "$1" --ghc-options="-finfo-table-map -fdistinct-constructor-tables -fforce-recomp -j12 -ddump-to-file -dinitial-unique=16777215 -dunique-increment=-1 -fobject-determinism -dumpdir=dumpout2 -ddump-simpl -ddump-stg-final -ddump-cmm" --ghc-options=-odir=out2 --ghc-options=-hidir=hiout2 Cabal
# cabal build -w $1 --ghc-options="-fforce-recomp -j4" --ghc-options=-odir=out2 Cabal
./check.sh "$1"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3759003a5225cd193d5707c045a9659e81267f77...cb65deac230dd2881c5a4107339ebee6000abbae
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/3759003a5225cd193d5707c045a9659e81267f77...cb65deac230dd2881c5a4107339ebee6000abbae
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/0c9c1eaf/attachment-0001.html>
More information about the ghc-commits
mailing list