[Git][ghc/ghc][wip/inplace-final] 2 commits: Add some more packages to multi-cradle

Matthew Pickering (@mpickering) gitlab at gitlab.haskell.org
Mon Aug 22 10:27:10 UTC 2022



Matthew Pickering pushed to branch wip/inplace-final at Glasgow Haskell Compiler / GHC


Commits:
96ee4385 by Matthew Pickering at 2022-08-21T23:12:37+01:00
Add some more packages to multi-cradle

- - - - -
d216e7ad by Matthew Pickering at 2022-08-22T11:21:57+01:00
hadrian: Need builders needed by Cabal Configure in parallel

Because of the use of withStaged (which needs the necessary builder)
when configuring a package, the builds of stage1:exe:ghc-bin and
stage1:exe:ghc-pkg where being linearised when building a specific
target like `binary-dist-dir`.

Thankfully the fix is quite local, to supply all the `withStaged`
arguments together so the needs can be batched together and hence
performed in parallel.

Fixes #22093

- - - - -


5 changed files:

- hadrian/src/Builder.hs
- hadrian/src/Hadrian/Builder.hs
- hadrian/src/Rules/ToolArgs.hs
- hadrian/src/Settings/Builders/Cabal.hs
- hadrian/src/Settings/Builders/Ghc.hs


Changes:

