hadrian: Introduce new package database for executables needed to build stage0

These executables (such as hsc2hs) are built using the boot compiler and
crucially, most libraries from the global package database.

We also move other build-time executables to be built in this stage such
as linters which also cleans up which libraries end up in the global
package database. This allows us to remove hacks where linters-common is
removed from the package database when a bindist is created.

This fixes issues caused by infinite recursion due to bytestring adding
a dependency on template-haskell.

Fixes #21634

10 files changed, 46 insertions, 32 deletions

diff --git a/hadrian/src/Settings/Builders/Cabal.hs b/hadrian/src/Settings/Builders/Cabal.hs
index 82e34d8594..4486ab002b 100644
--- a/hadrian/src/Settings/Builders/Cabal.hs
+++ b/hadrian/src/Settings/Builders/Cabal.hs
@@ -39,7 +39,7 @@ cabalInstallArgs = builder (Cabal Install) ?  do
 -- of the stage 2 compiler
 assertNoBuildRootLeak :: Args -> Args
 assertNoBuildRootLeak args = do
-  libPaths <- expr $ mapM stageLibPath [Stage0 ..]
+  libPaths <- expr $ mapM stageLibPath allStages
   xs <- args
   pure $ assert (not $ any (\arg -> or [libPath `isInfixOf` arg && not ("package.conf.d" `isSuffixOf` arg)
                                        | libPath <- libPaths]) xs)
@@ -205,8 +205,8 @@ configureArgs cFlags' ldFlags' = do
         ]
 
 bootPackageConstraints :: Args
-bootPackageConstraints = stage0 ? do
-    bootPkgs <- expr $ stagePackages Stage0
+bootPackageConstraints = (stage0InTree ==) <$> getStage ? do
+    bootPkgs <- expr $ stagePackages stage0InTree
     let pkgs = filter (\p -> p /= compiler && isLibrary p) bootPkgs
     constraints <- expr $ forM (sort pkgs) $ \pkg -> do
         version <- pkgVersion pkg
diff --git a/hadrian/src/Settings/Builders/Ghc.hs b/hadrian/src/Settings/Builders/Ghc.hs
index 3804c7ecc9..7deb22f179 100644
--- a/hadrian/src/Settings/Builders/Ghc.hs
+++ b/hadrian/src/Settings/Builders/Ghc.hs
@@ -24,7 +24,7 @@ ghcBuilderArgs = mconcat
       -- config at build time.
       -- See Note [Genapply target as host for RTS macros].
       stage <- getStage
-      nextStageRtsBuildDir <- expr $ rtsBuildPath $ succ stage
+      nextStageRtsBuildDir <- expr $ rtsBuildPath $ succStage stage
       let nextStageRtsBuildIncludeDir = nextStageRtsBuildDir </> "include"
       builder Ghc ? arg ("-I" ++ nextStageRtsBuildIncludeDir)
   , compileAndLinkHs, compileC, compileCxx, findHsDependencies
diff --git a/hadrian/src/Settings/Builders/GhcPkg.hs b/hadrian/src/Settings/Builders/GhcPkg.hs
index 752f1718da..5de76cc753 100644
--- a/hadrian/src/Settings/Builders/GhcPkg.hs
+++ b/hadrian/src/Settings/Builders/GhcPkg.hs
@@ -35,7 +35,7 @@ ghcPkgBuilderArgs = mconcat
         config    <- expr $ pkgInplaceConfig context
         stage     <- getStage
         pkgDb     <- expr $ packageDbPath stage
