Commit 2fc7bd3e authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Drop Rules.Resources, move packageDb resource to buildRules.

parent 6a9772a1
......@@ -61,7 +61,6 @@ executable ghc-shake
, Rules.Perl
, Rules.Program
, Rules.Register
, Rules.Resources
, Rules.Selftest
, Rules.Setup
, Rules.Test
......
......@@ -10,7 +10,6 @@ import Rules.Data
import Rules.Dependencies
import Rules.Documentation
import Rules.Generate
import Rules.Resources
import Rules.Cabal
import Rules.Gmp
import Rules.Libffi
......@@ -53,18 +52,25 @@ topLevelTargets = do
packageRules :: Rules ()
packageRules = do
resources <- resourceRules
-- We cannot register multiple packages in parallel. Also we cannot run GHC
-- when the package database is being mutated by "ghc-pkg". This is a
-- classic concurrent read exclusive write (CREW) conflict.
let maxConcurrentReaders = 1000
packageDb <- newResource "package-db" maxConcurrentReaders
let readPackageDb = [(packageDb, 1)]
writePackageDb = [(packageDb, maxConcurrentReaders)]
for_ allStages $ \stage ->
for_ knownPackages $ \package -> do
let context = vanillaContext stage package
compilePackage resources context
buildPackageData context
buildPackageDependencies resources context
buildPackageDocumentation context
generatePackageCode context
buildPackageLibrary context
buildProgram context
registerPackage resources context
compilePackage readPackageDb context
buildPackageData context
buildPackageDependencies readPackageDb context
buildPackageDocumentation context
generatePackageCode context
buildPackageLibrary context
buildProgram context
registerPackage writePackageDb context
buildRules :: Rules ()
buildRules = do
......
......@@ -6,12 +6,11 @@ import Context
import Expression
import Oracles.Dependencies
import Rules.Actions
import Rules.Resources
import Settings
import Target hiding (context)
-- TODO: Use way from Context, #207
compilePackage :: Resources -> Context -> Rules ()
compilePackage :: [(Resource, Int)] -> Context -> Rules ()
compilePackage rs context @ (Context {..}) = do
let buildPath = targetPath stage package -/- "build"
......@@ -21,7 +20,7 @@ compilePackage rs context @ (Context {..}) = do
let w = detectWay hi
(src, deps) <- dependencies buildPath $ hi -<.> osuf w
need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
buildWithResources rs $
Target (context { way = w }) (Ghc stage) [src] [hi]
else need [ hi -<.> osuf (detectWay hi) ]
......@@ -31,7 +30,7 @@ compilePackage rs context @ (Context {..}) = do
let w = detectWay hiboot
(src, deps) <- dependencies buildPath $ hiboot -<.> obootsuf w
need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
buildWithResources rs $
Target (context { way = w }) (Ghc stage) [src] [hiboot]
else need [ hiboot -<.> obootsuf (detectWay hiboot) ]
......@@ -47,7 +46,7 @@ compilePackage rs context @ (Context {..}) = do
if compileInterfaceFilesSeparately && "//*.hs" ?== src && not ("//HpcParser.*" ?== src)
then need $ (obj -<.> hisuf (detectWay obj)) : src : deps
else need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
buildWithResources rs $
Target (context { way = w }) (Ghc stage) [src] [obj]
-- TODO: get rid of these special cases
......@@ -57,5 +56,5 @@ compilePackage rs context @ (Context {..}) = do
if compileInterfaceFilesSeparately
then need $ (obj -<.> hibootsuf (detectWay obj)) : src : deps
else need $ src : deps
buildWithResources [(resPackageDb rs, 1)] $
buildWithResources rs $
Target (context { way = w }) (Ghc stage) [src] [obj]
......@@ -8,12 +8,11 @@ import Context
import Expression
import Oracles.PackageData
import Rules.Actions
import Rules.Resources
import Settings
import Target
-- TODO: simplify handling of AutoApply.cmm
buildPackageDependencies :: Resources -> Context -> Rules ()
buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
buildPackageDependencies rs context @ (Context {..}) =
let path = targetPath stage package
buildPath = path -/- "build"
......@@ -33,7 +32,7 @@ buildPackageDependencies rs context @ (Context {..}) =
need srcs
if srcs == []
then writeFileChanged out ""
else buildWithResources [(resPackageDb rs, 1)] $
else buildWithResources rs $
Target context (GhcM stage) srcs [out]
removeFileIfExists $ out <.> "bak"
......
......@@ -9,14 +9,13 @@ import Expression
import GHC
import Rules.Actions
import Rules.Libffi
import Rules.Resources
import Settings
import Settings.Packages.Rts
import Target
-- TODO: Use way from Context, #207
-- Build package-data.mk by using GhcCabal to process pkgCabal file
registerPackage :: Resources -> Context -> Rules ()
registerPackage :: [(Resource, Int)] -> Context -> Rules ()
registerPackage rs context @ (Context {..}) = do
let oldPath = pkgPath package -/- targetDirectory stage package -- TODO: remove, #113
pkgConf = packageDbDirectory stage -/- pkgNameString package
......@@ -38,13 +37,13 @@ registerPackage rs context @ (Context {..}) = do
fixFile pkgConfig fixPkgConf
buildWithResources [(resPackageDb rs, resPackageDbLimit)] $
buildWithResources rs $
Target context (GhcPkg stage) [pkgConfig] [conf]
when (package == rts && stage == Stage1) $ do
packageDbDirectory Stage1 -/- "rts.conf" %> \conf -> do
need [rtsConf]
buildWithResources [(resPackageDb rs, resPackageDbLimit)] $
buildWithResources rs $
Target context (GhcPkg stage) [rtsConf] [conf]
rtsConf %> \_ -> do
......
module Rules.Resources (resourceRules, Resources (..), resPackageDbLimit) where
import Base
data Resources = Resources
{
resPackageDb :: Resource
}
-- We cannot register multiple packages in parallel. Also we cannot run GHC
-- when the package database is being mutated by "ghc-pkg". This is a classic
-- concurrent read exclusive write (CREW) conflict.
resourceRules :: Rules Resources
resourceRules = Resources <$> newResource "package-db" resPackageDbLimit
resPackageDbLimit :: Int
resPackageDbLimit = 1000
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