[commit: ghc] wip/nfs-locking: Build top-level targets in parallel. (1441846)

[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/1441846ddc4fa070a8fa9351ec6386b8645b176e/ghc

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

commit 1441846ddc4fa070a8fa9351ec6386b8645b176e
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Tue Feb 2 15:17:05 2016 +0000

    Build top-level targets in parallel.
    
    See #200.


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

1441846ddc4fa070a8fa9351ec6386b8645b176e
 src/Main.hs    |  2 +-
 src/Package.hs |  3 ++-
 src/Rules.hs   | 48 +++++++++++++++++++++++++++++-------------------
 3 files changed, 32 insertions(+), 21 deletions(-)

diff --git a/src/Main.hs b/src/Main.hs
index 2c944d4..79601d8 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -36,7 +36,7 @@ main = shakeArgsWith options CmdLineFlag.cmdFlags $ \cmdLineFlags targets -> do
         , Rules.Libffi.libffiRules
         , Rules.Oracles.oracleRules
         , Rules.Perl.perlScriptRules
-        , Rules.generateTargets
+        , Rules.topLevelTargets
         , Rules.packageRules
         , Selftest.selftestRules
         , Test.testRules ]
diff --git a/src/Package.hs b/src/Package.hs
index b34dc02..43eb480 100644
--- a/src/Package.hs
+++ b/src/Package.hs
@@ -21,7 +21,8 @@ newtype PackageName = PackageName { getPackageName :: String }
 instance Show PackageName where
     show (PackageName name) = name
 
--- TODO: make PackageType more precise, #12
+-- TODO: Make PackageType more precise, #12
+-- TODO: Turn Program to Program FilePath thereby getting rid of programPath
 -- | We regard packages as either being libraries or programs. This is
 -- bit of a convenient lie as Cabal packages can be both, but it works
 -- for now.
diff --git a/src/Rules.hs b/src/Rules.hs
index 5f505b3..b22e028 100644
--- a/src/Rules.hs
+++ b/src/Rules.hs
@@ -1,10 +1,11 @@
-module Rules (generateTargets, packageRules) where
+module Rules (topLevelTargets, packageRules) where
 
 import Base
 import Data.Foldable
 import Expression
 import GHC
-import Rules.Generate
+import Oracles.PackageData
+import qualified Rules.Generate
 import Rules.Package
 import Rules.Resources
 import Settings
@@ -13,23 +14,32 @@ allStages :: [Stage]
 allStages = [minBound ..]
 
 -- | 'need' all top-level build targets
-generateTargets :: Rules ()
-generateTargets = action $ do
-    targets   <- fmap concat (traverse targetsForStage allStages)
-    rtsLib    <- pkgLibraryFile Stage1 rts "rts" vanilla
-    rtsThrLib <- pkgLibraryFile Stage1 rts "rts" threaded
-    need $ targets ++ installTargets ++ [ rtsLib, rtsThrLib ]
-
-targetsForStage :: Stage -> Action [String]
-targetsForStage stage = do
-    pkgs <- interpretWithStage stage getPackages
-    let libPkgs = filter isLibrary pkgs \\ [rts, libffi]
-    libTargets <- fmap concat . forM libPkgs $ \pkg -> do
-        let target = PartialTarget stage pkg
-        needHaddock <- interpretPartial target buildHaddock
-        return [ pkgHaddockFile pkg | needHaddock && stage == Stage1 ]
-    let programTargets = [ prog | Just prog <- programPath stage <$> pkgs ]
-    return $ libTargets ++ programTargets
+topLevelTargets :: Rules ()
+topLevelTargets = do
+
+    want $ Rules.Generate.installTargets
+
+    -- TODO: do we want libffiLibrary to be a top-level target?
+
+    action $ do -- TODO: Add support for all rtsWays
+        rtsLib    <- pkgLibraryFile Stage1 rts "rts" vanilla
+        rtsThrLib <- pkgLibraryFile Stage1 rts "rts" threaded
+        need [ rtsLib, rtsThrLib ]
+
+    for_ allStages $ \stage ->
+        for_ (knownPackages \\ [rts, libffi]) $ \pkg -> action $ do
+            let target = PartialTarget stage pkg
+            activePackages <- interpretPartial target getPackages
+            when (pkg `elem` activePackages) $
+                if isLibrary pkg
+                then do -- build a library
+                    ways    <- interpretPartial target getLibraryWays
+                    compId  <- interpretPartial target $ getPkgData ComponentId
+                    libs    <- traverse (pkgLibraryFile stage pkg compId) ways
+                    haddock <- interpretPartial target buildHaddock
+                    need $ libs ++ [ pkgHaddockFile pkg | haddock && stage == Stage1 ]
+                else do -- otherwise build a program
+                    need [ fromJust $ programPath stage pkg ] -- TODO: drop fromJust
 
 packageRules :: Rules ()
 packageRules = do