-        mconcat [ notStage0 ? use_db pkgDb
+        mconcat [ notM stage0 ? use_db pkgDb
                 , arg "update"
                 , arg "--force"
                 , verbosity < Verbose ? arg "-v0"
diff --git a/hadrian/src/Settings/Builders/Hsc2Hs.hs b/hadrian/src/Settings/Builders/Hsc2Hs.hs
index f1a44b5e87..7492f6e29a 100644
--- a/hadrian/src/Settings/Builders/Hsc2Hs.hs
+++ b/hadrian/src/Settings/Builders/Hsc2Hs.hs
@@ -16,10 +16,10 @@ hsc2hsBuilderArgs = builder Hsc2Hs ? do
     hOs     <- getSetting HostOs
     tArch   <- getSetting TargetArch
     tOs     <- getSetting TargetOs
-    version <- if stage == Stage0
-               then expr ghcCanonVersion
-               else getSetting ProjectVersionInt
-    tmpl <- (top -/-) <$> expr (templateHscPath Stage0)
+    version <- case stage of
+                  Stage0 {} -> expr ghcCanonVersion
+                  _ ->  getSetting ProjectVersionInt
+    tmpl <- (top -/-) <$> expr (templateHscPath stage0Boot)
     mconcat [ arg $ "--cc=" ++ ccPath
             , arg $ "--ld=" ++ ccPath
             , notM isWinTarget ? notM (flag CrossCompiling) ? arg "--cross-safe"
diff --git a/hadrian/src/Settings/Builders/Make.hs b/hadrian/src/Settings/Builders/Make.hs
index f00aab9776..22096a0838 100644
--- a/hadrian/src/Settings/Builders/Make.hs
+++ b/hadrian/src/Settings/Builders/Make.hs
@@ -12,7 +12,7 @@ makeBuilderArgs = do
     threads    <- shakeThreads <$> expr getShakeOptions
     stage      <- getStage
     gmpPath    <- expr (gmpBuildPath stage)
-    libffiPaths <- forM [Stage1 ..] $ \s -> expr (libffiBuildPath s)
+    libffiPaths <- forM [Stage1, Stage2, Stage3 ] $ \s -> expr (libffiBuildPath s)
     let t = show $ max 4 (threads - 2) -- Don't use all Shake's threads
     mconcat $
         (builder (Make gmpPath   ) ? pure ["MAKEFLAGS=-j" ++ t]) :
diff --git a/hadrian/src/Settings/Builders/RunTest.hs b/hadrian/src/Settings/Builders/RunTest.hs
index 0e442cb9be..f6b40d4065 100644
--- a/hadrian/src/Settings/Builders/RunTest.hs
+++ b/hadrian/src/Settings/Builders/RunTest.hs
@@ -264,7 +264,7 @@ runTestBuilderArgs = builder Testsuite ? do
             , arg "-e", arg $ "config.os="       ++ show os
             , arg "-e", arg $ "config.arch="     ++ show arch
             , arg "-e", arg $ "config.platform=" ++ show platform
-            , arg "-e", arg $ "config.stage="    ++ show (fromEnum (C.stage ctx) + 1)
+            , arg "-e", arg $ "config.stage="    ++ show (stageNumber (C.stage ctx))
 
             , arg "--config", arg $ "gs=gs"                           -- Use the default value as in test.mk
             , arg "--config", arg $ "timeout_prog=" ++ show (top -/- timeoutProg)
@@ -281,6 +281,12 @@ runTestBuilderArgs = builder Testsuite ? do
       where emitWhenSet Nothing  _ = mempty
             emitWhenSet (Just v) f = f v
 
+            stageNumber (Stage0 GlobalLibs) = error "stageNumber stageBoot"
+            stageNumber (Stage0 InTreeLibs) = 1
+            stageNumber Stage1 = 2
+            stageNumber Stage2 = 3
+            stageNumber Stage3 = 4
+
 -- | Command line arguments for running GHC's test script.
 getTestArgs :: Args
 getTestArgs = do
diff --git a/hadrian/src/Settings/Default.hs b/hadrian/src/Settings/Default.hs
index 54562b8aa3..ae9ea2ce81 100644
--- a/hadrian/src/Settings/Default.hs
+++ b/hadrian/src/Settings/Default.hs
@@ -50,7 +50,8 @@ import Settings.Builders.Win32Tarballs
 
 -- | Packages that are built by default. You can change this in "UserSettings".
 defaultPackages :: Stage -> Action [Package]
-defaultPackages Stage0 = stage0Packages
+defaultPackages (Stage0 GlobalLibs) = stageBootPackages
+defaultPackages (Stage0 InTreeLibs) = stage0Packages
 defaultPackages Stage1 = stage1Packages
 defaultPackages Stage2 = stage2Packages
 defaultPackages Stage3 = return []
@@ -59,19 +60,26 @@ defaultPackages Stage3 = return []
 defaultBignumBackend :: String
 defaultBignumBackend = "gmp"
 
+-- These packages are things needed to do the build.. so they are only built by
+-- boot compiler, with global package database. By default we will only build these
+-- packages in StageBoot so if you also need to distribute anything here then add
+-- it to `stage0packages` or `stage1packages` as appropiate.
+stageBootPackages :: Action [Package]
+stageBootPackages = return [lintersCommon, lintCommitMsg, lintSubmoduleRefs, lintWhitespace, lintNotes, hsc2hs, compareSizes, deriveConstants, genapply, genprimopcode, unlit ]
+
 -- | Packages built in 'Stage0' by default. You can change this in "UserSettings".
 stage0Packages :: Action [Package]
 stage0Packages = do
     cross <- flag CrossCompiling
+    winTarget  <- isWinTarget
     return $ [ binary
+             , bytestring
              , cabalSyntax
              , cabal
-             , compareSizes
              , compiler
-             , deriveConstants
+             , directory
+             , process
              , exceptions
-             , genapply
-             , genprimopcode
              , ghc
              , runGhc
              , ghcBoot
@@ -85,15 +93,12 @@ stage0Packages = do
              , hpcBin
              , mtl
              , parsec
+             , time
              , templateHaskell
              , text
              , transformers
              , unlit
-             , lintersCommon
-             , lintNotes
-             , lintCommitMsg
-             , lintSubmoduleRefs
-             , lintWhitespace
+             , if winTarget then win32 else unix
              ]
           ++ [ terminfo | not windowsHost, not cross ]
           ++ [ timeout  | windowsHost                ]
@@ -113,10 +118,8 @@ stage1Packages = do
       [ libraries0 -- Build all Stage0 libraries in Stage1
       , [ array
         , base
-        , bytestring
         , containers
         , deepseq
-        , directory
         , exceptions
         , filepath
         , ghc
@@ -129,10 +132,8 @@ stage1Packages = do
         , hsc2hs
         , integerGmp
         , pretty
-        , process
         , rts
         , stm
-        , time
         , unlit
         , xhtml
         ]
@@ -143,7 +144,6 @@ stage1Packages = do
         , libiserv
         , runGhc
         ]
-      , if winTarget then [ win32 ] else [ unix ]
       , when (winTarget && not cross)
         [ touchy
          -- See Note [Hadrian's ghci-wrapper package]
diff --git a/hadrian/src/Settings/Flavours/Development.hs b/hadrian/src/Settings/Flavours/Development.hs
index 75c0886bce..00831012cc 100644
--- a/hadrian/src/Settings/Flavours/Development.hs
+++ b/hadrian/src/Settings/Flavours/Development.hs
@@ -10,12 +10,17 @@ import {-# SOURCE #-} Settings.Default
 -- Please update doc/flavours.md when changing this file.
 developmentFlavour :: Stage -> Flavour
 developmentFlavour ghcStage = defaultFlavour
-    { name = "devel" ++ show (fromEnum ghcStage)
+    { name = "devel" ++ stageString ghcStage
     , args = defaultBuilderArgs <> developmentArgs ghcStage <> defaultPackageArgs
     , libraryWays = pure $ Set.fromList [vanilla]
     , rtsWays = pure $ Set.fromList [vanilla, debug, threaded, threadedDebug]
     , dynamicGhcPrograms = return False
     , ghcDebugAssertions = True }
+    where
+      stageString Stage2 = "2"
+      stageString Stage1 = "1"
+      stageString Stage3 = "3"
+      stageString s = error ("developmentFlavour not support for " ++ show s)
 
 developmentArgs :: Stage -> Args
 developmentArgs ghcStage = do
@@ -27,5 +32,5 @@ developmentArgs ghcStage = do
                                  package cabal ? pure ["-O0"]]
         , hsLibrary  = notStage0 ? arg "-dlint"
         , hsCompiler = mconcat [stage0 ? arg "-O2",
-                                succ stage == ghcStage ? pure ["-O0"]]
-        , hsGhc      = succ stage == ghcStage ? pure ["-O0"] }
+                                 stage == predStage ghcStage ? pure ["-O0"]]
+        , hsGhc      = stage == predStage ghcStage ? pure ["-O0"] }
diff --git a/hadrian/src/Settings/Packages.hs b/hadrian/src/Settings/Packages.hs
index 871e7235f8..96c09ba856 100644
--- a/hadrian/src/Settings/Packages.hs
+++ b/hadrian/src/Settings/Packages.hs
@@ -22,7 +22,7 @@ packageArgs = do
 
         -- Check if the bootstrap compiler has the same version as the one we
         -- are building. This is used to build cross-compilers
-        bootCross = (==) <$> ghcVersionStage Stage0 <*> ghcVersionStage Stage1
+        bootCross = (==) <$> ghcVersionStage (stage0InTree) <*> ghcVersionStage Stage1
 
     cursesIncludeDir <- getSetting CursesIncludeDir
     cursesLibraryDir <- getSetting CursesLibDir
diff --git a/hadrian/src/Settings/Program.hs b/hadrian/src/Settings/Program.hs
index d45b265008..62d41909d3 100644
--- a/hadrian/src/Settings/Program.hs
+++ b/hadrian/src/Settings/Program.hs
@@ -19,6 +19,9 @@ programContext stage pkg = do
     where wayFor prof dyn
             | prof && dyn                          =
                 error "programContext: profiling+dynamic not supported"
-            | pkg == ghc && prof && stage > Stage0 = profiling
-            | dyn && stage > Stage0                = dynamic
+            | pkg == ghc && prof && notStage0 stage = profiling
+            | dyn && notStage0 stage                = dynamic
             | otherwise                            = vanilla
+
+          notStage0 (Stage0 {}) = False
+          notStage0 _ = True