Commit 88fa774a authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Remove notP and (??) Predicate functions.

parent a4c1ebab
......@@ -7,7 +7,7 @@ module Expression (
module Stage,
module Way,
Expr, DiffExpr, fromDiffExpr,
Predicate, (?), (??), notP, applyPredicate,
Predicate, (?), applyPredicate,
Args, Ways, Packages,
apply, append, appendM, remove,
appendSub, appendSubD, filterSub, removeSub,
......@@ -63,7 +63,7 @@ append x = apply (<> x)
-- 3) remove given elements from a list expression
remove :: Eq a => [a] -> DiffExpr [a]
remove xs = apply . filter $ (`notElem` xs)
remove xs = apply $ filter (`notElem` xs)
-- 4) apply a predicate to an expression
applyPredicate :: Monoid a => Predicate -> Expr a -> Expr a
......@@ -74,25 +74,21 @@ applyPredicate predicate expr = do
-- A convenient operator for predicate application
class PredicateLike a where
(?) :: Monoid m => a -> Expr m -> Expr m
notP :: a -> Predicate
infixr 8 ?
instance PredicateLike Predicate where
(?) = applyPredicate
notP = liftM not
instance PredicateLike Bool where
(?) = applyPredicate . return
notP = return . not
instance PredicateLike (Action Bool) where
(?) = applyPredicate . lift
notP = lift . fmap not
-- An equivalent of if-then-else for predicates
(??) :: (PredicateLike a, Monoid m) => a -> (Expr m, Expr m) -> Expr m
p ?? (t, f) = p ? t <> notP p ? f
-- (??) :: (PredicateLike a, Monoid m) => a -> (Expr m, Expr m) -> Expr m
-- p ?? (t, f) = p ? t <> notP p ? f
-- A monadic version of append
appendM :: Monoid a => Action a -> DiffExpr a
......
......@@ -40,10 +40,10 @@ stage2 :: Predicate
stage2 = stage Stage2
notStage :: Stage -> Predicate
notStage = notP . stage
notStage = liftM not . stage
notStage0 :: Predicate
notStage0 = notP stage0
notStage0 = liftM not stage0
-- TODO: Actually, we don't register compiler in some circumstances -- fix.
registerPackage :: Predicate
......@@ -52,7 +52,7 @@ registerPackage = return True
splitObjects :: Predicate
splitObjects = do
goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages
goodPkg <- notP $ package compiler -- We don't split compiler
goodPkg <- liftM not $ package compiler -- We don't split compiler
broken <- lift $ flag SplitObjectsBroken
ghcUnreg <- lift $ flag GhcUnregisterised
goodArch <- lift $ targetArchs [ "i386", "x86_64", "powerpc", "sparc" ]
......
......@@ -102,13 +102,12 @@ packageConstraints = stage0 ? do
-- TODO: put all validating options together in one file
ccArgs :: Args
ccArgs = validating ? do
let gccGe46 = notP gccLt46
let notClang = fmap not gccIsClang
mconcat [ arg "-Werror"
, arg "-Wall"
, gccIsClang ??
( arg "-Wno-unknown-pragmas" <>
gccGe46 ? windowsHost ? arg "-Werror=unused-but-set-variable"
, gccGe46 ? arg "-Wno-error=inline" )]
, gccIsClang ? arg "-Wno-unknown-pragmas"
, notClang ? gccGe46 ? notWindowsHost ? arg "-Werror=unused-but-set-variable"
, notClang ? gccGe46 ? arg "-Wno-error=inline" ]
ldArgs :: Args
ldArgs = mempty
......@@ -151,8 +150,8 @@ customPackageArgs = do
, arg "--disable-library-for-ghci"
, targetOs "openbsd" ? arg "--ld-options=-E"
, flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
, notP ghcWithSMP ? arg "--ghc-option=-DNOSMP"
, notP ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
, fmap not ghcWithSMP ? arg "--ghc-option=-DNOSMP"
, fmap not ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
, (threaded `elem` rtsWays) ?
notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
, ghcWithNativeCodeGen ? arg "--flags=ncg"
......@@ -160,7 +159,7 @@ customPackageArgs = do
notStage0 ? arg "--flags=ghci"
, ghcWithInterpreter ?
ghcEnableTablesNextToCode ?
notP (flag GhcUnregisterised) ?
fmap not (flag GhcUnregisterised) ?
notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
, ghcWithInterpreter ?
ghciWithDebugger ?
......
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