Don't run GHC concurrently with ghc-pkg.

Fix #205.

src/Rules/Compile.hs

@@ -8,7 +8,7 @@ import Rules.Resources
 import Settings
 
 compilePackage :: Resources -> PartialTarget -> Rules ()
-compilePackage _ target @ (PartialTarget stage pkg) = do
+compilePackage rs target @ (PartialTarget stage pkg) = do
     let buildPath = targetPath stage pkg -/- "build"
 
     matchBuildResult buildPath "hi" ?> \hi ->
@@ -17,7 +17,8 @@ compilePackage _ target @ (PartialTarget stage pkg) = do
             let way = detectWay hi
             (src, deps) <- dependencies buildPath $ hi -<.> osuf way
             need $ src : deps
-            build $ fullTargetWithWay target (Ghc stage) way [src] [hi]
+            buildWithResources [(resPackageDb rs, 1)] $
+                fullTargetWithWay target (Ghc stage) way [src] [hi]
         else need [ hi -<.> osuf (detectWay hi) ]
 
     matchBuildResult buildPath "hi-boot" ?> \hiboot ->
@@ -26,7 +27,8 @@ compilePackage _ target @ (PartialTarget stage pkg) = do
             let way = detectWay hiboot
             (src, deps) <- dependencies buildPath $ hiboot -<.> obootsuf way
             need $ src : deps
-            build $ fullTargetWithWay target (Ghc stage) way [src] [hiboot]
+            buildWithResources [(resPackageDb rs, 1)] $
+                fullTargetWithWay target (Ghc stage) way [src] [hiboot]
         else need [ hiboot -<.> obootsuf (detectWay hiboot) ]
 
     -- TODO: add dependencies for #include of .h and .hs-incl files (gcc -MM?)
@@ -41,7 +43,8 @@ compilePackage _ target @ (PartialTarget stage pkg) = do
             if compileInterfaceFilesSeparately && "//*.hs" ?== src && not ("//HpcParser.*" ?== src)
             then need $ (obj -<.> hisuf (detectWay obj)) : src : deps
             else need $ src : deps
-            build $ fullTargetWithWay target (Ghc stage) way [src] [obj]
+            buildWithResources [(resPackageDb rs, 1)] $
+                fullTargetWithWay target (Ghc stage) way [src] [obj]
 
     -- TODO: get rid of these special cases
     matchBuildResult buildPath "o-boot" ?> \obj -> do
@@ -50,4 +53,5 @@ compilePackage _ target @ (PartialTarget stage pkg) = do
         if compileInterfaceFilesSeparately
         then need $ (obj -<.> hibootsuf (detectWay obj)) : src : deps
         else need $ src : deps
-        build $ fullTargetWithWay target (Ghc stage) way [src] [obj]
+        buildWithResources [(resPackageDb rs, 1)] $
+            fullTargetWithWay target (Ghc stage) way [src] [obj]

src/Rules/Data.hs

@@ -12,11 +12,10 @@ import Rules.Libffi
 import Rules.Resources
 import Settings
 import Settings.Builders.Common
-import Settings.Packages.Rts
 
 -- Build package-data.mk by using GhcCabal to process pkgCabal file
 buildPackageData :: Resources -> PartialTarget -> Rules ()
-buildPackageData rs target @ (PartialTarget stage pkg) = do
+buildPackageData _ target @ (PartialTarget stage pkg) = do
     let cabalFile = pkgCabalFile pkg
         configure = pkgPath pkg -/- "configure"
         dataFile  = pkgDataFile stage pkg
@@ -34,8 +33,7 @@ buildPackageData rs target @ (PartialTarget stage pkg) = do
         deps <- packageDeps pkg
         pkgs <- interpretPartial target getPackages
         let depPkgs = matchPackageNames (sort pkgs) deps
-        depConfs <- traverse (pkgConfFile stage) depPkgs
-        orderOnly depConfs
+        need =<< traverse (pkgConfFile stage) depPkgs
 
         -- TODO: get rid of this, see #113
         let inTreeMk = oldPath -/- takeFileName dataFile
