Split `Backend` into multiple sum typeswip/maybe-backend

(What's the additive version of "factor"? :))

Preliminary step towards #20927 and #21034

I have wanted to do this for a while, and @nrnrnr's work convinced me I
should hurry up :) and do so.

I think enumerating "No backend" with actual backends is not good. We are very
far from having any nice notion of an "identity backend", and absent
that I cannot think of any other justification for the status quo.

`NoBackend` is kept as a pattern synonym so the code doesn't regress in
readability when there are no type annotation nearby.

Note this is a bare minimum refactor; I didn't make much of an
attempt to "prove" this was the right direction. But a few low-hanging
fruits nevertheless did arise:

 - `platformDefaultBackend` is guaranteed to return an actual backend.

 - In `GHC.Tc.Gen.Foreign`, `checkCOrAsmOrLlvmOrInterp` is dead code,
   because `checkCg` allows any foreign declaration with `NoBackend`.
   This makes sense to me: without a choice of the next pipeline stage
   committed to committed to, who's to say some constructor is outside
   its domain?

   `checkCg` now takes a `ActualBackend -> Validity` callback,
   demonstrating that `NoBackend` is handled separately.

This is enough to make me feel good I am not barking down the wrong
tree.

@nrnrnr's !7442 will end up touching many/most of the same lines that
this touches, but I think that is OK.

I am all for, downstream of `DynFlags`, trying to get rid of anything
looking at the `Backend` datatype, because we should support arbitrary
backends where are free to very those knobs however they like, fully
independently.

However, I don't thinking folding in `NoBackend` to our more "semantic"
representation of a backend (the new record) will make sense.
Conversely, I think the more we try to better structure what a backend
is/does, the more `NoBackend` would stick out like a sore thumb, ruining
our abstractions.

If we do this before `!7442`, we have the opportunity to use `Maybe
SemanticBackend` downstream to side-step those issues, but even that I
think will be somewhat temporary. As we continue to purge `DynFlags`
from the code base, I think we will increasingly separate code that
needs an actual backend from code that is agnostic. And the code that
agnostic I don't think should get a `Maybe SemanticBackend`, but rather
expose the knobs it would infer from the backend directly.

Why? This is the same argument as `checkCg`: if you haven't chosen a
backend yet, who is to say some choices are invalid? Not the
non-existent backend!  Conversely if we a backend requires a certain
choice made "upstream" in order for it to work, that that code should go
with the backend, not the upstream component. This preserves the
separation of concerns, and allows arbitrary backends to have arbitrary
policies.

22 files changed, 123 insertions, 115 deletions

