Monomorphize HsModule to GhcPs (#17642)

Analyzing the call sites for `HsModule` reveals that it is only ever
used with parsed code (i.e., `GhcPs`). This simplifies `HsModule` by
concretizing its `pass` parameter to always be `GhcPs`.

Fixes #17642.

8 files changed, 19 insertions, 21 deletions

diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs
index 103539a41b..ecd891b52e 100644
--- a/compiler/GHC/Hs.hs
+++ b/compiler/GHC/Hs.hs
@@ -63,12 +63,12 @@ import Data.Data hiding ( Fixity )
 -- | Haskell Module
 --
 -- All we actually declare here is the top-level structure for a module.
-data HsModule pass
+data HsModule
   = HsModule {
       hsmodName :: Maybe (Located ModuleName),
         -- ^ @Nothing@: \"module X where\" is omitted (in which case the next
         --     field is Nothing too)
-      hsmodExports :: Maybe (Located [LIE pass]),
+      hsmodExports :: Maybe (Located [LIE GhcPs]),
         -- ^ Export list
         --
         --  - @Nothing@: export list omitted, so export everything
@@ -82,11 +82,11 @@ data HsModule pass
         --                                   ,'ApiAnnotation.AnnClose'
 
         -- For details on above see note [Api annotations] in ApiAnnotation
-      hsmodImports :: [LImportDecl pass],
+      hsmodImports :: [LImportDecl GhcPs],
         -- ^ We snaffle interesting stuff out of the imported interfaces early
         -- on, adding that info to TyDecls/etc; so this list is often empty,
         -- downstream.
-      hsmodDecls :: [LHsDecl pass],
+      hsmodDecls :: [LHsDecl GhcPs],
         -- ^ Type, class, value, and interface signature decls
       hsmodDeprecMessage :: Maybe (Located WarningTxt),
         -- ^ reason\/explanation for warning/deprecation of this module
@@ -113,12 +113,10 @@ data HsModule pass
      --    hsmodImports,hsmodDecls if this style is used.
 
      -- For details on above see note [Api annotations] in ApiAnnotation
--- deriving instance (DataIdLR name name) => Data (HsModule name)
-deriving instance Data (HsModule GhcPs)
-deriving instance Data (HsModule GhcRn)
-deriving instance Data (HsModule GhcTc)
 
-instance (OutputableBndrId p) => Outputable (HsModule (GhcPass p)) where
+deriving instance Data HsModule
+
+instance Outputable HsModule where
 
     ppr (HsModule Nothing _ imports decls _ mbDoc)
       = pp_mb mbDoc $$ pp_nonnull imports
diff --git a/compiler/backpack/BkpSyn.hs b/compiler/backpack/BkpSyn.hs
index 87eb2d6ddf..ce14018883 100644
--- a/compiler/backpack/BkpSyn.hs
+++ b/compiler/backpack/BkpSyn.hs
@@ -61,7 +61,7 @@ type LHsUnit n = Located (HsUnit n)
 -- | A declaration in a package, e.g. a module or signature definition,
 -- or an include.
 data HsUnitDecl n
-    = DeclD   HscSource (Located ModuleName) (Maybe (Located (HsModule GhcPs)))
+    = DeclD   HscSource (Located ModuleName) (Maybe (Located HsModule))
     | IncludeD   (IncludeDecl n)
 type LHsUnitDecl n = Located (HsUnitDecl n)
 
diff --git a/compiler/backpack/DriverBkp.hs b/compiler/backpack/DriverBkp.hs
index 828a39c57f..0afef71bb7 100644
--- a/compiler/backpack/DriverBkp.hs
+++ b/compiler/backpack/DriverBkp.hs
@@ -711,7 +711,7 @@ summariseRequirement pn mod_name = do
 summariseDecl :: PackageName
               -> HscSource
               -> Located ModuleName
-              -> Maybe (Located (HsModule GhcPs))
+              -> Maybe (Located HsModule)
               -> BkpM ModSummary
 summariseDecl pn hsc_src (L _ modname) (Just hsmod) = hsModuleToModSummary pn hsc_src modname hsmod
 summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
@@ -738,7 +738,7 @@ summariseDecl _pn hsc_src lmodname@(L loc modname) Nothing
 hsModuleToModSummary :: PackageName
                      -> HscSource
                      -> ModuleName
-                     -> Located (HsModule GhcPs)
+                     -> Located HsModule
                      -> BkpM ModSummary
 hsModuleToModSummary pn hsc_src modname
                      hsmod = do
diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs
index 4030e87eff..38645e9b23 100644
--- a/compiler/main/GHC.hs
+++ b/compiler/main/GHC.hs
@@ -857,7 +857,7 @@ instance TypecheckedMod DesugaredModule where
 instance DesugaredMod DesugaredModule where
   coreModule m = dm_core_module m
 
-type ParsedSource      = Located (HsModule GhcPs)
+type ParsedSource      = Located HsModule
 type RenamedSource     = (HsGroup GhcRn, [LImportDecl GhcRn], Maybe [(LIE GhcRn, Avails)],
                           Maybe LHsDocString)
 type TypecheckedSource = LHsBinds GhcTc
@@ -1547,7 +1547,7 @@ lookupName name =
 parser :: String         -- ^ Haskell module source text (full Unicode is supported)
        -> DynFlags       -- ^ the flags
        -> FilePath       -- ^ the filename (for source locations)
-       -> (WarningMessages, Either ErrorMessages (Located (HsModule GhcPs)))
+       -> (WarningMessages, Either ErrorMessages (Located HsModule))
 
 parser str dflags filename =
    let
diff --git a/compiler/main/HscStats.hs b/compiler/main/HscStats.hs
index a5072a7690..5c034a373f 100644
--- a/compiler/main/HscStats.hs
+++ b/compiler/main/HscStats.hs
@@ -21,7 +21,7 @@ import Util
 import Data.Char
 
 -- | Source Statistics
-ppSourceStats :: Bool -> Located (HsModule GhcPs) -> SDoc
+ppSourceStats :: Bool -> Located HsModule -> SDoc
 ppSourceStats short (L _ (HsModule _ exports imports ldecls _ _))
   = (if short then hcat else vcat)
         (map pp_val
diff --git a/compiler/main/HscTypes.hs b/compiler/main/HscTypes.hs
index 5974b4ec63..85aac8c7c4 100644
--- a/compiler/main/HscTypes.hs
+++ b/compiler/main/HscTypes.hs
@@ -3098,7 +3098,7 @@ instance Binary IfaceTrustInfo where
 -}
 
 data HsParsedModule = HsParsedModule {
-    hpm_module    :: Located (HsModule GhcPs),
+    hpm_module    :: Located HsModule,
     hpm_src_files :: [FilePath],
        -- ^ extra source files (e.g. from #includes).  The lexer collects
        -- these from '# <file> <line>' pragmas, which the C preprocessor
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index c96cd92f5a..e824c385c4 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -759,7 +759,7 @@ unitdecl :: { LHsUnitDecl PackageName }
 -- either, and DEPRECATED is only expected to be used by people who really
 -- know what they are doing. :-)
 
-signature :: { Located (HsModule GhcPs) }
+signature :: { Located HsModule }
        : maybedocheader 'signature' modid maybemodwarning maybeexports 'where' body
              {% fileSrcSpan >>= \ loc ->
                 ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
@@ -767,7 +767,7 @@ signature :: { Located (HsModule GhcPs) }
                     )
                     ([mj AnnSignature $2, mj AnnWhere $6] ++ fst $7) }
 
-module :: { Located (HsModule GhcPs) }
+module :: { Located HsModule }
        : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body
              {% fileSrcSpan >>= \ loc ->
                 ams (L loc (HsModule (Just $3) $5 (fst $ snd $7)
@@ -824,7 +824,7 @@ top1    :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) }
 -----------------------------------------------------------------------------
 -- Module declaration & imports only
 
-header  :: { Located (HsModule GhcPs) }
+header  :: { Located HsModule }
         : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body
                 {% fileSrcSpan >>= \ loc ->
                    ams (L loc (HsModule (Just $3) $5 $7 [] $4 $1
diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
index 0d7e44b4b6..89464451ee 100644
--- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
+++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs
@@ -31,8 +31,8 @@ parsedPlugin [name, "parse"] _ pm
   = return $ pm { hpm_module = removeParsedBinding name (hpm_module pm) }
 parsedPlugin _ _ pm = return pm
 
-removeParsedBinding :: String -> Located (HsModule GhcPs)
-                         -> Located (HsModule GhcPs)
+removeParsedBinding :: String -> Located HsModule
+                         -> Located HsModule
 removeParsedBinding name (L l m)
   = (L l (m { hsmodDecls = filter (notNamedAs name) (hsmodDecls m) } ))
   where notNamedAs name (L _ (ValD _ (FunBind { fun_id = L _ fid })))