Switches.hs 3.07 KB
Newer Older
1 2
module Switches (
    IntegerLibraryImpl (..), integerLibraryImpl,
3
    notStage, stage0, stage1, stage2,
4
    configKeyYes, configKeyNo, configKeyNonEmpty,
5
    supportsPackageKey, targetPlatforms, targetPlatform,
Andrey Mokhov's avatar
Andrey Mokhov committed
6 7
    targetOss, targetOs, notTargetOs,
    targetArchs, dynamicGhcPrograms, ghcWithInterpreter,
8
    platformSupportsSharedLibs, crossCompiling,
Andrey Mokhov's avatar
Andrey Mokhov committed
9
    gccIsClang, gccLt46, windowsHost, notWindowsHost
10 11
    ) where

12
import Base
Andrey Mokhov's avatar
Andrey Mokhov committed
13
import Expression
14

15 16
-- TODO: This setting should be moved to UserSettings.hs
-- TODO: Define three packages for integer library instead of one in Targets.hs
17 18 19 20 21 22
-- Support for multiple integer library implementations
data IntegerLibraryImpl = IntegerGmp | IntegerGmp2 | IntegerSimple

integerLibraryImpl :: IntegerLibraryImpl
integerLibraryImpl = IntegerGmp2

23 24 25 26 27 28 29 30 31 32 33 34 35
-- Derived predicates
notStage :: Stage -> Predicate
notStage = liftM not . stage

stage0 :: Predicate
stage0 = stage Stage0

stage1 :: Predicate
stage1 = stage Stage1

stage2 :: Predicate
stage2 = stage Stage2

36 37 38 39 40 41 42 43 44
configKeyYes :: String -> Predicate
configKeyYes key = configKeyValue key "YES"

configKeyNo :: String -> Predicate
configKeyNo key = configKeyValue key "NO"

configKeyNonEmpty :: String -> Predicate
configKeyNonEmpty key = liftM not $ configKeyValue key ""

45
-- Predicates based on configuration files
46
supportsPackageKey :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
47
supportsPackageKey = configKeyYes "supports-package-key"
48

49
targetPlatforms :: [String] -> Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
50
targetPlatforms = configKeyValues "target-platform-full"
51

52
targetPlatform :: String -> Predicate
53 54
targetPlatform s = targetPlatforms [s]

55
targetOss :: [String] -> Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
56
targetOss = configKeyValues "target-os"
57

58
targetOs :: String -> Predicate
59 60
targetOs s = targetOss [s]

61 62
notTargetOs :: String -> Predicate
notTargetOs = liftM not . targetOs
Andrey Mokhov's avatar
Andrey Mokhov committed
63

64
targetArchs :: [String] -> Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
65
targetArchs = configKeyValues "target-arch"
66

67
platformSupportsSharedLibs :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
68 69 70 71 72 73 74
platformSupportsSharedLibs = do
    badPlatform   <- targetPlatforms [ "powerpc-unknown-linux"
                                     , "x86_64-unknown-mingw32"
                                     , "i386-unknown-mingw32" ]
    solaris       <- targetPlatform    "i386-unknown-solaris2"
    solarisBroken <- configKeyYes "solaris-broken-shld"
    return $ not (badPlatform || solaris && solarisBroken)
75

76
dynamicGhcPrograms :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
77
dynamicGhcPrograms = configKeyYes "dynamic-ghc-programs"
78

79
ghcWithInterpreter :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
80 81 82 83 84 85 86
ghcWithInterpreter = do
    goodOs <- targetOss [ "mingw32", "cygwin32", "linux", "solaris2"
                        , "freebsd", "dragonfly", "netbsd", "openbsd"
                        , "darwin", "kfreebsdgnu" ]
    goodArch <- targetArchs [ "i386", "x86_64", "powerpc", "sparc"
                            , "sparc64", "arm" ]
    return $ goodOs && goodArch
87

88
crossCompiling :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
89
crossCompiling = configKeyYes "cross-compiling"
90

91
gccIsClang :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
92
gccIsClang = configKeyYes "gcc-is-clang"
93

94
gccLt46 :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
95
gccLt46 = configKeyYes "gcc-lt-46"
96

97
windowsHost :: Predicate
Andrey Mokhov's avatar
Andrey Mokhov committed
98
windowsHost = configKeyValues "host-os-cpp" ["mingw32", "cygwin32"]
99

100 101
notWindowsHost :: Predicate
notWindowsHost = liftM not windowsHost