diff --git a/compiler/GHC.hs b/compiler/GHC.hs
index 770cdf62b8..e8c81cb8f2 100644
--- a/compiler/GHC.hs
+++ b/compiler/GHC.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE NondecreasingIndentation, ScopedTypeVariables #-}
 {-# LANGUAGE TupleSections, NamedFieldPuns #-}
 {-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE TypeFamilies #-}
 
 -- -----------------------------------------------------------------------------
@@ -28,7 +29,7 @@ module GHC (
         needsTemplateHaskellOrQQ,
 
         -- * Flags and settings
-        DynFlags(..), GeneralFlag(..), Severity(..), Backend(..), gopt,
+        DynFlags(..), GeneralFlag(..), Severity(..), Backend, pattern NoBackend, ActualBackend(..), gopt,
         GhcMode(..), GhcLink(..),
         parseDynamicFlags, parseTargetFiles,
         getSessionDynFlags,
diff --git a/compiler/GHC/Cmm/Switch.hs b/compiler/GHC/Cmm/Switch.hs
index f8c6c674ef..c7e11fea1e 100644
--- a/compiler/GHC/Cmm/Switch.hs
+++ b/compiler/GHC/Cmm/Switch.hs
@@ -315,9 +315,9 @@ and slowed down all other cases making it not worthwhile.
 -- | Does the backend support switch out of the box? Then leave this to the
 -- backend!
 backendSupportsSwitch :: Backend -> Bool
-backendSupportsSwitch ViaC = True
-backendSupportsSwitch LLVM = True
-backendSupportsSwitch _    = False
+backendSupportsSwitch (Just ViaC) = True
+backendSupportsSwitch (Just LLVM) = True
+backendSupportsSwitch _           = False
 
 -- | This function creates a SwitchPlan from a SwitchTargets value, breaking it
 -- down into smaller pieces suitable for code generation.
diff --git a/compiler/GHC/Driver/Backend.hs b/compiler/GHC/Driver/Backend.hs
index 2642a2a9af..9f37f6c62a 100644
--- a/compiler/GHC/Driver/Backend.hs
+++ b/compiler/GHC/Driver/Backend.hs
@@ -1,8 +1,11 @@
 {-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE PatternSynonyms #-}
 
 -- | Code generation backends
 module GHC.Driver.Backend
-   ( Backend (..)
+   ( Backend
+   , pattern NoBackend
+   , ActualBackend (..)
    , platformDefaultBackend
    , platformNcgSupported
    , backendProducesObject
@@ -19,7 +22,7 @@ import GHC.Platform
 -- (producing machine code, producing ByteCode for the interpreter) and
 -- supporting different platforms.
 --
-data Backend
+data ActualBackend
    = NCG           -- ^ Native code generator backend.
                    --
                    -- Compiles Cmm code into textual assembler, then relies on
@@ -72,19 +75,30 @@ data Backend
                    --
                    -- See "GHC.StgToByteCode"
 
+   deriving (Eq,Ord,Show,Read)
 
-   | NoBackend     -- ^ No code generated.
-                   --
-                   -- Use this to disable code generation. It is particularly
-                   -- useful when GHC is used as a library for other purpose
-                   -- than generating code (e.g. to generate documentation with
-                   -- Haddock) or when the user requested it (via -fno-code) for
-                   -- some reason.
+-- | Sometimes we have a backend, and sometimes we do not.
+--
+-- Not inlining 'Nothing' into 'ActualBackend' will help lead towards things
+-- like e.g.
+--
+-- - Building for multiple backends at once, where we would switch from
+--   'Maybe ActualBackend' to 'Set ActualBackend', not 'Set (Maybe
+--   ActualBackend)'.
+--
+-- - Ensuring all backends can write to files. That would mean byte code can be
+--   written to a file (#21034), which makes 'ActualBackend' much more uniform.
+--   Conversely it's hard to imagine it would ever make sense for 'NoBackend' to
+--   write to a file!
+type Backend = Maybe ActualBackend
 
-   deriving (Eq,Ord,Show,Read)
+{-# COMPLETE NoBackend, Just #-}
+
+pattern NoBackend :: Backend
+pattern NoBackend = Nothing
 
 -- | Default backend to use for the given platform.
-platformDefaultBackend :: Platform -> Backend
+platformDefaultBackend :: Platform -> ActualBackend
 platformDefaultBackend platform = if
       | platformUnregisterised platform -> ViaC
       | platformNcgSupported platform   -> NCG
@@ -108,11 +122,11 @@ platformNcgSupported platform = if
 
 -- | Will this backend produce an object file on the disk?
 backendProducesObject :: Backend -> Bool
-backendProducesObject ViaC        = True
-backendProducesObject NCG         = True
-backendProducesObject LLVM        = True
-backendProducesObject Interpreter = False
-backendProducesObject NoBackend   = False
+backendProducesObject (Just ViaC)        = True
+backendProducesObject (Just NCG)         = True
+backendProducesObject (Just LLVM)        = True
+backendProducesObject (Just Interpreter) = False
+backendProducesObject NoBackend          = False
 
 -- | Does this backend retain *all* top-level bindings for a module,
 -- rather than just the exported bindings, in the TypeEnv and compiled
@@ -124,8 +138,8 @@ backendProducesObject NoBackend   = False
 -- When no backend is used we also do it, so that Haddock can get access to the
 -- GlobalRdrEnv for a module after typechecking it.
 backendRetainsAllBindings :: Backend -> Bool
-backendRetainsAllBindings Interpreter = True
-backendRetainsAllBindings NoBackend   = True
-backendRetainsAllBindings ViaC        = False
-backendRetainsAllBindings NCG         = False
-backendRetainsAllBindings LLVM        = False
+backendRetainsAllBindings NoBackend          = True
+backendRetainsAllBindings (Just Interpreter) = True
+backendRetainsAllBindings (Just ViaC)        = False
+backendRetainsAllBindings (Just NCG)         = False
+backendRetainsAllBindings (Just LLVM)        = False
diff --git a/compiler/GHC/Driver/CodeOutput.hs b/compiler/GHC/Driver/CodeOutput.hs
index 80a8277283..f4b8b95aab 100644
--- a/compiler/GHC/Driver/CodeOutput.hs
+++ b/compiler/GHC/Driver/CodeOutput.hs
@@ -111,12 +111,13 @@ codeOutput logger tmpfs dflags unit_state this_mod filenm location genForeignStu
                 }
 
         ; a <- case backend dflags of
+            NoBackend -> panic "codeOutput: NoBackend"
+            Just b -> case b of
                  NCG         -> outputAsm logger dflags this_mod location filenm
                                           linted_cmm_stream
                  ViaC        -> outputC logger dflags filenm linted_cmm_stream pkg_deps
                  LLVM        -> outputLlvm logger dflags filenm linted_cmm_stream
                  Interpreter -> panic "codeOutput: Interpreter"
-                 NoBackend   -> panic "codeOutput: NoBackend"
         ; let stubs = genForeignStubs a
         ; stubs_exist <- outputForeignStubs logger tmpfs dflags unit_state this_mod location stubs
         ; return (filenm, stubs_exist, foreign_fps, a)
diff --git a/compiler/GHC/Driver/Config/Cmm.hs b/compiler/GHC/Driver/Config/Cmm.hs
index 38bab62048..d7280b0e60 100644
--- a/compiler/GHC/Driver/Config/Cmm.hs
+++ b/compiler/GHC/Driver/Config/Cmm.hs
@@ -22,7 +22,7 @@ initCmmConfig dflags = CmmConfig
   , cmmGenStackUnwindInstr = debugLevel dflags > 0
   , cmmExternalDynamicRefs = gopt Opt_ExternalDynamicRefs dflags
   , cmmDoCmmSwitchPlans    = not . backendSupportsSwitch . backend $ dflags
-  , cmmSplitProcPoints     = (backend dflags /= NCG)
+  , cmmSplitProcPoints     = (backend dflags /= Just NCG)
                              || not (platformTablesNextToCode platform)
                              || usingInconsistentPicReg
   }
diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs
index ae59e41fdf..0476c0e684 100644
--- a/compiler/GHC/Driver/Config/StgToCmm.hs
+++ b/compiler/GHC/Driver/Config/StgToCmm.hs
@@ -58,8 +58,8 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
   } where profile  = targetProfile dflags
           platform = profilePlatform profile
           bk_end  = backend dflags
-          ncg     = bk_end == NCG
-          llvm    = bk_end == LLVM
+          ncg     = bk_end == Just NCG
+          llvm    = bk_end == Just LLVM
           x86ish  = case platformArch platform of
                       ArchX86    -> True
                       ArchX86_64 -> True
@@ -70,5 +70,5 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
                       _            -> False
           aarch64 = platformArch platform == ArchAArch64
           vec_err = case backend dflags of
-                      LLVM -> Nothing
-                      _    -> Just (unlines ["SIMD vector instructions require the LLVM back-end.", "Please use -fllvm."])
+                      Just LLVM -> Nothing
+                      _         -> Just (unlines ["SIMD vector instructions require the LLVM back-end.", "Please use -fllvm."])
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index 3e48771ace..bdbc65670f 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1001,9 +1001,9 @@ hscMaybeWriteIface :: Logger -> DynFlags -> Bool -> ModIface -> Maybe Fingerprin
 hscMaybeWriteIface logger dflags is_simple iface old_iface mod_location = do
     let force_write_interface = gopt Opt_WriteInterface dflags
         write_interface = case backend dflags of
-                            NoBackend    -> False
-                            Interpreter  -> False
-                            _            -> True
+                            NoBackend         -> False
+                            Just Interpreter  -> False
+                            Just _            -> True
 
         write_iface dflags' iface =
           let !iface_name = if dynamicNow dflags' then ml_dyn_hi_file mod_location else ml_hi_file mod_location
diff --git a/compiler/GHC/Driver/Make.hs b/compiler/GHC/Driver/Make.hs
index 4ec6d13348..a8c087bbc3 100644
--- a/compiler/GHC/Driver/Make.hs
+++ b/compiler/GHC/Driver/Make.hs
@@ -1711,7 +1711,7 @@ enableCodeGenWhen logger tmpfs condition should_modify staticLife dynLife unit_e
                               , ml_obj_file = o_file
                               , ml_dyn_hi_file = dyn_hi_file
                               , ml_dyn_obj_file = dyn_o_file }
-              , ms_hspp_opts = updOptLevel 0 $ dflags {backend = defaultBackendOf ms}
+              , ms_hspp_opts = updOptLevel 0 $ dflags { backend = Just $ defaultBackendOf ms }
               }
         pure (ModuleNode deps ms')
     enable_code_gen ms = return ms
diff --git a/compiler/GHC/Driver/Pipeline.hs b/compiler/GHC/Driver/Pipeline.hs
index 56e188395e..d96ee2daf0 100644
--- a/compiler/GHC/Driver/Pipeline.hs
+++ b/compiler/GHC/Driver/Pipeline.hs
@@ -259,9 +259,9 @@ compileOne' mHscMessage
        internalInterpreter = not (gopt Opt_ExternalInterpreter lcl_dflags)
 
        pipelineOutput = case bcknd of
-         Interpreter -> NoOutputFile
          NoBackend -> NoOutputFile
-         _ -> Persistent
+         Just Interpreter -> NoOutputFile
+         Just _ -> Persistent
 
        logger = hsc_logger hsc_env0
        tmpfs  = hsc_tmpfs hsc_env0
@@ -294,15 +294,16 @@ compileOne' mHscMessage
          = True
          | otherwise = False
        -- Figure out which backend we're using
-       (bcknd, dflags3)
+       dflags3
          -- #8042: When module was loaded with `*` prefix in ghci, but DynFlags
          -- suggest to generate object code (which may happen in case -fobject-code
          -- was set), force it to generate byte-code. This is NOT transitive and
          -- only applies to direct targets.
          | loadAsByteCode
-         = (Interpreter, gopt_set (dflags2 { backend = Interpreter }) Opt_ForceRecomp)
+         = gopt_set (dflags2 { backend = Just Interpreter }) Opt_ForceRecomp
          | otherwise
-         = (backend dflags, dflags2)
+         = dflags2
+       bcknd = backend dflags3
        -- See Note [Filepaths and Multiple Home Units]
        dflags  = dflags3 { includePaths = offsetIncludePaths dflags3 $ addImplicitQuoteInclude old_paths [current_dir] }
        upd_summary = summary { ms_hspp_opts = dflags }
@@ -835,11 +836,11 @@ 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
+        NoBackend        -> return Nothing
+        Just Interpreter -> return Nothing
+        Just ViaC        -> viaCPipeline HCc pipe_env hsc_env ml input_fn
+        Just NCG         -> Just <$> asPipeline False pipe_env hsc_env ml input_fn
+        Just LLVM        -> Just <$> llvmPipeline pipe_env hsc_env ml input_fn
 
 -- Pipeline from a given suffix
 pipelineStart :: P m => PipeEnv -> HscEnv -> FilePath -> m (Maybe FilePath)
diff --git a/compiler/GHC/Driver/Pipeline/Execute.hs b/compiler/GHC/Driver/Pipeline/Execute.hs
index 6bc9df7c6f..6250837996 100644
--- a/compiler/GHC/Driver/Pipeline/Execute.hs
+++ b/compiler/GHC/Driver/Pipeline/Execute.hs
@@ -284,7 +284,7 @@ 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
+        let (as_prog, get_asm_info) | backend dflags == Just LLVM
                     , platformOS platform == OSDarwin
                     = (GHC.SysTools.runClang, pure Clang)
                     | otherwise
@@ -500,7 +500,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
                 }
         -> case backend dflags of
           NoBackend -> panic "HscRecomp not relevant for NoBackend"
-          Interpreter -> do
+          Just 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
@@ -519,7 +519,7 @@ runHscBackendPhase pipe_env hsc_env mod_name src_flavour location result = do
               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
+          Just _ -> do
               output_fn <- phaseOutputFilenameNew next_phase pipe_env hsc_env (Just location)
               (outputFilename, mStub, foreign_files, cg_infos) <-
                 hscGenHardCode hsc_env cgguts mod_location output_fn
@@ -1040,7 +1040,7 @@ doCpp logger tmpfs dflags unit_env raw input_fn output_fn = do
                        ])
 
 getBackendDefs :: Logger -> DynFlags -> IO [String]
