Setting.hs 5.81 KB
Newer Older
Andrey Mokhov's avatar
Andrey Mokhov committed
1
module Oracles.Config.Setting (
2
    Setting (..), SettingList (..),
Andrey Mokhov's avatar
Andrey Mokhov committed
3
    setting, settingList, getSetting, getSettingList,
4
5
6
    anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs, windowsHost,
    ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
    ghcCanonVersion, cmdLineLengthLimit
7
8
    ) where

Andrey Mokhov's avatar
Andrey Mokhov committed
9
10
import Base
import Oracles.Config
Andrey Mokhov's avatar
Andrey Mokhov committed
11
import Stage
12

Andrey Mokhov's avatar
Andrey Mokhov committed
13
-- TODO: reduce the variety of similar flags (e.g. CPP and non-CPP versions).
14
15
16
-- Each Setting comes from the system.config file, e.g. 'target-os = mingw32'.
-- setting TargetOs looks up the config file and returns "mingw32".
--
17
-- SettingList is used for multiple string values separated by spaces, such
18
19
-- as 'gmp-include-dirs = a b'.
-- settingList GmpIncludeDirs therefore returns a list of strings ["a", "b"].
Andrey Mokhov's avatar
Andrey Mokhov committed
20
21
22
23
24
data Setting = BuildArch
             | BuildOs
             | BuildPlatform
             | BuildVendor
             | DynamicExtension
25
26
27
             | GhcMajorVersion
             | GhcMinorVersion
             | GhcPatchLevel
28
             | GhcVersion
29
30
31
             | GhcSourcePath
             | HostArch
             | HostOs
Andrey Mokhov's avatar
Andrey Mokhov committed
32
33
             | HostPlatform
             | HostVendor
34
35
             | ProjectGitCommitId
             | ProjectName
36
37
             | ProjectVersion
             | ProjectVersionInt
38
39
40
             | ProjectPatchLevel
             | ProjectPatchLevel1
             | ProjectPatchLevel2
41
             | TargetArch
42
             | TargetOs
Andrey Mokhov's avatar
Andrey Mokhov committed
43
             | TargetPlatform
44
             | TargetPlatformFull
Andrey Mokhov's avatar
Andrey Mokhov committed
45
             | TargetVendor
46

47
data SettingList = ConfCcArgs Stage
48
                 | ConfCppArgs Stage
49
50
51
52
                 | ConfGccLinkerArgs Stage
                 | ConfLdLinkerArgs Stage
                 | GmpIncludeDirs
                 | GmpLibDirs
Andrey Mokhov's avatar
Andrey Mokhov committed
53
                 | HsCppArgs
54
55
                 | IconvIncludeDirs
                 | IconvLibDirs
56
57

setting :: Setting -> Action String
58
setting key = askConfig $ case key of
Andrey Mokhov's avatar
Andrey Mokhov committed
59
60
61
62
    BuildArch          -> "build-arch"
    BuildOs            -> "build-os"
    BuildPlatform      -> "build-platform"
    BuildVendor        -> "build-vendor"
63
    DynamicExtension   -> "dynamic-extension"
64
65
66
    GhcMajorVersion    -> "ghc-major-version"
    GhcMinorVersion    -> "ghc-minor-version"
    GhcPatchLevel      -> "ghc-patch-level"
67
    GhcVersion         -> "ghc-version"
68
    GhcSourcePath      -> "ghc-source-path"
69
70
    HostArch           -> "host-arch"
    HostOs             -> "host-os"
Andrey Mokhov's avatar
Andrey Mokhov committed
71
72
    HostPlatform       -> "host-platform"
    HostVendor         -> "host-vendor"
73
74
    ProjectGitCommitId -> "project-git-commit-id"
    ProjectName        -> "project-name"
75
76
    ProjectVersion     -> "project-version"
    ProjectVersionInt  -> "project-version-int"
77
78
79
    ProjectPatchLevel  -> "project-patch-level"
    ProjectPatchLevel1 -> "project-patch-level1"
    ProjectPatchLevel2 -> "project-patch-level2"
