Drop GccLtXX flags, require GCC > 4.7 and up (#450)
[hadrian.git] / src / Oracles / Flag.hs
index fa29415..1bd4dfe 100644 (file)
-{-# LANGUAGE TypeFamilies, FlexibleInstances, MultiParamTypeClasses #-}
-
 module Oracles.Flag (
-    module Control.Monad,
-    module Prelude,
-    Flag (..),
-    test, when, unless, not, (&&), (||)
+    Flag (..), flag, crossCompiling, platformSupportsSharedLibs,
+    ghcWithSMP, ghcWithNativeCodeGen, supportsSplitObjects
     ) where
 
-import Control.Monad hiding (when, unless)
-import qualified Prelude
-import Prelude hiding (not, (&&), (||))
+import Hadrian.Oracles.TextFile
+
 import Base
-import Util
-import Oracles.Base
+import Oracles.Setting
 
-data Flag = LaxDeps
-          | DynamicGhcPrograms
-          | GccIsClang
-          | GccLt46
+data Flag = ArSupportsAtFile
           | CrossCompiling
-          | Validating
-          | SupportsPackageKey
+          | GccIsClang
+          | GhcUnregisterised
+          | LeadingUnderscore
           | SolarisBrokenShld
           | SplitObjectsBroken
-          | GhcUnregisterised
-
--- TODO: Give the warning *only once* per key
-test :: Flag -> Action Bool
-test flag = do
-    (key, defaultValue) <- return $ case flag of
-        LaxDeps            -> ("lax-dependencies"     , False)
-        DynamicGhcPrograms -> ("dynamic-ghc-programs" , False)
-        GccIsClang         -> ("gcc-is-clang"         , False)
-        GccLt46            -> ("gcc-lt-46"            , False)
-        CrossCompiling     -> ("cross-compiling"      , False)
-        Validating         -> ("validating"           , False)
-        SupportsPackageKey -> ("supports-package-key" , False)
-        SolarisBrokenShld  -> ("solaris-broken-shld"  , False)
-        SplitObjectsBroken -> ("split-objects-broken" , False)
-        GhcUnregisterised  -> ("ghc-unregisterised"   , False)
-    let defaultString = if defaultValue then "YES" else "NO"
-    value <- askConfigWithDefault key $ -- TODO: warn just once
-        do putColoured Red $ "\nFlag '"
-                ++ key
-                ++ "' not set in configuration files. "
-                ++ "Proceeding with default value '"
-                ++ defaultString
-                ++ "'.\n"
-           return defaultString
+          | WithLibdw
+          | HaveLibMingwEx
+          | UseSystemFfi
+
+-- Note, if a flag is set to empty string we treat it as set to NO. This seems
+-- fragile, but some flags do behave like this, e.g. GccIsClang.
+flag :: Flag -> Action Bool
+flag f = do
+    let key = case f of
+            ArSupportsAtFile   -> "ar-supports-at-file"
+            CrossCompiling     -> "cross-compiling"
+            GccIsClang         -> "gcc-is-clang"
+            GhcUnregisterised  -> "ghc-unregisterised"
+            LeadingUnderscore  -> "leading-underscore"
+            SolarisBrokenShld  -> "solaris-broken-shld"
+            SplitObjectsBroken -> "split-objects-broken"
+            WithLibdw          -> "with-libdw"
+            HaveLibMingwEx     -> "have-lib-mingw-ex"
+            UseSystemFfi       -> "use-system-ffi"
+    value <- lookupValueOrError configFile key
+    when (value `notElem` ["YES", "NO", ""]) . error $ "Configuration flag "
+        ++ quote (key ++ " = " ++ value) ++ " cannot be parsed."
     return $ value == "YES"
 
-class ToCondition a where
-    toCondition :: a -> Condition
-
-instance ToCondition Condition where
-    toCondition = id
-
-instance ToCondition Bool where
-    toCondition = return
-
-instance ToCondition Flag where
-    toCondition = test
-
-when :: (ToCondition a, Monoid m) => a -> Action m -> Action m
-when x act = do
-    bool <- toCondition x
-    if bool then act else mempty
-
-unless :: (ToCondition a, Monoid m) => a -> Action m -> Action m
-unless x act = do
-    bool <- toCondition x
-    if bool then mempty else act
-
-class Not a where
-    type NotResult a
-    not :: a -> NotResult a
-
-instance Not Bool where
-    type NotResult Bool = Bool
-    not = Prelude.not
-
-instance Not Condition where
-    type NotResult Condition = Condition
-    not = fmap not
-
-instance Not Flag where
-    type NotResult Flag = Condition
-    not = not . toCondition
-
-class AndOr a b where
-    type AndOrResult a b
-    (&&) :: a -> b -> AndOrResult a b
-    (||) :: a -> b -> AndOrResult a b
-
-infixr 3 &&
-infixr 2 ||
-
-instance AndOr Bool Bool where
-    type AndOrResult Bool Bool = Bool
-    (&&) = (Prelude.&&)
-    (||) = (Prelude.||)
-
-instance ToCondition a => AndOr Condition a where
-    type AndOrResult Condition a = Condition
-    x && y = (&&) <$> x <*> toCondition y
-    x || y = (||) <$> x <*> toCondition y
-
-instance ToCondition a => AndOr Flag a where
-    type AndOrResult Flag a = Condition
-    x && y = toCondition x && y
-    x || y = toCondition x || y
-
--- TODO: need more instances to handle Bool as first argument of (&&), (||)
+crossCompiling :: Action Bool
+crossCompiling = flag CrossCompiling
+
+platformSupportsSharedLibs :: Action Bool
+platformSupportsSharedLibs = do
+    badPlatform   <- anyTargetPlatform [ "powerpc-unknown-linux"
+                                       , "x86_64-unknown-mingw32"
+                                       , "i386-unknown-mingw32" ]
+    solaris       <- anyTargetPlatform [ "i386-unknown-solaris2" ]
+    solarisBroken <- flag SolarisBrokenShld
+    return $ not (badPlatform || solaris && solarisBroken)
+
+ghcWithSMP :: Action Bool
+ghcWithSMP = do
+    goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc", "arm"]
+    ghcUnreg <- flag GhcUnregisterised
+    return $ goodArch && not ghcUnreg
+
+ghcWithNativeCodeGen :: Action Bool
+ghcWithNativeCodeGen = do
+    goodArch <- anyTargetArch ["i386", "x86_64", "sparc", "powerpc"]
+    badOs    <- anyTargetOs ["ios", "aix"]
+    ghcUnreg <- flag GhcUnregisterised
+    return $ goodArch && not badOs && not ghcUnreg
+
+supportsSplitObjects :: Action Bool
+supportsSplitObjects = do
+    broken   <- flag SplitObjectsBroken
+    ghcUnreg <- flag GhcUnregisterised
+    goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc" ]
+    goodOs   <- anyTargetOs [ "mingw32", "cygwin32", "linux", "darwin", "solaris2"
+                            , "freebsd", "dragonfly", "netbsd", "openbsd" ]
+    return $ not broken && not ghcUnreg && goodArch && goodOs