[Git][ghc/ghc][wip/marge_bot_batch_merge_job] 5 commits: ci: Add nightly & release ubuntu-22.04 jobs
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Oct 4 09:38:01 UTC 2024
Marge Bot pushed to branch wip/marge_bot_batch_merge_job at Glasgow Haskell Compiler / GHC
Commits:
50490075 by Matthew Pickering at 2024-10-03T05:55:13-04:00
ci: Add nightly & release ubuntu-22.04 jobs
This adds build of bindists on ubuntu-22.04 on nightly and release
pipelines.
We also update ghcup-metadata to provide ubuntu-22.04 bindists on
ubuntu-22.04.
Fixes #25317
- - - - -
9cf1cef5 by Zubin Duggal at 2024-10-03T05:55:49-04:00
haddock: Bump binary interface version to 46.
This allows haddock to give good error messages when being used on mismatched interface files.
We bump to 46 since GHC 9.12 uses version 45: https://gitlab.haskell.org/ghc/ghc/-/commit/362afd632032ee8f174690c3ffe0015076b83ce6
This should have been done in e4ac1b0d281b85a0144d1ef6f84a1df00e236052 but was overlooked.
- - - - -
2293c0b7 by Andreas Klebinger at 2024-10-03T05:56:25-04:00
Change versionig of ghc-experimental to follow ghc versions.
Just like ghc-internal it will now use the @ProjectVersionForLib@ macro for versioning.
This means for ghc=9.10.1, ghc-experimental's version will be 9.1001.0 and so on.
This fixes #25289
- - - - -
2af3c986 by Torsten Schmits at 2024-10-04T05:37:44-04:00
Parallelize getRootSummary computations in dep analysis downsweep
This reuses the upsweep step's infrastructure to process batches of
modules in parallel.
I benchmarked this by running `ghc -M` on two sets of 10,000 modules;
one with a linear dependency chain and the other with a binary tree.
Comparing different values for the number of modules per thread
suggested an optimum at `length targets `div` (n_cap * 2)`, with results
similar to this one (6 cores, 12 threads):
```
Benchmark 1: linear 1 jobs
Time (mean ± σ): 1.775 s ± 0.026 s [User: 1.377 s, System: 0.399 s]
Range (min … max): 1.757 s … 1.793 s 2 runs
Benchmark 2: linear 6 jobs
Time (mean ± σ): 876.2 ms ± 20.9 ms [User: 1833.2 ms, System: 518.6 ms]
Range (min … max): 856.2 ms … 898.0 ms 3 runs
Benchmark 3: linear 12 jobs
Time (mean ± σ): 793.5 ms ± 23.2 ms [User: 2318.9 ms, System: 718.6 ms]
Range (min … max): 771.9 ms … 818.0 ms 3 runs
```
Results don't differ much when the batch size is reduced to a quarter
of that, but there's significant thread scheduling overhead for a size
of 1:
```
Benchmark 1: linear 1 jobs
Time (mean ± σ): 2.611 s ± 0.029 s [User: 2.851 s, System: 0.783 s]
Range (min … max): 2.591 s … 2.632 s 2 runs
Benchmark 2: linear 6 jobs
Time (mean ± σ): 1.189 s ± 0.007 s [User: 2.707 s, System: 1.103 s]
Range (min … max): 1.184 s … 1.194 s 2 runs
Benchmark 3: linear 12 jobs
Time (mean ± σ): 1.097 s ± 0.006 s [User: 2.938 s, System: 1.300 s]
Range (min … max): 1.093 s … 1.101 s 2 runs
```
Larger batches also slightly worsen performance.
- - - - -
8d7b73d3 by Cheng Shao at 2024-10-04T05:37:45-04:00
testsuite: remove accidentally checked in debug print logic
- - - - -
13 changed files:
- .gitlab-ci.yml
- .gitlab/generate-ci/gen_ci.hs
- .gitlab/jobs.yaml
- .gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
- .gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
- compiler/GHC/Driver/Make.hs
- compiler/GHC/Unit/Finder.hs
- libraries/ghc-experimental/ghc-experimental.cabal.in
- testsuite/tests/ghc-api/downsweep/OldModLocation.hs
- testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
- testsuite/tests/profiling/should_run/all.T
- utils/haddock/haddock-api/src/Haddock/Interface.hs
- utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
Changes:
=====================================
.gitlab-ci.yml
=====================================
@@ -1144,6 +1144,8 @@ ghcup-metadata-nightly:
artifacts: false
- job: nightly-x86_64-linux-centos7-validate
artifacts: false
+ - job: nightly-x86_64-linux-ubuntu22_04-validate
+ artifacts: false
- job: nightly-x86_64-linux-ubuntu20_04-validate
artifacts: false
- job: nightly-x86_64-linux-ubuntu18_04-validate
=====================================
.gitlab/generate-ci/gen_ci.hs
=====================================
@@ -112,6 +112,7 @@ data LinuxDistro
| Debian9
| Fedora33
| Fedora38
+ | Ubuntu2204
| Ubuntu2004
| Ubuntu1804
| Centos7
@@ -308,6 +309,7 @@ distroName Fedora33 = "fedora33"
distroName Fedora38 = "fedora38"
distroName Ubuntu1804 = "ubuntu18_04"
distroName Ubuntu2004 = "ubuntu20_04"
+distroName Ubuntu2204 = "ubuntu22_04"
distroName Centos7 = "centos7"
distroName Alpine312 = "alpine3_12"
distroName Alpine318 = "alpine3_18"
@@ -1060,6 +1062,7 @@ ubuntu_x86 :: [JobGroup Job]
ubuntu_x86 =
[ disableValidate (standardBuilds Amd64 (Linux Ubuntu1804))
, disableValidate (standardBuilds Amd64 (Linux Ubuntu2004))
+ , disableValidate (standardBuilds Amd64 (Linux Ubuntu2204))
]
rhel_x86 :: [JobGroup Job]
=====================================
.gitlab/jobs.yaml
=====================================
@@ -2745,6 +2745,69 @@
"XZ_OPT": "-9"
}
},
+ "nightly-x86_64-linux-ubuntu22_04-validate": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh save_test_output",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "8 weeks",
+ "paths": [
+ "ghc-x86_64-linux-ubuntu22_04-validate.tar.xz",
+ "junit.xml",
+ "unexpected-test-output.tar.gz"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-ubuntu22_04-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu22_04:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "(\"true\" == \"true\") && ($RELEASE_JOB != \"yes\") && ($NIGHTLY)",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ ".gitlab/ci.sh setup",
+ ".gitlab/ci.sh configure",
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "x86_64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu22_04-validate",
+ "BUILD_FLAVOUR": "validate",
+ "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "RUNTEST_ARGS": "",
+ "TEST_ENV": "x86_64-linux-ubuntu22_04-validate",
+ "XZ_OPT": "-9"
+ }
+ },
"nightly-x86_64-windows-int_native-validate": {
"after_script": [
"bash .gitlab/ci.sh save_cache",
@@ -4452,6 +4515,71 @@
"XZ_OPT": "-9"
}
},
+ "release-x86_64-linux-ubuntu22_04-release": {
+ "after_script": [
+ ".gitlab/ci.sh save_cache",
+ ".gitlab/ci.sh save_test_output",
+ ".gitlab/ci.sh clean",
+ "cat ci_timings"
+ ],
+ "allow_failure": false,
+ "artifacts": {
+ "expire_in": "1 year",
+ "paths": [
+ "ghc-x86_64-linux-ubuntu22_04-release.tar.xz",
+ "junit.xml",
+ "unexpected-test-output.tar.gz"
+ ],
+ "reports": {
+ "junit": "junit.xml"
+ },
+ "when": "always"
+ },
+ "cache": {
+ "key": "x86_64-linux-ubuntu22_04-$CACHE_REV",
+ "paths": [
+ "cabal-cache",
+ "toolchain"
+ ]
+ },
+ "dependencies": [],
+ "image": "registry.gitlab.haskell.org/ghc/ci-images/x86_64-linux-ubuntu22_04:$DOCKER_REV",
+ "needs": [
+ {
+ "artifacts": false,
+ "job": "hadrian-ghc-in-ghci"
+ }
+ ],
+ "rules": [
+ {
+ "if": "(\"true\" == \"true\") && ($RELEASE_JOB == \"yes\") && ($NIGHTLY == null)",
+ "when": "on_success"
+ }
+ ],
+ "script": [
+ "sudo chown ghc:ghc -R .",
+ ".gitlab/ci.sh setup",
+ ".gitlab/ci.sh configure",
+ ".gitlab/ci.sh build_hadrian",
+ ".gitlab/ci.sh test_hadrian"
+ ],
+ "stage": "full-build",
+ "tags": [
+ "x86_64-linux"
+ ],
+ "variables": {
+ "BIGNUM_BACKEND": "gmp",
+ "BIN_DIST_NAME": "ghc-x86_64-linux-ubuntu22_04-release",
+ "BUILD_FLAVOUR": "release",
+ "CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "HADRIAN_ARGS": "--hash-unit-ids",
+ "IGNORE_PERF_FAILURES": "all",
+ "INSTALL_CONFIGURE_ARGS": "--enable-strict-ghc-toolchain-check",
+ "RUNTEST_ARGS": "",
+ "TEST_ENV": "x86_64-linux-ubuntu22_04-release",
+ "XZ_OPT": "-9"
+ }
+ },
"release-x86_64-windows-int_native-release": {
"after_script": [
"bash .gitlab/ci.sh save_cache",
=====================================
.gitlab/rel_eng/fetch-gitlab-artifacts/fetch_gitlab.py
=====================================
@@ -19,6 +19,7 @@ def job_triple(job_name):
'release-x86_64-windows-release': 'x86_64-unknown-mingw32',
'release-x86_64-windows-int_native-release': 'x86_64-unknown-mingw32-int_native',
'release-x86_64-linux-rocky8-release': 'x86_64-rocky8-linux',
+ 'release-x86_64-linux-ubuntu22_04-release': 'x86_64-ubuntu22_04-linux',
'release-x86_64-linux-ubuntu20_04-release': 'x86_64-ubuntu20_04-linux',
'release-x86_64-linux-ubuntu18_04-release': 'x86_64-ubuntu18_04-linux',
'release-x86_64-linux-fedora38-release': 'x86_64-fedora38-linux',
=====================================
.gitlab/rel_eng/mk-ghcup-metadata/mk_ghcup_metadata.py
=====================================
@@ -191,6 +191,7 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
# Here are all the bindists we can distribute
ubuntu1804 = mk(ubuntu("18_04"))
ubuntu2004 = mk(ubuntu("20_04"))
+ ubuntu2204 = mk(ubuntu("22_04"))
rocky8 = mk(rocky("8"))
centos7 = mk(centos(7))
fedora33 = mk(fedora(33))
@@ -222,7 +223,10 @@ def mk_new_yaml(release_mode, version, date, pipeline_type, job_map):
, "unknown_versioning": deb11 }
, "Linux_Ubuntu" : { "unknown_versioning": ubuntu2004
, "( >= 16 && < 18 )": deb9
- , "( >= 18 && < 19 )": ubuntu1804 }
+ , "( >= 18 && < 19 )": ubuntu1804
+ , "( >= 19 && < 21 )": ubuntu2004
+ , "( >= 21 )": ubuntu2204
+ }
, "Linux_Mint" : { "< 20": ubuntu1804
, ">= 20": ubuntu2004
, "unknown_versioning": ubuntu2004 }
=====================================
compiler/GHC/Driver/Make.hs
=====================================
@@ -5,6 +5,8 @@
{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE BlockArguments #-}
-- -----------------------------------------------------------------------------
--
@@ -122,7 +124,7 @@ import qualified Control.Monad.Catch as MC
import Data.IORef
import Data.Maybe
import Data.Time
-import Data.List (sortOn)
+import Data.List (sortOn, unfoldr)
import Data.Bifunctor (first)
import System.Directory
import System.FilePath
@@ -169,7 +171,7 @@ depanal :: GhcMonad m =>
-> Bool -- ^ allow duplicate roots
-> m ModuleGraph
depanal excluded_mods allow_dup_roots = do
- (errs, mod_graph) <- depanalE excluded_mods allow_dup_roots
+ (errs, mod_graph) <- depanalE mkUnknownDiagnostic Nothing excluded_mods allow_dup_roots
if isEmptyMessages errs
then pure mod_graph
else throwErrors (fmap GhcDriverMessage errs)
@@ -177,12 +179,14 @@ depanal excluded_mods allow_dup_roots = do
-- | Perform dependency analysis like in 'depanal'.
-- In case of errors, the errors and an empty module graph are returned.
depanalE :: GhcMonad m => -- New for #17459
- [ModuleName] -- ^ excluded modules
+ (GhcMessage -> AnyGhcDiagnostic)
+ -> Maybe Messager
+ -> [ModuleName] -- ^ excluded modules
-> Bool -- ^ allow duplicate roots
-> m (DriverMessages, ModuleGraph)
-depanalE excluded_mods allow_dup_roots = do
+depanalE diag_wrapper msg excluded_mods allow_dup_roots = do
hsc_env <- getSession
- (errs, mod_graph) <- depanalPartial excluded_mods allow_dup_roots
+ (errs, mod_graph) <- depanalPartial diag_wrapper msg excluded_mods allow_dup_roots
if isEmptyMessages errs
then do
hsc_env <- getSession
@@ -220,11 +224,13 @@ depanalE excluded_mods allow_dup_roots = do
-- new module graph.
depanalPartial
:: GhcMonad m
- => [ModuleName] -- ^ excluded modules
+ => (GhcMessage -> AnyGhcDiagnostic)
+ -> Maybe Messager
+ -> [ModuleName] -- ^ excluded modules
-> Bool -- ^ allow duplicate roots
-> m (DriverMessages, ModuleGraph)
-- ^ possibly empty 'Bag' of errors and a module graph.
-depanalPartial excluded_mods allow_dup_roots = do
+depanalPartial diag_wrapper msg excluded_mods allow_dup_roots = do
hsc_env <- getSession
let
targets = hsc_targets hsc_env
@@ -243,7 +249,7 @@ depanalPartial excluded_mods allow_dup_roots = do
liftIO $ flushFinderCaches (hsc_FC hsc_env) (hsc_unit_env hsc_env)
(errs, graph_nodes) <- liftIO $ downsweep
- hsc_env (mgModSummaries old_graph)
+ hsc_env diag_wrapper msg (mgModSummaries old_graph)
excluded_mods allow_dup_roots
let
mod_graph = mkModuleGraph graph_nodes
@@ -497,8 +503,8 @@ loadWithCache :: GhcMonad m => Maybe ModIfaceCache -- ^ Instructions about how t
-> LoadHowMuch -- ^ How much `loadWithCache` should load
-> m SuccessFlag
loadWithCache cache diag_wrapper how_much = do
- (errs, mod_graph) <- depanalE [] False -- #17459
msg <- mkBatchMsg <$> getSession
+ (errs, mod_graph) <- depanalE diag_wrapper (Just msg) [] False -- #17459
success <- load' cache how_much diag_wrapper (Just msg) mod_graph
if isEmptyMessages errs
then pure success
@@ -506,7 +512,7 @@ loadWithCache cache diag_wrapper how_much = do
-- Note [Unused packages]
-- ~~~~~~~~~~~~~~~~~~~~~~
--- Cabal passes `--package-id` flag for each direct dependency. But GHC
+-- Cabal passes `-package-id` flag for each direct dependency. But GHC
-- loads them lazily, so when compilation is done, we have a list of all
-- actually loaded packages. All the packages, specified on command line,
-- but never loaded, are probably unused dependencies.
@@ -1553,6 +1559,8 @@ type DownsweepCache = M.Map (UnitId, PkgQual, ModuleNameWithIsBoot) [Either Driv
-- module, plus one for any hs-boot files. The imports of these nodes
-- are all there, including the imports of non-home-package modules.
downsweep :: HscEnv
+ -> (GhcMessage -> AnyGhcDiagnostic)
+ -> Maybe Messager
-> [ModSummary]
-- ^ Old summaries
-> [ModuleName] -- Ignore dependencies on these; treat
@@ -1564,17 +1572,38 @@ downsweep :: HscEnv
-- The non-error elements of the returned list all have distinct
-- (Modules, IsBoot) identifiers, unless the Bool is true in
-- which case there can be repeats
-downsweep hsc_env old_summaries excl_mods allow_dup_roots
+downsweep hsc_env diag_wrapper msg old_summaries excl_mods allow_dup_roots = do
+ n_jobs <- mkWorkerLimit (hsc_dflags hsc_env)
+ new <- rootSummariesParallel n_jobs hsc_env diag_wrapper msg summary
+ downsweep_imports hsc_env old_summary_map excl_mods allow_dup_roots new
+ where
+ summary = getRootSummary excl_mods old_summary_map
+
+ -- A cache from file paths to the already summarised modules. The same file
+ -- can be used in multiple units so the map is also keyed by which unit the
+ -- file was used in.
+ -- Reuse these if we can because the most expensive part of downsweep is
+ -- reading the headers.
+ old_summary_map :: M.Map (UnitId, FilePath) ModSummary
+ old_summary_map =
+ M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries]
+
+downsweep_imports :: HscEnv
+ -> M.Map (UnitId, FilePath) ModSummary
+ -> [ModuleName]
+ -> Bool
+ -> ([(UnitId, DriverMessages)], [ModSummary])
+ -> IO ([DriverMessages], [ModuleGraphNode])
+downsweep_imports hsc_env old_summaries excl_mods allow_dup_roots (root_errs, rootSummariesOk)
= do
- (root_errs, rootSummariesOk) <- partitionWithM getRootSummary roots -- #17549
let root_map = mkRootMap rootSummariesOk
checkDuplicates root_map
(deps, map0) <- loopSummaries rootSummariesOk (M.empty, root_map)
- let closure_errs = checkHomeUnitsClosed (hsc_unit_env hsc_env)
- let unit_env = hsc_unit_env hsc_env
- let tmpfs = hsc_tmpfs hsc_env
+ let closure_errs = checkHomeUnitsClosed unit_env
+ unit_env = hsc_unit_env hsc_env
+ tmpfs = hsc_tmpfs hsc_env
- let downsweep_errs = lefts $ concat $ M.elems map0
+ downsweep_errs = lefts $ concat $ M.elems map0
downsweep_nodes = M.elems deps
(other_errs, unit_nodes) = partitionEithers $ unitEnv_foldWithKey (\nodes uid hue -> nodes ++ unitModuleNodes downsweep_nodes uid hue) [] (hsc_HUG hsc_env)
@@ -1606,46 +1635,6 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
[(ms_unitid ms, b, c) | (b, c) <- msDeps ms ]
logger = hsc_logger hsc_env
- roots = hsc_targets hsc_env
-
- -- A cache from file paths to the already summarised modules. The same file
- -- can be used in multiple units so the map is also keyed by which unit the
- -- file was used in.
- -- Reuse these if we can because the most expensive part of downsweep is
- -- reading the headers.
- old_summary_map :: M.Map (UnitId, FilePath) ModSummary
- old_summary_map = M.fromList [((ms_unitid ms, msHsFilePath ms), ms) | ms <- old_summaries]
-
- getRootSummary :: Target -> IO (Either (UnitId, DriverMessages) ModSummary)
- getRootSummary Target { targetId = TargetFile file mb_phase
- , targetContents = maybe_buf
- , targetUnitId = uid
- }
- = do let offset_file = augmentByWorkingDirectory dflags file
- exists <- liftIO $ doesFileExist offset_file
- if exists || isJust maybe_buf
- then first (uid,) <$>
- summariseFile hsc_env home_unit old_summary_map offset_file mb_phase
- maybe_buf
- else return $ Left $ (uid,) $ singleMessage
- $ mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file)
- where
- dflags = homeUnitEnv_dflags (ue_findHomeUnitEnv uid (hsc_unit_env hsc_env))
- home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env)
- getRootSummary Target { targetId = TargetModule modl
- , targetContents = maybe_buf
- , targetUnitId = uid
- }
- = do maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot
- (L rootLoc modl) (ThisPkg (homeUnitId home_unit))
- maybe_buf excl_mods
- case maybe_summary of
- FoundHome s -> return (Right s)
- FoundHomeWithError err -> return (Left err)
- _ -> return $ Left $ (uid, moduleNotFoundErr modl)
- where
- home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env)
- rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
-- In a root module, the filename is allowed to diverge from the module
-- name, so we have to check that there aren't multiple root files
@@ -1713,7 +1702,7 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
loopImports ss done summarised
| otherwise
= do
- mb_s <- summariseModule hsc_env home_unit old_summary_map
+ mb_s <- summariseModule hsc_env home_unit old_summaries
is_boot wanted_mod mb_pkg
Nothing excl_mods
case mb_s of
@@ -1738,6 +1727,90 @@ downsweep hsc_env old_summaries excl_mods allow_dup_roots
GWIB { gwib_mod = L loc mod, gwib_isBoot = is_boot } = gwib
wanted_mod = L loc mod
+getRootSummary ::
+ [ModuleName] ->
+ M.Map (UnitId, FilePath) ModSummary ->
+ HscEnv ->
+ Target ->
+ IO (Either (UnitId, DriverMessages) ModSummary)
+getRootSummary excl_mods old_summary_map hsc_env target
+ | TargetFile file mb_phase <- targetId
+ = do
+ let offset_file = augmentByWorkingDirectory dflags file
+ exists <- liftIO $ doesFileExist offset_file
+ if exists || isJust maybe_buf
+ then first (uid,) <$>
+ summariseFile hsc_env home_unit old_summary_map offset_file mb_phase
+ maybe_buf
+ else
+ return $ Left $ (uid,) $ singleMessage $
+ mkPlainErrorMsgEnvelope noSrcSpan (DriverFileNotFound offset_file)
+ | TargetModule modl <- targetId
+ = do
+ maybe_summary <- summariseModule hsc_env home_unit old_summary_map NotBoot
+ (L rootLoc modl) (ThisPkg (homeUnitId home_unit))
+ maybe_buf excl_mods
+ pure case maybe_summary of
+ FoundHome s -> Right s
+ FoundHomeWithError err -> Left err
+ _ -> Left (uid, moduleNotFoundErr modl)
+ where
+ Target {targetId, targetContents = maybe_buf, targetUnitId = uid} = target
+ home_unit = ue_unitHomeUnit uid (hsc_unit_env hsc_env)
+ rootLoc = mkGeneralSrcSpan (fsLit "<command line>")
+ dflags = homeUnitEnv_dflags (ue_findHomeUnitEnv uid (hsc_unit_env hsc_env))
+
+-- | Execute 'getRootSummary' for the 'Target's using the parallelism pipeline
+-- system.
+-- Create bundles of 'Target's wrapped in a 'MakeAction' that uses
+-- 'withAbstractSem' to wait for a free slot, limiting the number of
+-- concurrently computed summaries to the value of the @-j@ option or the slots
+-- allocated by the job server, if that is used.
+--
+-- The 'MakeAction' returns 'Maybe', which is not handled as an error, because
+-- 'runLoop' only sets it to 'Nothing' when an exception was thrown, so the
+-- result won't be read anyway here.
+--
+-- To emulate the current behavior, we funnel exceptions past the concurrency
+-- barrier and rethrow the first one afterwards.
+rootSummariesParallel ::
+ WorkerLimit ->
+ HscEnv ->
+ (GhcMessage -> AnyGhcDiagnostic) ->
+ Maybe Messager ->
+ (HscEnv -> Target -> IO (Either (UnitId, DriverMessages) ModSummary)) ->
+ IO ([(UnitId, DriverMessages)], [ModSummary])
+rootSummariesParallel n_jobs hsc_env diag_wrapper msg get_summary = do
+ (actions, get_results) <- unzip <$> mapM action_and_result (zip [1..] bundles)
+ runPipelines n_jobs hsc_env diag_wrapper msg actions
+ (sequence . catMaybes <$> sequence get_results) >>= \case
+ Right results -> pure (partitionEithers (concat results))
+ Left exc -> throwIO exc
+ where
+ bundles = mk_bundles targets
+
+ mk_bundles = unfoldr \case
+ [] -> Nothing
+ ts -> Just (splitAt bundle_size ts)
+
+ bundle_size = 20
+
+ targets = hsc_targets hsc_env
+
+ action_and_result (log_queue_id, ts) = do
+ res_var <- liftIO newEmptyMVar
+ pure $! (MakeAction (action log_queue_id ts) res_var, readMVar res_var)
+
+ action log_queue_id target_bundle = do
+ env at MakeEnv {compile_sem} <- ask
+ lift $ lift $
+ withAbstractSem compile_sem $
+ withLoggerHsc log_queue_id env \ lcl_hsc_env ->
+ MC.try (mapM (get_summary lcl_hsc_env) target_bundle) >>= \case
+ Left e | Just (_ :: SomeAsyncException) <- fromException e ->
+ throwIO e
+ a -> pure a
+
-- | This function checks then important property that if both p and q are home units
-- then any dependency of p, which transitively depends on q is also a home unit.
--
@@ -2455,12 +2528,12 @@ wrapAction msg_wrapper hsc_env k = do
let lcl_logger = hsc_logger hsc_env
lcl_dynflags = hsc_dflags hsc_env
print_config = initPrintConfig lcl_dynflags
- let logg err = printMessages lcl_logger print_config (initDiagOpts lcl_dynflags) (msg_wrapper <$> srcErrorMessages err)
+ logg err = printMessages lcl_logger print_config (initDiagOpts lcl_dynflags) (msg_wrapper <$> srcErrorMessages err)
-- MP: It is a bit strange how prettyPrintGhcErrors handles some errors but then we handle
-- SourceError and ThreadKilled differently directly below. TODO: Refactor to use `catches`
-- directly. MP should probably use safeTry here to not catch async exceptions but that will regress performance due to
-- internally using forkIO.
- mres <- MC.try $ liftIO $ prettyPrintGhcErrors lcl_logger $ k
+ mres <- MC.try $ prettyPrintGhcErrors lcl_logger $ k
case mres of
Right res -> return $ Just res
Left exc -> do
@@ -2659,7 +2732,7 @@ R.hs: module R where
== Why we need to rehydrate A's ModIface before compiling R.hs
After compiling A.hs we'll have a TypeEnv in which the Id for `f` has a type
-type uses the AbstractTyCon T; and a TyCon for `S` that also mentions that same
+that uses the AbstractTyCon T; and a TyCon for `S` that also mentions that same
AbstractTyCon. (Abstract because it came from R.hs-boot; we know nothing about
it.)
=====================================
compiler/GHC/Unit/Finder.hs
=====================================
@@ -86,6 +86,20 @@ type BaseName = OsPath -- Basename of file
-- -----------------------------------------------------------------------------
-- The finder's cache
+{-
+[Note: Monotonic addToFinderCache]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+addToFinderCache is only used by functions that return the cached value
+if there is one, or by functions that always write an InstalledFound value.
+Without multithreading it is then safe to always directly write the value
+without checking the previously cached value.
+
+However, with multithreading, it is possible that another function has
+written a value into cache between the lookup and the addToFinderCache call.
+in this case we should check to not overwrite an InstalledFound with an
+InstalledNotFound.
+-}
initFinderCache :: IO FinderCache
initFinderCache = do
@@ -100,7 +114,12 @@ initFinderCache = do
addToFinderCache :: InstalledModuleWithIsBoot -> InstalledFindResult -> IO ()
addToFinderCache key val =
- atomicModifyIORef' mod_cache $ \c -> (extendInstalledModuleWithIsBootEnv c key val, ())
+ atomicModifyIORef' mod_cache $ \c ->
+ case (lookupInstalledModuleWithIsBootEnv c key, val) of
+ -- Don't overwrite an InstalledFound with an InstalledNotFound
+ -- See [Note Monotonic addToFinderCache]
+ (Just InstalledFound{}, InstalledNotFound{}) -> (c, ())
+ _ -> (extendInstalledModuleWithIsBootEnv c key val, ())
lookupFinderCache :: InstalledModuleWithIsBoot -> IO (Maybe InstalledFindResult)
lookupFinderCache key = do
=====================================
libraries/ghc-experimental/ghc-experimental.cabal.in
=====================================
@@ -4,7 +4,9 @@ cabal-version: 3.0
-- Make sure you are editing ghc-experimental.cabal.in, not ghc-experimental.cabal
name: ghc-experimental
-version: 0.1.0.0
+-- The project is ghc's version plus ghc-experimental's version suffix.
+-- For example, for ghc=9.10.1, ghc-experimental's version will be 9.1001.0.
+version: @ProjectVersionForLib at .0
synopsis: Experimental features of GHC's standard library
description:
This package is where experimental GHC standard library interfaces start
=====================================
testsuite/tests/ghc-api/downsweep/OldModLocation.hs
=====================================
@@ -6,6 +6,7 @@ import GHC
import GHC.Driver.Make
import GHC.Driver.Session
import GHC.Driver.Env
+import GHC.Types.Error (mkUnknownDiagnostic)
import GHC.Unit.Module.Graph
import GHC.Unit.Finder
@@ -47,13 +48,13 @@ main = do
liftIO $ do
- _emss <- downsweep hsc_env [] [] False
+ _emss <- downsweep hsc_env mkUnknownDiagnostic Nothing [] [] False
flushFinderCaches (hsc_FC hsc_env) (hsc_unit_env hsc_env)
createDirectoryIfMissing False "mydir"
renameFile "B.hs" "mydir/B.hs"
- (_, nodes) <- downsweep hsc_env [] [] False
+ (_, nodes) <- downsweep hsc_env mkUnknownDiagnostic Nothing [] [] False
-- If 'checkSummaryTimestamp' were to call 'addHomeModuleToFinder' with
-- (ms_location old_summary) like summariseFile used to instead of
=====================================
testsuite/tests/ghc-api/downsweep/PartialDownsweep.hs
=====================================
@@ -6,6 +6,7 @@
import GHC
import GHC.Driver.Make
import GHC.Driver.Session
+import GHC.Types.Error (mkUnknownDiagnostic)
import GHC.Utils.Outputable
import GHC.Utils.Exception (ExceptionMonad)
import GHC.Data.Bag
@@ -168,7 +169,7 @@ go label mods cnd =
setTargets [tgt]
hsc_env <- getSession
- (_, nodes) <- liftIO $ downsweep hsc_env [] [] False
+ (_, nodes) <- liftIO $ downsweep hsc_env mkUnknownDiagnostic Nothing [] [] False
it label $ cnd (mapMaybe moduleGraphNodeModSum nodes)
=====================================
testsuite/tests/profiling/should_run/all.T
=====================================
@@ -2,7 +2,6 @@ setTestOpts(js_skip) # JS backend doesn't support profiling yet
prun_ways = (['prof'] if have_profiling() else []) + (['profdyn'] if have_dynamic_prof() else [])
-print(prun_ways)
# Options to use when comparing .prof files
test_opts_dot_prof = [ only_ways(['prof', 'profdyn'])
, extra_ways(prun_ways) if prun_ways else skip]
=====================================
utils/haddock/haddock-api/src/Haddock/Interface.hs
=====================================
@@ -170,7 +170,7 @@ createIfaces verbosity modules flags instIfaceMap = do
_ <- setSessionDynFlags dflags''
targets <- mapM (\(filePath, _) -> guessTarget filePath Nothing Nothing) hs_srcs
setTargets targets
- (_errs, modGraph) <- depanalE [] False
+ (_errs, modGraph) <- depanalE mkUnknownDiagnostic (Just batchMsg) [] False
-- Create (if necessary) and load .hi-files. With --no-compilation this happens later.
when (Flag_NoCompilation `notElem` flags) $ do
=====================================
utils/haddock/haddock-api/src/Haddock/InterfaceFile.hs
=====================================
@@ -140,7 +140,7 @@ binaryInterfaceMagic = 0xD0Cface
--
binaryInterfaceVersion :: Word16
#if MIN_VERSION_ghc(9,11,0) && !MIN_VERSION_ghc(9,14,0)
-binaryInterfaceVersion = 44
+binaryInterfaceVersion = 46
binaryInterfaceVersionCompatibility :: [Word16]
binaryInterfaceVersionCompatibility = [binaryInterfaceVersion]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbb32e33f2e3dd8f735eb85afc5f7667640eec47...8d7b73d33a71a2fab8f5ac27813f3ecfe225c0fd
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/cbb32e33f2e3dd8f735eb85afc5f7667640eec47...8d7b73d33a71a2fab8f5ac27813f3ecfe225c0fd
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/20241004/1fe12110/attachment-0001.html>
More information about the ghc-commits
mailing list