Commit 2bd0715a authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Move derived predicates around.

parent 062952ca
......@@ -8,7 +8,7 @@ module Expression (
Environment (..), defaultEnvironment,
append, appendM, remove, appendSub, appendSubD, filterSub, removeSub,
interpret, interpretDiff,
applyPredicate, (?), (??), stage, notStage, builder, notBuilder, package,
applyPredicate, (?), (??), stage, builder, package,
configKeyValue, configKeyValues,
configKeyYes, configKeyNo, configKeyNonEmpty
) where
......@@ -112,15 +112,9 @@ infixr 8 ?
stage :: Stage -> Predicate
stage s = liftM (s ==) (asks getStage)
notStage :: Stage -> Predicate
notStage = liftM not . stage
builder :: Builder -> Predicate
builder b = liftM (b ==) (asks getBuilder)
notBuilder :: Builder -> Predicate
notBuilder = liftM not . builder
package :: Package -> Predicate
package p = liftM (p ==) (asks getPackage)
......
......@@ -14,6 +14,7 @@ import Expression hiding (when, liftIO)
import Settings.Ways
import Settings.Util
import Settings.Packages
import UserSettings
cabalSettings :: Settings
cabalSettings = do
......@@ -26,11 +27,11 @@ cabalSettings = do
, with' $ Ghc stage
, with' $ GhcPkg stage
, customConfigureSettings
, Expression.stage Stage0 ? bootPackageDbSettings
, stage0 ? bootPackageDbSettings
, librarySettings
, configKeyNonEmpty "hscolour" ? with' HsColour -- TODO: generalise?
, configureSettings
, Expression.stage Stage0 ? packageConstraints
, stage0 ? packageConstraints
, with' $ Gcc stage
, notStage Stage0 ? with' Ld
, with' Ar
......@@ -58,13 +59,14 @@ librarySettings = do
configureSettings :: Settings
configureSettings = do
let conf key = appendSubD $ "--configure-option=" ++ key
let conf key = appendSubD $ "--configure-option=" ++ key
ccSettings' = ccSettings <> remove ["-Werror"]
stage <- asks getStage
mconcat
[ conf "CFLAGS" ccSettings
[ conf "CFLAGS" ccSettings'
, conf "LDFLAGS" ldSettings
, conf "CPPFLAGS" cppSettings
, appendSubD "--gcc-options" $ ccSettings <> ldSettings
, appendSubD "--gcc-options" $ ccSettings' <> ldSettings
, conf "--with-iconv-includes" $ argConfig "iconv-include-dirs"
, conf "--with-iconv-libraries" $ argConfig "iconv-lib-dirs"
, conf "--with-gmp-includes" $ argConfig "gmp-include-dirs"
......@@ -99,7 +101,6 @@ packageConstraints = do
++ cabal ++ "'."
args $ concatMap (\c -> ["--constraint", c]) $ constraints
ccSettings :: Settings
ccSettings = do
let gccGe46 = liftM not gccLt46
......
......@@ -5,16 +5,17 @@ module Settings.GhcPkg (
import Base hiding (arg, args)
import Package
import Targets
import Switches
import Expression hiding (when, liftIO)
import Settings.Util
import Settings.GhcCabal
ghcPkgSettings :: Settings
ghcPkgSettings = do
stg <- asks getStage
pkg <- asks getPackage
let dir = pkgPath pkg </> targetDirectory stg pkg
stage <- asks getStage
let dir = pkgPath pkg </> targetDirectory stage pkg
mconcat [ arg "update"
, arg "--force"
, stage Stage0 ? bootPackageDbSettings
, stage0 ? bootPackageDbSettings
, arg $ dir </> "inplace-pkg-config" ]
......@@ -15,8 +15,8 @@ packages = defaultPackages <> userPackages
-- These are the packages we build by default
defaultPackages :: Packages
defaultPackages = mconcat
[ stage Stage0 ? packagesStage0
, stage Stage1 ? packagesStage1 ]
[ stage0 ? packagesStage0
, stage1 ? packagesStage1 ]
packagesStage0 :: Packages
packagesStage0 = mconcat
......
module Switches (
buildHaddock, validating,
IntegerLibraryImpl (..), integerLibraryImpl,
notStage, stage0, stage1, stage2, notBuilder,
supportsPackageKey, targetPlatforms, targetPlatform,
targetOss, targetOs, notTargetOs,
targetArchs, dynamicGhcPrograms, ghcWithInterpreter,
......@@ -8,21 +8,32 @@ module Switches (
gccIsClang, gccLt46, windowsHost, notWindowsHost
) where
import Base
import Oracles.Builder
import Expression
-- User-defined switches
buildHaddock :: Predicate
buildHaddock = return True
validating :: Predicate
validating = return False
-- Support for multiple integer library implementations
data IntegerLibraryImpl = IntegerGmp | IntegerGmp2 | IntegerSimple
integerLibraryImpl :: IntegerLibraryImpl
integerLibraryImpl = IntegerGmp2
-- Derived predicates
notStage :: Stage -> Predicate
notStage = liftM not . stage
stage0 :: Predicate
stage0 = stage Stage0
stage1 :: Predicate
stage1 = stage Stage1
stage2 :: Predicate
stage2 = stage Stage2
notBuilder :: Builder -> Predicate
notBuilder = liftM not . builder
-- Predicates based on configuration files
supportsPackageKey :: Predicate
supportsPackageKey = configKeyYes "supports-package-key"
......
......@@ -80,12 +80,14 @@ integerLibraryCabal = case integerLibraryImpl of
IntegerSimple -> "integer-simple.cabal"
-- Custom configure settings for packages
-- TODO: check if '--flag' and '--flags' should be collections of
-- sub-arguments or not.
customConfigureSettings :: Settings
customConfigureSettings = mconcat
[ package integerLibrary ?
windowsHost ? appendSub "--configure-option" ["--with-intree-gmp"]
, package base ? appendSub "--flags" [integerLibraryName]
, package ghcPrim ? appendSub "--flag" ["include-ghc-prim"]]
, package ghcPrim ? appendSub "--flag" ["include-ghc-prim"] ]
-- Note [Cabal name weirdness]
-- Find out if we can move the contents to just Cabal/
......
module UserSettings (
userSettings, userPackages, userWays
userSettings, userPackages, userWays,
buildHaddock, validating
) where
import Base hiding (arg, args, Args)
import Oracles.Builder
import Ways
import Targets
import Switches
import Expression
-- No user-specific settings by default
......@@ -18,17 +21,24 @@ userPackages = mempty
userWays :: Ways
userWays = mempty
-- User-defined predicates
buildHaddock :: Predicate
buildHaddock = return True
validating :: Predicate
validating = return False
-- Examples:
userSettings' :: Settings
userSettings' = mconcat
[ package compiler ? stage Stage0 ? append ["foo", "bar"]
[ package compiler ? stage0 ? append ["foo", "bar"]
, builder (Ghc Stage0) ? remove ["-O2"]
, builder GhcCabal ? removeSub "--configure-option=CFLAGS" ["-Werror"] ]
, builder GhcCabal ? removeSub "--configure-option=CFLAGS" ["-Werror"] ]
userPackages' :: Packages
userPackages' = mconcat
[ stage Stage1 ? remove [cabal]
, remove [compiler] ]
[ stage1 ? remove [cabal]
, remove [compiler] ]
userWays' :: Ways
userWays' = remove [profiling]
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