80
81
    TargetArch         -> "target-arch"
    TargetOs           -> "target-os"
Andrey Mokhov's avatar
Andrey Mokhov committed
82
    TargetPlatform     -> "target-platform"
83
    TargetPlatformFull -> "target-platform-full"
Andrey Mokhov's avatar
Andrey Mokhov committed
84
    TargetVendor       -> "target-vendor"
85

86
87
88
89
90
91
settingList :: SettingList -> Action [String]
settingList key = fmap words $ askConfig $ case key of
    ConfCcArgs        stage -> "conf-cc-args-stage"         ++ show stage
    ConfCppArgs       stage -> "conf-cpp-args-stage"        ++ show stage
    ConfGccLinkerArgs stage -> "conf-gcc-linker-args-stage" ++ show stage
    ConfLdLinkerArgs  stage -> "conf-ld-linker-args-stage"  ++ show stage
92
93
    GmpIncludeDirs          -> "gmp-include-dirs"
    GmpLibDirs              -> "gmp-lib-dirs"
Andrey Mokhov's avatar
Andrey Mokhov committed
94
    HsCppArgs               -> "hs-cpp-args"
95
96
    IconvIncludeDirs        -> "iconv-include-dirs"
    IconvLibDirs            -> "iconv-lib-dirs"
97

Andrey Mokhov's avatar
Andrey Mokhov committed
98
99
100
101
102
103
getSetting :: Setting -> ReaderT a Action String
getSetting = lift . setting

getSettingList :: SettingList -> ReaderT a Action [String]
getSettingList = lift . settingList

104
matchSetting :: Setting -> [String] -> Action Bool
105
matchSetting key values = fmap (`elem` values) $ setting key
106

107
108
anyTargetPlatform :: [String] -> Action Bool
anyTargetPlatform = matchSetting TargetPlatformFull
109

110
111
anyTargetOs :: [String] -> Action Bool
anyTargetOs = matchSetting TargetOs
112

113
114
anyTargetArch :: [String] -> Action Bool
anyTargetArch = matchSetting TargetArch
115

116
117
anyHostOs :: [String] -> Action Bool
anyHostOs = matchSetting HostOs
118

119
windowsHost :: Action Bool
120
windowsHost = anyHostOs ["mingw32", "cygwin32"]
121
122
123

ghcWithInterpreter :: Action Bool
ghcWithInterpreter = do
124
125
126
127
128
    goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "solaris2"
                          , "freebsd", "dragonfly", "netbsd", "openbsd"
                          , "darwin", "kfreebsdgnu" ]
    goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc"
                              , "sparc64", "arm" ]
129
    return $ goodOs && goodArch
130
131

ghcEnableTablesNextToCode :: Action Bool
132
133
134
135
ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc64le"]

useLibFFIForAdjustors :: Action Bool
useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"]
136

137
138
139
140
141
142
143
144
145
-- Canonicalised GHC version number, used for integer version comparisons. We
-- expand GhcMinorVersion to two digits by adding a leading zero if necessary.
ghcCanonVersion :: Action String
ghcCanonVersion = do
    ghcMajorVersion <- setting GhcMajorVersion
    ghcMinorVersion <- setting GhcMinorVersion
    let leadingZero = [ '0' | length ghcMinorVersion == 1 ]
    return $ ghcMajorVersion ++ leadingZero ++ ghcMinorVersion

146
147
148
149
150
151
152
153
154
155
-- Command lines have limited size on Windows. Since Windows 7 the limit is
-- 32768 characters (theoretically). In practice we use 31000 to leave some
-- breathing space for the builder's path & name, auxiliary flags, and other
-- overheads. Use this function to set limits for other OSs if necessary.
cmdLineLengthLimit :: Action Int
cmdLineLengthLimit = do
    windows <- windowsHost
    return $ if windows
             then 31000
             else 4194304 -- Cabal needs a bit more than 2MB!