[commit: ghc] wip/nfs-locking: Clean up code. (28e3a26)

git at git.haskell.org git at git.haskell.org
Thu Oct 26 23:21:47 UTC 2017


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

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

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

commit 28e3a26cbaa18b6efc353d543843efd1efb311f0
Author: Andrey Mokhov <andrey.mokhov at gmail.com>
Date:   Thu Sep 24 05:47:46 2015 +0100

    Clean up code.


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

28e3a26cbaa18b6efc353d543843efd1efb311f0
 src/Predicates.hs                 | 15 +++++----------
 src/Settings/Builders/GhcCabal.hs | 18 +++++++++---------
 src/Settings/Builders/Hsc2Hs.hs   |  2 +-
 src/Settings/Packages.hs          |  8 ++++----
 4 files changed, 19 insertions(+), 24 deletions(-)

diff --git a/src/Predicates.hs b/src/Predicates.hs
index 00c12ca..13482b7 100644
--- a/src/Predicates.hs
+++ b/src/Predicates.hs
@@ -43,7 +43,7 @@ stage2 :: Predicate
 stage2 = stage Stage2
 
 notStage0 :: Predicate
-notStage0 = fmap not stage0
+notStage0 = notM stage0
 
 -- TODO: Actually, we don't register compiler in some circumstances -- fix.
 registerPackage :: Predicate
@@ -51,12 +51,7 @@ registerPackage = return True
 
 splitObjects :: Predicate
 splitObjects = do
-    goodStage <- notStage0 -- We don't split bootstrap (stage 0) packages
-    goodPkg   <- fmap not $ package compiler -- We don't split compiler
-    broken    <- getFlag SplitObjectsBroken
-    ghcUnreg  <- getFlag GhcUnregisterised
-    goodArch  <- lift $ targetArchs [ "i386", "x86_64", "powerpc", "sparc" ]
-    goodOs    <- lift $ targetOss   [ "mingw32", "cygwin32", "linux", "darwin"
-                                    , "solaris2", "freebsd", "dragonfly"
-                                    , "netbsd", "openbsd" ]
-    return $ goodStage && goodPkg && not broken && not ghcUnreg && goodArch && goodOs
+    goodStage   <- notStage0 -- We don't split bootstrap (stage 0) packages
+    goodPackage <- notM $ package compiler -- We don't split compiler
+    supported   <- lift supportsSplitObjects
+    return $ goodStage && goodPackage && supported
diff --git a/src/Settings/Builders/GhcCabal.hs b/src/Settings/Builders/GhcCabal.hs
index ab65a51..54452d8 100644
--- a/src/Settings/Builders/GhcCabal.hs
+++ b/src/Settings/Builders/GhcCabal.hs
@@ -101,12 +101,12 @@ ccArgs = validating ? ccWarnings
 -- TODO: should be in a different file
 ccWarnings :: Args
 ccWarnings = do
-    let notClang = fmap not gccIsClang
+    let gccGe46 = notM $ (flag GccIsClang ||^ flag GccLt46)
     mconcat [ arg "-Werror"
             , arg "-Wall"
-            , gccIsClang ? arg "-Wno-unknown-pragmas"
-            , notClang ? gccGe46 ? notWindowsHost ? arg "-Werror=unused-but-set-variable"
-            , notClang ? gccGe46 ? arg "-Wno-error=inline" ]
+            , flag GccIsClang ? arg "-Wno-unknown-pragmas"
+            , gccGe46 ? notM windowsHost ? arg "-Werror=unused-but-set-variable"
+            , gccGe46 ? arg "-Wno-error=inline" ]
 
 ldArgs :: Args
 ldArgs = mempty
