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, 27 insertions, 20 deletions

diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 89a4329745..e988979df2 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -251,10 +251,7 @@ compileOne' mHscMessage
        input_fn    = expectJust "compile:hs" (ml_hs_file location)
        input_fnpp  = ms_hspp_file summary
 
-       pipelineOutput = case bcknd of
-         Interpreter -> NoOutputFile
-         NoBackend -> NoOutputFile
-         _ -> Persistent
+       pipelineOutput = backendPipelineOutput bcknd
 
        logger = hsc_logger hsc_env0
        tmpfs  = hsc_tmpfs hsc_env0
@@ -278,7 +275,10 @@ compileOne' mHscMessage
          -- was set), force it to generate byte-code. This is NOT transitive and
          -- only applies to direct targets.
          | loadAsByteCode
-         = (Interpreter, gopt_set (lcl_dflags { backend = Interpreter }) Opt_ForceRecomp)
+         = ( interpreterBackend
+           , gopt_set (lcl_dflags { backend = interpreterBackend }) Opt_ForceRecomp
+           )
+
          | otherwise
          = (backend dflags, lcl_dflags)
        -- See Note [Filepaths and Multiple Home Units]
@@ -526,7 +526,7 @@ compileFile hsc_env stop_phase (src, _mb_phase) = do
         -- When linking, the -o argument refers to the linker's output.
         -- otherwise, we use it as the name for the pipeline's output.
         output
-         | NoBackend <- backend dflags, notStopPreprocess = NoOutputFile
+         | not (backendGeneratesCode (backend dflags)), notStopPreprocess = NoOutputFile
                 -- avoid -E -fno-code undesirable interactions. see #20439
          | NoStop <- stop_phase, not (isNoLink ghc_link) = Persistent
                 -- -o foo applies to linker
@@ -728,19 +728,19 @@ hscPipeline pipe_env (hsc_env_with_plugins, mod_sum, hsc_recomp_status) = do
 
 hscBackendPipeline :: P m => PipeEnv -> HscEnv -> ModSummary -> HscBackendAction -> m (ModIface, Maybe Linkable)
 hscBackendPipeline pipe_env hsc_env mod_sum result =
-  case backend (hsc_dflags hsc_env) of
-    NoBackend ->
-      case result of
-        HscUpdate iface ->  return (iface, Nothing)
-        HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing
-    -- TODO: Why is there not a linkable?
-    -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing
-    _ -> do
+  if backendGeneratesCode (backend (hsc_dflags hsc_env)) then
+    do
       res <- hscGenBackendPipeline pipe_env hsc_env mod_sum result
       when (gopt Opt_BuildDynamicToo (hsc_dflags hsc_env)) $ do
           let dflags' = setDynamicNow (hsc_dflags hsc_env) -- set "dynamicNow"
           () <$ hscGenBackendPipeline pipe_env (hscSetFlags dflags' hsc_env) mod_sum result
       return res
+  else
+    case result of
+      HscUpdate iface ->  return (iface, Nothing)
+      HscRecomp {} -> (,) <$> liftIO (mkFullIface hsc_env (hscs_partial_iface result) Nothing) <*> pure Nothing
+    -- TODO: Why is there not a linkable?
+    -- Interpreter -> (,) <$> use (T_IO (mkFullIface hsc_env (hscs_partial_iface result) Nothing)) <*> pure Nothing
 
 hscGenBackendPipeline :: P m
   => PipeEnv
@@ -811,12 +811,19 @@ hscPostBackendPipeline :: P m => PipeEnv -> HscEnv -> HscSource -> Backend -> Ma
 hscPostBackendPipeline _ _ HsBootFile _ _ _   = return Nothing
 hscPostBackendPipeline _ _ HsigFile _ _ _     = return Nothing
 hscPostBackendPipeline pipe_env hsc_env _ bcknd ml input_fn =
-  case bcknd of
-        ViaC        -> viaCPipeline HCc pipe_env hsc_env ml input_fn
-        NCG         -> Just <$> asPipeline False pipe_env hsc_env ml input_fn
-        LLVM        -> Just <$> llvmPipeline pipe_env hsc_env ml input_fn
-        NoBackend   -> return Nothing
-        Interpreter -> return Nothing
+  applyPostHscPipeline (backendPostHscPipeline bcknd) pipe_env hsc_env ml input_fn
+
+applyPostHscPipeline
+    :: TPipelineClass TPhase m
+    => DefunctionalizedPostHscPipeline
+    -> PipeEnv -> HscEnv -> Maybe ModLocation -> FilePath -> m (Maybe FilePath)
+applyPostHscPipeline NcgPostHscPipeline =
+    \pe he ml fp -> Just <$> asPipeline False pe he ml fp
+applyPostHscPipeline ViaCPostHscPipeline = viaCPipeline HCc
+applyPostHscPipeline LlvmPostHscPipeline =
+    \pe he ml fp -> Just <$> llvmPipeline pe he ml fp
+applyPostHscPipeline NoPostHscPipeline = \_ _ _ _ -> return Nothing
+
 
 -- Pipeline from a given suffix
 pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)