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
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
|
module Settings.Builders.Cabal (cabalBuilderArgs) where
import Development.Shake.FilePath
import Hadrian.Haskell.Cabal
import Builder
import Context
import Flavour
import Packages
import Settings.Builders.Common
import qualified Settings.Builders.Common as S
import Control.Exception (assert)
import System.Directory
import Settings.Program (programContext)
cabalBuilderArgs :: Args
cabalBuilderArgs = cabalSetupArgs <> cabalInstallArgs
cabalInstallArgs :: Args
cabalInstallArgs = builder (Cabal Install) ? do
pkg <- getPackage
root <- exprIO . makeAbsolute =<< getBuildRoot
let pgmName
| pkg == ghc = "ghc"
| pkg == hpcBin = "hpc"
| otherwise = pkgName pkg
assertNoBuildRootLeak $
mconcat [ arg $ "--store-dir=" ++ (root -/- "stage-cabal" -/- "cabal-store")
, arg "install"
, if isProgram pkg then arg $ "exe:" ++ pgmName else mconcat [arg "--lib", arg $ pkgName pkg]
, commonReinstallCabalArgs
]
-- | Checks that _build/stageN/lib/* doesn't leak into the arguments for
-- reinstallable GHC. If this assert fails, then GHC probably isn't
-- properly reinstallable.
-- We allow "package.conf.d" however since we do need to read the package environment
-- of the stage 2 compiler
assertNoBuildRootLeak :: Args -> Args
assertNoBuildRootLeak args = do
libPaths <- expr $ mapM stageLibPath [Stage0 ..]
xs <- args
pure $ assert (not $ any (\arg -> or [libPath `isInfixOf` arg && not ("package.conf.d" `isSuffixOf` arg)
| libPath <- libPaths]) xs)
xs
commonReinstallCabalArgs :: Args
commonReinstallCabalArgs = do
top <- expr topDirectory
root <- getBuildRoot
threads <- shakeThreads <$> expr getShakeOptions
_pkg <- getPackage
compiler <- expr $ programPath =<< programContext Stage1 ghc
mconcat [ arg "--project-file"
, arg $ top -/- "cabal.project-reinstall"
, arg "--distdir"
, arg $ root -/- "stage-cabal" -/- "dist-newstyle"
, arg ("--ghc-option=-j" ++ show threads)
, arg $ "--install-method=copy"
, arg $ "--overwrite-policy=always"
, arg $ "--with-compiler=" ++ top -/- compiler
, arg $ "--installdir=" ++ (root -/- "stage-cabal" -/- "cabal-bin")
, arg $ "--package-env=" ++ (root -/- "stage-cabal" -/- "cabal-packages")
, arg "--enable-executable-dynamic"
, arg "--enable-library-vanilla"
]
cabalSetupArgs :: Args
cabalSetupArgs = builder (Cabal Setup) ? do
top <- expr topDirectory
stage <- getStage
path <- getContextPath
mconcat [ arg "configure"
, arg "--distdir"
, arg $ top -/- path
, commonCabalArgs stage
, configureStageArgs
]
commonCabalArgs :: Stage -> Args
commonCabalArgs stage = do
verbosity <- expr getVerbosity
pkg <- getPackage
let prefix = "${pkgroot}" ++ (if windowsHost then "" else "/..")
mconcat [ -- Don't strip libraries when cross compiling.
-- TODO: We need to set @--with-strip=(stripCmdPath :: Action FilePath)@,
-- and if it's @:@ disable stripping as well. As it is now, I believe
-- we might have issues with stripping on Windows, as I can't see a
-- consumer of 'stripCmdPath'.
-- TODO: See https://github.com/snowleopard/hadrian/issues/549.
flag CrossCompiling ? pure [ "--disable-executable-stripping"
, "--disable-library-stripping" ]
-- We don't want to strip the debug RTS
, S.package rts ? pure [ "--disable-executable-stripping"
, "--disable-library-stripping" ]
, arg "--cabal-file"
, arg $ pkgCabalFile pkg
, arg "--ipid"
, arg "$pkg-$version"
, arg "--prefix"
, arg prefix
-- NB: this is valid only because Hadrian puts the @docs@ and
-- @libraries@ folders in the same relative position:
--
-- * libraries in @_build/stageN/libraries@
-- * docs in @_build/docs/html/libraries@
--
-- This doesn't hold if we move the @docs@ folder anywhere else.
, arg "--htmldir"
, arg $ "${pkgroot}/../../docs/html/libraries/" ++ pkgName pkg
, withStaged $ Ghc CompileHs
, withBuilderArgs (Ghc CompileHs stage)
, withStaged (GhcPkg Update)
, withBuilderArgs (GhcPkg Update stage)
, bootPackageDatabaseArgs
, libraryArgs
, bootPackageConstraints
, withStaged $ Cc CompileC
, notStage0 ? with (Ld stage)
, withStaged (Ar Pack)
, with Alex
, with Happy
-- Update Target.trackArgument if changing these:
, verbosity < Verbose ?
pure [ "-v0", "--configure-option=--quiet"
, "--configure-option=--disable-option-checking" ] ]
-- TODO: Isn't vanilla always built? If yes, some conditions are redundant.
-- TODO: Need compiler_stage1_CONFIGURE_OPTS += --disable-library-for-ghci?
-- TODO: should `elem` be `wayUnit`?
-- This approach still doesn't work. Previously libraries were build only in the
-- Default flavours and not using context.
libraryArgs :: Args
libraryArgs = do
flavourWays <- getLibraryWays
contextWay <- getWay
package <- getPackage
withGhci <- expr ghcWithInterpreter
dynPrograms <- expr (flavour >>= dynamicGhcPrograms)
let ways = flavourWays ++ [contextWay]
hasVanilla = vanilla `elem` ways
hasProfiling = any (wayUnit Profiling) ways
hasDynamic = any (wayUnit Dynamic) ways
pure [ if hasVanilla
then "--enable-library-vanilla"
else "--disable-library-vanilla"
, if hasProfiling
then "--enable-library-profiling"
else "--disable-library-profiling"
, if (hasVanilla || hasProfiling) &&
package /= rts && withGhci && not dynPrograms
then "--enable-library-for-ghci"
else "--disable-library-for-ghci"
, if hasDynamic
then "--enable-shared"
else "--disable-shared" ]
-- | Configure args with stage/lib specific include directories and settings
configureStageArgs :: Args
configureStageArgs = do
let cFlags = getStagedSettingList ConfCcArgs
ldFlags = getStagedSettingList ConfGccLinkerArgs
mconcat [ configureArgs cFlags ldFlags
, notStage0 ? arg "--ghc-option=-ghcversion-file=rts/include/ghcversion.h"
]
-- TODO: LD_OPTS?
configureArgs :: Args -> Args -> Args
configureArgs cFlags' ldFlags' = do
top <- expr topDirectory
pkg <- getPackage
let conf key expr = do
values <- unwords <$> expr
not (null values) ?
arg ("--configure-option=" ++ key ++ "=" ++ values)
cFlags = mconcat [ remove ["-Werror"] cArgs
, getStagedSettingList ConfCcArgs
-- See https://github.com/snowleopard/hadrian/issues/523
, arg $ "-iquote"
, arg $ top -/- pkgPath pkg
, cFlags'
]
ldFlags = ldArgs <> ldFlags'
cldFlags <- unwords <$> (cFlags <> ldFlags)
mconcat
[ conf "CFLAGS" cFlags
, conf "LDFLAGS" ldFlags
, not (null cldFlags) ? arg ("--gcc-options=" ++ cldFlags)
, conf "--with-iconv-includes" $ arg =<< getSetting IconvIncludeDir
, conf "--with-iconv-libraries" $ arg =<< getSetting IconvLibDir
, conf "--with-gmp-includes" $ arg =<< getSetting GmpIncludeDir
, conf "--with-gmp-libraries" $ arg =<< getSetting GmpLibDir
, conf "--with-curses-libraries" $ arg =<< getSetting CursesLibDir
, conf "--host" $ arg =<< getSetting TargetPlatformFull
, conf "--with-cc" $ arg =<< getBuilderPath . (Cc CompileC) =<< getStage
, notStage0 ? arg "--ghc-option=-ghcversion-file=rts/include/ghcversion.h"
]
bootPackageConstraints :: Args
bootPackageConstraints = stage0 ? do
bootPkgs <- expr $ stagePackages Stage0
let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
constraints <- expr $ forM (sort pkgs) $ \pkg -> do
version <- pkgVersion pkg
return $ ((pkgName pkg ++ " == ") ++) version
pure $ concat [ ["--constraint", c] | c <- constraints ]
withBuilderKey :: Builder -> String
withBuilderKey b = case b of
Ar _ _ -> "--with-ar="
Ld _ -> "--with-ld="
Cc _ _ -> "--with-gcc="
Ghc _ _ -> "--with-ghc="
Alex -> "--with-alex="
Happy -> "--with-happy="
GhcPkg _ _ -> "--with-ghc-pkg="
_ -> error $ "withBuilderKey: not supported builder " ++ show b
-- | Add arguments to builders if needed.
withBuilderArgs :: Builder -> Args
withBuilderArgs b = case b of
Ghc _ stage -> do
top <- expr topDirectory
pkgDb <- expr $ packageDbPath stage
-- GHC starts with a nonempty package DB stack, so we need to tell it
-- to empty the stack first for it to truly consider only the package
-- DB we explicitly provide. See #17468.
notStage0 ? arg ("--ghc-option=-no-global-package-db") <>
arg ("--ghc-option=-package-db=" ++ top -/- pkgDb)
GhcPkg _ stage -> do
top <- expr topDirectory
pkgDb <- expr $ packageDbPath stage
notStage0 ? arg ("--ghc-pkg-option=--global-package-db=" ++ top -/- pkgDb)
_ -> return [] -- no arguments
-- | Expression 'with Alex' appends "--with-alex=/path/to/alex" and needs Alex.
with :: Builder -> Args
with b = do
path <- getBuilderPath b
if null path then mempty else do
top <- expr topDirectory
expr $ needBuilder b
-- Do not inject top, if we have a bare name. E.g. do not turn
-- `ar` into `$top/ar`. But let `ar` be `ar` as found on $PATH.
arg $ withBuilderKey b ++ unifyPath (if path /= takeFileName path
then top </> path
else path)
withStaged :: (Stage -> Builder) -> Args
withStaged sb = with . sb =<< getStage
|
