hadrian: Enrich flavours to build profiled/debugged/threaded ghcs per stage

11 files changed, 30 insertions, 32 deletions

diff --git a/hadrian/src/Flavour.hs b/hadrian/src/Flavour.hs
index a3b93f6094..178eda3a8b 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 46d540aabe..ed3730a006 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 88e9c89757..040787a7b2 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 a1bc0612ef..27ef2336f1 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 9dd481d7fe..47ac5f0ed9 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 33d09737c3..cc0f955c7f 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 b13f65cd92..54562b8aa3 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 afffa4ceb7..fa668bf1ba 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 d88c96115e..85fd0812f6 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 d98b1a9327..d45b265008 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 4a719eb501..b205390d37 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)