[commit: ghc] wip/nfs-locking: Improve zero build performance. (d2910ba)

[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/d2910ba1570a2b8a21d83b7ace7d3437c8311b22/ghc

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

commit d2910ba1570a2b8a21d83b7ace7d3437c8311b22
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sat Aug 8 01:03:26 2015 +0100

    Improve zero build performance.


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

d2910ba1570a2b8a21d83b7ace7d3437c8311b22
 src/Oracles/DependencyList.hs |  2 +-
 src/Rules/Compile.hs          | 52 ++++++++++++++++++-------------------------
 src/Rules/Library.hs          | 10 ++++++---
 src/Settings/Builders/Ghc.hs  |  5 +++++
 4 files changed, 35 insertions(+), 34 deletions(-)

diff --git a/src/Oracles/DependencyList.hs b/src/Oracles/DependencyList.hs
index 900b48e..e571f7b 100644
--- a/src/Oracles/DependencyList.hs
+++ b/src/Oracles/DependencyList.hs
@@ -28,7 +28,7 @@ dependencyListOracle :: Rules ()
 dependencyListOracle = do
     deps <- newCache $ \file -> do
         need [file]
-        putOracle $ "Reading " ++ file ++ "..."
+        putOracle $ "Reading dependencies from " ++ file ++ "..."
         contents <- parseMakefile <$> (liftIO $ readFile file)
         return . Map.fromList
                . map (bimap unifyPath (map unifyPath))
diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs
index 35c9755..66ab73b 100644
--- a/src/Rules/Compile.hs
+++ b/src/Rules/Compile.hs
@@ -27,37 +27,29 @@ compilePackage _ target = do
         need [ hiboot -<.> obootsuf (detectWay hiboot) ]
 
     matchBuildResult buildPath "o" ?> \obj -> do
-        let way  = detectWay obj
-            cObj = takeFileName obj -<.> "o"
-        cDeps <- dependencyList cDepsFile cObj
-        hDeps <- dependencyList hDepsFile obj
-        let hSrcDeps = filter ("//*hs" ?==) hDeps
-
-        when (null cDeps && null hDeps) $
-            putError $ "Cannot determine sources for '" ++ obj ++ "'."
-
-        when (not (null cDeps) && not (null hDeps)) $
-            putError $ "Both .c and .hs sources found for '" ++ obj ++ "'."
-
-        need $ hDeps ++ cDeps
-
-        if null cDeps
-        then build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
-        else build $ fullTarget        target cDeps    (Gcc stage)     [obj]
+        cDeps <- dependencyList cDepsFile (takeFileName obj -<.> "o")
+        if not (null cDeps)
+        then do -- obj is produced from a C source file
+            need cDeps
+            build $ fullTarget target cDeps (Gcc stage) [obj]
+        else do -- obj is produced from a Haskell source file
+            hDeps <- dependencyList hDepsFile obj
+            when (null hDeps) . putError $
+                "No dependencies found for '" ++ obj ++ "'."
+            let way  = detectWay obj
+                hSrc = head hDeps
+            unless ("//*hs" ?== hSrc) . putError $
+                "No Haskell source file found for '" ++ obj ++ "'."
+            need hDeps
+            build $ fullTargetWithWay target [hSrc] (Ghc stage) way [obj]
 
     matchBuildResult buildPath "o-boot" ?> \obj -> do
-        let way = detectWay obj
         hDeps <- dependencyList hDepsFile obj
-        let hSrcDeps = filter ("//*hs-boot" ?==) hDeps
-
-        when (null hDeps) $
-            putError $ "Cannot determine sources for '" ++ obj ++ "'."
-
+        when (null hDeps) . putError $
+            "No dependencies found for '" ++ obj ++ "'."
+        let way  = detectWay obj
+            hSrc = head hDeps
+        unless ("//*.hs-boot" ?== hSrc) . putError $
+            "No Haskell source file found for '" ++ obj ++ "'."
         need hDeps
-        build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
-
--- TODO: add support for -dyno
--- $1/$2/build/%.$$($3_o-bootsuf) : $1/$4/%.hs-boot
---     $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@
---     $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
---     $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
+        build $ fullTargetWithWay target [hSrc] (Ghc stage) way [obj]
diff --git a/src/Rules/Library.hs b/src/Rules/Library.hs
index 8fd9b0b..d9ce835 100644
--- a/src/Rules/Library.hs
+++ b/src/Rules/Library.hs
@@ -14,6 +14,7 @@ import Settings.TargetDirectory
 import Rules.Actions
 import Rules.Resources
 import Data.List
+import qualified System.Directory as IO
 
 buildPackageLibrary :: Resources -> StagePackageTarget -> Rules ()
 buildPackageLibrary _ target = do
@@ -33,13 +34,16 @@ buildPackageLibrary _ target = do
             cObjs = [ buildPath -/- src -<.> osuf way | src <- cSrcs ]
             hObjs = [ buildPath -/- src  <.> osuf way | src <- hSrcs ]
 
-        need $ cObjs ++ hObjs -- this will create split objects if required
+        -- This will create split objects if required (we don't track them)
+        need $ cObjs ++ hObjs
 
         split <- interpret target splitObjects
         splitObjs <- if split
             then fmap concat $ forM hSrcs $ \src -> do
-                let files = buildPath -/- src ++ "_" ++ osuf way ++ "_split/*"
-                fmap (map unifyPath) $ getDirectoryFiles "" [files]
+                let splitPath = buildPath -/- src ++ "_" ++ osuf way ++ "_split"
+                contents <- liftIO $ IO.getDirectoryContents splitPath
+                return . map (splitPath -/-)
+                       . filter (not . all (== '.')) $ contents
             else return []
 
         build $ fullTarget target (cObjs ++ hObjs ++ splitObjs) Ar [a]
diff --git a/src/Settings/Builders/Ghc.hs b/src/Settings/Builders/Ghc.hs
index 9c120bc..8ece818 100644
--- a/src/Settings/Builders/Ghc.hs
+++ b/src/Settings/Builders/Ghc.hs
@@ -11,6 +11,11 @@ import Oracles.PackageData
 import Settings.Util
 import Settings.Ways
 
+-- TODO: add support for -dyno
+-- $1/$2/build/%.$$($3_o-bootsuf) : $1/$4/%.hs-boot
+--     $$(call cmd,$1_$2_HC) $$($1_$2_$3_ALL_HC_OPTS) -c $$< -o $$@
+--     $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
+--     $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
 -- TODO: check code duplication
 ghcArgs :: Args
 ghcArgs = stagedBuilder Ghc ? do