Change `Backend` type and remove direct dependencieswip/backend-as-record

With this change, `Backend` becomes an abstract type
(there are no more exposed value constructors).
Decisions that were formerly made by asking "is the
current back end equal to (or different from) this named value
constructor?" are now made by interrogating the back end about
its properties, which are functions exported by `GHC.Driver.Backend`.

There is a description of how to migrate code using `Backend` in the
user guide.

Clients using the GHC API can find a backdoor to access the Backend
datatype in GHC.Driver.Backend.Internal.

Bumps haddock submodule.

Fixes #20927

1 files changed, 61 insertions, 44 deletions

diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 58bc1e6907..86ba305461 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -44,7 +44,6 @@ import GHC.Utils.TmpFs
 import GHC.Platform
 import Data.List (intercalate, isInfixOf)
 import GHC.Unit.Env
-import GHC.SysTools.Info
 import GHC.Utils.Error
 import Data.Maybe
 import GHC.CmmToLlvm.Mangler
@@ -287,13 +286,11 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
 
         -- LLVM from version 3.0 onwards doesn't support the OS X system
         -- assembler, so we use clang as the assembler instead. (#5636)
-        let (as_prog, get_asm_info) | backend dflags == LLVM
-                    , platformOS platform == OSDarwin
-                    = (GHC.SysTools.runClang, pure Clang)
-                    | otherwise
-                    = (GHC.SysTools.runAs, getAssemblerInfo logger dflags)
-
-        asmInfo <- get_asm_info
+        let (as_prog, get_asm_info) =
+                ( applyAssemblerProg $ backendAssemblerProg (backend dflags)
+                , applyAssemblerInfoGetter $ backendAssemblerInfoGetter (backend dflags)
+                )
+        asmInfo <- get_asm_info logger dflags platform
 
         let cmdline_include_paths = includePaths dflags
         let pic_c_flags = picCCOpts dflags
@@ -313,6 +310,7 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
               = withAtomicRename outputFilename $ \temp_outputFilename ->
                     as_prog
                        logger dflags
+                       platform
                        (local_includes ++ global_includes
                        -- See Note [-fPIC for assembler]
                        ++ map GHC.SysTools.Option pic_c_flags
@@ -340,6 +338,29 @@ runAsPhase with_cpp pipe_env hsc_env location input_fn = do
 
         return output_fn
 
+applyAssemblerInfoGetter
+    :: DefunctionalizedAssemblerInfoGetter
+    -> Logger -> DynFlags -> Platform -> IO CompilerInfo
+applyAssemblerInfoGetter StandardAssemblerInfoGetter logger dflags _platform =
+    getAssemblerInfo logger dflags
+applyAssemblerInfoGetter DarwinClangAssemblerInfoGetter logger dflags platform =
+    if platformOS platform == OSDarwin then
+        pure Clang
+    else
+        getAssemblerInfo logger dflags
+
+applyAssemblerProg
+    :: DefunctionalizedAssemblerProg
+    -> Logger -> DynFlags -> Platform -> [Option] -> IO ()
+applyAssemblerProg StandardAssemblerProg logger dflags _platform =
+    runAs logger dflags
+applyAssemblerProg DarwinClangAssemblerProg logger dflags platform =
+    if platformOS platform == OSDarwin then
+        runClang logger dflags
+    else
+        runAs logger dflags
+
+
 
 runCcPhase :: Phase -> PipeEnv -> HscEnv -> FilePath -> IO FilePath
 runCcPhase cc_phase pipe_env hsc_env input_fn = do
@@ -501,28 +522,10 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
                   hscs_partial_iface = partial_iface,
                   hscs_old_iface_hash = mb_old_iface_hash
                 }
-        -> case backend dflags of
-          NoBackend -> panic "HscRecomp not relevant for NoBackend"
-          Interpreter -> do
-              -- In interpreted mode the regular codeGen backend is not run so we
-              -- generate a interface without codeGen info.
-              final_iface <- mkFullIface hsc_env partial_iface Nothing
-              hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location
-
-              (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location
-
-              stub_o <- case hasStub of
-                        Nothing -> return []
-                        Just stub_c -> do
-                            stub_o <- compileStub hsc_env stub_c
-                            return [DotO stub_o]
-
-              let hs_unlinked = [BCOs comp_bc spt_entries]
-              unlinked_time <- getCurrentTime
-              let !linkable = LM unlinked_time (mkHomeModule (hsc_home_unit hsc_env) mod_name)
-                             (hs_unlinked ++ stub_o)
-              return ([], final_iface, Just linkable, panic "interpreter")
-          _ -> do
+        -> if not (backendGeneratesCode (backend dflags)) then
+             panic "HscRecomp not relevant for NoBackend"
+           else if backendWritesFiles (backend dflags) then
+             do
               output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location)
               (outputFilename, mStub, foreign_files, mb_cg_infos) <-
                 hscGenHardCode hsc_env cgguts mod_location output_fn
@@ -542,6 +545,27 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
               -- is in TPipeline and in this branch we can invoke the rest of the backend phase.
               return (fos, final_iface, Nothing, outputFilename)
 
+           else
+              -- In interpreted mode the regular codeGen backend is not run so we
+              -- generate a interface without codeGen info.
+            do
+              final_iface <- mkFullIface hsc_env partial_iface Nothing
+              hscMaybeWriteIface logger dflags True final_iface mb_old_iface_hash location
+
+              (hasStub, comp_bc, spt_entries) <- hscInteractive hsc_env cgguts mod_location
+
+              stub_o <- case hasStub of
+                        Nothing -> return []
+                        Just stub_c -> do
+                            stub_o <- compileStub hsc_env stub_c
+                            return [DotO stub_o]
+
+              let hs_unlinked = [BCOs comp_bc spt_entries]
+              unlinked_time <- getCurrentTime
+              let !linkable = LM unlinked_time (mkHomeModule (hsc_home_unit hsc_env) mod_name)
+                             (hs_unlinked ++ stub_o)
+              return ([], final_iface, Just linkable, panic "interpreter")
+
 
 runUnlitPhase :: HscEnv -> FilePath -> FilePath -> IO FilePath
 runUnlitPhase hsc_env input_fn output_fn = do
@@ -991,7 +1015,7 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do
           [ "-D__AVX512F__"  | isAvx512fEnabled  dflags ] ++
           [ "-D__AVX512PF__" | isAvx512pfEnabled dflags ]
 
-    backend_defs <- getBackendDefs logger dflags
+    backend_defs <- applyCDefs (backendCDefs $ backend dflags) logger dflags
 
     let th_defs = [ "-D__GLASGOW_HASKELL_TH__" ]
     -- Default CPP defines in Haskell source
@@ -1043,8 +1067,9 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do
                        , GHC.SysTools.FileOption "" output_fn
                        ])
 
