Commit 098d9c1e authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Implement compilePackage build rule.

parent 12cecf14
{-# LANGUAGE NoImplicitPrelude #-}
module Package.Compile (buildPackageCompile) where
import Package.Base
argListDir :: FilePath
argListDir = "shake/arg/buildPackageCompile"
suffixArgs :: Way -> Args
suffixArgs way =
return ["-hisuf", hisuf way, "-osuf", osuf way, "-hcsuf", hcsuf way]
ghcArgs :: Package -> TodoItem -> Way -> [FilePath] -> FilePath -> Args
ghcArgs (Package _ path _ _) (stage, dist, _) way srcs result =
let pathDist = path </> dist
buildDir = unifyPath $ pathDist </> "build"
in args [ suffixArgs way
, wayHcArgs way
, args SrcHcArgs
, packageArgs stage pathDist
, includeGhcArgs path dist
, concatArgs ["-optP"] $ CppArgs pathDist
, args $ HsArgs pathDist
-- TODO: now we have both -O and -O2
-- <> arg ["-O2"]
, productArgs ["-odir", "-hidir", "-stubdir"] [buildDir]
, when (splitObjects stage) $ arg "-split-objs"
, args ("-c":srcs)
, args ["-o", result] ]
gccArgs :: Package -> TodoItem -> [FilePath] -> FilePath -> Args
gccArgs (Package _ path _ _) (_, dist, settings) srcs result =
let pathDist = path </> dist
in args [ args $ CcArgs pathDist
, commonCcArgs
, customCcArgs settings
, commonCcWarninigArgs
, includeGccArgs path dist
, args ("-c":srcs)
, args ["-o", result] ]
compileC :: Package -> TodoItem -> [FilePath] -> FilePath -> Action ()
compileC pkg todo @ (stage, _, _) deps obj = do
need deps
let srcs = filter ("//*.c" ?==) deps
run (Gcc stage) $ gccArgs pkg todo srcs obj
compileHaskell :: Package -> TodoItem -> FilePath -> Way -> Action ()
compileHaskell pkg @ (Package _ path _ _) todo @ (stage, dist, _) obj way = do
let buildDir = unifyPath $ path </> dist </> "build"
-- TODO: keep only vanilla dependencies in 'haskell.deps'
deps <- args $ DependencyList (buildDir </> "haskell.deps") obj
let srcs = filter ("//*hs" ?==) deps
need deps
run (Ghc stage) $ ghcArgs pkg todo way srcs obj
buildRule :: Package -> TodoItem -> Rules ()
buildRule pkg @ (Package name path _ _) todo @ (stage, dist, _) =
let buildDir = unifyPath $ path </> dist </> "build"
cDepFile = buildDir </> "c.deps"
in
forM_ allWays $ \way -> do -- TODO: optimise (too many ways in allWays)
let oPattern = "*." ++ osuf way
let hiPattern = "*." ++ hisuf way
(buildDir <//> hiPattern) %> \hi -> do
let obj = hi -<.> osuf way
-- TODO: Understand why 'need [obj]' doesn't work, leading to
-- recursive rules error. Below is a workaround.
-- putColoured Yellow $ "Hi " ++ hi
compileHaskell pkg todo obj way
(buildDir <//> oPattern) %> \obj -> do
let vanillaObjName = takeFileName obj -<.> "o"
cDeps <- args $ DependencyList cDepFile vanillaObjName
if null cDeps
then compileHaskell pkg todo obj way
else compileC pkg todo cDeps obj
-- Finally, record the argument list
need [argListPath argListDir pkg stage]
argListRule :: Package -> TodoItem -> Rules ()
argListRule pkg todo @ (stage, _, settings) =
(argListPath argListDir pkg stage) %> \out -> do
need $ ["shake/src/Package/Compile.hs"] ++ sourceDependecies
ways' <- ways settings
ghcList <- forM ways' $ \way ->
argListWithComment
("way '" ++ tag way ++ "'")
(Ghc stage)
(ghcArgs pkg todo way ["input.hs"] $ "output" <.> osuf way)
gccList <- forM ways' $ \way ->
argListWithComment
("way '" ++ tag way ++ "'")
(Gcc stage)
(gccArgs pkg todo ["input.c"] $ "output" <.> osuf way)
writeFileChanged out $ unlines ghcList ++ "\n" ++ unlines gccList
buildPackageCompile :: Package -> TodoItem -> Rules ()
buildPackageCompile = argListRule <> buildRule
module Rules.Compile (compilePackage) where
import Way
import Base
import Util
import Builder
import Expression
import qualified Target
import Oracles.DependencyList
import Settings.Ways
import Settings.TargetDirectory
import Rules.Actions
import Rules.Resources
compilePackage :: Resources -> StagePackageTarget -> Rules ()
compilePackage _ target = do
let stage = Target.stage target
pkg = Target.package target
path = targetPath stage pkg
buildPath = path -/- "build"
cDepsFile = buildPath -/- "c.deps"
hDepsFile = buildPath -/- "haskell.deps"
forM_ knownWays $ \way -> do
(buildPath <//> "*." ++ hisuf way) %> \hi -> do
let obj = hi -<.> osuf way
need [obj]
(buildPath <//> "*." ++ osuf way) %> \obj -> do
let vanillaObjName = takeFileName obj -<.> "o"
cDeps <- dependencyList cDepsFile vanillaObjName
hDeps <- dependencyList hDepsFile obj
let hSrcDeps = filter ("//*hs" ?==) hDeps
when (null cDeps && null hDeps) $
putError_ $ "Cannot determine sources for '" ++ obj ++ "'."
if null cDeps
then build $ fullTargetWithWay target hSrcDeps (Ghc stage) way [obj]
else build $ fullTarget target cDeps (Gcc stage) [obj]
......@@ -3,8 +3,9 @@ module Rules.Package (buildPackage) where
import Base
import Expression
import Rules.Data
import Rules.Compile
import Rules.Resources
import Rules.Dependencies
buildPackage :: Resources -> StagePackageTarget -> Rules ()
buildPackage = buildPackageData <> buildPackageDependencies
buildPackage = buildPackageData <> buildPackageDependencies <> compilePackage
module Settings.Gcc (gccArgs, includeGccArgs) where
import Base
import Util
import Builder
import Expression
import Oracles.PackageData
import Settings.Util
gccArgs :: Args
gccArgs = stagedBuilder Gcc ? do
path <- getTargetPath
file <- getFile
deps <- getDependencies
ccArgs <- getPkgDataList CcArgs
mconcat [ append ccArgs
, includeGccArgs
, arg "-c"
, append $ filter ("//*.c" ?==) deps
, arg "-o"
, arg file ]
includeGccArgs :: Args
includeGccArgs = do
path <- getTargetPath
pkgPath <- getPackagePath
pkg <- getPackage
iDirs <- getPkgDataList IncludeDirs
dDirs <- getPkgDataList DepIncludeDirs
mconcat
[ arg $ "-I" ++ path -/- "build/autogen"
, append . map (\dir -> "-I" ++ pkgPath -/- dir) $ iDirs ++ dDirs ]
module Settings.GccM (gccMArgs) where
import Util
import Builder
import Expression
import Oracles.PackageData
import Settings.Gcc
import Settings.Util
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
......@@ -23,14 +23,3 @@ gccMArgs = stagedBuilder GccM ? do
, arg "-x"
, arg "c"
, arg src ]
includeGccArgs :: Args
includeGccArgs = do
path <- getTargetPath
pkgPath <- getPackagePath
pkg <- getPackage
iDirs <- getPkgDataList IncludeDirs
dDirs <- getPkgDataList DepIncludeDirs
mconcat
[ arg $ "-I" ++ path -/- "build/autogen"
, append . map (\dir -> "-I" ++ pkgPath -/- dir) $ iDirs ++ dDirs ]
module Settings.Ghc (ghcArgs, packageGhcArgs, includeGhcArgs) where
import Way
import Util
import Stage
import Builder
import Switches
import Expression
import Oracles.Flag
import Oracles.PackageData
import Settings.Util
ghcArgs :: Args
ghcArgs = stagedBuilder Ghc ? do
way <- getWay
hsArgs <- getPkgDataList HsArgs
cppArgs <- getPkgDataList CppArgs
srcs <- getDependencies
file <- getFile
path <- getTargetPath
let buildPath = path -/- "build"
mconcat
[ arg "-hisuf", arg $ hisuf way
, arg "-osuf" , arg $ osuf way
, arg "-hcsuf", arg $ hcsuf way
, wayHcArgs
, packageGhcArgs
, includeGhcArgs
, append hsArgs
, append . map ("-optP" ++) $ cppArgs
, arg "-odir" , arg buildPath
, arg "-stubdir", arg buildPath
, arg "-hidir" , arg buildPath
, splitObjects ? arg "-split-objs"
, arg "-no-user-package-db" -- TODO: is this needed?
, arg "-rtsopts" -- TODO: is this needed?
, arg "-c", append srcs
, arg "-o", arg file ]
-- TODO: do '-ticky' in all debug ways?
wayHcArgs :: Args
wayHcArgs = do
way <- getWay
mconcat [ if (Dynamic `wayUnit` way)
then append ["-fPIC", "-dynamic"]
else arg "-static"
, (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS"
, (Debug `wayUnit` way) ? arg "-optc-DDEBUG"
, (Profiling `wayUnit` way) ? arg "-prof"
, (Logging `wayUnit` way) ? arg "-eventlog"
, (Parallel `wayUnit` way) ? arg "-parallel"
, (GranSim `wayUnit` way) ? arg "-gransim"
, (way == debug || way == debugDynamic) ?
append ["-ticky", "-DTICKY_TICKY"] ]
packageGhcArgs :: Args
packageGhcArgs = do
stage <- getStage
supportsPackageKey <- getFlag SupportsPackageKey
pkgKey <- getPkgData PackageKey
pkgDepKeys <- getPkgDataList DepKeys
pkgDeps <- getPkgDataList Deps
mconcat
[ arg "-hide-all-packages"
, arg "-no-user-package-db"
, arg "-include-pkg-deps"
, stage0 ? arg "-package-db libraries/bootstrapping.conf"
, if supportsPackageKey || stage /= Stage0
then mconcat [ arg $ "-this-package-key " ++ pkgKey
, append . map ("-package-key " ++) $ pkgDepKeys ]
else mconcat [ arg $ "-package-name" ++ pkgKey
, append . map ("-package " ++) $ pkgDeps ]]
includeGhcArgs :: Args
includeGhcArgs = do
path <- getTargetPath
pkgPath <- getPackagePath
srcDirs <- getPkgDataList SrcDirs
incDirs <- getPkgDataList IncludeDirs
cppArgs <- getPkgDataList CppArgs
let buildPath = path -/- "build"
autogenPath = buildPath -/- "autogen"
mconcat
[ arg "-i"
, append . map (\dir -> "-i" ++ pkgPath -/- dir) $ srcDirs
, arg $ "-i" ++ buildPath
, arg $ "-i" ++ autogenPath
, arg $ "-I" ++ buildPath
, arg $ "-I" ++ autogenPath
, append . map (\dir -> "-I" ++ pkgPath -/- dir) $ incDirs
, arg "-optP-include", arg $ "-optP" ++ autogenPath -/- "cabal_macros.h"
, append . map ("-optP" ++) $ cppArgs ]
......@@ -2,12 +2,10 @@ module Settings.GhcM (ghcMArgs) where
import Way
import Util
import Stage
import Builder
import Switches
import Expression
import Oracles.Flag
import Oracles.PackageData
import Settings.Ghc
import Settings.Util
import Settings.Ways
......@@ -23,52 +21,13 @@ ghcMArgs = stagedBuilder GhcM ? do
[ arg "-M"
, packageGhcArgs
, includeGhcArgs
, append hsArgs
, append . map ("-optP" ++) $ cppArgs
, arg "-odir" , arg buildPath
, arg "-stubdir" , arg buildPath
, arg "-hidir" , arg buildPath
, arg "-dep-makefile", arg $ buildPath -/- "haskell.deps"
, append . concatMap (\way -> ["-dep-suffix", wayPrefix way]) $ ways
, append hsArgs
, arg "-no-user-package-db" -- TODO: is this needed?
, arg "-rtsopts" -- TODO: is this needed?
, append hsSrcs ]
packageGhcArgs :: Args
packageGhcArgs = do
stage <- getStage
supportsPackageKey <- getFlag SupportsPackageKey
pkgKey <- getPkgData PackageKey
pkgDepKeys <- getPkgDataList DepKeys
pkgDeps <- getPkgDataList Deps
mconcat
[ arg "-hide-all-packages"
, arg "-no-user-package-db"
, arg "-include-pkg-deps"
, stage0 ? arg "-package-db libraries/bootstrapping.conf"
, if supportsPackageKey || stage /= Stage0
then mconcat [ arg $ "-this-package-key " ++ pkgKey
, append . map ("-package-key " ++) $ pkgDepKeys ]
else mconcat [ arg $ "-package-name" ++ pkgKey
, append . map ("-package " ++) $ pkgDeps ]]
includeGhcArgs :: Args
includeGhcArgs = do
path <- getTargetPath
pkgPath <- getPackagePath
srcDirs <- getPkgDataList SrcDirs
incDirs <- getPkgDataList IncludeDirs
cppArgs <- getPkgDataList CppArgs
let buildPath = path -/- "build"
autogenPath = buildPath -/- "autogen"
mconcat
[ arg "-i"
, append . map (\dir -> "-i" ++ pkgPath -/- dir) $ srcDirs
, arg $ "-i" ++ buildPath
, arg $ "-i" ++ autogenPath
, arg $ "-I" ++ buildPath
, arg $ "-I" ++ autogenPath
, append . map (\dir -> "-I" ++ pkgPath -/- dir) $ incDirs
, arg "-optP-include", arg $ "-optP" ++ autogenPath -/- "cabal_macros.h"
, append . map ("-optP" ++) $ cppArgs ]
......@@ -146,18 +146,3 @@ needBuilder ghc @ (Ghc stage) = do
needBuilder builder = do
path <- builderPath builder
need [path]
-- TODO: do '-ticky' in all debug ways?
-- wayHcArgs :: Way -> Args
-- wayHcArgs (Way _ units) = args
-- [ if (Dynamic `elem` units)
-- then args ["-fPIC", "-dynamic"]
-- else arg "-static"
-- , when (Threaded `elem` units) $ arg "-optc-DTHREADED_RTS"
-- , when (Debug `elem` units) $ arg "-optc-DDEBUG"
-- , when (Profiling `elem` units) $ arg "-prof"
-- , when (Logging `elem` units) $ arg "-eventlog"
-- , when (Parallel `elem` units) $ arg "-parallel"
-- , when (GranSim `elem` units) $ arg "-gransim"
-- , when (units == [Debug] || units == [Debug, Dynamic]) $
-- args ["-ticky", "-DTICKY_TICKY"] ]
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