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.

2 files changed, 8 insertions, 23 deletions

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)