-getBackendDefs :: Logger -> DynFlags -> IO [String]
-getBackendDefs logger dflags | backend dflags == LLVM = do
+applyCDefs :: DefunctionalizedCDefs -> Logger -> DynFlags -> IO [String]
+applyCDefs NoCDefs _ _ = return []
+applyCDefs LlvmCDefs logger dflags = do
     llvmVer <- figureLlvmVersion logger dflags
     return $ case fmap llvmVersionList llvmVer of
                Just [m] -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,0) ]
@@ -1052,23 +1077,15 @@ getBackendDefs logger dflags | backend dflags == LLVM = do
                _ -> []
   where
     format (major, minor)
-      | minor >= 100 = error "getBackendDefs: Unsupported minor version"
-      | otherwise = show $ (100 * major + minor :: Int) -- Contract is Int
+      | minor >= 100 = error "backendCDefs: Unsupported minor version"
+      | otherwise = show (100 * major + minor :: Int) -- Contract is Int
 
-getBackendDefs _ _ =
-    return []
 
 -- | What phase to run after one of the backend code generators has run
 hscPostBackendPhase :: HscSource -> Backend -> Phase
 hscPostBackendPhase HsBootFile _    =  StopLn
 hscPostBackendPhase HsigFile _      =  StopLn
-hscPostBackendPhase _ bcknd =
-  case bcknd of
-        ViaC        -> HCc
-        NCG         -> As False
-        LLVM        -> LlvmOpt
-        NoBackend   -> StopLn
-        Interpreter -> StopLn
+hscPostBackendPhase _ bcknd = backendNormalSuccessorPhase bcknd
 
 
 compileStub :: HscEnv -> FilePath -> IO FilePath