[Git][ghc/ghc][wip/romes/12935] 3 commits: wip: temp file names
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Thu Aug 22 12:16:18 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
d544732d by Matthew Pickering at 2024-08-15T17:22:31+01:00
wip: temp file names
- - - - -
0658e1a7 by Rodrigo Mesquita at 2024-08-16T14:54:10+01:00
Two additional sorts in interface docs
- - - - -
3e22b78d by Rodrigo Mesquita at 2024-08-22T13:16:00+01:00
Writing Notes and Cleaning up v1
- - - - -
10 changed files:
- compiler/GHC/Cmm.hs
- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
- compiler/GHC/Driver/CodeOutput.hs
- compiler/GHC/Driver/Make.hs
- compiler/GHC/HsToCore/Docs.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/Types/Unique/DSM.hs
- compiler/GHC/Utils/TmpFs.hs
Changes:
=====================================
compiler/GHC/Cmm.hs
=====================================
@@ -263,6 +263,7 @@ data ProfilingInfo
= NoProfilingInfo
| ProfilingInfo ByteString ByteString -- closure_type, closure_desc
deriving (Eq, Ord)
+
-----------------------------------------------------------------------------
-- Static Data
-----------------------------------------------------------------------------
@@ -354,6 +355,24 @@ instance OutputableP Platform (GenCmmStatics a) where
type CmmStatics = GenCmmStatics 'False
type RawCmmStatics = GenCmmStatics 'True
+{-
+-----------------------------------------------------------------------------
+-- Deterministic Cmm / Info Tables
+-----------------------------------------------------------------------------
+
+Note [DCmmGroup vs CmmGroup or: Deterministic Info Tables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Label maps are not deterministic despite the names being deterministic (why?
+because of external names? or is it something else? I don't recall), so now we
+parametrise the info table data structure on whether we're using the non-deterministic label map or a list which preserves the order, etc...
+
+And then we change between DCmmGroup and CmmGroup back and forth? For different passes?
+
+TODO: for MP
+
+See also Note [Object determinism] in GHC.StgToCmm
+-}
+
-- Converting out of deterministic Cmm
removeDeterm :: DCmmGroup -> CmmGroup
@@ -372,7 +391,6 @@ removeDetermGraph (CmmGraph x y) =
GMany a (DWrap b) c -> GMany a (mapFromList b) c
in CmmGraph x y'
-
-- -----------------------------------------------------------------------------
-- Basic blocks consisting of lists
=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -1875,20 +1875,16 @@ returns True.
-- | A utility for renaming uniques in CLabels to produce deterministic object.
-- Note that not all Uniques are mapped over. Only those that can be safely alpha
--- renamed, eg uniques of local symbols or of system names.
--- See Note [....TODO]
--- ROMES:TODO: We can do less work here, like, do we really need to rename AsmTempLabel, SRTLabel, LocalBlockLabel?
--- however, the input to layout must be deterministic to produce deterministic layout.
--- Which means we could avoid renaming it here, as long as we guarantee the labels are produced deterministically (which we could, perhaps by using a det supply in fcode)
+-- renamed, e.g. uniques of local symbols, but not of external ones.
+-- See Note [Renaming uniques deterministically].
mapInternalNonDetUniques :: Applicative m => (Unique -> m Unique) -> CLabel -> m CLabel
+-- todo: Can we do less work here, e.g., do we really need to rename AsmTempLabel, LocalBlockLabel?
mapInternalNonDetUniques f x = case x of
IdLabel name cafInfo idLabelInfo
| not (isExternalName name) -> IdLabel . setNameUnique name <$> f (nameUnique name) <*> pure cafInfo <*> pure idLabelInfo
| otherwise -> pure x
cl at CmmLabel{} -> pure cl
- -- ROMES:TODO: what about `RtsApFast NonDetFastString`?
RtsLabel rtsLblInfo -> pure $ RtsLabel rtsLblInfo
- -- Even if we can't get away with not renaming, we could forget these local ones right after renaming this block
LocalBlockLabel unique -> LocalBlockLabel <$> f unique
fl at ForeignLabel{} -> pure fl
AsmTempLabel unique -> AsmTempLabel <$> f unique
@@ -1899,7 +1895,6 @@ mapInternalNonDetUniques f x = case x of
IPE_Label ipe at InfoProvEnt{infoTablePtr} ->
(\cl' -> IPE_Label ipe{infoTablePtr = cl'}) <$> mapInternalNonDetUniques f infoTablePtr
ml at ModuleLabel{} -> pure ml
- -- ROMES:TODO: Suspicious, maybe we shouldn't rename these.
DynamicLinkerLabel dlli clbl -> DynamicLinkerLabel dlli <$> mapInternalNonDetUniques f clbl
PicBaseLabel -> pure PicBaseLabel
DeadStripPreventer clbl -> DeadStripPreventer <$> mapInternalNonDetUniques f clbl
=====================================
compiler/GHC/Cmm/Info.hs
=====================================
@@ -79,7 +79,7 @@ cmmToRawCmm logger profile cmms
-- By using a local namespace 'i' here, we can have other
-- deterministic supplies starting from the same unique in
-- other parts of the Cmm backend
- -- See Note [Cmm Local Deterministic Uniques] (TODO)
+ -- See Note [Deterministic Uniques in the NCG]
let (a, us) = runUniqueDSM nextUq $
concatMapM (mkInfoTable profile) cmm
writeIORef detUqSupply us
=====================================
compiler/GHC/Cmm/UniqueRenamer.hs
=====================================
@@ -30,21 +30,21 @@ import GHC.Types.Var
{-
---------------------------------------------------------------------------------
--- * Deterministic Objects
---------------------------------------------------------------------------------
+Note [Renaming uniques deterministically]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+To produce deterministic object code, we alpha-rename all Uniques to deterministic uniques before Cmm linting.
+From here on out, the backend code generation can't use (non-deterministic) Uniques, or risk producing non-deterministic code.
+For example, the fix-up action in the ASM NCG should use determinist names for potential new blocks it has to create.
+Therefore, in the ASM NCG `NatM` Monad we use a deterministic `UniqSuply` (which won't be shared about multiple threads)
-** Write many notes in a collective note.
-
-Topics:
-* Before generating Code, we rename all uniques of local symbols deterministically
-* The code generation (like Assembly fix ups) need
+Before generating Code, we rename all uniques of local symbols deterministically
+See also Note [Object determinism] in GHC.StgToCmm
-}
-- | A mapping from non-deterministic uniques to deterministic uniques, to
-- rename local symbols with the end goal of producing deterministic object files.
--- See Note [....TODO]
+-- See Note [Renaming uniques deterministically]
data DetUniqFM = DetUniqFM
{ mapping :: !(UniqFM Unique Unique)
, supply :: !Word64
=====================================
compiler/GHC/Driver/CodeOutput.hs
=====================================
@@ -35,7 +35,7 @@ import GHC.Driver.LlvmConfigCache (LlvmConfigCache)
import GHC.Driver.Ppr
import GHC.Driver.Backend
-import GHC.Data.OsPath
+import GHC.Data.OsPath hiding ((</>), (<.>))
import qualified GHC.Data.ShortText as ST
import GHC.Data.Stream ( Stream )
import qualified GHC.Data.Stream as Stream
@@ -262,7 +262,10 @@ outputForeignStubs
outputForeignStubs logger tmpfs dflags unit_state mod location stubs
= do
let stub_h = unsafeDecodeUtf $ mkStubPaths (initFinderOpts dflags) (moduleName mod) location
- stub_c <- newTempName logger tmpfs (tmpDir dflags) TFL_CurrentModule "c"
+ tmp_dir <- getTempDir logger tmpfs (tmpDir dflags)
+ let stub_c = tmp_dir </> (unitIdString (moduleUnitId mod) ++ "_" ++ moduleNameString (moduleName mod) ++ "_stub") <.> "c"
+
+ addFilesToClean tmpfs TFL_CurrentModule [stub_c]
case stubs of
NoStubs ->
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -2923,19 +2923,22 @@ runParPipelines worker_limit plugin_hsc_env diag_wrapper mHscMessager all_pipeli
atomically $ writeTVar stopped_var True
wait_log_thread
-withLocalTmpFS :: RunMakeM a -> RunMakeM a
-withLocalTmpFS act = do
+withLocalTmpFS :: TmpFs -> (TmpFs -> IO a) -> IO a
+withLocalTmpFS tmpfs act = do
let initialiser = do
- MakeEnv{..} <- ask
- lcl_tmpfs <- liftIO $ forkTmpFsFrom (hsc_tmpfs hsc_env)
- return $ hsc_env { hsc_tmpfs = lcl_tmpfs }
- finaliser lcl_env = do
- gbl_env <- ask
- liftIO $ mergeTmpFsInto (hsc_tmpfs lcl_env) (hsc_tmpfs (hsc_env gbl_env))
+ liftIO $ forkTmpFsFrom tmpfs
+ finaliser tmpfs_local = do
+ liftIO $ mergeTmpFsInto tmpfs_local tmpfs
-- Add remaining files which weren't cleaned up into local tmp fs for
-- clean-up later.
-- Clear the logQueue if this node had it's own log queue
- MC.bracket initialiser finaliser $ \lcl_hsc_env -> local (\env -> env { hsc_env = lcl_hsc_env}) act
+ MC.bracket initialiser finaliser act
+
+withLocalTmpFSMake :: MakeEnv -> (MakeEnv -> IO a) -> IO a
+withLocalTmpFSMake env k =
+ withLocalTmpFS (hsc_tmpfs (hsc_env env)) $ \lcl_tmpfs
+ -> k (env { hsc_env = (hsc_env env) { hsc_tmpfs = lcl_tmpfs }})
+
-- | Run the given actions and then wait for them all to finish.
runAllPipelines :: WorkerLimit -> MakeEnv -> [MakeAction] -> IO ()
@@ -2957,16 +2960,18 @@ runAllPipelines worker_limit env acts = do
runLoop :: (((forall a. IO a -> IO a) -> IO ()) -> IO a) -> MakeEnv -> [MakeAction] -> IO [a]
runLoop _ _env [] = return []
runLoop fork_thread env (MakeAction act res_var :acts) = do
- new_thread <-
+
+ -- withLocalTmpFs has to occur outside of fork to remain deterministic
+ new_thread <- withLocalTmpFSMake env $ \lcl_env ->
fork_thread $ \unmask -> (do
- mres <- (unmask $ run_pipeline (withLocalTmpFS act))
+ mres <- (unmask $ run_pipeline lcl_env act)
`MC.onException` (putMVar res_var Nothing) -- Defensive: If there's an unhandled exception then still signal the failure.
putMVar res_var mres)
threads <- runLoop fork_thread env acts
return (new_thread : threads)
where
- run_pipeline :: RunMakeM a -> IO (Maybe a)
- run_pipeline p = runMaybeT (runReaderT p env)
+ run_pipeline :: MakeEnv -> RunMakeM a -> IO (Maybe a)
+ run_pipeline env p = runMaybeT (runReaderT p env)
data MakeAction = forall a . MakeAction !(RunMakeM a) !(MVar (Maybe a))
=====================================
compiler/GHC/HsToCore/Docs.hs
=====================================
@@ -160,7 +160,7 @@ mkDocStructureFromExportList mdl import_avails export_list =
(IEGroup _ level doc, _) -> DsiSectionHeading level (unLoc doc)
(IEDoc _ doc, _) -> DsiDocChunk (unLoc doc)
(IEDocNamed _ name, _) -> DsiNamedChunkRef name
- (_, avails) -> DsiExports (nubAvails avails)
+ (_, avails) -> DsiExports (sortAvails (nubAvails avails))
moduleExport :: ModuleName -- Alias
-> Avails
@@ -199,7 +199,7 @@ mkDocStructureFromDecls env all_exports decls =
map unLoc (sortLocated (docs ++ avails))
where
avails :: [Located DocStructureItem]
- avails = flip fmap all_exports $ \avail ->
+ avails = flip fmap (sortAvails all_exports) $ \avail ->
case M.lookup (availName avail) name_locs of
Just loc -> L loc (DsiExports [avail])
-- FIXME: This is just a workaround that we use when handling e.g.
=====================================
compiler/GHC/StgToCmm.hs
=====================================
@@ -95,11 +95,6 @@ codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons
(a, cmm) <- liftIO . withTimingSilent logger (text "STG -> Cmm") (`seq` ()) $ do
st <- readIORef cgref
- -- To produce deterministic object code, we alpha-rename all Uniques to deterministic uniques before Cmm linting.
- -- From here on out, the backend code generation can't use (non-deterministic) Uniques, or risk producing non-deterministic code.
- -- For example, the fix-up action in the ASM NCG should use determinist names for potential new blocks it has to create.
- -- Therefore, in the ASM NCG `NatM` Monad we use a deterministic `UniqSuply` (which won't be shared about multiple threads)
- -- TODO: Put these all into notes carefully organized
rnm0 <- readIORef uniqRnRef
let
@@ -107,6 +102,7 @@ codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons
(rnm1, cmm_renamed) =
-- Enable deterministic object code generation by
-- renaming uniques deterministically.
+ -- See Note [Object determinism]
if stgToCmmObjectDeterminism cfg
then detRenameCmmGroup rnm0 cmm -- The yielded cmm will already be renamed.
else (rnm0, removeDeterm cmm)
@@ -164,6 +160,54 @@ codeGen logger tmpfs cfg (InfoTableProvMap denv _ _) data_tycons
; return (generatedInfo, rn_mapping)
}
+{-
+Note [Object Determinism]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Object determinism means that GHC, for the same exact input, produces,
+deterministically, byte-for-byte identical objects (.o files, executables,
+libraries...) on separate multi-threaded runs.
+
+The main cause of non-determinism in objects comes from the non-deterministic
+uniques leaking into the generated code. Apart from uniques previously affecting
+determinism both directly by showing up in symbol labels and indirectly, e.g. in
+the CLabel Ord instance, GHC already did a lot deterministically (modulo bugs)
+by the time we set out to achieve full object determinism:
+
+* The Simplifier is deterministic in the optimisations it applies (c.f. #25170)
+
+* Interface files are deterministic (also a consequence of the previous bullet)
+
+* The Cmm/NCG pipeline processes sections in a deterministic order, so the final
+ object sections, closures, data, etc., are already always outputted in the
+ same order for the same module.
+
+Beyond fixing small bugs in the above bullets and other smaller non-determinism
+leaks like the Ord instance of CLabels, we must ensure that/do the following to
+make GHC fully deterministic:
+
+* In STG -> Cmm, deterministically /rename/ all non-external uniques in the Cmm
+ chunk before yielding it. See Note [Renaming uniques deterministically] in
+ GHC.Cmm.UniqueRenamer. This pass is necessary for object determinism but is
+ currently guarded by -fobject-determinism.
+
+* Multiple Cmm passes work with non-deterministic @LabelMap at s -- that doesn't
+ change since they are both important for performance and do not affect the
+ determinism of the end result. In contrast, info tables in CmmDecls cannot be
+ backed by @LabelMap at s in certain stages since the nondeterministic order of its
+ labels does leak into the object, so we have a little dance between @DCmmGroup@
+ and @CmmGroup@ to preserve determinism of the info tables while keeping a
+ performant Cmm pipeline. (TODO: MP: revise)
+ See Note [DCmmGroup vs CmmGroup or: Deterministic Info Tables] in GHC.Cmm.
+
+* In the code generation pipeline from Cmm onwards, when new uniques need to be
+ created for a given pass, use @UniqDSM@ instead of the previously used @UniqSM at .
+ @UniqDSM@ supplies uniques iteratively, guaranteeing uniques produced by the
+ backend are deterministic accross runs.
+ See Note [Deterministic Uniques in the NCG] in GHC.Types.Unique.DSM.
+
+-}
+
+
---------------------------------------------------------------
-- Top-level bindings
---------------------------------------------------------------
=====================================
compiler/GHC/Types/Unique/DSM.hs
=====================================
@@ -9,13 +9,29 @@ import GHC.Types.Unique
import qualified GHC.Utils.Monad.State.Strict as Strict
import qualified GHC.Types.Unique.Supply as USM
--- todo: Do I need to use the one-shot state monad trick? Probably yes.
+{-
+Note [Deterministic Uniques in the NCG]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+(TODO: Is there anything about locality that I need to add? better to avoid if possible. Need to double check.)
--- check: UniqSM is only used before Cmm (grep for it), afterwards only UniqDSM is used.
+See also Note [Object determinism] in GHC.StgToCmm
+
+-- This was on top of initDUniqSupply
+-- TODO::::::
+-- Write Note about the importance of locality in uniques that are deterministic
+--
+-- If you use a tag which collides with other names, you'll get a uniques
+-- deterministically colliding with existing symbols.
+--
+-- (e.g. easy to observe if you do this wrong)
+--
+-- Ideally, we'd thread the same deterministic unique supply all the way
+-- throughout the Cmm pipeline, starting off from hte deterministic rename
+-- pass.
--- todo: use UniqSM for UniqRenamable? We've basically re-implemented this logic
--- there, but without the unboxing it feels? Maybe not, since we carry the
--- mappings too.
+-- todo:check: UniqSM is only used before Cmm (grep for it), afterwards only UniqDSM is used.
+-}
newtype DUniqSupply = DUS Word64 -- supply uniques iteratively
type DUniqResult result = (# result, DUniqSupply #)
@@ -47,16 +63,8 @@ takeUniqueFromDSupply d =
case unUDSM getUniqueDSM d of
DUniqResult x y -> (x, y)
--- Write Note about the importance of locality in uniques that are deterministic
---
--- If you use a tag which collides with other names, you'll get a uniques
--- deterministically colliding with existing symbols.
---
--- (e.g. easy to observe if you do this wrong)
---
--- Ideally, we'd thread the same deterministic unique supply all the way
--- throughout the Cmm pipeline, starting off from hte deterministic rename
--- pass.
+-- | Initialize a deterministic unique supply with the given Tag and initial unique.
+-- See Note [Deterministic Uniques in the NCG]
initDUniqSupply :: Char -> Word64 -> DUniqSupply
initDUniqSupply c firstUniq =
let !tag = mkTag c
@@ -70,8 +78,12 @@ runUniqueDSM ds (UDSM f) =
case f ds of
DUniqResult uq us -> (uq, us)
--- Add explanation on how this gives you a deterministic way of getting uniques
--- if the instance uses a deterministic unique supply.
+-- | Get a unique from a monad that can access a unique supply.
+--
+-- Crucially, because 'MonadGetUnique' doesn't allow you to get the
+-- 'UniqSupply' (unlike 'MonadUnique'), an instance such as 'UniqDSM' can use a
+-- deterministic unique supply to return deterministic uniques without allowing
+-- for the 'UniqSupply' to be shared.
class Monad m => MonadGetUnique m where
getUniqueM :: m Unique
@@ -81,9 +93,3 @@ instance MonadGetUnique UniqDSM where
instance MonadGetUnique USM.UniqSM where
getUniqueM = USM.getUniqueM
-{-
-Note [Cmm Local Deterministic Uniques]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-TODO!!!!!
-TODO!!!!!
--}
=====================================
compiler/GHC/Utils/TmpFs.hs
=====================================
@@ -10,6 +10,7 @@ module GHC.Utils.TmpFs
, emptyPathsToClean
, TempFileLifetime(..)
, TempDir (..)
+ , getTempDir
, cleanTempDirs
, cleanTempFiles
, cleanCurrentModuleTempFiles
@@ -64,6 +65,8 @@ data TmpFs = TmpFs
--
-- Shared with forked TmpFs.
+ , tmp_dir_prefix :: String
+
, tmp_files_to_clean :: IORef PathsToClean
-- ^ Files to clean (per session or per module)
--
@@ -121,6 +124,7 @@ initTmpFs = do
, tmp_subdirs_to_clean = subdirs
, tmp_dirs_to_clean = dirs
, tmp_next_suffix = next
+ , tmp_dir_prefix = "tmp"
}
-- | Initialise an empty TmpFs sharing unique numbers and per-process temporary
@@ -132,11 +136,16 @@ forkTmpFsFrom :: TmpFs -> IO TmpFs
forkTmpFsFrom old = do
files <- newIORef emptyPathsToClean
subdirs <- newIORef emptyPathsToClean
+ counter <- newIORef 0
+ prefix <- newTempSuffix old
+
+
return $ TmpFs
{ tmp_files_to_clean = files
, tmp_subdirs_to_clean = subdirs
, tmp_dirs_to_clean = tmp_dirs_to_clean old
- , tmp_next_suffix = tmp_next_suffix old
+ , tmp_next_suffix = counter
+ , tmp_dir_prefix = prefix
}
-- | Merge the first TmpFs into the second.
@@ -259,9 +268,11 @@ changeTempFilesLifetime tmpfs lifetime files = do
addFilesToClean tmpfs lifetime existing_files
-- Return a unique numeric temp file suffix
-newTempSuffix :: TmpFs -> IO Int
-newTempSuffix tmpfs =
- atomicModifyIORef' (tmp_next_suffix tmpfs) $ \n -> (n+1,n)
+newTempSuffix :: TmpFs -> IO String
+newTempSuffix tmpfs = do
+ n <- atomicModifyIORef' (tmp_next_suffix tmpfs) $ \n -> (n+1,n)
+ return $ tmp_dir_prefix tmpfs ++ "_" ++ show n
+
-- Find a temporary name that doesn't already exist.
newTempName :: Logger -> TmpFs -> TempDir -> TempFileLifetime -> Suffix -> IO FilePath
@@ -271,8 +282,8 @@ newTempName logger tmpfs tmp_dir lifetime extn
where
findTempName :: FilePath -> IO FilePath
findTempName prefix
- = do n <- newTempSuffix tmpfs
- let filename = prefix ++ show n <.> extn
+ = do suffix <- newTempSuffix tmpfs
+ let filename = prefix ++ suffix <.> extn
b <- doesFileExist filename
if b then findTempName prefix
else do -- clean it up later
@@ -295,8 +306,8 @@ newTempSubDir logger tmpfs tmp_dir
where
findTempDir :: FilePath -> IO FilePath
findTempDir prefix
- = do n <- newTempSuffix tmpfs
- let name = prefix ++ show n
+ = do suffix <- newTempSuffix tmpfs
+ let name = prefix ++ suffix
b <- doesDirectoryExist name
if b then findTempDir prefix
else (do
@@ -314,8 +325,8 @@ newTempLibName logger tmpfs tmp_dir lifetime extn
where
findTempName :: FilePath -> String -> IO (FilePath, FilePath, String)
findTempName dir prefix
- = do n <- newTempSuffix tmpfs -- See Note [Deterministic base name]
- let libname = prefix ++ show n
+ = do suffix <- newTempSuffix tmpfs -- See Note [Deterministic base name]
+ let libname = prefix ++ suffix
filename = dir </> "lib" ++ libname <.> extn
b <- doesFileExist filename
if b then findTempName dir prefix
@@ -340,8 +351,8 @@ getTempDir logger tmpfs (TempDir tmp_dir) = do
mkTempDir :: FilePath -> IO FilePath
mkTempDir prefix = do
- n <- newTempSuffix tmpfs
- let our_dir = prefix ++ show n
+ suffix <- newTempSuffix tmpfs
+ let our_dir = prefix ++ suffix
-- 1. Speculatively create our new directory.
createDirectory our_dir
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd304be598e6cca82b751caec1a1402210b220eb...3e22b78df634db4e418f8b44a003abe09c69521a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/dd304be598e6cca82b751caec1a1402210b220eb...3e22b78df634db4e418f8b44a003abe09c69521a
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/20240822/9237d704/attachment-0001.html>
More information about the ghc-commits
mailing list