1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
|
module Oracles.Setting (
configFile, Setting (..), SettingList (..), setting, settingList, getSetting,
getSettingList, anyTargetPlatform, anyTargetOs, anyTargetArch, anyHostOs,
ghcWithInterpreter, ghcEnableTablesNextToCode, useLibFFIForAdjustors,
ghcCanonVersion, cmdLineLengthLimit, iosHost, osxHost, windowsHost,
hostSupportsRPaths, topDirectory, libsuf, ghcVersionStage
) where
import Hadrian.Expression
import Hadrian.Oracles.TextFile
import Hadrian.Oracles.Path
import Base
-- | Each 'Setting' comes from the file @hadrian/cfg/system.config@, generated
-- by the @configure@ script from the input file @hadrian/cfg/system.config.in@.
-- For example, the line
--
-- > target-os = mingw32
--
-- sets the value of the setting 'TargetOs'. The action 'setting' 'TargetOs'
-- looks up the value of the setting and returns the string @"mingw32"@,
-- tracking the result in the Shake database.
data Setting = BuildArch
| BuildOs
| BuildPlatform
| BuildVendor
| CcClangBackend
| CcLlvmBackend
| CursesLibDir
| DynamicExtension
| FfiIncludeDir
| FfiLibDir
| GhcMajorVersion
| GhcMinorVersion
| GhcPatchLevel
| GhcVersion
| GhcSourcePath
| GmpIncludeDir
| GmpLibDir
| HostArch
| HostOs
| HostPlatform
| HostVendor
| IconvIncludeDir
| IconvLibDir
| LlvmTarget
| ProjectGitCommitId
| ProjectName
| ProjectVersion
| ProjectVersionInt
| ProjectPatchLevel
| ProjectPatchLevel1
| ProjectPatchLevel2
| SystemGhc
| TargetArch
| TargetOs
| TargetPlatform
| TargetPlatformFull
| TargetVendor
-- TODO: Reduce the variety of similar flags (e.g. CPP and non-CPP versions).
-- | Each 'SettingList' comes from the file @hadrian/cfg/system.config@,
-- generated by the @configure@ script from the input file
-- @hadrian/cfg/system.config.in@. For example, the line
--
-- > hs-cpp-args = -E -undef -traditional
--
-- sets the value of 'HsCppArgs'. The action 'settingList' 'HsCppArgs' looks up
-- the value of the setting and returns the list of strings
-- @["-E", "-undef", "-traditional"]@, tracking the result in the Shake database.
data SettingList = ConfCcArgs Stage
| ConfCppArgs Stage
| ConfGccLinkerArgs Stage
| ConfLdLinkerArgs Stage
| HsCppArgs
-- | Look up the value of a 'Setting' in @cfg/system.config@, tracking the
-- result.
setting :: Setting -> Action String
setting key = lookupValueOrError configFile $ case key of
BuildArch -> "build-arch"
BuildOs -> "build-os"
BuildPlatform -> "build-platform"
BuildVendor -> "build-vendor"
CcClangBackend -> "cc-clang-backend"
CcLlvmBackend -> "cc-llvm-backend"
CursesLibDir -> "curses-lib-dir"
DynamicExtension -> "dynamic-extension"
FfiIncludeDir -> "ffi-include-dir"
FfiLibDir -> "ffi-lib-dir"
GhcMajorVersion -> "ghc-major-version"
GhcMinorVersion -> "ghc-minor-version"
GhcPatchLevel -> "ghc-patch-level"
GhcVersion -> "ghc-version"
GhcSourcePath -> "ghc-source-path"
GmpIncludeDir -> "gmp-include-dir"
GmpLibDir -> "gmp-lib-dir"
HostArch -> "host-arch"
HostOs -> "host-os"
HostPlatform -> "host-platform"
HostVendor -> "host-vendor"
IconvIncludeDir -> "iconv-include-dir"
IconvLibDir -> "iconv-lib-dir"
LlvmTarget -> "llvm-target"
ProjectGitCommitId -> "project-git-commit-id"
ProjectName -> "project-name"
ProjectVersion -> "project-version"
ProjectVersionInt -> "project-version-int"
ProjectPatchLevel -> "project-patch-level"
ProjectPatchLevel1 -> "project-patch-level1"
ProjectPatchLevel2 -> "project-patch-level2"
SystemGhc -> "system-ghc"
TargetArch -> "target-arch"
TargetOs -> "target-os"
TargetPlatform -> "target-platform"
TargetPlatformFull -> "target-platform-full"
TargetVendor -> "target-vendor"
-- | Look up the value of a 'SettingList' in @cfg/system.config@, tracking the
-- result.
settingList :: SettingList -> Action [String]
settingList key = fmap words $ lookupValueOrError configFile $ case key of
ConfCcArgs stage -> "conf-cc-args-" ++ stageString stage
ConfCppArgs stage -> "conf-cpp-args-" ++ stageString stage
ConfGccLinkerArgs stage -> "conf-gcc-linker-args-" ++ stageString stage
ConfLdLinkerArgs stage -> "conf-ld-linker-args-" ++ stageString stage
HsCppArgs -> "hs-cpp-args"
-- | An expression that looks up the value of a 'Setting' in @cfg/system.config@,
-- tracking the result.
getSetting :: Setting -> Expr c b String
getSetting = expr . setting
-- | An expression that looks up the value of a 'SettingList' in
-- @cfg/system.config@, tracking the result.
getSettingList :: SettingList -> Args c b
getSettingList = expr . settingList
-- | Check whether the value of a 'Setting' matches one of the given strings.
matchSetting :: Setting -> [String] -> Action Bool
matchSetting key values = (`elem` values) <$> setting key
-- | Check whether the target platform setting matches one of the given strings.
anyTargetPlatform :: [String] -> Action Bool
anyTargetPlatform = matchSetting TargetPlatformFull
-- | Check whether the target OS setting matches one of the given strings.
anyTargetOs :: [String] -> Action Bool
anyTargetOs = matchSetting TargetOs
-- | Check whether the target architecture setting matches one of the given
-- strings.
anyTargetArch :: [String] -> Action Bool
anyTargetArch = matchSetting TargetArch
-- | Check whether the host OS setting matches one of the given strings.
anyHostOs :: [String] -> Action Bool
anyHostOs = matchSetting HostOs
-- | Check whether the host OS setting is set to @"ios"@.
iosHost :: Action Bool
iosHost = anyHostOs ["ios"]
-- | Check whether the host OS setting is set to @"darwin"@.
osxHost :: Action Bool
osxHost = anyHostOs ["darwin"]
-- | Check whether the host OS supports the @-rpath@ linker option when
-- using dynamic linking.
--
-- TODO: Windows supports lazy binding (but GHC doesn't currently support
-- dynamic way on Windows anyways).
hostSupportsRPaths :: Action Bool
hostSupportsRPaths = anyHostOs ["linux", "darwin", "freebsd"]
-- | Check whether the host OS setting is set to @"mingw32"@ or @"cygwin32"@.
windowsHost :: Action Bool
windowsHost = anyHostOs ["mingw32", "cygwin32"]
-- | Check whether the target supports GHCi.
ghcWithInterpreter :: Action Bool
ghcWithInterpreter = do
goodOs <- anyTargetOs [ "mingw32", "cygwin32", "linux", "solaris2"
, "freebsd", "dragonfly", "netbsd", "openbsd"
, "darwin", "kfreebsdgnu" ]
goodArch <- anyTargetArch [ "i386", "x86_64", "powerpc", "sparc"
, "sparc64", "arm" ]
return $ goodOs && goodArch
-- | Check whether the target architecture supports placing info tables next to
-- code. See: https://ghc.haskell.org/trac/ghc/wiki/Commentary/Rts/Storage/HeapObjects#TABLES_NEXT_TO_CODE.
ghcEnableTablesNextToCode :: Action Bool
ghcEnableTablesNextToCode = notM $ anyTargetArch ["ia64", "powerpc64", "powerpc64le"]
-- | Check to use @libffi@ for adjustors.
useLibFFIForAdjustors :: Action Bool
useLibFFIForAdjustors = notM $ anyTargetArch ["i386", "x86_64"]
-- | 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
-- | Path to the GHC source tree.
topDirectory :: Action FilePath
topDirectory = fixAbsolutePathOnWindows =<< setting GhcSourcePath
ghcVersionStage :: Stage -> Action String
ghcVersionStage Stage0 = setting GhcVersion
ghcVersionStage _ = setting ProjectVersion
-- | The file suffix used for libraries of a given build 'Way'. For example,
-- @_p.a@ corresponds to a static profiled library, and @-ghc7.11.20141222.so@
-- is a dynamic vanilly library. Why do we need GHC version number in the
-- dynamic suffix? Here is a possible reason: dynamic libraries are placed in a
-- single giant directory in the load path of the dynamic linker, and hence we
-- must distinguish different versions of GHC. In contrast, static libraries
-- live in their own per-package directory and hence do not need a unique
-- filename. We also need to respect the system's dynamic extension, e.g. @.dll@
-- or @.so@.
libsuf :: Stage -> Way -> Action String
libsuf st way
| not (wayUnit Dynamic way) = return (waySuffix way ++ ".a") -- e.g., _p.a
| otherwise = do
extension <- setting DynamicExtension -- e.g., .dll or .so
version <- ghcVersionStage st -- e.g. 8.4.4 or 8.9.xxxx
let suffix = waySuffix (removeWayUnit Dynamic way)
return (suffix ++ "-ghc" ++ version ++ extension)
|
