[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