[commit: ghc] wip/nfs-locking: Optimise rules by removing a loop over all possible ways. (c204ca9)

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

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

commit c204ca9764ac5ffdb141247151e040bd1bffa5d6
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Wed Aug 5 23:26:36 2015 +0100

    Optimise rules by removing a loop over all possible ways.


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

c204ca9764ac5ffdb141247151e040bd1bffa5d6
 src/Rules/Compile.hs | 34 +++++++++++++++++++---------------
 1 file changed, 19 insertions(+), 15 deletions(-)

diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs
index 4b2fe4b..89b60c2 100644
--- a/src/Rules/Compile.hs
+++ b/src/Rules/Compile.hs
@@ -7,10 +7,14 @@ import Builder
 import Expression
 import qualified Target
 import Oracles.DependencyList
-import Settings.Ways
 import Settings.TargetDirectory
 import Rules.Actions
 import Rules.Resources
+import Data.Maybe
+
+matchBuildResult :: FilePath -> String -> FilePath -> Bool
+matchBuildResult buildPath extension file =
+    (buildPath <//> "*" ++ extension) ?== file && (isJust . detectWay $ file)
 
 compilePackage :: Resources -> StagePackageTarget -> Rules ()
 compilePackage _ target = do
@@ -21,20 +25,20 @@ compilePackage _ target = do
         cDepsFile = buildPath -/- "c.deps"
         hDepsFile = buildPath -/- "haskell.deps"
 
-    forM_ knownWays $ \way -> do
-        (buildPath <//> "*." ++ hisuf way) %> \hi -> do
-            let obj = hi -<.> osuf way
-            need [obj]
+    matchBuildResult buildPath "hi" ?> \hi -> do
+        let way = fromJust . detectWay $ hi -- fromJust is safe
+        need [hi -<.> osuf way]
 
-        (buildPath <//> "*." ++ osuf way) %> \obj -> do
-            let vanillaObjName = takeFileName obj -<.> "o"
-            cDeps <- dependencyList cDepsFile vanillaObjName
-            hDeps <- dependencyList hDepsFile obj
-            let hSrcDeps = filter ("//*hs" ?==) hDeps
+    matchBuildResult buildPath "o" ?> \obj -> do
+        let way        = fromJust . detectWay $ obj -- fromJust is safe
+            vanillaObj = takeFileName obj -<.> "o"
+        cDeps <- dependencyList cDepsFile vanillaObj
+        hDeps <- dependencyList hDepsFile obj
+        let hSrcDeps = filter ("//*hs" ?==) hDeps
 
-            when (null cDeps && null hDeps) $
-                putError_ $ "Cannot determine sources for '" ++ obj ++ "'."
+        when (null cDeps && null hDeps) $
+            putError $ "Cannot determine sources for '" ++ obj ++ "'."
 
-            if null cDeps
-            then build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
-            else build $ fullTarget        target cDeps    (Gcc stage)     [obj]
+        if null cDeps
+        then build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
+        else build $ fullTarget        target cDeps    (Gcc stage)     [obj]