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
|
module Settings.Builders.Ghc (ghcBuilderArgs, haddockGhcArgs) where
import Hadrian.Haskell.Cabal
import Hadrian.Haskell.Cabal.Type
import Flavour
import Packages
import Settings.Builders.Common
import Settings.Warnings
ghcBuilderArgs :: Args
ghcBuilderArgs = mconcat [compileAndLinkHs, compileC, findHsDependencies]
compileAndLinkHs :: Args
compileAndLinkHs = (builder (Ghc CompileHs) ||^ builder (Ghc LinkHs)) ? do
mconcat [ arg "-Wall"
, commonGhcArgs
, splitObjects <$> flavour ? arg "-split-objs"
, ghcLinkArgs
, defaultGhcWarningsArgs
, builder (Ghc CompileHs) ? arg "-c"
, getInputs
, arg "-o", arg =<< getOutput ]
compileC :: Args
compileC = builder (Ghc CompileCWithGhc) ? do
way <- getWay
let ccArgs = [ getContextData ccOpts
, getStagedSettingList ConfCcArgs
, cIncludeArgs
, Dynamic `wayUnit` way ? pure [ "-fPIC", "-DDYNAMIC" ] ]
mconcat [ arg "-Wall"
, ghcLinkArgs
, commonGhcArgs
, mconcat (map (map ("-optc" ++) <$>) ccArgs)
, defaultGhcWarningsArgs
, arg "-c"
, getInputs
, arg "-o"
, arg =<< getOutput ]
ghcLinkArgs :: Args
ghcLinkArgs = builder (Ghc LinkHs) ? do
way <- getWay
pkg <- getPackage
libs <- pkg == hp2ps ? pure ["m"]
intLib <- getIntegerPackage
gmpLibs <- notStage0 ? intLib == integerGmp ? pure ["gmp"]
mconcat [ (Dynamic `wayUnit` way) ?
pure [ "-shared", "-dynamic", "-dynload", "deploy" ]
, arg "-no-auto-link-packages"
, nonHsMainPackage pkg ? arg "-no-hs-main"
, not (nonHsMainPackage pkg) ? arg "-rtsopts"
, pure [ "-optl-l" ++ lib | lib <- libs ++ gmpLibs ]
]
findHsDependencies :: Args
findHsDependencies = builder (Ghc FindHsDependencies) ? do
ways <- getLibraryWays
mconcat [ arg "-M"
, commonGhcArgs
, arg "-include-pkg-deps"
, arg "-dep-makefile", arg =<< getOutput
, pure $ concat [ ["-dep-suffix", wayPrefix w] | w <- ways ]
, getInputs ]
haddockGhcArgs :: Args
haddockGhcArgs = mconcat [ commonGhcArgs, getContextData hcOpts ]
-- | Common GHC command line arguments used in 'ghcBuilderArgs',
-- 'ghcCBuilderArgs', 'ghcMBuilderArgs' and 'haddockGhcArgs'.
commonGhcArgs :: Args
commonGhcArgs = do
way <- getWay
path <- getBuildPath
ghcVersion <- expr ghcVersionH
mconcat [ arg "-hisuf", arg $ hisuf way
, arg "-osuf" , arg $ osuf way
, arg "-hcsuf", arg $ hcsuf way
, wayGhcArgs
, packageGhcArgs
, includeGhcArgs
-- When compiling RTS for Stage1 or Stage2 we do not have it (yet)
-- in the package database. We therefore explicity supply the path
-- to the @ghc-version@ file, to prevent GHC from trying to open the
-- RTS package in the package database and failing.
, package rts ? notStage0 ? arg ("-ghcversion-file=" ++ ghcVersion)
, map ("-optc" ++) <$> getStagedSettingList ConfCcArgs
, map ("-optP" ++) <$> getStagedSettingList ConfCppArgs
, map ("-optP" ++) <$> getContextData cppOpts
, arg "-odir" , arg path
, arg "-hidir" , arg path
, arg "-stubdir" , arg path ]
-- TODO: Do '-ticky' in all debug ways?
wayGhcArgs :: Args
wayGhcArgs = do
way <- getWay
mconcat [ if (Dynamic `wayUnit` way)
then pure ["-fPIC", "-dynamic"]
else arg "-static"
, (Threaded `wayUnit` way) ? arg "-optc-DTHREADED_RTS"
, (Debug `wayUnit` way) ? arg "-optc-DDEBUG"
, (Profiling `wayUnit` way) ? arg "-prof"
, (Logging `wayUnit` way) ? arg "-eventlog"
, (way == debug || way == debugDynamic) ?
pure ["-ticky", "-DTICKY_TICKY"] ]
packageGhcArgs :: Args
packageGhcArgs = do
package <- getPackage
pkgId <- expr $ pkgIdentifier package
mconcat [ arg "-hide-all-packages"
, arg "-no-user-package-db"
, packageDatabaseArgs
, libraryPackage ? arg ("-this-unit-id " ++ pkgId)
, map ("-package-id " ++) <$> getContextData depIds ]
includeGhcArgs :: Args
includeGhcArgs = do
pkg <- getPackage
path <- getBuildPath
root <- getBuildRoot
context <- getContext
srcDirs <- getContextData srcDirs
autogen <- expr $ autogenPath context
mconcat [ arg "-i"
, arg $ "-i" ++ path
, arg $ "-i" ++ autogen
, pure [ "-i" ++ pkgPath pkg -/- dir | dir <- srcDirs ]
, cIncludeArgs
, arg $ "-I" ++ root -/- generatedDir
, arg $ "-optc-I" ++ root -/- generatedDir
, pure ["-optP-include", "-optP" ++ autogen -/- "cabal_macros.h"] ]
|
