[commit: ghc] wip/nfs-locking: Initial version of FindMissingInclude (c2d7e2a)

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

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

commit c2d7e2aa683c89d9b1464734ea9ae68ff735655c
Author: Michal Terepeta <michal.terepeta at gmail.com>
Date:   Sat Jul 23 16:50:31 2016 +0200

    Initial version of FindMissingInclude
    
    This allows finding missing includes for `.c` files (this is important
    for all the cases where we generate the includes during the build
    process).
    
    We're using GCC's `-MM` `-MG` options and iterate as long as we get
    new includes. Since this would return all includes verbatim from the
    `#include`, we check which ones are actually generated and what are
    their final paths.
    
    Note: this is currently applied only to `.c` files and does not (yet?)
    work for `.hs` files (there are issues with things like ifdefs for
    package versions that cause GCC to error out).
    
    Signed-off-by: Michal Terepeta <michal.terepeta at gmail.com>


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

c2d7e2aa683c89d9b1464734ea9ae68ff735655c
 src/Builder.hs              |  3 ++-
 src/Rules/Compile.hs        | 40 ++++++++++++++++++++++++++++++++++++++++
 src/Rules/Generate.hs       | 17 ++++++++++++++++-
 src/Settings/Builders/Cc.hs | 13 ++++++++++++-
 4 files changed, 70 insertions(+), 3 deletions(-)

diff --git a/src/Builder.hs b/src/Builder.hs
index 17198e7..1974eff 100644
--- a/src/Builder.hs
+++ b/src/Builder.hs
@@ -21,7 +21,8 @@ import Stage
 -- 3) Linking object files & static libraries into an executable.
 -- We have CcMode for CC and GhcMode for GHC.
 
-data CcMode = CompileC | FindCDependencies
+-- TODO: Consider merging FindCDependencies and FindMissingInclude
+data CcMode = CompileC | FindCDependencies | FindMissingInclude
     deriving (Eq, Generic, Show)
 
 data GhcMode = CompileHs | FindHsDependencies | LinkHs
diff --git a/src/Rules/Compile.hs b/src/Rules/Compile.hs
index fd6cd32..001068a 100644
--- a/src/Rules/Compile.hs
+++ b/src/Rules/Compile.hs
@@ -5,9 +5,16 @@ import Context
 import Expression
 import Oracles.Dependencies
 import Rules.Actions
+import Rules.Generate
 import Settings.Paths
 import Target
 
+import Development.Shake.Util
+
+import Data.Maybe
+import Data.List
+import qualified Data.Set as Set
+
 compilePackage :: [(Resource, Int)] -> Context -> Rules ()
 compilePackage rs context at Context {..} = do
     let path = buildPath context
@@ -22,6 +29,9 @@ compilePackage rs context at Context {..} = do
         if ("//*.c" ?== src)
         then do
             need $ src : deps
+            -- TODO: Improve parallelism by collecting all dependencies and
+            -- need'ing them all at once
+            mapM_  (needGenerated context) . filter ("//*.c" ?==) $ src : deps
             build $ Target context (Cc CompileC stage) [src] [obj]
         else do
             need $ src : deps
@@ -39,3 +49,33 @@ needCompileDependencies :: Context -> Action ()
 needCompileDependencies context at Context {..} = do
     when (isLibrary package) $ need =<< return <$> pkgConfFile context
     needContext =<< contextDependencies context
+
+needGenerated :: Context -> FilePath -> Action ()
+needGenerated context origFile = go Set.empty
+  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
+
+        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)
+
+    parseFile :: FilePath -> Action [String]
+    parseFile file = do
+        input <- liftIO $ readFile file
+        case parseMakefile input of
+            [(_file, deps)] -> return deps
+            _               -> return []
+
diff --git a/src/Rules/Generate.hs b/src/Rules/Generate.hs
index 988b3d7..34874db 100644
--- a/src/Rules/Generate.hs
+++ b/src/Rules/Generate.hs
@@ -1,6 +1,7 @@
 module Rules.Generate (
     generatePackageCode, generateRules, installTargets, copyRules,
-    includesDependencies, derivedConstantsPath, generatedDependencies
+    includesDependencies, derivedConstantsPath, generatedDependencies,
+    getPathIfGenerated
     ) where
 
 import qualified System.Directory as IO
@@ -196,3 +197,17 @@ 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 354d2b4..36a172e 100644
--- a/src/Settings/Builders/Cc.hs
+++ b/src/Settings/Builders/Cc.hs
@@ -26,7 +26,18 @@ ccBuilderArgs = mconcat
                 , arg $ dropExtension output -<.> "o"
                 , arg "-x"
                 , arg "c"
-                , arg =<< getInput ] ]
+                , arg =<< getInput ]
+
+    , builder (Cc FindMissingInclude) ? do
+        mconcat [ arg "-E"
+                , arg "-MM"
+                , arg "-MG"
+                , commonCcArgs
+                , arg "-MF"
+                , arg =<< getOutput
+                , arg =<< getInput
+                ]
+    ]
 
 commonCcArgs :: Args
 commonCcArgs = mconcat [ append =<< getPkgDataList CcArgs