-getBackendDefs logger dflags | backend dflags == LLVM = do
+getBackendDefs logger dflags | backend dflags == Just LLVM = do
     llvmVer <- figureLlvmVersion logger dflags
     return $ case fmap llvmVersionList llvmVer of
                Just [m] -> [ "-D__GLASGOW_HASKELL_LLVM__=" ++ format (m,0) ]
@@ -1060,11 +1060,11 @@ hscPostBackendPhase HsBootFile _    =  StopLn
 hscPostBackendPhase HsigFile _      =  StopLn
 hscPostBackendPhase _ bcknd =
   case bcknd of
-        ViaC        -> HCc
-        NCG         -> As False
-        LLVM        -> LlvmOpt
-        NoBackend   -> StopLn
-        Interpreter -> StopLn
+        NoBackend        -> StopLn
+        Just Interpreter -> StopLn
+        Just ViaC        -> HCc
+        Just NCG         -> As False
+        Just LLVM        -> LlvmOpt
 
 
 compileStub :: HscEnv -> FilePath -> IO FilePath
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index 838f0bf3b7..51440d187c 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -1117,7 +1117,7 @@ defaultDynFlags mySettings llvmConfig =
      DynFlags {
         ghcMode                 = CompManager,
         ghcLink                 = LinkBinary,
-        backend                 = platformDefaultBackend (sTargetPlatform mySettings),
+        backend                 = Just $ platformDefaultBackend $ sTargetPlatform mySettings,
         verbosity               = 0,
         debugLevel              = 0,
         simplPhases             = 2,
@@ -2268,9 +2268,13 @@ dynamic_flags_deps = [
   , make_ord_flag defGhcFlag "keep-s-files"
         (NoArg (setGeneralFlag Opt_KeepSFiles))
   , make_ord_flag defGhcFlag "keep-llvm-file"
-        (NoArg $ setObjBackend LLVM >> setGeneralFlag Opt_KeepLlvmFiles)
+        $ NoArg $ do
+          setObjBackend $ Just LLVM
+          setGeneralFlag Opt_KeepLlvmFiles
   , make_ord_flag defGhcFlag "keep-llvm-files"
-        (NoArg $ setObjBackend LLVM >> setGeneralFlag Opt_KeepLlvmFiles)
+        $ NoArg $ do
+          setObjBackend $ Just LLVM
+          setGeneralFlag Opt_KeepLlvmFiles
      -- This only makes sense as plural
   , make_ord_flag defGhcFlag "keep-tmp-files"
         (NoArg (setGeneralFlag Opt_KeepTmpFiles))
@@ -2442,7 +2446,9 @@ dynamic_flags_deps = [
   , make_ord_flag defGhcFlag "ddump-asm-stats"
         (setDumpFlag Opt_D_dump_asm_stats)
   , make_ord_flag defGhcFlag "ddump-llvm"
-        (NoArg $ setObjBackend LLVM >> setDumpFlag' Opt_D_dump_llvm)
+        $ NoArg $ do
+          setObjBackend $ Just LLVM
+          setDumpFlag' Opt_D_dump_llvm
   , make_ord_flag defGhcFlag "ddump-c-backend"
         (NoArg $ setDumpFlag' Opt_D_dump_c_backend)
   , make_ord_flag defGhcFlag "ddump-deriv"
@@ -2862,24 +2868,24 @@ dynamic_flags_deps = [
       (NoArg (setGeneralFlag Opt_InfoTableMap))
         ------ Compiler flags -----------------------------------------------
 
-  , make_ord_flag defGhcFlag "fasm"             (NoArg (setObjBackend NCG))
+  , make_ord_flag defGhcFlag "fasm"             (NoArg $ setObjBackend $ Just NCG)
   , make_ord_flag defGhcFlag "fvia-c"           (NoArg
          (deprecate $ "The -fvia-c flag does nothing; " ++
                       "it will be removed in a future GHC release"))
   , make_ord_flag defGhcFlag "fvia-C"           (NoArg
          (deprecate $ "The -fvia-C flag does nothing; " ++
                       "it will be removed in a future GHC release"))
-  , make_ord_flag defGhcFlag "fllvm"            (NoArg (setObjBackend LLVM))
+  , make_ord_flag defGhcFlag "fllvm"            (NoArg $ setObjBackend $ Just LLVM)
 
   , make_ord_flag defFlag "fno-code"         (NoArg ((upd $ \d ->
                   d { ghcLink=NoLink }) >> setBackend NoBackend))
   , make_ord_flag defFlag "fbyte-code"
       (noArgM $ \dflags -> do
-        setBackend Interpreter
+        setBackend $ Just Interpreter
         pure $ gopt_set dflags Opt_ByteCode)
   , make_ord_flag defFlag "fobject-code"     $ NoArg $ do
       dflags <- liftEwM getCmdLineState
-      setBackend $ platformDefaultBackend (targetPlatform dflags)
+      setBackend $ Just $ platformDefaultBackend $ targetPlatform dflags
 
   , make_dep_flag defFlag "fglasgow-exts"
       (NoArg enableGlasgowExts) "Use individual extensions instead"
@@ -4720,30 +4726,30 @@ makeDynFlagsConsistent dflags
 
    -- Via-C backend only supports unregisterised ABI. Switch to a backend
    -- supporting it if possible.
- | backend dflags == ViaC &&
+ | backend dflags == Just ViaC &&
    not (platformUnregisterised (targetPlatform dflags))
     = case platformDefaultBackend (targetPlatform dflags) of
-         NCG ->  let dflags' = dflags { backend = NCG }
+         NCG ->  let dflags' = dflags { backend = Just NCG }
                      warn = "Target platform doesn't use unregisterised ABI, so using native code generator rather than compiling via C"
                  in loop dflags' warn
-         LLVM -> let dflags' = dflags { backend = LLVM }
+         LLVM -> let dflags' = dflags { backend = Just LLVM }
                      warn = "Target platform doesn't use unregisterised ABI, so using LLVM rather than compiling via C"
                  in loop dflags' warn
          _    -> pgmError "Compiling via C only supports unregisterised ABI but target platform doesn't use it."
 
- | gopt Opt_Hpc dflags && backend dflags == Interpreter
+ | gopt Opt_Hpc dflags && backend dflags == Just Interpreter
     = let dflags' = gopt_unset dflags Opt_Hpc
           warn = "Hpc can't be used with byte-code interpreter. Ignoring -fhpc."
       in loop dflags' warn
 
- | backend dflags `elem` [NCG, LLVM] &&
+ | backend dflags `elem` (fmap Just [NCG, LLVM]) &&
    platformUnregisterised (targetPlatform dflags)
-    = loop (dflags { backend = ViaC })
+    = loop (dflags { backend = Just ViaC })
            "Target platform uses unregisterised ABI, so compiling via C"
 
- | backend dflags == NCG &&
+ | backend dflags == Just NCG &&
    not (platformNcgSupported $ targetPlatform dflags)
-      = let dflags' = dflags { backend = LLVM }
+      = let dflags' = dflags { backend = Just LLVM }
             warn = "Native code generator doesn't support target platform, so using LLVM"
         in loop dflags' warn
 
@@ -4756,7 +4762,7 @@ makeDynFlagsConsistent dflags
     = loop (gopt_set dflags Opt_PIC)
            "Enabling -fPIC as it is always on for this platform"
 
- | backend dflags == Interpreter
+ | backend dflags == Just Interpreter
  , let (dflags', changed) = updOptLevelChanged 0 dflags
  , changed
     = loop dflags' "Optimization flags conflict with --interactive; optimization flags ignored."
diff --git a/compiler/GHC/HsToCore/Coverage.hs b/compiler/GHC/HsToCore/Coverage.hs
index 20086620e5..da033244f5 100644
--- a/compiler/GHC/HsToCore/Coverage.hs
+++ b/compiler/GHC/HsToCore/Coverage.hs
@@ -1066,7 +1066,7 @@ coveragePasses dflags =
 
 -- | Should we produce 'Breakpoint' ticks?
 breakpointsEnabled :: DynFlags -> Bool
-breakpointsEnabled dflags = backend dflags == Interpreter
+breakpointsEnabled dflags = backend dflags == Just Interpreter
 
 -- | Tickishs that only make sense when their source code location
 -- refers to the current file. This might not always be true due to
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 28c2cbc54d..8f3c15e508 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -395,7 +395,7 @@ tidyProgram hsc_env  (ModGuts { mg_module           = mod
                   case backend dflags of
                     -- If we are compiling for the interpreter we will insert
                     -- any necessary SPT entries dynamically
-                    Interpreter -> id
+                    Just Interpreter -> id
                     -- otherwise add a C stub to do so
                     _              -> (`appendStubC` spt_init_code)
 
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index b1c38a7166..372c39358c 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -268,8 +268,7 @@ tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport
 
 tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh l@(CLabel _) src)
   -- Foreign import label
-  = do checkCg checkCOrAsmOrLlvmOrInterp
-       -- NB check res_ty not sig_ty!
+  = do -- NB check res_ty not sig_ty!
        --    In case sig_ty is (forall a. ForeignPtr a)
        check (isFFILabelTy (mkVisFunTys arg_tys res_ty)) (illegalForeignTyErr Outputable.empty)
        cconv' <- checkCConv cconv
@@ -280,7 +279,6 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do
         -- The type must be of the form ft -> IO (FunPtr ft), where ft is a valid
         -- foreign type.  For legacy reasons ft -> IO (Ptr ft) is accepted, too.
         -- The use of the latter form is DEPRECATED, though.
-    checkCg checkCOrAsmOrLlvmOrInterp
     cconv' <- checkCConv cconv
     case arg_tys of
         [Scaled arg1_mult arg1_ty] -> do
@@ -296,7 +294,6 @@ tcCheckFIType arg_tys res_ty (CImport (L lc cconv) safety mh CWrapper src) = do
 tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
                                             (CFunction target) src)
   | isDynamicTarget target = do -- Foreign import dynamic
-      checkCg checkCOrAsmOrLlvmOrInterp
       cconv' <- checkCConv cconv
       case arg_tys of           -- The first arg must be Ptr or FunPtr
         []                ->
@@ -315,7 +312,6 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
       checkTc (xopt LangExt.GHCForeignImportPrim dflags)
               (TcRnUnknownMessage $ mkPlainError noHints $
                text "Use GHCForeignImportPrim to allow `foreign import prim'.")
-      checkCg checkCOrAsmOrLlvmOrInterp
       checkCTarget target
       checkTc (playSafe safety)
               (TcRnUnknownMessage $ mkPlainError noHints $
@@ -325,7 +321,6 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
       checkForeignRes nonIOok checkSafe (isFFIPrimResultTy dflags) res_ty
       return idecl
   | otherwise = do              -- Normal foreign import
-      checkCg checkCOrAsmOrLlvmOrInterp
       cconv' <- checkCConv cconv
       checkCTarget target
       dflags <- getDynFlags
@@ -345,7 +340,6 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
 -- that the C identifier is valid for C
 checkCTarget :: CCallTarget -> TcM ()
 checkCTarget (StaticTarget _ str _ _) = do
-    checkCg checkCOrAsmOrLlvmOrInterp
     checkTc (isCLabelString str) (badCName str)
 
 checkCTarget DynamicTarget = panic "checkCTarget DynamicTarget"
@@ -506,30 +500,21 @@ checkSafe   = True
 noCheckSafe = False
 
 -- | Checking a supported backend is in use
-checkCOrAsmOrLlvm :: Backend -> Validity
+checkCOrAsmOrLlvm :: ActualBackend -> Validity
 checkCOrAsmOrLlvm ViaC = IsValid
 checkCOrAsmOrLlvm NCG  = IsValid
 checkCOrAsmOrLlvm LLVM = IsValid
 checkCOrAsmOrLlvm _
   = NotValid (text "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)")
 
--- | Checking a supported backend is in use
-checkCOrAsmOrLlvmOrInterp :: Backend -> Validity
-checkCOrAsmOrLlvmOrInterp ViaC        = IsValid
-checkCOrAsmOrLlvmOrInterp NCG         = IsValid
-checkCOrAsmOrLlvmOrInterp LLVM        = IsValid
-checkCOrAsmOrLlvmOrInterp Interpreter = IsValid
-checkCOrAsmOrLlvmOrInterp _
-  = NotValid (text "requires interpreted, unregisterised, llvm or native code generation")
-
-checkCg :: (Backend -> Validity) -> TcM ()
+checkCg :: (ActualBackend -> Validity) -> TcM ()
 checkCg check = do
     dflags <- getDynFlags
     let bcknd = backend dflags
     case bcknd of
       NoBackend -> return ()
-      _ ->
-        case check bcknd of
+      Just bcknd' ->
+        case check bcknd' of
           IsValid      -> return ()
           NotValid err ->
             addErrTc (TcRnUnknownMessage $ mkPlainError noHints $ text "Illegal foreign declaration:" <+> err)
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 82a3290e4c..2fba3a4be1 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -839,9 +839,9 @@ tcImpPrags prags
     not_specialising dflags
       | not (gopt Opt_Specialise dflags) = True
       | otherwise = case backend dflags of
-                      NoBackend   -> True
-                      Interpreter -> True
-                      _other      -> False
+                      NoBackend        -> True
+                      Just Interpreter -> True
+                      Just _other      -> False
 
 tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag]
 tcImpSpec (name, prag)
diff --git a/compiler/GHC/Unit/Module/Graph.hs b/compiler/GHC/Unit/Module/Graph.hs
index a225c50f27..cb3df65322 100644
--- a/compiler/GHC/Unit/Module/Graph.hs
+++ b/compiler/GHC/Unit/Module/Graph.hs
@@ -276,9 +276,9 @@ showModMsg dflags recomp (ModuleNode _ mod_summary) =
     dyn_file = op $ msDynObjFilePath mod_summary
     obj_file = op $ msObjFilePath mod_summary
     message = case backend dflags of
-                Interpreter | recomp -> text "interpreted"
-                NoBackend            -> text "nothing"
-                _                    ->
+                Just Interpreter | recomp -> text "interpreted"
+                NoBackend                 -> text "nothing"
+                _                         ->
                   if gopt Opt_BuildDynamicToo  dflags
                     then text obj_file <> comma <+> text dyn_file
                     else text obj_file
diff --git a/ghc/Main.hs b/ghc/Main.hs
index cb701e24e2..82b6cd7fae 100644
--- a/ghc/Main.hs
+++ b/ghc/Main.hs
@@ -16,7 +16,7 @@ module Main (main) where
 
 -- The official GHC API
 import qualified GHC
-import GHC              (parseTargetFiles,  Ghc, GhcMonad(..), Backend (..),
+import GHC              (parseTargetFiles,  Ghc, GhcMonad(..), ActualBackend (..),
                           LoadHowMuch(..) )
 
 import GHC.Driver.CmdLine
@@ -175,14 +175,14 @@ main' postLoadMode units dflags0 args flagWarnings = do
   let dflt_backend = backend dflags0
       (mode, bcknd, link)
          = case postLoadMode of
-               DoInteractive   -> (CompManager, Interpreter,  LinkInMemory)
-               DoEval _        -> (CompManager, Interpreter,  LinkInMemory)
-               DoRun           -> (CompManager, Interpreter,  LinkInMemory)
-               DoMake          -> (CompManager, dflt_backend, LinkBinary)
-               DoBackpack      -> (CompManager, dflt_backend, LinkBinary)
-               DoMkDependHS    -> (MkDepend,    dflt_backend, LinkBinary)
-               DoAbiHash       -> (OneShot,     dflt_backend, LinkBinary)
-               _               -> (OneShot,     dflt_backend, LinkBinary)
+               DoInteractive   -> (CompManager, Just Interpreter, LinkInMemory)
+               DoEval _        -> (CompManager, Just Interpreter, LinkInMemory)
+               DoRun           -> (CompManager, Just Interpreter, LinkInMemory)
+               DoMake          -> (CompManager, dflt_backend,     LinkBinary)
+               DoBackpack      -> (CompManager, dflt_backend,     LinkBinary)
+               DoMkDependHS    -> (MkDepend,    dflt_backend,     LinkBinary)
+               DoAbiHash       -> (OneShot,     dflt_backend,     LinkBinary)
+               _               -> (OneShot,     dflt_backend,     LinkBinary)
 
   let dflags1 = dflags0{ ghcMode   = mode,
                          backend   = bcknd,
@@ -218,7 +218,7 @@ main' postLoadMode units dflags0 args flagWarnings = do
       GHC.parseDynamicFlags logger2 dflags2 args'
 
   let dflags4 = case bcknd of
-                Interpreter | not (gopt Opt_ExternalInterpreter dflags3) ->
+                Just Interpreter | not (gopt Opt_ExternalInterpreter dflags3) ->
                     let platform = targetPlatform dflags3
                         dflags3a = dflags3 { targetWays_ = hostFullWays }
                         dflags3b = foldl gopt_set dflags3a
@@ -364,7 +364,7 @@ checkOptions mode dflags srcs objs units = do
         else do
 
    case mode of
-      StopBefore StopC | backend dflags /= ViaC
+      StopBefore StopC | backend dflags /= Just ViaC
         -> throwGhcException $ UsageError $
            "the option -C is only available with an unregisterised GHC"
       StopBefore StopAs | ghcLink dflags == NoLink
diff --git a/testsuite/tests/driver/T5313.hs b/testsuite/tests/driver/T5313.hs
index 7379e9bb53..2a4b4c4682 100644
--- a/testsuite/tests/driver/T5313.hs
+++ b/testsuite/tests/driver/T5313.hs
@@ -7,7 +7,7 @@ main = do
       -- begin initialize
       df0 <- GHC.getSessionDynFlags
       let df1 = df0{GHC.ghcMode    = GHC.CompManager,
-                    GHC.backend    = GHC.Interpreter,
+                    GHC.backend    = Just GHC.Interpreter,
                     GHC.ghcLink    = GHC.LinkInMemory,
                     GHC.verbosity  = 0}
       _ <- GHC.setSessionDynFlags df1
diff --git a/testsuite/tests/ghc-api/T10052/T10052.hs b/testsuite/tests/ghc-api/T10052/T10052.hs
index 2b82a41c15..338dd13f43 100644
--- a/testsuite/tests/ghc-api/T10052/T10052.hs
+++ b/testsuite/tests/ghc-api/T10052/T10052.hs
@@ -23,7 +23,7 @@ runGhc' args act = do
       logger <- getLogger
       (dflags1, _leftover, _warns) <- parseDynamicFlags logger dflags0 flags
       let dflags2 = dflags1 {
-              backend   = Interpreter
+              backend   = Just Interpreter
             , ghcLink   = LinkInMemory
             , verbosity = 1
             }
diff --git a/testsuite/tests/ghc-api/T8639_api.hs b/testsuite/tests/ghc-api/T8639_api.hs
index e74b994a27..addab049b1 100644
--- a/testsuite/tests/ghc-api/T8639_api.hs
+++ b/testsuite/tests/ghc-api/T8639_api.hs
@@ -11,7 +11,7 @@ main
  = do { [libdir] <- getArgs
       ; runGhc (Just libdir) $ do
            flags <- getSessionDynFlags
-           setSessionDynFlags (flags{ backend = Interpreter, ghcLink = LinkInMemory})
+           setSessionDynFlags (flags{ backend = Just Interpreter, ghcLink = LinkInMemory})
            target <- guessTarget "T8639_api_a.hs" Nothing Nothing
            setTargets [target]
            load LoadAllTargets
diff --git a/testsuite/tests/ghc-api/apirecomp001/myghc.hs b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
index 3d2cb9c238..7c4f6dc3a4 100644
--- a/testsuite/tests/ghc-api/apirecomp001/myghc.hs
+++ b/testsuite/tests/ghc-api/apirecomp001/myghc.hs
@@ -37,7 +37,7 @@ main = do
     prn "target nothing: ok"
 
     dflags <- getSessionDynFlags
-    setSessionDynFlags $ dflags { backend = Interpreter }
+    setSessionDynFlags $ dflags { backend = Just Interpreter }
     ok <- load LoadAllTargets
     when (failed ok) $ error "Couldn't load A.hs in interpreted mode"
     prn "target interpreted: ok"
diff --git a/testsuite/tests/ghci/linking/dyn/T3372.hs b/testsuite/tests/ghci/linking/dyn/T3372.hs
index e49e0a1672..7ff61264a6 100644
--- a/testsuite/tests/ghci/linking/dyn/T3372.hs
+++ b/testsuite/tests/ghci/linking/dyn/T3372.hs
@@ -41,7 +41,7 @@ newGhcServer = do (libdir:_) <- getArgs
   where ghc action libdir = GHC.runGhc (Just libdir) (init >> action)
         init = do df <- GHC.getSessionDynFlags
                   GHC.setSessionDynFlags df{GHC.ghcMode    = GHC.CompManager,
-                                            GHC.backend    = GHC.Interpreter,
+                                            GHC.backend    = Just GHC.Interpreter,
                                             GHC.ghcLink    = GHC.LinkInMemory,
                                             GHC.verbosity  = 0}