Commit bb43f249 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Refactor discovery of generated dependencies

See #285, #267.
parent b61423df
......@@ -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)
......
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@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@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@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@Context {..} obj
| isGenerated src = src
......
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 ]
......@@ -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 ] ]
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment