Reinstallable GHC

This patch allows ghc and its dependencies to be built using a normal
invocation of cabal-install. Each componenent which relied on generated
files or additional configuration now has a Setup.hs file.

There are also various fixes to the cabal files to satisfy
cabal-install.

There is a new hadrian command which will build a stage2 compiler and
then a stage3 compiler by using cabal.

```
./hadrian/build build-cabal
```

There is also a new CI job which tests running this command.

For the 9.4 release we will upload all the dependent executables to
hackage and then end users will be free to build GHC and GHC executables
via cabal.

There are still some unresolved questions about how to ensure soundness
when loading plugins into a reinstalled GHC (#20742) which will be
tighted up in due course.

Fixes #19896

3 files changed, 158 insertions, 3 deletions

diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 91bf2adf39..34d34815ce 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -4429,6 +4429,7 @@ parseEnvFile envfile = mapM_ parseEntry . lines
         where envdir = takeDirectory envfile
               db     = drop 11 str
       ["clear-package-db"]  -> clearPkgDb
+      ["hide-package", pkg]  -> hidePackage pkg
       ["global-package-db"] -> addPkgDbRef GlobalPkgDb
       ["user-package-db"]   -> addPkgDbRef UserPkgDb
       ["package-id", pkgid] -> exposePackageId pkgid
@@ -4622,6 +4623,10 @@ compilerInfo dflags
           (rawSettings dflags)
    ++ [("Project version",             projectVersion dflags),
        ("Project Git commit id",       cProjectGitCommitId),
+       ("Project Version Int",         cProjectVersionInt),
+       ("Project Patch Level",         cProjectPatchLevel),
+       ("Project Patch Level1",        cProjectPatchLevel1),
+       ("Project Patch Level2",        cProjectPatchLevel2),
        ("Booter version",              cBooterVersion),
        ("Stage",                       cStage),
        ("Build platform",              cBuildPlatformString),
diff --git a/compiler/Setup.hs b/compiler/Setup.hs
new file mode 100644
index 0000000000..e6d3d09d18
--- /dev/null
+++ b/compiler/Setup.hs
@@ -0,0 +1,138 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
+module Main where
+
+import Distribution.Simple
+import Distribution.Simple.BuildPaths
+import Distribution.Types.LocalBuildInfo
+import Distribution.Verbosity
+import Distribution.Simple.Program
+import Distribution.Simple.Utils
+import Distribution.Simple.Setup
+
+import System.IO
+import System.Process
+import System.Directory
+import System.FilePath
+import Control.Monad
+import Data.Char
+import GHC.ResponseFile
+import System.Environment
+
+main :: IO ()
+main = defaultMainWithHooks ghcHooks
+  where
+    ghcHooks = simpleUserHooks
+      { postConf = \args cfg pd lbi -> do
+          let verbosity = fromFlagOrDefault minBound (configVerbosity cfg)
+          ghcAutogen verbosity lbi
+          postConf simpleUserHooks args cfg pd lbi
+      }
+
+-- Mapping from primop-*.hs-incl file to command
+primopIncls :: [(String,String)]
+primopIncls =
+    [ ("primop-data-decl.hs-incl"         , "--data-decl")
+    , ("primop-tag.hs-incl"               , "--primop-tag")
+    , ("primop-list.hs-incl"              , "--primop-list")
+    , ("primop-has-side-effects.hs-incl"  , "--has-side-effects")
+    , ("primop-out-of-line.hs-incl"       , "--out-of-line")
+    , ("primop-commutable.hs-incl"        , "--commutable")
+    , ("primop-code-size.hs-incl"         , "--code-size")
+    , ("primop-can-fail.hs-incl"          , "--can-fail")
+    , ("primop-strictness.hs-incl"        , "--strictness")
+    , ("primop-fixity.hs-incl"            , "--fixity")
+    , ("primop-primop-info.hs-incl"       , "--primop-primop-info")
+    , ("primop-vector-uniques.hs-incl"    , "--primop-vector-uniques")
+    , ("primop-vector-tys.hs-incl"        , "--primop-vector-tys")
+    , ("primop-vector-tys-exports.hs-incl", "--primop-vector-tys-exports")
+    , ("primop-vector-tycons.hs-incl"     , "--primop-vector-tycons")
+    , ("primop-docs.hs-incl"              , "--wired-in-docs")
+    ]
+
+ghcAutogen :: Verbosity -> LocalBuildInfo -> IO ()
+ghcAutogen verbosity lbi@LocalBuildInfo{..} = do
+  -- Get compiler/ root directory from the cabal file
+  let Just compilerRoot = takeDirectory <$> pkgDescrFile
+
+  -- Require the necessary programs
+  (gcc   ,withPrograms) <- requireProgram normal gccProgram withPrograms
+  (ghc   ,withPrograms) <- requireProgram normal ghcProgram withPrograms
+
+  settings <- read <$> getProgramOutput normal ghc ["--info"]
+  -- We are reinstalling GHC
+  -- Write primop-*.hs-incl
+  let hsCppOpts = case lookup "Haskell CPP flags" settings of
+        Just fs -> unescapeArgs fs
+        Nothing -> []
+      primopsTxtPP = compilerRoot </> "GHC/Builtin/primops.txt.pp"
+      cppOpts = hsCppOpts ++ ["-P","-x","c"]
+      cppIncludes = map ("-I"++) [compilerRoot]
+  -- Preprocess primops.txt.pp
+  primopsStr <- getProgramOutput normal gcc (cppOpts ++ cppIncludes ++ [primopsTxtPP])
+  -- Call genprimopcode to generate *.hs-incl
+  forM_ primopIncls $ \(file,command) -> do
+    contents <- readProcess "genprimopcode" [command] primopsStr
+    rewriteFileEx verbosity (buildDir </> file) contents
+
+  -- Write GHC.Platform.Constants
+  let platformConstantsPath = autogenPackageModulesDir lbi </> "GHC/Platform/Constants.hs"
+      targetOS = case lookup "target os" settings of
+        Nothing -> error "no target os in settings"
+        Just os -> os
+  createDirectoryIfMissingVerbose verbosity True (takeDirectory platformConstantsPath)
+  withTempFile (takeDirectory platformConstantsPath) "Constants_tmp.hs" $ \tmp h -> do
+    hClose h
+    callProcess "deriveConstants" ["--gen-haskell-type","-o",tmp,"--target-os",targetOS]
+    renameFile tmp platformConstantsPath
+
+  -- Write GHC.Settings.Config
+  let configHsPath = autogenPackageModulesDir lbi </> "GHC/Settings/Config.hs"
+      configHs = generateConfigHs settings
+  createDirectoryIfMissingVerbose verbosity True (takeDirectory configHsPath)
+  rewriteFileEx verbosity configHsPath configHs
+
+getSetting :: [(String,String)] -> String -> String -> Either String String
+getSetting settings kh kr = go settings kr
+  where
+    go settings k =  case lookup k settings of
+      Nothing -> Left (show k ++ " not found in settings: " ++ show settings)
+      Just v -> Right v
+
+generateConfigHs :: [(String,String)] -> String
+generateConfigHs settings = either error id $ do
+    let getSetting' = getSetting $ (("cStage","2"):) settings
+    buildPlatform  <- getSetting' "cBuildPlatformString" "Host platform"
+    hostPlatform   <- getSetting' "cHostPlatformString" "Target platform"
+    cProjectName   <- getSetting' "cProjectName" "Project name"
+    cBooterVersion <- getSetting' "cBooterVersion" "Project version"
+    cStage         <- getSetting' "cStage" "cStage"
+    return $ unlines
+        [ "module GHC.Settings.Config"
+        , "  ( module GHC.Version"
+        , "  , cBuildPlatformString"
+        , "  , cHostPlatformString"
+        , "  , cProjectName"
+        , "  , cBooterVersion"
+        , "  , cStage"
+        , "  ) where"
+        , ""
+        , "import GHC.Prelude"
+        , ""
+        , "import GHC.Version"
+        , ""
+        , "cBuildPlatformString :: String"
+        , "cBuildPlatformString = " ++ show buildPlatform
+        , ""
+        , "cHostPlatformString :: String"
+        , "cHostPlatformString = " ++ show hostPlatform
+        , ""
+        , "cProjectName          :: String"
+        , "cProjectName          = " ++ show cProjectName
+        , ""
+        , "cBooterVersion        :: String"
+        , "cBooterVersion        = " ++ show cBooterVersion
+        , ""
+        , "cStage                :: String"
+        , "cStage                = show ("++ cStage ++ " :: Int)"
+        ]
diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in
index 6bc23a69a8..4ff65c4e61 100644
--- a/compiler/ghc.cabal.in
+++ b/compiler/ghc.cabal.in
@@ -1,10 +1,10 @@
+Cabal-Version: 2.2
 -- WARNING: ghc.cabal is automatically generated from ghc.cabal.in by
 -- ./configure.  Make sure you are editing ghc.cabal.in, not ghc.cabal.
 
-Cabal-Version: 1.22
 Name: ghc
 Version: @ProjectVersionMunged@
-License: BSD3
+License: BSD-3-Clause
 License-File: LICENSE
 Author: The GHC Team
 Maintainer: glasgow-haskell-users@haskell.org
@@ -21,9 +21,11 @@ Description:
     See <https://gitlab.haskell.org/ghc/ghc/-/wikis/commentary/compiler>
     for more information.
 Category: Development
-Build-Type: Simple
+Build-Type: Custom
 
 extra-source-files:
+    GHC/Builtin/primops.txt.pp 
+    GHC/Builtin/bytearray-ops.txt.pp
     Unique.h
     CodeGen.Platform.h
     -- Shared with rts via hard-link at configure time. This is safer
@@ -33,6 +35,11 @@ extra-source-files:
     ClosureTypes.h
     FunTypes.h
     MachRegs.h
+    ghc-llvm-version.h
+
+
+custom-setup
+    setup-depends: base >= 3 && < 5, Cabal >= 1.6 && <3.8, directory, process, filepath
 
 Flag internal-interpreter
     Description: Build with internal interpreter support.
@@ -60,6 +67,8 @@ Library
               FunTypes.h
               ghc-llvm-version.h
 
+    build-tool-depends: alex:alex >= 3.2.6, happy:happy >= 1.20.0, genprimopcode:genprimopcode, deriveConstants:deriveConstants
+
     Build-Depends: base       >= 4.11 && < 4.17,
                    deepseq    >= 1.4 && < 1.5,
                    directory  >= 1   && < 1.4,
@@ -765,6 +774,9 @@ Library
         Language.Haskell.Syntax.Pat
         Language.Haskell.Syntax.Type
 
+    autogen-modules: GHC.Platform.Constants
+                     GHC.Settings.Config
+
     reexported-modules:
           GHC.Platform.ArchOS
         , GHC.Platform.Host