[commit: ghc] wip/nfs-locking: Switch to using one dependency file for all objects. (4914709)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:34:25 UTC 2017


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

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

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

commit 4914709cd864e4f28be22ea9e12d60b8f5945ffc
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Mon Aug 10 01:35:55 2015 +0100

    Switch to using one dependency file for all objects.


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

4914709cd864e4f28be22ea9e12d60b8f5945ffc
 src/Oracles/Dependencies.hs   | 49 +++++++++++++++++++++++++++++++++++++++++++
 src/Oracles/DependencyList.hs | 40 -----------------------------------
 src/Rules/Dependencies.hs     | 30 ++++++++++++++------------
 3 files changed, 66 insertions(+), 53 deletions(-)

diff --git a/src/Oracles/Dependencies.hs b/src/Oracles/Dependencies.hs
new file mode 100644
index 0000000..c301547
--- /dev/null
+++ b/src/Oracles/Dependencies.hs
@@ -0,0 +1,49 @@
+{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
+
+module Oracles.Dependencies (
+    dependencies,
+    dependenciesOracle
+    ) where
+
+import Base
+import Util
+import Data.List
+import Data.Function
+import qualified Data.HashMap.Strict as Map
+import Control.Applicative
+
+newtype DependenciesKey = DependenciesKey (FilePath, FilePath)
+    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+
+-- dependencies path obj is an action that looks up dependencies of an object
+-- file in a generated dependecy file 'path/.dependencies'.
+-- If the dependencies cannot be determined, an appropriate error is raised.
+-- Otherwise, a pair (source, depFiles) is returned, such that obj can be
+-- produced by compiling 'source'; the latter can also depend on a number of
+-- other dependencies listed in depFiles.
+dependencies :: FilePath -> FilePath -> Action (FilePath, [FilePath])
+dependencies path obj = do
+    let depFile = path -/- ".dependencies"
+    res1 <- askOracle $ DependenciesKey (depFile, obj)
+    -- if no dependencies found attempt to drop the way prefix (for *.c sources)
+    res2 <- case res1 of
+        Nothing -> askOracle $ DependenciesKey (depFile, obj -<.> "o")
+        _       -> return res1
+    case res2 of
+        Nothing -> putError $ "No dependencies found for '" ++ obj ++ "'."
+        Just [] -> putError $ "Empty dependency list for '" ++ obj ++ "'."
+        Just (src:depFiles) -> return (src, depFiles)
+
+-- Oracle for 'path/dist/.dependencies' files
+dependenciesOracle :: Rules ()
+dependenciesOracle = do
+    deps <- newCache $ \file -> do
+        putOracle $ "Reading dependencies from " ++ file ++ "..."
+        contents <- parseMakefile <$> readFile' file
+        return . Map.fromList . map (bimap unifyPath (map unifyPath))
+                              . map (bimap head concat . unzip)
+                              . groupBy ((==) `on` fst)
+                              . sortBy (compare `on` fst) $ contents
+
+    addOracle $ \(DependenciesKey (file, obj)) -> Map.lookup obj <$> deps file
+    return ()
diff --git a/src/Oracles/DependencyList.hs b/src/Oracles/DependencyList.hs
deleted file mode 100644
index e571f7b..0000000
--- a/src/Oracles/DependencyList.hs
+++ /dev/null
@@ -1,40 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
-
-module Oracles.DependencyList (
-    dependencyList,
-    dependencyListOracle
-    ) where
-
-import Base
-import Util
-import Data.List
-import Data.Maybe
-import Data.Function
-import qualified Data.HashMap.Strict as Map
-import Control.Applicative
-
-newtype DependencyListKey = DependencyListKey (FilePath, FilePath)
-    deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
-
--- dependencyList depFile objFile is an action that looks up dependencies of an
--- object file (objFile) in a generated dependecy file (depFile).
-dependencyList :: FilePath -> FilePath -> Action [FilePath]
-dependencyList depFile objFile = do
-    res <- askOracle $ DependencyListKey (depFile, objFile)
-    return . fromMaybe [] $ res
-
--- Oracle for 'path/dist/*.deps' files
-dependencyListOracle :: Rules ()
-dependencyListOracle = do
-    deps <- newCache $ \file -> do
-        need [file]
-        putOracle $ "Reading dependencies from " ++ file ++ "..."
-        contents <- parseMakefile <$> (liftIO $ readFile file)
-        return . Map.fromList
-               . map (bimap unifyPath (map unifyPath))
-               . map (bimap head concat . unzip)
-               . groupBy ((==) `on` fst)
-               . sortBy (compare `on` fst) $ contents
-    addOracle $ \(DependencyListKey (file, obj)) ->
-        Map.lookup (unifyPath obj) <$> deps (unifyPath file)
-    return ()
diff --git a/src/Rules/Dependencies.hs b/src/Rules/Dependencies.hs
index ea47241..90c764f 100644
--- a/src/Rules/Dependencies.hs
+++ b/src/Rules/Dependencies.hs
@@ -19,20 +19,24 @@ buildPackageDependencies _ target =
         path      = targetPath stage pkg
         buildPath = path -/- "build"
         dropBuild = (pkgPath pkg ++) . drop (length buildPath)
+        hDepFile  = buildPath -/- ".hs-dependencies"
     in do
-        (buildPath <//> "*.c.deps") %> \depFile -> do
-            let srcFile = dropBuild . dropExtension $ depFile
+        (buildPath <//> "*.c.deps") %> \file -> do
+            let srcFile = dropBuild . dropExtension $ file
             need [srcFile]
-            build $ fullTarget target [srcFile] (GccM stage) [depFile]
+            build $ fullTarget target (GccM stage) [srcFile] [file]
 
-        (buildPath -/- "c.deps") %> \file -> do
-            srcs <- pkgDataList $ CSrcs path
-            let depFiles = [ buildPath -/- src <.> "deps" | src <- srcs ]
-            need depFiles
-            deps <- mapM readFile' depFiles
-            writeFileChanged file (concat deps)
-
-        (buildPath -/- "haskell.deps") %> \file -> do
-            srcs <- interpret target getHsSources
+        hDepFile %> \file -> do
+            srcs <- interpret target getPackageSources
             need srcs
-            build $ fullTarget target srcs (GhcM stage) [file]
+            build $ fullTarget target (GhcM stage) srcs [file]
+            liftIO $ removeFiles "." [hDepFile <.> "bak"]
+
+        (buildPath -/- ".dependencies") %> \file -> do
+            cSrcs <- pkgDataList $ CSrcs path
+            let cDepFiles = [ buildPath -/- src <.> "deps" | src <- cSrcs ]
+            need $ hDepFile : cDepFiles -- need all for more parallelism
+            cDeps <- fmap concat $ mapM readFile' cDepFiles
+            hDeps <- readFile' hDepFile
+            writeFileChanged file $ cDeps ++ hDeps
+



More information about the ghc-commits mailing list