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

Split compilation of Haskell and non-Haskell files

See #216, #264, #267.
parent fbe22e6f
......@@ -17,15 +17,14 @@ newtype ObjDepsKey = ObjDepsKey (FilePath, FilePath)
deriving (Binary, Eq, Hashable, NFData, Show, Typeable)
-- | 'Action' @fileDependencies context file@ looks up dependencies of a @file@
-- in a generated dependecy file @path/.dependencies@, where @path@ is the build
-- in a generated dependency file @path/.dependencies@, where @path@ is the build
-- path of the given @context@. The action returns a pair @(source, files)@,
-- such that the @file@ can be produced by compiling @source@, which in turn
-- also depends on a number of other @files@.
fileDependencies :: Context -> FilePath -> Action (FilePath, [FilePath])
fileDependencies context obj = do
let path = buildPath context -/- ".dependencies"
-- If no dependencies found, try to drop the way suffix (for *.c sources).
deps <- firstJustM (askOracle . ObjDepsKey . (,) path) [obj, obj -<.> "o"]
deps <- askOracle $ ObjDepsKey (path, obj)
case deps of
Nothing -> error $ "No dependencies found for file " ++ obj
Just [] -> error $ "No source file found for file " ++ obj
......
......@@ -13,8 +13,10 @@ data PackageData = BuildGhciLib FilePath
| Synopsis FilePath
| Version FilePath
data PackageDataList = CcArgs FilePath
data PackageDataList = AsmSrcs FilePath
| CcArgs FilePath
| CSrcs FilePath
| CmmSrcs FilePath
| CppArgs FilePath
| DepCcArgs FilePath
| DepExtraLibs FilePath
......@@ -55,8 +57,10 @@ pkgData packageData = case packageData of
-- @pkgListData Modules@ therefore returns ["Data.Array", "Data.Array.Base", ...]
pkgDataList :: PackageDataList -> Action [String]
pkgDataList packageData = fmap (map unquote . words) $ case packageData of
AsmSrcs path -> askPackageData path "S_SRCS"
CcArgs path -> askPackageData path "CC_OPTS"
CSrcs path -> askPackageData path "C_SRCS"
CmmSrcs path -> askPackageData path "CMM_SRCS"
CppArgs path -> askPackageData path "CPP_OPTS"
DepCcArgs path -> askPackageData path "DEP_CC_OPTS"
DepExtraLibs path -> askPackageData path "DEP_EXTRA_LIBS"
......
......@@ -15,39 +15,33 @@ import qualified Data.Set as Set
compilePackage :: [(Resource, Int)] -> Context -> Rules ()
compilePackage rs context@Context {..} = do
let path = buildPath context
path <//> "*" <.> hisuf way %> \hi -> need [ hi -<.> osuf way ]
path <//> "*" <.> hibootsuf way %> \hiboot -> need [ hiboot -<.> obootsuf way ]
-- TODO: Add dependencies for #include of .h and .hs-incl files (gcc -MM?).
path <//> "*" <.> osuf way %> \obj -> do
(src, deps) <- fileDependencies context obj
if ("//*.c" ?== src)
then do
let path = buildPath context
nonHs extension = path </> extension <//> "*" <.> osuf way
compile compiler obj2src obj = do
let depFile = obj -<.> "d"
src = obj2src context obj
need [src]
needGenerated context src
build $ Target context (Cc FindCDependencies stage) [src] [depFile]
needMakefileDependencies depFile -- TODO: Is this actually needed?
build $ Target context (compiler stage) [src] [obj]
compileHs = \[obj, _] -> do
(src, deps) <- fileDependencies context obj
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
needCompileDependencies context
when (isLibrary package) $ need =<< return <$> pkgConfFile context
needContext =<< contextDependencies context
buildWithResources rs $ Target context (Ghc CompileHs stage) [src] [obj]
-- TODO: Get rid of these special cases.
path <//> "*" <.> obootsuf way %> \obj -> do
(src, deps) <- fileDependencies context obj
need $ src : deps
needCompileDependencies context
buildWithResources rs $ Target context (Ghc CompileHs stage) [src] [obj]
priority 2.0 $ do
nonHs "c" %> compile (Cc CompileC ) (obj2src "c" isGeneratedCFile )
nonHs "cmm" %> compile (Ghc CompileHs) (obj2src "cmm" isGeneratedCmmFile)
nonHs "s" %> compile (Ghc CompileHs) (obj2src "S" $ const False )
needCompileDependencies :: Context -> Action ()
needCompileDependencies context@Context {..} = do
when (isLibrary package) $ need =<< return <$> pkgConfFile context
needContext =<< contextDependencies context
-- TODO: Add dependencies for #include of .h and .hs-incl files (gcc -MM?).
[ 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
where
......@@ -77,3 +71,11 @@ needGenerated context origFile = go Set.empty
[(_file, deps)] -> return deps
_ -> return []
obj2src :: String -> (FilePath -> Bool) -> Context -> FilePath -> FilePath
obj2src extension isGenerated context@Context {..} obj
| isGenerated src = src
| otherwise = pkgPath package ++ suffix
where
src = obj -<.> extension
suffix = fromMaybe ("Cannot determine source for " ++ obj)
$ stripPrefix (buildPath context -/- extension) src
......@@ -113,19 +113,20 @@ buildPackageData context@Context {..} = do
let prefix = fixKey (buildPath context) ++ "_"
dirs = [ ".", "hooks", "sm", "eventlog", "linker" ]
++ [ if windows then "win32" else "posix" ]
-- TODO: Adding cmm/S sources to C_SRCS is a hack -- refactor.
cSrcs <- map unifyPath <$>
getDirectoryFiles (pkgPath package) (map (-/- "*.c") dirs)
cmmSrcs <- getDirectoryFiles (pkgPath package) ["*.cmm"]
buildAdjustor <- anyTargetArch ["i386", "powerpc", "powerpc64"]
buildStgCRunAsm <- anyTargetArch ["powerpc64le"]
let extraSrcs = [ "AdjustorAsm.S" | buildAdjustor ]
++ [ "StgCRunAsm.S" | buildStgCRunAsm ]
++ [ rtsBuildPath -/- "AutoApply.cmm" ]
++ [ rtsBuildPath -/- "sm/Evac_thr.c" ]
++ [ rtsBuildPath -/- "sm/Scav_thr.c" ]
let contents = unlines $ map (prefix++)
[ "C_SRCS = " ++ unwords (cSrcs ++ cmmSrcs ++ extraSrcs)
let extraCSrcs = [ rtsBuildPath -/- "c/sm/Evac_thr.c" ]
++ [ rtsBuildPath -/- "c/sm/Scav_thr.c" ]
extraCmmSrcs = [ rtsBuildPath -/- "cmm/AutoApply.cmm" ]
extraAsmSrcs = [ "AdjustorAsm.S" | buildAdjustor ]
++ [ "StgCRunAsm.S" | buildStgCRunAsm ]
let contents = unlines $ map (prefix ++)
[ "C_SRCS = " ++ unwords (cSrcs ++ extraCSrcs)
, "CMM_SRCS = " ++ unwords (cmmSrcs ++ extraCmmSrcs)
, "S_SRCS = " ++ unwords extraAsmSrcs
, "CC_OPTS = -I" ++ generatedPath
, "COMPONENT_ID = rts" ]
writeFileChanged mk contents
......
module Rules.Dependencies (buildPackageDependencies) where
import Development.Shake.Util (parseMakefile)
import Development.Shake.Util
import Base
import Context
import Expression
import Oracles.ModuleFiles
import Oracles.PackageData
import Rules.Actions
import Settings.Paths
import Target
import UserSettings
import GHC
buildPackageDependencies :: [(Resource, Int)] -> Context -> Rules ()
buildPackageDependencies rs context@Context {..} =
let path = buildPath context
hDepFile = path -/- ".hs-dependencies"
in do
fmap (path ++)
[ "//*.c.deps", "//*.cmm.deps", "//*.S.deps" ] |%> \out -> do
let src = dep2src context out
when (package == integerGmp) (need [gmpLibraryH])
need [src]
build $ Target context (Cc FindCDependencies stage) [src] [out]
hDepFile %> \out -> do
srcs <- haskellSources context
need srcs
if srcs == []
then writeFileChanged out ""
else buildWithResources rs $
Target context (Ghc FindHsDependencies stage) srcs [out]
removeFile $ out <.> "bak"
-- TODO: don't accumulate *.deps into .dependencies
path -/- ".dependencies" %> \out -> do
cSrcs <- pkgDataList $ CSrcs path
let cDepFiles = map (src2dep context) cSrcs
need $ hDepFile : cDepFiles -- need all for more parallelism
cDeps <- concatMapM readFile' cDepFiles
hDeps <- readFile' hDepFile
let result = unlines
. map (\(src, deps) -> unwords $ src : deps)
. map (bimap unifyPath (map unifyPath))
. map (bimap head concat . unzip)
. groupBy ((==) `on` fst)
. sortBy (compare `on` fst)
. parseMakefile $ cDeps ++ hDeps
writeFileChanged out result
-- Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
-- to its dependencies. For example, in vanillaContext Stage1 rts:
-- * "Task.c" -> "_build/stage1/rts/Task.c.deps"
-- * "_build/stage1/rts/AutoApply.cmm" -> "_build/stage1/rts/AutoApply.cmm.deps"
src2dep :: Context -> FilePath -> FilePath
src2dep context src
| buildRootPath `isPrefixOf` src = src <.> "deps"
| otherwise = buildPath context -/- src <.> "deps"
-- Given a 'Context' and a 'FilePath' to a file with dependencies, compute the
-- 'FilePath' to the source file. For example, in vanillaContext Stage1 rts:
-- * "_build/stage1/rts/Task.c.deps" -> "Task.c"
-- * "_build/stage1/rts/AutoApply.cmm.deps" -> "_build/stage1/rts/AutoApply.cmm"
dep2src :: Context -> FilePath -> FilePath
dep2src context@Context {..} dep
| takeBaseName dep `elem` [ "AutoApply.cmm", "Evac_thr.c", "Scav_thr.c" ] = src
| otherwise = pkgPath package ++ drop (length $ buildPath context) src
where
src = dropExtension dep
buildPath context -/- ".dependencies" %> \deps -> do
srcs <- haskellSources context
need srcs
let mk = deps <.> "mk"
if srcs == []
then writeFileChanged mk ""
else buildWithResources rs $
Target context (Ghc FindHsDependencies stage) srcs [mk]
removeFile $ mk <.> "bak"
mkDeps <- readFile' mk
writeFileChanged deps . unlines
. map (\(src, deps) -> unwords $ src : deps)
. map (bimap unifyPath (map unifyPath))
. map (bimap head concat . unzip)
. groupBy ((==) `on` fst)
. sortBy (compare `on` fst)
$ parseMakefile mkDeps
module Rules.Generate (
generatePackageCode, generateRules, installTargets, copyRules,
includesDependencies, generatedDependencies, getPathIfGenerated
isGeneratedCFile, isGeneratedCmmFile, generatePackageCode, generateRules,
installTargets, copyRules, includesDependencies, generatedDependencies,
getPathIfGenerated
) where
import qualified System.Directory as IO
......@@ -40,6 +41,12 @@ primopsTxt stage = buildPath (vanillaContext stage compiler) -/- "primops.txt"
platformH :: Stage -> FilePath
platformH stage = buildPath (vanillaContext stage compiler) -/- "ghc_boot_platform.h"
isGeneratedCFile :: FilePath -> Bool
isGeneratedCFile file = takeBaseName file `elem` ["Evac_thr", "Scav_thr"]
isGeneratedCmmFile :: FilePath -> Bool
isGeneratedCmmFile file = takeBaseName file == "AutoApply"
includesDependencies :: [FilePath]
includesDependencies = fmap (generatedPath -/-)
[ "ghcautoconf.h"
......@@ -133,7 +140,7 @@ generatePackageCode context@(Context stage pkg _) =
liftIO $ IO.copyFile file newFile
putBuild $ "| Duplicate file " ++ file ++ " -> " ++ newFile
when (pkg == rts) $ path -/- "AutoApply.cmm" %> \file -> do
when (pkg == rts) $ path -/- "cmm/AutoApply.cmm" %> \file -> do
build $ Target context GenApply [] [file]
priority 2.0 $ do
......@@ -163,8 +170,8 @@ copyRules = do
"inplace/lib/platformConstants" <~ generatedPath
"inplace/lib/settings" <~ "."
"inplace/lib/template-hsc.h" <~ pkgPath hsc2hs
rtsBuildPath -/- "sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
rtsBuildPath -/- "sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
rtsBuildPath -/- "c/sm/Evac_thr.c" %> copyFile (pkgPath rts -/- "sm/Evac.c")
rtsBuildPath -/- "c/sm/Scav_thr.c" %> copyFile (pkgPath rts -/- "sm/Scav.c")
where
file <~ dir = file %> copyFile (dir -/- takeFileName file)
......
module Rules.Library (
buildPackageLibrary, buildPackageGhciLibrary, cSources, hSources
buildPackageLibrary, buildPackageGhciLibrary, cSources, hsSources
) where
import Data.Char
......@@ -12,6 +12,7 @@ import Flavour
import GHC
import Oracles.PackageData
import Rules.Actions
import Rules.Generate
import Settings
import Settings.Paths
import Target
......@@ -19,34 +20,36 @@ import UserSettings
buildPackageLibrary :: Context -> Rules ()
buildPackageLibrary context@Context {..} = do
let path = buildPath context
libPrefix = path -/- "libHS" ++ pkgNameString package
let path = buildPath context
libPrefix = path -/- "libHS" ++ pkgNameString package
-- TODO: handle dynamic libraries
matchVersionedFilePath libPrefix (waySuffix way <.> "a") ?> \a -> do
removeFile a
cSrcs <- cSources context
hSrcs <- hSources context
asmSrcs <- asmSources context
cSrcs <- cSources context
cmmSrcs <- cmmSources context
hsSrcs <- hsSources context
let cObjs = [ objFile context src | src <- cSrcs
, takeFileName src `notElem` ["Evac_thr.c", "Scav_thr.c"]
|| way == threaded ]
hObjs = [ path -/- src <.> osuf way | src <- hSrcs ]
let asmObjs = [ objFile context src | src <- asmSrcs ]
cObjs = [ objFile context src | src <- cSrcs ]
cmmObjs = [ objFile context src | src <- cmmSrcs ]
hsObjs = [ path -/- src <.> osuf way | src <- hsSrcs ]
-- This will create split objects if required (we don't track them
-- explicitly as this would needlessly bloat the Shake database).
need $ cObjs ++ hObjs
need $ asmObjs ++ cObjs ++ cmmObjs ++ hsObjs
split <- interpretInContext context $ splitObjects flavour
splitObjs <- if not split then return hObjs else -- TODO: make clearer!
concatForM hSrcs $ \src -> do
splitObjs <- if not split then return hsObjs else -- TODO: make clearer!
concatForM hsSrcs $ \src -> do
let splitPath = path -/- src ++ "_" ++ osuf way ++ "_split"
contents <- liftIO $ IO.getDirectoryContents splitPath
return . map (splitPath -/-)
. filter (not . all (== '.')) $ contents
eObjs <- extraObjects context
let objs = cObjs ++ splitObjs ++ eObjs
let objs = asmObjs ++ cObjs ++ cmmObjs ++ splitObjs ++ eObjs
asuf <- libsuf way
let isLib0 = ("//*-0" ++ asuf) ?== a
......@@ -66,30 +69,47 @@ buildPackageGhciLibrary context@Context {..} = priority 2 $ do
libPrefix = path -/- "HS" ++ pkgNameString package
matchVersionedFilePath libPrefix (waySuffix way <.> "o") ?> \obj -> do
cSrcs <- cSources context
hSrcs <- hSources context
eObjs <- extraObjects context
let cObjs = map (objFile context) cSrcs
hObjs = [ path -/- src <.> osuf way | src <- hSrcs ]
objs = cObjs ++ hObjs ++ eObjs
cSrcs <- cSources context
hsSrcs <- hsSources context
eObjs <- extraObjects context
let cObjs = map (objFile context) cSrcs
hsObjs = [ path -/- src <.> osuf way | src <- hsSrcs ]
objs = cObjs ++ hsObjs ++ eObjs
need objs
build $ Target context Ld objs [obj]
-- TODO: Get rid of code duplication and simplify. See also src2dep.
-- | Given a 'Context' and a 'FilePath' to a source file, compute the 'FilePath'
-- to its object file. For example, in Context Stage1 rts threaded:
-- * "Task.c" -> "_build/stage1/rts/Task.thr_o"
-- * "_build/stage1/rts/sm/Evac_thr.c" -> "_build/stage1/rts/sm/Evac_thr.thr_o"
-- to its object file. For example:
-- * "Task.c" -> "_build/stage1/rts/Task.thr_o"
-- * "_build/stage1/rts/cmm/AutoApply.cmm" -> "_build/stage1/rts/cmm/AutoApply.o"
objFile :: Context -> FilePath -> FilePath
objFile context@Context {..} src
| buildRootPath `isPrefixOf` src = src -<.> osuf way
| otherwise = buildPath context -/- src -<.> osuf way
| isGenerated src = src -<.> osuf way
| otherwise = buildPath context -/- extension -/- src -<.> osuf way
where
extension = drop 1 $ takeExtension src
isGenerated
| extension == "c" = isGeneratedCFile
| extension == "cmm" = isGeneratedCmmFile
| otherwise = const False
asmSources :: Context -> Action [FilePath]
asmSources context = interpretInContext context $ getPkgDataList AsmSrcs
-- TODO: simplify
cSources :: Context -> Action [FilePath]
cSources context = interpretInContext context $ getPkgDataList CSrcs
hSources :: Context -> Action [FilePath]
hSources context = do
cSources context = do
srcs <- interpretInContext context $ getPkgDataList CSrcs
if way context == threaded
then return srcs
else return [ src | src <- srcs
, takeFileName src `notElem` ["Evac_thr.c", "Scav_thr.c"] ]
cmmSources :: Context -> Action [FilePath]
cmmSources context = interpretInContext context $ getPkgDataList CmmSrcs
hsSources :: Context -> Action [FilePath]
hsSources context = do
modules <- interpretInContext context $ getPkgDataList Modules
-- GHC.Prim is special: we do not build it.
return . map (replaceEq '.' '/') . filter (/= "GHC.Prim") $ modules
......
......@@ -73,19 +73,19 @@ buildWrapper context@Context {..} wrapper wrapperPath binPath = do
-- TODO: Do we need to consider other ways when building programs?
buildBinary :: [(Resource, Int)] -> Context -> FilePath -> Action ()
buildBinary rs context@Context {..} bin = do
hSrcs <- hSources context
hsSrcs <- hsSources context
binDeps <- if stage == Stage0 && package == ghcCabal
then return [ pkgPath package -/- src <.> "hs" | src <- hSrcs ]
then return [ pkgPath package -/- src <.> "hs" | src <- hsSrcs ]
else do
ways <- interpretInContext context getLibraryWays
deps <- contextDependencies context
needContext [ dep { way = w } | dep <- deps, w <- ways ]
cSrcs <- cSources context -- TODO: Drop code duplication (Library.hs).
let path = buildPath context
return $ [ path -/- src -<.> osuf vanilla | src <- cSrcs ]
++ [ path -/- src <.> osuf vanilla | src <- hSrcs ]
++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
++ [ path -/- "Paths_haddock.o" | package == haddock ]
return $ [ path -/- "c" -/- src -<.> osuf vanilla | src <- cSrcs ]
++ [ path -/- src <.> osuf vanilla | src <- hsSrcs ]
++ [ path -/- "Paths_hsc2hs.o" | package == hsc2hs ]
++ [ path -/- "Paths_haddock.o" | package == haddock ]
need binDeps
buildWithResources rs $ Target context (Ghc LinkHs stage) binDeps [bin]
synopsis <- interpretInContext context $ getPkgData Synopsis
......
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