[Git][ghc/ghc][master] Hadrian: fix ghcDebugAssertions off-by-one error
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Tue Dec 6 20:46:16 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
cd31acad by sheaf at 2022-12-06T15:45:58-05:00
Hadrian: fix ghcDebugAssertions off-by-one error
Commit 6b2f7ffe changed the logic that decided whether to enable debug
assertions. However, it had an off-by-one error, as the stage parameter
to the function inconsistently referred to the stage of the compiler
being used to build or the stage of the compiler we are building.
This patch makes it consistent. Now the parameter always refers to the
the compiler which is being built.
In particular, this patch re-enables
assertions in the stage 2 compiler when building with devel2 flavour,
and disables assertions in the stage 2 compiler when building with
validate flavour.
Some extra performance tests are now run in the "validate" jobs because
the stage2 compiler no longer contains assertions.
-------------------------
Metric Decrease:
CoOpt_Singletons
MultiComponentModules
MultiComponentModulesRecomp
MultiLayerModulesTH_OneShot
T11374
T12227
T12234
T13253-spj
T13701
T14683
T14697
T15703
T17096
T17516
T18304
T18478
T18923
T5030
T9872b
TcPlugin_RewritePerf
Metric Increase:
MultiComponentModules
MultiComponentModulesRecomp
MultiLayerModules
MultiLayerModulesRecomp
MultiLayerModulesTH_Make
T13386
T13719
T3294
T9233
T9675
parsing001
-------------------------
- - - - -
5 changed files:
- hadrian/doc/user-settings.md
- hadrian/src/Flavour/Type.hs
- hadrian/src/Settings/Builders/RunTest.hs
- hadrian/src/Settings/Flavours/Development.hs
- hadrian/src/Settings/Packages.hs
Changes:
=====================================
hadrian/doc/user-settings.md
=====================================
@@ -25,7 +25,7 @@ data Flavour = Flavour {
packages :: Stage -> Action [Package],
-- | Bignum backend: 'native', 'gmp', 'ffi', etc.
bignumBackend :: String,
- -- | Check bignum backend against native
+ -- | Check selected bignum backend against native backend
bignumCheck :: Bool,
-- | Build libraries these ways.
libraryWays :: Ways,
@@ -34,15 +34,20 @@ data Flavour = Flavour {
-- | Build dynamic GHC programs.
dynamicGhcPrograms :: Action Bool,
-- | Enable GHCi debugger.
- ghciWithDebugger :: Bool,
+ ghciWithDebugger :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Build profiled GHC.
- ghcProfiled :: Bool,
+ ghcProfiled :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Build GHC with the debug RTS.
- ghcDebugged :: Bool,
+ ghcDebugged :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Build GHC with debug assertions (-DDEBUG).
- ghcDebugAssertions :: Bool,
+ ghcDebugAssertions :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Build the GHC executable against the threaded runtime system.
- ghcThreaded :: Bool,
+ ghcThreaded :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Whether to build docs and which ones
-- (haddocks, user manual, haddock manual)
ghcDocs :: Action DocTargets }
=====================================
hadrian/src/Flavour/Type.hs
=====================================
@@ -18,9 +18,9 @@ data Flavour = Flavour {
args :: Args,
-- | Build these packages.
packages :: Stage -> Action [Package],
- -- | 'native', 'gmp', 'ffi'.
+ -- | Bignum backend: 'native', 'gmp', 'ffi', etc.
bignumBackend :: String,
- -- | Check selected backend against native backend
+ -- | Check selected bignum backend against native backend
bignumCheck :: Bool,
-- | Build libraries these ways.
libraryWays :: Ways,
@@ -29,15 +29,20 @@ data Flavour = Flavour {
-- | Build dynamic GHC programs.
dynamicGhcPrograms :: Action Bool,
-- | Enable GHCi debugger.
- ghciWithDebugger :: Stage -> Bool,
+ ghciWithDebugger :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Build profiled GHC.
- ghcProfiled :: Stage -> Bool,
+ ghcProfiled :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Build GHC with the debug RTS.
- ghcDebugged :: Stage -> Bool,
- -- | Build GHC with debug assertions.
- ghcDebugAssertions :: Stage -> Bool,
+ ghcDebugged :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
+ -- | Build GHC with debug assertions (-DDEBUG).
+ ghcDebugAssertions :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Build the GHC executable against the threaded runtime system.
- ghcThreaded :: Stage -> Bool,
+ ghcThreaded :: Stage -- ^ stage of the /built/ compiler
+ -> Bool,
-- | Whether to build docs and which ones
-- (haddocks, user manual, haddock manual)
ghcDocs :: Action DocTargets }
=====================================
hadrian/src/Settings/Builders/RunTest.hs
=====================================
@@ -101,7 +101,7 @@ inTreeCompilerArgs stg = do
unregisterised <- flag GhcUnregisterised
tables_next_to_code <- flag TablesNextToCode
withSMP <- targetSupportsSMP
- debugAssertions <- ($ stg) . ghcDebugAssertions <$> flavour
+ debugAssertions <- ($ succStage stg) . ghcDebugAssertions <$> flavour
profiled <- ghcProfiled <$> flavour <*> pure stg
os <- setting HostOs
=====================================
hadrian/src/Settings/Flavours/Development.hs
=====================================
@@ -16,12 +16,12 @@ developmentFlavour ghcStage = defaultFlavour
, libraryWays = pure $ Set.fromList [vanilla]
, rtsWays = Set.fromList <$> mconcat [pure [vanilla, debug], targetSupportsThreadedRts ? pure [threaded, threadedDebug]]
, dynamicGhcPrograms = return False
- , ghcDebugAssertions = (>= Stage2) }
+ , ghcDebugAssertions = (== ghcStage) }
where
stageString Stage2 = "2"
stageString Stage1 = "1"
stageString Stage3 = "3"
- stageString s = error ("developmentFlavour not support for " ++ show s)
+ stageString s = error ("developmentFlavour not supported for " ++ show s)
developmentArgs :: Stage -> Args
developmentArgs ghcStage = do
=====================================
hadrian/src/Settings/Packages.hs
=====================================
@@ -13,7 +13,6 @@ packageArgs :: Args
packageArgs = do
stage <- getStage
path <- getBuildPath
- root <- getBuildRoot
compilerPath <- expr $ buildPath (vanillaContext stage compiler)
let -- Do not bind the result to a Boolean: this forces the configure rule
@@ -29,7 +28,10 @@ packageArgs = do
cursesLibraryDir <- getSetting CursesLibDir
ffiIncludeDir <- getSetting FfiIncludeDir
ffiLibraryDir <- getSetting FfiLibDir
- debugAssertions <- ghcDebugAssertions <$> expr flavour
+ 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 ---------------------------------
@@ -52,7 +54,7 @@ packageArgs = do
[ builder Alex ? arg "--latin1"
, builder (Ghc CompileHs) ? mconcat
- [ debugAssertions stage ? arg "-DDEBUG"
+ [ debugAssertions ? arg "-DDEBUG"
, inputs ["**/GHC.hs", "**/GHC/Driver/Make.hs"] ? arg "-fprof-auto"
, input "**/Parser.hs" ?
@@ -83,7 +85,7 @@ packageArgs = do
, package ghc ? mconcat
[ builder Ghc ? mconcat
[ arg ("-I" ++ compilerPath)
- , debugAssertions stage ? arg "-DDEBUG" ]
+ , debugAssertions ? arg "-DDEBUG" ]
, builder (Cabal Flags) ? mconcat
[ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd31acad391582dd16b00a823271b364ab063ca9
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd31acad391582dd16b00a823271b364ab063ca9
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/20221206/f6c1dee5/attachment-0001.html>
More information about the ghc-commits
mailing list