diff options
author | romes <rodrigo.m.mesquita@gmail.com> | 2022-05-14 12:12:19 +0200 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-07-03 14:11:31 -0400 |
commit | 3a8970ac0c69335a1d229f9c9a71e6e333e99bfb (patch) | |
tree | 28a786d6e3bbc40b068cc7fe10433a9a8037b1d6 /compiler/GHC | |
parent | 9e79f6d09c9fbd81150a45d307f753141453c945 (diff) | |
download | haskell-3a8970ac0c69335a1d229f9c9a71e6e333e99bfb.tar.gz |
TTG: Move HsModule to L.H.S
Move the definition of HsModule defined in GHC.Hs to
Language.Haskell.Syntax with an added TTG parameter and corresponding
extension fields.
This is progress towards having the haskell-syntax package, as described
in #21592
Diffstat (limited to 'compiler/GHC')
-rw-r--r-- | compiler/GHC/Driver/Backpack.hs | 16 | ||||
-rw-r--r-- | compiler/GHC/Driver/Backpack/Syntax.hs | 3 | ||||
-rw-r--r-- | compiler/GHC/Driver/Main.hs | 20 | ||||
-rw-r--r-- | compiler/GHC/Hs.hs | 61 | ||||
-rw-r--r-- | compiler/GHC/Hs/Dump.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Hs/Stats.hs | 5 | ||||
-rw-r--r-- | compiler/GHC/Iface/Ext/Ast.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Parser.y | 51 | ||||
-rw-r--r-- | compiler/GHC/Parser/Errors/Types.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Parser/PostProcess/Haddock.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Tc/Errors/Types.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/Tc/Module.hs | 8 | ||||
-rw-r--r-- | compiler/GHC/Tc/Utils/Backpack.hs | 2 | ||||
-rw-r--r-- | compiler/GHC/Unit/Module/Name.hs | 7 | ||||
-rw-r--r-- | compiler/GHC/Unit/Module/Name.hs-boot | 9 | ||||
-rw-r--r-- | compiler/GHC/Unit/Types.hs-boot | 2 | ||||
-rw-r--r-- | compiler/GHC/Utils/Outputable.hs | 2 |
18 files changed, 92 insertions, 108 deletions
diff --git a/compiler/GHC/Driver/Backpack.hs b/compiler/GHC/Driver/Backpack.hs index 06fdbb34e8..09a5678796 100644 --- a/compiler/GHC/Driver/Backpack.hs +++ b/compiler/GHC/Driver/Backpack.hs @@ -795,14 +795,16 @@ summariseRequirement pn mod_name = do ms_ghc_prim_import = False, ms_parsed_mod = Just (HsParsedModule { hpm_module = L loc (HsModule { - hsmodAnn = noAnn, - hsmodLayout = NoLayoutInfo, + hsmodExt = XModulePs { + hsmodAnn = noAnn, + hsmodLayout = NoLayoutInfo, + hsmodDeprecMessage = Nothing, + hsmodHaddockModHeader = Nothing + }, hsmodName = Just (L (noAnnSrcSpan loc) mod_name), hsmodExports = Nothing, hsmodImports = [], - hsmodDecls = [], - hsmodDeprecMessage = Nothing, - hsmodHaddockModHeader = Nothing + hsmodDecls = [] }), hpm_src_files = [] }), @@ -816,7 +818,7 @@ summariseRequirement pn mod_name = do summariseDecl :: PackageName -> HscSource -> Located ModuleName - -> Located HsModule + -> Located (HsModule GhcPs) -> [NodeKey] -> BkpM ModuleGraphNode summariseDecl pn hsc_src (L _ modname) hsmod home_keys = hsModuleToModSummary home_keys pn hsc_src modname hsmod @@ -830,7 +832,7 @@ hsModuleToModSummary :: [NodeKey] -> PackageName -> HscSource -> ModuleName - -> Located HsModule + -> Located (HsModule GhcPs) -> BkpM ModuleGraphNode hsModuleToModSummary home_keys pn hsc_src modname hsmod = do diff --git a/compiler/GHC/Driver/Backpack/Syntax.hs b/compiler/GHC/Driver/Backpack/Syntax.hs index e67c62d6d8..572d650982 100644 --- a/compiler/GHC/Driver/Backpack/Syntax.hs +++ b/compiler/GHC/Driver/Backpack/Syntax.hs @@ -23,7 +23,6 @@ import GHC.Hs import GHC.Types.SrcLoc import GHC.Types.SourceFile -import GHC.Unit.Module.Name import GHC.Unit.Types import GHC.Unit.Info @@ -65,7 +64,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) (Located HsModule) + = DeclD HscSource (Located ModuleName) (Located (HsModule GhcPs)) | IncludeD (IncludeDecl n) type LHsUnitDecl n = Located (HsUnitDecl n) diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 2936630db8..29ca1e42ae 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -1,4 +1,5 @@ {-# LANGUAGE BangPatterns #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE NondecreasingIndentation #-} {-# LANGUAGE GADTs #-} @@ -2051,7 +2052,7 @@ hscDecls :: HscEnv -> IO ([TyThing], InteractiveContext) hscDecls hsc_env str = hscDeclsWithLocation hsc_env str "<interactive>" 1 -hscParseModuleWithLocation :: HscEnv -> String -> Int -> String -> IO HsModule +hscParseModuleWithLocation :: HscEnv -> String -> Int -> String -> IO (HsModule GhcPs) hscParseModuleWithLocation hsc_env source line_num str = do L _ mod <- runInteractiveHsc hsc_env $ @@ -2198,14 +2199,15 @@ hscAddSptEntries hsc_env entries = do hscImport :: HscEnv -> String -> IO (ImportDecl GhcPs) hscImport hsc_env str = runInteractiveHsc hsc_env $ do - (L _ (HsModule{hsmodImports=is})) <- - hscParseThing parseModule str - case is of - [L _ i] -> return i - _ -> liftIO $ throwOneError $ - mkPlainErrorMsgEnvelope noSrcSpan $ - GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $ - text "parse error in import declaration" + hscParseThing parseModule str >>= \case + (L _ (XModule x)) -> dataConCantHappen x + (L _ (HsModule{hsmodImports=is})) -> + case is of + [L _ i] -> return i + _ -> liftIO $ throwOneError $ + mkPlainErrorMsgEnvelope noSrcSpan $ + GhcPsMessage $ PsUnknownMessage $ mkPlainError noHints $ + text "parse error in import declaration" -- | Typecheck an expression (but don't run it) hscTcExpr :: HscEnv diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs index 5a6f2cc2be..f06619d030 100644 --- a/compiler/GHC/Hs.hs +++ b/compiler/GHC/Hs.hs @@ -34,7 +34,7 @@ module GHC.Hs ( Fixity, HsModule(..), AnnsModule(..), - HsParsedModule(..) + HsParsedModule(..), XModulePs(..) ) where -- friends: @@ -58,53 +58,18 @@ import GHC.Hs.Instances () -- For Data instances import GHC.Utils.Outputable import GHC.Types.Fixity ( Fixity ) import GHC.Types.SrcLoc -import GHC.Unit.Module ( ModuleName ) import GHC.Unit.Module.Warnings ( WarningTxt ) -- libraries: import Data.Data hiding ( Fixity ) --- | Haskell Module --- --- All we actually declare here is the top-level structure for a module. -data HsModule - = -- | 'GHC.Parser.Annotation.AnnKeywordId's - -- - -- - 'GHC.Parser.Annotation.AnnModule','GHC.Parser.Annotation.AnnWhere' - -- - -- - 'GHC.Parser.Annotation.AnnOpen','GHC.Parser.Annotation.AnnSemi', - -- 'GHC.Parser.Annotation.AnnClose' for explicit braces and semi around - -- hsmodImports,hsmodDecls if this style is used. - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - HsModule { +-- | Haskell Module extension point: GHC specific +data XModulePs + = XModulePs { hsmodAnn :: EpAnn AnnsModule, hsmodLayout :: LayoutInfo, -- ^ Layout info for the module. -- For incomplete modules (e.g. the output of parseHeader), it is NoLayoutInfo. - hsmodName :: Maybe (LocatedA ModuleName), - -- ^ @Nothing@: \"module X where\" is omitted (in which case the next - -- field is Nothing too) - hsmodExports :: Maybe (LocatedL [LIE GhcPs]), - -- ^ Export list - -- - -- - @Nothing@: export list omitted, so export everything - -- - -- - @Just []@: export /nothing/ - -- - -- - @Just [...]@: as you would expect... - -- - -- - -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen' - -- ,'GHC.Parser.Annotation.AnnClose' - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - 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 GhcPs], - -- ^ Type, class, value, and interface signature decls hsmodDeprecMessage :: Maybe (LocatedP (WarningTxt GhcPs)), -- ^ reason\/explanation for warning/deprecation of this module -- @@ -121,8 +86,14 @@ data HsModule -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation } + deriving Data + +type instance XModule GhcPs = XModulePs +type instance XModule GhcRn = DataConCantHappen +type instance XModule GhcTc = DataConCantHappen +type instance XXModule p = DataConCantHappen -deriving instance Data HsModule +deriving instance Data (HsModule GhcPs) data AnnsModule = AnnsModule { @@ -130,13 +101,15 @@ data AnnsModule am_decls :: AnnList } deriving (Data, Eq) -instance Outputable HsModule where +instance Outputable (HsModule GhcPs) where + + ppr (XModule ext) = dataConCantHappen ext - ppr (HsModule _ _ Nothing _ imports decls _ mbDoc) + ppr (HsModule (XModulePs _ _ _ mbDoc) Nothing _ imports decls) = pprMaybeWithDoc mbDoc $ pp_nonnull imports $$ pp_nonnull decls - ppr (HsModule _ _ (Just name) exports imports decls deprec mbDoc) + ppr (HsModule (XModulePs _ _ deprec mbDoc) (Just name) exports imports decls) = pprMaybeWithDoc mbDoc $ vcat [ case exports of @@ -161,7 +134,7 @@ pp_nonnull [] = empty pp_nonnull xs = vcat (map ppr xs) data HsParsedModule = HsParsedModule { - hpm_module :: Located HsModule, + hpm_module :: Located (HsModule GhcPs), 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/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs index de9848e139..77d2036425 100644 --- a/compiler/GHC/Hs/Dump.hs +++ b/compiler/GHC/Hs/Dump.hs @@ -30,7 +30,6 @@ import GHC.Types.Name import GHC.Types.SrcLoc import GHC.Types.Var import GHC.Types.SourceText -import GHC.Unit.Module import GHC.Utils.Outputable import Data.Data hiding (Fixity) diff --git a/compiler/GHC/Hs/Stats.hs b/compiler/GHC/Hs/Stats.hs index bd3e2e6b6d..0c348e2c97 100644 --- a/compiler/GHC/Hs/Stats.hs +++ b/compiler/GHC/Hs/Stats.hs @@ -22,8 +22,9 @@ import GHC.Utils.Panic import Data.Char -- | Source Statistics -ppSourceStats :: Bool -> Located HsModule -> SDoc -ppSourceStats short (L _ (HsModule{ hsmodExports = exports, hsmodImports = imports, hsmodDecls = ldecls })) +ppSourceStats :: Bool -> Located (HsModule GhcPs) -> SDoc +ppSourceStats _ (L _ (XModule x)) = dataConCantHappen x +ppSourceStats short (L _ (HsModule _ _ exports imports ldecls)) = (if short then hcat else vcat) (map pp_val [("ExportAll ", export_all), -- 1 if no export list diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index 9547296fe0..cbd46de9f5 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -61,7 +61,7 @@ import qualified GHC.Data.Strict as Strict import GHC.Iface.Ext.Types import GHC.Iface.Ext.Utils -import GHC.Unit.Module ( ModuleName, ml_hs_file ) +import GHC.Unit.Module ( ml_hs_file ) import GHC.Unit.Module.ModSummary import qualified Data.Array as A diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 9d45b0c7c8..f819320d1f 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -853,12 +853,12 @@ unitdecl :: { LHsUnitDecl PackageName } NotBoot -> HsSrcFile IsBoot -> HsBootFile) (reLoc $3) - (sL1 $1 (HsModule noAnn (thdOf3 $7) (Just $3) $5 (fst $ sndOf3 $7) (snd $ sndOf3 $7) $4 Nothing)) } + (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $7) $4 Nothing) (Just $3) $5 (fst $ sndOf3 $7) (snd $ sndOf3 $7))) } | 'signature' modid maybemodwarning maybeexports 'where' body { sL1 $1 $ DeclD HsigFile (reLoc $2) - (sL1 $1 (HsModule noAnn (thdOf3 $6) (Just $2) $4 (fst $ sndOf3 $6) (snd $ sndOf3 $6) $3 Nothing)) } + (sL1 $1 (HsModule (XModulePs noAnn (thdOf3 $6) $3 Nothing) (Just $2) $4 (fst $ sndOf3 $6) (snd $ sndOf3 $6))) } | 'dependency' unitid mayberns { sL1 $1 $ IncludeD (IncludeDecl { idUnitId = $2 , idModRenaming = $3 @@ -878,26 +878,32 @@ unitdecl :: { LHsUnitDecl PackageName } -- either, and DEPRECATED is only expected to be used by people who really -- know what they are doing. :-) -signature :: { Located HsModule } +signature :: { Located (HsModule GhcPs) } : 'signature' modid maybemodwarning maybeexports 'where' body {% fileSrcSpan >>= \ loc -> - acs (\cs-> (L loc (HsModule (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnSignature $1, mj AnnWhere $5] (fstOf3 $6)) cs) - (thdOf3 $6) (Just $2) $4 (fst $ sndOf3 $6) - (snd $ sndOf3 $6) $3 Nothing)) + acs (\cs-> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnSignature $1, mj AnnWhere $5] (fstOf3 $6)) cs) + (thdOf3 $6) $3 Nothing) + (Just $2) $4 (fst $ sndOf3 $6) + (snd $ sndOf3 $6))) ) } -module :: { Located HsModule } +module :: { Located (HsModule GhcPs) } : 'module' modid maybemodwarning maybeexports 'where' body {% fileSrcSpan >>= \ loc -> - acsFinal (\cs -> (L loc (HsModule (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1, mj AnnWhere $5] (fstOf3 $6)) cs) - (thdOf3 $6) (Just $2) $4 (fst $ sndOf3 $6) - (snd $ sndOf3 $6) $3 Nothing) + acsFinal (\cs -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1, mj AnnWhere $5] (fstOf3 $6)) cs) + (thdOf3 $6) $3 Nothing) + (Just $2) $4 (fst $ sndOf3 $6) + (snd $ sndOf3 $6)) )) } | body2 {% fileSrcSpan >>= \ loc -> - acsFinal (\cs -> (L loc (HsModule (EpAnn (spanAsAnchor loc) (AnnsModule [] (fstOf3 $1)) cs) - (thdOf3 $1) Nothing Nothing - (fst $ sndOf3 $1) (snd $ sndOf3 $1) Nothing Nothing))) } + acsFinal (\cs -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule [] (fstOf3 $1)) cs) + (thdOf3 $1) Nothing Nothing) + Nothing Nothing + (fst $ sndOf3 $1) (snd $ sndOf3 $1)))) } missing_module_keyword :: { () } : {- empty -} {% pushModuleContext } @@ -942,21 +948,24 @@ top1 :: { ([LImportDecl GhcPs], [LHsDecl GhcPs]) } ----------------------------------------------------------------------------- -- Module declaration & imports only -header :: { Located HsModule } +header :: { Located (HsModule GhcPs) } : 'module' modid maybemodwarning maybeexports 'where' header_body {% fileSrcSpan >>= \ loc -> - acs (\cs -> (L loc (HsModule (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] [])) cs) - NoLayoutInfo (Just $2) $4 $6 [] $3 Nothing + acs (\cs -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] [])) cs) + NoLayoutInfo $3 Nothing) + (Just $2) $4 $6 [] ))) } | 'signature' modid maybemodwarning maybeexports 'where' header_body {% fileSrcSpan >>= \ loc -> - acs (\cs -> (L loc (HsModule (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] [])) cs) - NoLayoutInfo (Just $2) $4 $6 [] $3 Nothing + acs (\cs -> (L loc (HsModule (XModulePs + (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] [])) cs) + NoLayoutInfo $3 Nothing) + (Just $2) $4 $6 [] ))) } | header_body2 {% fileSrcSpan >>= \ loc -> - return (L loc (HsModule noAnn NoLayoutInfo Nothing Nothing $1 [] Nothing - Nothing)) } + return (L loc (HsModule (XModulePs noAnn NoLayoutInfo Nothing Nothing) Nothing Nothing $1 [])) } header_body :: { [LImportDecl GhcPs] } : '{' header_top { $2 } @@ -4361,7 +4370,7 @@ pvL a = do { av <- a -- This is the only parser entry point that deals with Haddock comments. -- The other entry points ('parseDeclaration', 'parseExpression', etc) do -- not insert them into the AST. -parseModule :: P (Located HsModule) +parseModule :: P (Located (HsModule GhcPs)) parseModule = parseModuleNoHaddock >>= addHaddockToModule commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) diff --git a/compiler/GHC/Parser/Errors/Types.hs b/compiler/GHC/Parser/Errors/Types.hs index b4ea2f42a0..1d3fcbc08e 100644 --- a/compiler/GHC/Parser/Errors/Types.hs +++ b/compiler/GHC/Parser/Errors/Types.hs @@ -15,7 +15,6 @@ import GHC.Types.Error import GHC.Types.Hint import GHC.Types.Name.Occurrence (OccName) import GHC.Types.Name.Reader -import GHC.Unit.Module.Name import GHC.Utils.Outputable import Data.List.NonEmpty (NonEmpty) import GHC.Types.SrcLoc (PsLoc) diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 94b689fe71..e67e6d734e 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -125,7 +125,6 @@ import GHC.Core.ConLike ( ConLike(..) ) import GHC.Core.Coercion.Axiom ( Role, fsFromRole ) import GHC.Types.Name.Reader import GHC.Types.Name -import GHC.Unit.Module (ModuleName) import GHC.Types.Basic import GHC.Types.Error import GHC.Types.Fixity diff --git a/compiler/GHC/Parser/PostProcess/Haddock.hs b/compiler/GHC/Parser/PostProcess/Haddock.hs index ea9118a525..95f02f8f21 100644 --- a/compiler/GHC/Parser/PostProcess/Haddock.hs +++ b/compiler/GHC/Parser/PostProcess/Haddock.hs @@ -178,7 +178,7 @@ we have to use 'flattenBindsAndSigs' to traverse it in the correct order. -- to a parsed HsModule. -- -- Reports badly positioned comments when -Winvalid-haddock is enabled. -addHaddockToModule :: Located HsModule -> P (Located HsModule) +addHaddockToModule :: Located (HsModule GhcPs) -> P (Located (HsModule GhcPs)) addHaddockToModule lmod = do pState <- getPState let all_comments = toList (hdk_comments pState) @@ -239,7 +239,7 @@ instance HasHaddock a => HasHaddock [a] where -- item4 -- ) where -- -instance HasHaddock (Located HsModule) where +instance HasHaddock (Located (HsModule GhcPs)) where addHaddock (L l_mod mod) = do -- Step 1, get the module header documentation comment: -- @@ -287,13 +287,13 @@ instance HasHaddock (Located HsModule) where -- data C = MkC -- ^ Comment on MkC -- -- ^ Comment on C -- - let layout_info = hsmodLayout mod + let layout_info = hsmodLayout (hsmodExt mod) hsmodDecls' <- addHaddockInterleaveItems layout_info (mkDocHsDecl layout_info) (hsmodDecls mod) pure $ L l_mod $ mod { hsmodExports = hsmodExports' , hsmodDecls = hsmodDecls' - , hsmodHaddockModHeader = join @Maybe headerDocs } + , hsmodExt = (hsmodExt mod) {Â hsmodHaddockModHeader = join @Maybe headerDocs } } lexHsDocString :: HsDocString -> HsDoc GhcPs lexHsDocString = lexHsDoc parseIdentifier diff --git a/compiler/GHC/Tc/Errors/Types.hs b/compiler/GHC/Tc/Errors/Types.hs index 62732ed8dd..1e52a526fe 100644 --- a/compiler/GHC/Tc/Errors/Types.hs +++ b/compiler/GHC/Tc/Errors/Types.hs @@ -104,7 +104,6 @@ import GHC.Core.TyCon (TyCon, TyConFlavour) import GHC.Core.Type (Kind, Type, ThetaType, PredType) import GHC.Driver.Backend (Backend) import GHC.Unit.State (UnitState) -import GHC.Unit.Module.Name (ModuleName) import GHC.Types.Basic import GHC.Utils.Misc (capitalise, filterOut) import qualified GHC.LanguageExtensions as LangExt diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index 7345638d2d..d23fad536c 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -239,12 +239,14 @@ tcRnModuleTcRnM :: HscEnv -> TcRn TcGblEnv -- Factored out separately from tcRnModule so that a Core plugin can -- call the type checker directly +tcRnModuleTcRnM _ _ + (HsParsedModule (L _ (XModule x)) _) + _ = dataConCantHappen x tcRnModuleTcRnM hsc_env mod_sum (HsParsedModule { hpm_module = - (L loc (HsModule _ _ maybe_mod export_ies - import_decls local_decls mod_deprec - maybe_doc_hdr)), + (L loc (HsModule (XModulePs _ _ mod_deprec maybe_doc_hdr) + maybe_mod export_ies import_decls local_decls)), hpm_src_files = src_files }) (this_mod, prel_imp_loc) diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index d553ec4fad..8758db5f47 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -521,6 +521,8 @@ merge_msg mod_name reqs = -- a final 'TcGblEnv' that matches the local signature and -- all required signatures. mergeSignatures :: HsParsedModule -> TcGblEnv -> ModIface -> TcRn TcGblEnv +mergeSignatures (HsParsedModule { hpm_module = L _ (XModule ext) }) _ _ + = dataConCantHappen ext mergeSignatures (HsParsedModule { hpm_module = L loc (HsModule { hsmodExports = mb_exports }), hpm_src_files = src_files }) diff --git a/compiler/GHC/Unit/Module/Name.hs b/compiler/GHC/Unit/Module/Name.hs index cc5e430bd6..9860914502 100644 --- a/compiler/GHC/Unit/Module/Name.hs +++ b/compiler/GHC/Unit/Module/Name.hs @@ -1,7 +1,7 @@ -- | The ModuleName type module GHC.Unit.Module.Name - ( ModuleName + ( module Language.Haskell.Syntax , pprModuleName , moduleNameFS , moduleNameString @@ -13,6 +13,8 @@ module GHC.Unit.Module.Name ) where +import {-# SOURCE #-} Language.Haskell.Syntax (ModuleName(..)) + import GHC.Prelude import GHC.Utils.Outputable @@ -29,9 +31,6 @@ import qualified Text.ParserCombinators.ReadP as Parse import Text.ParserCombinators.ReadP (ReadP) import Data.Char (isAlphaNum) --- | A ModuleName is essentially a simple string, e.g. @Data.List@. -newtype ModuleName = ModuleName FastString deriving Show - instance Uniquable ModuleName where getUnique (ModuleName nm) = getUnique nm diff --git a/compiler/GHC/Unit/Module/Name.hs-boot b/compiler/GHC/Unit/Module/Name.hs-boot index 7a48d807a7..deff51787e 100644 --- a/compiler/GHC/Unit/Module/Name.hs-boot +++ b/compiler/GHC/Unit/Module/Name.hs-boot @@ -1,6 +1,5 @@ -module GHC.Unit.Module.Name where - -import GHC.Prelude () - -data ModuleName +module GHC.Unit.Module.Name ( + module Language.Haskell.Syntax + ) where +import {-# SOURCE #-} Language.Haskell.Syntax (ModuleName(..)) diff --git a/compiler/GHC/Unit/Types.hs-boot b/compiler/GHC/Unit/Types.hs-boot index 0fe5302123..800b07db9a 100644 --- a/compiler/GHC/Unit/Types.hs-boot +++ b/compiler/GHC/Unit/Types.hs-boot @@ -3,7 +3,7 @@ module GHC.Unit.Types where import GHC.Prelude () import {-# SOURCE #-} GHC.Utils.Outputable -import {-# SOURCE #-} GHC.Unit.Module.Name ( ModuleName ) +import {-# SOURCE #-} Language.Haskell.Syntax ( ModuleName ) import Data.Kind (Type) data UnitId diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs index f711fd96aa..d759091850 100644 --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -107,7 +107,7 @@ module GHC.Utils.Outputable ( import GHC.Prelude import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module, moduleName ) -import {-# SOURCE #-} GHC.Unit.Module.Name( ModuleName ) +import {-# SOURCE #-} Language.Haskell.Syntax( ModuleName ) import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName ) import GHC.Utils.BufHandle (BufHandle) |