diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index a3b93f6094d4c780965678985d2b408714bcd53d..178eda3a8bf0846afe5eb78f5298f5a93070eb50 100644
--- a/hadrian/src/Flavour.hs
+++ b/hadrian/src/Flavour.hs
@@ -162,19 +162,18 @@ enableThreadSanitizer = addArgs $ mconcat
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.
+-- | Build the GHC executable with profiling enabled in stages 1 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 = addWays [profiling, threadedProfiling, debugProfiling, threadedDebugProfiling] (rtsWays flavour)
- , libraryWays = addWays [profiling] (libraryWays flavour)
- , ghcProfiled = True
+ enableLateCCS flavour { rtsWays = do
+ ws <- rtsWays flavour
+ pure $ (Set.map (\w -> w <> profiling) ws) <> ws
+ , libraryWays = (Set.singleton profiling <>) <$> (libraryWays flavour)
+ , ghcProfiled = (>= Stage1)
}
- where
- addWays :: [Way] -> Ways -> Ways
- addWays ways =
- fmap (Set.union (Set.fromList ways))
-- | Disable 'dynamicGhcPrograms'.
disableDynamicGhcPrograms :: Flavour -> Flavour
@@ -271,7 +270,6 @@ collectTimings =
addArgs $ notStage0 ? builder (Ghc CompileHs) ?
pure ["-ddump-to-file", "-ddump-timings", "-v"]
-
-- * CLI and <root>/hadrian.settings options
{-
diff --git a/hadrian/src/Flavour/Type.hs b/hadrian/src/Flavour/Type.hs
index 46d540aabe2216f5fa5643c3b96322b00ab8d637..ed3730a0069d777db504bd58fad20a30052b6930 100644
--- a/hadrian/src/Flavour/Type.hs
+++ b/hadrian/src/Flavour/Type.hs
@@ -29,15 +29,15 @@ data Flavour = Flavour {
-- | Build dynamic GHC programs.
dynamicGhcPrograms :: Action Bool,
-- | Enable GHCi debugger.
- ghciWithDebugger :: Bool,
+ ghciWithDebugger :: Stage -> Bool,
-- | Build profiled GHC.
- ghcProfiled :: Bool,
+ ghcProfiled :: Stage -> Bool,
-- | Build GHC with the debug RTS.
- ghcDebugged :: Bool,
+ ghcDebugged :: Stage -> Bool,
-- | Build GHC with debug assertions.
ghcDebugAssertions :: Bool,
-- | Build the GHC executable against the threaded runtime system.
- ghcThreaded :: Bool,
+ ghcThreaded :: Stage -> Bool,
-- | Whether to build docs and which ones
-- (haddocks, user manual, haddock manual)
ghcDocs :: Action DocTargets }
diff --git a/hadrian/src/Oracles/Flavour.hs b/hadrian/src/Oracles/Flavour.hs
index 88e9c897574b413ce6e7c676aac5b77de32e7630..040787a7b2355d1c1c215450b736280db359b9d8 100644
--- a/hadrian/src/Oracles/Flavour.hs
+++ b/hadrian/src/Oracles/Flavour.hs
@@ -18,16 +18,16 @@ newtype DynGhcPrograms =
type instance RuleResult DynGhcPrograms = Bool
newtype GhcProfiled =
- GhcProfiled () deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
+ GhcProfiled Stage deriving (Show, Typeable, Eq, Hashable, Binary, NFData)
type instance RuleResult GhcProfiled = Bool
oracles :: Rules ()
oracles = do
void $ addOracle $ \(DynGhcPrograms _) -> dynamicGhcPrograms =<< flavour
- void $ addOracle $ \(GhcProfiled _) -> ghcProfiled <$> flavour
+ void $ addOracle $ \(GhcProfiled stage) -> ghcProfiled <$> flavour <*> pure stage
askDynGhcPrograms :: Action Bool
askDynGhcPrograms = askOracle $ DynGhcPrograms ()
-askGhcProfiled :: Action Bool
-askGhcProfiled = askOracle $ GhcProfiled ()
+askGhcProfiled :: Stage -> Action Bool
+askGhcProfiled s = askOracle $ GhcProfiled s
diff --git a/hadrian/src/Rules/Test.hs b/hadrian/src/Rules/Test.hs
index a1bc0612ef133ff9520ddb3a6a409eedd9383f75..27ef2336f175aecefcdca48ffe04ae8f5809e2bc 100644
--- a/hadrian/src/Rules/Test.hs
+++ b/hadrian/src/Rules/Test.hs
@@ -146,7 +146,7 @@ testRules = do
top <- topDirectory
depsPkgs <- mod_pkgs . packageDependencies <$> readPackageData progPkg
bindir <- getBinaryDirectory testGhc
- debugged <- ghcDebugged <$> flavour
+ debugged <- ghcDebugged <$> flavour <*> pure Stage3
dynPrograms <- dynamicGhcPrograms =<< flavour
cmd [bindir </> "ghc" <.> exe] $
concatMap (\p -> ["-package", pkgName p]) depsPkgs ++
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
index 9dd481d7fe303e8469e0b221daa84eee2311728b..47ac5f0ed966f932452fa0b3cc50205e31e3db42 100644
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ b/hadrian/src/Settings/Builders/Ghc.hs
@@ -115,7 +115,7 @@ ghcLinkArgs = builder (Ghc LinkHs) ? do
useSystemFfi <- expr (flag UseSystemFfi)
buildPath <- getBuildPath
libffiName' <- libffiName
- debugged <- ghcDebugged <$> expr flavour
+ debugged <- ghcDebugged <$> expr flavour <*> getStage
osxTarget <- expr isOsxTarget
winTarget <- expr isWinTarget
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 33d09737c35820fd9d2ff078b9d02cee330bfee0..cc0f955c7f84b7057319ee56a37be5ec79127431 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -98,7 +98,7 @@ inTreeCompilerArgs stg = do
unregisterised <- flag GhcUnregisterised
withSMP <- targetSupportsSMP
debugAssertions <- ghcDebugAssertions <$> flavour
- profiled <- ghcProfiled <$> flavour
+ profiled <- ghcProfiled <$> flavour <*> pure stg
os <- setting HostOs
arch <- setting TargetArch
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index b13f65cd92f5f8352d394f624538a5d269391048..54562b8aa3e84b11df58952fb397edcd77c5e9fc 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -235,11 +235,11 @@ defaultFlavour = Flavour
, libraryWays = defaultLibraryWays
, rtsWays = defaultRtsWays
, dynamicGhcPrograms = defaultDynamicGhcPrograms
- , ghciWithDebugger = False
- , ghcProfiled = False
- , ghcDebugged = False
+ , ghciWithDebugger = const False
+ , ghcProfiled = const False
+ , ghcDebugged = const False
+ , ghcThreaded = const True
, ghcDebugAssertions = False
- , ghcThreaded = True
, ghcDocs = cmdDocsArgs }
-- | Default logic for determining whether to build
diff --git a/hadrian/src/Settings/Flavours/Quick.hs b/hadrian/src/Settings/Flavours/Quick.hs
index afffa4ceb754631f6f3f7e636b93a4e33e41e3df..fa668bf1ba788c8a44fe3fa37e8be54b6fd4d56e 100644
--- a/hadrian/src/Settings/Flavours/Quick.hs
+++ b/hadrian/src/Settings/Flavours/Quick.hs
@@ -39,5 +39,5 @@ quickArgs = sourceArgs SourceArgs
quickDebugFlavour :: Flavour
quickDebugFlavour = quickFlavour
{ name = "quick-debug"
- , ghcDebugged = True
+ , ghcDebugged = (>= Stage1)
}
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index d88c96115e6c6dad6462bf73d1c1cdc6bdf9c762..85fd0812f65550f3e4af3b30d2e96875c623a814 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -6,6 +6,7 @@ import Oracles.Setting
import Oracles.Flag
import Packages
import Settings
+import Oracles.Flavour
-- | Package-specific command-line arguments.
packageArgs :: Args
@@ -67,8 +68,7 @@ packageArgs = do
, builder (Cabal Setup) ? mconcat
[ arg "--disable-library-for-ghci"
, anyTargetOs ["openbsd"] ? arg "--ld-options=-E"
- , ghcProfiled <$> flavour ?
- notStage0 ? arg "--ghc-pkg-option=--force" ]
+ , (getStage >>= expr . askGhcProfiled) ? arg "--ghc-pkg-option=--force" ]
, builder (Cabal Flags) ? mconcat
[ andM [expr ghcWithInterpreter, notStage0] `cabalFlag` "internal-interpreter"
@@ -93,7 +93,7 @@ packageArgs = do
-- We build a threaded stage N, N>1 if the configuration calls
-- for it.
- ((ghcThreaded <$> expr flavour) `cabalFlag` "threaded")
+ ((ghcThreaded <$> expr flavour <*> getStage ) `cabalFlag` "threaded")
]
]
diff --git a/hadrian/src/Settings/Program.hs b/hadrian/src/Settings/Program.hs
index d98b1a932775b715055b5b8f715dc5f6d5bf5dd1..d45b265008065e2c70e9a374d73e835b561723bf 100644
--- a/hadrian/src/Settings/Program.hs
+++ b/hadrian/src/Settings/Program.hs
@@ -12,7 +12,7 @@ import Packages
-- get a context/contexts for a given stage and package.
programContext :: Stage -> Package -> Action Context
programContext stage pkg = do
- profiled <- askGhcProfiled
+ profiled <- askGhcProfiled stage
dynGhcProgs <- askDynGhcPrograms --dynamicGhcPrograms =<< flavour
return $ Context stage pkg (wayFor profiled dynGhcProgs)
diff --git a/hadrian/src/Way/Type.hs b/hadrian/src/Way/Type.hs
index 4a719eb5012e725abd4bb562c27a25c5e294e2cd..b205390d3774df82dc172939ed317cba9792e19b 100644
--- a/hadrian/src/Way/Type.hs
+++ b/hadrian/src/Way/Type.hs
@@ -39,7 +39,7 @@ instance Read WayUnit where
"dyn" -> [(Dynamic,"")]
_ -> []
--- | Collection of 'WayUnit's that stands for the different ways source codeA
+-- | Collection of 'WayUnit's that stands for the different ways source code
-- is to be built.
newtype Way = Way IntSet
deriving newtype (Semigroup, Monoid)