[commit: ghc] wip/nfs-locking: Remove notP and (??) Predicate functions. (88fa774)

git at git.haskell.org git at git.haskell.org
Fri Oct 27 00:06:33 UTC 2017


Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nfs-locking
Link       : http://ghc.haskell.org/trac/ghc/changeset/88fa774add49f09b3ccac966c85c49458275a5c6/ghc

>---------------------------------------------------------------

commit 88fa774add49f09b3ccac966c85c49458275a5c6
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Sat Aug 22 21:40:24 2015 +0100

    Remove notP and (??) Predicate functions.


>---------------------------------------------------------------

88fa774add49f09b3ccac966c85c49458275a5c6
 src/Expression.hs                 | 12 ++++--------
 src/Predicates.hs                 |  6 +++---
 src/Settings/Builders/GhcCabal.hs | 15 +++++++--------
 3 files changed, 14 insertions(+), 19 deletions(-)

diff --git a/src/Expression.hs b/src/Expression.hs
index e62acf0..d84fb2c 100644
--- a/src/Expression.hs
+++ b/src/Expression.hs
@@ -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
diff --git a/src/Predicates.hs b/src/Predicates.hs
index 8743881..5bc0aed 100644
--- a/src/Predicates.hs
+++ b/src/Predicates.hs
@@ -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" ]
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index 11529bf..1925daf 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -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 ?



More information about the ghc-commits mailing list