=====================================
hadrian/src/Builder.hs
=====================================
@@ -6,7 +6,7 @@ module Builder (
     TarMode (..), GitMode (..), Builder (..), Win32TarballsMode(..),
 
     -- * Builder properties
-    builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder,
+    builderProvenance, systemBuilderPath, builderPath, isSpecified, needBuilder, needBuilders,
     runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath,
     builderEnvironment,
 


=====================================
hadrian/src/Hadrian/Builder.hs
=====================================
@@ -12,7 +12,7 @@
 -- functions that can be used to invoke builders.
 -----------------------------------------------------------------------------
 module Hadrian.Builder (
-    Builder (..), BuildInfo (..), needBuilder, runBuilder,
+    Builder (..), BuildInfo (..), needBuilder, needBuilders, runBuilder,
     runBuilderWithCmdOptions, build, buildWithResources, buildWithCmdOptions,
     getBuilderPath, builderEnvironment, askWithResources
     ) where
@@ -26,7 +26,6 @@ import Hadrian.Oracles.ArgsHash
 import Hadrian.Target
 import Hadrian.Utilities
 
-import Base
 
 -- | This data structure captures all information relevant to invoking a builder.
 data BuildInfo = BuildInfo {
@@ -67,18 +66,19 @@ class ShakeValue b => Builder b where
 
 -- | Make sure a builder and its runtime dependencies are up-to-date.
 needBuilder :: Builder b => b -> Action ()
-needBuilder builder = do
-    path <- builderPath builder
-    deps <- runtimeDependencies builder
+needBuilder builder = needBuilders [builder]
+
+needBuilders :: Builder b => [b] -> Action ()
+needBuilders bs = do
+    paths <- mapM builderPath bs
+    deps <- mapM runtimeDependencies bs
     -- so `path` might be just `gcc`, in which case we won't issue a "need" on
     -- it.  If someone really wants the full qualified path, he ought to pass
     -- CC=$(which gcc) to the configure script.  If CC=gcc was passed, we should
     -- respect that choice and not resolve that via $PATH into a fully qualified
     -- path.  We can only `need` fully qualified path's though, hence we won't
     -- `need` bare tool names.
-    when (path /= takeFileName path) $
-        need [path]
-    need deps
+    need (concat $ [path | path <- paths, path /= takeFileName path] : deps)
 
 -- | Run a builder with a specified list of command line arguments, reading a
 -- list of input files and writing a list of output files. A lightweight version


=====================================
hadrian/src/Rules/ToolArgs.hs
=====================================
@@ -79,8 +79,6 @@ multiSetup pkg_s = do
                           (Ghc ToolArgs stage0InTree) [] ["ignored"]
       arg_list <- interpret fake_target getArgs
       let c = Context stage0InTree p (if windowsHost then vanilla else dynamic) Inplace -- Critical use of Inplace, one of the main motivations!
-      -- readContextData has the effect of configuring the package so all
-      -- dependent packages will also be built.
       cd <- readContextData c
       srcs <- hsSources c
       gens <- interpretInContext c generatedDependencies
@@ -154,17 +152,17 @@ toolTargets = [ binary
               , directory
               , process
               , exceptions
---            , ghc     # depends on ghc library
---            , runGhc  # depends on ghc library
+              -- , ghc     -- # depends on ghc library
+              -- , runGhc  -- # depends on ghc library
               , ghcBoot
               , ghcBootTh
               , ghcHeap
               , ghci
---            , ghcPkg  # executable
---            , haddock # depends on ghc library
---            , hsc2hs  # executable
+              , ghcPkg  -- # executable
+              -- , haddock -- # depends on ghc library
+              , hsc2hs  -- # executable
               , hpc
---            , hpcBin  # executable
+              , hpcBin  -- # executable
               , mtl
               , parsec
               , time
@@ -172,7 +170,7 @@ toolTargets = [ binary
               , text
               , terminfo
               , transformers
---            , unlit  # executable
+              , unlit  -- # executable
               ] ++ if windowsHost then [ win32 ] else [ unix ]
 
 -- | Create a mapping from files to which component it belongs to.


=====================================
hadrian/src/Settings/Builders/Cabal.hs
=====================================
@@ -71,7 +71,6 @@ cabalSetupArgs = builder (Cabal Setup) ? do
   top   <- expr topDirectory
   stage <- getStage
   path  <- getContextPath
-  ctx <- getContext
   mconcat [ arg "configure"
           , arg "--distdir"
           , arg $ top -/- path
@@ -113,16 +112,15 @@ commonCabalArgs stage = do
             , arg "--htmldir"
             , arg $ "${pkgroot}/../../doc/html/libraries/" ++ package_id
 
-            , withStaged $ Ghc CompileHs
+            -- These trigger a need on each dependency, so every important to need
+            -- them in parallel or  it linearises the build of Ghc and GhcPkg
+            , withStageds [Ghc CompileHs, GhcPkg Update, Cc CompileC, Ar Pack]
             , withBuilderArgs (Ghc CompileHs stage)
-            , withStaged (GhcPkg Update)
             , withBuilderArgs (GhcPkg Update stage)
             , bootPackageDatabaseArgs
             , libraryArgs
             , bootPackageConstraints
-            , withStaged $ Cc CompileC
             , notStage0 ? with (Ld stage)
-            , withStaged (Ar Pack)
             , with Alex
             , with Happy
             -- Update Target.trackArgument if changing these:
@@ -245,16 +243,23 @@ withBuilderArgs b = case b of
 
 -- | Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
 with :: Builder -> Args
-with b = do
-    path <- getBuilderPath b
-    if null path then mempty else do
-        top <- expr topDirectory
-        expr $ needBuilder b
+with b = withs [b]
+
+-- | Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
+withs :: [Builder] -> Args
+withs bs = do
+    paths <- filter (not . null . snd) <$> mapM (\b -> (b,) <$> getBuilderPath b) bs
+    let bs = map fst paths
+    expr $ (needBuilders bs)
+    top <- expr topDirectory
+    mconcat $ map (\(b, path) ->
         -- Do not inject top, if we have a bare name. E.g. do not turn
         -- `ar` into `$top/ar`. But let `ar` be `ar` as found on $PATH.
         arg  $ withBuilderKey b ++ unifyPath (if path /= takeFileName path
                                               then top </> path
-                                              else path)
+                                              else path)) paths
 
-withStaged :: (Stage -> Builder) -> Args
-withStaged sb = with . sb =<< getStage
+withStageds :: [Stage -> Builder] -> Args
+withStageds sb = do
+  st <- getStage
+  withs (map (\f -> f st) sb)


=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -255,7 +255,7 @@ packageGhcArgs = do
             , arg "-no-user-package-db"
             , arg "-package-env -"
             , packageDatabaseArgs
-            , libraryPackage ? arg ("-this-unit-id " ++ pkgId)
+            , arg ("-this-unit-id " ++ pkgId)
             , map ("-package-id " ++) <$> getContextData depIds ]
 
 includeGhcArgs :: Args



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38607298f61d01f70536557a3fb1271acd48d513...d216e7ad0df3eb091aa9d0357c11fad808595677

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/38607298f61d01f70536557a3fb1271acd48d513...d216e7ad0df3eb091aa9d0357c11fad808595677
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/20220822/dfe56417/attachment-0001.html>


More information about the ghc-commits mailing list