summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-01-06 14:02:47 -0500
committerMarge Bot <ben+marge-bot@smart-cactus.org>2020-01-07 13:14:57 -0500
commitb69a3460d11cba49e861f708100801c8e25efa3e (patch)
treea075a807851b803a62d602dab40b62472d2be297
parent1ca9adbc88903afe49de0d063ccd35daf43f7d9e (diff)
downloadhaskell-b69a3460d11cba49e861f708100801c8e25efa3e.tar.gz
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.
-rw-r--r--compiler/GHC/Hs.hs16
-rw-r--r--compiler/backpack/BkpSyn.hs2
-rw-r--r--compiler/backpack/DriverBkp.hs4
-rw-r--r--compiler/main/GHC.hs4
-rw-r--r--compiler/main/HscStats.hs2
-rw-r--r--compiler/main/HscTypes.hs2
-rw-r--r--compiler/parser/Parser.y6
-rw-r--r--testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs4
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 })))