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

Clean up code, do renaming.

parent 4914709c
......@@ -10,7 +10,7 @@ module Expression (
appendSub, appendSubD, filterSub, removeSub,
interpret, interpretDiff,
getStage, getPackage, getBuilder, getFiles, getFile,
getDependencies, getDependency, getWay,
getSources, getSource, getWay,
stage, package, builder, stagedBuilder, file, way
) where
......@@ -162,6 +162,20 @@ getPackage = asks Target.package
getBuilder :: Expr Builder
getBuilder = asks Target.builder
getWay :: Expr Way
getWay = asks Target.way
getSources :: Expr [FilePath]
getSources = asks Target.sources
getSource :: Expr FilePath
getSource = do
target <- ask
srcs <- getSources
case srcs of
[src] -> return src
_ -> error $ "Exactly one source expected in target " ++ show target
getFiles :: Expr [FilePath]
getFiles = asks Target.files
......@@ -174,21 +188,6 @@ getFile = do
[file] -> return file
_ -> error $ "Exactly one file expected in target " ++ show target
getDependencies :: Expr [FilePath]
getDependencies = asks Target.dependencies
getDependency :: Expr FilePath
getDependency = do
target <- ask
deps <- getDependencies
case deps of
[dep] -> return dep
_ -> error $ "Exactly one dependency expected in target "
++ show target
getWay :: Expr Way
getWay = asks Target.way
-- Basic predicates (see Switches.hs for derived predicates)
stage :: Stage -> Predicate
stage s = liftM (s ==) getStage
......
......@@ -6,7 +6,7 @@ import Util
import Builder
import Expression
import qualified Target
import Oracles.DependencyList
import Oracles.Dependencies
import Settings.TargetDirectory
import Rules.Actions
import Rules.Resources
......@@ -27,29 +27,16 @@ compilePackage _ target = do
need [ hiboot -<.> obootsuf (detectWay hiboot) ]
matchBuildResult buildPath "o" ?> \obj -> do
cDeps <- dependencyList cDepsFile (takeFileName obj -<.> "o")
if not (null cDeps)
then do -- obj is produced from a C source file
need cDeps
build $ fullTarget target cDeps (Gcc stage) [obj]
else do -- obj is produced from a Haskell source file
hDeps <- dependencyList hDepsFile obj
when (null hDeps) . putError $
"No dependencies found for '" ++ obj ++ "'."
(src, deps) <- dependencies buildPath obj
need deps
if ("//*.c" ?== src)
then build $ fullTarget target (Gcc stage) [src] [obj]
else do
let way = detectWay obj
hSrc = head hDeps
unless ("//*hs" ?== hSrc) . putError $
"No Haskell source file found for '" ++ obj ++ "'."
need hDeps
build $ fullTargetWithWay target [hSrc] (Ghc stage) way [obj]
build $ fullTargetWithWay target (Ghc stage) way [src] [obj]
matchBuildResult buildPath "o-boot" ?> \obj -> do
hDeps <- dependencyList hDepsFile obj
when (null hDeps) . putError $
"No dependencies found for '" ++ obj ++ "'."
(src, deps) <- dependencies buildPath obj
need deps
let way = detectWay obj
hSrc = head hDeps
unless ("//*.hs-boot" ?== hSrc) . putError $
"No Haskell source file found for '" ++ obj ++ "'."
need hDeps
build $ fullTargetWithWay target [hSrc] (Ghc stage) way [obj]
build $ fullTargetWithWay target (Ghc stage) way [src] [obj]
......@@ -47,12 +47,12 @@ buildPackageData (Resources ghcCabal ghcPkg) target = do
need [cabal]
buildWithResources [(ghcCabal, 1)] $
fullTarget target [cabal] GhcCabal files
fullTarget target GhcCabal [cabal] files
-- TODO: find out of ghc-cabal can be concurrent with ghc-pkg
whenM (interpret target registerPackage) .
buildWithResources [(ghcPkg, 1)] $
fullTarget target [cabal] (GhcPkg stage) files
fullTarget target (GhcPkg stage) [cabal] files
postProcessPackageData $ path -/- "package-data.mk"
......
......@@ -46,7 +46,7 @@ buildPackageLibrary _ target = do
. filter (not . all (== '.')) $ contents
else return []
build $ fullTarget target (cObjs ++ hObjs ++ splitObjs) Ar [a]
build $ fullTarget target Ar (cObjs ++ hObjs ++ splitObjs) [a]
synopsis <- interpret target $ getPkgData Synopsis
putSuccess $ "/--------\n| Successfully built package library '"
......@@ -64,4 +64,4 @@ buildPackageLibrary _ target = do
cObjs = [ buildPath -/- src -<.> "o" | src <- cSrcs ]
hObjs = [ buildPath -/- src <.> "o" | src <- hSrcs ]
need $ cObjs ++ hObjs
build $ fullTarget target (cObjs ++ hObjs) Ld [obj]
build $ fullTarget target Ld (cObjs ++ hObjs) [obj]
......@@ -8,13 +8,13 @@ import Oracles.ArgsHash
import Oracles.PackageData
import Oracles.WindowsRoot
import Oracles.PackageDeps
import Oracles.DependencyList
import Oracles.Dependencies
oracleRules :: Rules ()
oracleRules = do
configOracle -- see Oracles.Base
packageDataOracle -- see Oracles.PackageData
packageDepsOracle -- see Oracles.PackageDeps
dependencyListOracle -- see Oracles.DependencyList
dependenciesOracle -- see Oracles.Dependencies
argsHashOracle -- see Oracles.ArgsHash
windowsRootOracle -- see Oracles.WindowsRoot
......@@ -6,8 +6,8 @@ import Settings.Util
arArgs :: Args
arArgs = builder Ar ? do
objs <- getDependencies
file <- getFile
objs <- getSources
mconcat [ arg "q"
, arg file
, append objs ]
......
......@@ -12,12 +12,12 @@ gccArgs :: Args
gccArgs = stagedBuilder Gcc ? do
path <- getTargetPath
file <- getFile
deps <- getDependencies
src <- getSource
ccArgs <- getPkgDataList CcArgs
mconcat [ append ccArgs
, includeGccArgs
, arg "-c"
, append $ filter ("//*.c" ?==) deps
, arg src
, arg "-o"
, arg file ]
......@@ -26,7 +26,7 @@ gccMArgs :: Args
gccMArgs = stagedBuilder GccM ? do
path <- getTargetPath
file <- getFile
src <- getDependency
src <- getSource
ccArgs <- getPkgDataList CcArgs
mconcat
[ arg "-E"
......@@ -35,6 +35,8 @@ gccMArgs = stagedBuilder GccM ? do
, includeGccArgs
, arg "-MF"
, arg file
, arg "-MT"
, arg $ dropExtension file -<.> "o"
, arg "-x"
, arg "c"
, arg src ]
......
......@@ -22,7 +22,7 @@ ghcArgs = stagedBuilder Ghc ? do
way <- getWay
hsArgs <- getPkgDataList HsArgs
cppArgs <- getPkgDataList CppArgs
srcs <- getDependencies
srcs <- getSources
file <- getFile
path <- getTargetPath
let buildPath = path -/- "build"
......@@ -47,7 +47,8 @@ ghcArgs = stagedBuilder Ghc ? do
ghcMArgs :: Args
ghcMArgs = stagedBuilder GhcM ? do
ways <- getWays
hsSrcs <- getHsSources
file <- getFile
srcs <- getSources
hsArgs <- getPkgDataList HsArgs
cppArgs <- getPkgDataList CppArgs
path <- getTargetPath
......@@ -61,11 +62,11 @@ ghcMArgs = stagedBuilder GhcM ? do
, arg "-odir" , arg buildPath
, arg "-stubdir" , arg buildPath
, arg "-hidir" , arg buildPath
, arg "-dep-makefile", arg $ buildPath -/- "haskell.deps"
, arg "-dep-makefile", arg file
, append . concatMap (\way -> ["-dep-suffix", wayPrefix way]) $ ways
, arg "-no-user-package-db" -- TODO: is this needed?
, arg "-rtsopts" -- TODO: is this needed?
, append hsSrcs ]
, append srcs ]
-- TODO: do '-ticky' in all debug ways?
wayHcArgs :: Args
......
......@@ -8,8 +8,8 @@ import Settings.Util
ldArgs :: Args
ldArgs = builder Ld ? do
stage <- getStage
objs <- getDependencies
file <- getFile
objs <- getSources
confArgs <- getSettingList $ ConfLdLinkerArgs stage
mconcat [ append confArgs
, arg "-r"
......
......@@ -13,17 +13,17 @@ import GHC.Generics
-- Target captures all parameters relevant to the current build target:
-- * Stage and Package being built,
-- * dependencies (e.g., source files) that need to be tracked,
-- * Builder to be invoked,
-- * Way to be built (set to vanilla for most targets),
-- * source file(s) to be passed to Builder,
-- * file(s) to be produced.
data Target = Target
{
stage :: Stage,
package :: Package,
dependencies :: [FilePath],
builder :: Builder,
way :: Way,
sources :: [FilePath],
files :: [FilePath]
}
deriving (Show, Eq, Generic)
......@@ -37,9 +37,9 @@ stageTarget s = Target
{
stage = s,
package = error "stageTarget: package not set",
dependencies = error "stageTarget: dependencies not set",
builder = error "stageTarget: builder not set",
way = vanilla,
sources = error "stageTarget: sources not set",
files = error "stageTarget: files not set"
}
......@@ -52,9 +52,9 @@ stagePackageTarget s p = Target
{
stage = s,
package = p,
dependencies = error "stagePackageTarget: dependencies not set",
builder = error "stagePackageTarget: builder not set",
way = vanilla,
sources = error "stagePackageTarget: sources not set",
files = error "stagePackageTarget: files not set"
}
......@@ -62,23 +62,22 @@ stagePackageTarget s p = Target
type FullTarget = Target
-- Most targets are built only one way, vanilla, hence we set it by default.
fullTarget :: StagePackageTarget -> [FilePath] -> Builder -> [FilePath] -> FullTarget
fullTarget target deps b fs = target
fullTarget :: StagePackageTarget -> Builder -> [FilePath] -> [FilePath] -> FullTarget
fullTarget target b srcs fs = target
{
dependencies = deps,
builder = b,
way = vanilla,
sources = srcs,
files = fs
}
-- Use this function to be explicit about the build way.
fullTargetWithWay :: StagePackageTarget -> [FilePath] -> Builder -> Way
-> [FilePath] -> FullTarget
fullTargetWithWay target deps b w fs = target
fullTargetWithWay :: StagePackageTarget -> Builder -> Way -> [FilePath] -> [FilePath] -> FullTarget
fullTargetWithWay target b w srcs fs = target
{
dependencies = deps,
builder = b,
way = w,
sources = srcs,
files = fs
}
......
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