Migrate errors to diagnostics in GHC.Tc.Module

This commit migrates the errors in GHC.Tc.Module to use the new
diagnostic infrastructure.

It required a significant overhaul of the compatibility checks between
an hs-boot or signature module and its implementation; we now use
a Writer monad to accumulate errors; see the BootMismatch datatype
in GHC.Tc.Errors.Types, with its panoply of subtypes.
For the sake of readability, several local functions inside the
'checkBootTyCon' function were split off into top-level functions.

We split off GHC.Types.HscSource into a "boot or sig" vs "normal hs file"
datatype, as this mirrors the logic in several other places where we
want to treat hs-boot and hsig files in a similar fashion.

This commit also refactors the Backpack checks for type synonyms
implementing abstract data, to correctly reject implementations that
contain qualified or quantified types (this fixes #23342 and #23344).

1 files changed, 16 insertions, 5 deletions

diff --git a/compiler/GHC/Rename/Bind.hs b/compiler/GHC/Rename/Bind.hs
index 503e56bd57..73af997a2e 100644
--- a/compiler/GHC/Rename/Bind.hs
+++ b/compiler/GHC/Rename/Bind.hs
@@ -26,7 +26,10 @@ module GHC.Rename.Bind (
    rnMethodBinds, renameSigs,
    rnMatchGroup, rnGRHSs, rnGRHS, rnSrcFixityDecl,
    makeMiniFixityEnv, MiniFixityEnv,
-   HsSigCtxt(..)
+   HsSigCtxt(..),
+
+   -- Utility for hs-boot files
+   rejectBootDecls
    ) where
 
 import GHC.Prelude
@@ -56,6 +59,7 @@ import GHC.Types.Name
 import GHC.Types.Name.Env
 import GHC.Types.Name.Set
 import GHC.Types.Name.Reader ( RdrName, rdrNameOcc )
+import GHC.Types.SourceFile
 import GHC.Types.SrcLoc as SrcLoc
 import GHC.Data.List.SetOps    ( findDupsEq )
 import GHC.Types.Basic         ( RecFlag(..), TypeOrKind(..) )
@@ -199,10 +203,20 @@ rnTopBindsLHSBoot fix_env binds
   = do  { topBinds <- rnTopBindsLHS fix_env binds
         ; case topBinds of
             ValBinds x mbinds sigs ->
-              do  { mapM_ bindInHsBootFileErr mbinds
+              do  { rejectBootDecls HsBoot BootBindsPs (bagToList $ mbinds)
                   ; pure (ValBinds x emptyBag sigs) }
             _ -> pprPanic "rnTopBindsLHSBoot" (ppr topBinds) }
 
+rejectBootDecls :: HsBootOrSig
+                -> (NonEmpty (LocatedA decl) -> BadBootDecls)
+                -> [LocatedA decl]
+                -> TcM ()
+rejectBootDecls _ _ [] = return ()
+rejectBootDecls hsc_src what (decl@(L loc _) : decls)
+  = addErrAt (locA loc)
+  $ TcRnIllegalHsBootOrSigDecl hsc_src
+      (what $ decl :| decls)
+
 rnTopBindsBoot :: NameSet -> HsValBindsLR GhcRn GhcPs
                -> RnM (HsValBinds GhcRn, DefUses)
 -- A hs-boot file has no bindings.
@@ -1384,9 +1398,6 @@ misplacedSigErr :: LSig GhcRn -> RnM ()
 misplacedSigErr (L loc sig)
   = addErrAt (locA loc) $ TcRnMisplacedSigDecl sig
 
-bindInHsBootFileErr :: LHsBindLR GhcRn GhcPs -> RnM ()
-bindInHsBootFileErr (L loc _) = addErrAt (locA loc) TcRnBindInBootFile
-
 nonStdGuardErr :: (Outputable body,
                    Anno (Stmt GhcRn body) ~ SrcSpanAnnA)
                => [LStmtLR GhcRn GhcRn body] -> TcRnMessage