Commit 6547fc76 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Add support for resources. Limit parallelism of ghc-pkg.

parent 94638520
module Rules.Actions (
build, buildWhen, run, verboseRun
build, buildWithResources, run, verboseRun
) where
import Util
......@@ -11,38 +11,37 @@ import Settings.Util
import Oracles.ArgsHash
import Development.Shake
-- Build a given target using an appropriate builder. Force a rebuilt if the
-- argument list has changed since the last built (that is, track changes in
-- the build system).
build :: FullTarget -> Action ()
build target = do
-- Build a given target using an appropriate builder and acquiring necessary
-- resources. Force a rebuilt if the argument list has changed since the last
-- built (that is, track changes in the build system).
buildWithResources :: [(Resource, Int)] -> FullTarget -> Action ()
buildWithResources rs target = do
need $ Target.dependencies target
argList <- interpret target args
-- The line below forces the rule to be rerun if the args hash has changed
argsHash <- askArgsHash target
run (Target.builder target) argList
run rs (Target.builder target) argList
buildWhen :: Predicate -> FullTarget -> Action ()
buildWhen predicate target = do
bool <- interpretExpr target predicate
when bool $ build target
-- Most targets are built without explicitly acquiring resources
build :: FullTarget -> Action ()
build = buildWithResources []
-- Run the builder with a given collection of arguments
verboseRun :: Builder -> [String] -> Action ()
verboseRun builder args = do
verboseRun :: [(Resource, Int)] -> Builder -> [String] -> Action ()
verboseRun rs builder args = do
needBuilder builder
path <- builderPath builder
cmd [path] args
withResources rs $ cmd [path] args
-- Run the builder with a given collection of arguments printing out a
-- terse commentary with only 'interesting' info for the builder.
run :: Builder -> [String] -> Action ()
run builder args = do
run :: [(Resource, Int)] -> Builder -> [String] -> Action ()
run rs builder args = do
putColoured White $ "/--------\n" ++
"| Running " ++ show builder ++ " with arguments:"
mapM_ (putColoured White . ("| " ++)) $ interestingInfo builder args
putColoured White $ "\\--------"
quietly $ verboseRun builder args
quietly $ verboseRun rs builder args
interestingInfo :: Builder -> [String] -> [String]
interestingInfo builder ss = case builder of
......
......@@ -12,31 +12,36 @@ import Control.Applicative
import Control.Monad.Extra
import Development.Shake
-- TODO: Add ordering between packages? (see ghc.mk)
-- Build package-data.mk by using GhcCabal to process pkgCabal file
buildPackageData :: StagePackageTarget -> Rules ()
buildPackageData target =
buildPackageData target = do
let stage = Target.stage target
pkg = Target.package target
path = targetPath stage pkg
cabal = pkgPath pkg -/- pkgCabal pkg
configure = pkgPath pkg -/- "configure"
in
-- We do not allow parallel invokations of ghc-pkg (they don't work)
ghcPkg <- newResource "ghc-pkg" 1
(path -/-) <$>
[ "package-data.mk"
, "haddock-prologue.txt"
, "inplace-pkg-config"
, "setup-config"
, "build" -/- "autogen" -/- "cabal_macros.h"
-- TODO: Is this needed? Also check out Paths_cpsa.hs.
-- , "build" -/- "autogen" -/- ("Paths_" ++ name) <.> "hs"
] &%> \files -> do
-- GhcCabal may run the configure script, so we depend on it
-- We still don't know who built the configure script from configure.ac
whenM (doesFileExist $ configure <.> "ac") $ need [configure]
build $ fullTarget target [cabal] GhcCabal files
buildWhen registerPackage $
fullTarget target [cabal] (GhcPkg stage) files
postProcessPackageData $ path -/- "package-data.mk"
[ "package-data.mk"
, "haddock-prologue.txt"
, "inplace-pkg-config"
, "setup-config"
, "build" -/- "autogen" -/- "cabal_macros.h"
-- TODO: Is this needed? Also check out Paths_cpsa.hs.
-- , "build" -/- "autogen" -/- ("Paths_" ++ name) <.> "hs"
] &%> \files -> do
-- GhcCabal may run the configure script, so we depend on it
-- We don't know who built the configure script from configure.ac
whenM (doesFileExist $ configure <.> "ac") $ need [configure]
build $ fullTarget target [cabal] GhcCabal files
whenM (interpretExpr target registerPackage) .
buildWithResources [(ghcPkg, 1)] $
fullTarget target [cabal] (GhcPkg stage) files
postProcessPackageData $ path -/- "package-data.mk"
-- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
-- 1) Drop lines containing '$'
......
{-# LANGUAGE DeriveGeneric, TypeSynonymInstances #-}
module Target (
Target (..), StageTarget (..), StagePackageTarget (..), FullTarget (..),
stageTarget, stagePackageTarget, fullTarget, fullTargetWithWay
stageTarget, stagePackageTarget, fullTarget, fullTargetWithWay,
) where
import Way
......@@ -72,7 +72,8 @@ fullTarget target deps b fs = target
}
-- Use this function to be explicit about the build way.
fullTargetWithWay :: StagePackageTarget -> [FilePath] -> Builder -> Way -> [FilePath] -> FullTarget
fullTargetWithWay :: StagePackageTarget -> [FilePath] -> Builder -> Way
-> [FilePath] -> FullTarget
fullTargetWithWay target deps b w fs = target
{
dependencies = deps,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment