[Git][ghc/ghc][master] hadrian: Fix flavour compiler stage options off-by-one error
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Mar 8 20:03:28 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
7c813d06 by Alexis King at 2023-03-08T15:03:10-05:00
hadrian: Fix flavour compiler stage options off-by-one error
!9193 pointed out that ghcDebugAssertions was supposed to be a predicate
on the stage of the built compiler, but in practice it was a predicate
on the stage of the compiler used to build. Unfortunately, while it
fixed that issue for ghcDebugAssertions, it documented every other
similar option as behaving the same way when in fact they all used the
old behavior.
The new behavior of ghcDebugAssertions seems more intuitive, so this
commit changes the interpretation of every other option to match. It
also improves the enableProfiledGhc and debugGhc flavour transformers by
making them more selective about which stages in which they build
additional library/RTS ways.
- - - - -
9 changed files:
- hadrian/doc/user-settings.md
- hadrian/src/Expression.hs
- hadrian/src/Flavour.hs
- hadrian/src/Oracles/Flavour.hs
- hadrian/src/Settings/Builders/Ghc.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Flavours/Quick.hs
- hadrian/src/Settings/Packages.hs
Changes:
=====================================
hadrian/doc/user-settings.md
=====================================
@@ -227,17 +227,21 @@ prefixes, and `*` matches an entire path component, excluding any separators.
What was previously achieved by having `GhcDebugged=YES` in `mk/build.mk` can
be done by defining a custom flavour in the user settings file, one that
-sets the `ghcDebugged` field of `Flavour` to `True`, e.g:
+sets the `ghcDebugged` field of `Flavour` to `const True`, e.g:
``` haskell
quickDebug :: Flavour
-quickDebug = quickFlavour { name = "dbg", ghcDebugged = True }
+quickDebug = quickFlavour { name = "dbg", ghcDebugged = const True }
```
Running `build --flavour=dbg` will build a `quick`-flavoured GHC and link
GHC, iserv, iserv-proxy and remote-iserv against the debugged RTS, by passing
`-debug` to the commands that link those executables.
+More generally, a predicate on `Stage` can be provided to specify which stages should be built debugged. For example, setting `ghcDebugged = (>= Stage2)` will build a debugged compiler at stage 2 or higher, but not stage 1.
+
+Finally, the `debug_ghc` and `debug_stage1_ghc` [flavour transformers](#flavour-transformers) provide a convenient way to enable `ghcDebugged` on the command line without the need to define a separate custom flavour.
+
### Packages
Users can add and remove packages from particular build stages. As an example,
=====================================
hadrian/src/Expression.hs
=====================================
@@ -8,7 +8,8 @@ module Expression (
expr, exprIO, arg, remove, cabalFlag,
-- ** Predicates
- (?), stage, stage0, stage1, stage2, notStage0, threadedBootstrapper,
+ (?), stage, stage0, stage1, stage2, notStage0, buildingCompilerStage,
+ buildingCompilerStage', threadedBootstrapper,
package, notPackage, packageOneOf, cross, notCross,
libraryPackage, builder, way, input, inputs, output, outputs,
@@ -128,6 +129,16 @@ stage2 = stage Stage2
notStage0 :: Predicate
notStage0 = notM Expression.stage0
+-- | Are we currently building a compiler for a particular stage?
+buildingCompilerStage :: Stage -> Predicate
+buildingCompilerStage s = buildingCompilerStage' (== s)
+
+-- | Like 'buildingCompilerStage', but lifts an arbitrary predicate on 'Stage',
+-- which is useful for checking flavour fields like 'ghcProfiled' and
+-- 'ghcDebugged'.
+buildingCompilerStage' :: (Stage -> Bool) -> Predicate
+buildingCompilerStage' f = f . succStage <$> getStage
+
-- | Whether or not the bootstrapping compiler provides a threaded RTS. We need
-- to know this when building stage 1, since stage 1 links against the
=====================================
hadrian/src/Flavour.hs
=====================================
@@ -59,8 +59,8 @@ flavourTransformers = M.fromList
, "fully_static" =: fullyStatic
, "collect_timings" =: collectTimings
, "assertions" =: enableAssertions
- , "debug_ghc" =: debugGhc Stage1
- , "debug_stage1_ghc" =: debugGhc stage0InTree
+ , "debug_ghc" =: debugGhc Stage2
+ , "debug_stage1_ghc" =: debugGhc Stage1
, "lint" =: enableLinting
, "haddock" =: enableHaddock
, "hi_core" =: enableHiCore
@@ -215,18 +215,29 @@ enableThreadSanitizer = addArgs $ notStage0 ? mconcat
viaLlvmBackend :: Flavour -> Flavour
viaLlvmBackend = addArgs $ notStage0 ? builder Ghc ? arg "-fllvm"
--- | Build the GHC executable with profiling enabled in stages 1 and later. It
+-- | Build the GHC executable with profiling enabled in stages 2 and later. 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 =
- enableLateCCS flavour { rtsWays = do
- ws <- rtsWays flavour
- pure $ (Set.map (\w -> if wayUnit Dynamic w then w else w <> profiling) ws) <> ws
- , libraryWays = (Set.singleton profiling <>) <$> (libraryWays flavour)
- , ghcProfiled = (>= Stage1)
- }
+ enableLateCCS flavour
+ { rtsWays = do
+ ws <- rtsWays flavour
+ mconcat
+ [ pure ws
+ , buildingCompilerStage' (>= Stage2) ? pure (foldMap profiled_ways ws)
+ ]
+ , libraryWays = mconcat
+ [ libraryWays flavour
+ , buildingCompilerStage' (>= Stage2) ? pure (Set.singleton profiling)
+ ]
+ , ghcProfiled = (>= Stage2)
+ }
+ where
+ profiled_ways w
+ | wayUnit Dynamic w = Set.empty
+ | otherwise = Set.singleton (w <> profiling)
-- | Disable 'dynamicGhcPrograms'.
disableDynamicGhcPrograms :: Flavour -> Flavour
@@ -350,11 +361,14 @@ collectTimings =
-- | Build ghc with debug rts (i.e. -debug) in and after this stage
debugGhc :: Stage -> Flavour -> Flavour
-debugGhc stage f = f
- { ghcDebugged = (>= stage)
+debugGhc ghcStage f = f
+ { ghcDebugged = (>= ghcStage)
, rtsWays = do
ws <- rtsWays f
- pure $ (Set.map (\w -> w <> debug) ws) <> ws
+ mconcat
+ [ pure ws
+ , buildingCompilerStage' (>= ghcStage) ? pure (Set.map (<> debug) ws)
+ ]
}
-- * CLI and <root>/hadrian.settings options
=====================================
hadrian/src/Oracles/Flavour.hs
=====================================
@@ -24,7 +24,8 @@ type instance RuleResult GhcProfiled = Bool
oracles :: Rules ()
oracles = do
void $ addOracle $ \(DynGhcPrograms _) -> dynamicGhcPrograms =<< flavour
- void $ addOracle $ \(GhcProfiled stage) -> ghcProfiled <$> flavour <*> pure stage
+ void $ addOracle $ \(GhcProfiled stage) ->
+ ghcProfiled <$> flavour <*> pure (succStage stage)
askDynGhcPrograms :: Action Bool
askDynGhcPrograms = askOracle $ DynGhcPrograms ()
=====================================
hadrian/src/Settings/Builders/Ghc.hs
=====================================
@@ -116,7 +116,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
useSystemFfi <- expr (flag UseSystemFfi)
buildPath <- getBuildPath
libffiName' <- libffiName
- debugged <- ghcDebugged <$> expr flavour <*> getStage
+ debugged <- buildingCompilerStage' . ghcDebugged =<< expr flavour
osxTarget <- expr isOsxTarget
winTarget <- expr isWinTarget
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -101,8 +101,10 @@ inTreeCompilerArgs stg = do
unregisterised <- flag GhcUnregisterised
tables_next_to_code <- flag TablesNextToCode
targetWithSMP <- targetSupportsSMP
- debugAssertions <- ($ succStage stg) . ghcDebugAssertions <$> flavour
- profiled <- ghcProfiled <$> flavour <*> pure stg
+
+ let ghcStage = succStage stg
+ debugAssertions <- ghcDebugAssertions <$> flavour <*> pure ghcStage
+ profiled <- ghcProfiled <$> flavour <*> pure ghcStage
os <- setting HostOs
arch <- setting TargetArch
=====================================
hadrian/src/Settings/Flavours/Development.hs
=====================================
@@ -24,8 +24,7 @@ developmentFlavour ghcStage = defaultFlavour
stageString s = error ("developmentFlavour not supported for " ++ show s)
developmentArgs :: Stage -> Args
-developmentArgs ghcStage = do
- stage <- getStage
+developmentArgs ghcStage =
sourceArgs SourceArgs
{ hsDefault = mconcat [ pure ["-O", "-H64m"],
-- Disable optimization when building Cabal;
@@ -33,5 +32,5 @@ developmentArgs ghcStage = do
package cabal ? pure ["-O0"]]
, hsLibrary = notStage0 ? arg "-dlint"
, hsCompiler = mconcat [stage0 ? arg "-O2",
- stage == predStage ghcStage ? pure ["-O0"]]
- , hsGhc = stage == predStage ghcStage ? pure ["-O0"] }
+ buildingCompilerStage ghcStage ? pure ["-O0"]]
+ , hsGhc = buildingCompilerStage ghcStage ? pure ["-O0"] }
=====================================
hadrian/src/Settings/Flavours/Quick.hs
=====================================
@@ -42,5 +42,5 @@ quickArgs = sourceArgs SourceArgs
quickDebugFlavour :: Flavour
quickDebugFlavour = quickFlavour
{ name = "quick-debug"
- , ghcDebugged = (>= Stage1)
+ , ghcDebugged = (>= Stage2)
}
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -6,7 +6,6 @@ import Oracles.Setting
import Oracles.Flag
import Packages
import Settings
-import Oracles.Flavour
-- | Package-specific command-line arguments.
packageArgs :: Args
@@ -24,14 +23,12 @@ packageArgs = do
-- are building. This is used to build cross-compilers
bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1
+ compilerStageOption f = buildingCompilerStage' . f =<< expr flavour
+
cursesIncludeDir <- getSetting CursesIncludeDir
cursesLibraryDir <- getSetting CursesLibDir
ffiIncludeDir <- getSetting FfiIncludeDir
ffiLibraryDir <- getSetting FfiLibDir
- debugAssertions <- ( `ghcDebugAssertions` (succStage stage) ) <$> expr flavour
- -- NB: in this function, "stage" is the stage of the compiler we are
- -- using to build, but ghcDebugAssertions wants the stage of the compiler
- -- we are building, which we get using succStage.
mconcat
--------------------------------- base ---------------------------------
@@ -54,7 +51,7 @@ packageArgs = do
[ builder Alex ? arg "--latin1"
, builder (Ghc CompileHs) ? mconcat
- [ debugAssertions ? arg "-DDEBUG"
+ [ compilerStageOption ghcDebugAssertions ? arg "-DDEBUG"
, inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto"
, input "**/Parser.hs" ?
@@ -71,7 +68,7 @@ packageArgs = do
, builder (Cabal Setup) ? mconcat
[ arg "--disable-library-for-ghci"
, anyTargetOs ["openbsd"] ? arg "--ld-options=-E"
- , (getStage >>= expr . askGhcProfiled) ? arg "--ghc-pkg-option=--force" ]
+ , compilerStageOption ghcProfiled ? arg "--ghc-pkg-option=--force" ]
, builder (Cabal Flags) ? mconcat
[ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"
@@ -85,7 +82,7 @@ packageArgs = do
, package ghc ? mconcat
[ builder Ghc ? mconcat
[ arg ("-I" ++ compilerPath)
- , debugAssertions ? arg "-DDEBUG" ]
+ , compilerStageOption ghcDebugAssertions ? arg "-DDEBUG" ]
, builder (Cabal Flags) ? mconcat
[ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"
@@ -96,7 +93,7 @@ packageArgs = do
-- We build a threaded stage N, N>1 if the configuration calls
-- for it.
- ((ghcThreaded <$> expr flavour <*> getStage ) `cabalFlag` "threaded")
+ (compilerStageOption ghcThreaded `cabalFlag` "threaded")
]
]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c813d0688f03c782d3c3a93a8369a48b7e74c8d
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7c813d0688f03c782d3c3a93a8369a48b7e74c8d
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230308/83d0010f/attachment-0001.html>
More information about the ghc-commits
mailing list