@@ -126,24 +124,6 @@ buildPackageData rs target @ (PartialTarget stage pkg) = do
                 writeFileChanged mk contents
                 putSuccess $ "| Successfully generated '" ++ mk ++ "'."
 
-                need [rtsConf]
-                buildWithResources [(resGhcPkg rs, 1)] $
-                    fullTarget target (GhcPkg stage) [rtsConf] []
-
-            rtsConf %> \_ -> do
-                orderOnly $ generatedDependencies stage pkg
-                need [ rtsConfIn ]
-                build $ fullTarget target HsCpp [rtsConfIn] [rtsConf]
-
-                let fixRtsConf = unlines
-                               . map
-                               ( replace "\"\"" ""
-                               . replace "rts/dist/build" rtsBuildPath )
-                               . filter (not . null)
-                               . lines
-
-                fixFile rtsConf fixRtsConf
-
 -- Prepare a given 'packaga-data.mk' file for parsing by readConfigFile:
 -- 1) Drop lines containing '$'
 -- For example, get rid of

src/Rules/Register.hs

@@ -6,11 +6,10 @@ import Base
 import Expression
 import GHC
 import Rules.Actions
+import Rules.Libffi
 import Rules.Resources
 import Settings
-
--- matchPkgConf :: FilePath -> Bool
--- matchPkgConf file =
+import Settings.Packages.Rts
 
 -- Build package-data.mk by using GhcCabal to process pkgCabal file
 registerPackage :: Resources -> PartialTarget -> Rules ()
@@ -21,7 +20,7 @@ registerPackage rs target @ (PartialTarget stage pkg) = do
             Nothing  -> False
             Just suf -> dropWhile (\c -> isDigit c || c == '.') suf == "conf"
 
-    when (stage <= Stage1) $ match ?> \_ -> do
+    when (stage <= Stage1) $ match ?> \conf -> do
         -- This produces pkgConfig. TODO: Add explicit tracking
         need [pkgDataFile stage pkg]
 
@@ -35,5 +34,24 @@ registerPackage rs target @ (PartialTarget stage pkg) = do
 
         fixFile pkgConfig fixPkgConf
 
-        buildWithResources [(resGhcPkg rs, 1)] $
-            fullTarget target (GhcPkg stage) [pkgConfig] []
+        buildWithResources [(resPackageDb rs, resPackageDbLimit)] $
+            fullTarget target (GhcPkg stage) [pkgConfig] [conf]
+
+    when (pkg == rts && stage == Stage1) $ do
+        packageDbDirectory Stage1 -/- "rts.conf" %> \conf -> do
+            need [rtsConf]
+            buildWithResources [(resPackageDb rs, resPackageDbLimit)] $
+                fullTarget target (GhcPkg stage) [rtsConf] [conf]
+
+        rtsConf %> \_ -> do
+            need [ pkgDataFile Stage1 rts, rtsConfIn ]
+            build $ fullTarget target HsCpp [rtsConfIn] [rtsConf]
+
+            let fixRtsConf = unlines
+                           . map
+                           ( replace "\"\"" ""
+                           . replace "rts/dist/build" rtsBuildPath )
+                           . filter (not . null)
+                           . lines
+
+            fixFile rtsConf fixRtsConf

src/Rules/Resources.hs

-module Rules.Resources (resourceRules, Resources (..)) where
+module Rules.Resources (resourceRules, Resources (..), resPackageDbLimit) where
 
 import Base
 
 data Resources = Resources
     {
-        resGhcPkg :: Resource
+        resPackageDb :: Resource
     }
 
--- We cannot register multiple packages in parallel:
+-- 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 "ghc-pkg" 1
+resourceRules = Resources <$> newResource "package-db" resPackageDbLimit
+
+resPackageDbLimit :: Int
+resPackageDbLimit = 1000