[commit: ghc] wip/nfs-locking: Fix broken parallel build: track dependencies due to -package-id flags. (361c3c2)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/361c3c2b250bd016ec16494b6f89b4971241e41e/ghc

>---------------------------------------------------------------

commit 361c3c2b250bd016ec16494b6f89b4971241e41e
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sun Dec 20 04:13:38 2015 +0000

    Fix broken parallel build: track dependencies due to -package-id flags.


>---------------------------------------------------------------

361c3c2b250bd016ec16494b6f89b4971241e41e
 src/Rules.hs                    | 24 ++----------------------
 src/Rules/Program.hs            | 26 +++++++++++++++++++++++---
 src/Settings/TargetDirectory.hs | 17 ++++++++++++++++-
 3 files changed, 41 insertions(+), 26 deletions(-)

diff --git a/src/Rules.hs b/src/Rules.hs
index 90769c1..505b8a5 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -1,11 +1,9 @@
 module Rules (generateTargets, packageRules) where
 
 import Expression
-import Oracles
 import Rules.Package
 import Rules.Resources
 import Settings
-import Settings.Builders.GhcCabal
 
 -- generateTargets needs top-level build targets
 generateTargets :: Rules ()
@@ -14,29 +12,11 @@ generateTargets = action $ do
         pkgs <- interpretWithStage stage getPackages
         let (libPkgs, programPkgs) = partition isLibrary pkgs
         libTargets <- fmap concat . forM libPkgs $ \pkg -> do
-            let target    = PartialTarget stage pkg
-                buildPath = targetPath stage pkg -/- "build"
-            compId      <- interpretPartial target $ getPkgData ComponentId
-            needGhciLib <- interpretPartial target $ getPkgData BuildGhciLib
+            let target = PartialTarget stage pkg
             needHaddock <- interpretPartial target buildHaddock
-            ways        <- interpretPartial target getWays
-            let ghciLib = buildPath -/- "HS" ++ compId <.> "o"
-                haddock = pkgHaddockFile pkg
-            libs <- fmap concat . forM ways $ \way -> do
-                extension <- libsuf way
-                let name = buildPath -/- "libHS" ++ compId
-                dll0 <- needDll0 stage pkg
-                return $ [ name <.> extension ]
-                      ++ [ name ++ "-0" <.> extension | dll0 ]
-
-            return $  [ ghciLib | needGhciLib == "YES" && stage == Stage1 ]
-                   ++ [ haddock | needHaddock          && stage == Stage1 ]
-                   ++ libs
-
+            return $ [ pkgHaddockFile pkg | needHaddock && stage == Stage1 ]
         let programTargets = map (fromJust . programPath stage) programPkgs
-
         return $ libTargets ++ programTargets
-
     need $ reverse targets
 
 -- TODO: use stage 2 compiler for building stage 2 packages (instead of stage 1)
diff --git a/src/Rules/Program.hs b/src/Rules/Program.hs
index afe2738..8e3ec77 100644
--- a/src/Rules/Program.hs
+++ b/src/Rules/Program.hs
@@ -1,20 +1,26 @@
 module Rules.Program (buildProgram) where
 
 import Expression hiding (splitPath)
-import GHC
+import GHC (hsc2hs, haddock)
 import Oracles
 import Rules.Actions
 import Rules.Library
 import Rules.Resources
 import Settings
+import Settings.Builders.GhcCabal
 
 -- TODO: Get rid of the Paths_hsc2hs.o hack.
+-- TODO: Do we need to consider other ways when building programs?
 buildProgram :: Resources -> PartialTarget -> Rules ()
 buildProgram _ target @ (PartialTarget stage pkg) = do
     let path      = targetPath stage pkg
         buildPath = path -/- "build"
         program   = programPath stage pkg
 
+            -- return $  [ ghciLib | needGhciLib == "YES" && stage == Stage1 ]
+            --        ++ [ haddock | needHaddock          && stage == Stage1 ]
+            --        ++ libs
+
     (\f -> program == Just f) ?> \bin -> do
         cSrcs <- cSources target -- TODO: remove code duplication (Library.hs)
         hSrcs <- hSources target
@@ -23,8 +29,22 @@ buildProgram _ target @ (PartialTarget stage pkg) = do
                  ++ [ buildPath -/- "Paths_hsc2hs.o"      | pkg == hsc2hs  ]
                  ++ [ buildPath -/- "Paths_haddock.o"     | pkg == haddock ]
             objs  = cObjs ++ hObjs
-        putBuild $ "objs = " ++ show objs
-        need objs
+        pkgs     <- interpretPartial target getPackages
+        ways     <- interpretPartial target getWays
+        depNames <- interpretPartial target $ getPkgDataList DepNames
+        ghciFlag <- interpretPartial target $ getPkgData BuildGhciLib
+        let deps = matchPackageNames (sort pkgs) (sort depNames)
+            ghci = ghciFlag == "YES" && stage == Stage1
+        libs <- fmap concat . forM deps $ \dep -> do
+            let depTarget = PartialTarget stage dep
+            compId <- interpretPartial depTarget $ getPkgData ComponentId
+            libFiles <- fmap concat . forM ways $ \way -> do
+                libFile  <- pkgLibraryFile stage dep compId           way
+                lib0File <- pkgLibraryFile stage dep (compId ++ "-0") way
+                dll0     <- needDll0 stage dep
+                return $ [ libFile ] ++ [ lib0File | dll0 ]
+            return $ libFiles ++ [ pkgGhciLibraryFile stage dep compId | ghci ]
+        need $ objs ++ libs
         build $ fullTargetWithWay target (Ghc stage) vanilla objs [bin]
         synopsis <- interpretPartial target $ getPkgData Synopsis
         putSuccess $ "/--------\n| Successfully built program '"
diff --git a/src/Settings/TargetDirectory.hs b/src/Settings/TargetDirectory.hs
index b84d03d..6bcec88 100644
--- a/src/Settings/TargetDirectory.hs
+++ b/src/Settings/TargetDirectory.hs
@@ -1,5 +1,5 @@
 module Settings.TargetDirectory (
-    targetDirectory, targetPath, pkgHaddockFile
+    targetDirectory, targetPath, pkgHaddockFile, pkgLibraryFile, pkgGhciLibraryFile
     ) where
 
 import Expression
@@ -20,3 +20,18 @@ targetPath stage pkg = pkgPath pkg -/- targetDirectory stage pkg
 pkgHaddockFile :: Package -> FilePath
 pkgHaddockFile pkg @ (Package name _) =
     targetPath Stage1 pkg -/- "doc/html" -/- name -/- name <.> "haddock"
+
+-- Relative path to a package library file, e.g.:
+-- "libraries/array/dist-install/build/libHSarray-0.5.1.0.a"
+-- TODO: remove code duplication for computing buildPath
+pkgLibraryFile :: Stage -> Package -> String -> Way -> Action FilePath
+pkgLibraryFile stage pkg componentId way = do
+    extension <- libsuf way
+    let buildPath = targetPath stage pkg -/- "build"
+    return $ buildPath -/- "libHS" ++ componentId <.> extension
+
+-- Relative path to a package ghci library file, e.g.:
+-- "libraries/array/dist-install/build/HSarray-0.5.1.0.o"
+pkgGhciLibraryFile :: Stage -> Package -> String -> FilePath
+pkgGhciLibraryFile stage pkg componentId =
+    targetPath stage pkg -/- "build" -/- "HS" ++ componentId <.> "o"