diff options
| -rw-r--r-- | hadrian/doc/user-settings.md | 8 | ||||
| -rw-r--r-- | hadrian/src/Expression.hs | 13 | ||||
| -rw-r--r-- | hadrian/src/Flavour.hs | 38 | ||||
| -rw-r--r-- | hadrian/src/Oracles/Flavour.hs | 3 | ||||
| -rw-r--r-- | hadrian/src/Settings/Builders/Ghc.hs | 2 | ||||
| -rw-r--r-- | hadrian/src/Settings/Builders/RunTest.hs | 6 | ||||
| -rw-r--r-- | hadrian/src/Settings/Flavours/Development.hs | 7 | ||||
| -rw-r--r-- | hadrian/src/Settings/Flavours/Quick.hs | 2 | ||||
| -rw-r--r-- | hadrian/src/Settings/Packages.hs | 15 |
9 files changed, 61 insertions, 33 deletions
diff --git a/hadrian/doc/user-settings.md b/hadrian/doc/user-settings.md index 795f877557..5616d871be 100644 --- a/hadrian/doc/user-settings.md +++ b/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, diff --git a/hadrian/src/Expression.hs b/hadrian/src/Expression.hs index db437013b4..0b9c50ef3a 100644 --- a/hadrian/src/Expression.hs +++ b/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 diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs index 79eb18bed4..6f68d6c6ba 100644 --- a/hadrian/src/Flavour.hs +++ b/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 diff --git a/hadrian/src/Oracles/Flavour.hs b/hadrian/src/Oracles/Flavour.hs index 040787a7b2..cf9ec7e3c2 100644 --- a/hadrian/src/Oracles/Flavour.hs +++ b/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 () diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs index 88bd26bd62..aa243db30c 100644 --- a/hadrian/src/Settings/Builders/Ghc.hs +++ b/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 diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs index b096f05a45..a0a245458b 100644 --- a/hadrian/src/Settings/Builders/RunTest.hs +++ b/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 diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs index ccc592cdc6..c710d8855f 100644 --- a/hadrian/src/Settings/Flavours/Development.hs +++ b/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"] } diff --git a/hadrian/src/Settings/Flavours/Quick.hs b/hadrian/src/Settings/Flavours/Quick.hs index 25a5624b9b..6df22c5712 100644 --- a/hadrian/src/Settings/Flavours/Quick.hs +++ b/hadrian/src/Settings/Flavours/Quick.hs @@ -42,5 +42,5 @@ quickArgs = sourceArgs SourceArgs quickDebugFlavour :: Flavour quickDebugFlavour = quickFlavour { name = "quick-debug" - , ghcDebugged = (>= Stage1) + , ghcDebugged = (>= Stage2) } diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs index e2afd72ee5..05f7b6fb1e 100644 --- a/hadrian/src/Settings/Packages.hs +++ b/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") ] ] |