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

Move derived predicates around.

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