Commit b69a3460 authored by Ryan Scott's avatar Ryan Scott Committed by Marge Bot

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.
parent 1ca9adbc
Pipeline #14335 failed with stages
in 516 minutes and 59 seconds
......@@ -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
......
......@@ -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)
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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
......
......@@ -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 })))
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment