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

4 files changed, 32 insertions, 48 deletions

diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs
index 59bde4f0aa..b8ed303dd7 100644
--- a/compiler/GHC/Tc/Errors/Ppr.hs
+++ b/compiler/GHC/Tc/Errors/Ppr.hs
@@ -41,7 +41,7 @@ import GHC.Core.Predicate
 import GHC.Core.Type
 
 import GHC.Driver.Flags
-
+import GHC.Driver.Backend
 import GHC.Hs
 
 import GHC.Tc.Errors.Types
@@ -737,12 +737,9 @@ instance Diagnostic TcRnMessage where
            text "possible missing & in foreign import of FunPtr"
 
     TcRnIllegalForeignDeclBackend _decl _backend expectedBknds
-      -> mkSimpleDecorated $ text "Illegal foreign declaration:" <+>
-           case expectedBknds of
-             COrAsmOrLlvm ->
-               text "requires unregisterised, llvm (-fllvm) or native code generation (-fasm)"
-             COrAsmOrLlvmOrInterp ->
-               text "requires interpreted, unregisterised, llvm or native code generation"
+      -> mkSimpleDecorated $
+         fsep (text "Illegal foreign declaration: requires one of these back ends:" :
+               commafyWith (text "or") (map (text . backendDescription) expectedBknds))
 
     TcRnUnsupportedCallConv _decl unsupportedCC
       -> mkSimpleDecorated $
@@ -1481,6 +1478,18 @@ instance Diagnostic TcRnMessage where
     TcRnUnpromotableThing{}
       -> noHints
 
+
+-- | Change [x] to "x", [x, y] to "x and y", [x, y, z] to "x, y, and z",
+-- and so on.  The `and` stands for any `conjunction`, which is passed in.
+commafyWith :: SDoc -> [SDoc] -> [SDoc]
+commafyWith _ [] = []
+commafyWith _ [x] = [x]
+commafyWith conjunction [x, y] = [x <+> conjunction <+> y]
+commafyWith conjunction xs = addConjunction $ punctuate comma xs
+    where addConjunction [x, y] = [x, conjunction, y]
+          addConjunction (x : xs) = x : addConjunction xs
+          addConjunction _ = panic "commafyWith expected 2 or more elements"
+
 deriveInstanceErrReasonHints :: Class
                              -> UsingGeneralizedNewtypeDeriving
                              -> DeriveInstanceErrReason
diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs
index b1f635325a..182818616a 100644
--- a/compiler/GHC/Tc/Errors/Types.hs
+++ b/compiler/GHC/Tc/Errors/Types.hs
@@ -62,7 +62,7 @@ module GHC.Tc.Errors.Types (
   , CoercibleMsg(..)
   , PotentialInstances(..)
   , UnsupportedCallConvention(..)
-  , ExpectedBackends(..)
+  , ExpectedBackends
   , ArgOrResult(..)
   ) where
 
@@ -2008,11 +2008,8 @@ data TcRnMessage where
   -}
   TcRnUnpromotableThing :: !Name -> !PromotionErr -> TcRnMessage
 
--- | Specifies which backend code generators where expected for an FFI declaration
-data ExpectedBackends
-  = COrAsmOrLlvm         -- ^ C, Asm, or LLVM
-  | COrAsmOrLlvmOrInterp -- ^ C, Asm, LLVM, or interpreted
-  deriving Eq
+-- | Specifies which back ends can handle a requested foreign import or export
+type ExpectedBackends = [Backend]
 
 -- | Specifies which calling convention is unsupported on the current platform
 data UnsupportedCallConvention
diff --git a/compiler/GHC/Tc/Gen/Foreign.hs b/compiler/GHC/Tc/Gen/Foreign.hs
index 31f47227c8..819c66b2c2 100644
--- a/compiler/GHC/Tc/Gen/Foreign.hs
+++ b/compiler/GHC/Tc/Gen/Foreign.hs
@@ -268,7 +268,7 @@ tcCheckFIType :: [Scaled Type] -> Type -> ForeignImport -> TcM ForeignImport
 
 tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) safety mh l@(CLabel _) src)
   -- Foreign import label
-  = do checkCg (Right idecl) checkCOrAsmOrLlvmOrInterp
+  = do checkCg (Right idecl) backendValidityOfCImport
        -- NB check res_ty not sig_ty!
        --    In case sig_ty is (forall a. ForeignPtr a)
        check (isFFILabelTy (mkVisFunTys arg_tys res_ty))
@@ -281,7 +281,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) safety mh CWrapper src)
         -- 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 (Right idecl) checkCOrAsmOrLlvmOrInterp
+    checkCg (Right idecl) backendValidityOfCImport
     cconv' <- checkCConv (Right idecl) cconv
     case arg_tys of
         [Scaled arg1_mult arg1_ty] -> do
@@ -297,7 +297,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) safety mh CWrapper src)
 tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
                                             (CFunction target) src)
   | isDynamicTarget target = do -- Foreign import dynamic
