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

Add support for c source files.

parent 316d98ef
......@@ -7,8 +7,8 @@ module Package.Base (
Package (..), Settings (..), TodoItem (..),
defaultSettings, libraryPackage,
commonCcArgs, commonLdArgs, commonCppArgs, commonCcWarninigArgs,
pathArgs, packageArgs, includeArgs, pkgHsSources,
pkgDepObjects, pkgLibObjects,
pathArgs, packageArgs, includeHcArgs, pkgHsSources,
pkgDepHsObjects, pkgLibHsObjects, pkgCObjects,
argSizeLimit,
sourceDependecies,
argList, argListWithComment,
......@@ -92,8 +92,8 @@ packageArgs stage pathDist = do
else productArgs "-package-name" (arg $ PackageKey pathDist)
<> productArgs "-package" (args $ Deps pathDist) ]
includeArgs :: FilePath -> FilePath -> Args
includeArgs path dist =
includeHcArgs :: FilePath -> FilePath -> Args
includeHcArgs path dist =
let pathDist = path </> dist
buildDir = toStandard $ pathDist </> "build"
in args [ arg "-i"
......@@ -111,10 +111,11 @@ pkgHsSources path dist = do
dirs <- map (path </>) <$> args (SrcDirs pathDist)
findModuleFiles pathDist dirs [".hs", ".lhs"]
-- Find objects we depend on (we don't want to depend on split objects)
-- TODO: look for non-hs objects too
pkgDepObjects :: FilePath -> FilePath -> Way -> Action [FilePath]
pkgDepObjects path dist way = do
-- TODO: look for non-{hs,c} objects too
-- Find Haskell objects we depend on (we don't want to depend on split objects)
pkgDepHsObjects :: FilePath -> FilePath -> Way -> Action [FilePath]
pkgDepHsObjects path dist way = do
let pathDist = path </> dist
buildDir = pathDist </> "build"
dirs <- map (normaliseEx . (path </>)) <$> args (SrcDirs pathDist)
......@@ -122,9 +123,16 @@ pkgDepObjects path dist way = do
map (toStandard . (buildDir ++) . (-<.> osuf way) . drop (length d))
<$> (findModuleFiles pathDist [d] [".hs", ".lhs"])
-- Find objects that go to library
pkgLibObjects :: FilePath -> FilePath -> Stage -> Way -> Action [FilePath]
pkgLibObjects path dist stage way = do
pkgCObjects :: FilePath -> FilePath -> Way -> Action [FilePath]
pkgCObjects path dist way = do
let pathDist = path </> dist
buildDir = pathDist </> "build"
srcs <- args $ CSrcs pathDist
return $ map (toStandard . (buildDir </>) . (-<.> osuf way)) srcs
-- Find Haskell objects that go to library
pkgLibHsObjects :: FilePath -> FilePath -> Stage -> Way -> Action [FilePath]
pkgLibHsObjects path dist stage way = do
let pathDist = path </> dist
buildDir = pathDist </> "build"
split <- splitObjects stage
......@@ -132,7 +140,7 @@ pkgLibObjects path dist stage way = do
then do
let suffixes = ["_" ++ osuf way ++ "_split//*"]
findModuleFiles pathDist [buildDir] suffixes
else pkgDepObjects path dist way
else pkgDepHsObjects path dist way
findModuleFiles :: FilePath -> [FilePath] -> [String] -> Action [FilePath]
findModuleFiles pathDist directories suffixes = do
......
......@@ -2,7 +2,6 @@
module Package.Compile (buildPackageCompile) where
import Package.Base
import Development.Shake.Util
argListDir :: FilePath
argListDir = "shake/arg/buildPackageCompile"
......@@ -19,7 +18,7 @@ ghcArgs (Package _ path _) (stage, dist, _) way srcs result =
, wayHcArgs way
, args SrcHcArgs
, packageArgs stage pathDist
, includeArgs path dist
, includeHcArgs path dist
, concatArgs ["-optP"] $ CppArgs pathDist
, args $ HsArgs pathDist
-- TODO: now we have both -O and -O2
......@@ -29,19 +28,47 @@ ghcArgs (Package _ path _) (stage, dist, _) way srcs result =
, args ("-c":srcs)
, args ["-o", result] ]
gccArgs :: Package -> TodoItem -> [FilePath] -> FilePath -> Args
gccArgs (Package _ path _) (_, dist, _) srcs result =
let pathDist = path </> dist
in args [ args $ CcArgs pathDist
, commonCcArgs
, commonCcWarninigArgs
, pathArgs "-I" path $ IncludeDirs pathDist
, args ("-c":srcs)
, args ["-o", result] ]
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _) todo @ (stage, dist, _) =
let buildDir = toStandard $ path </> dist </> "build"
depFile = buildDir </> takeBaseName name <.> "m"
hDepFile = buildDir </> "haskell.deps"
cDepFile = buildDir </> "c.deps"
in
[buildDir <//> "*o", buildDir <//> "*hi"] &%> \[out, _] -> do
let way = detectWay $ tail $ takeExtension out
need [argListPath argListDir pkg stage, depFile]
depContents <- parseMakefile <$> (liftIO $ readFile depFile)
let deps = concat $ snd $ unzip $ filter ((== out) . fst) depContents
srcs = filter ("//*hs" ?==) deps -- TODO: handle *.c sources
need deps
terseRun (Ghc stage) $ ghcArgs pkg todo way srcs (toStandard out)
forM_ allWays $ \way -> do -- TODO: optimise (too many ways in allWays)
let oPattern = "*." ++ osuf way
let hiPattern = "*." ++ hisuf way
[buildDir <//> oPattern, buildDir <//> hiPattern] |%> \out -> do
need [argListPath argListDir pkg stage, hDepFile, cDepFile]
let obj = toStandard $ out -<.> osuf way
vanillaObj = toStandard $ out -<.> "o"
-- TODO: keep only vanilla dependencies in hDepFile
hDeps <- args $ DependencyList hDepFile obj
cDeps <- args $ DependencyList cDepFile $ takeFileName vanillaObj
let hSrcs = filter ("//*hs" ?==) hDeps
cSrcs = filter ("//*.c" ?==) cDeps
-- Report impossible cases
when (null $ hSrcs ++ cSrcs)
$ redError_ $ "No source files found for "
++ toStandard out ++ "."
when (not (null hSrcs) && not (null cSrcs))
$ redError_ $ "Both c and Haskell sources found for "
++ toStandard out ++ "."
-- Build using appropriate compiler
need $ hDeps ++ cDeps
when (not $ null hSrcs)
$ terseRun (Ghc stage) $ ghcArgs pkg todo way hSrcs obj
when (not $ null cSrcs)
$ terseRun Gcc $ gccArgs pkg todo cSrcs obj
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg todo @ (stage, _, settings) =
......
......@@ -10,10 +10,10 @@ ghcArgs :: Package -> TodoItem -> Args
ghcArgs (Package name path _) (stage, dist, settings) =
let pathDist = path </> dist
buildDir = toStandard $ pathDist </> "build"
depFile = buildDir </> takeBaseName name <.> "m"
depFile = buildDir </> "haskell.deps"
in args [ arg "-M"
, packageArgs stage pathDist
, includeArgs path dist
, includeHcArgs path dist
, concatArgs ["-optP"] $ CppArgs pathDist
, productArgs ["-odir", "-stubdir", "-hidir"] buildDir
, args ["-dep-makefile", depFile <.> "new"]
......@@ -21,25 +21,79 @@ ghcArgs (Package name path _) (stage, dist, settings) =
, args $ HsArgs pathDist
, args $ pkgHsSources path dist ]
-- $(CPP) $($1_$2_MKDEPENDC_OPTS)
-- $($1_$2_$(firstword $($1_$2_WAYS))_ALL_CC_OPTS)
-- $($(basename $4)_CC_OPTS) -MM -x c $4 -MF $3.bit
--
-- $1_$2_$3_ALL_CC_OPTS = \
-- $$(WAY_$3_CC_OPTS) \
-- $$($1_$2_DIST_GCC_CC_OPTS) \
-- $$($1_$2_$3_CC_OPTS) \
-- $$($$(basename $$<)_CC_OPTS) \
-- $$($1_$2_EXTRA_CC_OPTS) \
-- $$(EXTRA_CC_OPTS)
--
-- $1_$2_DIST_CC_OPTS = \
-- $$(SRC_CC_OPTS) \
-- $$($1_CC_OPTS) \
-- -I$1/$2/build/autogen \
-- $$(foreach dir,$$(filter-out /%,$$($1_$2_INCLUDE_DIRS)),-I$1/$$(dir)) \
-- $$(foreach dir,$$(filter /%,$$($1_$2_INCLUDE_DIRS)),-I$$(dir)) \
-- $$($1_$2_CC_OPTS) \
-- $$($1_$2_CPP_OPTS) \
-- $$($1_$2_CC_INC_FLAGS) \
-- $$($1_$2_DEP_CC_OPTS) \
-- $$(SRC_CC_WARNING_OPTS)
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
gccArgs :: FilePath -> Package -> TodoItem -> Args
gccArgs sourceFile (Package _ path _) (stage, dist, _) =
let pathDist = path </> dist
buildDir = pathDist </> "build"
depFile = buildDir </> takeFileName sourceFile <.> "deps"
in args [ arg "-MM"
, args $ CcArgs pathDist
, commonCcArgs
, commonCcWarninigArgs
, pathArgs "-I" path $ IncludeDirs pathDist
, args ["-MF", toStandard depFile]
, args ["-x", "c"]
, arg $ toStandard sourceFile ]
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) =
let buildDir = toStandard $ path </> dist </> "build"
in
(buildDir </> takeBaseName name <.> "m") %> \out -> do
buildRule pkg @ (Package name path _) todo @ (stage, dist, settings) = do
let pathDist = path </> dist
buildDir = pathDist </> "build"
hDepFile = buildDir </> "haskell.deps"
cDepFile = buildDir </> "c.deps"
hDepFile %> \out -> do
need [argListPath argListDir pkg stage]
terseRun (Ghc stage) $ ghcArgs pkg todo
-- Avoid rebuilding dependecies of out if it hasn't changed:
-- Note: cannot use copyFileChanged as it depends on the source file
deps <- liftIO $ readFile $ out <.> "new"
writeFileChanged out deps
removeFilesAfter "." [out <.> "new"]
liftIO $ removeFiles "." [out <.> "new"]
cDepFile %> \out -> do
need [argListPath argListDir pkg stage]
srcs <- args $ CSrcs pathDist
deps <- fmap concat $ forM srcs $ \src -> do
let srcPath = path </> src
depFile = buildDir </> takeFileName src <.> "deps"
terseRun Gcc $ gccArgs srcPath pkg todo
liftIO $ readFile depFile
writeFileChanged out deps
liftIO $ removeFiles buildDir ["*.c.deps"]
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg todo @ (stage, _, _) =
(argListPath argListDir pkg stage) %> \out -> do
need $ ["shake/src/Package/Dependencies.hs"] ++ sourceDependecies
ghcList <- argList (Ghc stage) $ ghcArgs pkg todo
writeFileChanged out ghcList
gccList <- argList Gcc $ gccArgs "source.c" pkg todo
writeFileChanged out $ ghcList ++ "\n" ++ gccList
buildPackageDependencies :: Package -> TodoItem -> Rules ()
buildPackageDependencies = argListRule <> buildRule
......@@ -17,24 +17,26 @@ arRule pkg @ (Package _ path _) todo @ (stage, dist, _) =
in
(buildDir <//> "*a") %> \out -> do
let way = detectWay $ tail $ takeExtension out
depObjs <- pkgDepObjects path dist way
need $ [argListPath argListDir pkg stage] ++ depObjs
libObjs <- pkgLibObjects path dist stage way
depHsObjs <- pkgDepHsObjects path dist way
cObjs <- pkgCObjects path dist way
need $ [argListPath argListDir pkg stage] ++ depHsObjs ++ cObjs
libHsObjs <- pkgLibHsObjects path dist stage way
liftIO $ removeFiles "." [out]
-- Splitting argument list into chunks as otherwise Ar chokes up
maxChunk <- argSizeLimit
forM_ (chunksOfSize maxChunk libObjs) $ \os -> do
forM_ (chunksOfSize maxChunk $ libHsObjs ++ cObjs) $ \os -> do
terseRun Ar $ arArgs os $ toStandard out
ldArgs :: Package -> TodoItem -> FilePath -> Args
ldArgs (Package _ path _) (stage, dist, _) result = do
depObjs <- pkgDepObjects path dist vanilla
need depObjs
hObjs <- pkgDepHsObjects path dist vanilla
cObjs <- pkgCObjects path dist vanilla
need $ hObjs ++ cObjs
args [ args $ ConfLdLinkerArgs stage
, arg "-r"
, arg "-o"
, arg result
, args depObjs ]
, args $ hObjs ++ cObjs ]
ldRule :: Package -> TodoItem -> Rules ()
ldRule pkg @ (Package name path _) todo @ (stage, dist, _) =
......@@ -44,10 +46,10 @@ ldRule pkg @ (Package name path _) todo @ (stage, dist, _) =
priority 2 $ (buildDir </> "*.o") %> \out -> do
need [argListPath argListDir pkg stage]
terseRun Ld $ ldArgs pkg todo $ toStandard out
synopsis <- unwords <$> arg (Synopsis pathDist)
putColoured Vivid Green $ "/--------\n| Successfully built package "
synopsis <- dropWhileEnd isPunctuation <$> showArg (Synopsis pathDist)
putColoured Green $ "/--------\n| Successfully built package "
++ name ++ " (stage " ++ show stage ++ ")."
putColoured Vivid Green $ "| Package synopsis: " ++ synopsis ++ "."
putColoured Green $ "| Package synopsis: " ++ synopsis ++ "."
++ "\n\\--------"
argListRule :: Package -> TodoItem -> Rules ()
......@@ -57,14 +59,13 @@ argListRule pkg @ (Package _ path _) todo @ (stage, dist, settings) =
ways' <- ways settings
ldList <- argList Ld (ldArgs pkg todo "output.o")
arList <- forM ways' $ \way -> do
depObjs <- pkgDepObjects path dist way
need depObjs
libObjs <- pkgLibObjects path dist stage way
cObjs <- pkgCObjects path dist way
libHsObjs <- pkgLibHsObjects path dist stage way
extension <- libsuf way
argListWithComment
("way '" ++ tag way ++ "'")
Ar
(arArgs libObjs $ "output" <.> extension)
(arArgs (libHsObjs ++ cObjs) $ "output" <.> extension)
writeFileChanged out $ unlines $ [ldList] ++ arList
buildPackageLibrary :: Package -> TodoItem -> Rules ()
......
......@@ -6,25 +6,25 @@ import Base
-- TODO: this should eventually be removed and replaced by the top-level
-- target, i.e. GHC (and perhaps, something else)
libraryPackagesInStage :: Stage -> [String]
libraryPackagesInStage Stage0 =
[ "bin-package-db"
, "binary"
, "hoopl"
, "hpc"
, "transformers" ]
libraryPackagesInStage Stage1 =
libraryPackagesInStage Stage0 ++
[ "array"
, "deepseq"
, "Cabal/Cabal"
, "containers"
, "filepath"
, "parallel"
, "pretty"
, "stm"
, "template-haskell" ]
libraryPackagesInStage Stage0 = []
--[ "bin-package-db"
--, "binary"
--, "hoopl"
--, "hpc"
--, "transformers" ]
libraryPackagesInStage Stage1 = ["directory", "bytestring"]
--libraryPackagesInStage Stage0 ++
--[ "array"
--, "deepseq"
--, "Cabal/Cabal"
--, "containers"
--, "filepath"
--, "parallel"
--, "pretty"
--, "stm"
--, "template-haskell" ]
libraryPackagesInStage _ = []
libraryPackages :: [String]
libraryPackages = concatMap libraryPackagesInStage [Stage0 ..]
libraryPackages = nub $ concatMap libraryPackagesInStage [Stage0 ..]
......@@ -130,6 +130,7 @@ dropDynamic way
-- Detect way from a given extension. Fail if the result is not unique.
-- TODO: This may be slow -- optimise if overhead is significant.
-- TODO: No longer needed -- remove?
detectWay :: FilePath -> Way
detectWay extension =
let prefix = reverse $ dropWhile (/= '_') $ reverse extension
......
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