[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