-      checkCg (Right idecl) checkCOrAsmOrLlvmOrInterp
+      checkCg (Right idecl) backendValidityOfCImport
       cconv' <- checkCConv (Right idecl) cconv
       case arg_tys of           -- The first arg must be Ptr or FunPtr
         []                ->
@@ -315,7 +315,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
       dflags <- getDynFlags
       checkTc (xopt LangExt.GHCForeignImportPrim dflags)
               (TcRnForeignImportPrimExtNotSet idecl)
-      checkCg (Right idecl) checkCOrAsmOrLlvmOrInterp
+      checkCg (Right idecl) backendValidityOfCImport
       checkCTarget idecl target
       checkTc (playSafe safety)
               (TcRnForeignImportPrimSafeAnn idecl)
@@ -324,7 +324,7 @@ 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 (Right idecl) checkCOrAsmOrLlvmOrInterp
+      checkCg (Right idecl) backendValidityOfCImport
       cconv' <- checkCConv (Right idecl) cconv
       checkCTarget idecl target
       dflags <- getDynFlags
@@ -342,7 +342,7 @@ tcCheckFIType arg_tys res_ty idecl@(CImport (L lc cconv) (L ls safety) mh
 -- that the C identifier is valid for C
 checkCTarget :: ForeignImport -> CCallTarget -> TcM ()
 checkCTarget idecl (StaticTarget _ str _ _) = do
-    checkCg (Right idecl) checkCOrAsmOrLlvmOrInterp
+    checkCg (Right idecl) backendValidityOfCImport
     checkTc (isCLabelString str) (TcRnInvalidCIdentifier str)
 
 checkCTarget _ DynamicTarget = panic "checkCTarget DynamicTarget"
@@ -415,7 +415,7 @@ tcFExport d = pprPanic "tcFExport" (ppr d)
 
 tcCheckFEType :: Type -> ForeignExport -> TcM ForeignExport
 tcCheckFEType sig_ty edecl@(CExport (L l (CExportStatic esrc str cconv)) src) = do
-    checkCg (Left edecl) checkCOrAsmOrLlvm
+    checkCg (Left edecl) backendValidityOfCExport
     checkTc (isCLabelString str) (TcRnInvalidCIdentifier str)
     cconv' <- checkCConv (Left edecl) cconv
     checkForeignArgs isFFIExternalTy arg_tys
@@ -497,32 +497,14 @@ checkSafe, noCheckSafe :: Bool
 checkSafe   = True
 noCheckSafe = False
 
--- | Checking a supported backend is in use
-checkCOrAsmOrLlvm :: Backend -> Validity' ExpectedBackends
-checkCOrAsmOrLlvm ViaC = IsValid
-checkCOrAsmOrLlvm NCG  = IsValid
-checkCOrAsmOrLlvm LLVM = IsValid
-checkCOrAsmOrLlvm _    = NotValid COrAsmOrLlvm
-
--- | Checking a supported backend is in use
-checkCOrAsmOrLlvmOrInterp :: Backend -> Validity' ExpectedBackends
-checkCOrAsmOrLlvmOrInterp ViaC        = IsValid
-checkCOrAsmOrLlvmOrInterp NCG         = IsValid
-checkCOrAsmOrLlvmOrInterp LLVM        = IsValid
-checkCOrAsmOrLlvmOrInterp Interpreter = IsValid
-checkCOrAsmOrLlvmOrInterp _           = NotValid COrAsmOrLlvmOrInterp
-
 checkCg :: Either ForeignExport ForeignImport -> (Backend -> Validity' ExpectedBackends) -> TcM ()
 checkCg decl check = do
     dflags <- getDynFlags
     let bcknd = backend dflags
-    case bcknd of
-      NoBackend -> return ()
-      _ ->
-        case check bcknd of
-          IsValid -> return ()
-          NotValid expectedBcknd ->
-            addErrTc $ TcRnIllegalForeignDeclBackend decl bcknd expectedBcknd
+    case check bcknd of
+      IsValid -> return ()
+      NotValid expectedBcknds ->
+        addErrTc $ TcRnIllegalForeignDeclBackend decl bcknd expectedBcknds
 
 -- Calling conventions
 
diff --git a/compiler/GHC/Tc/Gen/Sig.hs b/compiler/GHC/Tc/Gen/Sig.hs
index 874870765f..95cb2f467f 100644
--- a/compiler/GHC/Tc/Gen/Sig.hs
+++ b/compiler/GHC/Tc/Gen/Sig.hs
@@ -858,12 +858,8 @@ tcImpPrags prags
     -- when we aren't specialising, or when we aren't generating
     -- code.  The latter happens when Haddocking the base library;
     -- we don't want complaints about lack of INLINABLE pragmas
-    not_specialising dflags
-      | not (gopt Opt_Specialise dflags) = True
-      | otherwise = case backend dflags of
-                      NoBackend   -> True
-                      Interpreter -> True
-                      _other      -> False
+    not_specialising dflags =
+      not (gopt Opt_Specialise dflags) || not (backendRespectsSpecialise (backend dflags))
 
 tcImpSpec :: (Name, Sig GhcRn) -> TcM [TcSpecPrag]
 tcImpSpec (name, prag)