[commit: ghc] wip/nfs-locking: Refactor discovery of generated dependencies (bb43f24)
git at git.haskell.org
git at git.haskell.org
Fri Oct 27 00:24:43 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/nfs-locking
Link : http://ghc.haskell.org/trac/ghc/changeset/bb43f249ba63559f988fedac9b5180bfdc28d1cf/ghc
>---------------------------------------------------------------
commit bb43f249ba63559f988fedac9b5180bfdc28d1cf
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date: Fri Oct 21 01:30:10 2016 +0100
Refactor discovery of generated dependencies
See #285, #267.
>---------------------------------------------------------------
bb43f249ba63559f988fedac9b5180bfdc28d1cf
src/Builder.hs | 8 ++----
src/Rules/Compile.hs | 59 +++++++++++++++++++++++----------------------
src/Rules/Generate.hs | 17 +------------
src/Settings/Builders/Cc.hs | 12 ++-------
4 files changed, 35 insertions(+), 61 deletions(-)
diff --git a/src/Builder.hs b/src/Builder.hs
index 09b87cb..860034e 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -20,12 +20,8 @@ import Stage
-- 1) Compiling sources into object files.
-- 2) Extracting source dependencies, e.g. by passing -M command line argument.
-- 3) Linking object files & static libraries into an executable.
--- We have CcMode for CC and GhcMode for GHC.
-
--- TODO: Consider merging FindCDependencies and FindMissingInclude
-data CcMode = CompileC | FindCDependencies | FindMissingInclude
- deriving (Eq, Generic, Show)
-
+-- We have CcMode for C compiler and GhcMode for GHC.
+data CcMode = CompileC | FindCDependencies deriving (Eq, Generic, Show)
data GhcMode = CompileHs | FindHsDependencies | LinkHs
deriving (Eq, Generic, Show)
diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs
index 535758c..285abe0 100644
--- a/src/Rules/Compile.hs
+++ b/src/Rules/Compile.hs
@@ -1,5 +1,7 @@
module Rules.Compile (compilePackage) where
+import Development.Shake.Util
+
import Base
import Context
import Expression
@@ -9,21 +11,14 @@ import Rules.Generate
import Settings.Paths
import Target
-import Development.Shake.Util
-
-import qualified Data.Set as Set
-
compilePackage :: [(Resource, Int)] -> Context -> Rules ()
compilePackage rs context at Context {..} = do
let path = buildPath context
nonHs extension = path </> extension <//> "*" <.> osuf way
compile compiler obj2src obj = do
- let depFile = obj -<.> "d"
- src = obj2src context obj
+ let src = obj2src context obj
need [src]
- needGenerated context src
- build $ Target context (Cc FindCDependencies stage) [src] [depFile]
- needMakefileDependencies depFile -- TODO: Is this actually needed?
+ needDependencies context src $ obj <.> "d"
build $ Target context (compiler stage) [src] [obj]
compileHs = \[obj, _] -> do
(src, deps) <- fileDependencies context obj
@@ -41,28 +36,27 @@ compilePackage rs context at Context {..} = do
[ path <//> "*" <.> suf way | suf <- [ osuf, hisuf] ] &%> compileHs
[ path <//> "*" <.> suf way | suf <- [obootsuf, hibootsuf] ] &%> compileHs
--- TODO: Simplify.
-needGenerated :: Context -> FilePath -> Action ()
-needGenerated context origFile = go Set.empty
+-- | Discover dependencies of a given source file by iteratively calling @gcc@
+-- in the @-MM -MG@ mode and building generated dependencies if they are missing
+-- until reaching a fixed point.
+needDependencies :: Context -> FilePath -> FilePath -> Action ()
+needDependencies context at Context {..} src depFile = discover
where
- go :: Set.Set String -> Action ()
- go done = withTempFile $ \outFile -> do
- let builder = Cc FindMissingInclude $ stage context
- target = Target context builder [origFile] [outFile]
- build target
- deps <- parseFile outFile
-
- -- Get the full path if the include refers to a generated file and call
- -- `need` on it.
- needed <- liftM catMaybes $
- interpretInContext context (mapM getPathIfGenerated deps)
- need needed
+ discover = do
+ build $ Target context (Cc FindCDependencies stage) [src] [depFile]
+ deps <- parseFile depFile
+ -- Generated dependencies, if not yet built, will not be found and hence
+ -- will be referred to simply by their file names.
+ let notFound = filter (\file -> file == takeFileName file) deps
+ -- We find the full paths to generated dependencies, so we can request
+ -- to build them by calling 'need'.
+ todo <- catMaybes <$> mapM (fullPathIfGenerated context) notFound
- let newdone = Set.fromList needed `Set.union` done
- -- If we added a new file to the set of needed files, let's try one more
- -- time, since the new file might include a genreated header of itself
- -- (which we'll `need`).
- when (Set.size newdone > Set.size done) (go newdone)
+ if null todo
+ then need deps -- The list of dependencies is final, need all
+ else do
+ need todo -- Build newly discovered generated dependencies
+ discover -- Continue the discovery process
parseFile :: FilePath -> Action [String]
parseFile file = do
@@ -71,6 +65,13 @@ needGenerated context origFile = go Set.empty
[(_file, deps)] -> return deps
_ -> return []
+-- | Find a given 'FilePath' in the list of generated files in the given
+-- 'Context' and return its full path.
+fullPathIfGenerated :: Context -> FilePath -> Action (Maybe FilePath)
+fullPathIfGenerated context file = interpretInContext context $ do
+ generated <- generatedDependencies
+ return $ find ((== file) . takeFileName) generated
+
obj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> FilePath
obj2src extension isGenerated context at Context {..} obj
| isGenerated src = src
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index ceeb182..bfede1a 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -1,7 +1,6 @@
module Rules.Generate (
isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules,
- installTargets, copyRules, includesDependencies, generatedDependencies,
- getPathIfGenerated
+ installTargets, copyRules, includesDependencies, generatedDependencies
) where
import qualified System.Directory as IO
@@ -199,17 +198,3 @@ generateRules = do
emptyTarget :: Context
emptyTarget = vanillaContext (error "Rules.Generate.emptyTarget: unknown stage")
(error "Rules.Generate.emptyTarget: unknown package")
-
-getPathIfGenerated :: FilePath -> Expr (Maybe FilePath)
-getPathIfGenerated include = do
- generated <- generatedFiles
- -- For includes of generated files, we cannot get the full path of the file
- -- (since it might be included due to some include dir, i.e., through `-I`).
- -- So here we try both the name and the path.
- let nameOrPath (name, path) = include == name || include == path
- return . fmap snd $ find nameOrPath generated
-
-generatedFiles :: Expr [(FilePath, FilePath)]
-generatedFiles = do
- deps <- generatedDependencies
- return [ (takeFileName fp, fp) | fp <- deps ]
diff --git a/src/Settings/Builders/Cc.hs b/src/Settings/Builders/Cc.hs
index 41a8466..595feab 100644
--- a/src/Settings/Builders/Cc.hs
+++ b/src/Settings/Builders/Cc.hs
@@ -21,19 +21,11 @@ ccBuilderArgs = builder Cc ? mconcat
output <- getOutput
mconcat [ arg "-E"
, arg "-MM"
+ , arg "-MG"
, arg "-MF"
, arg output
, arg "-MT"
, arg $ dropExtension output -<.> "o"
, arg "-x"
, arg "c"
- , arg =<< getInput ]
-
- , builder (Cc FindMissingInclude) ?
- mconcat [ arg "-E"
- , arg "-MM"
- , arg "-MG"
- , arg "-MF"
- , arg =<< getOutput
- , arg =<< getInput ]
- ]
+ , arg =<< getInput ] ]
More information about the ghc-commits
mailing list