@@ -147,10 +147,10 @@ customPackageArgs = do
           mconcat [ arg $ "--ghc-option=-DSTAGE=" ++ show nextStage
                   , arg $ "--flags=stage" ++ show nextStage
                   , arg "--disable-library-for-ghci"
-                  , targetOs "openbsd" ? arg "--ld-options=-E"
+                  , anyTargetOs ["openbsd"] ? arg "--ld-options=-E"
                   , flag GhcUnregisterised ? arg "--ghc-option=-DNO_REGS"
-                  , fmap not ghcWithSMP ? arg "--ghc-option=-DNOSMP"
-                  , fmap not ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
+                  , notM ghcWithSMP ? arg "--ghc-option=-DNOSMP"
+                  , notM ghcWithSMP ? arg "--ghc-option=-optc-DNOSMP"
                   , (threaded `elem` rtsWays) ?
                     notStage0 ? arg "--ghc-option=-optc-DTHREADED_RTS"
                   , ghcWithNativeCodeGen ? arg "--flags=ncg"
@@ -158,7 +158,7 @@ customPackageArgs = do
                     notStage0 ? arg "--flags=ghci"
                   , ghcWithInterpreter ?
                     ghcEnableTablesNextToCode ?
-                    fmap not (flag GhcUnregisterised) ?
+                    notM (flag GhcUnregisterised) ?
                     notStage0 ? arg "--ghc-option=-DGHCI_TABLES_NEXT_TO_CODE"
                   , ghcWithInterpreter ?
                     ghciWithDebugger ?
@@ -183,7 +183,7 @@ withBuilderKey b = case b of
 -- Expression 'with Gcc' appends "--with-gcc=/path/to/gcc" and needs Gcc.
 with :: Builder -> Args
 with b = specified b ? do
-    path <- lift $ builderPath b
+    path <- getBuilderPath b
     lift $ needBuilder laxDependencies b
     append [withBuilderKey b ++ path]
 
diff --git a/src/Settings/Builders/Hsc2Hs.hs b/src/Settings/Builders/Hsc2Hs.hs
index fae7c1f..7dfe286 100644
--- a/src/Settings/Builders/Hsc2Hs.hs
+++ b/src/Settings/Builders/Hsc2Hs.hs
@@ -24,7 +24,7 @@ hsc2HsArgs = builder Hsc2Hs ? do
                else getSetting ProjectVersionInt
     mconcat [ arg $ "--cc=" ++ ccPath
             , arg $ "--ld=" ++ ccPath
-            , notWindowsHost ? arg "--cross-safe"
+            , notM windowsHost ? arg "--cross-safe"
             , append $ map ("-I"       ++) gmpDirs
             , append $ map ("--cflag=" ++) cFlags
             , append $ map ("--lflag=" ++) lFlags
diff --git a/src/Settings/Packages.hs b/src/Settings/Packages.hs
index 87f293d..dee0c95 100644
--- a/src/Settings/Packages.hs
+++ b/src/Settings/Packages.hs
@@ -17,7 +17,7 @@ defaultPackages = mconcat
 packagesStage0 :: Packages
 packagesStage0 = mconcat
     [ append [ binPackageDb, binary, cabal, compiler, hoopl, hpc, transformers ]
-    , notWindowsHost ? notTargetOs "ios" ? append [terminfo] ]
+    , notM windowsHost ? notM (anyHostOs ["ios"]) ? append [terminfo] ]
 
 -- TODO: what do we do with parallel, stm, random, primitive, vector and dph?
 packagesStage1 :: Packages
@@ -26,9 +26,9 @@ packagesStage1 = mconcat
     , append [ array, base, bytestring, containers, deepseq, directory
              , filepath, ghcPrim, haskeline, integerLibrary, pretty, process
              , templateHaskell, time ]
-    , windowsHost    ? append [win32]
-    , notWindowsHost ? append [unix]
-    , buildHaddock   ? append [xhtml] ]
+    , windowsHost      ? append [win32]
+    , notM windowsHost ? append [unix]
+    , buildHaddock     ? append [xhtml] ]
 
 knownPackages :: [Package]
 knownPackages = defaultKnownPackages ++ userKnownPackages



More information about the ghc-commits mailing list