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
|
module Flavour
( Flavour (..), werror
, DocTargets, DocTarget(..)
, parseFlavour
-- * Flavour transformers
, flavourTransformers
, addArgs
, splitSections, splitSectionsIf
, enableThreadSanitizer
, enableDebugInfo, enableTickyGhc
, viaLlvmBackend
, enableProfiledGhc
, disableDynamicGhcPrograms
, disableProfiledLibs
) where
import Expression
import Data.Set (Set)
import Data.Map (Map)
import qualified Data.Map as M
import Packages
import Text.Parsec.Prim as P
import Text.Parsec.Combinator as P
import Text.Parsec.Char as P
-- Please update doc/{flavours.md, user-settings.md} when changing this file.
-- | 'Flavour' is a collection of build settings that fully define a GHC build.
-- Note the following type semantics:
-- * @Bool@: a plain Boolean flag whose value is known at compile time.
-- * @Action Bool@: a flag whose value can depend on the build environment.
-- * @Predicate@: a flag whose value can depend on the build environment and
-- on the current build target.
data Flavour = Flavour {
-- | Flavour name, to select this flavour from command line.
name :: String,
-- | Use these command line arguments.
args :: Args,
-- | Build these packages.
packages :: Stage -> Action [Package],
-- | 'native', 'gmp', 'ffi'.
bignumBackend :: String,
-- | Check selected backend against native backend
bignumCheck :: Bool,
-- | Build libraries these ways.
libraryWays :: Ways,
-- | Build RTS these ways.
rtsWays :: Ways,
-- | Build dynamic GHC programs.
dynamicGhcPrograms :: Action Bool,
-- | Enable GHCi debugger.
ghciWithDebugger :: Bool,
-- | Build profiled GHC.
ghcProfiled :: Bool,
-- | Build GHC with debugging assertions.
ghcDebugged :: Bool,
-- | Build the GHC executable against the threaded runtime system.
ghcThreaded :: Bool,
-- | Whether to build docs and which ones
-- (haddocks, user manual, haddock manual)
ghcDocs :: Action DocTargets }
-- | A set of documentation targets
type DocTargets = Set DocTarget
-- | Documentation targets
--
-- While we can't reasonably expose settings or CLI options
-- to selectively disable, say, base's haddocks, we can offer
-- a less fine-grained choice:
--
-- - haddocks for libraries
-- - non-haddock html pages (e.g GHC's user manual)
-- - PDF documents (e.g haddock's manual)
-- - man pages (GHC's)
--
-- The main goal being to have easy ways to do away with the need
-- for e.g @sphinx-build@ or @xelatex@ and associated packages
-- while still being able to build a(n almost) complete binary
-- distribution.
data DocTarget = Haddocks | SphinxHTML | SphinxPDFs | SphinxMan | SphinxInfo
deriving (Eq, Ord, Show, Bounded, Enum)
flavourTransformers :: Map String (Flavour -> Flavour)
flavourTransformers = M.fromList
[ "werror" =: werror
, "debug_info" =: enableDebugInfo
, "ticky_ghc" =: enableTickyGhc
, "split_sections" =: splitSections
, "thread_sanitizer" =: enableThreadSanitizer
, "llvm" =: viaLlvmBackend
, "profiled_ghc" =: enableProfiledGhc
, "no_dynamic_ghc" =: disableDynamicGhcPrograms
, "no_profiled_libs" =: disableProfiledLibs
]
where (=:) = (,)
type Parser = Parsec String ()
parseFlavour :: [Flavour] -- ^ base flavours
-> Map String (Flavour -> Flavour) -- ^ modifiers
-> String
-> Either String Flavour
parseFlavour baseFlavours transformers str =
case P.runParser parser () "" str of
Left perr -> Left $ unlines $
[ "error parsing flavour specifier: " ++ show perr
, ""
, "known flavours:"
] ++
[ " " ++ name f | f <- baseFlavours ] ++
[ ""
, "known flavour transformers:"
] ++
[ " " ++ nm | nm <- M.keys transformers ]
Right f -> Right f
where
parser :: Parser Flavour
parser = do
base <- baseFlavour
transs <- P.many flavourTrans
P.eof
return $ foldr ($) base transs
baseFlavour :: Parser Flavour
baseFlavour =
P.choice [ f <$ P.try (P.string (name f))
| f <- reverse (sortOn name baseFlavours)
] -- needed to parse e.g. "quick-debug" before "quick"
flavourTrans :: Parser (Flavour -> Flavour)
flavourTrans = do
void $ P.char '+'
P.choice [ trans <$ P.try (P.string nm)
| (nm, trans) <- M.toList transformers
]
-- | Add arguments to the 'args' of a 'Flavour'.
addArgs :: Args -> Flavour -> Flavour
addArgs args' fl = fl { args = args fl <> args' }
-- | Turn on -Werror for packages built with the stage1 compiler.
-- It mimics the CI settings so is useful to turn on when developing.
werror :: Flavour -> Flavour
werror = addArgs (builder Ghc ? notStage0 ? arg "-Werror")
-- | Build C and Haskell objects with debugging information.
enableDebugInfo :: Flavour -> Flavour
enableDebugInfo = addArgs $ notStage0 ? mconcat
[ builder (Ghc CompileHs) ? arg "-g3"
, builder (Cc CompileC) ? arg "-g3"
, builder (Cabal Setup) ? arg "--disable-library-stripping"
, builder (Cabal Setup) ? arg "--disable-executable-stripping"
]
-- | Enable the ticky-ticky profiler in stage2 GHC
enableTickyGhc :: Flavour -> Flavour
enableTickyGhc =
addArgs $ stage1 ? mconcat
[ builder (Ghc CompileHs) ? ticky
, builder (Ghc LinkHs) ? ticky
]
where
ticky = mconcat
[ arg "-ticky"
, arg "-ticky-allocd"
-- You generally need STG dumps to interpret ticky profiles
, arg "-ddump-to-file"
, arg "-ddump-stg-final"
]
-- | Transform the input 'Flavour' so as to build with
-- @-split-sections@ whenever appropriate. You can
-- select which package gets built with split sections
-- by passing a suitable predicate. If the predicate holds
-- for a given package, then @split-sections@ is used when
-- building it. If the given flavour doesn't build
-- anything in a @dyn@-enabled way, then 'splitSections' is a no-op.
splitSectionsIf :: (Package -> Bool) -> Flavour -> Flavour
splitSectionsIf pkgPredicate = addArgs $ do
way <- getWay
pkg <- getPackage
(Dynamic `wayUnit` way) ? pkgPredicate pkg ?
builder (Ghc CompileHs) ? arg "-split-sections"
-- | Like 'splitSectionsIf', but with a fixed predicate: use
-- split sections for all packages but the GHC library.
splitSections :: Flavour -> Flavour
splitSections = splitSectionsIf (/=ghc)
-- Disable section splitting for the GHC library. It takes too long and
-- there is little benefit.
enableThreadSanitizer :: Flavour -> Flavour
enableThreadSanitizer = addArgs $ mconcat
[ builder (Ghc CompileHs) ? arg "-optc-fsanitize=thread"
, builder (Ghc CompileCWithGhc) ? (arg "-optc-fsanitize=thread" <> arg "-DTSAN_ENABLED")
, builder (Ghc LinkHs) ? arg "-optl-fsanitize=thread"
, builder (Cc CompileC) ? (arg "-fsanitize=thread" <> arg "-DTSAN_ENABLED")
, builder (Cabal Flags) ? arg "thread-sanitizer"
, builder RunTest ? arg "--config=have_thread_sanitizer=True"
]
-- | Use the LLVM backend in stages 1 and later.
viaLlvmBackend :: Flavour -> Flavour
viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
-- | Build the GHC executable with profiling enabled. It is also recommended
-- that you use this with @'dynamicGhcPrograms' = False@ since GHC does not
-- support loading of profiled libraries with the dynamically-linker.
enableProfiledGhc :: Flavour -> Flavour
enableProfiledGhc flavour =
flavour { rtsWays = addWays [profiling, threadedProfiling, debugProfiling, threadedDebugProfiling] (rtsWays flavour)
, libraryWays = addWays [profiling] (libraryWays flavour)
, ghcProfiled = True
}
where
addWays :: [Way] -> Ways -> Ways
addWays ways =
fmap (++ ways)
-- | Disable 'dynamicGhcPrograms'.
disableDynamicGhcPrograms :: Flavour -> Flavour
disableDynamicGhcPrograms flavour = flavour { dynamicGhcPrograms = pure False }
-- | Don't build libraries in profiled 'Way's.
disableProfiledLibs :: Flavour -> Flavour
disableProfiledLibs flavour =
flavour { libraryWays = filter (not . wayUnit Profiling) <$> libraryWays flavour }
|