diff options
| author | romes <rodrigo.m.mesquita@gmail.com> | 2022-05-17 16:06:52 +0200 |
|---|---|---|
| committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2022-07-03 14:11:31 -0400 |
| commit | f9f8099598fd169fa2f17305fc660e5c473f8836 (patch) | |
| tree | 5acdb9a38b78dc17ffa0abb63d87555e214d98af | |
| parent | 3a8970ac0c69335a1d229f9c9a71e6e333e99bfb (diff) | |
| download | haskell-f9f8099598fd169fa2f17305fc660e5c473f8836.tar.gz | |
TTG: Move ImpExp client-independent bits to L.H.S.ImpExp
Move the GHC-independent definitions from GHC.Hs.ImpExp to
Language.Haskell.Syntax.ImpExp with the required TTG extension fields
such as to keep the AST independent from GHC.
This is progress towards having the haskell-syntax package, as described
in #21592
Bumps haddock submodule
54 files changed, 1154 insertions, 989 deletions
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs index 29ca1e42ae..237352877a 100644 --- a/compiler/GHC/Driver/Main.hs +++ b/compiler/GHC/Driver/Main.hs @@ -2199,8 +2199,10 @@ hscAddSptEntries hsc_env entries = do hscImport :: HscEnv -> String -> IO (ImportDecl GhcPs) hscImport hsc_env str = runInteractiveHsc hsc_env $ do + -- Use >>= \case instead of MonadFail desugaring to take into + -- consideration `instance XXModule p = DataConCantHappen`. + -- Tracked in #15681 hscParseThing parseModule str >>= \case - (L _ (XModule x)) -> dataConCantHappen x (L _ (HsModule{hsmodImports=is})) -> case is of [L _ i] -> return i diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs index f06619d030..6c4a810b35 100644 --- a/compiler/GHC/Hs.hs +++ b/compiler/GHC/Hs.hs @@ -9,6 +9,7 @@ which is declared in the various \tr{Hs*} modules. This module, therefore, is almost nothing but re-exporting. -} +{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE FlexibleContexts #-} @@ -63,7 +64,7 @@ import GHC.Unit.Module.Warnings ( WarningTxt ) -- libraries: import Data.Data hiding ( Fixity ) --- | Haskell Module extension point: GHC specific +-- | Haskell Module extension point: GHC specific data XModulePs = XModulePs { hsmodAnn :: EpAnn AnnsModule, @@ -88,11 +89,13 @@ data XModulePs } deriving Data -type instance XModule GhcPs = XModulePs -type instance XModule GhcRn = DataConCantHappen -type instance XModule GhcTc = DataConCantHappen +type instance XCModule GhcPs = XModulePs +type instance XCModule GhcRn = DataConCantHappen +type instance XCModule GhcTc = DataConCantHappen type instance XXModule p = DataConCantHappen +type instance Anno ModuleName = SrcSpanAnnA + deriving instance Data (HsModule GhcPs) data AnnsModule @@ -102,14 +105,19 @@ data AnnsModule } deriving (Data, Eq) instance Outputable (HsModule GhcPs) where - - ppr (XModule ext) = dataConCantHappen ext - - ppr (HsModule (XModulePs _ _ _ mbDoc) Nothing _ imports decls) + ppr (HsModule { hsmodExt = XModulePs { hsmodHaddockModHeader = mbDoc } + , hsmodName = Nothing + , hsmodImports = imports + , hsmodDecls = decls }) = pprMaybeWithDoc mbDoc $ pp_nonnull imports $$ pp_nonnull decls - ppr (HsModule (XModulePs _ _ deprec mbDoc) (Just name) exports imports decls) + ppr (HsModule { hsmodExt = XModulePs { hsmodDeprecMessage = deprec + , hsmodHaddockModHeader = mbDoc } + , hsmodName = (Just name) + , hsmodExports = exports + , hsmodImports = imports + , hsmodDecls = decls }) = pprMaybeWithDoc mbDoc $ vcat [ case exports of diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs index 22c83e6e2a..1f13d8a2fe 100644 --- a/compiler/GHC/Hs/ImpExp.hs +++ b/compiler/GHC/Hs/ImpExp.hs @@ -1,4 +1,6 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable and IEWrappedName {-# LANGUAGE DataKinds #-} +{-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} @@ -14,12 +16,13 @@ GHC.Hs.ImpExp: Abstract syntax: imports, exports, interfaces -} -module GHC.Hs.ImpExp where +module GHC.Hs.ImpExp + ( module Language.Haskell.Syntax.ImpExp + , module GHC.Hs.ImpExp + ) where import GHC.Prelude -import GHC.Unit.Module ( ModuleName, IsBootInterface(..) ) -import GHC.Hs.Doc import GHC.Types.SourceText ( SourceText(..) ) import GHC.Types.FieldLabel ( FieldLabel ) @@ -27,8 +30,9 @@ import GHC.Utils.Outputable import GHC.Utils.Panic import GHC.Types.SrcLoc import Language.Haskell.Syntax.Extension -import GHC.Hs.Extension +import Language.Haskell.Syntax.ImpExp import GHC.Parser.Annotation +import GHC.Hs.Extension import GHC.Types.Name import GHC.Types.PkgQual @@ -38,29 +42,15 @@ import Data.Maybe {- ************************************************************************ * * -\subsection{Import and export declaration lists} + Import and export declaration lists * * ************************************************************************ -One per \tr{import} declaration in a module. +One per import declaration in a module. -} --- | Located Import Declaration -type LImportDecl pass = XRec pass (ImportDecl pass) - -- ^ When in a list this may have - -- - -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation type instance Anno (ImportDecl (GhcPass p)) = SrcSpanAnnA --- | If/how an import is 'qualified'. -data ImportDeclQualifiedStyle - = QualifiedPre -- ^ 'qualified' appears in prepositive position. - | QualifiedPost -- ^ 'qualified' appears in postpositive position. - | NotQualified -- ^ Not qualified. - deriving (Eq, Data) - -- | Given two possible located 'qualified' tokens, compute a style -- (in a conforming Haskell program only one of the two can be not -- 'Nothing'). This is called from "GHC.Parser". @@ -77,56 +67,40 @@ isImportDeclQualified :: ImportDeclQualifiedStyle -> Bool isImportDeclQualified NotQualified = False isImportDeclQualified _ = True --- | Import Declaration --- --- A single Haskell @import@ declaration. -data ImportDecl pass - = ImportDecl { - ideclExt :: XCImportDecl pass, - ideclSourceSrc :: SourceText, - -- Note [Pragma source text] in GHC.Types.SourceText - ideclName :: XRec pass ModuleName, -- ^ Module name. - ideclPkgQual :: ImportDeclPkgQual pass, -- ^ Package qualifier. - ideclSource :: IsBootInterface, -- ^ IsBoot <=> {-\# SOURCE \#-} import - ideclSafe :: Bool, -- ^ True => safe import - ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified. - ideclImplicit :: Bool, -- ^ True => implicit import (of Prelude) - ideclAs :: Maybe (XRec pass ModuleName), -- ^ as Module - ideclHiding :: Maybe (Bool, XRec pass [LIE pass]) - -- ^ (True => hiding, names) - } - | XImportDecl !(XXImportDecl pass) - -- ^ - -- 'GHC.Parser.Annotation.AnnKeywordId's - -- - -- - 'GHC.Parser.Annotation.AnnImport' - -- - -- - 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnClose' for ideclSource - -- - -- - 'GHC.Parser.Annotation.AnnSafe','GHC.Parser.Annotation.AnnQualified', - -- 'GHC.Parser.Annotation.AnnPackageName','GHC.Parser.Annotation.AnnAs', - -- 'GHC.Parser.Annotation.AnnVal' - -- - -- - 'GHC.Parser.Annotation.AnnHiding','GHC.Parser.Annotation.AnnOpen', - -- 'GHC.Parser.Annotation.AnnClose' attached - -- to location in ideclHiding - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - -type family ImportDeclPkgQual pass + type instance ImportDeclPkgQual GhcPs = RawPkgQual type instance ImportDeclPkgQual GhcRn = PkgQual type instance ImportDeclPkgQual GhcTc = PkgQual -type instance XCImportDecl GhcPs = EpAnn EpAnnImportDecl -type instance XCImportDecl GhcRn = NoExtField -type instance XCImportDecl GhcTc = NoExtField +type instance XCImportDecl GhcPs = XImportDeclPass +type instance XCImportDecl GhcRn = XImportDeclPass +type instance XCImportDecl GhcTc = DataConCantHappen + -- Note [Pragma source text] in GHC.Types.SourceText + +data XImportDeclPass = XImportDeclPass + { ideclAnn :: EpAnn EpAnnImportDecl + , ideclSourceText :: SourceText + , ideclImplicit :: Bool + -- ^ GHC generates an `ImportDecl` to represent the invisible `import Prelude` + -- that appears in any file that omits `import Prelude`, setting + -- this field to indicate that the import doesn't appear in the + -- original source. True => implicit import (of Prelude) + } + deriving (Data) type instance XXImportDecl (GhcPass _) = DataConCantHappen type instance Anno ModuleName = SrcSpanAnnA type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnL +deriving instance Data (IEWrappedName GhcPs) +deriving instance Data (IEWrappedName GhcRn) +deriving instance Data (IEWrappedName GhcTc) + +deriving instance Eq (IEWrappedName GhcPs) +deriving instance Eq (IEWrappedName GhcRn) +deriving instance Eq (IEWrappedName GhcTc) + -- --------------------------------------------------------------------- -- API Annotations types @@ -144,33 +118,36 @@ data EpAnnImportDecl = EpAnnImportDecl simpleImportDecl :: ModuleName -> ImportDecl GhcPs simpleImportDecl mn = ImportDecl { - ideclExt = noAnn, - ideclSourceSrc = NoSourceText, - ideclName = noLocA mn, - ideclPkgQual = NoRawPkgQual, - ideclSource = NotBoot, - ideclSafe = False, - ideclImplicit = False, - ideclQualified = NotQualified, - ideclAs = Nothing, - ideclHiding = Nothing + ideclExt = XImportDeclPass noAnn NoSourceText False, + ideclName = noLocA mn, + ideclPkgQual = NoRawPkgQual, + ideclSource = NotBoot, + ideclSafe = False, + ideclQualified = NotQualified, + ideclAs = Nothing, + ideclImportList = Nothing } instance (OutputableBndrId p , Outputable (Anno (IE (GhcPass p))) , Outputable (ImportDeclPkgQual (GhcPass p))) => Outputable (ImportDecl (GhcPass p)) where - ppr (ImportDecl { ideclSourceSrc = mSrcText, ideclName = mod' + ppr (ImportDecl { ideclExt = impExt, ideclName = mod' , ideclPkgQual = pkg , ideclSource = from, ideclSafe = safe - , ideclQualified = qual, ideclImplicit = implicit - , ideclAs = as, ideclHiding = spec }) - = hang (hsep [text "import", ppr_imp from, pp_implicit implicit, pp_safe safe, + , ideclQualified = qual + , ideclAs = as, ideclImportList = spec }) + = hang (hsep [text "import", ppr_imp impExt from, pp_implicit impExt, pp_safe safe, pp_qual qual False, ppr pkg, ppr mod', pp_qual qual True, pp_as as]) 4 (pp_spec spec) where - pp_implicit False = empty - pp_implicit True = text "(implicit)" + pp_implicit ext = + let implicit = case ghcPass @p of + GhcPs | XImportDeclPass { ideclImplicit = implicit } <- ext -> implicit + GhcRn | XImportDeclPass { ideclImplicit = implicit } <- ext -> implicit + GhcTc -> dataConCantHappen ext + in if implicit then text "(implicit)" + else empty pp_qual QualifiedPre False = text "qualified" -- Prepositive qualifier/prepositive position. pp_qual QualifiedPost True = text "qualified" -- Postpositive qualifier/postpositive position. @@ -184,14 +161,19 @@ instance (OutputableBndrId p pp_as Nothing = empty pp_as (Just a) = text "as" <+> ppr a - ppr_imp IsBoot = case mSrcText of - NoSourceText -> text "{-# SOURCE #-}" - SourceText src -> text src <+> text "#-}" - ppr_imp NotBoot = empty + ppr_imp ext IsBoot = + let mSrcText = case ghcPass @p of + GhcPs | XImportDeclPass { ideclSourceText = mst } <- ext -> mst + GhcRn | XImportDeclPass { ideclSourceText = mst } <- ext -> mst + GhcTc -> dataConCantHappen ext + in case mSrcText of + NoSourceText -> text "{-# SOURCE #-}" + SourceText src -> text src <+> text "#-}" + ppr_imp _ NotBoot = empty pp_spec Nothing = empty - pp_spec (Just (False, (L _ ies))) = ppr_ies ies - pp_spec (Just (True, (L _ ies))) = text "hiding" <+> ppr_ies ies + pp_spec (Just (Exactly, (L _ ies))) = ppr_ies ies + pp_spec (Just (EverythingBut, (L _ ies))) = text "hiding" <+> ppr_ies ies ppr_ies [] = text "()" ppr_ies ies = char '(' <+> interpp'SP ies <+> char ')' @@ -204,85 +186,14 @@ instance (OutputableBndrId p ************************************************************************ -} --- | A name in an import or export specification which may have --- adornments. Used primarily for accurate pretty printing of --- ParsedSource, and API Annotation placement. The --- 'GHC.Parser.Annotation' is the location of the adornment in --- the original source. -data IEWrappedName name - = IEName (LocatedN name) -- ^ no extra - | IEPattern EpaLocation (LocatedN name) -- ^ pattern X - | IEType EpaLocation (LocatedN name) -- ^ type (:+:) - deriving (Eq,Data) - --- | Located name with possible adornment --- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnType', --- 'GHC.Parser.Annotation.AnnPattern' -type LIEWrappedName name = LocatedA (IEWrappedName name) --- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - - --- | Located Import or Export -type LIE pass = XRec pass (IE pass) - -- ^ When in a list this may have - -- - -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation -type instance Anno (IE (GhcPass p)) = SrcSpanAnnA +type instance XIEName (GhcPass _) = NoExtField +type instance XIEPattern (GhcPass _) = EpaLocation +type instance XIEType (GhcPass _) = EpaLocation +type instance XXIEWrappedName (GhcPass _) = DataConCantHappen + +type instance Anno (IEWrappedName (GhcPass _)) = SrcSpanAnnA --- | Imported or exported entity. -data IE pass - = IEVar (XIEVar pass) (LIEWrappedName (IdP pass)) - -- ^ Imported or Exported Variable - - | IEThingAbs (XIEThingAbs pass) (LIEWrappedName (IdP pass)) - -- ^ Imported or exported Thing with Absent list - -- - -- The thing is a Class/Type (can't tell) - -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnPattern', - -- 'GHC.Parser.Annotation.AnnType','GHC.Parser.Annotation.AnnVal' - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - -- See Note [Located RdrNames] in GHC.Hs.Expr - | IEThingAll (XIEThingAll pass) (LIEWrappedName (IdP pass)) - -- ^ Imported or exported Thing with All imported or exported - -- - -- The thing is a Class/Type and the All refers to methods/constructors - -- - -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen', - -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose', - -- 'GHC.Parser.Annotation.AnnType' - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - -- See Note [Located RdrNames] in GHC.Hs.Expr - - | IEThingWith (XIEThingWith pass) - (LIEWrappedName (IdP pass)) - IEWildcard - [LIEWrappedName (IdP pass)] - -- ^ Imported or exported Thing With given imported or exported - -- - -- The thing is a Class/Type and the imported or exported things are - -- methods/constructors and record fields; see Note [IEThingWith] - -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen', - -- 'GHC.Parser.Annotation.AnnClose', - -- 'GHC.Parser.Annotation.AnnComma', - -- 'GHC.Parser.Annotation.AnnType' - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - | IEModuleContents (XIEModuleContents pass) (XRec pass ModuleName) - -- ^ Imported or exported module contents - -- - -- (Export Only) - -- - -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule' - - -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation - | IEGroup (XIEGroup pass) Int (LHsDoc pass) -- ^ Doc section heading - | IEDoc (XIEDoc pass) (LHsDoc pass) -- ^ Some documentation - | IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc - | XIE !(XXIE pass) +type instance Anno (IE (GhcPass p)) = SrcSpanAnnA type instance XIEVar GhcPs = NoExtField type instance XIEVar GhcRn = NoExtField @@ -307,9 +218,6 @@ type instance XXIE (GhcPass _) = DataConCantHappen type instance Anno (LocatedA (IE (GhcPass p))) = SrcSpanAnnA --- | Imported or Exported Wildcard -data IEWildcard = NoIEWildcard | IEWildcard Int deriving (Eq, Data) - {- Note [IEThingWith] ~~~~~~~~~~~~~~~~~~ @@ -355,27 +263,27 @@ ieNames (IEGroup {}) = [] ieNames (IEDoc {}) = [] ieNames (IEDocNamed {}) = [] -ieWrappedLName :: IEWrappedName name -> LocatedN name -ieWrappedLName (IEName ln) = ln -ieWrappedLName (IEPattern _ ln) = ln -ieWrappedLName (IEType _ ln) = ln +ieWrappedLName :: IEWrappedName (GhcPass p) -> LIdP (GhcPass p) +ieWrappedLName (IEName _ (L l n)) = L l n +ieWrappedLName (IEPattern _ (L l n)) = L l n +ieWrappedLName (IEType _ (L l n)) = L l n -ieWrappedName :: IEWrappedName name -> name +ieWrappedName :: IEWrappedName (GhcPass p) -> IdP (GhcPass p) ieWrappedName = unLoc . ieWrappedLName -lieWrappedName :: LIEWrappedName name -> name +lieWrappedName :: LIEWrappedName (GhcPass p) -> IdP (GhcPass p) lieWrappedName (L _ n) = ieWrappedName n -ieLWrappedName :: LIEWrappedName name -> LocatedN name +ieLWrappedName :: LIEWrappedName (GhcPass p) -> LIdP (GhcPass p) ieLWrappedName (L _ n) = ieWrappedLName n -replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2 -replaceWrappedName (IEName (L l _)) n = IEName (L l n) +replaceWrappedName :: IEWrappedName GhcPs -> IdP GhcRn -> IEWrappedName GhcRn +replaceWrappedName (IEName x (L l _)) n = IEName x (L l n) replaceWrappedName (IEPattern r (L l _)) n = IEPattern r (L l n) replaceWrappedName (IEType r (L l _)) n = IEType r (L l n) -replaceLWrappedName :: LIEWrappedName name1 -> name2 -> LIEWrappedName name2 +replaceLWrappedName :: LIEWrappedName GhcPs -> IdP GhcRn -> LIEWrappedName GhcRn replaceLWrappedName (L l n) n' = L l (replaceWrappedName n n') instance OutputableBndrId p => Outputable (IE (GhcPass p)) where @@ -403,18 +311,18 @@ instance OutputableBndrId p => Outputable (IE (GhcPass p)) where ppr (IEDoc _ doc) = ppr doc ppr (IEDocNamed _ string) = text ("<IEDocNamed: " ++ string ++ ">") -instance (HasOccName name) => HasOccName (IEWrappedName name) where +instance (HasOccName (IdP (GhcPass p)), OutputableBndrId p) => HasOccName (IEWrappedName (GhcPass p)) where occName w = occName (ieWrappedName w) -instance (OutputableBndr name) => OutputableBndr (IEWrappedName name) where +instance OutputableBndrId p => OutputableBndr (IEWrappedName (GhcPass p)) where pprBndr bs w = pprBndr bs (ieWrappedName w) pprPrefixOcc w = pprPrefixOcc (ieWrappedName w) pprInfixOcc w = pprInfixOcc (ieWrappedName w) -instance (OutputableBndr name) => Outputable (IEWrappedName name) where - ppr (IEName n) = pprPrefixOcc (unLoc n) - ppr (IEPattern _ n) = text "pattern" <+> pprPrefixOcc (unLoc n) - ppr (IEType _ n) = text "type" <+> pprPrefixOcc (unLoc n) +instance OutputableBndrId p => Outputable (IEWrappedName (GhcPass p)) where + ppr (IEName _ (L _ n)) = pprPrefixOcc n + ppr (IEPattern _ (L _ n)) = text "pattern" <+> pprPrefixOcc n + ppr (IEType _ (L _ n)) = text "type" <+> pprPrefixOcc n pprImpExp :: (HasOccName name, OutputableBndr name) => name -> SDoc pprImpExp name = type_pref <+> pprPrefixOcc name diff --git a/compiler/GHC/Hs/Stats.hs b/compiler/GHC/Hs/Stats.hs index 0c348e2c97..50757fb63d 100644 --- a/compiler/GHC/Hs/Stats.hs +++ b/compiler/GHC/Hs/Stats.hs @@ -23,8 +23,7 @@ import Data.Char -- | Source Statistics ppSourceStats :: Bool -> Located (HsModule GhcPs) -> SDoc -ppSourceStats _ (L _ (XModule x)) = dataConCantHappen x -ppSourceStats short (L _ (HsModule _ _ exports imports ldecls)) +ppSourceStats short (L _ (HsModule{ hsmodExports = exports, hsmodImports = imports, hsmodDecls = ldecls })) = (if short then hcat else vcat) (map pp_val [("ExportAll ", export_all), -- 1 if no export list @@ -123,7 +122,7 @@ ppSourceStats short (L _ (HsModule _ _ exports imports ldecls)) import_info :: LImportDecl GhcPs -> (Int, Int, Int, Int, Int, Int, Int) import_info (L _ (ImportDecl { ideclSafe = safe, ideclQualified = qual - , ideclAs = as, ideclHiding = spec })) + , ideclAs = as, ideclImportList = spec })) = add7 (1, safe_info safe, qual_info qual, as_info as, 0,0,0) (spec_info spec) safe_info False = 0 @@ -133,8 +132,8 @@ ppSourceStats short (L _ (HsModule _ _ exports imports ldecls)) as_info Nothing = 0 as_info (Just _) = 1 spec_info Nothing = (0,0,0,0,1,0,0) - spec_info (Just (False, _)) = (0,0,0,0,0,1,0) - spec_info (Just (True, _)) = (0,0,0,0,0,0,1) + spec_info (Just (Exactly, _)) = (0,0,0,0,0,1,0) + spec_info (Just (EverythingBut, _)) = (0,0,0,0,0,0,1) data_info (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = cs diff --git a/compiler/GHC/Iface/Ext/Ast.hs b/compiler/GHC/Iface/Ext/Ast.hs index cbd46de9f5..dab2a7e7ad 100644 --- a/compiler/GHC/Iface/Ext/Ast.hs +++ b/compiler/GHC/Iface/Ext/Ast.hs @@ -320,7 +320,7 @@ enrichHie ts (hsGrp, imports, exports, docs) ev_bs insts tcs = runIdentity $ flip evalStateT initState $ flip runReaderT SourceInfo $ do tasts <- toHie $ fmap (BC RegularBind ModuleScope) ts rasts <- processGrp hsGrp - imps <- toHie $ filter (not . ideclImplicit . unLoc) imports + imps <- toHie $ filter (not . ideclImplicit . ideclExt . unLoc) imports exps <- toHie $ fmap (map $ IEC Export . fst) exports docs <- toHie docs -- Add Instance bindings @@ -2068,7 +2068,7 @@ instance ToHie (RScoped (LocatedAn NoEpAnns (RuleBndr GhcRn))) where instance ToHie (LocatedA (ImportDecl GhcRn)) where toHie (L span decl) = concatM $ makeNode decl (locA span) : case decl of - ImportDecl { ideclName = name, ideclAs = as, ideclHiding = hidden } -> + ImportDecl { ideclName = name, ideclAs = as, ideclImportList = hidden } -> [ toHie $ IEC Import name , toHie $ fmap (IEC ImportAs) as , maybe (pure []) goIE hidden @@ -2079,7 +2079,12 @@ instance ToHie (LocatedA (ImportDecl GhcRn)) where , toHie $ map (IEC c) liens ] where - c = if hiding then ImportHiding else Import + -- ROMES:TODO: I notice some overlap here with Iface types, eventually + -- we could join these + c = case hiding of + Exactly -> Import + EverythingBut -> ImportHiding + instance ToHie (IEContext (LocatedA (IE GhcRn))) where toHie (IEC c (L span ie)) = concatM $ makeNode ie (locA span) : case ie of @@ -2104,16 +2109,16 @@ instance ToHie (IEContext (LocatedA (IE GhcRn))) where IEDoc _ d -> [toHie d] IEDocNamed _ _ -> [] -instance ToHie (IEContext (LIEWrappedName Name)) where +instance ToHie (IEContext (LocatedA (IEWrappedName GhcRn))) where toHie (IEC c (L span iewn)) = concatM $ makeNodeA iewn span : case iewn of - IEName n -> - [ toHie $ C (IEThing c) n + IEName _ (L l n) -> + [ toHie $ C (IEThing c) (L l n) ] - IEPattern _ p -> - [ toHie $ C (IEThing c) p + IEPattern _ (L l p) -> + [ toHie $ C (IEThing c) (L l p) ] - IEType _ n -> - [ toHie $ C (IEThing c) n + IEType _ (L l n) -> + [ toHie $ C (IEThing c) (L l n) ] instance ToHie (IEContext (Located FieldLabel)) where diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index f819320d1f..be897a1d14 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1110,14 +1110,12 @@ importdecl :: { LImportDecl GhcPs } , importDeclAnnAs = fst $8 } ; fmap reLocA $ acs (\cs -> L (comb5 $1 (reLoc $6) $7 (snd $8) $9) $ - ImportDecl { ideclExt = EpAnn (glR $1) anns cs - , ideclSourceSrc = snd $ fst $2 + ImportDecl { ideclExt = XImportDeclPass (EpAnn (glR $1) anns cs) (snd $ fst $2) False , ideclName = $6, ideclPkgQual = snd $5 , ideclSource = snd $2, ideclSafe = snd $3 , ideclQualified = snd $ importDeclQualifiedStyle mPreQual mPostQual - , ideclImplicit = False , ideclAs = unLoc (snd $8) - , ideclHiding = unLoc $9 }) + , ideclImportList = unLoc $9 }) } } @@ -1148,20 +1146,20 @@ maybeas :: { (Maybe EpaLocation,Located (Maybe (LocatedA ModuleName))) } ,sLL $1 (reLoc $>) (Just $2)) } | {- empty -} { (Nothing,noLoc Nothing) } -maybeimpspec :: { Located (Maybe (Bool, LocatedL [LIE GhcPs])) } +maybeimpspec :: { Located (Maybe (ImportListInterpretation, LocatedL [LIE GhcPs])) } : impspec {% let (b, ie) = unLoc $1 in checkImportSpec ie >>= \checkedIe -> return (L (gl $1) (Just (b, checkedIe))) } | {- empty -} { noLoc Nothing } -impspec :: { Located (Bool, LocatedL [LIE GhcPs]) } +impspec :: { Located (ImportListInterpretation, LocatedL [LIE GhcPs]) } : '(' exportlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $2) (AnnList Nothing (Just $ mop $1) (Just $ mcp $3) (fst $2) []) - ; return $ sLL $1 $> (False, es)} } + ; return $ sLL $1 $> (Exactly, es)} } | 'hiding' '(' exportlist ')' {% do { es <- amsrl (sLL $1 $> $ fromOL $ snd $3) (AnnList Nothing (Just $ mop $2) (Just $ mcp $4) (mj AnnHiding $1:fst $3) []) - ; return $ sLL $1 $> (True, es)} } + ; return $ sLL $1 $> (EverythingBut, es)} } ----------------------------------------------------------------------------- -- Fixity Declarations diff --git a/compiler/GHC/Parser/Header.hs b/compiler/GHC/Parser/Header.hs index 2a31d21cfc..9daf8e5d71 100644 --- a/compiler/GHC/Parser/Header.hs +++ b/compiler/GHC/Parser/Header.hs @@ -145,16 +145,18 @@ mkPrelImports this_mod loc implicit_prelude import_decls loc' = noAnnSrcSpan loc preludeImportDecl :: LImportDecl GhcPs preludeImportDecl - = L loc' $ ImportDecl { ideclExt = noAnn, - ideclSourceSrc = NoSourceText, + = L loc' $ ImportDecl { ideclExt = XImportDeclPass + { ideclAnn = noAnn + , ideclSourceText = NoSourceText + , ideclImplicit = True -- Implicit! + }, ideclName = L loc' pRELUDE_NAME, ideclPkgQual = NoRawPkgQual, ideclSource = NotBoot, ideclSafe = False, -- Not a safe import ideclQualified = NotQualified, - ideclImplicit = True, -- Implicit! ideclAs = Nothing, - ideclHiding = Nothing } + ideclImportList = Nothing } -------------------------------------------------------------- -- Get options diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index e67e6d734e..9dabe3331d 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -2787,7 +2787,7 @@ mkModuleImpExp anns (L l specname) subs = do let withs = map unLoc xs pos = maybe NoIEWildcard IEWildcard (findIndex isImpExpQcWildcard withs) - ies :: [LocatedA (IEWrappedName RdrName)] + ies :: [LocatedA (IEWrappedName GhcPs)] ies = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs in (\newName -> IEThingWith ann (L l newName) pos ies) @@ -2806,8 +2806,9 @@ mkModuleImpExp anns (L l specname) subs = do ieNameVal (ImpExpQcType _ ln) = unLoc ln ieNameVal (ImpExpQcWildcard) = panic "ieNameVal got wildcard" - ieNameFromSpec (ImpExpQcName ln) = IEName ln - ieNameFromSpec (ImpExpQcType r ln) = IEType r ln + ieNameFromSpec :: ImpExpQcSpec -> IEWrappedName GhcPs + ieNameFromSpec (ImpExpQcName (L l n)) = IEName noExtField (L l n) + ieNameFromSpec (ImpExpQcType r (L l n)) = IEType r (L l n) ieNameFromSpec (ImpExpQcWildcard) = panic "ieName got wildcard" wrapped = map (mapLoc ieNameFromSpec) diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 3a4cb78820..83f254b132 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -308,8 +308,9 @@ rnImportDecl this_mod (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name , ideclPkgQual = raw_pkg_qual , ideclSource = want_boot, ideclSafe = mod_safe - , ideclQualified = qual_style, ideclImplicit = implicit - , ideclAs = as_mod, ideclHiding = imp_details }), import_reason) + , ideclQualified = qual_style + , ideclExt = XImportDeclPass { ideclImplicit = implicit } + , ideclAs = as_mod, ideclImportList = imp_details }), import_reason) = setSrcSpanA loc $ do case raw_pkg_qual of @@ -355,7 +356,7 @@ rnImportDecl this_mod -- Check for a missing import list (Opt_WarnMissingImportList also -- checks for T(..) items but that is done in checkDodgyImport below) case imp_details of - Just (False, _) -> return () -- Explicit import list + Just (Exactly, _) -> return () -- Explicit import list _ | implicit -> return () -- Do not bleat for implicit imports | qual_only -> return () | otherwise -> whenWOptM Opt_WarnMissingImportList $ do @@ -402,8 +403,8 @@ rnImportDecl this_mod let gbl_env = mkGlobalRdrEnv gres - is_hiding | Just (True,_) <- imp_details = True - | otherwise = False + is_hiding | Just (EverythingBut,_) <- imp_details = True + | otherwise = False -- should the import be safe? mod_safe' = mod_safe @@ -437,16 +438,14 @@ rnImportDecl this_mod warnUnqualifiedImport decl iface let new_imp_decl = ImportDecl - { ideclExt = noExtField - , ideclSourceSrc = ideclSourceSrc decl + { ideclExt = ideclExt decl , ideclName = ideclName decl , ideclPkgQual = pkg_qual , ideclSource = ideclSource decl , ideclSafe = mod_safe' , ideclQualified = ideclQualified decl - , ideclImplicit = ideclImplicit decl , ideclAs = ideclAs decl - , ideclHiding = new_imp_details + , ideclImportList = new_imp_details } return (L loc new_imp_decl, gbl_env, imports, mi_hpc iface) @@ -622,8 +621,8 @@ warnUnqualifiedImport decl iface = has_import_list = -- We treat a `hiding` clause as not having an import list although -- it's not entirely clear this is the right choice. - case ideclHiding decl of - Just (False, _) -> True + case ideclImportList decl of + Just (Exactly, _) -> True _ -> False bad_import = not is_qual @@ -1187,8 +1186,8 @@ See T16745 for a test of this. filterImports :: ModIface -> ImpDeclSpec -- The span for the entire import decl - -> Maybe (Bool, LocatedL [LIE GhcPs]) -- Import spec; True => hiding - -> RnM (Maybe (Bool, LocatedL [LIE GhcRn]), -- Import spec w/ Names + -> Maybe (ImportListInterpretation, LocatedL [LIE GhcPs]) -- Import spec; True => hiding + -> RnM (Maybe (ImportListInterpretation, LocatedL [LIE GhcRn]), -- Import spec w/ Names [GlobalRdrElt]) -- Same again, but in GRE form filterImports iface decl_spec Nothing = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface)) @@ -1210,8 +1209,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) pruned_avails = filterAvails keep all_avails hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll } - gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails - | otherwise = concatMap (gresFromIE decl_spec) items2 + gres | want_hiding == EverythingBut = gresFromAvails (Just hiding_spec) pruned_avails + | otherwise = concatMap (gresFromIE decl_spec) items2 return (Just (want_hiding, L l (map fst items2)), gres) where @@ -1341,7 +1340,7 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) -- associated type IEThingAbs _ (L l tc') - | want_hiding -- hiding ( C ) + | want_hiding == EverythingBut -- hiding ( C ) -- Here the 'C' can be a data constructor -- *or* a type/class, or even both -> let tc = ieWrappedName tc' @@ -1403,8 +1402,8 @@ filterImports iface decl_spec (Just (want_hiding, L l import_items)) , availTC parent [n] []) handle_bad_import m = catchIELookup m $ \err -> case err of - BadImport ie | want_hiding -> return ([], [BadImportW ie]) - _ -> failLookupWith err + BadImport ie | want_hiding == EverythingBut -> return ([], [BadImportW ie]) + _ -> failLookupWith err type IELookupM = MaybeErr IELookupError @@ -1480,8 +1479,8 @@ mkChildEnv gres = foldr add emptyNameEnv gres findChildren :: NameEnv [a] -> Name -> [a] findChildren env n = lookupNameEnv env n `orElse` [] -lookupChildren :: [GreName] -> [LIEWrappedName RdrName] - -> MaybeErr [LIEWrappedName RdrName] -- The ones for which the lookup failed +lookupChildren :: [GreName] -> [LIEWrappedName GhcPs] + -> MaybeErr [LIEWrappedName GhcPs] -- The ones for which the lookup failed ([LocatedA Name], [Located FieldLabel]) -- (lookupChildren all_kids rdr_items) maps each rdr_item to its -- corresponding Name all_kids, if the former exists @@ -1699,7 +1698,7 @@ warnUnusedImportDecls :: TcGblEnv -> HscSource -> RnM () warnUnusedImportDecls gbl_env hsc_src = do { uses <- readMutVar (tcg_used_gres gbl_env) ; let user_imports = filterOut - (ideclImplicit . unLoc) + (ideclImplicit . ideclExt . unLoc) (tcg_rn_imports gbl_env) -- This whole function deals only with *user* imports -- both for warning about unnecessary ones, and for @@ -1731,7 +1730,7 @@ findImportUsage imports used_gres import_usage = mkImportMap used_gres unused_decl :: LImportDecl GhcRn -> (LImportDecl GhcRn, [GlobalRdrElt], [Name]) - unused_decl decl@(L loc (ImportDecl { ideclHiding = imps })) + unused_decl decl@(L loc (ImportDecl { ideclImportList = imps })) = (decl, used_gres, nameSetElemsStable unused_imps) where used_gres = lookupSrcLoc (srcSpanEnd $ locA loc) import_usage @@ -1743,7 +1742,7 @@ findImportUsage imports used_gres unused_imps -- Not trivial; see eg #7454 = case imps of - Just (False, L _ imp_ies) -> + Just (Exactly, L _ imp_ies) -> foldr (add_unused . unLoc) emptyNameSet imp_ies _other -> emptyNameSet -- No explicit import list => no unused-name list @@ -1822,11 +1821,11 @@ warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Parent) warnUnusedImport flag fld_env (L loc decl, used, unused) -- Do not warn for 'import M()' - | Just (False,L _ []) <- ideclHiding decl + | Just (Exactly, L _ []) <- ideclImportList decl = return () -- Note [Do not warn about Prelude hiding] - | Just (True, L _ hides) <- ideclHiding decl + | Just (EverythingBut, L _ hides) <- ideclImportList decl , not (null hides) , pRELUDE_NAME == unLoc (ideclName decl) = return () @@ -1843,7 +1842,7 @@ warnUnusedImport flag fld_env (L loc decl, used, unused) -- Only one import is unused, with `SrcSpan` covering only the unused item instead of -- the whole import statement - | Just (_, L _ imports) <- ideclHiding decl + | Just (_, L _ imports) <- ideclImportList decl , length unused == 1 , Just (L loc _) <- find (\(L _ ie) -> ((ieName ie) :: Name) `elem` unused) imports = let dia = TcRnUnknownMessage $ mkPlainDiagnostic (WarningWithFlag flag) noHints msg2 @@ -1910,7 +1909,7 @@ getMinimalImports = fmap combine . mapM mk_minimal where mk_minimal (L l decl, used_gres, unused) | null unused - , Just (False, _) <- ideclHiding decl + , Just (Exactly, _) <- ideclImportList decl = return (L l decl) | otherwise = do { let ImportDecl { ideclName = L _ mod_name @@ -1919,7 +1918,7 @@ getMinimalImports = fmap combine . mapM mk_minimal ; iface <- loadSrcInterface doc mod_name is_boot pkg_qual ; let used_avails = gresToAvailInfo used_gres lies = map (L l) (concatMap (to_ie iface) used_avails) - ; return (L l (decl { ideclHiding = Just (False, L (l2l l) lies) })) } + ; return (L l (decl { ideclImportList = Just (Exactly, L (l2l l) lies) })) } where doc = text "Compute minimal imports for" <+> ppr decl @@ -1970,8 +1969,8 @@ getMinimalImports = fmap combine . mapM mk_minimal merge :: [LImportDecl GhcRn] -> LImportDecl GhcRn merge [] = error "getMinimalImports: unexpected empty list" - merge decls@((L l decl) : _) = L l (decl { ideclHiding = Just (False, L (noAnnSrcSpan (locA l)) lies) }) - where lies = concatMap (unLoc . snd) $ mapMaybe (ideclHiding . unLoc) decls + merge decls@((L l decl) : _) = L l (decl { ideclImportList = Just (Exactly, L (noAnnSrcSpan (locA l)) lies) }) + where lies = concatMap (unLoc . snd) $ mapMaybe (ideclImportList . unLoc) decls printMinimalImports :: HscSource -> [ImportDeclUsage] -> RnM () @@ -2000,16 +1999,16 @@ printMinimalImports hsc_src imports_w_usage basefn = moduleNameString (moduleName this_mod) ++ suffix -to_ie_post_rn_var :: (HasOccName name) => LocatedA name -> LIEWrappedName name +to_ie_post_rn_var :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn to_ie_post_rn_var (L l n) | isDataOcc $ occName n = L l (IEPattern (EpaSpan $ la2r l) (L (la2na l) n)) - | otherwise = L l (IEName (L (la2na l) n)) + | otherwise = L l (IEName noExtField (L (la2na l) n)) -to_ie_post_rn :: (HasOccName name) => LocatedA name -> LIEWrappedName name +to_ie_post_rn :: LocatedA (IdP GhcRn) -> LIEWrappedName GhcRn to_ie_post_rn (L l n) | isTcOcc occ && isSymOcc occ = L l (IEType (EpaSpan $ la2r l) (L (la2na l) n)) - | otherwise = L l (IEName (L (la2na l) n)) + | otherwise = L l (IEName noExtField (L (la2na l) n)) where occ = occName n {- diff --git a/compiler/GHC/Tc/Errors/Ppr.hs b/compiler/GHC/Tc/Errors/Ppr.hs index 35bfea6ae1..349f587ddc 100644 --- a/compiler/GHC/Tc/Errors/Ppr.hs +++ b/compiler/GHC/Tc/Errors/Ppr.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} @@ -1694,11 +1695,11 @@ dodgy_msg kind tc ie quotes (ppr tc) <+> text "has (in-scope) constructors or class methods,", text "but it has none" ] -dodgy_msg_insert :: forall p . IdP (GhcPass p) -> IE (GhcPass p) +dodgy_msg_insert :: forall p . (Anno (IdP (GhcPass p)) ~ SrcSpanAnnN) => IdP (GhcPass p) -> IE (GhcPass p) dodgy_msg_insert tc = IEThingAll noAnn ii where - ii :: LIEWrappedName (IdP (GhcPass p)) - ii = noLocA (IEName $ noLocA tc) + ii :: LIEWrappedName (GhcPass p) + ii = noLocA (IEName noExtField $ noLocA tc) pprTypeDoesNotHaveFixedRuntimeRep :: Type -> FixedRuntimeRepProvenance -> SDoc pprTypeDoesNotHaveFixedRuntimeRep ty prov = diff --git a/compiler/GHC/Tc/Gen/Export.hs b/compiler/GHC/Tc/Gen/Export.hs index 27b2e84d6a..efc6433f29 100644 --- a/compiler/GHC/Tc/Gen/Export.hs +++ b/compiler/GHC/Tc/Gen/Export.hs @@ -190,7 +190,7 @@ rnExports explicit_mod exports | explicit_mod = exports | has_main = Just (noLocA [noLocA (IEVar noExtField - (noLocA (IEName $ noLocA default_main)))]) + (noLocA (IEName noExtField $ noLocA default_main)))]) -- ToDo: the 'noLoc' here is unhelpful if 'main' -- turns out to be out of scope | otherwise = Nothing @@ -369,8 +369,8 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier - lookup_ie_with :: LIEWrappedName RdrName -> [LIEWrappedName RdrName] - -> RnM (Located Name, [LIEWrappedName Name], [Name], + lookup_ie_with :: LIEWrappedName GhcPs -> [LIEWrappedName GhcPs] + -> RnM (Located Name, [LIEWrappedName GhcRn], [Name], [Located FieldLabel]) lookup_ie_with (L l rdr) sub_rdrs = do name <- lookupGlobalOccRn $ ieWrappedName rdr @@ -381,7 +381,7 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod , map (ieWrappedName . unLoc) non_flds , flds) - lookup_ie_all :: IE GhcPs -> LIEWrappedName RdrName + lookup_ie_all :: IE GhcPs -> LIEWrappedName GhcPs -> RnM (Located Name, [Name], [FieldLabel]) lookup_ie_all ie (L l rdr) = do name <- lookupGlobalOccRn $ ieWrappedName rdr @@ -476,8 +476,8 @@ If the module has NO main function: -lookupChildrenExport :: Name -> [LIEWrappedName RdrName] - -> RnM ([LIEWrappedName Name], [Located FieldLabel]) +lookupChildrenExport :: Name -> [LIEWrappedName GhcPs] + -> RnM ([LIEWrappedName GhcRn], [Located FieldLabel]) lookupChildrenExport spec_parent rdr_items = do xs <- mapAndReportM doOne rdr_items @@ -492,8 +492,8 @@ lookupChildrenExport spec_parent rdr_items = | ns == tcName = [dataName, tcName] | otherwise = [ns] -- Process an individual child - doOne :: LIEWrappedName RdrName - -> RnM (Either (LIEWrappedName Name) (Located FieldLabel)) + doOne :: LIEWrappedName GhcPs + -> RnM (Either (LIEWrappedName GhcRn) (Located FieldLabel)) doOne n = do let bareName = (ieWrappedName . unLoc) n @@ -513,7 +513,7 @@ lookupChildrenExport spec_parent rdr_items = case name of NameNotFound -> do { ub <- reportUnboundName unboundName ; let l = getLoc n - ; return (Left (L l (IEName (L (la2na l) ub))))} + ; return (Left (L l (IEName noExtField (L (la2na l) ub))))} FoundChild par child -> do { checkPatSynParent spec_parent par child ; return $ case child of FieldGreName fl -> Right (L (getLocA n) fl) diff --git a/compiler/GHC/Tc/Module.hs b/compiler/GHC/Tc/Module.hs index d23fad536c..a332d61fb1 100644 --- a/compiler/GHC/Tc/Module.hs +++ b/compiler/GHC/Tc/Module.hs @@ -239,9 +239,6 @@ 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 = @@ -285,7 +282,7 @@ tcRnModuleTcRnM hsc_env mod_sum ++ import_decls)) ; let { mkImport mod_name = noLocA $ (simpleImportDecl mod_name) - { ideclHiding = Just (False, noLocA [])}} + { ideclImportList = Just (Exactly, noLocA [])}} ; let { withReason t imps = map (,text t) imps } ; let { all_imports = withReason "is implicitly imported" prel_imports ++ withReason "is directly imported" import_decls @@ -1652,7 +1649,7 @@ tcPreludeClashWarn warnFlag name = do -- Implicit (Prelude) import? isImplicit :: ImportDecl GhcRn -> Bool - isImplicit = ideclImplicit + isImplicit = ideclImplicit . ideclExt -- Unqualified import? isUnqualified :: ImportDecl GhcRn -> Bool @@ -1662,17 +1659,17 @@ tcPreludeClashWarn warnFlag name = do -- Nothing -> No explicit imports -- Just (False, <names>) -> Explicit import list of <names> -- Just (True , <names>) -> Explicit hiding of <names> - importListOf :: ImportDecl GhcRn -> Maybe (Bool, [Name]) - importListOf = fmap toImportList . ideclHiding + importListOf :: ImportDecl GhcRn -> Maybe (ImportListInterpretation, [Name]) + importListOf = fmap toImportList . ideclImportList where toImportList (h, loc) = (h, map (ieName . unLoc) (unLoc loc)) isExplicit :: ImportDecl GhcRn -> Bool isExplicit x = case importListOf x of Nothing -> False - Just (False, explicit) + Just (Exactly, explicit) -> nameOccName name `elem` map nameOccName explicit - Just (True, hidden) + Just (EverythingBut, hidden) -> nameOccName name `notElem` map nameOccName hidden -- Check whether the given name would be imported (unqualified) from diff --git a/compiler/GHC/Tc/Utils/Backpack.hs b/compiler/GHC/Tc/Utils/Backpack.hs index 8758db5f47..d553ec4fad 100644 --- a/compiler/GHC/Tc/Utils/Backpack.hs +++ b/compiler/GHC/Tc/Utils/Backpack.hs @@ -521,8 +521,6 @@ 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 9860914502..b7bf62857c 100644 --- a/compiler/GHC/Unit/Module/Name.hs +++ b/compiler/GHC/Unit/Module/Name.hs @@ -1,7 +1,8 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- Outputable and Module Name -- | The ModuleName type module GHC.Unit.Module.Name - ( module Language.Haskell.Syntax + ( ModuleName , pprModuleName , moduleNameFS , moduleNameString @@ -13,7 +14,7 @@ module GHC.Unit.Module.Name ) where -import {-# SOURCE #-} Language.Haskell.Syntax (ModuleName(..)) +import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (ModuleName(..)) import GHC.Prelude diff --git a/compiler/GHC/Unit/Module/Name.hs-boot b/compiler/GHC/Unit/Module/Name.hs-boot deleted file mode 100644 index deff51787e..0000000000 --- a/compiler/GHC/Unit/Module/Name.hs-boot +++ /dev/null @@ -1,5 +0,0 @@ -module GHC.Unit.Module.Name ( - module Language.Haskell.Syntax - ) where - -import {-# SOURCE #-} Language.Haskell.Syntax (ModuleName(..)) diff --git a/compiler/GHC/Unit/Types.hs b/compiler/GHC/Unit/Types.hs index 51a09f72e1..e99fea94d4 100644 --- a/compiler/GHC/Unit/Types.hs +++ b/compiler/GHC/Unit/Types.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -Wno-orphans #-} -- instance Binary IsBootInterface + {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveTraversable #-} @@ -105,6 +107,8 @@ import Data.Bifunctor import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BS.Char8 +import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp (IsBootInterface(..)) + --------------------------------------------------------------------- -- MODULES --------------------------------------------------------------------- @@ -633,13 +637,6 @@ wiredInUnitIds = -- modules in opposition to boot interfaces. Instead, one should use -- 'DriverPhases.HscSource'. See Note [HscSource types]. --- | Indicates whether a module name is referring to a boot interface (hs-boot --- file) or regular module (hs file). We need to treat boot modules specially --- when building compilation graphs, since they break cycles. Regular source --- files and signature files are treated equivalently. -data IsBootInterface = NotBoot | IsBoot - deriving (Eq, Ord, Show, Data) - instance Binary IsBootInterface where put_ bh ib = put_ bh $ case ib of diff --git a/compiler/GHC/Unit/Types.hs-boot b/compiler/GHC/Unit/Types.hs-boot index 800b07db9a..21a0f6bc79 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 #-} Language.Haskell.Syntax ( ModuleName ) +import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp ( ModuleName ) import Data.Kind (Type) data UnitId diff --git a/compiler/GHC/Utils/Outputable.hs b/compiler/GHC/Utils/Outputable.hs index d759091850..09575cf53d 100644 --- a/compiler/GHC/Utils/Outputable.hs +++ b/compiler/GHC/Utils/Outputable.hs @@ -104,10 +104,11 @@ module GHC.Utils.Outputable ( ) where +import {-# SOURCE #-} Language.Haskell.Syntax.ImpExp ( ModuleName ) + import GHC.Prelude import {-# SOURCE #-} GHC.Unit.Types ( Unit, Module, moduleName ) -import {-# SOURCE #-} Language.Haskell.Syntax( ModuleName ) import {-# SOURCE #-} GHC.Types.Name.Occurrence( OccName ) import GHC.Utils.BufHandle (BufHandle) diff --git a/compiler/Language/Haskell/Syntax.hs b/compiler/Language/Haskell/Syntax.hs index 143b682405..d5129cbb13 100644 --- a/compiler/Language/Haskell/Syntax.hs +++ b/compiler/Language/Haskell/Syntax.hs @@ -20,6 +20,7 @@ module Language.Haskell.Syntax ( module Language.Haskell.Syntax.Binds, module Language.Haskell.Syntax.Decls, module Language.Haskell.Syntax.Expr, + module Language.Haskell.Syntax.ImpExp, module Language.Haskell.Syntax.Lit, module Language.Haskell.Syntax.Pat, module Language.Haskell.Syntax.Type, @@ -30,16 +31,13 @@ module Language.Haskell.Syntax ( import Language.Haskell.Syntax.Decls import Language.Haskell.Syntax.Binds import Language.Haskell.Syntax.Expr +import Language.Haskell.Syntax.ImpExp import Language.Haskell.Syntax.Lit import Language.Haskell.Syntax.Extension import Language.Haskell.Syntax.Pat import Language.Haskell.Syntax.Type -import GHC.Data.FastString -import GHC.Data.Maybe (Maybe) -import GHC.Prelude (Show) -import GHC.Parser.Annotation -import GHC.Hs.ImpExp (LIE, LImportDecl) +import Data.Maybe (Maybe) {- Note [Language.Haskell.Syntax.* Hierarchy] @@ -62,9 +60,6 @@ For more details, see https://gitlab.haskell.org/ghc/ghc/-/wikis/implementing-trees-that-grow -} --- | A ModuleName is essentially a simple string, e.g. @Data.List@. -newtype ModuleName = ModuleName FastString deriving Show - -- | Haskell Module -- -- All we actually declare here is the top-level structure for a module. @@ -79,12 +74,12 @@ data HsModule p -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation HsModule { - hsmodExt :: XModule p, + hsmodExt :: XCModule p, -- ^ HsModule extension point - hsmodName :: Maybe (LocatedA ModuleName), + hsmodName :: Maybe (XRec p ModuleName), -- ^ @Nothing@: \"module X where\" is omitted (in which case the next -- field is Nothing too) - hsmodExports :: Maybe (LocatedL [LIE p]), + hsmodExports :: Maybe (XRec p [LIE p]), -- ^ Export list -- -- - @Nothing@: export list omitted, so export everything @@ -99,10 +94,8 @@ data HsModule p -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation hsmodImports :: [LImportDecl p], - -- ^ 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 p] -- ^ Type, class, value, and interface signature decls } - | XModule (XXModule p) + | XModule !(XXModule p) + diff --git a/compiler/Language/Haskell/Syntax.hs-boot b/compiler/Language/Haskell/Syntax.hs-boot deleted file mode 100644 index 72ddcaa0e4..0000000000 --- a/compiler/Language/Haskell/Syntax.hs-boot +++ /dev/null @@ -1,9 +0,0 @@ -{-# LANGUAGE StandaloneDeriving #-} -module Language.Haskell.Syntax where - -import GHC.Prelude (Show) -import GHC.Data.FastString - -newtype ModuleName = ModuleName FastString - -instance Show ModuleName diff --git a/compiler/Language/Haskell/Syntax/Decls.hs b/compiler/Language/Haskell/Syntax/Decls.hs index 303105e3d4..da5265a144 100644 --- a/compiler/Language/Haskell/Syntax/Decls.hs +++ b/compiler/Language/Haskell/Syntax/Decls.hs @@ -100,7 +100,7 @@ import {-# SOURCE #-} Language.Haskell.Syntax.Expr import Language.Haskell.Syntax.Binds import Language.Haskell.Syntax.Type -import GHC.Hs.Doc +import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST import GHC.Core.TyCon import GHC.Types.Basic import GHC.Types.ForeignCall diff --git a/compiler/Language/Haskell/Syntax/Extension.hs b/compiler/Language/Haskell/Syntax/Extension.hs index f63ca09b30..6312681f52 100644 --- a/compiler/Language/Haskell/Syntax/Extension.hs +++ b/compiler/Language/Haskell/Syntax/Extension.hs @@ -399,7 +399,7 @@ type family XXInjectivityAnn x -- ===================================================================== -- Type families for the HsModule extension points -type family XModule x +type family XCModule x type family XXModule x -- ===================================================================== @@ -686,6 +686,7 @@ type family XXFieldOcc x -- ImportDecl type families type family XCImportDecl x type family XXImportDecl x +type family ImportDeclPkgQual x -- stores the package qualifier in an import statement -- ------------------------------------- -- IE type families @@ -700,6 +701,13 @@ type family XIEDocNamed x type family XXIE x -- ------------------------------------- +-- IEWrappedName type families +type family XIEName p +type family XIEPattern p +type family XIEType p +type family XXIEWrappedName p + + -- ===================================================================== -- Misc diff --git a/compiler/Language/Haskell/Syntax/ImpExp.hs b/compiler/Language/Haskell/Syntax/ImpExp.hs new file mode 100644 index 0000000000..7e529701c4 --- /dev/null +++ b/compiler/Language/Haskell/Syntax/ImpExp.hs @@ -0,0 +1,177 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE DeriveDataTypeable #-} +module Language.Haskell.Syntax.ImpExp where + +import Language.Haskell.Syntax.Extension + +import Data.Eq (Eq) +import Data.Ord (Ord) +import Text.Show (Show) +import Data.Data (Data) +import Data.Bool (Bool) +import Data.Maybe (Maybe) +import Data.String (String) +import Data.Int (Int) + +import GHC.Hs.Doc -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST +import GHC.Data.FastString + +{- +************************************************************************ +* * +Import and export declaration lists +* * +************************************************************************ + +One per import declaration in a module. +-} + +-- | A ModuleName is essentially a simple string, e.g. @Data.List@. +newtype ModuleName = ModuleName FastString deriving Show + +-- | Located Import Declaration +type LImportDecl pass = XRec pass (ImportDecl pass) + -- ^ When in a list this may have + -- + -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnSemi' + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + +-- | If/how an import is 'qualified'. +data ImportDeclQualifiedStyle + = QualifiedPre -- ^ 'qualified' appears in prepositive position. + | QualifiedPost -- ^ 'qualified' appears in postpositive position. + | NotQualified -- ^ Not qualified. + deriving Data + +-- | Indicates whether a module name is referring to a boot interface (hs-boot +-- file) or regular module (hs file). We need to treat boot modules specially +-- when building compilation graphs, since they break cycles. Regular source +-- files and signature files are treated equivalently. +data IsBootInterface = NotBoot | IsBoot + deriving (Eq, Ord, Show, Data) + +-- | Import Declaration +-- +-- A single Haskell @import@ declaration. +data ImportDecl pass + = ImportDecl { + ideclExt :: XCImportDecl pass, + ideclName :: XRec pass ModuleName, -- ^ Module name. + ideclPkgQual :: ImportDeclPkgQual pass, -- ^ Package qualifier. + ideclSource :: IsBootInterface, -- ^ IsBoot <=> {-\# SOURCE \#-} import + ideclSafe :: Bool, -- ^ True => safe import + ideclQualified :: ImportDeclQualifiedStyle, -- ^ If/how the import is qualified. + ideclAs :: Maybe (XRec pass ModuleName), -- ^ as Module + ideclImportList :: Maybe (ImportListInterpretation, XRec pass [LIE pass]) + -- ^ Explicit import list (EverythingBut => hiding, names) + } + | XImportDecl !(XXImportDecl pass) + -- ^ + -- 'GHC.Parser.Annotation.AnnKeywordId's + -- + -- - 'GHC.Parser.Annotation.AnnImport' + -- + -- - 'GHC.Parser.Annotation.AnnOpen', 'GHC.Parser.Annotation.AnnClose' for ideclSource + -- + -- - 'GHC.Parser.Annotation.AnnSafe','GHC.Parser.Annotation.AnnQualified', + -- 'GHC.Parser.Annotation.AnnPackageName','GHC.Parser.Annotation.AnnAs', + -- 'GHC.Parser.Annotation.AnnVal' + -- + -- - 'GHC.Parser.Annotation.AnnHiding','GHC.Parser.Annotation.AnnOpen', + -- 'GHC.Parser.Annotation.AnnClose' attached + -- to location in ideclImportList + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + +-- | Whether the import list is exactly what to import, or whether `hiding` was +-- used, and therefore everything but what was listed should be imported +data ImportListInterpretation = Exactly | EverythingBut + deriving (Eq, Data) + +-- | Located Import or Export +type LIE pass = XRec pass (IE pass) + -- ^ When in a list this may have + -- + -- - 'GHC.Parser.Annotation.AnnKeywordId' : 'GHC.Parser.Annotation.AnnComma' + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + +-- | Imported or exported entity. +data IE pass + = IEVar (XIEVar pass) (LIEWrappedName pass) + -- ^ Imported or Exported Variable + + | IEThingAbs (XIEThingAbs pass) (LIEWrappedName pass) + -- ^ Imported or exported Thing with Absent list + -- + -- The thing is a Class/Type (can't tell) + -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnPattern', + -- 'GHC.Parser.Annotation.AnnType','GHC.Parser.Annotation.AnnVal' + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + -- See Note [Located RdrNames] in GHC.Hs.Expr + | IEThingAll (XIEThingAll pass) (LIEWrappedName pass) + -- ^ Imported or exported Thing with All imported or exported + -- + -- The thing is a Class/Type and the All refers to methods/constructors + -- + -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen', + -- 'GHC.Parser.Annotation.AnnDotdot','GHC.Parser.Annotation.AnnClose', + -- 'GHC.Parser.Annotation.AnnType' + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + -- See Note [Located RdrNames] in GHC.Hs.Expr + + | IEThingWith (XIEThingWith pass) + (LIEWrappedName pass) + IEWildcard + [LIEWrappedName pass] + -- ^ Imported or exported Thing With given imported or exported + -- + -- The thing is a Class/Type and the imported or exported things are + -- methods/constructors and record fields; see Note [IEThingWith] + -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnOpen', + -- 'GHC.Parser.Annotation.AnnClose', + -- 'GHC.Parser.Annotation.AnnComma', + -- 'GHC.Parser.Annotation.AnnType' + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + | IEModuleContents (XIEModuleContents pass) (XRec pass ModuleName) + -- ^ Imported or exported module contents + -- + -- (Export Only) + -- + -- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnModule' + + -- For details on above see Note [exact print annotations] in GHC.Parser.Annotation + | IEGroup (XIEGroup pass) Int (LHsDoc pass) -- ^ Doc section heading + | IEDoc (XIEDoc pass) (LHsDoc pass) -- ^ Some documentation + | IEDocNamed (XIEDocNamed pass) String -- ^ Reference to named doc + | XIE !(XXIE pass) + +-- | Wildcard in an import or export sublist, like the @..@ in +-- @import Mod ( T(Mk1, Mk2, ..) )@. +data IEWildcard + = NoIEWildcard -- ^ no wildcard in this list + | IEWildcard Int -- ^ wildcard after the given \# of items in this list + -- The @Int@ is in the range [0..n], where n is the length + -- of the list. + deriving (Eq, Data) + +-- | A name in an import or export specification which may have +-- adornments. Used primarily for accurate pretty printing of +-- ParsedSource, and API Annotation placement. The +-- 'GHC.Parser.Annotation' is the location of the adornment in +-- the original source. +data IEWrappedName p + = IEName (XIEName p) (LIdP p) -- ^ no extra + | IEPattern (XIEPattern p) (LIdP p) -- ^ pattern X + | IEType (XIEType p) (LIdP p) -- ^ type (:+:) + | XIEWrappedName !(XXIEWrappedName p) + +-- | Located name with possible adornment +-- - 'GHC.Parser.Annotation.AnnKeywordId's : 'GHC.Parser.Annotation.AnnType', +-- 'GHC.Parser.Annotation.AnnPattern' +type LIEWrappedName p = XRec p (IEWrappedName p) +-- For details on above see Note [exact print annotations] in GHC.Parser.Annotation diff --git a/compiler/Language/Haskell/Syntax/ImpExp.hs-boot b/compiler/Language/Haskell/Syntax/ImpExp.hs-boot new file mode 100644 index 0000000000..9cc78600b8 --- /dev/null +++ b/compiler/Language/Haskell/Syntax/ImpExp.hs-boot @@ -0,0 +1,22 @@ +module Language.Haskell.Syntax.ImpExp where + +import GHC.Data.FastString + +import Data.Eq +import Data.Ord +import Text.Show +import Data.Data + +-- This boot file should be short lived: As soon as the dependency on +-- `GHC.Hs.Doc` is gone we'll no longer have cycles and can get rid this file. + +data IsBootInterface = NotBoot | IsBoot + +instance Eq IsBootInterface +instance Ord IsBootInterface +instance Show IsBootInterface +instance Data IsBootInterface + +newtype ModuleName = ModuleName FastString + +instance Show ModuleName diff --git a/compiler/ghc.cabal.in b/compiler/ghc.cabal.in index 3d86eec217..e06a2c5837 100644 --- a/compiler/ghc.cabal.in +++ b/compiler/ghc.cabal.in @@ -804,6 +804,7 @@ Library Language.Haskell.Syntax.Decls Language.Haskell.Syntax.Expr Language.Haskell.Syntax.Extension + Language.Haskell.Syntax.ImpExp Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Type diff --git a/ghc/GHCi/UI.hs b/ghc/GHCi/UI.hs index ff607d645c..8fac7da93a 100644 --- a/ghc/GHCi/UI.hs +++ b/ghc/GHCi/UI.hs @@ -1270,10 +1270,13 @@ runStmt input step = do setDumpFilePrefix ic -- `-ddump-to-file` must work for normal GHCi compilations / -- evaluations. (#17500) - HsModule { hsmodDecls = decls, hsmodImports = imports } <- - liftIO (hscParseModuleWithLocation hsc_env source line input) - run_imports imports - run_decls decls + -- Use >>= \case instead of MonadFail desugaring to take into + -- consideration `instance XXModule p = DataConCantHappen`. + -- Tracked in #15681 + liftIO (hscParseModuleWithLocation hsc_env source line input) >>= \case + HsModule { hsmodDecls = decls, hsmodImports = imports } -> do + run_imports imports + run_decls decls where exec_complete = GHC.ExecComplete (Right []) 0 @@ -2908,10 +2911,10 @@ iiSubsumes (IIDecl d1) (IIDecl d2) -- A bit crude = unLoc (ideclName d1) == unLoc (ideclName d2) && ideclAs d1 == ideclAs d2 && (not (isImportDeclQualified (ideclQualified d1)) || isImportDeclQualified (ideclQualified d2)) - && (ideclHiding d1 `hidingSubsumes` ideclHiding d2) + && (ideclImportList d1 `hidingSubsumes` ideclImportList d2) where - _ `hidingSubsumes` Just (False,L _ []) = True - Just (False, L _ xs) `hidingSubsumes` Just (False,L _ ys) + _ `hidingSubsumes` Just (Exactly,L _ []) = True + Just (Exactly, L _ xs) `hidingSubsumes` Just (Exactly,L _ ys) = all (`elem` xs) ys h1 `hidingSubsumes` h2 = h1 == h2 iiSubsumes _ _ = False diff --git a/testsuite/tests/count-deps/CountDepsAst.stdout b/testsuite/tests/count-deps/CountDepsAst.stdout index 75ef4e13de..edf9f38183 100644 --- a/testsuite/tests/count-deps/CountDepsAst.stdout +++ b/testsuite/tests/count-deps/CountDepsAst.stdout @@ -285,6 +285,7 @@ Language.Haskell.Syntax.Binds Language.Haskell.Syntax.Decls Language.Haskell.Syntax.Expr Language.Haskell.Syntax.Extension +Language.Haskell.Syntax.ImpExp Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Type diff --git a/testsuite/tests/count-deps/CountDepsParser.stdout b/testsuite/tests/count-deps/CountDepsParser.stdout index a4a51fbf9a..213126ce47 100644 --- a/testsuite/tests/count-deps/CountDepsParser.stdout +++ b/testsuite/tests/count-deps/CountDepsParser.stdout @@ -292,6 +292,7 @@ Language.Haskell.Syntax.Binds Language.Haskell.Syntax.Decls Language.Haskell.Syntax.Expr Language.Haskell.Syntax.Extension +Language.Haskell.Syntax.ImpExp Language.Haskell.Syntax.Lit Language.Haskell.Syntax.Pat Language.Haskell.Syntax.Type diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr index bada9845ab..32f05282ff 100644 --- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr +++ b/testsuite/tests/ghc-api/exactprint/Test20239.stderr @@ -4,37 +4,40 @@ (L { Test20239.hs:1:1 } (HsModule - (EpAnn - (Anchor - { Test20239.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { Test20239.hs:1:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { Test20239.hs:1:18-22 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - [])) - (EpaCommentsBalanced - [(L - (Anchor - { Test20239.hs:3:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- | Leading Haddock Comment") - { Test20239.hs:1:18-22 }))] - [(L - (Anchor - { Test20239.hs:8:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { Test20239.hs:7:34-63 }))])) - (VirtualBraces - (1)) + (XModulePs + (EpAnn + (Anchor + { Test20239.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { Test20239.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { Test20239.hs:1:18-22 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { Test20239.hs:3:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- | Leading Haddock Comment") + { Test20239.hs:1:18-22 }))] + [(L + (Anchor + { Test20239.hs:8:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { Test20239.hs:7:34-63 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { Test20239.hs:1:8-16 }) @@ -317,11 +320,9 @@ (HsBoxedOrConstraintTuple) [])))))))))))))]) (Nothing)))] - []))))))] - (Nothing) - (Nothing))) + []))))))])) -Test20239.hs:4:15: +Test20239.hs:4:15: error: Not in scope: type constructor or class ‘Method’ diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr index 2e0335db9f..de7d9e6f67 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr @@ -4,30 +4,33 @@ (L { T17544.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T17544.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T17544.hs:3:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:3:15-19 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { T17544.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T17544.hs:3:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:3:15-19 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { T17544.hs:57:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T17544.hs:57:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { T17544.hs:57:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T17544.hs:57:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T17544.hs:3:8-13 }) @@ -2245,9 +2248,7 @@ (HsDocStringChunk " comment on class instance C10 Int")) [])) - [])))))] - (Nothing) - (Nothing))) + [])))))])) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr index 889833f2a6..ce76e9de6d 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr @@ -4,30 +4,45 @@ (L { T17544_kw.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T17544_kw.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { T17544_kw.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { T17544_kw.hs:25:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T17544_kw.hs:25:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { T17544_kw.hs:25:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T17544_kw.hs:25:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Just + (L + { T17544_kw.hs:12:3-33 } + (WithHsDocIdentifiers + (MultiLineDocString + (HsDocStringNext) + (:| + (L + { T17544_kw.hs:12:7-33 } + (HsDocStringChunk + " Bad comment for the module")) + [])) + [])))) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T17544_kw.hs:13:3-11 }) @@ -341,20 +356,6 @@ (HsDocStringChunk " Bad comment for clsmethod")) [])) - []))))])))] - (Nothing) - (Just - (L - { T17544_kw.hs:12:3-33 } - (WithHsDocIdentifiers - (MultiLineDocString - (HsDocStringNext) - (:| - (L - { T17544_kw.hs:12:7-33 } - (HsDocStringChunk - " Bad comment for the module")) - [])) - []))))) + []))))])))])) diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr index 678557c52f..b5af7f60ba 100644 --- a/testsuite/tests/module/mod185.stderr +++ b/testsuite/tests/module/mod185.stderr @@ -4,49 +4,54 @@ (L { mod185.hs:1:1 } (HsModule - (EpAnn - (Anchor - { mod185.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { mod185.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { mod185.hs:6:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { mod185.hs:6:1 }))])) - (VirtualBraces - (1)) + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [] + [(L + (Anchor + { mod185.hs:6:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { mod185.hs:6:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Nothing) (Nothing) [(L (SrcSpanAnn (EpAnnNotUsed) { mod185.hs:3:1-24 }) (ImportDecl - (EpAnn - (Anchor - { mod185.hs:3:1-6 } - (UnchangedAnchor)) - (EpAnnImportDecl - (EpaSpan { mod185.hs:3:1-6 }) - (Nothing) - (Nothing) - (Just - (EpaSpan { mod185.hs:3:16-24 })) - (Nothing) - (Nothing)) - (EpaComments - [])) - (NoSourceText) + (XImportDeclPass + (EpAnn + (Anchor + { mod185.hs:3:1-6 } + (UnchangedAnchor)) + (EpAnnImportDecl + (EpaSpan { mod185.hs:3:1-6 }) + (Nothing) + (Nothing) + (Just + (EpaSpan { mod185.hs:3:16-24 })) + (Nothing) + (Nothing)) + (EpaComments + [])) + (NoSourceText) + (False)) (L (SrcSpanAnn (EpAnnNotUsed) { mod185.hs:3:8-14 }) {ModuleName: Prelude}) @@ -54,7 +59,6 @@ (NotBoot) (False) (QualifiedPost) - (False) (Nothing) (Nothing)))] [(L @@ -125,8 +129,6 @@ {OccName: undefined}))))))] (EmptyLocalBinds (NoExtField)))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index c91d8cdc70..f11708fa06 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -4,30 +4,33 @@ (L { DumpParsedAst.hs:1:1 } (HsModule - (EpAnn - (Anchor - { DumpParsedAst.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { DumpParsedAst.hs:5:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:5:22-26 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { DumpParsedAst.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { DumpParsedAst.hs:5:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:5:22-26 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { DumpParsedAst.hs:25:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { DumpParsedAst.hs:25:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { DumpParsedAst.hs:25:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { DumpParsedAst.hs:25:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:5:8-20 }) @@ -36,20 +39,22 @@ [(L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:6:1-16 }) (ImportDecl - (EpAnn - (Anchor - { DumpParsedAst.hs:6:1-6 } - (UnchangedAnchor)) - (EpAnnImportDecl - (EpaSpan { DumpParsedAst.hs:6:1-6 }) - (Nothing) - (Nothing) - (Nothing) - (Nothing) - (Nothing)) - (EpaComments - [])) - (NoSourceText) + (XImportDeclPass + (EpAnn + (Anchor + { DumpParsedAst.hs:6:1-6 } + (UnchangedAnchor)) + (EpAnnImportDecl + (EpaSpan { DumpParsedAst.hs:6:1-6 }) + (Nothing) + (Nothing) + (Nothing) + (Nothing) + (Nothing)) + (EpaComments + [])) + (NoSourceText) + (False)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAst.hs:6:8-16 }) {ModuleName: Data.Kind}) @@ -57,7 +62,6 @@ (NotBoot) (False) (NotQualified) - (False) (Nothing) (Nothing)))] [(L @@ -1529,8 +1533,6 @@ {FastString: "hello"})))))))] (EmptyLocalBinds (NoExtField)))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr index 6673dff801..fd620baf4b 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr @@ -4,46 +4,49 @@ (L { DumpParsedAstComments.hs:1:1 } (HsModule - (EpAnn - (Anchor - { DumpParsedAstComments.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { DumpParsedAstComments.hs:5:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAstComments.hs:5:30-34 - }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - [])) - (EpaCommentsBalanced - [(L - (Anchor - { DumpParsedAstComments.hs:1:1-28 } - (UnchangedAnchor)) - (EpaComment - (EpaBlockComment - "{-# LANGUAGE Haskell2010 #-}") - { DumpParsedAstComments.hs:1:1 })) - ,(L - (Anchor - { DumpParsedAstComments.hs:(2,1)-(4,4) } - (UnchangedAnchor)) - (EpaComment - (EpaBlockComment - "{-\n Block comment at the beginning\n -}") - { DumpParsedAstComments.hs:1:1-28 }))] - [(L - (Anchor - { DumpParsedAstComments.hs:13:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { DumpParsedAstComments.hs:13:1 }))])) - (VirtualBraces - (1)) + (XModulePs + (EpAnn + (Anchor + { DumpParsedAstComments.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { DumpParsedAstComments.hs:5:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAstComments.hs:5:30-34 + }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { DumpParsedAstComments.hs:1:1-28 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{-# LANGUAGE Haskell2010 #-}") + { DumpParsedAstComments.hs:1:1 })) + ,(L + (Anchor + { DumpParsedAstComments.hs:(2,1)-(4,4) } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{-\n Block comment at the beginning\n -}") + { DumpParsedAstComments.hs:1:1-28 }))] + [(L + (Anchor + { DumpParsedAstComments.hs:13:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { DumpParsedAstComments.hs:13:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:5:8-28 }) @@ -277,8 +280,6 @@ {FastString: "hello"})))))))] (EmptyLocalBinds (NoExtField)))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index f5fc2e9d00..290d505195 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -1272,8 +1272,10 @@ [(L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:5:8-21 }) (ImportDecl - (NoExtField) - (NoSourceText) + (XImportDeclPass + (EpAnnNotUsed) + (NoSourceText) + (True)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:5:8-21 }) {ModuleName: Prelude}) @@ -1281,14 +1283,27 @@ (NotBoot) (False) (NotQualified) - (True) (Nothing) (Nothing))) ,(L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:6:1-16 }) (ImportDecl - (NoExtField) - (NoSourceText) + (XImportDeclPass + (EpAnn + (Anchor + { DumpRenamedAst.hs:6:1-6 } + (UnchangedAnchor)) + (EpAnnImportDecl + (EpaSpan { DumpRenamedAst.hs:6:1-6 }) + (Nothing) + (Nothing) + (Nothing) + (Nothing) + (Nothing)) + (EpaComments + [])) + (NoSourceText) + (False)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:6:8-16 }) {ModuleName: Data.Kind}) @@ -1296,14 +1311,27 @@ (NotBoot) (False) (NotQualified) - (False) (Nothing) (Nothing))) ,(L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:8:1-23 }) (ImportDecl - (NoExtField) - (NoSourceText) + (XImportDeclPass + (EpAnn + (Anchor + { DumpRenamedAst.hs:8:1-6 } + (UnchangedAnchor)) + (EpAnnImportDecl + (EpaSpan { DumpRenamedAst.hs:8:1-6 }) + (Nothing) + (Nothing) + (Nothing) + (Nothing) + (Nothing)) + (EpaComments + [])) + (NoSourceText) + (False)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:8:8-16 }) {ModuleName: Data.Kind}) @@ -1311,11 +1339,10 @@ (NotBoot) (False) (NotQualified) - (False) (Nothing) (Just ((,) - (False) + (Exactly) (L (SrcSpanAnn (EpAnn (Anchor @@ -1338,6 +1365,7 @@ (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:8:19-22 }) (IEName + (NoExtField) (L (SrcSpanAnn (EpAnnNotUsed) { DumpRenamedAst.hs:8:19-22 }) {Name: GHC.Types.Type})))))])))))] diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr index 45a3d7acda..3d0a47521e 100644 --- a/testsuite/tests/parser/should_compile/DumpSemis.stderr +++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr @@ -4,41 +4,44 @@ (L { DumpSemis.hs:1:1 } (HsModule - (EpAnn - (Anchor - { DumpSemis.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { DumpSemis.hs:1:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { DumpSemis.hs:1:18-22 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { DumpSemis.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { DumpSemis.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { DumpSemis.hs:1:18-22 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [(AddSemiAnn + (EpaSpan { DumpSemis.hs:4:1 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:4:2 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:4:3 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:4:4 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:4:7 })) + ,(AddSemiAnn + (EpaSpan { DumpSemis.hs:4:8 }))])) + (EpaCommentsBalanced [] - [(AddSemiAnn - (EpaSpan { DumpSemis.hs:4:1 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:4:2 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:4:3 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:4:4 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:4:7 })) - ,(AddSemiAnn - (EpaSpan { DumpSemis.hs:4:8 }))])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { DumpSemis.hs:46:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { DumpSemis.hs:46:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { DumpSemis.hs:46:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { DumpSemis.hs:46:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:1:8-16 }) @@ -59,20 +62,22 @@ (EpaComments [])) { DumpSemis.hs:5:1-19 }) (ImportDecl - (EpAnn - (Anchor - { DumpSemis.hs:5:1-6 } - (UnchangedAnchor)) - (EpAnnImportDecl - (EpaSpan { DumpSemis.hs:5:1-6 }) - (Nothing) - (Nothing) - (Nothing) - (Nothing) - (Nothing)) - (EpaComments - [])) - (NoSourceText) + (XImportDeclPass + (EpAnn + (Anchor + { DumpSemis.hs:5:1-6 } + (UnchangedAnchor)) + (EpAnnImportDecl + (EpaSpan { DumpSemis.hs:5:1-6 }) + (Nothing) + (Nothing) + (Nothing) + (Nothing) + (Nothing)) + (EpaComments + [])) + (NoSourceText) + (False)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:5:8-16 }) {ModuleName: Data.List}) @@ -80,11 +85,10 @@ (NotBoot) (False) (NotQualified) - (False) (Nothing) (Just ((,) - (False) + (Exactly) (L (SrcSpanAnn (EpAnn (Anchor @@ -116,20 +120,22 @@ (EpaComments [])) { DumpSemis.hs:7:1-16 }) (ImportDecl - (EpAnn - (Anchor - { DumpSemis.hs:7:1-6 } - (UnchangedAnchor)) - (EpAnnImportDecl - (EpaSpan { DumpSemis.hs:7:1-6 }) - (Nothing) - (Nothing) - (Nothing) - (Nothing) - (Nothing)) - (EpaComments - [])) - (NoSourceText) + (XImportDeclPass + (EpAnn + (Anchor + { DumpSemis.hs:7:1-6 } + (UnchangedAnchor)) + (EpAnnImportDecl + (EpaSpan { DumpSemis.hs:7:1-6 }) + (Nothing) + (Nothing) + (Nothing) + (Nothing) + (Nothing)) + (EpaComments + [])) + (NoSourceText) + (False)) (L (SrcSpanAnn (EpAnnNotUsed) { DumpSemis.hs:7:8-16 }) {ModuleName: Data.Kind}) @@ -137,7 +143,6 @@ (NotBoot) (False) (NotQualified) - (False) (Nothing) (Nothing)))] [(L @@ -2117,8 +2122,6 @@ (NoExtField)))))]))))))] (EmptyLocalBinds (NoExtField)))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr index b3107c18c6..7794fda45e 100644 --- a/testsuite/tests/parser/should_compile/KindSigs.stderr +++ b/testsuite/tests/parser/should_compile/KindSigs.stderr @@ -4,30 +4,33 @@ (L { KindSigs.hs:1:1 } (HsModule - (EpAnn - (Anchor - { KindSigs.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { KindSigs.hs:6:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:6:17-21 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { KindSigs.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { KindSigs.hs:6:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:6:17-21 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { KindSigs.hs:36:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { KindSigs.hs:36:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { KindSigs.hs:36:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { KindSigs.hs:36:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:6:8-15 }) @@ -36,20 +39,22 @@ [(L (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:8:1-16 }) (ImportDecl - (EpAnn - (Anchor - { KindSigs.hs:8:1-6 } - (UnchangedAnchor)) - (EpAnnImportDecl - (EpaSpan { KindSigs.hs:8:1-6 }) - (Nothing) - (Nothing) - (Nothing) - (Nothing) - (Nothing)) - (EpaComments - [])) - (NoSourceText) + (XImportDeclPass + (EpAnn + (Anchor + { KindSigs.hs:8:1-6 } + (UnchangedAnchor)) + (EpAnnImportDecl + (EpaSpan { KindSigs.hs:8:1-6 }) + (Nothing) + (Nothing) + (Nothing) + (Nothing) + (Nothing)) + (EpaComments + [])) + (NoSourceText) + (False)) (L (SrcSpanAnn (EpAnnNotUsed) { KindSigs.hs:8:8-16 }) {ModuleName: Data.Kind}) @@ -57,7 +62,6 @@ (NotBoot) (False) (NotQualified) - (False) (Nothing) (Nothing)))] [(L @@ -1512,8 +1516,6 @@ {OccName: True}))))))] (EmptyLocalBinds (NoExtField)))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr index 9eda4089be..b2e294562b 100644 --- a/testsuite/tests/parser/should_compile/T14189.stderr +++ b/testsuite/tests/parser/should_compile/T14189.stderr @@ -167,8 +167,10 @@ [(L (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:1:8-13 }) (ImportDecl - (NoExtField) - (NoSourceText) + (XImportDeclPass + (EpAnnNotUsed) + (NoSourceText) + (True)) (L (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:1:8-13 }) {ModuleName: Prelude}) @@ -176,7 +178,6 @@ (NotBoot) (False) (NotQualified) - (True) (Nothing) (Nothing)))] (Just @@ -194,6 +195,7 @@ (L (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:3:3-8 }) (IEName + (NoExtField) (L (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:3:3-8 }) {Name: T14189.MyType}))) @@ -201,6 +203,7 @@ [(L (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:3:13-14 }) (IEName + (NoExtField) (L (SrcSpanAnn (EpAnnNotUsed) { T14189.hs:3:13-14 }) {Name: T14189.NT})))])) diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index 693814f96e..ee0748d050 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -4,30 +4,33 @@ (L { T15323.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T15323.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T15323.hs:3:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:3:15-19 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { T15323.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T15323.hs:3:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:3:15-19 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { T15323.hs:7:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T15323.hs:7:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { T15323.hs:7:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T15323.hs:7:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T15323.hs:3:8-13 }) @@ -226,8 +229,6 @@ (Unqual {OccName: v})))))) (Nothing)))] - []))))] - (Nothing) - (Nothing))) + []))))])) diff --git a/testsuite/tests/parser/should_compile/T20452.stderr b/testsuite/tests/parser/should_compile/T20452.stderr index c5eded00e9..810b831cd7 100644 --- a/testsuite/tests/parser/should_compile/T20452.stderr +++ b/testsuite/tests/parser/should_compile/T20452.stderr @@ -4,30 +4,33 @@ (L { T20452.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T20452.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T20452.hs:3:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T20452.hs:3:15-19 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { T20452.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T20452.hs:3:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T20452.hs:3:15-19 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { T20452.hs:10:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T20452.hs:10:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { T20452.hs:10:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T20452.hs:10:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20452.hs:3:8-13 }) @@ -587,6 +590,6 @@ []} [] [] - [])))] - (Nothing) - (Nothing))) + [])))])) + + diff --git a/testsuite/tests/parser/should_compile/T20718.stderr b/testsuite/tests/parser/should_compile/T20718.stderr index 77563d8631..fd8fbfb261 100644 --- a/testsuite/tests/parser/should_compile/T20718.stderr +++ b/testsuite/tests/parser/should_compile/T20718.stderr @@ -4,61 +4,64 @@ (L { T20718.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T20718.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T20718.hs:3:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T20718.hs:3:15-19 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - [])) - (EpaCommentsBalanced - [(L - (Anchor - { T20718.hs:1:1-16 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- top of file 1") - { T20718.hs:1:1 })) - ,(L - (Anchor - { T20718.hs:2:1-16 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- top of file 2") - { T20718.hs:1:1-16 })) - ,(L - (Anchor - { T20718.hs:5:1-11 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- before 1") - { T20718.hs:3:15-19 })) - ,(L - (Anchor - { T20718.hs:6:1-11 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- before 2") - { T20718.hs:5:1-11 }))] - [(L - (Anchor - { T20718.hs:12:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T20718.hs:11:1-8 }))])) - (VirtualBraces - (1)) + (XModulePs + (EpAnn + (Anchor + { T20718.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T20718.hs:3:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T20718.hs:3:15-19 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { T20718.hs:1:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- top of file 1") + { T20718.hs:1:1 })) + ,(L + (Anchor + { T20718.hs:2:1-16 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- top of file 2") + { T20718.hs:1:1-16 })) + ,(L + (Anchor + { T20718.hs:5:1-11 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- before 1") + { T20718.hs:3:15-19 })) + ,(L + (Anchor + { T20718.hs:6:1-11 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- before 2") + { T20718.hs:5:1-11 }))] + [(L + (Anchor + { T20718.hs:12:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T20718.hs:11:1-8 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20718.hs:3:8-13 }) @@ -156,8 +159,6 @@ (1))))))))] (EmptyLocalBinds (NoExtField)))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/testsuite/tests/parser/should_compile/T20718b.stderr b/testsuite/tests/parser/should_compile/T20718b.stderr index d359e5c5cf..79b5d67bb3 100644 --- a/testsuite/tests/parser/should_compile/T20718b.stderr +++ b/testsuite/tests/parser/should_compile/T20718b.stderr @@ -4,67 +4,70 @@ (L { T20718b.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T20718b.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T20718b.hs:4:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T20718b.hs:4:16-20 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - [])) - (EpaCommentsBalanced - [(L - (Anchor - { T20718b.hs:1:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- header comment 1") - { T20718b.hs:1:1 })) - ,(L - (Anchor - { T20718b.hs:2:1-19 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- header comment 2") - { T20718b.hs:1:1-19 })) - ,(L - (Anchor - { T20718b.hs:6:1-21 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- trailing comment 1") - { T20718b.hs:4:16-20 })) - ,(L - (Anchor - { T20718b.hs:7:1-21 } - (UnchangedAnchor)) - (EpaComment - (EpaLineComment - "-- trailing comment 2") - { T20718b.hs:6:1-21 }))] - [(L - (Anchor - { T20718b.hs:8:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T20718b.hs:7:1-21 }))])) - (VirtualBraces - (1)) + (XModulePs + (EpAnn + (Anchor + { T20718b.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T20718b.hs:4:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T20718b.hs:4:16-20 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { T20718b.hs:1:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- header comment 1") + { T20718b.hs:1:1 })) + ,(L + (Anchor + { T20718b.hs:2:1-19 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- header comment 2") + { T20718b.hs:1:1-19 })) + ,(L + (Anchor + { T20718b.hs:6:1-21 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- trailing comment 1") + { T20718b.hs:4:16-20 })) + ,(L + (Anchor + { T20718b.hs:7:1-21 } + (UnchangedAnchor)) + (EpaComment + (EpaLineComment + "-- trailing comment 2") + { T20718b.hs:6:1-21 }))] + [(L + (Anchor + { T20718b.hs:8:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T20718b.hs:7:1-21 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20718b.hs:4:8-14 }) {ModuleName: T20718b})) (Nothing) [] - [] - (Nothing) - (Nothing))) + [])) + + diff --git a/testsuite/tests/parser/should_compile/T20846.stderr b/testsuite/tests/parser/should_compile/T20846.stderr index 775531c619..5d2cf5c0ea 100644 --- a/testsuite/tests/parser/should_compile/T20846.stderr +++ b/testsuite/tests/parser/should_compile/T20846.stderr @@ -4,30 +4,33 @@ (L { T20846.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T20846.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T20846.hs:1:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T20846.hs:1:15-19 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { T20846.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T20846.hs:1:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T20846.hs:1:15-19 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { T20846.hs:5:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T20846.hs:5:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { T20846.hs:5:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T20846.hs:5:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T20846.hs:1:8-13 }) @@ -149,8 +152,6 @@ {OccName: undefined}))))))] (EmptyLocalBinds (NoExtField)))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/testsuite/tests/plugins/plugins01.hs b/testsuite/tests/plugins/plugins01.hs index 7bb2ec7e2e..f39f7fc9f9 100644 --- a/testsuite/tests/plugins/plugins01.hs +++ b/testsuite/tests/plugins/plugins01.hs @@ -12,4 +12,4 @@ theMessage = "Wrong" main = do putStrLn "Program Started" putStrLn theMessage - putStrLn "Program Ended"
\ No newline at end of file + putStrLn "Program Ended" diff --git a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs index 24ed240cfc..778d0974e0 100644 --- a/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs +++ b/testsuite/tests/plugins/simple-plugin/Simple/RemovePlugin.hs @@ -33,8 +33,8 @@ parsedPlugin [name, "parse"] _ (ParsedResult pm msgs) = return (ParsedResult pm { hpm_module = removeParsedBinding name (hpm_module pm) } msgs) parsedPlugin _ _ parsed = return parsed -removeParsedBinding :: String -> Located HsModule - -> Located HsModule +removeParsedBinding :: String -> Located (HsModule GhcPs) + -> Located (HsModule GhcPs) removeParsedBinding name (L l m) = (L l (m { hsmodDecls = filter (notNamedAs name) (hsmodDecls m) } )) where notNamedAs name (L _ (ValD _ (FunBind { fun_id = L _ fid }))) diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr index 8d3588e7ec..f4264de86d 100644 --- a/testsuite/tests/printer/T18791.stderr +++ b/testsuite/tests/printer/T18791.stderr @@ -4,30 +4,33 @@ (L { T18791.hs:1:1 } (HsModule - (EpAnn - (Anchor - { T18791.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { T18791.hs:2:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:2:15-19 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) + (XModulePs + (EpAnn + (Anchor + { T18791.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { T18791.hs:2:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:2:15-19 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced [] - [])) - (EpaCommentsBalanced - [] - [(L - (Anchor - { T18791.hs:6:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { T18791.hs:6:1 }))])) - (VirtualBraces - (1)) + [(L + (Anchor + { T18791.hs:6:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { T18791.hs:6:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { T18791.hs:2:8-13 }) @@ -136,8 +139,6 @@ (Unqual {OccName: T})))) (Nothing)))] - []))))] - (Nothing) - (Nothing))) + []))))])) diff --git a/testsuite/tests/printer/Test20297.stdout b/testsuite/tests/printer/Test20297.stdout index 2328e8201c..9bda031e23 100644 --- a/testsuite/tests/printer/Test20297.stdout +++ b/testsuite/tests/printer/Test20297.stdout @@ -4,37 +4,40 @@ (L { Test20297.hs:1:1 } (HsModule - (EpAnn - (Anchor - { Test20297.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { Test20297.hs:2:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { Test20297.hs:2:18-22 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - [])) - (EpaCommentsBalanced - [(L - (Anchor - { Test20297.hs:1:1-33 } - (UnchangedAnchor)) - (EpaComment - (EpaBlockComment - "{-# OPTIONS -ddump-parsed-ast #-}") - { Test20297.hs:1:1 }))] - [(L - (Anchor - { Test20297.hs:12:1 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { Test20297.hs:12:1 }))])) - (VirtualBraces - (1)) + (XModulePs + (EpAnn + (Anchor + { Test20297.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { Test20297.hs:2:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { Test20297.hs:2:18-22 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { Test20297.hs:1:1-33 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{-# OPTIONS -ddump-parsed-ast #-}") + { Test20297.hs:1:1 }))] + [(L + (Anchor + { Test20297.hs:12:1 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { Test20297.hs:12:1 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { Test20297.hs:2:8-16 }) @@ -342,9 +345,7 @@ (NoExtField)))))])) []))]} [])))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) @@ -353,37 +354,40 @@ (L { Test20297.ppr.hs:1:1 } (HsModule - (EpAnn - (Anchor - { Test20297.ppr.hs:1:1 } - (UnchangedAnchor)) - (AnnsModule - [(AddEpAnn AnnModule (EpaSpan { Test20297.ppr.hs:2:1-6 })) - ,(AddEpAnn AnnWhere (EpaSpan { Test20297.ppr.hs:2:18-22 }))] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - [])) - (EpaCommentsBalanced - [(L - (Anchor - { Test20297.ppr.hs:1:1-33 } - (UnchangedAnchor)) - (EpaComment - (EpaBlockComment - "{-# OPTIONS -ddump-parsed-ast #-}") - { Test20297.ppr.hs:1:1 }))] - [(L - (Anchor - { Test20297.ppr.hs:9:25 } - (UnchangedAnchor)) - (EpaComment - (EpaEofComment) - { Test20297.ppr.hs:9:20 }))])) - (VirtualBraces - (1)) + (XModulePs + (EpAnn + (Anchor + { Test20297.ppr.hs:1:1 } + (UnchangedAnchor)) + (AnnsModule + [(AddEpAnn AnnModule (EpaSpan { Test20297.ppr.hs:2:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { Test20297.ppr.hs:2:18-22 }))] + (AnnList + (Nothing) + (Nothing) + (Nothing) + [] + [])) + (EpaCommentsBalanced + [(L + (Anchor + { Test20297.ppr.hs:1:1-33 } + (UnchangedAnchor)) + (EpaComment + (EpaBlockComment + "{-# OPTIONS -ddump-parsed-ast #-}") + { Test20297.ppr.hs:1:1 }))] + [(L + (Anchor + { Test20297.ppr.hs:9:25 } + (UnchangedAnchor)) + (EpaComment + (EpaEofComment) + { Test20297.ppr.hs:9:20 }))])) + (VirtualBraces + (1)) + (Nothing) + (Nothing)) (Just (L (SrcSpanAnn (EpAnnNotUsed) { Test20297.ppr.hs:2:8-16 }) @@ -670,8 +674,6 @@ (NoExtField)))))])) []))]} [])))))])) - [])))] - (Nothing) - (Nothing))) + [])))])) diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 9d5f932f1e..1255d492e0 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -398,11 +398,11 @@ instance (ExactPrint a) => ExactPrint (Maybe a) where -- --------------------------------------------------------------------- -- | 'Located (HsModule GhcPs)' corresponds to 'ParsedSource' -instance ExactPrint HsModule where - getAnnotationEntry hsmod = fromAnn (hsmodAnn hsmod) +instance ExactPrint (HsModule GhcPs) where + getAnnotationEntry hsmod = fromAnn (hsmodAnn $ hsmodExt hsmod) - exact hsmod@(HsModule EpAnnNotUsed _ _ _ _ _ _ _) = withPpr hsmod - exact (HsModule an _lo mmn mexports imports decls mdeprec mbDoc) = do + exact hsmod@(HsModule (XModulePs EpAnnNotUsed _ _ _) _ _ _ _) = withPpr hsmod + exact (HsModule (XModulePs an _lo mdeprec mbDoc) mmn mexports imports decls) = do markAnnotated mbDoc @@ -760,9 +760,9 @@ instance ExactPrint (LocatedP (WarningTxt GhcPs)) where -- --------------------------------------------------------------------- instance ExactPrint (ImportDecl GhcPs) where - getAnnotationEntry idecl = fromAnn (ideclExt idecl) - exact x@(ImportDecl EpAnnNotUsed _ _ _ _ _ _ _ _ _) = withPpr x - exact (ImportDecl ann@(EpAnn _ an _) msrc modname mpkg _src safeflag qualFlag _impl mAs hiding) = do + getAnnotationEntry idecl = fromAnn (ideclAnn $ ideclExt idecl) + exact x@(ImportDecl{ ideclExt = XImportDeclPass{ ideclAnn = EpAnnNotUsed } }) = withPpr x + exact (ImportDecl (XImportDeclPass ann@(EpAnn _ an _) msrc _impl) modname mpkg _src safeflag qualFlag mAs hiding) = do markAnnKw ann importDeclAnnImport AnnImport @@ -3515,10 +3515,10 @@ instance ExactPrint (IE GhcPs) where -- --------------------------------------------------------------------- -instance ExactPrint (IEWrappedName RdrName) where +instance ExactPrint (IEWrappedName GhcPs) where getAnnotationEntry = const NoEntryVal - exact (IEName n) = markAnnotated n + exact (IEName _ n) = markAnnotated n exact (IEPattern r n) = do printStringAtAA r "pattern" markAnnotated n diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index f017233da5..8e79de24b3 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -883,8 +883,8 @@ addHiding1 _libdir (L l p) = do [L li imp1,imp2] = hsmodImports p n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1")) n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2")) - v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName n1))) - v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName n2))) + v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName noExtField n1))) + v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName noExtField n2))) impHiding = L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan l0) m0) (AnnList Nothing (Just (AddEpAnn AnnOpenP d1)) @@ -892,7 +892,7 @@ addHiding1 _libdir (L l p) = do [(AddEpAnn AnnHiding d1)] []) emptyComments) l0) [v1,v2] - imp1' = imp1 { ideclHiding = Just (True,impHiding)} + imp1' = imp1 { ideclImportList = Just (EverythingBut,impHiding)} p' = p { hsmodImports = [L li imp1',imp2]} return (L l p') @@ -909,7 +909,7 @@ addHiding2 _libdir (L l p) = do l2 <- uniqueSrcSpanT let [L li imp1] = hsmodImports p - Just (_,L lh ns) = ideclHiding imp1 + Just (_,L lh ns) = ideclImportList imp1 lh' = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan (locA lh)) m0) (AnnList Nothing (Just (AddEpAnn AnnOpenP d1)) @@ -919,11 +919,11 @@ addHiding2 _libdir (L l p) = do emptyComments) (locA lh)) n1 = L (noAnnSrcSpanDP0 l1) (mkVarUnqual (mkFastString "n1")) n2 = L (noAnnSrcSpanDP0 l2) (mkVarUnqual (mkFastString "n2")) - v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName n1))) - v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName n2))) + v1 = L (addComma $ noAnnSrcSpanDP0 l1) (IEVar noExtField (L (noAnnSrcSpanDP0 l1) (IEName noExtField n1))) + v2 = L ( noAnnSrcSpanDP0 l2) (IEVar noExtField (L (noAnnSrcSpanDP0 l2) (IEName noExtField n2))) L ln n = last ns n' = L (addComma ln) n - imp1' = imp1 { ideclHiding = Just (True,L lh' (init ns ++ [n',v1,v2]))} + imp1' = imp1 { ideclImportList = Just (EverythingBut, L lh' (init ns ++ [n',v1,v2]))} p' = p { hsmodImports = [L li imp1']} return (L l p') diff --git a/utils/check-exact/Parsers.hs b/utils/check-exact/Parsers.hs index b592a4cee4..e631d43314 100644 --- a/utils/check-exact/Parsers.hs +++ b/utils/check-exact/Parsers.hs @@ -119,7 +119,7 @@ withDynFlags libdir action = ghcWrapper libdir $ do -- --------------------------------------------------------------------- -parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located GHC.HsModule) +parseFile :: GHC.DynFlags -> FilePath -> String -> GHC.ParseResult (GHC.Located (GHC.HsModule GHC.GhcPs)) parseFile = runParser GHC.parseModule -- --------------------------------------------------------------------- @@ -275,10 +275,10 @@ postParseTransform parseRes = fmap mkAnns parseRes fixModuleTrailingComments :: GHC.ParsedSource -> GHC.ParsedSource fixModuleTrailingComments (GHC.L l p) = GHC.L l p' where - an' = case GHC.hsmodAnn p of + an' = case GHC.hsmodAnn $ GHC.hsmodExt p of (GHC.EpAnn a an ocs) -> GHC.EpAnn a an (rebalance (GHC.am_decls an) ocs) unused -> unused - p' = p { GHC.hsmodAnn = an' } + p' = p { GHC.hsmodExt = (GHC.hsmodExt p){ GHC.hsmodAnn = an' } } -- p' = error $ "fixModuleTrailingComments: an'=" ++ showAst an' rebalance :: GHC.AnnList -> GHC.EpAnnComments -> GHC.EpAnnComments diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs index fec7a32068..08b335291c 100644 --- a/utils/check-exact/Transform.hs +++ b/utils/check-exact/Transform.hs @@ -979,7 +979,7 @@ moveTrailingComments first second = do -- --------------------------------------------------------------------- anchorEof :: ParsedSource -> ParsedSource -anchorEof (L l m@(HsModule an _lo _mn _exps _imps _decls _ _)) = L l (m { hsmodAnn = an' }) +anchorEof (L l m@(HsModule (XModulePs an _lo _ _) _mn _exps _imps _decls)) = L l (m { hsmodExt = (hsmodExt m){ hsmodAnn = an' } }) where an' = addCommentOrigDeltasAnn an @@ -1128,12 +1128,12 @@ class (Data t) => HasDecls t where -- --------------------------------------------------------------------- instance HasDecls ParsedSource where - hsDecls (L _ (HsModule _ _lo _mn _exps _imps decls _ _)) = return decls - replaceDecls (L l (HsModule a lo mname exps imps _decls deps haddocks)) decls + hsDecls (L _ (HsModule (XModulePs _ _lo _ _) _mn _exps _imps decls)) = return decls + replaceDecls (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps _decls)) decls = do logTr "replaceDecls LHsModule" -- modifyAnnsT (captureOrder m decls) - return (L l (HsModule a lo mname exps imps decls deps haddocks)) + return (L l (HsModule (XModulePs a lo deps haddocks) mname exps imps decls)) -- --------------------------------------------------------------------- diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs index 4f94222370..3f16407175 100644 --- a/utils/check-exact/Utils.hs +++ b/utils/check-exact/Utils.hs @@ -229,10 +229,10 @@ insertCppComments :: ParsedSource -> [LEpaComment] -> ParsedSource insertCppComments (L l p) cs = L l p' where ncs = EpaComments cs - an' = case GHC.hsmodAnn p of + an' = case GHC.hsmodAnn $ GHC.hsmodExt p of (EpAnn a an ocs) -> EpAnn a an (ocs <> ncs) unused -> unused - p' = p { GHC.hsmodAnn = an' } + p' = p { GHC.hsmodExt = (GHC.hsmodExt p) { GHC.hsmodAnn = an' } } -- --------------------------------------------------------------------- diff --git a/utils/check-ppr/Main.hs b/utils/check-ppr/Main.hs index 47b3fe3bbf..9758889052 100644 --- a/utils/check-ppr/Main.hs +++ b/utils/check-ppr/Main.hs @@ -90,8 +90,8 @@ parseOneFile libdir fileName = do Left _err -> error "parseOneFile" Right ms -> parseModule ms -getPragmas :: Located HsModule -> String -getPragmas (L _ (HsModule { hsmodAnn = anns'})) = pragmaStr +getPragmas :: Located (HsModule GhcPs) -> String +getPragmas (L _ (HsModule { hsmodExt = XModulePs { hsmodAnn = anns' } })) = pragmaStr where tokComment (L _ (EpaComment (EpaBlockComment s) _)) = s tokComment (L _ (EpaComment (EpaLineComment s) _)) = s diff --git a/utils/haddock b/utils/haddock -Subproject 89afef9daeb6da6624d42d32813d86c1f9b9f0c +Subproject 8976930748c4c9ba19cede2f0f29037d1cbce5e |