diff options
| -rw-r--r-- | hadrian/src/Builder.hs | 6 | ||||
| -rw-r--r-- | hadrian/src/Hadrian/Builder.hs | 22 | ||||
| -rw-r--r-- | hadrian/src/Rules/Nofib.hs | 2 | ||||
| -rw-r--r-- | hadrian/src/Settings/Builders/Cabal.hs | 30 |
4 files changed, 31 insertions, 29 deletions
diff --git a/hadrian/src/Builder.hs b/hadrian/src/Builder.hs index 79415ea926..5bc5cacc80 100644 --- a/hadrian/src/Builder.hs +++ b/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, needBuilders, runBuilder, runBuilderWith, runBuilderWithCmdOptions, getBuilderPath, builderEnvironment, @@ -266,7 +266,7 @@ instance H.Builder Builder where GhcPkg Dependencies _ -> do let input = fromSingleton msgIn buildInputs msgIn = "[askBuilder] Exactly one input file expected." - needBuilder builder + needBuilders [builder] path <- H.builderPath builder -- we do not depend on bare builders. E.g. we won't depend on `clang` -- or `ld` or `ar`. Unless they are provided with fully qualified paths @@ -484,7 +484,7 @@ isSpecified = fmap (not . null) . systemBuilderPath applyPatch :: FilePath -> FilePath -> Action () applyPatch dir patch = do let file = dir -/- patch - needBuilder Patch + needBuilders [Patch] path <- builderPath Patch putBuild $ "| Apply patch " ++ file quietly $ cmd' [Cwd dir, FileStdin file] [path, "-p0"] diff --git a/hadrian/src/Hadrian/Builder.hs b/hadrian/src/Hadrian/Builder.hs index 1f8f8595fa..630c58d603 100644 --- a/hadrian/src/Hadrian/Builder.hs +++ b/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 (..), 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 { @@ -59,26 +58,23 @@ class ShakeValue b => Builder b where runBuilderWith :: b -> BuildInfo -> Action () runBuilderWith builder buildInfo = do let args = buildArgs buildInfo - needBuilder builder + needBuilders [builder] path <- builderPath builder let msg = if null args then "" else " (" ++ intercalate ", " args ++ ")" putBuild $ "| Run " ++ show builder ++ msg quietly $ cmd (buildOptions buildInfo) [path] args --- | 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 +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 @@ -117,7 +113,7 @@ doWith :: (Builder b, ShakeValue c) -> (Target c b -> Action ()) -> [(Resource, Int)] -> [CmdOption] -> Target c b -> Args c b -> Action a doWith f info rs opts target args = do - needBuilder (builder target) + needBuilders [builder target] argList <- interpret target args trackArgsHash target -- Rerun the rule if the hash of argList has changed. info target @@ -163,6 +159,6 @@ getBuilderPath = expr . builderPath -- | Write a builder path into a given environment variable. builderEnvironment :: Builder b => String -> b -> Action CmdOption builderEnvironment variable builder = do - needBuilder builder + needBuilders [builder] path <- builderPath builder return $ AddEnv variable path diff --git a/hadrian/src/Rules/Nofib.hs b/hadrian/src/Rules/Nofib.hs index 1e7550b480..99f149d6aa 100644 --- a/hadrian/src/Rules/Nofib.hs +++ b/hadrian/src/Rules/Nofib.hs @@ -53,4 +53,4 @@ needNofibDeps = do unlitPath <- programPath (vanillaContext Stage1 unlit) mtlPath <- pkgConfFile (vanillaContext Stage1 mtl ) need [ unlitPath, mtlPath ] - needBuilder (Ghc CompileHs Stage2) + needBuilders [Ghc CompileHs Stage2] diff --git a/hadrian/src/Settings/Builders/Cabal.hs b/hadrian/src/Settings/Builders/Cabal.hs index f13418a333..03e1f1c5ac 100644 --- a/hadrian/src/Settings/Builders/Cabal.hs +++ b/hadrian/src/Settings/Builders/Cabal.hs @@ -112,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: @@ -244,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) |