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

Merge builder, stagedBuilder, builderGhc/Cc into builder.

See #223.
parent 366b35b2
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase, FlexibleInstances #-}
-- | Convenient predicates
module Predicates (
stage, package, builder, stagedBuilder, builderCc, builderGhc, file, way,
stage0, stage1, stage2, notStage0, notPackage
stage, package, builder, file, way, stage0, stage1, stage2, notStage0, notPackage
) where
import Base
......@@ -16,27 +15,19 @@ stage s = (s ==) <$> getStage
package :: Package -> Predicate
package p = (p ==) <$> getPackage
-- | Is an unstaged builder is being used such as /GhcCabal/?
builder :: Builder -> Predicate
builder b = (b ==) <$> getBuilder
-- TODO: Also add needBuilder, builderPath, etc.
-- | Is a particular builder being used?
class BuilderLike a where
builder :: a -> Predicate
-- TODO: Use type classes to unify various builder predicates (also needBuilder,
-- builderPath, etc).
-- | Is a certain builder used in the current stage?
stagedBuilder :: (Stage -> Builder) -> Predicate
stagedBuilder stageBuilder = builder . stageBuilder =<< getStage
instance BuilderLike Builder where
builder b = (b ==) <$> getBuilder
-- | Are we building with a C compiler?
builderCc :: Predicate
builderCc = getBuilder >>= \case
Cc _ _ -> return True
_ -> return False
instance BuilderLike a => BuilderLike (Stage -> a) where
builder stagedBuilder = builder . stagedBuilder =<< getStage
-- | Are we building with GHC?
builderGhc :: Predicate
builderGhc = getBuilder >>= \case
Ghc _ _ -> return True
_ -> return False
instance BuilderLike a => BuilderLike (CompilerMode -> a) where
builder compiler = anyM (builder . compiler) [Compile, FindDependencies, Link]
-- | Does any of the output files match a given pattern?
file :: FilePattern -> Predicate
......
......@@ -4,19 +4,19 @@ import Development.Shake.FilePath
import Expression
import Oracles.Config.Setting
import Oracles.PackageData
import Predicates (stagedBuilder)
import Predicates (builder)
import Settings
import Settings.Builders.Common (cIncludeArgs)
-- TODO: handle custom $1_$2_MKDEPENDC_OPTS and
ccBuilderArgs :: Args
ccBuilderArgs = mconcat
[ stagedBuilder (Cc Compile) ?
[ builder (Cc Compile) ?
mconcat [ commonCcArgs
, arg "-c", arg =<< getInput
, arg "-o", arg =<< getOutput ]
, stagedBuilder (Cc FindDependencies) ? do
, builder (Cc FindDependencies) ? do
output <- getOutput
mconcat [ arg "-E"
, arg "-MM"
......
......@@ -21,7 +21,7 @@ import Settings.Builders.Common (cIncludeArgs)
-- $$(if $$(findstring YES,$$($1_$2_DYNAMIC_TOO)),-dyno
-- $$(addsuffix .$$(dyn_osuf)-boot,$$(basename $$@)))
ghcBuilderArgs :: Args
ghcBuilderArgs = (stagedBuilder (Ghc Compile) ||^ stagedBuilder (Ghc Link)) ? do
ghcBuilderArgs = (builder (Ghc Compile) ||^ builder (Ghc Link)) ? do
needTouchy
mconcat [ commonGhcArgs
, arg "-H32m"
......@@ -31,12 +31,12 @@ ghcBuilderArgs = (stagedBuilder (Ghc Compile) ||^ stagedBuilder (Ghc Link)) ? do
, arg "-fwarn-tabs"
, splitObjectsArgs
, ghcLinkArgs
, stagedBuilder (Ghc Compile) ? arg "-c"
, builder (Ghc Compile) ? arg "-c"
, append =<< getInputs
, arg "-o", arg =<< getOutput ]
ghcLinkArgs :: Args
ghcLinkArgs = stagedBuilder (Ghc Link) ? do
ghcLinkArgs = builder (Ghc Link) ? do
stage <- getStage
libs <- getPkgDataList DepExtraLibs
gmpLibs <- if stage > Stage0
......@@ -67,7 +67,7 @@ splitObjectsArgs = splitObjects ? do
arg "-split-objs"
ghcMBuilderArgs :: Args
ghcMBuilderArgs = stagedBuilder (Ghc FindDependencies) ? do
ghcMBuilderArgs = builder (Ghc FindDependencies) ? do
ways <- getLibraryWays
mconcat [ arg "-M"
, commonGhcArgs
......
......@@ -99,7 +99,7 @@ bootPackageDbArgs = do
lift $ initialisePackageDb stage
stage0 ? do
path <- getTopDirectory
prefix <- ifM builderGhc (return "-package-db ") (return "--package-db=")
prefix <- ifM (builder Ghc) (return "-package-db ") (return "--package-db=")
arg $ prefix ++ path -/- packageDbDirectory Stage0
packageConstraints :: Args
......
......@@ -8,7 +8,7 @@ import Settings
import Settings.Builders.GhcCabal
ghcPkgBuilderArgs :: Args
ghcPkgBuilderArgs = stagedBuilder GhcPkg ? (initArgs <> updateArgs)
ghcPkgBuilderArgs = builder GhcPkg ? (initArgs <> updateArgs)
initPredicate :: Predicate
initPredicate = orM $ map (file . packageDbDirectory) [Stage0 ..]
......
module Settings.Flavours.Quick (quickFlavourArgs, quickFlavourWays) where
import Expression
import Predicates (builderGhc)
import Predicates (builder)
quickFlavourArgs :: Args
quickFlavourArgs = builderGhc ? arg "-O0"
quickFlavourArgs = builder Ghc ? arg "-O0"
quickFlavourWays :: Ways
quickFlavourWays = remove [profiling]
......@@ -5,7 +5,7 @@ import Expression
import GHC (compiler)
import Oracles.Config.Setting
import Oracles.Config.Flag
import Predicates (builder, builderGhc, package, notStage0)
import Predicates (builder, package, notStage0)
import Settings
compilerPackageArgs :: Args
......@@ -15,7 +15,7 @@ compilerPackageArgs = package compiler ? do
path <- getBuildPath
mconcat [ builder Alex ? arg "--latin1"
, builderGhc ? arg ("-I" ++ path)
, builder Ghc ? arg ("-I" ++ path)
, builder GhcCabal ? mconcat
[ arg $ "--ghc-option=-DSTAGE=" ++ show (fromEnum stage + 1)
......
......@@ -2,7 +2,7 @@ module Settings.Packages.Directory (directoryPackageArgs) where
import Expression
import GHC (directory)
import Predicates (builderCc, package)
import Predicates (builder, package)
-- TODO: I had to define symbol __GLASGOW_HASKELL__ as otherwise directory.c is
-- effectively empty. I presume it was expected that GHC will be used for
......@@ -10,4 +10,4 @@ import Predicates (builderCc, package)
-- only file which requires special treatment when using GCC.
directoryPackageArgs :: Args
directoryPackageArgs = package directory ?
builderCc ? arg "-D__GLASGOW_HASKELL__"
builder Cc ? arg "-D__GLASGOW_HASKELL__"
......@@ -3,13 +3,13 @@ module Settings.Packages.Ghc (ghcPackageArgs) where
import Expression
import GHC (ghc, compiler)
import Oracles.Config.Setting
import Predicates (builder, builderGhc, package, notStage0)
import Predicates (builder, package, notStage0)
import Settings.Paths
ghcPackageArgs :: Args
ghcPackageArgs = package ghc ? do
stage <- getStage
mconcat [ builderGhc ? mconcat
mconcat [ builder Ghc ? mconcat
[ arg $ "-I" ++ buildPath (vanillaContext stage compiler)
, arg "-no-hs-main" ]
......
......@@ -4,12 +4,12 @@ import Base
import Expression
import GHC
import Oracles.Config.Setting
import Predicates (builderGhc, package, stage0)
import Predicates (builder, package, stage0)
import Settings
ghcCabalPackageArgs :: Args
ghcCabalPackageArgs = package ghcCabal ? mconcat
[ builderGhc ?
[ builder Ghc ?
mconcat [ ghcCabalBootArgs
, remove ["-no-auto-link-packages"] ] ]
......
......@@ -3,14 +3,14 @@ module Settings.Packages.Hp2ps (hp2psPackageArgs) where
import Base
import Expression
import GHC (hp2ps)
import Predicates (builderGhc, package)
import Predicates (builder, package)
import Settings
hp2psPackageArgs :: Args
hp2psPackageArgs = package hp2ps ? do
path <- getBuildPath
let cabalMacros = path -/- "build/autogen/cabal_macros.h"
mconcat [ builderGhc ?
mconcat [ builder Ghc ?
mconcat [ arg "-no-hs-main"
, remove ["-hide-all-packages"]
, removePair "-optP-include" $ "-optP" ++ cabalMacros ] ]
......@@ -3,7 +3,7 @@ module Settings.Packages.IntegerGmp (integerGmpPackageArgs, gmpBuildPath) where
import Base
import Expression
import GHC (integerGmp)
import Predicates (builder, builderCc, package)
import Predicates (builder, package)
import Settings.Paths
import Oracles.Config.Setting
......@@ -24,4 +24,4 @@ integerGmpPackageArgs = package integerGmp ? do
, appendSub "--configure-option=CFLAGS" [includeGmp]
, appendSub "--gcc-options" [includeGmp] ]
, builderCc ? arg includeGmp ]
, builder Cc ? arg includeGmp ]
......@@ -2,8 +2,8 @@ module Settings.Packages.IservBin (iservBinPackageArgs) where
import Expression
import GHC (iservBin)
import Predicates (builderGhc, package)
import Predicates (builder, package)
iservBinPackageArgs :: Args
iservBinPackageArgs = package iservBin ? do
mconcat [ builderGhc ? arg "-no-hs-main" ]
mconcat [ builder Ghc ? arg "-no-hs-main" ]
......@@ -7,7 +7,7 @@ import Expression
import GHC (rts, rtsContext)
import Oracles.Config.Flag
import Oracles.Config.Setting
import Predicates (builder, builderCc, builderGhc, package, file)
import Predicates (builder, package, file)
import Settings
import Settings.Builders.Common
......@@ -52,7 +52,7 @@ rtsPackageArgs = package rts ? do
ffiIncludeDir <- getSetting FfiIncludeDir
ffiLibraryDir <- getSetting FfiLibDir
mconcat
[ builderCc ? mconcat
[ builder Cc ? mconcat
[ arg "-Irts"
, arg $ "-I" ++ path
, arg $ "-DRtsWay=\"rts_" ++ show way ++ "\""
......@@ -92,7 +92,7 @@ rtsPackageArgs = package rts ? do
, file "//Evac_thr.*" ? append [ "-DPARALLEL_GC", "-Irts/sm" ]
, file "//Scav_thr.*" ? append [ "-DPARALLEL_GC", "-Irts/sm" ] ]
, builderGhc ? (arg "-Irts" <> includesArgs)
, builder Ghc ? (arg "-Irts" <> includesArgs)
, builder (GhcPkg Stage1) ? mconcat
[ remove ["rts/stage1/inplace-pkg-config"] -- TODO: fix, see #113
......
......@@ -3,11 +3,11 @@ module Settings.Packages.RunGhc (runGhcPackageArgs) where
import Expression
import GHC (runGhc)
import Oracles.Config.Setting
import Predicates (builderGhc, file, package)
import Predicates (builder, file, package)
runGhcPackageArgs :: Args
runGhcPackageArgs = package runGhc ? do
version <- getSetting ProjectVersion
mconcat [ builderGhc ?
mconcat [ builder Ghc ?
file "//Main.*" ?
append ["-cpp", "-DVERSION=\"" ++ version ++ "\""] ]
......@@ -3,14 +3,14 @@ module Settings.Packages.Touchy (touchyPackageArgs) where
import Base
import Expression
import GHC (touchy)
import Predicates (builderGhc, package)
import Predicates (builder, package)
import Settings
touchyPackageArgs :: Args
touchyPackageArgs = package touchy ? do
path <- getBuildPath
let cabalMacros = path -/- "autogen/cabal_macros.h"
mconcat [ builderGhc ?
mconcat [ builder Ghc ?
mconcat [ arg "-no-hs-main"
, remove ["-hide-all-packages"]
, removePair "-optP-include" $ "-optP" ++ cabalMacros ] ]
......@@ -3,14 +3,14 @@ module Settings.Packages.Unlit (unlitPackageArgs) where
import Base
import Expression
import GHC (unlit)
import Predicates (builderGhc, package)
import Predicates (builder, package)
import Settings
unlitPackageArgs :: Args
unlitPackageArgs = package unlit ? do
path <- getBuildPath
let cabalMacros = path -/- "autogen/cabal_macros.h"
mconcat [ builderGhc ?
mconcat [ builder Ghc ?
mconcat [ arg "-no-hs-main"
, remove ["-hide-all-packages"]
, removePair "-optP-include" $ "-optP" ++ cabalMacros ] ]
......@@ -18,7 +18,7 @@ buildRootPath = ".build"
-- Control user-specific settings
userArgs :: Args
userArgs = builderGhc ? remove ["-Wall", "-fwarn-tabs"]
userArgs = builder Ghc ? remove ["-Wall", "-fwarn-tabs"]
-- Control which packages get to be built
userPackages :: Packages
......
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