Occurrrence analysis improvements for NOINLINE functions
[ghc.git] / hadrian / src / Rules / Compile.hs
1 module Rules.Compile (compilePackage) where
2
3 import Hadrian.Oracles.TextFile
4
5 import Base
6 import Context
7 import Expression
8 import Rules.Generate
9 import Target
10 import Utilities
11
12 compilePackage :: [(Resource, Int)] -> Context -> Rules ()
13 compilePackage rs context@Context {..} = do
14 let dir = "//" ++ contextDir context
15 nonHs extension = dir -/- extension <//> "*" <.> osuf way
16 compile compiler obj2src obj = do
17 src <- obj2src context obj
18 need [src]
19 needDependencies context src $ obj <.> "d"
20 buildWithResources rs $ target context (compiler stage) [src] [obj]
21 compileHs = \[obj, _hi] -> do
22 path <- buildPath context
23 (src, deps) <- lookupDependencies (path -/- ".dependencies") obj
24 need $ src : deps
25 buildWithResources rs $ target context (Ghc CompileHs stage) [src] [obj]
26
27 priority 2.0 $ do
28 nonHs "c" %> compile (Ghc CompileCWithGhc) (obj2src "c" isGeneratedCFile )
29 nonHs "cmm" %> compile (Ghc CompileHs) (obj2src "cmm" isGeneratedCmmFile)
30 nonHs "s" %> compile (Ghc CompileHs) (obj2src "S" $ const False )
31
32 -- TODO: Add dependencies for #include of .h and .hs-incl files (gcc -MM?).
33 [ dir <//> "*" <.> suf way | suf <- [ osuf, hisuf] ] &%> compileHs
34 [ dir <//> "*" <.> suf way | suf <- [obootsuf, hibootsuf] ] &%> compileHs
35
36 -- | Discover dependencies of a given source file by iteratively calling @gcc@
37 -- in the @-MM -MG@ mode and building generated dependencies if they are missing
38 -- until reaching a fixed point.
39 needDependencies :: Context -> FilePath -> FilePath -> Action ()
40 needDependencies context@Context {..} src depFile = discover
41 where
42 discover = do
43 build $ target context (Cc FindCDependencies stage) [src] [depFile]
44 deps <- parseFile depFile
45 -- Generated dependencies, if not yet built, will not be found and hence
46 -- will be referred to simply by their file names.
47 let notFound = filter (\file -> file == takeFileName file) deps
48 -- We find the full paths to generated dependencies, so we can request
49 -- to build them by calling 'need'.
50 todo <- catMaybes <$> mapM (fullPathIfGenerated context) notFound
51
52 if null todo
53 then need deps -- The list of dependencies is final, need all
54 else do
55 need todo -- Build newly discovered generated dependencies
56 discover -- Continue the discovery process
57
58 parseFile :: FilePath -> Action [String]
59 parseFile file = do
60 input <- liftIO $ readFile file
61 case parseMakefile input of
62 [(_file, deps)] -> return deps
63 _ -> return []
64
65 -- | Find a given 'FilePath' in the list of generated files in the given
66 -- 'Context' and return its full path.
67 fullPathIfGenerated :: Context -> FilePath -> Action (Maybe FilePath)
68 fullPathIfGenerated context file = interpretInContext context $ do
69 generated <- generatedDependencies
70 return $ find ((== file) . takeFileName) generated
71
72 obj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> Action FilePath
73 obj2src extension isGenerated context@Context {..} obj
74 | isGenerated src = return src
75 | otherwise = (pkgPath package ++) <$> suffix
76 where
77 src = obj -<.> extension
78 suffix = do
79 path <- buildPath context
80 return $ fromMaybe ("Cannot determine source for " ++ obj)
81 $ stripPrefix (path -/- extension) src