diff options
| author | Alan Zimmerman <alan.zimm@gmail.com> | 2021-04-15 20:57:54 +0100 |
|---|---|---|
| committer | Alan Zimmerman <alan.zimm@gmail.com> | 2021-04-18 18:17:19 +0100 |
| commit | 9bd8f0f232067ef805d079315ba54e12b12bef46 (patch) | |
| tree | fcb4a703c3879835ed62f712f08e9ff391ab88ee | |
| parent | 0a8c14bd5a5438b1d042ad279b8ffff1bc867e7e (diff) | |
| download | haskell-wip/az/T19579.tar.gz | |
EPA: cleanups after the mergewip/az/T19579
Remove EpaAnn type synonym, rename EpaAnn' to EpaAnn.
Closes #19705
Updates haddock submodule
--
Change
data EpaAnchor = AR RealSrcSpan
| AD DeltaPos
To instead be
data EpaAnchor = AnchorReal RealSrcSpan
| AnchorDelta DeltaPos
Closes #19699
--
Change
data DeltaPos =
DP
{ deltaLine :: !Int,
deltaColumn :: !Int
}
To instead be
data DeltaPos
= SameLine { deltaColumn :: !Int }
| DifferentLine { deltaLine :: !Int, startColumn :: !Int }
Closes #19698
--
Also some clean-ups of unused parts of check-exact.
35 files changed, 884 insertions, 1123 deletions
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs index 17825119e7..0de279e597 100644 --- a/compiler/GHC/Hs.hs +++ b/compiler/GHC/Hs.hs @@ -69,7 +69,7 @@ import Data.Data hiding ( Fixity ) -- All we actually declare here is the top-level structure for a module. data HsModule = HsModule { - hsmodAnn :: EpAnn' AnnsModule, + hsmodAnn :: EpAnn AnnsModule, hsmodLayout :: LayoutInfo, -- ^ Layout info for the module. -- For incomplete modules (e.g. the output of parseHeader), it is NoLayoutInfo. diff --git a/compiler/GHC/Hs/Binds.hs b/compiler/GHC/Hs/Binds.hs index 72f54828ee..6c2ed3c167 100644 --- a/compiler/GHC/Hs/Binds.hs +++ b/compiler/GHC/Hs/Binds.hs @@ -69,8 +69,8 @@ Global bindings (where clauses) -- the ...LR datatypes are parametrized by two id types, -- one for the left and one for the right. -type instance XHsValBinds (GhcPass pL) (GhcPass pR) = EpAnn' AnnList -type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = EpAnn' AnnList +type instance XHsValBinds (GhcPass pL) (GhcPass pR) = EpAnn AnnList +type instance XHsIPBinds (GhcPass pL) (GhcPass pR) = EpAnn AnnList type instance XEmptyLocalBinds (GhcPass pL) (GhcPass pR) = NoExtField type instance XXHsLocalBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon @@ -93,7 +93,7 @@ type instance XFunBind (GhcPass pL) GhcPs = NoExtField type instance XFunBind (GhcPass pL) GhcRn = NameSet -- Free variables type instance XFunBind (GhcPass pL) GhcTc = HsWrapper -- See comments on FunBind.fun_ext -type instance XPatBind GhcPs (GhcPass pR) = EpAnn +type instance XPatBind GhcPs (GhcPass pR) = EpAnn [AddEpAnn] type instance XPatBind GhcRn (GhcPass pR) = NameSet -- Free variables type instance XPatBind GhcTc (GhcPass pR) = Type -- Type of the GRHSs @@ -105,7 +105,7 @@ type instance XXHsBindsLR (GhcPass pL) (GhcPass pR) = NoExtCon type instance XABE (GhcPass p) = NoExtField type instance XXABExport (GhcPass p) = NoExtCon -type instance XPSB (GhcPass idL) GhcPs = EpAnn +type instance XPSB (GhcPass idL) GhcPs = EpAnn [AddEpAnn] type instance XPSB (GhcPass idL) GhcRn = NameSet type instance XPSB (GhcPass idL) GhcTc = NameSet @@ -552,7 +552,7 @@ isEmptyIPBindsPR (IPBinds _ is) = null is isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds -type instance XCIPBind (GhcPass p) = EpAnn +type instance XCIPBind (GhcPass p) = EpAnn [AddEpAnn] type instance XXIPBind (GhcPass p) = NoExtCon instance OutputableBndrId p @@ -574,17 +574,17 @@ instance OutputableBndrId p => Outputable (IPBind (GhcPass p)) where ************************************************************************ -} -type instance XTypeSig (GhcPass p) = EpAnn' AnnSig -type instance XPatSynSig (GhcPass p) = EpAnn' AnnSig -type instance XClassOpSig (GhcPass p) = EpAnn' AnnSig +type instance XTypeSig (GhcPass p) = EpAnn AnnSig +type instance XPatSynSig (GhcPass p) = EpAnn AnnSig +type instance XClassOpSig (GhcPass p) = EpAnn AnnSig type instance XIdSig (GhcPass p) = NoExtField -- No anns, generated -type instance XFixSig (GhcPass p) = EpAnn -type instance XInlineSig (GhcPass p) = EpAnn -type instance XSpecSig (GhcPass p) = EpAnn -type instance XSpecInstSig (GhcPass p) = EpAnn -type instance XMinimalSig (GhcPass p) = EpAnn -type instance XSCCFunSig (GhcPass p) = EpAnn -type instance XCompleteMatchSig (GhcPass p) = EpAnn +type instance XFixSig (GhcPass p) = EpAnn [AddEpAnn] +type instance XInlineSig (GhcPass p) = EpAnn [AddEpAnn] +type instance XSpecSig (GhcPass p) = EpAnn [AddEpAnn] +type instance XSpecInstSig (GhcPass p) = EpAnn [AddEpAnn] +type instance XMinimalSig (GhcPass p) = EpAnn [AddEpAnn] +type instance XSCCFunSig (GhcPass p) = EpAnn [AddEpAnn] +type instance XCompleteMatchSig (GhcPass p) = EpAnn [AddEpAnn] type instance XXSig (GhcPass p) = NoExtCon diff --git a/compiler/GHC/Hs/Decls.hs b/compiler/GHC/Hs/Decls.hs index b3eac48499..9f3f6469e5 100644 --- a/compiler/GHC/Hs/Decls.hs +++ b/compiler/GHC/Hs/Decls.hs @@ -325,22 +325,22 @@ instance OutputableBndrId p type instance XFamDecl (GhcPass _) = NoExtField -type instance XSynDecl GhcPs = EpAnn +type instance XSynDecl GhcPs = EpAnn [AddEpAnn] type instance XSynDecl GhcRn = NameSet -- FVs type instance XSynDecl GhcTc = NameSet -- FVs -type instance XDataDecl GhcPs = EpAnn -- AZ: used? +type instance XDataDecl GhcPs = EpAnn [AddEpAnn] -- AZ: used? type instance XDataDecl GhcRn = DataDeclRn type instance XDataDecl GhcTc = DataDeclRn -type instance XClassDecl GhcPs = (EpAnn, AnnSortKey, LayoutInfo) -- See Note [Class LayoutInfo] +type instance XClassDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey, LayoutInfo) -- See Note [Class LayoutInfo] -- TODO:AZ:tidy up AnnSortKey above type instance XClassDecl GhcRn = NameSet -- FVs type instance XClassDecl GhcTc = NameSet -- FVs type instance XXTyClDecl (GhcPass _) = NoExtCon -type instance XCTyFamInstDecl (GhcPass _) = EpAnn +type instance XCTyFamInstDecl (GhcPass _) = EpAnn [AddEpAnn] type instance XXTyFamInstDecl (GhcPass _) = NoExtCon -- Dealing with names @@ -463,7 +463,7 @@ pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_ND = nd } }) instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where ppr = pprFunDep -type instance XCFunDep (GhcPass _) = EpAnn +type instance XCFunDep (GhcPass _) = EpAnn [AddEpAnn] type instance XXFunDep (GhcPass _) = NoExtCon pprFundeps :: OutputableBndrId p => [FunDep (GhcPass p)] -> SDoc @@ -497,7 +497,7 @@ type instance XCKindSig (GhcPass _) = NoExtField type instance XTyVarSig (GhcPass _) = NoExtField type instance XXFamilyResultSig (GhcPass _) = NoExtCon -type instance XCFamilyDecl (GhcPass _) = EpAnn +type instance XCFamilyDecl (GhcPass _) = EpAnn [AddEpAnn] type instance XXFamilyDecl (GhcPass _) = NoExtCon @@ -524,7 +524,7 @@ resultVariableName _ = Nothing ------------- Pretty printing FamilyDecls ----------- -type instance XCInjectivityAnn (GhcPass _) = EpAnn +type instance XCInjectivityAnn (GhcPass _) = EpAnn [AddEpAnn] type instance XXInjectivityAnn (GhcPass _) = NoExtCon instance OutputableBndrId p @@ -568,10 +568,10 @@ instance OutputableBndrId p * * ********************************************************************* -} -type instance XCHsDataDefn (GhcPass _) = EpAnn +type instance XCHsDataDefn (GhcPass _) = EpAnn [AddEpAnn] type instance XXHsDataDefn (GhcPass _) = NoExtCon -type instance XCHsDerivingClause (GhcPass _) = EpAnn +type instance XCHsDerivingClause (GhcPass _) = EpAnn [AddEpAnn] type instance XXHsDerivingClause (GhcPass _) = NoExtCon instance OutputableBndrId p @@ -598,7 +598,7 @@ instance OutputableBndrId p => Outputable (DerivClauseTys (GhcPass p)) where ppr (DctSingle _ ty) = ppr ty ppr (DctMulti _ tys) = parens (interpp'SP tys) -type instance XStandaloneKindSig GhcPs = EpAnn +type instance XStandaloneKindSig GhcPs = EpAnn [AddEpAnn] type instance XStandaloneKindSig GhcRn = NoExtField type instance XStandaloneKindSig GhcTc = NoExtField @@ -607,8 +607,8 @@ type instance XXStandaloneKindSig (GhcPass p) = NoExtCon standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p) standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname -type instance XConDeclGADT (GhcPass _) = EpAnn -type instance XConDeclH98 (GhcPass _) = EpAnn +type instance XConDeclGADT (GhcPass _) = EpAnn [AddEpAnn] +type instance XConDeclH98 (GhcPass _) = EpAnn [AddEpAnn] type instance XXConDecl (GhcPass _) = NoExtCon @@ -724,14 +724,14 @@ ppr_con_names = pprWithCommas (pprPrefixOcc . unLoc) ************************************************************************ -} -type instance XCFamEqn (GhcPass _) r = EpAnn +type instance XCFamEqn (GhcPass _) r = EpAnn [AddEpAnn] type instance XXFamEqn (GhcPass _) r = NoExtCon type instance Anno (FamEqn (GhcPass p) _) = SrcSpanAnnA ----------------- Class instances ------------- -type instance XCClsInstDecl GhcPs = (EpAnn, AnnSortKey) -- TODO:AZ:tidy up +type instance XCClsInstDecl GhcPs = (EpAnn [AddEpAnn], AnnSortKey) -- TODO:AZ:tidy up type instance XCClsInstDecl GhcRn = NoExtField type instance XCClsInstDecl GhcTc = NoExtField @@ -741,7 +741,7 @@ type instance XXClsInstDecl (GhcPass _) = NoExtCon type instance XClsInstD (GhcPass _) = NoExtField -type instance XDataFamInstD GhcPs = EpAnn +type instance XDataFamInstD GhcPs = EpAnn [AddEpAnn] type instance XDataFamInstD GhcRn = NoExtField type instance XDataFamInstD GhcTc = NoExtField @@ -887,7 +887,7 @@ instDeclDataFamInsts inst_decls ************************************************************************ -} -type instance XCDerivDecl (GhcPass _) = EpAnn +type instance XCDerivDecl (GhcPass _) = EpAnn [AddEpAnn] type instance XXDerivDecl (GhcPass _) = NoExtCon type instance Anno OverlapMode = SrcSpanAnnP @@ -911,15 +911,15 @@ instance OutputableBndrId p ************************************************************************ -} -type instance XStockStrategy GhcPs = EpAnn +type instance XStockStrategy GhcPs = EpAnn [AddEpAnn] type instance XStockStrategy GhcRn = NoExtField type instance XStockStrategy GhcTc = NoExtField -type instance XAnyClassStrategy GhcPs = EpAnn +type instance XAnyClassStrategy GhcPs = EpAnn [AddEpAnn] type instance XAnyClassStrategy GhcRn = NoExtField type instance XAnyClassStrategy GhcTc = NoExtField -type instance XNewtypeStrategy GhcPs = EpAnn +type instance XNewtypeStrategy GhcPs = EpAnn [AddEpAnn] type instance XNewtypeStrategy GhcRn = NoExtField type instance XNewtypeStrategy GhcTc = NoExtField @@ -927,7 +927,7 @@ type instance XViaStrategy GhcPs = XViaStrategyPs type instance XViaStrategy GhcRn = LHsSigType GhcRn type instance XViaStrategy GhcTc = Type -data XViaStrategyPs = XViaStrategyPs EpAnn (LHsSigType GhcPs) +data XViaStrategyPs = XViaStrategyPs (EpAnn [AddEpAnn]) (LHsSigType GhcPs) instance OutputableBndrId p => Outputable (DerivStrategy (GhcPass p)) where @@ -966,7 +966,7 @@ mapDerivStrategy f ds = foldDerivStrategy ds (ViaStrategy . f) ds ************************************************************************ -} -type instance XCDefaultDecl GhcPs = EpAnn +type instance XCDefaultDecl GhcPs = EpAnn [AddEpAnn] type instance XCDefaultDecl GhcRn = NoExtField type instance XCDefaultDecl GhcTc = NoExtField @@ -985,11 +985,11 @@ instance OutputableBndrId p ************************************************************************ -} -type instance XForeignImport GhcPs = EpAnn +type instance XForeignImport GhcPs = EpAnn [AddEpAnn] type instance XForeignImport GhcRn = NoExtField type instance XForeignImport GhcTc = Coercion -type instance XForeignExport GhcPs = EpAnn +type instance XForeignExport GhcPs = EpAnn [AddEpAnn] type instance XForeignExport GhcRn = NoExtField type instance XForeignExport GhcTc = Coercion @@ -1012,13 +1012,13 @@ instance OutputableBndrId p ************************************************************************ -} -type instance XCRuleDecls GhcPs = EpAnn +type instance XCRuleDecls GhcPs = EpAnn [AddEpAnn] type instance XCRuleDecls GhcRn = NoExtField type instance XCRuleDecls GhcTc = NoExtField type instance XXRuleDecls (GhcPass _) = NoExtCon -type instance XHsRule GhcPs = EpAnn' HsRuleAnn +type instance XHsRule GhcPs = EpAnn HsRuleAnn type instance XHsRule GhcRn = HsRuleRn type instance XHsRule GhcTc = HsRuleRn @@ -1040,8 +1040,8 @@ data HsRuleAnn flattenRuleDecls :: [LRuleDecls (GhcPass p)] -> [LRuleDecl (GhcPass p)] flattenRuleDecls decls = concatMap (rds_rules . unLoc) decls -type instance XCRuleBndr (GhcPass _) = EpAnn -type instance XRuleBndrSig (GhcPass _) = EpAnn +type instance XCRuleBndr (GhcPass _) = EpAnn [AddEpAnn] +type instance XRuleBndrSig (GhcPass _) = EpAnn [AddEpAnn] type instance XXRuleBndr (GhcPass _) = NoExtCon instance (OutputableBndrId p) => Outputable (RuleDecls (GhcPass p)) where @@ -1079,13 +1079,13 @@ instance (OutputableBndrId p) => Outputable (RuleBndr (GhcPass p)) where ************************************************************************ -} -type instance XWarnings GhcPs = EpAnn +type instance XWarnings GhcPs = EpAnn [AddEpAnn] type instance XWarnings GhcRn = NoExtField type instance XWarnings GhcTc = NoExtField type instance XXWarnDecls (GhcPass _) = NoExtCon -type instance XWarning (GhcPass _) = EpAnn +type instance XWarning (GhcPass _) = EpAnn [AddEpAnn] type instance XXWarnDecl (GhcPass _) = NoExtCon @@ -1109,7 +1109,7 @@ instance OutputableBndrId p ************************************************************************ -} -type instance XHsAnnotation (GhcPass _) = EpAnn' AnnPragma +type instance XHsAnnotation (GhcPass _) = EpAnn AnnPragma type instance XXAnnDecl (GhcPass _) = NoExtCon instance (OutputableBndrId p) => Outputable (AnnDecl (GhcPass p)) where @@ -1131,7 +1131,7 @@ pprAnnProvenance (TypeAnnProvenance (L _ name)) ************************************************************************ -} -type instance XCRoleAnnotDecl GhcPs = EpAnn +type instance XCRoleAnnotDecl GhcPs = EpAnn [AddEpAnn] type instance XCRoleAnnotDecl GhcRn = NoExtField type instance XCRoleAnnotDecl GhcTc = NoExtField diff --git a/compiler/GHC/Hs/Dump.hs b/compiler/GHC/Hs/Dump.hs index 8a69ad0c60..9be0f96640 100644 --- a/compiler/GHC/Hs/Dump.hs +++ b/compiler/GHC/Hs/Dump.hs @@ -136,12 +136,13 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 BlankSrcSpanFile -> parens $ text "SourceText" <+> text src _ -> parens $ text "SourceText" <+> text "blanked" - epaAnchor :: EpaAnchor -> SDoc - epaAnchor (AR r) = parens $ text "AR" <+> realSrcSpan r - epaAnchor (AD d) = parens $ text "AD" <+> deltaPos d + epaAnchor :: EpaLocation -> SDoc + epaAnchor (EpaSpan r) = parens $ text "EpaSpan" <+> realSrcSpan r + epaAnchor (EpaDelta d) = parens $ text "EpaDelta" <+> deltaPos d deltaPos :: DeltaPos -> SDoc - deltaPos (DP l c) = parens $ text "DP" <+> ppr l <+> ppr c + deltaPos (SameLine c) = parens $ text "SameLine" <+> ppr c + deltaPos (DifferentLine l c) = parens $ text "DifferentLine" <+> ppr l <+> ppr c name :: Name -> SDoc name nm = braces $ text "Name:" <+> ppr nm @@ -223,38 +224,38 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 -- ------------------------- - annotation :: EpAnn -> SDoc - annotation = annotation' (text "EpAnn") + annotation :: EpAnn [AddEpAnn] -> SDoc + annotation = annotation' (text "EpAnn [AddEpAnn]") - annotationModule :: EpAnn' AnnsModule -> SDoc - annotationModule = annotation' (text "EpAnn' AnnsModule") + annotationModule :: EpAnn AnnsModule -> SDoc + annotationModule = annotation' (text "EpAnn AnnsModule") - annotationAddEpAnn :: EpAnn' AddEpAnn -> SDoc - annotationAddEpAnn = annotation' (text "EpAnn' AddEpAnn") + annotationAddEpAnn :: EpAnn AddEpAnn -> SDoc + annotationAddEpAnn = annotation' (text "EpAnn AddEpAnn") - annotationGrhsAnn :: EpAnn' GrhsAnn -> SDoc - annotationGrhsAnn = annotation' (text "EpAnn' GrhsAnn") + annotationGrhsAnn :: EpAnn GrhsAnn -> SDoc + annotationGrhsAnn = annotation' (text "EpAnn GrhsAnn") - annotationEpAnnHsCase :: EpAnn' EpAnnHsCase -> SDoc - annotationEpAnnHsCase = annotation' (text "EpAnn' EpAnnHsCase") + annotationEpAnnHsCase :: EpAnn EpAnnHsCase -> SDoc + annotationEpAnnHsCase = annotation' (text "EpAnn EpAnnHsCase") - annotationEpAnnHsLet :: EpAnn' AnnsLet -> SDoc - annotationEpAnnHsLet = annotation' (text "EpAnn' AnnsLet") + annotationEpAnnHsLet :: EpAnn AnnsLet -> SDoc + annotationEpAnnHsLet = annotation' (text "EpAnn AnnsLet") - annotationAnnList :: EpAnn' AnnList -> SDoc - annotationAnnList = annotation' (text "EpAnn' AnnList") + annotationAnnList :: EpAnn AnnList -> SDoc + annotationAnnList = annotation' (text "EpAnn AnnList") - annotationEpAnnImportDecl :: EpAnn' EpAnnImportDecl -> SDoc - annotationEpAnnImportDecl = annotation' (text "EpAnn' EpAnnImportDecl") + annotationEpAnnImportDecl :: EpAnn EpAnnImportDecl -> SDoc + annotationEpAnnImportDecl = annotation' (text "EpAnn EpAnnImportDecl") - annotationAnnParen :: EpAnn' AnnParen -> SDoc - annotationAnnParen = annotation' (text "EpAnn' AnnParen") + annotationAnnParen :: EpAnn AnnParen -> SDoc + annotationAnnParen = annotation' (text "EpAnn AnnParen") - annotationTrailingAnn :: EpAnn' TrailingAnn -> SDoc - annotationTrailingAnn = annotation' (text "EpAnn' TrailingAnn") + annotationTrailingAnn :: EpAnn TrailingAnn -> SDoc + annotationTrailingAnn = annotation' (text "EpAnn TrailingAnn") annotation' :: forall a .(Data a, Typeable a) - => SDoc -> EpAnn' a -> SDoc + => SDoc -> EpAnn a -> SDoc annotation' tag anns = case ba of BlankEpAnnotations -> parens (text "blanked:" <+> tag) NoBlankEpAnnotations -> parens $ text (showConstr (toConstr anns)) @@ -262,19 +263,19 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0 -- ------------------------- - srcSpanAnnA :: SrcSpanAnn' (EpAnn' AnnListItem) -> SDoc + srcSpanAnnA :: SrcSpanAnn' (EpAnn AnnListItem) -> SDoc srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA") - srcSpanAnnL :: SrcSpanAnn' (EpAnn' AnnList) -> SDoc + srcSpanAnnL :: SrcSpanAnn' (EpAnn AnnList) -> SDoc srcSpanAnnL = locatedAnn'' (text "SrcSpanAnnL") - srcSpanAnnP :: SrcSpanAnn' (EpAnn' AnnPragma) -> SDoc + srcSpanAnnP :: SrcSpanAnn' (EpAnn AnnPragma) -> SDoc srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP") - srcSpanAnnC :: SrcSpanAnn' (EpAnn' AnnContext) -> SDoc + srcSpanAnnC :: SrcSpanAnn' (EpAnn AnnContext) -> SDoc srcSpanAnnC = locatedAnn'' (text "SrcSpanAnnC") - srcSpanAnnN :: SrcSpanAnn' (EpAnn' NameAnn) -> SDoc + srcSpanAnnN :: SrcSpanAnn' (EpAnn NameAnn) -> SDoc srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN") locatedAnn'' :: forall a. (Typeable a, Data a) diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs index 436da995a7..bf415f7264 100644 --- a/compiler/GHC/Hs/Expr.hs +++ b/compiler/GHC/Hs/Expr.hs @@ -207,14 +207,14 @@ could only do that if the extension field was strict (#18764) -- API Annotations types data EpAnnHsCase = EpAnnHsCase - { hsCaseAnnCase :: EpaAnchor - , hsCaseAnnOf :: EpaAnchor + { hsCaseAnnCase :: EpaLocation + , hsCaseAnnOf :: EpaLocation , hsCaseAnnsRest :: [AddEpAnn] } deriving Data data EpAnnUnboundVar = EpAnnUnboundVar - { hsUnboundBackquotes :: (EpaAnchor, EpaAnchor) - , hsUnboundHole :: EpaAnchor + { hsUnboundBackquotes :: (EpaLocation, EpaLocation) + , hsUnboundHole :: EpaLocation } deriving Data type instance XVar (GhcPass _) = NoExtField @@ -232,7 +232,7 @@ type instance XOverLabel GhcTc = Void -- See Note [Constructor cannot occur type instance XVar (GhcPass _) = NoExtField -type instance XUnboundVar GhcPs = EpAnn' EpAnnUnboundVar +type instance XUnboundVar GhcPs = EpAnn EpAnnUnboundVar type instance XUnboundVar GhcRn = NoExtField type instance XUnboundVar GhcTc = HoleExprRef -- We really don't need the whole HoleExprRef; just the IORef EvTerm @@ -248,7 +248,7 @@ type instance XLitE (GhcPass _) = EpAnnCO type instance XLam (GhcPass _) = NoExtField -type instance XLamCase (GhcPass _) = EpAnn +type instance XLamCase (GhcPass _) = EpAnn [AddEpAnn] type instance XApp (GhcPass _) = EpAnnCO type instance XAppTypeE GhcPs = SrcSpan -- Where the `@` lives @@ -257,7 +257,7 @@ type instance XAppTypeE GhcTc = Type -- OpApp not present in GhcTc pass; see GHC.Rename.Expr -- Note [Handling overloaded and rebindable constructs] -type instance XOpApp GhcPs = EpAnn +type instance XOpApp GhcPs = EpAnn [AddEpAnn] type instance XOpApp GhcRn = Fixity type instance XOpApp GhcTc = Void -- See Note [Constructor cannot occur] @@ -271,41 +271,41 @@ type instance XSectionL GhcTc = Void -- See Note [Constructor cannot occur type instance XSectionR GhcTc = Void -- See Note [Constructor cannot occur] -type instance XNegApp GhcPs = EpAnn +type instance XNegApp GhcPs = EpAnn [AddEpAnn] type instance XNegApp GhcRn = NoExtField type instance XNegApp GhcTc = NoExtField -type instance XPar (GhcPass _) = EpAnn' AnnParen +type instance XPar (GhcPass _) = EpAnn AnnParen -type instance XExplicitTuple GhcPs = EpAnn +type instance XExplicitTuple GhcPs = EpAnn [AddEpAnn] type instance XExplicitTuple GhcRn = NoExtField type instance XExplicitTuple GhcTc = NoExtField -type instance XExplicitSum GhcPs = EpAnn' AnnExplicitSum +type instance XExplicitSum GhcPs = EpAnn AnnExplicitSum type instance XExplicitSum GhcRn = NoExtField type instance XExplicitSum GhcTc = [Type] -type instance XCase GhcPs = EpAnn' EpAnnHsCase +type instance XCase GhcPs = EpAnn EpAnnHsCase type instance XCase GhcRn = NoExtField type instance XCase GhcTc = NoExtField -type instance XIf GhcPs = EpAnn +type instance XIf GhcPs = EpAnn [AddEpAnn] type instance XIf GhcRn = NoExtField type instance XIf GhcTc = NoExtField -type instance XMultiIf GhcPs = EpAnn +type instance XMultiIf GhcPs = EpAnn [AddEpAnn] type instance XMultiIf GhcRn = NoExtField type instance XMultiIf GhcTc = Type -type instance XLet GhcPs = EpAnn' AnnsLet +type instance XLet GhcPs = EpAnn AnnsLet type instance XLet GhcRn = NoExtField type instance XLet GhcTc = NoExtField -type instance XDo GhcPs = EpAnn' AnnList +type instance XDo GhcPs = EpAnn AnnList type instance XDo GhcRn = NoExtField type instance XDo GhcTc = Type -type instance XExplicitList GhcPs = EpAnn' AnnList +type instance XExplicitList GhcPs = EpAnn AnnList type instance XExplicitList GhcRn = NoExtField type instance XExplicitList GhcTc = Type -- GhcPs: ExplicitList includes all source-level @@ -316,11 +316,11 @@ type instance XExplicitList GhcTc = Type -- See Note [Handling overloaded and rebindable constructs] -- in GHC.Rename.Expr -type instance XRecordCon GhcPs = EpAnn +type instance XRecordCon GhcPs = EpAnn [AddEpAnn] type instance XRecordCon GhcRn = NoExtField type instance XRecordCon GhcTc = PostTcExpr -- Instantiated constructor function -type instance XRecordUpd GhcPs = EpAnn +type instance XRecordUpd GhcPs = EpAnn [AddEpAnn] type instance XRecordUpd GhcRn = NoExtField type instance XRecordUpd GhcTc = RecordUpdTc @@ -330,29 +330,29 @@ type instance XGetField GhcTc = Void -- HsGetField is eliminated by the renamer. See [Handling overloaded -- and rebindable constructs]. -type instance XProjection GhcPs = EpAnn' AnnProjection +type instance XProjection GhcPs = EpAnn AnnProjection type instance XProjection GhcRn = NoExtField type instance XProjection GhcTc = Void -- HsProjection is eliminated by the renamer. See [Handling overloaded -- and rebindable constructs]. -type instance XExprWithTySig GhcPs = EpAnn +type instance XExprWithTySig GhcPs = EpAnn [AddEpAnn] type instance XExprWithTySig GhcRn = NoExtField type instance XExprWithTySig GhcTc = NoExtField -type instance XArithSeq GhcPs = EpAnn +type instance XArithSeq GhcPs = EpAnn [AddEpAnn] type instance XArithSeq GhcRn = NoExtField type instance XArithSeq GhcTc = PostTcExpr -type instance XBracket (GhcPass _) = EpAnn +type instance XBracket (GhcPass _) = EpAnn [AddEpAnn] type instance XRnBracketOut (GhcPass _) = NoExtField type instance XTcBracketOut (GhcPass _) = NoExtField type instance XSpliceE (GhcPass _) = EpAnnCO -type instance XProc (GhcPass _) = EpAnn +type instance XProc (GhcPass _) = EpAnn [AddEpAnn] -type instance XStatic GhcPs = EpAnn +type instance XStatic GhcPs = EpAnn [AddEpAnn] type instance XStatic GhcRn = NameSet type instance XStatic GhcTc = NameSet @@ -378,40 +378,40 @@ data XXExprGhcTc data AnnExplicitSum = AnnExplicitSum { - aesOpen :: EpaAnchor, - aesBarsBefore :: [EpaAnchor], - aesBarsAfter :: [EpaAnchor], - aesClose :: EpaAnchor + aesOpen :: EpaLocation, + aesBarsBefore :: [EpaLocation], + aesBarsAfter :: [EpaLocation], + aesClose :: EpaLocation } deriving Data data AnnsLet = AnnsLet { - alLet :: EpaAnchor, - alIn :: EpaAnchor + alLet :: EpaLocation, + alIn :: EpaLocation } deriving Data data AnnFieldLabel = AnnFieldLabel { - afDot :: Maybe EpaAnchor + afDot :: Maybe EpaLocation } deriving Data data AnnProjection = AnnProjection { - apOpen :: EpaAnchor, -- ^ '(' - apClose :: EpaAnchor -- ^ ')' + apOpen :: EpaLocation, -- ^ '(' + apClose :: EpaLocation -- ^ ')' } deriving Data -- --------------------------------------------------------------------- -type instance XSCC (GhcPass _) = EpAnn' AnnPragma +type instance XSCC (GhcPass _) = EpAnn AnnPragma type instance XXPragE (GhcPass _) = NoExtCon -type instance XCHsFieldLabel (GhcPass _) = EpAnn' AnnFieldLabel +type instance XCHsFieldLabel (GhcPass _) = EpAnn AnnFieldLabel type instance XXHsFieldLabel (GhcPass _) = NoExtCon -type instance XPresent (GhcPass _) = EpAnn +type instance XPresent (GhcPass _) = EpAnn [AddEpAnn] -type instance XMissing GhcPs = EpAnn' EpaAnchor +type instance XMissing GhcPs = EpAnn EpaLocation type instance XMissing GhcRn = NoExtField type instance XMissing GhcTc = Scaled Type @@ -981,33 +981,33 @@ instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where ************************************************************************ -} -type instance XCmdArrApp GhcPs = EpAnn' AddEpAnn +type instance XCmdArrApp GhcPs = EpAnn AddEpAnn type instance XCmdArrApp GhcRn = NoExtField type instance XCmdArrApp GhcTc = Type -type instance XCmdArrForm GhcPs = EpAnn' AnnList +type instance XCmdArrForm GhcPs = EpAnn AnnList type instance XCmdArrForm GhcRn = NoExtField type instance XCmdArrForm GhcTc = NoExtField type instance XCmdApp (GhcPass _) = EpAnnCO type instance XCmdLam (GhcPass _) = NoExtField -type instance XCmdPar (GhcPass _) = EpAnn' AnnParen +type instance XCmdPar (GhcPass _) = EpAnn AnnParen -type instance XCmdCase GhcPs = EpAnn' EpAnnHsCase +type instance XCmdCase GhcPs = EpAnn EpAnnHsCase type instance XCmdCase GhcRn = NoExtField type instance XCmdCase GhcTc = NoExtField -type instance XCmdLamCase (GhcPass _) = EpAnn +type instance XCmdLamCase (GhcPass _) = EpAnn [AddEpAnn] -type instance XCmdIf GhcPs = EpAnn +type instance XCmdIf GhcPs = EpAnn [AddEpAnn] type instance XCmdIf GhcRn = NoExtField type instance XCmdIf GhcTc = NoExtField -type instance XCmdLet GhcPs = EpAnn' AnnsLet +type instance XCmdLet GhcPs = EpAnn AnnsLet type instance XCmdLet GhcRn = NoExtField type instance XCmdLet GhcTc = NoExtField -type instance XCmdDo GhcPs = EpAnn' AnnList +type instance XCmdDo GhcPs = EpAnn AnnList type instance XCmdDo GhcRn = NoExtField type instance XCmdDo GhcTc = Type @@ -1152,7 +1152,7 @@ type instance XMG GhcTc b = MatchGroupTc type instance XXMatchGroup (GhcPass _) b = NoExtCon -type instance XCMatch (GhcPass _) b = EpAnn +type instance XCMatch (GhcPass _) b = EpAnn [AddEpAnn] type instance XXMatch (GhcPass _) b = NoExtCon instance (OutputableBndrId pr, Outputable body) @@ -1186,11 +1186,11 @@ type instance XXGRHSs (GhcPass _) _ = NoExtCon data GrhsAnn = GrhsAnn { - ga_vbar :: Maybe EpaAnchor, -- TODO:AZ do we need this? + ga_vbar :: Maybe EpaLocation, -- TODO:AZ do we need this? ga_sep :: AddEpAnn -- ^ Match separator location } deriving (Data) -type instance XCGRHS (GhcPass _) _ = EpAnn' GrhsAnn +type instance XCGRHS (GhcPass _) _ = EpAnn GrhsAnn -- Location of matchSeparator -- TODO:AZ does this belong on the GRHS, or GRHSs? @@ -1304,7 +1304,7 @@ data RecStmtTc = type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExtField -type instance XBindStmt (GhcPass _) GhcPs b = EpAnn +type instance XBindStmt (GhcPass _) GhcPs b = EpAnn [AddEpAnn] type instance XBindStmt (GhcPass _) GhcRn b = XBindStmtRn type instance XBindStmt (GhcPass _) GhcTc b = XBindStmtTc @@ -1328,17 +1328,17 @@ type instance XBodyStmt (GhcPass _) GhcPs b = NoExtField type instance XBodyStmt (GhcPass _) GhcRn b = NoExtField type instance XBodyStmt (GhcPass _) GhcTc b = Type -type instance XLetStmt (GhcPass _) (GhcPass _) b = EpAnn +type instance XLetStmt (GhcPass _) (GhcPass _) b = EpAnn [AddEpAnn] type instance XParStmt (GhcPass _) GhcPs b = NoExtField type instance XParStmt (GhcPass _) GhcRn b = NoExtField type instance XParStmt (GhcPass _) GhcTc b = Type -type instance XTransStmt (GhcPass _) GhcPs b = EpAnn +type instance XTransStmt (GhcPass _) GhcPs b = EpAnn [AddEpAnn] type instance XTransStmt (GhcPass _) GhcRn b = NoExtField type instance XTransStmt (GhcPass _) GhcTc b = Type -type instance XRecStmt (GhcPass _) GhcPs b = EpAnn' AnnList +type instance XRecStmt (GhcPass _) GhcPs b = EpAnn AnnList type instance XRecStmt (GhcPass _) GhcRn b = NoExtField type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc @@ -1523,8 +1523,8 @@ pprQuals quals = interpp'SP quals newtype HsSplicedT = HsSplicedT DelayedSplice deriving (Data) -type instance XTypedSplice (GhcPass _) = EpAnn -type instance XUntypedSplice (GhcPass _) = EpAnn +type instance XTypedSplice (GhcPass _) = EpAnn [AddEpAnn] +type instance XUntypedSplice (GhcPass _) = EpAnn [AddEpAnn] type instance XQuasiQuote (GhcPass _) = NoExtField type instance XSpliced (GhcPass _) = NoExtField type instance XXSplice GhcPs = NoExtCon @@ -1838,6 +1838,6 @@ type instance Anno (HsSplice (GhcPass p)) = SrcSpanAnnA type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsExpr (GhcPass pr))))] = SrcSpanAnnL type instance Anno [LocatedA (StmtLR (GhcPass pl) (GhcPass pr) (LocatedA (HsCmd (GhcPass pr))))] = SrcSpanAnnL -instance (Anno a ~ SrcSpanAnn' (EpAnn' an)) +instance (Anno a ~ SrcSpanAnn' (EpAnn an)) => WrapXRec (GhcPass p) a where wrapXRec = noLocA diff --git a/compiler/GHC/Hs/Extension.hs b/compiler/GHC/Hs/Extension.hs index 1134e2520a..e28bcddbf1 100644 --- a/compiler/GHC/Hs/Extension.hs +++ b/compiler/GHC/Hs/Extension.hs @@ -101,7 +101,7 @@ type instance Anno RdrName = SrcSpanAnnN type instance Anno Name = SrcSpanAnnN type instance Anno Id = SrcSpanAnnN -type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ SrcSpanAnn' (EpAnn' a), +type IsSrcSpanAnn p a = ( Anno (IdGhcP p) ~ SrcSpanAnn' (EpAnn a), IsPass p) instance UnXRec (GhcPass p) where diff --git a/compiler/GHC/Hs/ImpExp.hs b/compiler/GHC/Hs/ImpExp.hs index 103359281b..55b5af7bc9 100644 --- a/compiler/GHC/Hs/ImpExp.hs +++ b/compiler/GHC/Hs/ImpExp.hs @@ -64,9 +64,9 @@ data ImportDeclQualifiedStyle -- | 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". -importDeclQualifiedStyle :: Maybe EpaAnchor - -> Maybe EpaAnchor - -> (Maybe EpaAnchor, ImportDeclQualifiedStyle) +importDeclQualifiedStyle :: Maybe EpaLocation + -> Maybe EpaLocation + -> (Maybe EpaLocation, ImportDeclQualifiedStyle) importDeclQualifiedStyle mPre mPost = if isJust mPre then (mPre, QualifiedPre) else if isJust mPost then (mPost,QualifiedPost) else (Nothing, NotQualified) @@ -113,7 +113,7 @@ data ImportDecl pass -- For details on above see note [exact print annotations] in GHC.Parser.Annotation -type instance XCImportDecl GhcPs = EpAnn' EpAnnImportDecl +type instance XCImportDecl GhcPs = EpAnn EpAnnImportDecl type instance XCImportDecl GhcRn = NoExtField type instance XCImportDecl GhcTc = NoExtField @@ -127,12 +127,12 @@ type instance Anno [LocatedA (IE (GhcPass p))] = SrcSpanAnnL -- API Annotations types data EpAnnImportDecl = EpAnnImportDecl - { importDeclAnnImport :: EpaAnchor - , importDeclAnnPragma :: Maybe (EpaAnchor, EpaAnchor) - , importDeclAnnSafe :: Maybe EpaAnchor - , importDeclAnnQualified :: Maybe EpaAnchor - , importDeclAnnPackage :: Maybe EpaAnchor - , importDeclAnnAs :: Maybe EpaAnchor + { importDeclAnnImport :: EpaLocation + , importDeclAnnPragma :: Maybe (EpaLocation, EpaLocation) + , importDeclAnnSafe :: Maybe EpaLocation + , importDeclAnnQualified :: Maybe EpaLocation + , importDeclAnnPackage :: Maybe EpaLocation + , importDeclAnnAs :: Maybe EpaLocation } deriving (Data) -- --------------------------------------------------------------------- @@ -208,9 +208,9 @@ instance (OutputableBndrId p -- 'GHC.Parser.Annotation' is the location of the adornment in -- the original source. data IEWrappedName name - = IEName (LocatedN name) -- ^ no extra - | IEPattern EpaAnchor (LocatedN name) -- ^ pattern X - | IEType EpaAnchor (LocatedN name) -- ^ type (:+:) + = IEName (LocatedN name) -- ^ no extra + | IEPattern EpaLocation (LocatedN name) -- ^ pattern X + | IEType EpaLocation (LocatedN name) -- ^ type (:+:) deriving (Eq,Data) -- | Located name with possible adornment @@ -286,15 +286,15 @@ type instance XIEVar GhcPs = NoExtField type instance XIEVar GhcRn = NoExtField type instance XIEVar GhcTc = NoExtField -type instance XIEThingAbs (GhcPass _) = EpAnn -type instance XIEThingAll (GhcPass _) = EpAnn +type instance XIEThingAbs (GhcPass _) = EpAnn [AddEpAnn] +type instance XIEThingAll (GhcPass _) = EpAnn [AddEpAnn] -- See Note [IEThingWith] -type instance XIEThingWith (GhcPass 'Parsed) = EpAnn +type instance XIEThingWith (GhcPass 'Parsed) = EpAnn [AddEpAnn] type instance XIEThingWith (GhcPass 'Renamed) = [Located FieldLabel] type instance XIEThingWith (GhcPass 'Typechecked) = NoExtField -type instance XIEModuleContents GhcPs = EpAnn +type instance XIEModuleContents GhcPs = EpAnn [AddEpAnn] type instance XIEModuleContents GhcRn = NoExtField type instance XIEModuleContents GhcTc = NoExtField diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs index 6efbfb860e..577321ea0a 100644 --- a/compiler/GHC/Hs/Pat.hs +++ b/compiler/GHC/Hs/Pat.hs @@ -95,55 +95,55 @@ type instance XWildPat GhcTc = Type type instance XVarPat (GhcPass _) = NoExtField -type instance XLazyPat GhcPs = EpAnn -- For '~' +type instance XLazyPat GhcPs = EpAnn [AddEpAnn] -- For '~' type instance XLazyPat GhcRn = NoExtField type instance XLazyPat GhcTc = NoExtField -type instance XAsPat GhcPs = EpAnn -- For '@' +type instance XAsPat GhcPs = EpAnn [AddEpAnn] -- For '@' type instance XAsPat GhcRn = NoExtField type instance XAsPat GhcTc = NoExtField -type instance XParPat (GhcPass _) = EpAnn' AnnParen +type instance XParPat (GhcPass _) = EpAnn AnnParen -type instance XBangPat GhcPs = EpAnn -- For '!' +type instance XBangPat GhcPs = EpAnn [AddEpAnn] -- For '!' type instance XBangPat GhcRn = NoExtField type instance XBangPat GhcTc = NoExtField -- Note: XListPat cannot be extended when using GHC 8.0.2 as the bootstrap -- compiler, as it triggers https://gitlab.haskell.org/ghc/ghc/issues/14396 for -- `SyntaxExpr` -type instance XListPat GhcPs = EpAnn' AnnList +type instance XListPat GhcPs = EpAnn AnnList type instance XListPat GhcRn = Maybe (SyntaxExpr GhcRn) type instance XListPat GhcTc = ListPatTc -type instance XTuplePat GhcPs = EpAnn +type instance XTuplePat GhcPs = EpAnn [AddEpAnn] type instance XTuplePat GhcRn = NoExtField type instance XTuplePat GhcTc = [Type] -type instance XSumPat GhcPs = EpAnn' EpAnnSumPat +type instance XSumPat GhcPs = EpAnn EpAnnSumPat type instance XSumPat GhcRn = NoExtField type instance XSumPat GhcTc = [Type] -type instance XConPat GhcPs = EpAnn +type instance XConPat GhcPs = EpAnn [AddEpAnn] type instance XConPat GhcRn = NoExtField type instance XConPat GhcTc = ConPatTc -type instance XViewPat GhcPs = EpAnn +type instance XViewPat GhcPs = EpAnn [AddEpAnn] type instance XViewPat GhcRn = NoExtField type instance XViewPat GhcTc = Type type instance XSplicePat (GhcPass _) = NoExtField type instance XLitPat (GhcPass _) = NoExtField -type instance XNPat GhcPs = EpAnn -type instance XNPat GhcRn = EpAnn +type instance XNPat GhcPs = EpAnn [AddEpAnn] +type instance XNPat GhcRn = EpAnn [AddEpAnn] type instance XNPat GhcTc = Type -type instance XNPlusKPat GhcPs = EpAnn +type instance XNPlusKPat GhcPs = EpAnn [AddEpAnn] type instance XNPlusKPat GhcRn = NoExtField type instance XNPlusKPat GhcTc = Type -type instance XSigPat GhcPs = EpAnn +type instance XSigPat GhcPs = EpAnn [AddEpAnn] type instance XSigPat GhcRn = NoExtField type instance XSigPat GhcTc = Type @@ -156,7 +156,7 @@ type instance ConLikeP GhcPs = RdrName -- IdP GhcPs type instance ConLikeP GhcRn = Name -- IdP GhcRn type instance ConLikeP GhcTc = ConLike -type instance XHsRecField _ = EpAnn +type instance XHsRecField _ = EpAnn [AddEpAnn] -- --------------------------------------------------------------------- @@ -164,8 +164,8 @@ type instance XHsRecField _ = EpAnn data EpAnnSumPat = EpAnnSumPat { sumPatParens :: [AddEpAnn] - , sumPatVbarsBefore :: [EpaAnchor] - , sumPatVbarsAfter :: [EpaAnchor] + , sumPatVbarsBefore :: [EpaLocation] + , sumPatVbarsAfter :: [EpaLocation] } deriving Data -- --------------------------------------------------------------------- diff --git a/compiler/GHC/Hs/Type.hs b/compiler/GHC/Hs/Type.hs index 9c494d6aa7..a666a87519 100644 --- a/compiler/GHC/Hs/Type.hs +++ b/compiler/GHC/Hs/Type.hs @@ -151,7 +151,7 @@ type instance XHsForAllInvis (GhcPass _) = EpAnnForallTy type instance XXHsForAllTelescope (GhcPass _) = NoExtCon -type EpAnnForallTy = EpAnn' (AddEpAnn, AddEpAnn) +type EpAnnForallTy = EpAnn (AddEpAnn, AddEpAnn) -- ^ Location of 'forall' and '->' for HsForAllVis -- Location of 'forall' and '.' for HsForAllInvis @@ -259,8 +259,8 @@ mkEmptyWildCardBndrs x = HsWC { hswc_body = x -------------------------------------------------- -type instance XUserTyVar (GhcPass _) = EpAnn -type instance XKindedTyVar (GhcPass _) = EpAnn +type instance XUserTyVar (GhcPass _) = EpAnn [AddEpAnn] +type instance XKindedTyVar (GhcPass _) = EpAnn [AddEpAnn] type instance XXTyVarBndr (GhcPass _) = NoExtCon @@ -285,17 +285,17 @@ instance NamedThing (HsTyVarBndr flag GhcRn) where type instance XForAllTy (GhcPass _) = NoExtField type instance XQualTy (GhcPass _) = NoExtField -type instance XTyVar (GhcPass _) = EpAnn +type instance XTyVar (GhcPass _) = EpAnn [AddEpAnn] type instance XAppTy (GhcPass _) = NoExtField -type instance XFunTy (GhcPass _) = EpAnn' TrailingAnn -- For the AnnRarrow or AnnLolly -type instance XListTy (GhcPass _) = EpAnn' AnnParen -type instance XTupleTy (GhcPass _) = EpAnn' AnnParen -type instance XSumTy (GhcPass _) = EpAnn' AnnParen +type instance XFunTy (GhcPass _) = EpAnn TrailingAnn -- For the AnnRarrow or AnnLolly +type instance XListTy (GhcPass _) = EpAnn AnnParen +type instance XTupleTy (GhcPass _) = EpAnn AnnParen +type instance XSumTy (GhcPass _) = EpAnn AnnParen type instance XOpTy (GhcPass _) = NoExtField -type instance XParTy (GhcPass _) = EpAnn' AnnParen -type instance XIParamTy (GhcPass _) = EpAnn +type instance XParTy (GhcPass _) = EpAnn AnnParen +type instance XIParamTy (GhcPass _) = EpAnn [AddEpAnn] type instance XStarTy (GhcPass _) = NoExtField -type instance XKindSig (GhcPass _) = EpAnn +type instance XKindSig (GhcPass _) = EpAnn [AddEpAnn] type instance XAppKindTy (GhcPass _) = SrcSpan -- Where the `@` lives @@ -303,18 +303,18 @@ type instance XSpliceTy GhcPs = NoExtField type instance XSpliceTy GhcRn = NoExtField type instance XSpliceTy GhcTc = Kind -type instance XDocTy (GhcPass _) = EpAnn -type instance XBangTy (GhcPass _) = EpAnn +type instance XDocTy (GhcPass _) = EpAnn [AddEpAnn] +type instance XBangTy (GhcPass _) = EpAnn [AddEpAnn] -type instance XRecTy GhcPs = EpAnn' AnnList +type instance XRecTy GhcPs = EpAnn AnnList type instance XRecTy GhcRn = NoExtField type instance XRecTy GhcTc = NoExtField -type instance XExplicitListTy GhcPs = EpAnn +type instance XExplicitListTy GhcPs = EpAnn [AddEpAnn] type instance XExplicitListTy GhcRn = NoExtField type instance XExplicitListTy GhcTc = Kind -type instance XExplicitTupleTy GhcPs = EpAnn +type instance XExplicitTupleTy GhcPs = EpAnn [AddEpAnn] type instance XExplicitTupleTy GhcRn = NoExtField type instance XExplicitTupleTy GhcTc = [Kind] @@ -354,7 +354,7 @@ pprHsArrow (HsUnrestrictedArrow _) = arrow pprHsArrow (HsLinearArrow _ _) = lollipop pprHsArrow (HsExplicitMult _ _ p) = (mulArrow (ppr p)) -type instance XConDeclField (GhcPass _) = EpAnn +type instance XConDeclField (GhcPass _) = EpAnn [AddEpAnn] type instance XXConDeclField (GhcPass _) = NoExtCon instance OutputableBndrId p @@ -494,7 +494,7 @@ splitHsFunType ty = go ty an' = addTrailingAnnToA l an cs a x' = L (SrcSpanAnn an' l) t - go other = ([], noCom, [], other) + go other = ([], emptyComments, [], other) -- | Retrieve the name of the \"head\" of a nested type application. -- This is somewhat like @GHC.Tc.Gen.HsType.splitHsAppTys@, but a little more diff --git a/compiler/GHC/Hs/Utils.hs b/compiler/GHC/Hs/Utils.hs index a23c1a1868..bf37398347 100644 --- a/compiler/GHC/Hs/Utils.hs +++ b/compiler/GHC/Hs/Utils.hs @@ -190,14 +190,14 @@ mkSimpleMatch ctxt pats rhs unguardedGRHSs :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan - => SrcSpan -> LocatedA (body (GhcPass p)) -> EpAnn' GrhsAnn + => SrcSpan -> LocatedA (body (GhcPass p)) -> EpAnn GrhsAnn -> GRHSs (GhcPass p) (LocatedA (body (GhcPass p))) unguardedGRHSs loc rhs an = GRHSs noExtField (unguardedRHS an loc rhs) emptyLocalBinds unguardedRHS :: Anno (GRHS (GhcPass p) (LocatedA (body (GhcPass p)))) ~ SrcSpan - => EpAnn' GrhsAnn -> SrcSpan -> LocatedA (body (GhcPass p)) + => EpAnn GrhsAnn -> SrcSpan -> LocatedA (body (GhcPass p)) -> [LGRHS (GhcPass p) (LocatedA (body (GhcPass p)))] unguardedRHS an loc rhs = [L loc (GRHS an [] rhs)] @@ -305,16 +305,16 @@ mkHsIntegral :: IntegralLit -> HsOverLit GhcPs mkHsFractional :: FractionalLit -> HsOverLit GhcPs mkHsIsString :: SourceText -> FastString -> HsOverLit GhcPs mkHsDo :: HsStmtContext GhcRn -> LocatedL [ExprLStmt GhcPs] -> HsExpr GhcPs -mkHsDoAnns :: HsStmtContext GhcRn -> LocatedL [ExprLStmt GhcPs] -> EpAnn' AnnList -> HsExpr GhcPs +mkHsDoAnns :: HsStmtContext GhcRn -> LocatedL [ExprLStmt GhcPs] -> EpAnn AnnList -> HsExpr GhcPs mkHsComp :: HsStmtContext GhcRn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> HsExpr GhcPs mkHsCompAnns :: HsStmtContext GhcRn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs - -> EpAnn' AnnList + -> EpAnn AnnList -> HsExpr GhcPs -mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpAnn +mkNPat :: Located (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpAnn [AddEpAnn] -> Pat GhcPs -mkNPlusKPat :: LocatedN RdrName -> Located (HsOverLit GhcPs) -> EpAnn +mkNPlusKPat :: LocatedN RdrName -> Located (HsOverLit GhcPs) -> EpAnn [AddEpAnn] -> Pat GhcPs -- NB: The following functions all use noSyntaxExpr: the generated expressions @@ -323,7 +323,7 @@ mkLastStmt :: IsPass idR => LocatedA (bodyR (GhcPass idR)) -> StmtLR (GhcPass idL) (GhcPass idR) (LocatedA (bodyR (GhcPass idR))) mkBodyStmt :: LocatedA (bodyR GhcPs) -> StmtLR (GhcPass idL) GhcPs (LocatedA (bodyR GhcPs)) -mkPsBindStmt :: EpAnn -> LPat GhcPs -> LocatedA (bodyR GhcPs) +mkPsBindStmt :: EpAnn [AddEpAnn] -> LPat GhcPs -> LocatedA (bodyR GhcPs) -> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs)) mkRnBindStmt :: LPat GhcRn -> LocatedA (bodyR GhcRn) -> StmtLR GhcRn GhcRn (LocatedA (bodyR GhcRn)) @@ -345,7 +345,7 @@ mkRecStmt :: (Anno [GenLocated (Anno (StmtLR (GhcPass idL) GhcPs bodyR)) (StmtLR (GhcPass idL) GhcPs bodyR)] ~ SrcSpanAnnL) - => EpAnn' AnnList + => EpAnn AnnList -> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR] -> StmtLR (GhcPass idL) GhcPs bodyR @@ -363,12 +363,12 @@ mkHsCompAnns ctxt stmts expr anns = mkHsDoAnns ctxt (mkLocatedList (stmts ++ [la last_stmt = L (noAnnSrcSpan $ getLocA expr) $ mkLastStmt expr -- restricted to GhcPs because other phases might need a SyntaxExpr -mkHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn +mkHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs mkHsIf c a b anns = HsIf anns c a b -- restricted to GhcPs because other phases might need a SyntaxExpr -mkHsCmdIf :: LHsExpr GhcPs -> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn +mkHsCmdIf :: LHsExpr GhcPs -> LHsCmd GhcPs -> LHsCmd GhcPs -> EpAnn [AddEpAnn] -> HsCmd GhcPs mkHsCmdIf c a b anns = HsCmdIf anns noSyntaxExpr c a b @@ -376,17 +376,17 @@ mkNPat lit neg anns = NPat anns lit neg noSyntaxExpr mkNPlusKPat id lit anns = NPlusKPat anns id lit (unLoc lit) noSyntaxExpr noSyntaxExpr -mkTransformStmt :: EpAnn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs +mkTransformStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -mkTransformByStmt :: EpAnn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs +mkTransformByStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -mkGroupUsingStmt :: EpAnn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs +mkGroupUsingStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -mkGroupByUsingStmt :: EpAnn -> [ExprLStmt GhcPs] -> LHsExpr GhcPs +mkGroupByUsingStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs -> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) -emptyTransStmt :: EpAnn -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) +emptyTransStmt :: EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs) emptyTransStmt anns = TransStmt { trS_ext = anns , trS_form = panic "emptyTransStmt: form" , trS_stmts = [], trS_bndrs = [] @@ -436,7 +436,7 @@ emptyRecStmtId = emptyRecStmt' unitRecStmtTc -- a panic might trigger during zonking mkRecStmt anns stmts = (emptyRecStmt' anns) { recS_stmts = stmts } -mkLetStmt :: EpAnn -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b) +mkLetStmt :: EpAnn [AddEpAnn] -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b) mkLetStmt anns binds = LetStmt anns binds ------------------------------- @@ -448,10 +448,10 @@ mkHsOpApp e1 op e2 = OpApp noAnn e1 (noLocA (HsVar noExtField (noLocA op))) e2 unqualSplice :: RdrName unqualSplice = mkRdrUnqual (mkVarOccFS (fsLit "splice")) -mkUntypedSplice :: EpAnn -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs +mkUntypedSplice :: EpAnn [AddEpAnn] -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs mkUntypedSplice ann hasParen e = HsUntypedSplice ann hasParen unqualSplice e -mkTypedSplice :: EpAnn -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs +mkTypedSplice :: EpAnn [AddEpAnn] -> SpliceDecoration -> LHsExpr GhcPs -> HsSplice GhcPs mkTypedSplice ann hasParen e = HsTypedSplice ann hasParen unqualSplice e mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs @@ -657,7 +657,7 @@ mkLHsVarTuple ids ext = mkLHsTupleExpr (map nlHsVar ids) ext nlTuplePat :: [LPat GhcPs] -> Boxity -> LPat GhcPs nlTuplePat pats box = noLocA (TuplePat noAnn pats box) -missingTupArg :: EpAnn' EpaAnchor -> HsTupArg GhcPs +missingTupArg :: EpAnn EpaLocation -> HsTupArg GhcPs missingTupArg ann = Missing ann mkLHsPatTup :: [LPat GhcRn] -> LPat GhcRn @@ -862,7 +862,7 @@ mkVarBind var rhs = L (getLoc rhs) $ var_id = var, var_rhs = rhs } mkPatSynBind :: LocatedN RdrName -> HsPatSynDetails GhcPs - -> LPat GhcPs -> HsPatSynDir GhcPs -> EpAnn -> HsBind GhcPs + -> LPat GhcPs -> HsPatSynDir GhcPs -> EpAnn [AddEpAnn] -> HsBind GhcPs mkPatSynBind name details lpat dir anns = PatSynBind noExtField psb where psb = PSB{ psb_ext = anns diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index 356a728b23..6c85b8d08c 100644 --- a/compiler/GHC/Parser.y +++ b/compiler/GHC/Parser.y @@ -1112,27 +1112,27 @@ importdecl :: { LImportDecl GhcPs } } -maybe_src :: { ((Maybe (EpaAnchor,EpaAnchor),SourceText),IsBootInterface) } +maybe_src :: { ((Maybe (EpaLocation,EpaLocation),SourceText),IsBootInterface) } : '{-# SOURCE' '#-}' { ((Just (glAA $1,glAA $2),getSOURCE_PRAGs $1) , IsBoot) } | {- empty -} { ((Nothing,NoSourceText),NotBoot) } -maybe_safe :: { (Maybe EpaAnchor,Bool) } +maybe_safe :: { (Maybe EpaLocation,Bool) } : 'safe' { (Just (glAA $1),True) } | {- empty -} { (Nothing, False) } -maybe_pkg :: { (Maybe EpaAnchor,Maybe StringLiteral) } +maybe_pkg :: { (Maybe EpaLocation,Maybe StringLiteral) } : STRING {% do { let { pkgFS = getSTRING $1 } ; unless (looksLikePackageName (unpackFS pkgFS)) $ addError $ PsError (PsErrInvalidPackageName pkgFS) [] (getLoc $1) ; return (Just (glAA $1), Just (StringLiteral (getSTRINGs $1) pkgFS Nothing)) } } | {- empty -} { (Nothing,Nothing) } -optqualified :: { Located (Maybe EpaAnchor) } +optqualified :: { Located (Maybe EpaLocation) } : 'qualified' { sL1 $1 (Just (glAA $1)) } | {- empty -} { noLoc Nothing } -maybeas :: { (Maybe EpaAnchor,Located (Maybe (Located ModuleName))) } +maybeas :: { (Maybe EpaLocation,Located (Maybe (Located ModuleName))) } : 'as' modid { (Just (glAA $1) ,sLL $1 $> (Just $2)) } | {- empty -} { (Nothing,noLoc Nothing) } @@ -1545,7 +1545,7 @@ datafam_inst_hdr :: { Located (Maybe (LHsContext GhcPs), HsOuterFamEqnTyVarBndrs >>= \tvbs -> (acs (\cs -> (sLL $1 (reLoc $>) (Just ( addTrailingDarrowC $4 $5 cs) - , mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) noCom) tvbs, $6)))) + , mkHsOuterExplicit (EpAnn (glR $1) (mu AnnForall $1, mj AnnDot $3) emptyComments) tvbs, $6)))) } | 'forall' tv_bndrs '.' type {% do { hintExplicitForall $1 ; tvbs <- fromSpecTyVarBndrs $2 @@ -2007,7 +2007,7 @@ annotation :: { LHsDecl GhcPs } ----------------------------------------------------------------------------- -- Foreign import and export declarations -fdecl :: { Located ([AddEpAnn],EpAnn -> HsDecl GhcPs) } +fdecl :: { Located ([AddEpAnn],EpAnn [AddEpAnn] -> HsDecl GhcPs) } fdecl : 'import' callconv safety fspec {% mkImport $2 $3 (snd $ unLoc $4) >>= \i -> return (sLL $1 $> (mj AnnImport $1 : (fst $ unLoc $4),i)) } @@ -2787,7 +2787,7 @@ aexp :: { ECP } $ Match { m_ext = EpAnn (glR $1) [mj AnnLam $1] cs , m_ctxt = LambdaExpr , m_pats = $2:$3 - , m_grhss = unguardedGRHSs (comb2 $4 (reLoc $5)) $5 (EpAnn (glR $4) (GrhsAnn Nothing (mu AnnRarrow $4)) noCom) }])) } + , m_grhss = unguardedGRHSs (comb2 $4 (reLoc $5)) $5 (EpAnn (glR $4) (GrhsAnn Nothing (mu AnnRarrow $4)) emptyComments) }])) } | 'let' binds 'in' exp { ECP $ unECP $4 >>= \ $4 -> mkHsLetPV (comb2A $1 $>) (unLoc $2) $4 @@ -2852,7 +2852,7 @@ aexp1 :: { ECP } | aexp1 TIGHT_INFIX_PROJ field {% runPV (unECP $1) >>= \ $1 -> fmap ecpFromExp $ acsa (\cs -> - let fl = sLL $2 $> (HsFieldLabel ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) noCom)) $3) in + let fl = sLL $2 $> (HsFieldLabel ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in mkRdrGetField (noAnnSrcSpan $ comb2 (reLoc $1) $>) $1 fl (EpAnn (glAR $1) NoEpAnns cs)) } @@ -3020,11 +3020,11 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) } : texp commas_tup_tail { unECP $1 >>= \ $1 -> $2 >>= \ $2 -> - do { t <- amsA $1 [AddCommaAnn (AR $ rs $ fst $2)] + do { t <- amsA $1 [AddCommaAnn (EpaSpan $ rs $ fst $2)] ; return (Tuple (Right t : snd $2)) } } | commas tup_tail { $2 >>= \ $2 -> - do { let {cos = map (\ll -> (Left (EpAnn (anc $ rs ll) (AR $ rs ll) noCom))) (fst $1) } + do { let {cos = map (\ll -> (Left (EpAnn (anc $ rs ll) (EpaSpan $ rs ll) emptyComments))) (fst $1) } ; return (Tuple (cos ++ $2)) } } | texp bars { unECP $1 >>= \ $1 -> return $ @@ -3035,17 +3035,17 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) } (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2 (fst $1) (fst $3)) } -- Always starts with commas; always follows an expr -commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn' EpaAnchor) (LocatedA b)]) } +commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn EpaLocation) (LocatedA b)]) } commas_tup_tail : commas tup_tail { $2 >>= \ $2 -> - do { let {cos = map (\l -> (Left (EpAnn (anc $ rs l) (AR $ rs l) noCom))) (tail $ fst $1) } + do { let {cos = map (\l -> (Left (EpAnn (anc $ rs l) (EpaSpan $ rs l) emptyComments))) (tail $ fst $1) } ; return ((head $ fst $1, cos ++ $2)) } } -- Always follows a comma -tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn' EpaAnchor) (LocatedA b)] } +tup_tail :: { forall b. DisambECP b => PV [Either (EpAnn EpaLocation) (LocatedA b)] } : texp commas_tup_tail { unECP $1 >>= \ $1 -> $2 >>= \ $2 -> - do { t <- amsA $1 [AddCommaAnn (AR $ rs $ fst $2)] + do { t <- amsA $1 [AddCommaAnn (EpaSpan $ rs $ fst $2)] ; return (Right t : snd $2) } } | texp { unECP $1 >>= \ $1 -> return [Right $1] } @@ -3382,7 +3382,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } let top = sL1 $1 $ HsFieldLabel noAnn $1 ((L lf (HsFieldLabel _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) - fields = top : L lf' (HsFieldLabel (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) noCom) f) : t + fields = top : L lf' (HsFieldLabel (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t final = last fields l = comb2 $1 $3 isPun = False @@ -3398,7 +3398,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) } let top = sL1 $1 $ HsFieldLabel noAnn $1 ((L lf (HsFieldLabel _ f)):t) = reverse (unLoc $3) lf' = comb2 $2 (L lf ()) - fields = top : L lf' (HsFieldLabel (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) noCom) f) : t + fields = top : L lf' (HsFieldLabel (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t final = last fields l = comb2 $1 $3 isPun = True @@ -3514,10 +3514,10 @@ con_list : con { sL1N $1 [$1] } sysdcon_nolist :: { LocatedN DataCon } -- Wired in data constructors : '(' ')' {% amsrn (sLL $1 $> unitDataCon) (NameAnnOnly NameParens (glAA $1) (glAA $2) []) } | '(' commas ')' {% amsrn (sLL $1 $> $ tupleDataCon Boxed (snd $2 + 1)) - (NameAnnCommas NameParens (glAA $1) (map (AR . realSrcSpan) (fst $2)) (glAA $3) []) } + (NameAnnCommas NameParens (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) } | '(#' '#)' {% amsrn (sLL $1 $> $ unboxedUnitDataCon) (NameAnnOnly NameParensHash (glAA $1) (glAA $2) []) } | '(#' commas '#)' {% amsrn (sLL $1 $> $ tupleDataCon Unboxed (snd $2 + 1)) - (NameAnnCommas NameParensHash (glAA $1) (map (AR . realSrcSpan) (fst $2)) (glAA $3) []) } + (NameAnnCommas NameParensHash (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) } -- See Note [Empty lists] in GHC.Hs.Expr sysdcon :: { LocatedN DataCon } @@ -3551,10 +3551,10 @@ ntgtycon :: { LocatedN RdrName } -- A "general" qualified tycon, excluding unit : oqtycon { $1 } | '(' commas ')' {% amsrn (sLL $1 $> $ getRdrName (tupleTyCon Boxed (snd $2 + 1))) - (NameAnnCommas NameParens (glAA $1) (map (AR . realSrcSpan) (fst $2)) (glAA $3) []) } + (NameAnnCommas NameParens (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) } | '(#' commas '#)' {% amsrn (sLL $1 $> $ getRdrName (tupleTyCon Unboxed (snd $2 + 1))) - (NameAnnCommas NameParensHash (glAA $1) (map (AR . realSrcSpan) (fst $2)) (glAA $3) []) } + (NameAnnCommas NameParensHash (glAA $1) (map (EpaSpan . realSrcSpan) (fst $2)) (glAA $3) []) } | '(' '->' ')' {% amsrn (sLL $1 $> $ getRdrName unrestrictedFunTyCon) (NameAnn NameParens (glAA $1) (glAA $2) (glAA $3) []) } | '[' ']' {% amsrn (sLL $1 $> $ listTyCon_RDR) @@ -3846,11 +3846,11 @@ commas :: { ([SrcSpan],Int) } -- One or more commas : commas ',' { ((fst $1)++[gl $2],snd $1 + 1) } | ',' { ([gl $1],1) } -bars0 :: { ([EpaAnchor],Int) } -- Zero or more bars +bars0 :: { ([EpaLocation],Int) } -- Zero or more bars : bars { $1 } | { ([], 0) } -bars :: { ([EpaAnchor],Int) } -- One or more bars +bars :: { ([EpaLocation],Int) } -- One or more bars : bars '|' { ((fst $1)++[glAA $2],snd $1 + 1) } | '|' { ([glAA $1],1) } @@ -4148,28 +4148,28 @@ in GHC.Parser.Annotation -- |Construct an AddEpAnn from the annotation keyword and the location -- of the keyword itself mj :: AnnKeywordId -> Located e -> AddEpAnn -mj a l = AddEpAnn a (AR $ rs $ gl l) +mj a l = AddEpAnn a (EpaSpan $ rs $ gl l) mjN :: AnnKeywordId -> LocatedN e -> AddEpAnn -mjN a l = AddEpAnn a (AR $ rs $ glN l) +mjN a l = AddEpAnn a (EpaSpan $ rs $ glN l) -- |Construct an AddEpAnn from the annotation keyword and the location -- of the keyword itself, provided the span is not zero width mz :: AnnKeywordId -> Located e -> [AddEpAnn] -mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (AR $ rs $ gl l)] +mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (EpaSpan $ rs $ gl l)] msemi :: Located e -> [TrailingAnn] -msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (AR $ rs $ gl l)] +msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (EpaSpan $ rs $ gl l)] -- |Construct an AddEpAnn from the annotation keyword and the Located Token. If -- the token has a unicode equivalent and this has been used, provide the -- unicode variant of the annotation. mu :: AnnKeywordId -> Located Token -> AddEpAnn -mu a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (AR $ rs l) +mu a lt@(L l t) = AddEpAnn (toUnicodeAnn a lt) (EpaSpan $ rs l) mau :: Located Token -> TrailingAnn -mau lt@(L l t) = if isUnicode lt then AddRarrowAnnU (AR $ rs l) - else AddRarrowAnn (AR $ rs l) +mau lt@(L l t) = if isUnicode lt then AddRarrowAnnU (EpaSpan $ rs l) + else AddRarrowAnn (EpaSpan $ rs l) -- | If the 'Token' is using its unicode variant return the unicode variant of -- the annotation @@ -4191,8 +4191,8 @@ glN = getLocA glR :: Located a -> Anchor glR la = Anchor (realSrcSpan $ getLoc la) UnchangedAnchor -glAA :: Located a -> EpaAnchor -glAA = AR <$> realSrcSpan . getLoc +glAA :: Located a -> EpaLocation +glAA = EpaSpan <$> realSrcSpan . getLoc glRR :: Located a -> RealSrcSpan glRR = realSrcSpan . getLoc @@ -4203,22 +4203,22 @@ glAR la = Anchor (realSrcSpan $ getLocA la) UnchangedAnchor glNR :: LocatedN a -> Anchor glNR ln = Anchor (realSrcSpan $ getLocA ln) UnchangedAnchor -glNRR :: LocatedN a -> EpaAnchor -glNRR = AR <$> realSrcSpan . getLocA +glNRR :: LocatedN a -> EpaLocation +glNRR = EpaSpan <$> realSrcSpan . getLocA anc :: RealSrcSpan -> Anchor anc r = Anchor r UnchangedAnchor acs :: MonadP m => (EpAnnComments -> Located a) -> m (Located a) acs a = do - let (L l _) = a noCom + let (L l _) = a emptyComments cs <- getCommentsFor l return (a cs) -- Called at the very end to pick up the EOF position, as well as any comments not allocated yet. acsFinal :: (EpAnnComments -> Located a) -> P (Located a) acsFinal a = do - let (L l _) = a noCom + let (L l _) = a emptyComments cs <- getCommentsFor l csf <- getFinalCommentsFor l meof <- getEofPos @@ -4229,7 +4229,7 @@ acsFinal a = do acsa :: MonadP m => (EpAnnComments -> LocatedAn t a) -> m (LocatedAn t a) acsa a = do - let (L l _) = a noCom + let (L l _) = a emptyComments cs <- getCommentsFor (locA l) return (a cs) @@ -4311,7 +4311,7 @@ pvL a = do { av <- a parseModule :: P (Located HsModule) parseModule = parseModuleNoHaddock >>= addHaddockToModule -commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn' ann) +commentsA :: (Monoid ann) => SrcSpan -> EpAnnComments -> SrcSpanAnn' (EpAnn ann) commentsA loc cs = SrcSpanAnn (EpAnn (Anchor (rs loc) UnchangedAnchor) mempty cs) loc -- | Instead of getting the *enclosed* comments, this includes the @@ -4328,7 +4328,7 @@ rs _ = panic "Parser should only have RealSrcSpan" hsDoAnn :: Located a -> LocatedAn t b -> AnnKeywordId -> AnnList hsDoAnn (L l _) (L ll _) kw - = AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (AR $ rs l)] [] + = AnnList (Just $ spanAsAnchor (locA ll)) Nothing Nothing [AddEpAnn kw (EpaSpan $ rs l)] [] listAsAnchor :: [LocatedAn t a] -> Anchor listAsAnchor [] = spanAsAnchor noSrcSpan @@ -4349,24 +4349,24 @@ addTrailingSemiA la span = addTrailingAnnA la span AddSemiAnn addTrailingCommaA :: MonadP m => LocatedA a -> SrcSpan -> m (LocatedA a) addTrailingCommaA la span = addTrailingAnnA la span AddCommaAnn -addTrailingAnnA :: MonadP m => LocatedA a -> SrcSpan -> (EpaAnchor -> TrailingAnn) -> m (LocatedA a) +addTrailingAnnA :: MonadP m => LocatedA a -> SrcSpan -> (EpaLocation -> TrailingAnn) -> m (LocatedA a) addTrailingAnnA (L (SrcSpanAnn anns l) a) ss ta = do -- cs <- getCommentsFor l - let cs = noCom + let cs = emptyComments -- AZ:TODO: generalise updating comments into an annotation let anns' = if isZeroWidthSpan ss then anns - else addTrailingAnnToA l (ta (AR $ rs ss)) cs anns + else addTrailingAnnToA l (ta (EpaSpan $ rs ss)) cs anns return (L (SrcSpanAnn anns' l) a) -- ------------------------------------- addTrailingVbarL :: MonadP m => LocatedL a -> SrcSpan -> m (LocatedL a) -addTrailingVbarL la span = addTrailingAnnL la (AddVbarAnn (AR $ rs span)) +addTrailingVbarL la span = addTrailingAnnL la (AddVbarAnn (EpaSpan $ rs span)) addTrailingCommaL :: MonadP m => LocatedL a -> SrcSpan -> m (LocatedL a) -addTrailingCommaL la span = addTrailingAnnL la (AddCommaAnn (AR $ rs span)) +addTrailingCommaL la span = addTrailingAnnL la (AddCommaAnn (EpaSpan $ rs span)) addTrailingAnnL :: MonadP m => LocatedL a -> TrailingAnn -> m (LocatedL a) addTrailingAnnL (L (SrcSpanAnn anns l) a) ta = do @@ -4380,15 +4380,15 @@ addTrailingAnnL (L (SrcSpanAnn anns l) a) ta = do addTrailingCommaN :: MonadP m => LocatedN a -> SrcSpan -> m (LocatedN a) addTrailingCommaN (L (SrcSpanAnn anns l) a) span = do -- cs <- getCommentsFor l - let cs = noCom + let cs = emptyComments -- AZ:TODO: generalise updating comments into an annotation let anns' = if isZeroWidthSpan span then anns - else addTrailingCommaToN l anns (AR $ rs span) + else addTrailingCommaToN l anns (EpaSpan $ rs span) return (L (SrcSpanAnn anns' l) a) -addTrailingCommaS :: Located StringLiteral -> EpaAnchor -> Located StringLiteral -addTrailingCommaS (L l sl) span = L l (sl { sl_tc = Just (epaAnchorRealSrcSpan span) }) +addTrailingCommaS :: Located StringLiteral -> EpaLocation -> Located StringLiteral +addTrailingCommaS (L l sl) span = L l (sl { sl_tc = Just (epaLocationRealSrcSpan span) }) -- ------------------------------------- diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs index c62bdce65e..f234c7c789 100644 --- a/compiler/GHC/Parser/Annotation.hs +++ b/compiler/GHC/Parser/Annotation.hs @@ -13,16 +13,16 @@ module GHC.Parser.Annotation ( -- * In-tree Exact Print Annotations AddEpAnn(..), - EpaAnchor(..), epaAnchorRealSrcSpan, - DeltaPos(..), + EpaLocation(..), epaLocationRealSrcSpan, + DeltaPos(..), deltaPos, getDeltaLine, - EpAnn, EpAnn'(..), Anchor(..), AnchorOperation(..), + EpAnn(..), Anchor(..), AnchorOperation(..), spanAsAnchor, realSpanAsAnchor, noAnn, -- ** Comments in Annotations - EpAnnComments(..), LEpaComment, com, noCom, + EpAnnComments(..), LEpaComment, emptyComments, getFollowingComments, setFollowingComments, setPriorComments, EpAnnCO, @@ -316,8 +316,11 @@ data EpaComment = EpaComment { ac_tok :: EpaCommentTok , ac_prior_tok :: RealSrcSpan - -- ^ The location of the prior - -- token, used for exact printing + -- ^ The location of the prior token, used in exact printing. The + -- 'EpaComment' appears as an 'LEpaComment' containing its + -- location. The difference between the end of the prior token + -- and the start of this location is used for the spacing when + -- exact printing the comment. } deriving (Eq, Ord, Data, Show) @@ -332,6 +335,11 @@ data EpaCommentTok = | EpaBlockComment String -- ^ comment in {- -} | EpaEofComment -- ^ empty comment, capturing -- location of EOF + + -- See #19697 for a discussion of its use and how it should be + -- removed in favour of capturing it in the location for + -- 'Located HsModule' in the parser. + deriving (Eq, Ord, Data, Show) -- Note: these are based on the Token versions, but the Token type is -- defined in GHC.Parser.Lexer and bringing it in here would create a loop @@ -383,24 +391,24 @@ data HasE = HasE | NoE -- --------------------------------------------------------------------- -- | Captures an annotation, storing the @'AnnKeywordId'@ and its --- location. The parser only ever inserts @'EpaAnchor'@ fields with a +-- location. The parser only ever inserts @'EpaLocation'@ fields with a -- RealSrcSpan being the original location of the annotation in the -- source file. --- The @'EpaAnchor'@ can also store a delta position if the AST has been +-- The @'EpaLocation'@ can also store a delta position if the AST has been -- modified and needs to be pretty printed again. -- The usual way an 'AddEpAnn' is created is using the 'mj' ("make -- jump") function, and then it can be inserted into the appropriate -- annotation. -data AddEpAnn = AddEpAnn AnnKeywordId EpaAnchor deriving (Data,Show,Eq,Ord) +data AddEpAnn = AddEpAnn AnnKeywordId EpaLocation deriving (Data,Show,Eq,Ord) --- | The anchor for an @'AnnKeywordId'@. The Parser inserts the @'AR'@ +-- | The anchor for an @'AnnKeywordId'@. The Parser inserts the @'EpaSpan'@ -- variant, giving the exact location of the original item in the --- parsed source. This can be replace by the @'AD'@ version, to +-- parsed source. This can be replaced by the @'EpaDelta'@ version, to -- provide a position for the item relative to the end of the previous -- item in the source. This is useful when editing an AST prior to -- exact printing the changed one. -data EpaAnchor = AR RealSrcSpan - | AD DeltaPos +data EpaLocation = EpaSpan RealSrcSpan + | EpaDelta DeltaPos deriving (Data,Show,Eq,Ord) -- | Relative position, line then column. If 'deltaLine' is zero then @@ -409,20 +417,32 @@ data EpaAnchor = AR RealSrcSpan -- to, on the same line. If 'deltaLine' is > 0, then it is the number -- of lines to advance, and 'deltaColumn' is the start column on the -- new line. -data DeltaPos = - DP - { deltaLine :: !Int, - deltaColumn :: !Int - } deriving (Show,Eq,Ord,Data) - - -epaAnchorRealSrcSpan :: EpaAnchor -> RealSrcSpan -epaAnchorRealSrcSpan (AR r) = r -epaAnchorRealSrcSpan (AD _) = placeholderRealSpan - -instance Outputable EpaAnchor where - ppr (AR r) = text "AR" <+> ppr r - ppr (AD d) = text "AD" <+> ppr d +data DeltaPos + = SameLine { deltaColumn :: !Int } + | DifferentLine + { deltaLine :: !Int, -- ^ deltaLine should always be > 0 + deltaColumn :: !Int + } deriving (Show,Eq,Ord,Data) + +deltaPos :: Int -> Int -> DeltaPos +deltaPos l c = case l of + 0 -> SameLine c + _ -> DifferentLine l c + +getDeltaLine :: DeltaPos -> Int +getDeltaLine (SameLine _) = 0 +getDeltaLine (DifferentLine r _) = r + +-- | Used in the parser only, extract the 'RealSrcSpan' from an +-- 'EpaLocation'. The parser will never insert a 'DeltaPos', so the +-- partial function is safe. +epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan +epaLocationRealSrcSpan (EpaSpan r) = r +epaLocationRealSrcSpan (EpaDelta _) = panic "epaLocationRealSrcSpan" + +instance Outputable EpaLocation where + ppr (EpaSpan r) = text "EpaSpan" <+> ppr r + ppr (EpaDelta d) = text "EpaDelta" <+> ppr d instance Outputable AddEpAnn where ppr (AddEpAnn kw ss) = text "AddEpAnn" <+> ppr kw <+> ppr ss @@ -478,27 +498,27 @@ See Note [XRec and Anno in the AST] for details of how this is done. -- specialised to the specific set of locations of original API -- Annotation elements. So for 'HsLet' we have -- --- type instance XLet GhcPs = EpAnn' AnnsLet +-- type instance XLet GhcPs = EpAnn AnnsLet -- data AnnsLet -- = AnnsLet { --- alLet :: EpaAnchor, --- alIn :: EpaAnchor +-- alLet :: EpaLocation, +-- alIn :: EpaLocation -- } deriving Data -- --- The spacing between the items under the scope of a given EpAnn' is +-- The spacing between the items under the scope of a given EpAnn is -- derived from the original 'Anchor'. But there is no requirement -- that the items included in the sub-element have a "matching" -- location in their relative anchors. This allows us to freely move -- elements around, and stitch together new AST fragments out of old -- ones, and have them still printed out in a reasonable way. -data EpAnn' ann +data EpAnn ann = EpAnn { entry :: Anchor -- ^ Base location for the start of the syntactic element -- holding the annotations. , anns :: ann -- ^ Annotations added by the Parser , comments :: EpAnnComments -- ^ Comments enclosed in the SrcSpan of the element - -- this `EpAnn'` is attached to + -- this `EpAnn` is attached to } | EpAnnNotUsed -- ^ No Annotation for generated code, -- e.g. from TH, deriving, etc. @@ -550,19 +570,8 @@ data EpAnnComments = EpaComments type LEpaComment = GenLocated Anchor EpaComment -noCom :: EpAnnComments -noCom = EpaComments [] - -com :: [LEpaComment] -> EpAnnComments -com cs = EpaComments cs - --- --------------------------------------------------------------------- - --- | This type is the "vanilla" Exact Print Annotation. It captures --- the containing `SrcSpan' in its `entry` `Anchor`, has a list of --- `AddEpAnn`, and keeps track of the comments associated with the --- anchor. -type EpAnn = EpAnn' [AddEpAnn] +emptyComments :: EpAnnComments +emptyComments = EpaComments [] -- --------------------------------------------------------------------- -- Annotations attached to a 'SrcSpan'. @@ -576,7 +585,7 @@ data SrcSpanAnn' a = SrcSpanAnn { ann :: a, locA :: SrcSpan } -- See Note [XRec and Anno in the AST] -- | We mostly use 'SrcSpanAnn\'' with an 'EpAnn\'' -type SrcAnn ann = SrcSpanAnn' (EpAnn' ann) +type SrcAnn ann = SrcSpanAnn' (EpAnn ann) -- AZ: is SrcAnn the right abbreviation here? Any better suggestions? -- AZ: should we rename LocatedA to LocatedL? The name comes from @@ -642,11 +651,11 @@ meaning we can have type LocatedN RdrName -- | Captures the location of punctuation occuring between items, -- normally in a list. It is captured as a trailing annotation. data TrailingAnn - = AddSemiAnn EpaAnchor -- ^ Trailing ';' - | AddCommaAnn EpaAnchor -- ^ Trailing ',' - | AddVbarAnn EpaAnchor -- ^ Trailing '|' - | AddRarrowAnn EpaAnchor -- ^ Trailing '->' - | AddRarrowAnnU EpaAnchor -- ^ Trailing '->', unicode variant + = AddSemiAnn EpaLocation -- ^ Trailing ';' + | AddCommaAnn EpaLocation -- ^ Trailing ',' + | AddVbarAnn EpaLocation -- ^ Trailing '|' + | AddRarrowAnn EpaLocation -- ^ Trailing '->' + | AddRarrowAnnU EpaLocation -- ^ Trailing '->', unicode variant deriving (Data,Show,Eq, Ord) instance Outputable TrailingAnn where @@ -691,8 +700,8 @@ data AnnList data AnnParen = AnnParen { ap_adornment :: ParenType, - ap_open :: EpaAnchor, - ap_close :: EpaAnchor + ap_open :: EpaLocation, + ap_close :: EpaLocation } deriving (Data) -- | Detail of the "brackets" used in an 'AnnParen' API Annotation. @@ -714,10 +723,10 @@ parenTypeKws AnnParensSquare = (AnnOpenS, AnnCloseS) -- | API Annotation for the 'Context' data type. data AnnContext = AnnContext { - ac_darrow :: Maybe (IsUnicodeSyntax, EpaAnchor), + ac_darrow :: Maybe (IsUnicodeSyntax, EpaLocation), -- ^ location and encoding of the '=>', if present. - ac_open :: [EpaAnchor], -- ^ zero or more opening parentheses. - ac_close :: [EpaAnchor] -- ^ zero or more closing parentheses. + ac_open :: [EpaLocation], -- ^ zero or more opening parentheses. + ac_close :: [EpaLocation] -- ^ zero or more closing parentheses. } deriving (Data) @@ -732,35 +741,35 @@ data NameAnn -- | Used for a name with an adornment, so '`foo`', '(bar)' = NameAnn { nann_adornment :: NameAdornment, - nann_open :: EpaAnchor, - nann_name :: EpaAnchor, - nann_close :: EpaAnchor, + nann_open :: EpaLocation, + nann_name :: EpaLocation, + nann_close :: EpaLocation, nann_trailing :: [TrailingAnn] } -- | Used for @(,,,)@, or @(#,,,#)# | NameAnnCommas { nann_adornment :: NameAdornment, - nann_open :: EpaAnchor, - nann_commas :: [EpaAnchor], - nann_close :: EpaAnchor, + nann_open :: EpaLocation, + nann_commas :: [EpaLocation], + nann_close :: EpaLocation, nann_trailing :: [TrailingAnn] } -- | Used for @()@, @(##)@, @[]@ | NameAnnOnly { nann_adornment :: NameAdornment, - nann_open :: EpaAnchor, - nann_close :: EpaAnchor, + nann_open :: EpaLocation, + nann_close :: EpaLocation, nann_trailing :: [TrailingAnn] } -- | Used for @->@, as an identifier | NameAnnRArrow { - nann_name :: EpaAnchor, + nann_name :: EpaLocation, nann_trailing :: [TrailingAnn] } -- | Used for an item with a leading @'@. The annotation for -- unquoted item is stored in 'nann_quoted'. | NameAnnQuote { - nann_quote :: EpaAnchor, + nann_quote :: EpaLocation, nann_quoted :: SrcSpanAnnN, nann_trailing :: [TrailingAnn] } @@ -811,7 +820,7 @@ data AnnSortKey -- | Helper function used in the parser to add a 'TrailingAnn' items -- to an existing annotation. addTrailingAnnToL :: SrcSpan -> TrailingAnn -> EpAnnComments - -> EpAnn' AnnList -> EpAnn' AnnList + -> EpAnn AnnList -> EpAnn AnnList addTrailingAnnToL s t cs EpAnnNotUsed = EpAnn (spanAsAnchor s) (AnnList (Just $ spanAsAnchor s) Nothing Nothing [] [t]) cs addTrailingAnnToL _ t cs n = n { anns = addTrailing (anns n) @@ -822,7 +831,7 @@ addTrailingAnnToL _ t cs n = n { anns = addTrailing (anns n) -- | Helper function used in the parser to add a 'TrailingAnn' items -- to an existing annotation. addTrailingAnnToA :: SrcSpan -> TrailingAnn -> EpAnnComments - -> EpAnn' AnnListItem -> EpAnn' AnnListItem + -> EpAnn AnnListItem -> EpAnn AnnListItem addTrailingAnnToA s t cs EpAnnNotUsed = EpAnn (spanAsAnchor s) (AnnListItem [t]) cs addTrailingAnnToA _ t cs n = n { anns = addTrailing (anns n) @@ -832,12 +841,12 @@ addTrailingAnnToA _ t cs n = n { anns = addTrailing (anns n) -- | Helper function used in the parser to add a comma location to an -- existing annotation. -addTrailingCommaToN :: SrcSpan -> EpAnn' NameAnn -> EpaAnchor -> EpAnn' NameAnn +addTrailingCommaToN :: SrcSpan -> EpAnn NameAnn -> EpaLocation -> EpAnn NameAnn addTrailingCommaToN s EpAnnNotUsed l - = EpAnn (spanAsAnchor s) (NameAnnTrailing [AddCommaAnn l]) noCom + = EpAnn (spanAsAnchor s) (NameAnnTrailing [AddCommaAnn l]) emptyComments addTrailingCommaToN _ n l = n { anns = addTrailing (anns n) l } where - addTrailing :: NameAnn -> EpaAnchor -> NameAnn + addTrailing :: NameAnn -> EpaLocation -> NameAnn addTrailing n l = n { nann_trailing = AddCommaAnn l : nann_trailing n } -- --------------------------------------------------------------------- @@ -923,11 +932,11 @@ noSrcSpanA :: SrcAnn ann noSrcSpanA = noAnnSrcSpan noSrcSpan -- | Short form for 'EpAnnNotUsed' -noAnn :: EpAnn' a +noAnn :: EpAnn a noAnn = EpAnnNotUsed -addAnns :: EpAnn -> [AddEpAnn] -> EpAnnComments -> EpAnn +addAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] -> EpAnnComments -> EpAnn [AddEpAnn] addAnns (EpAnn l as1 cs) as2 cs2 = EpAnn (widenAnchor l (as1 ++ as2)) (as1 ++ as2) (cs <> cs2) addAnns EpAnnNotUsed [] (EpaComments []) = EpAnnNotUsed @@ -951,8 +960,8 @@ widenSpan :: SrcSpan -> [AddEpAnn] -> SrcSpan widenSpan s as = foldl combineSrcSpans s (go as) where go [] = [] - go (AddEpAnn _ (AR s):rest) = RealSrcSpan s Nothing : go rest - go (AddEpAnn _ (AD _):rest) = go rest + go (AddEpAnn _ (EpaSpan s):rest) = RealSrcSpan s Nothing : go rest + go (AddEpAnn _ (EpaDelta _):rest) = go rest -- | The annotations need to all come after the anchor. Make sure -- this is the case. @@ -960,8 +969,8 @@ widenRealSpan :: RealSrcSpan -> [AddEpAnn] -> RealSrcSpan widenRealSpan s as = foldl combineRealSrcSpans s (go as) where go [] = [] - go (AddEpAnn _ (AR s):rest) = s : go rest - go (AddEpAnn _ (AD _):rest) = go rest + go (AddEpAnn _ (EpaSpan s):rest) = s : go rest + go (AddEpAnn _ (EpaDelta _):rest) = go rest widenAnchor :: Anchor -> [AddEpAnn] -> Anchor widenAnchor (Anchor s op) as = Anchor (widenRealSpan s as) op @@ -972,22 +981,22 @@ widenAnchorR (Anchor s op) r = Anchor (combineRealSrcSpans s r) op widenLocatedAn :: SrcSpanAnn' an -> [AddEpAnn] -> SrcSpanAnn' an widenLocatedAn (SrcSpanAnn a l) as = SrcSpanAnn a (widenSpan l as) -epAnnAnnsL :: EpAnn' a -> [a] +epAnnAnnsL :: EpAnn a -> [a] epAnnAnnsL EpAnnNotUsed = [] epAnnAnnsL (EpAnn _ anns _) = [anns] -epAnnAnns :: EpAnn -> [AddEpAnn] +epAnnAnns :: EpAnn [AddEpAnn] -> [AddEpAnn] epAnnAnns EpAnnNotUsed = [] epAnnAnns (EpAnn _ anns _) = anns -annParen2AddEpAnn :: EpAnn' AnnParen -> [AddEpAnn] +annParen2AddEpAnn :: EpAnn AnnParen -> [AddEpAnn] annParen2AddEpAnn EpAnnNotUsed = [] annParen2AddEpAnn (EpAnn _ (AnnParen pt o c) _) = [AddEpAnn ai o, AddEpAnn ac c] where (ai,ac) = parenTypeKws pt -epAnnComments :: EpAnn' an -> EpAnnComments +epAnnComments :: EpAnn an -> EpAnnComments epAnnComments EpAnnNotUsed = EpaComments [] epAnnComments (EpAnn _ _ cs) = cs @@ -1036,13 +1045,13 @@ setPriorComments (EpaCommentsBalanced _ ts) cs = EpaCommentsBalanced cs ts -- --------------------------------------------------------------------- -- TODO:AZ I think EpAnnCO is not needed -type EpAnnCO = EpAnn' NoEpAnns -- ^ Api Annotations for comments only +type EpAnnCO = EpAnn NoEpAnns -- ^ Api Annotations for comments only data NoEpAnns = NoEpAnns deriving (Data,Eq,Ord) noComments ::EpAnnCO -noComments = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) NoEpAnns noCom +noComments = EpAnn (Anchor placeholderRealSpan UnchangedAnchor) NoEpAnns emptyComments -- TODO:AZ get rid of this placeholderRealSpan :: RealSrcSpan @@ -1052,7 +1061,7 @@ comment :: RealSrcSpan -> EpAnnComments -> EpAnnCO comment loc cs = EpAnn (Anchor loc UnchangedAnchor) NoEpAnns cs -- --------------------------------------------------------------------- --- Utilities for managing comments in an `EpAnn' a` structure. +-- Utilities for managing comments in an `EpAnn a` structure. -- --------------------------------------------------------------------- -- | Add additional comments to a 'SrcAnn', used for manipulating the @@ -1074,7 +1083,7 @@ setCommentsSrcAnn (SrcSpanAnn (EpAnn a an _) loc) cs -- | Add additional comments, used for manipulating the -- AST prior to exact printing the changed one. addCommentsToEpAnn :: (Monoid a) - => SrcSpan -> EpAnn' a -> EpAnnComments -> EpAnn' a + => SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a addCommentsToEpAnn loc EpAnnNotUsed cs = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs addCommentsToEpAnn _ (EpAnn a an ocs) ncs = EpAnn a an (ocs <> ncs) @@ -1082,7 +1091,7 @@ addCommentsToEpAnn _ (EpAnn a an ocs) ncs = EpAnn a an (ocs <> ncs) -- | Replace any existing comments, used for manipulating the -- AST prior to exact printing the changed one. setCommentsEpAnn :: (Monoid a) - => SrcSpan -> EpAnn' a -> EpAnnComments -> EpAnn' a + => SrcSpan -> EpAnn a -> EpAnnComments -> EpAnn a setCommentsEpAnn loc EpAnnNotUsed cs = EpAnn (Anchor (realSrcSpan loc) UnchangedAnchor) mempty cs setCommentsEpAnn _ (EpAnn a an _) cs = EpAnn a an cs @@ -1094,7 +1103,7 @@ transferComments :: (Monoid ann) => SrcAnn ann -> SrcAnn ann -> (SrcAnn ann, SrcAnn ann) transferComments from@(SrcSpanAnn EpAnnNotUsed _) to = (from, to) transferComments (SrcSpanAnn (EpAnn a an cs) l) to - = ((SrcSpanAnn (EpAnn a an noCom) l), addCommentsToSrcAnn to cs) + = ((SrcSpanAnn (EpAnn a an emptyComments) l), addCommentsToSrcAnn to cs) -- --------------------------------------------------------------------- -- Semigroup instances, to allow easy combination of annotaion elements @@ -1106,7 +1115,7 @@ instance (Semigroup an) => Semigroup (SrcSpanAnn' an) where -- annotations must follow it. So we combine them which yields the -- largest span -instance (Semigroup a) => Semigroup (EpAnn' a) where +instance (Semigroup a) => Semigroup (EpAnn a) where EpAnnNotUsed <> x = x x <> EpAnnNotUsed = x (EpAnn l1 a1 b1) <> (EpAnn l2 a2 b2) = EpAnn (l1 <> l2) (a1 <> a2) (b1 <> b2) @@ -1127,7 +1136,7 @@ instance Semigroup EpAnnComments where EpaCommentsBalanced cs1 as1 <> EpaCommentsBalanced cs2 as2 = EpaCommentsBalanced (cs1 ++ cs2) (as1++as2) -instance (Monoid a) => Monoid (EpAnn' a) where +instance (Monoid a) => Monoid (EpAnn a) where mempty = EpAnnNotUsed instance Semigroup AnnListItem where @@ -1164,7 +1173,7 @@ instance Semigroup AnnSortKey where instance Monoid AnnSortKey where mempty = NoAnnSortKey -instance (Outputable a) => Outputable (EpAnn' a) where +instance (Outputable a) => Outputable (EpAnn a) where ppr (EpAnn l a c) = text "EpAnn" <+> ppr l <+> ppr a <+> ppr c ppr EpAnnNotUsed = text "EpAnnNotUsed" @@ -1176,7 +1185,8 @@ instance Outputable AnchorOperation where ppr (MovedAnchor d) = text "MovedAnchor" <+> ppr d instance Outputable DeltaPos where - ppr (DP l c) = text "DP" <+> ppr l <+> ppr c + ppr (SameLine c) = text "SameLine" <+> ppr c + ppr (DifferentLine l c) = text "DifferentLine" <+> ppr l <+> ppr c instance Outputable (GenLocated Anchor EpaComment) where ppr (L l c) = text "L" <+> ppr l <+> ppr c diff --git a/compiler/GHC/Parser/Lexer.x b/compiler/GHC/Parser/Lexer.x index fef3b8b8c3..c813ab33e2 100644 --- a/compiler/GHC/Parser/Lexer.x +++ b/compiler/GHC/Parser/Lexer.x @@ -2935,15 +2935,15 @@ instance MonadP P where getCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments getCommentsFor (RealSrcSpan l _) = allocateCommentsP l -getCommentsFor _ = return noCom +getCommentsFor _ = return emptyComments getPriorCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments getPriorCommentsFor (RealSrcSpan l _) = allocatePriorCommentsP l -getPriorCommentsFor _ = return noCom +getPriorCommentsFor _ = return emptyComments getFinalCommentsFor :: (MonadP m) => SrcSpan -> m EpAnnComments getFinalCommentsFor (RealSrcSpan l _) = allocateFinalCommentsP l -getFinalCommentsFor _ = return noCom +getFinalCommentsFor _ = return emptyComments getEofPos :: P (Maybe (RealSrcSpan, RealSrcSpan)) getEofPos = P $ \s@(PState { eof_pos = pos }) -> POk s pos @@ -3438,7 +3438,7 @@ clean_pragma prag = canon_ws (map toLower (unprefix prag)) -- and end of the span mkParensEpAnn :: SrcSpan -> [AddEpAnn] mkParensEpAnn (UnhelpfulSpan _) = [] -mkParensEpAnn (RealSrcSpan ss _) = [AddEpAnn AnnOpenP (AR lo),AddEpAnn AnnCloseP (AR lc)] +mkParensEpAnn (RealSrcSpan ss _) = [AddEpAnn AnnOpenP (EpaSpan lo),AddEpAnn AnnCloseP (EpaSpan lc)] where f = srcSpanFile ss sl = srcSpanStartLine ss diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs index 2686bc151b..1de9f0cd53 100644 --- a/compiler/GHC/Parser/PostProcess.hs +++ b/compiler/GHC/Parser/PostProcess.hs @@ -189,7 +189,7 @@ mkClassDecl loc' (L _ (mcxt, tycl_hdr)) fds where_cls layoutInfo annsIn ; (cls, tparams, fixity, ann) <- checkTyClHdr True tycl_hdr ; (tyvars,annst) <- checkTyVars (text "class") whereDots cls tparams ; cs <- getCommentsFor (locA loc) -- Get any remaining comments - ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn noCom) (ann++annst) cs + ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) (ann++annst) cs ; return (L loc (ClassDecl { tcdCExt = (anns', NoAnnSortKey, layoutInfo) , tcdCtxt = mcxt , tcdLName = cls, tcdTyVars = tyvars @@ -215,7 +215,7 @@ mkTyData loc' new_or_data cType (L _ (mcxt, tycl_hdr)) ; (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; (tyvars, anns) <- checkTyVars (ppr new_or_data) equalsDots tc tparams ; cs <- getCommentsFor (locA loc) -- Get any remaining comments - ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn noCom) (ann ++ anns) cs + ; let anns' = addAnns (EpAnn (spanAsAnchor $ locA loc) annsIn emptyComments) (ann ++ anns) cs ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv anns' ; return (L loc (DataDecl { tcdDExt = anns', -- AZ: do we need these? tcdLName = tc, tcdTyVars = tyvars, @@ -228,7 +228,7 @@ mkDataDefn :: NewOrData -> Maybe (LHsKind GhcPs) -> [LConDecl GhcPs] -> HsDeriving GhcPs - -> EpAnn + -> EpAnn [AddEpAnn] -> P (HsDataDefn GhcPs) mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv ann = do { checkDatatypeContext mcxt @@ -250,7 +250,7 @@ mkTySynonym loc lhs rhs annsIn ; cs1 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp] ; (tyvars, anns) <- checkTyVars (text "type") equalsDots tc tparams ; cs2 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp] - ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn noCom) (ann ++ anns) (cs1 Semi.<> cs2) + ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn emptyComments) (ann ++ anns) (cs1 Semi.<> cs2) ; return (L (noAnnSrcSpan loc) (SynDecl { tcdSExt = anns' , tcdLName = tc, tcdTyVars = tyvars @@ -312,7 +312,7 @@ mkDataFamInst loc new_or_data cType (mcxt, bndrs, tycl_hdr) = do { (tc, tparams, fixity, ann) <- checkTyClHdr False tycl_hdr ; -- AZ:TODO: deal with these comments ; cs <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp] - ; let anns' = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns noCom + ; let anns' = addAnns (EpAnn (spanAsAnchor loc) ann cs) anns emptyComments ; defn <- mkDataDefn new_or_data cType mcxt ksig data_cons maybe_deriv anns' ; return (L (noAnnSrcSpan loc) (DataFamInstD anns' (DataFamInstDecl (FamEqn { feqn_ext = noAnn -- AZ: get anns @@ -344,7 +344,7 @@ mkFamDecl loc info topLevel lhs ksig injAnn annsIn ; cs1 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp] ; (tyvars, anns) <- checkTyVars (ppr info) equals_or_where tc tparams ; cs2 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp] - ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn noCom) (ann++anns) (cs1 Semi.<> cs2) + ; let anns' = addAnns (EpAnn (spanAsAnchor loc) annsIn emptyComments) (ann++anns) (cs1 Semi.<> cs2) ; return (L (noAnnSrcSpan loc) (FamDecl noExtField (FamilyDecl { fdExt = anns' @@ -436,17 +436,17 @@ annBinds a (HsValBinds an bs) = (HsValBinds (add_where a an) bs) annBinds a (HsIPBinds an bs) = (HsIPBinds (add_where a an) bs) annBinds _ (EmptyLocalBinds x) = (EmptyLocalBinds x) -add_where :: AddEpAnn -> EpAnn' AnnList -> EpAnn' AnnList -add_where an@(AddEpAnn _ (AR rs)) (EpAnn a (AnnList anc o c r t) cs) +add_where :: AddEpAnn -> EpAnn AnnList -> EpAnn AnnList +add_where an@(AddEpAnn _ (EpaSpan rs)) (EpAnn a (AnnList anc o c r t) cs) | valid_anchor (anchor a) = EpAnn (widenAnchor a [an]) (AnnList anc o c (an:r) t) cs | otherwise = EpAnn (patch_anchor rs a) (AnnList (fmap (patch_anchor rs) anc) o c (an:r) t) cs -add_where an@(AddEpAnn _ (AR rs)) EpAnnNotUsed +add_where an@(AddEpAnn _ (EpaSpan rs)) EpAnnNotUsed = EpAnn (Anchor rs UnchangedAnchor) - (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) noCom -add_where (AddEpAnn _ (AD _)) _ = panic "add_where" - -- AD should only be used for transformations + (AnnList (Just $ Anchor rs UnchangedAnchor) Nothing Nothing [an] []) emptyComments +add_where (AddEpAnn _ (EpaDelta _)) _ = panic "add_where" + -- EpaDelta should only be used for transformations valid_anchor :: RealSrcSpan -> Bool valid_anchor r = srcSpanStartLine r >= 0 @@ -679,7 +679,7 @@ recordPatSynErr :: SrcSpan -> LPat GhcPs -> P a recordPatSynErr loc pat = addFatalError $ PsError (PsErrRecordSyntaxInPatSynDecl pat) [] loc -mkConDeclH98 :: EpAnn -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs] +mkConDeclH98 :: EpAnn [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs] -> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs -> ConDecl GhcPs @@ -833,7 +833,7 @@ checkTyVars pp_what equals_or_where tc tparms ; return (mkHsQTvs tvs, concat anns) } where check (HsTypeArg _ ki@(L loc _)) = addFatalError $ PsError (PsErrUnexpectedTypeAppInDecl ki pp_what (unLoc tc)) [] (locA loc) - check (HsValArg ty) = chkParens [] noCom ty + check (HsValArg ty) = chkParens [] emptyComments ty check (HsArgPar sp) = addFatalError $ PsError (PsErrMalformedDecl pp_what (unLoc tc)) [] sp -- Keep around an action for adjusting the annotations of extra parens chkParens :: [AddEpAnn] -> EpAnnComments -> LHsType GhcPs @@ -869,7 +869,7 @@ checkDatatypeContext (Just c) unless allowed $ addError $ PsError (PsErrIllegalDataTypeContext c) [] (getLocA c) type LRuleTyTmVar = Located RuleTyTmVar -data RuleTyTmVar = RuleTyTmVar EpAnn (LocatedN RdrName) (Maybe (LHsType GhcPs)) +data RuleTyTmVar = RuleTyTmVar (EpAnn [AddEpAnn]) (LocatedN RdrName) (Maybe (LHsType GhcPs)) -- ^ Essentially a wrapper for a @RuleBndr GhcPs@ -- turns RuleTyTmVars into RuleBnrs - this is straightforward @@ -960,18 +960,18 @@ checkTyClHdr is_cls ty -- Combine the annotations from the HsParTy and HsStarTy into a -- new one for the LocatedN RdrName - newAnns :: SrcSpanAnnA -> EpAnn' AnnParen -> SrcSpanAnnN + newAnns :: SrcSpanAnnA -> EpAnn AnnParen -> SrcSpanAnnN newAnns (SrcSpanAnn EpAnnNotUsed l) (EpAnn as (AnnParen _ o c) cs) = let lr = combineRealSrcSpans (realSrcSpan l) (anchor as) -- lr = widenAnchorR as (realSrcSpan l) - an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (AR $ realSrcSpan l) c []) cs) + an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c []) cs) in SrcSpanAnn an (RealSrcSpan lr Nothing) newAnns _ EpAnnNotUsed = panic "missing AnnParen" newAnns (SrcSpanAnn (EpAnn ap (AnnListItem ta) csp) l) (EpAnn as (AnnParen _ o c) cs) = let lr = combineRealSrcSpans (anchor ap) (anchor as) - an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (AR $ realSrcSpan l) c ta) (csp Semi.<> cs)) + an = (EpAnn (Anchor lr UnchangedAnchor) (NameAnn NameParens o (EpaSpan $ realSrcSpan l) c ta) (csp Semi.<> cs)) in SrcSpanAnn an (RealSrcSpan lr Nothing) -- | Yield a parse error if we have a function applied directly to a do block @@ -1017,9 +1017,9 @@ checkCmdBlockArguments :: LHsCmd GhcPs -> PV () -- @ checkContext :: LHsType GhcPs -> P (LHsContext GhcPs) checkContext orig_t@(L (SrcSpanAnn _ l) _orig_t) = - check ([],[],noCom) orig_t + check ([],[],emptyComments) orig_t where - check :: ([EpaAnchor],[EpaAnchor],EpAnnComments) + check :: ([EpaLocation],[EpaLocation],EpAnnComments) -> LHsType GhcPs -> P (LHsContext GhcPs) check (oparens,cparens,cs) (L _l (HsTupleTy ann' HsBoxedOrConstraintTuple ts)) -- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can @@ -1027,7 +1027,7 @@ checkContext orig_t@(L (SrcSpanAnn _ l) _orig_t) = -- Ditto () = do let (op,cp,cs') = case ann' of - EpAnnNotUsed -> ([],[],noCom) + EpAnnNotUsed -> ([],[],emptyComments) EpAnn _ (AnnParen _ o c) cs -> ([o],[c],cs) return (L (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnContext Nothing (op Semi.<> oparens) (cp Semi.<> cparens)) (cs Semi.<> cs')) l) ts) @@ -1036,16 +1036,16 @@ checkContext orig_t@(L (SrcSpanAnn _ l) _orig_t) = -- to be sure HsParTy doesn't get into the way = do let (op,cp,cs') = case ann' of - EpAnnNotUsed -> ([],[],noCom) + EpAnnNotUsed -> ([],[],emptyComments) EpAnn _ (AnnParen _ open close ) cs -> ([open],[close],cs) check (op++opi,cp++cpi,cs' Semi.<> csi) ty -- No need for anns, returning original check (_opi,_cpi,_csi) _t = - return (L (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnContext Nothing [] []) noCom) l) [orig_t]) + return (L (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnContext Nothing [] []) emptyComments) l) [orig_t]) -checkImportDecl :: Maybe EpaAnchor - -> Maybe EpaAnchor +checkImportDecl :: Maybe EpaLocation + -> Maybe EpaLocation -> P () checkImportDecl mPre mPost = do let whenJust mg f = maybe (pure ()) f mg @@ -1056,18 +1056,18 @@ checkImportDecl mPre mPost = do -- 'ImportQualifiedPost' is not in effect. whenJust mPost $ \post -> when (not importQualifiedPostEnabled) $ - failOpNotEnabledImportQualifiedPost (RealSrcSpan (epaAnchorRealSrcSpan post) Nothing) + failOpNotEnabledImportQualifiedPost (RealSrcSpan (epaLocationRealSrcSpan post) Nothing) -- Error if 'qualified' occurs in both pre and postpositive -- positions. whenJust mPost $ \post -> when (isJust mPre) $ - failOpImportQualifiedTwice (RealSrcSpan (epaAnchorRealSrcSpan post) Nothing) + failOpImportQualifiedTwice (RealSrcSpan (epaLocationRealSrcSpan post) Nothing) -- Warn if 'qualified' found in prepositive position and -- 'Opt_WarnPrepositiveQualifiedModule' is enabled. whenJust mPre $ \pre -> - warnPrepositiveQualifiedModule (RealSrcSpan (epaAnchorRealSrcSpan pre) Nothing) + warnPrepositiveQualifiedModule (RealSrcSpan (epaLocationRealSrcSpan pre) Nothing) -- ------------------------------------------------------------------------- -- Checking Patterns. @@ -1148,7 +1148,7 @@ checkAPat loc e0 = do (L l p) <- checkLPat e let aa = [AddEpAnn ai o, AddEpAnn ac c] (ai,ac) = parenTypeKws pt - return (ParPat (EpAnn (spanAsAnchor $ (widenSpan (locA l) aa)) an noCom) (L l p)) + return (ParPat (EpAnn (spanAsAnchor $ (widenSpan (locA l) aa)) an emptyComments) (L l p)) _ -> patFail (locA loc) (ppr e0) placeHolderPunRhs :: DisambECP b => PV (LocatedA b) @@ -1306,7 +1306,7 @@ isFunLhs e = go e [] [] _ -> return Nothing } go _ _ _ = return Nothing -mkBangTy :: EpAnn -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs +mkBangTy :: EpAnn [AddEpAnn] -> SrcStrictness -> LHsType GhcPs -> HsType GhcPs mkBangTy anns strictness = HsBangTy anns (HsSrcBang NoSourceText NoSrcUnpack strictness) @@ -1381,7 +1381,7 @@ type Fbind b = Either (LHsRecField GhcPs (LocatedA b)) (LHsRecProj GhcPs (Locate class DisambInfixOp b where mkHsVarOpPV :: LocatedN RdrName -> PV (LocatedN b) mkHsConOpPV :: LocatedN RdrName -> PV (LocatedN b) - mkHsInfixHolePV :: SrcSpan -> (EpAnnComments -> EpAnn' EpAnnUnboundVar) -> PV (Located b) + mkHsInfixHolePV :: SrcSpan -> (EpAnnComments -> EpAnn EpAnnUnboundVar) -> PV (Located b) instance DisambInfixOp (HsExpr GhcPs) where mkHsVarOpPV v = return $ L (getLoc v) (HsVar noExtField v) @@ -1719,7 +1719,7 @@ instance DisambECP (HsExpr GhcPs) where rejectPragmaPV (L l (HsPragE _ prag _)) = addError $ PsError (PsErrUnallowedPragma prag) [] (locA l) rejectPragmaPV _ = return () -hsHoleExpr :: EpAnn' EpAnnUnboundVar -> HsExpr GhcPs +hsHoleExpr :: EpAnn EpAnnUnboundVar -> HsExpr GhcPs hsHoleExpr anns = HsUnboundVar anns (mkVarOcc "_") type instance Anno (GRHS GhcPs (LocatedA (PatBuilder GhcPs))) = SrcSpan @@ -1811,7 +1811,7 @@ checkUnboxedStringLitPat (L loc lit) = mkPatRec :: LocatedA (PatBuilder GhcPs) -> HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) -> - EpAnn -> + EpAnn [AddEpAnn] -> PV (PatBuilder GhcPs) mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) anns | isRdrDataCon (unLoc c) @@ -2377,7 +2377,7 @@ mkRecConstrOrUpdate -> LHsExpr GhcPs -> SrcSpan -> ([Fbind (HsExpr GhcPs)], Maybe SrcSpan) - -> EpAnn + -> EpAnn [AddEpAnn] -> PV (HsExpr GhcPs) mkRecConstrOrUpdate _ (L _ (HsVar _ (L l c))) _lrec (fbinds,dd) anns | isRdrDataCon c @@ -2390,7 +2390,7 @@ mkRecConstrOrUpdate overloaded_update exp _ (fs,dd) anns | Just dd_loc <- dd = addFatalError $ PsError PsErrDotsInRecordUpdate [] dd_loc | otherwise = mkRdrRecordUpd overloaded_update exp fs anns -mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> EpAnn -> PV (HsExpr GhcPs) +mkRdrRecordUpd :: Bool -> LHsExpr GhcPs -> [Fbind (HsExpr GhcPs)] -> EpAnn [AddEpAnn] -> PV (HsExpr GhcPs) mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do -- We do not need to know if OverloadedRecordDot is in effect. We do -- however need to know if OverloadedRecordUpdate (passed in @@ -2443,7 +2443,7 @@ mkRdrRecordUpd overloaded_on exp@(L loc _) fbinds anns = do punnedVar f = if not pun then arg else noLocA . HsVar noExtField . noLocA . mkRdrUnqual . mkVarOccFS $ f mkRdrRecordCon - :: LocatedN RdrName -> HsRecordBinds GhcPs -> EpAnn -> HsExpr GhcPs + :: LocatedN RdrName -> HsRecordBinds GhcPs -> EpAnn [AddEpAnn] -> HsExpr GhcPs mkRdrRecordCon con flds anns = RecordCon { rcon_ext = anns, rcon_con = con, rcon_flds = flds } @@ -2482,7 +2482,7 @@ mkInlinePragma src (inl, match_info) mb_act mkImport :: Located CCallConv -> Located Safety -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs) - -> P (EpAnn -> HsDecl GhcPs) + -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs) mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) = case unLoc cconv of CCallConv -> mkCImport @@ -2583,7 +2583,7 @@ parseCImport cconv safety nm str sourceText = -- mkExport :: Located CCallConv -> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs) - -> P (EpAnn -> HsDecl GhcPs) + -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs) mkExport (L lc cconv) (L le (StringLiteral esrc entity _), v, ty) = return $ \ann -> ForD noExtField $ ForeignExport { fd_e_ext = ann, fd_name = v, fd_sig_ty = ty @@ -2611,7 +2611,7 @@ data ImpExpSubSpec = ImpExpAbs | ImpExpAllWith [LocatedA ImpExpQcSpec] data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName) - | ImpExpQcType EpaAnchor (LocatedN RdrName) + | ImpExpQcType EpaLocation (LocatedN RdrName) | ImpExpQcWildcard mkModuleImpExp :: [AddEpAnn] -> LocatedA ImpExpQcSpec -> ImpExpSubSpec -> P (IE GhcPs) @@ -2677,7 +2677,7 @@ checkImportSpec ie@(L _ specs) = mkImpExpSubSpec :: [LocatedA ImpExpQcSpec] -> P ([AddEpAnn], ImpExpSubSpec) mkImpExpSubSpec [] = return ([], ImpExpList []) mkImpExpSubSpec [L la ImpExpQcWildcard] = - return ([AddEpAnn AnnDotdot (AR $ la2r la)], ImpExpAll) + return ([AddEpAnn AnnDotdot (EpaSpan $ la2r la)], ImpExpAll) mkImpExpSubSpec xs = if (any (isImpExpQcWildcard . unLoc) xs) then return $ ([], ImpExpAllWith xs) @@ -2885,7 +2885,7 @@ mkSumOrTupleExpr l boxity (Tuple es) anns = do cs <- getCommentsFor (locA l) return $ L l (ExplicitTuple (EpAnn (spanAsAnchor $ locA l) anns cs) (map toTupArg es) boxity) where - toTupArg :: Either (EpAnn' EpaAnchor) (LHsExpr GhcPs) -> HsTupArg GhcPs + toTupArg :: Either (EpAnn EpaLocation) (LHsExpr GhcPs) -> HsTupArg GhcPs toTupArg (Left ann) = missingTupArg ann toTupArg (Right a) = Present noAnn a @@ -2912,7 +2912,7 @@ mkSumOrTuplePat l boxity (Tuple ps) anns = do cs <- getCommentsFor (locA l) return $ L l (PatBuilderPat (TuplePat (EpAnn (spanAsAnchor $ locA l) anns cs) ps' boxity)) where - toTupPat :: Either (EpAnn' EpaAnchor) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs) + toTupPat :: Either (EpAnn EpaLocation) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs) -- Ignore the element location so that the error message refers to the -- entire tuple. See #19504 (and the discussion) for details. toTupPat p = case p of @@ -2936,8 +2936,8 @@ mkLHsOpTy x op y = mkMultTy :: IsUnicodeSyntax -> Located Token -> LHsType GhcPs -> HsArrow GhcPs mkMultTy u tok t@(L _ (HsTyLit _ (HsNumTy (SourceText "1") 1))) -- See #18888 for the use of (SourceText "1") above - = HsLinearArrow u (Just $ AddEpAnn AnnPercentOne (AR $ realSrcSpan $ combineLocs tok (reLoc t))) -mkMultTy u tok t = HsExplicitMult u (Just $ AddEpAnn AnnPercent (AR $ realSrcSpan $ getLoc tok)) t + = HsLinearArrow u (Just $ AddEpAnn AnnPercentOne (EpaSpan $ realSrcSpan $ combineLocs tok (reLoc t))) +mkMultTy u tok t = HsExplicitMult u (Just $ AddEpAnn AnnPercent (EpaSpan $ realSrcSpan $ getLoc tok)) t ----------------------------------------------------------------------------- -- Token symbols @@ -2958,7 +2958,7 @@ mkRdrGetField loc arg field anns = , gf_field = field } -mkRdrProjection :: [Located (HsFieldLabel GhcPs)] -> EpAnn' AnnProjection -> HsExpr GhcPs +mkRdrProjection :: [Located (HsFieldLabel GhcPs)] -> EpAnn AnnProjection -> HsExpr GhcPs mkRdrProjection [] _ = panic "mkRdrProjection: The impossible has happened!" mkRdrProjection flds anns = HsProjection { @@ -2967,7 +2967,7 @@ mkRdrProjection flds anns = } mkRdrProjUpdate :: SrcSpanAnnA -> Located [Located (HsFieldLabel GhcPs)] - -> LHsExpr GhcPs -> Bool -> EpAnn + -> LHsExpr GhcPs -> Bool -> EpAnn [AddEpAnn] -> LHsRecProj GhcPs (LHsExpr GhcPs) mkRdrProjUpdate _ (L _ []) _ _ _ = panic "mkRdrProjUpdate: The impossible has happened!" mkRdrProjUpdate loc (L l flds) arg isPun anns = diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs index 2f5f304009..5369367ed2 100644 --- a/compiler/GHC/Parser/Types.hs +++ b/compiler/GHC/Parser/Types.hs @@ -26,9 +26,9 @@ import GHC.Parser.Annotation import Language.Haskell.Syntax data SumOrTuple b - = Sum ConTag Arity (LocatedA b) [EpaAnchor] [EpaAnchor] + = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation] -- ^ Last two are the locations of the '|' before and after the payload - | Tuple [Either (EpAnn' EpaAnchor) (LocatedA b)] + | Tuple [Either (EpAnn EpaLocation) (LocatedA b)] pprSumOrTuple :: Outputable b => Boxity -> SumOrTuple b -> SDoc pprSumOrTuple boxity = \case @@ -56,7 +56,7 @@ data PatBuilder p | PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p)) | PatBuilderAppType (LocatedA (PatBuilder p)) SrcSpan (HsPatSigType GhcPs) | PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName) - (LocatedA (PatBuilder p)) EpAnn + (LocatedA (PatBuilder p)) (EpAnn [AddEpAnn]) | PatBuilderVar (LocatedN RdrName) | PatBuilderOverLit (HsOverLit GhcPs) diff --git a/compiler/GHC/Rename/Names.hs b/compiler/GHC/Rename/Names.hs index 0502d8d962..32d9bd0da8 100644 --- a/compiler/GHC/Rename/Names.hs +++ b/compiler/GHC/Rename/Names.hs @@ -1868,14 +1868,14 @@ printMinimalImports hsc_src imports_w_usage to_ie_post_rn_var :: (HasOccName name) => LocatedA name -> LIEWrappedName name to_ie_post_rn_var (L l n) - | isDataOcc $ occName n = L l (IEPattern (AR $ la2r l) (L (la2na l) n)) - | otherwise = L l (IEName (L (la2na l) n)) + | isDataOcc $ occName n = L l (IEPattern (EpaSpan $ la2r l) (L (la2na l) n)) + | otherwise = L l (IEName (L (la2na l) n)) to_ie_post_rn :: (HasOccName name) => LocatedA name -> LIEWrappedName name to_ie_post_rn (L l n) - | isTcOcc occ && isSymOcc occ = L l (IEType (AR $ la2r l) (L (la2na l) n)) - | otherwise = L l (IEName (L (la2na l) n)) + | isTcOcc occ && isSymOcc occ = L l (IEType (EpaSpan $ la2r l) (L (la2na l) n)) + | otherwise = L l (IEName (L (la2na l) n)) where occ = occName n {- diff --git a/compiler/GHC/ThToHs.hs b/compiler/GHC/ThToHs.hs index 77c436c912..ce88ddeade 100644 --- a/compiler/GHC/ThToHs.hs +++ b/compiler/GHC/ThToHs.hs @@ -131,7 +131,7 @@ returnL :: a -> CvtM (Located a) returnL x = CvtM (\_ loc -> Right (loc, L loc x)) -- returnLA :: a -> CvtM (LocatedA a) -returnLA :: e -> CvtM (GenLocated (SrcSpanAnn' (EpAnn' ann)) e) +returnLA :: e -> CvtM (GenLocated (SrcSpanAnn' (EpAnn ann)) e) returnLA x = CvtM (\_ loc -> Right (loc, L (noAnnSrcSpan loc) x)) returnJustLA :: a -> CvtM (Maybe (LocatedA a)) diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr index 7e34424807..db88734005 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr @@ -9,8 +9,8 @@ { T17544.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (AR { T17544.hs:3:1-6 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:3:15-19 }))] + [(AddEpAnn AnnModule (EpaSpan { T17544.hs:3:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:3:15-19 }))] (AnnList (Nothing) (Nothing) @@ -51,8 +51,8 @@ (Anchor { T17544.hs:(5,1)-(6,16) } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:5:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:5:12-16 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:5:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:5:12-16 }))] (EpaComments [])) (NoAnnSortKey) @@ -90,7 +90,7 @@ { T17544.hs:6:3-4 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { T17544.hs:6:6-7 })) + (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:6:6-7 })) []) (EpaComments [])) @@ -113,7 +113,7 @@ { T17544.hs:6:9 } (UnchangedAnchor)) (AddRarrowAnn - (AR { T17544.hs:6:11-12 })) + (EpaSpan { T17544.hs:6:11-12 })) (EpaComments [])) (HsUnrestrictedArrow @@ -178,8 +178,8 @@ (Anchor { T17544.hs:(9,1)-(10,16) } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:9:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:9:12-16 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:9:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:9:12-16 }))] (EpaComments [])) (NoAnnSortKey) @@ -217,7 +217,7 @@ { T17544.hs:10:3-4 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { T17544.hs:10:6-7 })) + (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:10:6-7 })) []) (EpaComments [])) @@ -240,7 +240,7 @@ { T17544.hs:10:9 } (UnchangedAnchor)) (AddRarrowAnn - (AR { T17544.hs:10:11-12 })) + (EpaSpan { T17544.hs:10:11-12 })) (EpaComments [])) (HsUnrestrictedArrow @@ -301,8 +301,8 @@ (Anchor { T17544.hs:(13,1)-(14,16) } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:13:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:13:12-16 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:13:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:13:12-16 }))] (EpaComments [])) (NoAnnSortKey) @@ -340,7 +340,7 @@ { T17544.hs:14:3-4 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { T17544.hs:14:6-7 })) + (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:14:6-7 })) []) (EpaComments [])) @@ -363,7 +363,7 @@ { T17544.hs:14:9 } (UnchangedAnchor)) (AddRarrowAnn - (AR { T17544.hs:14:11-12 })) + (EpaSpan { T17544.hs:14:11-12 })) (EpaComments [])) (HsUnrestrictedArrow @@ -427,8 +427,8 @@ (Anchor { T17544.hs:(17,1)-(20,16) } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:17:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:17:12-16 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:17:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:17:12-16 }))] (EpaComments [])) (NoAnnSortKey) @@ -466,7 +466,7 @@ { T17544.hs:18:3-4 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { T17544.hs:18:6-7 })) + (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:18:6-7 })) []) (EpaComments [])) @@ -489,7 +489,7 @@ { T17544.hs:18:9 } (UnchangedAnchor)) (AddRarrowAnn - (AR { T17544.hs:18:11-12 })) + (EpaSpan { T17544.hs:18:11-12 })) (EpaComments [])) (HsUnrestrictedArrow @@ -532,7 +532,7 @@ { T17544.hs:20:3-4 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { T17544.hs:20:6-7 })) + (AddEpAnn AnnDcolon (EpaSpan { T17544.hs:20:6-7 })) []) (EpaComments [])) @@ -555,7 +555,7 @@ { T17544.hs:20:9 } (UnchangedAnchor)) (AddRarrowAnn - (AR { T17544.hs:20:11-12 })) + (EpaSpan { T17544.hs:20:11-12 })) (EpaComments [])) (HsUnrestrictedArrow @@ -612,10 +612,10 @@ (Anchor { T17544.hs:22:1-30 } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:22:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:22:12-16 })) - ,(AddEpAnn AnnOpenC (AR { T17544.hs:22:18 })) - ,(AddEpAnn AnnCloseC (AR { T17544.hs:22:30 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:22:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:22:12-16 })) + ,(AddEpAnn AnnOpenC (EpaSpan { T17544.hs:22:18 })) + ,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:22:30 }))] (EpaComments [])) (NoAnnSortKey) @@ -654,7 +654,7 @@ (Anchor { T17544.hs:22:20-28 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:22:20-23 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:22:20-23 }))] (EpaComments [])) (DataFamily) @@ -707,8 +707,8 @@ (Anchor { T17544.hs:23:1-8 } (UnchangedAnchor)) - [(AddEpAnn AnnInstance (AR { T17544.hs:23:1-8 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:23:17-21 }))] + [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:23:1-8 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:23:17-21 }))] (EpaComments [])) (NoAnnSortKey)) @@ -789,8 +789,8 @@ (Anchor { T17544.hs:(24,3)-(25,18) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:24:3-6 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:24:15-19 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:24:3-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:24:15-19 }))] (EpaComments [])) (DataType) @@ -804,7 +804,7 @@ (Anchor { T17544.hs:25:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544.hs:25:10-11 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:25:10-11 }))] (EpaComments [])) [(L @@ -872,10 +872,10 @@ (Anchor { T17544.hs:28:1-30 } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:28:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:28:12-16 })) - ,(AddEpAnn AnnOpenC (AR { T17544.hs:28:18 })) - ,(AddEpAnn AnnCloseC (AR { T17544.hs:28:30 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:28:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:28:12-16 })) + ,(AddEpAnn AnnOpenC (EpaSpan { T17544.hs:28:18 })) + ,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:28:30 }))] (EpaComments [])) (NoAnnSortKey) @@ -914,7 +914,7 @@ (Anchor { T17544.hs:28:20-28 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:28:20-23 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:28:20-23 }))] (EpaComments [])) (DataFamily) @@ -967,8 +967,8 @@ (Anchor { T17544.hs:29:1-8 } (UnchangedAnchor)) - [(AddEpAnn AnnInstance (AR { T17544.hs:29:1-8 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:29:17-21 }))] + [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:29:1-8 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:29:17-21 }))] (EpaComments [])) (NoAnnSortKey)) @@ -1049,8 +1049,8 @@ (Anchor { T17544.hs:(30,3)-(31,18) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:30:3-6 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:30:15-19 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:30:3-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:30:15-19 }))] (EpaComments [])) (DataType) @@ -1064,7 +1064,7 @@ (Anchor { T17544.hs:31:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544.hs:31:10-11 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:31:10-11 }))] (EpaComments [])) [(L @@ -1132,10 +1132,10 @@ (Anchor { T17544.hs:34:1-30 } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:34:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:34:12-16 })) - ,(AddEpAnn AnnOpenC (AR { T17544.hs:34:18 })) - ,(AddEpAnn AnnCloseC (AR { T17544.hs:34:30 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:34:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:34:12-16 })) + ,(AddEpAnn AnnOpenC (EpaSpan { T17544.hs:34:18 })) + ,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:34:30 }))] (EpaComments [])) (NoAnnSortKey) @@ -1174,7 +1174,7 @@ (Anchor { T17544.hs:34:20-28 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:34:20-23 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:34:20-23 }))] (EpaComments [])) (DataFamily) @@ -1227,8 +1227,8 @@ (Anchor { T17544.hs:35:1-8 } (UnchangedAnchor)) - [(AddEpAnn AnnInstance (AR { T17544.hs:35:1-8 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:35:17-21 }))] + [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:35:1-8 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:35:17-21 }))] (EpaComments [])) (NoAnnSortKey)) @@ -1309,8 +1309,8 @@ (Anchor { T17544.hs:(36,3)-(37,18) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:36:3-6 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:36:15-19 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:36:3-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:36:15-19 }))] (EpaComments [])) (DataType) @@ -1324,7 +1324,7 @@ (Anchor { T17544.hs:37:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544.hs:37:10-11 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:37:10-11 }))] (EpaComments [])) [(L @@ -1392,10 +1392,10 @@ (Anchor { T17544.hs:40:1-30 } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:40:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:40:12-16 })) - ,(AddEpAnn AnnOpenC (AR { T17544.hs:40:18 })) - ,(AddEpAnn AnnCloseC (AR { T17544.hs:40:30 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:40:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:40:12-16 })) + ,(AddEpAnn AnnOpenC (EpaSpan { T17544.hs:40:18 })) + ,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:40:30 }))] (EpaComments [])) (NoAnnSortKey) @@ -1434,7 +1434,7 @@ (Anchor { T17544.hs:40:20-28 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:40:20-23 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:40:20-23 }))] (EpaComments [])) (DataFamily) @@ -1487,8 +1487,8 @@ (Anchor { T17544.hs:41:1-8 } (UnchangedAnchor)) - [(AddEpAnn AnnInstance (AR { T17544.hs:41:1-8 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:41:17-21 }))] + [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:41:1-8 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:41:17-21 }))] (EpaComments [])) (NoAnnSortKey)) @@ -1569,8 +1569,8 @@ (Anchor { T17544.hs:(42,3)-(43,18) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:42:3-6 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:42:15-19 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:42:3-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:42:15-19 }))] (EpaComments [])) (DataType) @@ -1584,7 +1584,7 @@ (Anchor { T17544.hs:43:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544.hs:43:10-11 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:43:10-11 }))] (EpaComments [])) [(L @@ -1652,10 +1652,10 @@ (Anchor { T17544.hs:46:1-30 } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:46:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:46:12-16 })) - ,(AddEpAnn AnnOpenC (AR { T17544.hs:46:18 })) - ,(AddEpAnn AnnCloseC (AR { T17544.hs:46:30 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:46:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:46:12-16 })) + ,(AddEpAnn AnnOpenC (EpaSpan { T17544.hs:46:18 })) + ,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:46:30 }))] (EpaComments [])) (NoAnnSortKey) @@ -1694,7 +1694,7 @@ (Anchor { T17544.hs:46:20-28 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:46:20-23 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:46:20-23 }))] (EpaComments [])) (DataFamily) @@ -1747,8 +1747,8 @@ (Anchor { T17544.hs:47:1-8 } (UnchangedAnchor)) - [(AddEpAnn AnnInstance (AR { T17544.hs:47:1-8 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:47:17-21 }))] + [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:47:1-8 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:47:17-21 }))] (EpaComments [])) (NoAnnSortKey)) @@ -1829,8 +1829,8 @@ (Anchor { T17544.hs:(48,3)-(49,18) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:48:3-6 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:48:15-19 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:48:3-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:48:15-19 }))] (EpaComments [])) (DataType) @@ -1844,7 +1844,7 @@ (Anchor { T17544.hs:49:5-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544.hs:49:10-11 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:49:10-11 }))] (EpaComments [])) [(L @@ -1912,10 +1912,10 @@ (Anchor { T17544.hs:52:1-32 } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544.hs:52:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:52:13-17 })) - ,(AddEpAnn AnnOpenC (AR { T17544.hs:52:19 })) - ,(AddEpAnn AnnCloseC (AR { T17544.hs:52:32 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544.hs:52:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:52:13-17 })) + ,(AddEpAnn AnnOpenC (EpaSpan { T17544.hs:52:19 })) + ,(AddEpAnn AnnCloseC (EpaSpan { T17544.hs:52:32 }))] (EpaComments [])) (NoAnnSortKey) @@ -1954,7 +1954,7 @@ (Anchor { T17544.hs:52:21-30 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:52:21-24 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:52:21-24 }))] (EpaComments [])) (DataFamily) @@ -2007,8 +2007,8 @@ (Anchor { T17544.hs:53:1-8 } (UnchangedAnchor)) - [(AddEpAnn AnnInstance (AR { T17544.hs:53:1-8 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:53:18-22 }))] + [(AddEpAnn AnnInstance (EpaSpan { T17544.hs:53:1-8 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:53:18-22 }))] (EpaComments [])) (NoAnnSortKey)) @@ -2089,8 +2089,8 @@ (Anchor { T17544.hs:(54,3)-(55,20) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544.hs:54:3-6 })) - ,(AddEpAnn AnnWhere (AR { T17544.hs:54:16-20 }))] + [(AddEpAnn AnnData (EpaSpan { T17544.hs:54:3-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:54:16-20 }))] (EpaComments [])) (DataType) @@ -2104,7 +2104,7 @@ (Anchor { T17544.hs:55:5-20 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544.hs:55:11-12 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544.hs:55:11-12 }))] (EpaComments [])) [(L 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 b00f2efdeb..6d58a727af 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr +++ b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr @@ -9,8 +9,8 @@ { T17544_kw.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (AR { T17544_kw.hs:11:1-6 })) - ,(AddEpAnn AnnWhere (AR { T17544_kw.hs:13:13-17 }))] + [(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))] (AnnList (Nothing) (Nothing) @@ -50,8 +50,8 @@ (Anchor { T17544_kw.hs:(15,1)-(16,20) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544_kw.hs:15:1-4 })) - ,(AddEpAnn AnnWhere (AR { T17544_kw.hs:16:3-7 }))] + [(AddEpAnn AnnData (EpaSpan { T17544_kw.hs:15:1-4 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:16:3-7 }))] (EpaComments [])) (L @@ -67,8 +67,8 @@ (Anchor { T17544_kw.hs:(15,1)-(16,20) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T17544_kw.hs:15:1-4 })) - ,(AddEpAnn AnnWhere (AR { T17544_kw.hs:16:3-7 }))] + [(AddEpAnn AnnData (EpaSpan { T17544_kw.hs:15:1-4 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:16:3-7 }))] (EpaComments [])) (DataType) @@ -82,7 +82,7 @@ (Anchor { T17544_kw.hs:16:9-20 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544_kw.hs:16:15-16 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:16:15-16 }))] (EpaComments [])) [(L @@ -133,8 +133,8 @@ (Anchor { T17544_kw.hs:(18,1)-(19,26) } (UnchangedAnchor)) - [(AddEpAnn AnnNewtype (AR { T17544_kw.hs:18:1-7 })) - ,(AddEpAnn AnnWhere (AR { T17544_kw.hs:19:3-7 }))] + [(AddEpAnn AnnNewtype (EpaSpan { T17544_kw.hs:18:1-7 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:19:3-7 }))] (EpaComments [])) (L @@ -150,8 +150,8 @@ (Anchor { T17544_kw.hs:(18,1)-(19,26) } (UnchangedAnchor)) - [(AddEpAnn AnnNewtype (AR { T17544_kw.hs:18:1-7 })) - ,(AddEpAnn AnnWhere (AR { T17544_kw.hs:19:3-7 }))] + [(AddEpAnn AnnNewtype (EpaSpan { T17544_kw.hs:18:1-7 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:19:3-7 }))] (EpaComments [])) (NewType) @@ -165,7 +165,7 @@ (Anchor { T17544_kw.hs:19:9-26 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T17544_kw.hs:19:15-16 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:19:15-16 }))] (EpaComments [])) [(L @@ -188,7 +188,7 @@ (UnchangedAnchor)) (AnnListItem [(AddRarrowAnn - (AR { T17544_kw.hs:19:21-22 }))]) + (EpaSpan { T17544_kw.hs:19:21-22 }))]) (EpaComments [])) { T17544_kw.hs:19:18-19 }) (HsTupleTy @@ -198,8 +198,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { T17544_kw.hs:19:18 }) - (AR { T17544_kw.hs:19:19 })) + (EpaSpan { T17544_kw.hs:19:18 }) + (EpaSpan { T17544_kw.hs:19:19 })) (EpaComments [])) (HsBoxedOrConstraintTuple) @@ -242,8 +242,8 @@ (Anchor { T17544_kw.hs:(21,1)-(24,18) } (UnchangedAnchor)) - [(AddEpAnn AnnClass (AR { T17544_kw.hs:21:1-5 })) - ,(AddEpAnn AnnWhere (AR { T17544_kw.hs:23:3-7 }))] + [(AddEpAnn AnnClass (EpaSpan { T17544_kw.hs:21:1-5 })) + ,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:23:3-7 }))] (EpaComments [])) (NoAnnSortKey) @@ -281,7 +281,7 @@ { T17544_kw.hs:24:5-13 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { T17544_kw.hs:24:15-16 })) + (AddEpAnn AnnDcolon (EpaSpan { T17544_kw.hs:24:15-16 })) []) (EpaComments [])) diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr index bc428b5d0b..62427a5746 100644 --- a/testsuite/tests/module/mod185.stderr +++ b/testsuite/tests/module/mod185.stderr @@ -37,11 +37,11 @@ { mod185.hs:3:1-6 } (UnchangedAnchor)) (EpAnnImportDecl - (AR { mod185.hs:3:1-6 }) + (EpaSpan { mod185.hs:3:1-6 }) (Nothing) (Nothing) (Just - (AR { mod185.hs:3:16-24 })) + (EpaSpan { mod185.hs:3:16-24 })) (Nothing) (Nothing)) (EpaComments @@ -107,7 +107,7 @@ (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (AR { mod185.hs:5:6 }))) + (AddEpAnn AnnEqual (EpaSpan { mod185.hs:5:6 }))) (EpaComments [])) [] diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index 332e6e4822..d4956a81e4 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr @@ -9,8 +9,8 @@ { DumpParsedAst.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (AR { DumpParsedAst.hs:5:1-6 })) - ,(AddEpAnn AnnWhere (AR { DumpParsedAst.hs:5:22-26 }))] + [(AddEpAnn AnnModule (EpaSpan { DumpParsedAst.hs:5:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:5:22-26 }))] (AnnList (Nothing) (Nothing) @@ -41,7 +41,7 @@ { DumpParsedAst.hs:6:1-6 } (UnchangedAnchor)) (EpAnnImportDecl - (AR { DumpParsedAst.hs:6:1-6 }) + (EpaSpan { DumpParsedAst.hs:6:1-6 }) (Nothing) (Nothing) (Nothing) @@ -76,8 +76,8 @@ (Anchor { DumpParsedAst.hs:8:1-30 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { DumpParsedAst.hs:8:1-4 })) - ,(AddEpAnn AnnEqual (AR { DumpParsedAst.hs:8:12 }))] + [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:8:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:8:12 }))] (EpaComments [])) (L @@ -93,8 +93,8 @@ (Anchor { DumpParsedAst.hs:8:1-30 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { DumpParsedAst.hs:8:1-4 })) - ,(AddEpAnn AnnEqual (AR { DumpParsedAst.hs:8:12 }))] + [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:8:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:8:12 }))] (EpaComments [])) (DataType) @@ -108,7 +108,7 @@ (UnchangedAnchor)) (AnnListItem [(AddVbarAnn - (AR { DumpParsedAst.hs:8:19 }))]) + (EpaSpan { DumpParsedAst.hs:8:19 }))]) (EpaComments [])) { DumpParsedAst.hs:8:14-17 }) (ConDeclH98 @@ -188,12 +188,12 @@ (Anchor { DumpParsedAst.hs:10:1-45 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { DumpParsedAst.hs:10:1-4 })) - ,(AddEpAnn AnnFamily (AR { DumpParsedAst.hs:10:6-11 })) - ,(AddEpAnn AnnDcolon (AR { DumpParsedAst.hs:10:32-33 })) - ,(AddEpAnn AnnWhere (AR { DumpParsedAst.hs:10:41-45 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:10:30 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:10:20 }))] + [(AddEpAnn AnnType (EpaSpan { DumpParsedAst.hs:10:1-4 })) + ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:10:6-11 })) + ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:10:32-33 })) + ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:10:41-45 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:10:30 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:10:20 }))] (EpaComments [])) (ClosedTypeFamily @@ -205,7 +205,7 @@ (Anchor { DumpParsedAst.hs:11:3-36 } (UnchangedAnchor)) - [(AddEpAnn AnnEqual (AR { DumpParsedAst.hs:11:19 }))] + [(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:11:19 }))] (EpaComments [])) (L @@ -224,8 +224,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { DumpParsedAst.hs:11:10 }) - (AR { DumpParsedAst.hs:11:17 })) + (EpaSpan { DumpParsedAst.hs:11:10 }) + (EpaSpan { DumpParsedAst.hs:11:17 })) (EpaComments [])) (L @@ -295,8 +295,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { DumpParsedAst.hs:11:26 }) - (AR { DumpParsedAst.hs:11:36 })) + (EpaSpan { DumpParsedAst.hs:11:26 }) + (EpaSpan { DumpParsedAst.hs:11:36 })) (EpaComments [])) (L @@ -340,7 +340,7 @@ (Anchor { DumpParsedAst.hs:12:3-24 } (UnchangedAnchor)) - [(AddEpAnn AnnEqual (AR { DumpParsedAst.hs:12:19 }))] + [(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:12:19 }))] (EpaComments [])) (L @@ -357,9 +357,9 @@ (Anchor { DumpParsedAst.hs:12:10 } (UnchangedAnchor)) - [(AddEpAnn AnnSimpleQuote (AR { DumpParsedAst.hs:12:10 })) - ,(AddEpAnn AnnOpenS (AR { DumpParsedAst.hs:12:11 })) - ,(AddEpAnn AnnCloseS (AR { DumpParsedAst.hs:12:12 }))] + [(AddEpAnn AnnSimpleQuote (EpaSpan { DumpParsedAst.hs:12:10 })) + ,(AddEpAnn AnnOpenS (EpaSpan { DumpParsedAst.hs:12:11 })) + ,(AddEpAnn AnnCloseS (EpaSpan { DumpParsedAst.hs:12:12 }))] (EpaComments [])) (IsPromoted) @@ -394,9 +394,9 @@ (Anchor { DumpParsedAst.hs:10:20-30 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpParsedAst.hs:10:24-25 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:10:20 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:10:30 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:10:24-25 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:10:20 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:10:30 }))] (EpaComments [])) (()) @@ -413,8 +413,8 @@ (UnchangedAnchor)) (AnnParen (AnnParensSquare) - (AR { DumpParsedAst.hs:10:27 }) - (AR { DumpParsedAst.hs:10:29 })) + (EpaSpan { DumpParsedAst.hs:10:27 }) + (EpaSpan { DumpParsedAst.hs:10:29 })) (EpaComments [])) (L @@ -469,10 +469,10 @@ (Anchor { DumpParsedAst.hs:15:1-29 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { DumpParsedAst.hs:15:1-4 })) - ,(AddEpAnn AnnEqual (AR { DumpParsedAst.hs:15:19 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:15:17 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:15:10 }))] + [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:15:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:15:19 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:15:17 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:15:10 }))] (EpaComments [])) (L @@ -503,9 +503,9 @@ (Anchor { DumpParsedAst.hs:15:10-17 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpParsedAst.hs:15:13-14 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:15:10 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:15:17 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:15:13-14 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:15:10 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:15:17 }))] (EpaComments [])) (()) @@ -534,10 +534,10 @@ (Anchor { DumpParsedAst.hs:15:1-29 } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { DumpParsedAst.hs:15:1-4 })) - ,(AddEpAnn AnnEqual (AR { DumpParsedAst.hs:15:19 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:15:17 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:15:10 }))] + [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:15:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:15:19 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:15:17 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:15:10 }))] (EpaComments [])) (DataType) @@ -576,8 +576,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { DumpParsedAst.hs:15:25 }) - (AR { DumpParsedAst.hs:15:29 })) + (EpaSpan { DumpParsedAst.hs:15:25 }) + (EpaSpan { DumpParsedAst.hs:15:29 })) (EpaComments [])) (L @@ -634,14 +634,14 @@ (Anchor { DumpParsedAst.hs:17:1-54 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { DumpParsedAst.hs:17:1-4 })) - ,(AddEpAnn AnnFamily (AR { DumpParsedAst.hs:17:6-11 })) - ,(AddEpAnn AnnDcolon (AR { DumpParsedAst.hs:17:42-43 })) - ,(AddEpAnn AnnWhere (AR { DumpParsedAst.hs:17:50-54 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:17:23 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:17:16 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:17:40 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:17:25 }))] + [(AddEpAnn AnnType (EpaSpan { DumpParsedAst.hs:17:1-4 })) + ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:17:6-11 })) + ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:17:42-43 })) + ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:17:50-54 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:17:23 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:17:16 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:17:40 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:17:25 }))] (EpaComments [])) (ClosedTypeFamily @@ -653,7 +653,7 @@ (Anchor { DumpParsedAst.hs:18:3-30 } (UnchangedAnchor)) - [(AddEpAnn AnnEqual (AR { DumpParsedAst.hs:18:17 }))] + [(AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:18:17 }))] (EpaComments [])) (L @@ -798,9 +798,9 @@ (Anchor { DumpParsedAst.hs:17:16-23 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpParsedAst.hs:17:19-20 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:17:16 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:17:23 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:17:19-20 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:17:16 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:17:23 }))] (EpaComments [])) (()) @@ -830,9 +830,9 @@ (Anchor { DumpParsedAst.hs:17:25-40 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpParsedAst.hs:17:28-29 })) - ,(AddEpAnn AnnOpenP (AR { DumpParsedAst.hs:17:25 })) - ,(AddEpAnn AnnCloseP (AR { DumpParsedAst.hs:17:40 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:17:28-29 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpParsedAst.hs:17:25 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpParsedAst.hs:17:40 }))] (EpaComments [])) (()) @@ -848,7 +848,7 @@ { DumpParsedAst.hs:17:31 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpParsedAst.hs:17:33-34 })) + (EpaSpan { DumpParsedAst.hs:17:33-34 })) (EpaComments [])) (HsUnrestrictedArrow @@ -954,7 +954,7 @@ (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (AR { DumpParsedAst.hs:20:6 }))) + (AddEpAnn AnnEqual (EpaSpan { DumpParsedAst.hs:20:6 }))) (EpaComments [])) [] @@ -994,4 +994,4 @@ (FromSource)) [])))] (Nothing) - (Nothing))) + (Nothing)))
\ No newline at end of file diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr index f131c08880..c41d01d452 100644 --- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr +++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr @@ -119,7 +119,7 @@ (UnchangedAnchor)) (AnnListItem [(AddVbarAnn - (AR { DumpRenamedAst.hs:10:19 }))]) + (EpaSpan { DumpRenamedAst.hs:10:19 }))]) (EpaComments [])) { DumpRenamedAst.hs:10:14-17 }) (ConDeclH98 @@ -293,9 +293,9 @@ (Anchor { DumpRenamedAst.hs:12:20-30 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpRenamedAst.hs:12:24-25 })) - ,(AddEpAnn AnnOpenP (AR { DumpRenamedAst.hs:12:20 })) - ,(AddEpAnn AnnCloseP (AR { DumpRenamedAst.hs:12:30 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpRenamedAst.hs:12:24-25 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpRenamedAst.hs:12:20 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:12:30 }))] (EpaComments [])) (()) @@ -311,8 +311,8 @@ (UnchangedAnchor)) (AnnParen (AnnParensSquare) - (AR { DumpRenamedAst.hs:12:27 }) - (AR { DumpRenamedAst.hs:12:29 })) + (EpaSpan { DumpRenamedAst.hs:12:27 }) + (EpaSpan { DumpRenamedAst.hs:12:29 })) (EpaComments [])) (L @@ -376,7 +376,7 @@ { DumpRenamedAst.hs:16:20 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpRenamedAst.hs:16:22-23 })) + (EpaSpan { DumpRenamedAst.hs:16:22-23 })) (EpaComments [])) (HsUnrestrictedArrow @@ -397,7 +397,7 @@ { DumpRenamedAst.hs:16:25 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpRenamedAst.hs:16:27-28 })) + (EpaSpan { DumpRenamedAst.hs:16:27-28 })) (EpaComments [])) (HsUnrestrictedArrow @@ -453,7 +453,7 @@ (Anchor { DumpRenamedAst.hs:19:23 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpRenamedAst.hs:19:25-26 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpRenamedAst.hs:19:25-26 }))] (EpaComments [])) (L @@ -472,7 +472,7 @@ { DumpRenamedAst.hs:19:28 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpRenamedAst.hs:19:30-31 })) + (EpaSpan { DumpRenamedAst.hs:19:30-31 })) (EpaComments [])) (HsUnrestrictedArrow @@ -508,7 +508,7 @@ { DumpRenamedAst.hs:19:42-52 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpRenamedAst.hs:19:54-55 })) + (EpaSpan { DumpRenamedAst.hs:19:54-55 })) (EpaComments [])) (HsUnrestrictedArrow @@ -525,7 +525,7 @@ { DumpRenamedAst.hs:19:43 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpRenamedAst.hs:19:45-46 })) + (EpaSpan { DumpRenamedAst.hs:19:45-46 })) (EpaComments [])) (HsUnrestrictedArrow @@ -578,7 +578,7 @@ (UnchangedAnchor)) (AnnListItem [(AddRarrowAnn - (AR { DumpRenamedAst.hs:20:36-37 }))]) + (EpaSpan { DumpRenamedAst.hs:20:36-37 }))]) (EpaComments [])) { DumpRenamedAst.hs:20:10-34 }) (HsParTy @@ -611,7 +611,7 @@ { DumpRenamedAst.hs:20:22-25 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpRenamedAst.hs:20:27-28 })) + (EpaSpan { DumpRenamedAst.hs:20:27-28 })) (EpaComments [])) (HsUnrestrictedArrow @@ -733,9 +733,9 @@ (Anchor { DumpRenamedAst.hs:22:10-17 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpRenamedAst.hs:22:13-14 })) - ,(AddEpAnn AnnOpenP (AR { DumpRenamedAst.hs:22:10 })) - ,(AddEpAnn AnnCloseP (AR { DumpRenamedAst.hs:22:17 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpRenamedAst.hs:22:13-14 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpRenamedAst.hs:22:10 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:22:17 }))] (EpaComments [])) (()) @@ -915,9 +915,9 @@ (Anchor { DumpRenamedAst.hs:24:16-23 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpRenamedAst.hs:24:19-20 })) - ,(AddEpAnn AnnOpenP (AR { DumpRenamedAst.hs:24:16 })) - ,(AddEpAnn AnnCloseP (AR { DumpRenamedAst.hs:24:23 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpRenamedAst.hs:24:19-20 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpRenamedAst.hs:24:16 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:24:23 }))] (EpaComments [])) (()) @@ -939,9 +939,9 @@ (Anchor { DumpRenamedAst.hs:24:25-40 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { DumpRenamedAst.hs:24:28-29 })) - ,(AddEpAnn AnnOpenP (AR { DumpRenamedAst.hs:24:25 })) - ,(AddEpAnn AnnCloseP (AR { DumpRenamedAst.hs:24:40 }))] + [(AddEpAnn AnnDcolon (EpaSpan { DumpRenamedAst.hs:24:28-29 })) + ,(AddEpAnn AnnOpenP (EpaSpan { DumpRenamedAst.hs:24:25 })) + ,(AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:24:40 }))] (EpaComments [])) (()) @@ -956,7 +956,7 @@ { DumpRenamedAst.hs:24:31 } (UnchangedAnchor)) (AddRarrowAnn - (AR { DumpRenamedAst.hs:24:33-34 })) + (EpaSpan { DumpRenamedAst.hs:24:33-34 })) (EpaComments [])) (HsUnrestrictedArrow @@ -1122,8 +1122,8 @@ (UnchangedAnchor)) (AnnParen (AnnParensSquare) - (AR { DumpRenamedAst.hs:30:12 }) - (AR { DumpRenamedAst.hs:30:14 })) + (EpaSpan { DumpRenamedAst.hs:30:12 }) + (EpaSpan { DumpRenamedAst.hs:30:14 })) (EpaComments [])) (L @@ -1144,7 +1144,7 @@ (Anchor { DumpRenamedAst.hs:31:3-27 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { DumpRenamedAst.hs:31:3-6 }))] + [(AddEpAnn AnnType (EpaSpan { DumpRenamedAst.hs:31:3-6 }))] (EpaComments [])) (FamEqn @@ -1164,8 +1164,8 @@ (UnchangedAnchor)) (AnnParen (AnnParensSquare) - (AR { DumpRenamedAst.hs:31:10 }) - (AR { DumpRenamedAst.hs:31:12 })) + (EpaSpan { DumpRenamedAst.hs:31:10 }) + (EpaSpan { DumpRenamedAst.hs:31:12 })) (EpaComments [])) (L @@ -1283,9 +1283,9 @@ (AnnList (Nothing) (Just - (AddEpAnn AnnOpenP (AR { DumpRenamedAst.hs:8:18 }))) + (AddEpAnn AnnOpenP (EpaSpan { DumpRenamedAst.hs:8:18 }))) (Just - (AddEpAnn AnnCloseP (AR { DumpRenamedAst.hs:8:23 }))) + (AddEpAnn AnnCloseP (EpaSpan { DumpRenamedAst.hs:8:23 }))) [] []) (EpaComments @@ -1302,5 +1302,3 @@ {Name: GHC.Types.Type})))))])))))] (Nothing) (Nothing))) - - diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr index 3f477a4bec..f33f08312d 100644 --- a/testsuite/tests/parser/should_compile/KindSigs.stderr +++ b/testsuite/tests/parser/should_compile/KindSigs.stderr @@ -9,8 +9,8 @@ { KindSigs.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (AR { KindSigs.hs:6:1-6 })) - ,(AddEpAnn AnnWhere (AR { KindSigs.hs:6:17-21 }))] + [(AddEpAnn AnnModule (EpaSpan { KindSigs.hs:6:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:6:17-21 }))] (AnnList (Nothing) (Nothing) @@ -41,7 +41,7 @@ { KindSigs.hs:8:1-6 } (UnchangedAnchor)) (EpAnnImportDecl - (AR { KindSigs.hs:8:1-6 }) + (EpaSpan { KindSigs.hs:8:1-6 }) (Nothing) (Nothing) (Nothing) @@ -78,9 +78,9 @@ (Anchor { KindSigs.hs:11:1-23 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:11:1-4 })) - ,(AddEpAnn AnnFamily (AR { KindSigs.hs:11:6-11 })) - ,(AddEpAnn AnnWhere (AR { KindSigs.hs:11:19-23 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:11:1-4 })) + ,(AddEpAnn AnnFamily (EpaSpan { KindSigs.hs:11:6-11 })) + ,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:11:19-23 }))] (EpaComments [])) (ClosedTypeFamily @@ -92,7 +92,7 @@ (Anchor { KindSigs.hs:12:3-21 } (UnchangedAnchor)) - [(AddEpAnn AnnEqual (AR { KindSigs.hs:12:9 }))] + [(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:12:9 }))] (EpaComments [])) (L @@ -125,7 +125,7 @@ (Anchor { KindSigs.hs:12:11-13 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:12:15-16 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:12:15-16 }))] (EpaComments [])) (L @@ -202,8 +202,8 @@ (Anchor { KindSigs.hs:15:1-51 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:15:1-4 })) - ,(AddEpAnn AnnEqual (AR { KindSigs.hs:15:12 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:15:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:15:12 }))] (EpaComments [])) (L @@ -237,8 +237,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { KindSigs.hs:15:14 }) - (AR { KindSigs.hs:15:51 })) + (EpaSpan { KindSigs.hs:15:14 }) + (EpaSpan { KindSigs.hs:15:51 })) (EpaComments [])) (HsBoxedOrConstraintTuple) @@ -249,7 +249,7 @@ (UnchangedAnchor)) (AnnListItem [(AddCommaAnn - (AR { KindSigs.hs:15:27 }))]) + (EpaSpan { KindSigs.hs:15:27 }))]) (EpaComments [])) { KindSigs.hs:15:16-26 }) (HsKindSig @@ -257,7 +257,7 @@ (Anchor { KindSigs.hs:15:16-18 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:15:20-21 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:15:20-21 }))] (EpaComments [])) (L @@ -297,7 +297,7 @@ (UnchangedAnchor)) (AnnListItem [(AddCommaAnn - (AR { KindSigs.hs:15:33 }))]) + (EpaSpan { KindSigs.hs:15:33 }))]) (EpaComments [])) { KindSigs.hs:15:29-32 }) (HsTyVar @@ -320,7 +320,7 @@ (Anchor { KindSigs.hs:15:35-41 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:15:43-44 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:15:43-44 }))] (EpaComments [])) (L @@ -388,8 +388,8 @@ (Anchor { KindSigs.hs:16:1-54 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:16:1-4 })) - ,(AddEpAnn AnnEqual (AR { KindSigs.hs:16:13 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:16:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:16:13 }))] (EpaComments [])) (L @@ -423,8 +423,8 @@ (UnchangedAnchor)) (AnnParen (AnnParensHash) - (AR { KindSigs.hs:16:15-16 }) - (AR { KindSigs.hs:16:53-54 })) + (EpaSpan { KindSigs.hs:16:15-16 }) + (EpaSpan { KindSigs.hs:16:53-54 })) (EpaComments [])) (HsUnboxedTuple) @@ -435,7 +435,7 @@ (UnchangedAnchor)) (AnnListItem [(AddCommaAnn - (AR { KindSigs.hs:16:29 }))]) + (EpaSpan { KindSigs.hs:16:29 }))]) (EpaComments [])) { KindSigs.hs:16:18-28 }) (HsKindSig @@ -443,7 +443,7 @@ (Anchor { KindSigs.hs:16:18-20 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:16:22-23 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:16:22-23 }))] (EpaComments [])) (L @@ -483,7 +483,7 @@ (UnchangedAnchor)) (AnnListItem [(AddCommaAnn - (AR { KindSigs.hs:16:35 }))]) + (EpaSpan { KindSigs.hs:16:35 }))]) (EpaComments [])) { KindSigs.hs:16:31-34 }) (HsTyVar @@ -506,7 +506,7 @@ (Anchor { KindSigs.hs:16:37-43 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:16:45-46 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:16:45-46 }))] (EpaComments [])) (L @@ -574,8 +574,8 @@ (Anchor { KindSigs.hs:19:1-26 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:19:1-4 })) - ,(AddEpAnn AnnEqual (AR { KindSigs.hs:19:10 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:19:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:19:10 }))] (EpaComments [])) (L @@ -595,8 +595,8 @@ (UnchangedAnchor)) (AnnParen (AnnParensSquare) - (AR { KindSigs.hs:19:12 }) - (AR { KindSigs.hs:19:26 })) + (EpaSpan { KindSigs.hs:19:12 }) + (EpaSpan { KindSigs.hs:19:26 })) (EpaComments [])) (L @@ -606,7 +606,7 @@ (Anchor { KindSigs.hs:19:14-16 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:19:18-19 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:19:18-19 }))] (EpaComments [])) (L @@ -656,7 +656,7 @@ { KindSigs.hs:22:1-3 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { KindSigs.hs:22:5-6 })) + (AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:22:5-6 })) []) (EpaComments [])) @@ -680,7 +680,7 @@ { KindSigs.hs:22:8-20 } (UnchangedAnchor)) (AddRarrowAnn - (AR { KindSigs.hs:22:22-23 })) + (EpaSpan { KindSigs.hs:22:22-23 })) (EpaComments [])) (HsUnrestrictedArrow @@ -694,8 +694,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { KindSigs.hs:22:8 }) - (AR { KindSigs.hs:22:20 })) + (EpaSpan { KindSigs.hs:22:8 }) + (EpaSpan { KindSigs.hs:22:20 })) (EpaComments [])) (L @@ -705,7 +705,7 @@ (Anchor { KindSigs.hs:22:9-11 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:22:13-14 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:22:13-14 }))] (EpaComments [])) (L @@ -746,7 +746,7 @@ { KindSigs.hs:22:25-28 } (UnchangedAnchor)) (AddRarrowAnn - (AR { KindSigs.hs:22:30-31 })) + (EpaSpan { KindSigs.hs:22:30-31 })) (EpaComments [])) (HsUnrestrictedArrow @@ -775,8 +775,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { KindSigs.hs:22:33 }) - (AR { KindSigs.hs:22:44 })) + (EpaSpan { KindSigs.hs:22:33 }) + (EpaSpan { KindSigs.hs:22:44 })) (EpaComments [])) (L @@ -786,7 +786,7 @@ (Anchor { KindSigs.hs:22:34-35 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:22:37-38 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:22:37-38 }))] (EpaComments [])) (L @@ -798,8 +798,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { KindSigs.hs:22:34 }) - (AR { KindSigs.hs:22:35 })) + (EpaSpan { KindSigs.hs:22:34 }) + (EpaSpan { KindSigs.hs:22:35 })) (EpaComments [])) (HsBoxedOrConstraintTuple) @@ -876,7 +876,7 @@ (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (AR { KindSigs.hs:23:9 }))) + (AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:23:9 }))) (EpaComments [])) [] @@ -891,8 +891,8 @@ (UnchangedAnchor)) (NameAnnOnly (NameParens) - (AR { KindSigs.hs:23:11 }) - (AR { KindSigs.hs:23:12 }) + (EpaSpan { KindSigs.hs:23:11 }) + (EpaSpan { KindSigs.hs:23:12 }) []) (EpaComments [])) { KindSigs.hs:23:11-12 }) @@ -918,8 +918,8 @@ (Anchor { KindSigs.hs:26:1-29 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:26:1-4 })) - ,(AddEpAnn AnnEqual (AR { KindSigs.hs:26:11 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:26:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:26:11 }))] (EpaComments [])) (L @@ -937,9 +937,9 @@ (Anchor { KindSigs.hs:26:13 } (UnchangedAnchor)) - [(AddEpAnn AnnSimpleQuote (AR { KindSigs.hs:26:13 })) - ,(AddEpAnn AnnOpenS (AR { KindSigs.hs:26:14 })) - ,(AddEpAnn AnnCloseS (AR { KindSigs.hs:26:29 }))] + [(AddEpAnn AnnSimpleQuote (EpaSpan { KindSigs.hs:26:13 })) + ,(AddEpAnn AnnOpenS (EpaSpan { KindSigs.hs:26:14 })) + ,(AddEpAnn AnnCloseS (EpaSpan { KindSigs.hs:26:29 }))] (EpaComments [])) (IsPromoted) @@ -950,7 +950,7 @@ (Anchor { KindSigs.hs:26:16-19 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:26:21-22 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:26:21-22 }))] (EpaComments [])) (L @@ -999,8 +999,8 @@ (Anchor { KindSigs.hs:27:1-45 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:27:1-4 })) - ,(AddEpAnn AnnEqual (AR { KindSigs.hs:27:12 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:27:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:27:12 }))] (EpaComments [])) (L @@ -1018,8 +1018,8 @@ (Anchor { KindSigs.hs:27:14 } (UnchangedAnchor)) - [(AddEpAnn AnnOpenS (AR { KindSigs.hs:27:14 })) - ,(AddEpAnn AnnCloseS (AR { KindSigs.hs:27:45 }))] + [(AddEpAnn AnnOpenS (EpaSpan { KindSigs.hs:27:14 })) + ,(AddEpAnn AnnCloseS (EpaSpan { KindSigs.hs:27:45 }))] (EpaComments [])) (NotPromoted) @@ -1030,7 +1030,7 @@ (UnchangedAnchor)) (AnnListItem [(AddCommaAnn - (AR { KindSigs.hs:27:28 }))]) + (EpaSpan { KindSigs.hs:27:28 }))]) (EpaComments [])) { KindSigs.hs:27:16-27 }) (HsKindSig @@ -1038,7 +1038,7 @@ (Anchor { KindSigs.hs:27:16-19 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:27:21-22 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:27:21-22 }))] (EpaComments [])) (L @@ -1078,7 +1078,7 @@ (Anchor { KindSigs.hs:27:30-34 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:27:36-37 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:27:36-37 }))] (EpaComments [])) (L @@ -1127,8 +1127,8 @@ (Anchor { KindSigs.hs:28:1-44 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:28:1-4 })) - ,(AddEpAnn AnnEqual (AR { KindSigs.hs:28:14 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:28:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:28:14 }))] (EpaComments [])) (L @@ -1160,9 +1160,9 @@ (Anchor { KindSigs.hs:28:16 } (UnchangedAnchor)) - [(AddEpAnn AnnSimpleQuote (AR { KindSigs.hs:28:16 })) - ,(AddEpAnn AnnOpenP (AR { KindSigs.hs:28:17 })) - ,(AddEpAnn AnnCloseP (AR { KindSigs.hs:28:44 }))] + [(AddEpAnn AnnSimpleQuote (EpaSpan { KindSigs.hs:28:16 })) + ,(AddEpAnn AnnOpenP (EpaSpan { KindSigs.hs:28:17 })) + ,(AddEpAnn AnnCloseP (EpaSpan { KindSigs.hs:28:44 }))] (EpaComments [])) [(L @@ -1172,7 +1172,7 @@ (UnchangedAnchor)) (AnnListItem [(AddCommaAnn - (AR { KindSigs.hs:28:40 }))]) + (EpaSpan { KindSigs.hs:28:40 }))]) (EpaComments [])) { KindSigs.hs:28:19-39 }) (HsKindSig @@ -1180,7 +1180,7 @@ (Anchor { KindSigs.hs:28:19-29 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:28:31-32 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:28:31-32 }))] (EpaComments [])) (L @@ -1190,8 +1190,8 @@ (Anchor { KindSigs.hs:28:19 } (UnchangedAnchor)) - [(AddEpAnn AnnOpenS (AR { KindSigs.hs:28:19 })) - ,(AddEpAnn AnnCloseS (AR { KindSigs.hs:28:29 }))] + [(AddEpAnn AnnOpenS (EpaSpan { KindSigs.hs:28:19 })) + ,(AddEpAnn AnnCloseS (EpaSpan { KindSigs.hs:28:29 }))] (EpaComments [])) (NotPromoted) @@ -1202,7 +1202,7 @@ (UnchangedAnchor)) (AnnListItem [(AddCommaAnn - (AR { KindSigs.hs:28:23 }))]) + (EpaSpan { KindSigs.hs:28:23 }))]) (EpaComments [])) { KindSigs.hs:28:20-22 }) (HsTyVar @@ -1242,8 +1242,8 @@ (UnchangedAnchor)) (AnnParen (AnnParensSquare) - (AR { KindSigs.hs:28:34 }) - (AR { KindSigs.hs:28:39 })) + (EpaSpan { KindSigs.hs:28:34 }) + (EpaSpan { KindSigs.hs:28:39 })) (EpaComments [])) (L @@ -1292,8 +1292,8 @@ (Anchor { KindSigs.hs:31:1-31 } (UnchangedAnchor)) - [(AddEpAnn AnnType (AR { KindSigs.hs:31:1-4 })) - ,(AddEpAnn AnnEqual (AR { KindSigs.hs:31:19 }))] + [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:31:1-4 })) + ,(AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:31:19 }))] (EpaComments [])) (L @@ -1311,7 +1311,7 @@ (Anchor { KindSigs.hs:31:21-23 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:31:25-26 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:31:25-26 }))] (EpaComments [])) (L @@ -1361,7 +1361,7 @@ { KindSigs.hs:34:1-4 } (UnchangedAnchor)) (AnnSig - (AddEpAnn AnnDcolon (AR { KindSigs.hs:34:6-7 })) + (AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:34:6-7 })) []) (EpaComments [])) @@ -1386,8 +1386,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { KindSigs.hs:34:9 }) - (AR { KindSigs.hs:34:22 })) + (EpaSpan { KindSigs.hs:34:9 }) + (EpaSpan { KindSigs.hs:34:22 })) (EpaComments [])) (L @@ -1397,7 +1397,7 @@ (Anchor { KindSigs.hs:34:10-13 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { KindSigs.hs:34:15-16 }))] + [(AddEpAnn AnnDcolon (EpaSpan { KindSigs.hs:34:15-16 }))] (EpaComments [])) (L @@ -1480,7 +1480,7 @@ (UnchangedAnchor)) (GrhsAnn (Nothing) - (AddEpAnn AnnEqual (AR { KindSigs.hs:35:6 }))) + (AddEpAnn AnnEqual (EpaSpan { KindSigs.hs:35:6 }))) (EpaComments [])) [] diff --git a/testsuite/tests/parser/should_compile/T14189.stderr b/testsuite/tests/parser/should_compile/T14189.stderr index c1ebd053ac..5871c41b1c 100644 --- a/testsuite/tests/parser/should_compile/T14189.stderr +++ b/testsuite/tests/parser/should_compile/T14189.stderr @@ -46,7 +46,7 @@ (UnchangedAnchor)) (AnnListItem [(AddVbarAnn - (AR { T14189.hs:6:22 }))]) + (EpaSpan { T14189.hs:6:22 }))]) (EpaComments [])) { T14189.hs:6:15-20 }) (ConDeclH98 @@ -79,7 +79,7 @@ (UnchangedAnchor)) (AnnListItem [(AddVbarAnn - (AR { T14189.hs:6:27 }))]) + (EpaSpan { T14189.hs:6:27 }))]) (EpaComments [])) { T14189.hs:6:24-25 }) (ConDeclH98 @@ -116,9 +116,9 @@ { T14189.hs:6:33-40 } (UnchangedAnchor))) (Just - (AddEpAnn AnnOpenC (AR { T14189.hs:6:31 }))) + (AddEpAnn AnnOpenC (EpaSpan { T14189.hs:6:31 }))) (Just - (AddEpAnn AnnCloseC (AR { T14189.hs:6:42 }))) + (AddEpAnn AnnCloseC (EpaSpan { T14189.hs:6:42 }))) [] []) (EpaComments @@ -210,3 +210,4 @@ (FieldSelectors) {Name: T14189.f}))])])]) (Nothing))) + diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index e91ff5b3f4..987a5b88a6 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/testsuite/tests/parser/should_compile/T15323.stderr @@ -9,8 +9,8 @@ { T15323.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (AR { T15323.hs:3:1-6 })) - ,(AddEpAnn AnnWhere (AR { T15323.hs:3:15-19 }))] + [(AddEpAnn AnnModule (EpaSpan { T15323.hs:3:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:3:15-19 }))] (AnnList (Nothing) (Nothing) @@ -50,8 +50,8 @@ (Anchor { T15323.hs:(5,1)-(6,54) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T15323.hs:5:1-4 })) - ,(AddEpAnn AnnWhere (AR { T15323.hs:5:21-25 }))] + [(AddEpAnn AnnData (EpaSpan { T15323.hs:5:1-4 })) + ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:5:21-25 }))] (EpaComments [])) (L @@ -81,8 +81,8 @@ (Anchor { T15323.hs:(5,1)-(6,54) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T15323.hs:5:1-4 })) - ,(AddEpAnn AnnWhere (AR { T15323.hs:5:21-25 }))] + [(AddEpAnn AnnData (EpaSpan { T15323.hs:5:1-4 })) + ,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:5:21-25 }))] (EpaComments [])) (DataType) @@ -96,7 +96,7 @@ (Anchor { T15323.hs:6:5-54 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T15323.hs:6:17-18 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T15323.hs:6:17-18 }))] (EpaComments [])) [(L @@ -111,8 +111,8 @@ { T15323.hs:6:20-25 } (UnchangedAnchor)) ((,) - (AddEpAnn AnnForall (AR { T15323.hs:6:20-25 })) - (AddEpAnn AnnDot (AR { T15323.hs:6:29 }))) + (AddEpAnn AnnForall (EpaSpan { T15323.hs:6:20-25 })) + (AddEpAnn AnnDot (EpaSpan { T15323.hs:6:29 }))) (EpaComments [])) [(L @@ -140,7 +140,7 @@ (Just ((,) (NormalSyntax) - (AR { T15323.hs:6:38-39 }))) + (EpaSpan { T15323.hs:6:38-39 }))) [] []) (EpaComments @@ -154,8 +154,8 @@ (UnchangedAnchor)) (AnnParen (AnnParens) - (AR { T15323.hs:6:31 }) - (AR { T15323.hs:6:36 })) + (EpaSpan { T15323.hs:6:31 }) + (EpaSpan { T15323.hs:6:36 })) (EpaComments [])) (L diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr index 4787c0b8db..3ff58cc17e 100644 --- a/testsuite/tests/printer/T18791.stderr +++ b/testsuite/tests/printer/T18791.stderr @@ -1,6 +1,7 @@ ==================== Parser AST ==================== + (L { T18791.hs:1:1 } (HsModule @@ -9,8 +10,8 @@ { T18791.hs:1:1 } (UnchangedAnchor)) (AnnsModule - [(AddEpAnn AnnModule (AR { T18791.hs:2:1-6 })) - ,(AddEpAnn AnnWhere (AR { T18791.hs:2:15-19 }))] + [(AddEpAnn AnnModule (EpaSpan { T18791.hs:2:1-6 })) + ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:2:15-19 }))] (AnnList (Nothing) (Nothing) @@ -50,8 +51,8 @@ (Anchor { T18791.hs:(4,1)-(5,17) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T18791.hs:4:1-4 })) - ,(AddEpAnn AnnWhere (AR { T18791.hs:4:8-12 }))] + [(AddEpAnn AnnData (EpaSpan { T18791.hs:4:1-4 })) + ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:4:8-12 }))] (EpaComments [])) (L @@ -67,8 +68,8 @@ (Anchor { T18791.hs:(4,1)-(5,17) } (UnchangedAnchor)) - [(AddEpAnn AnnData (AR { T18791.hs:4:1-4 })) - ,(AddEpAnn AnnWhere (AR { T18791.hs:4:8-12 }))] + [(AddEpAnn AnnData (EpaSpan { T18791.hs:4:1-4 })) + ,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:4:8-12 }))] (EpaComments [])) (DataType) @@ -82,7 +83,7 @@ (Anchor { T18791.hs:5:3-17 } (UnchangedAnchor)) - [(AddEpAnn AnnDcolon (AR { T18791.hs:5:7-8 }))] + [(AddEpAnn AnnDcolon (EpaSpan { T18791.hs:5:7-8 }))] (EpaComments [])) [(L @@ -105,7 +106,7 @@ (UnchangedAnchor)) (AnnListItem [(AddRarrowAnn - (AR { T18791.hs:5:14-15 }))]) + (EpaSpan { T18791.hs:5:14-15 }))]) (EpaComments [])) { T18791.hs:5:10-12 }) (HsTyVar diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index f65deb456b..9f093c7faf 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/utils/check-exact/ExactPrint.hs @@ -95,7 +95,6 @@ data PrintOptions m a = PrintOptions , epTokenPrint :: String -> m a , epWhitespacePrint :: String -> m a , epRigidity :: Rigidity - , epContext :: !AstContextSet } -- | Helper to create a 'PrintOptions' @@ -112,7 +111,6 @@ printOptions astPrint tokenPrint wsPrint rigidity = PrintOptions , epWhitespacePrint = wsPrint , epTokenPrint = tokenPrint , epRigidity = rigidity - , epContext = defaultACS } -- | Options which can be used to print as a normal String. @@ -153,7 +151,7 @@ data EPState = EPState -- --------------------------------------------------------------------- --- AZ:TODO: this can just be a function :: (EpAnn' a) -> Entry +-- AZ:TODO: this can just be a function :: (EpAnn a) -> Entry class HasEntry ast where fromAnn :: ast -> Entry @@ -172,11 +170,11 @@ markAnnotated a = enterAnn (getAnnotationEntry a) a data Entry = Entry Anchor EpAnnComments | NoEntryVal -instance (HasEntry (EpAnn' an)) => HasEntry (SrcSpanAnn' (EpAnn' an)) where - fromAnn (SrcSpanAnn EpAnnNotUsed ss) = Entry (spanAsAnchor ss) noCom +instance (HasEntry (EpAnn an)) => HasEntry (SrcSpanAnn' (EpAnn an)) where + fromAnn (SrcSpanAnn EpAnnNotUsed ss) = Entry (spanAsAnchor ss) emptyComments fromAnn (SrcSpanAnn an _) = fromAnn an -instance HasEntry (EpAnn' a) where +instance HasEntry (EpAnn a) where fromAnn (EpAnn anchor _ cs) = Entry anchor cs fromAnn EpAnnNotUsed = NoEntryVal @@ -242,7 +240,6 @@ enterAnn (Entry anchor' cs) a = do setExtraDP Nothing let edp = case med of Nothing -> edp'' - -- Just dp -> addDP dp edp'' Just (Anchor _ (MovedAnchor dp)) -> dp -- Replace original with desired one. Allows all -- list entry values to be DP (1,0) @@ -336,7 +333,7 @@ class (Typeable a) => ExactPrint a where -- | Bare Located elements are simply stripped off without further -- processing. instance (ExactPrint a) => ExactPrint (Located a) where - getAnnotationEntry (L l _) = Entry (spanAsAnchor l) noCom + getAnnotationEntry (L l _) = Entry (spanAsAnchor l) emptyComments exact (L _ a) = markAnnotated a instance (ExactPrint a) => ExactPrint (LocatedA a) where @@ -439,14 +436,14 @@ printStringAtSs ss str = printStringAtKw' (realSrcSpan ss) str -- --------------------------------------------------------------------- -- AZ:TODO get rid of this -printStringAtMkw :: Maybe EpaAnchor -> String -> EPP () +printStringAtMkw :: Maybe EpaLocation -> String -> EPP () printStringAtMkw (Just aa) s = printStringAtAA aa s -printStringAtMkw Nothing s = printStringAtLsDelta (DP 0 1) s +printStringAtMkw Nothing s = printStringAtLsDelta (SameLine 1) s -printStringAtAA :: EpaAnchor -> String -> EPP () -printStringAtAA (AR r) s = printStringAtKw' r s -printStringAtAA (AD d) s = do +printStringAtAA :: EpaLocation -> String -> EPP () +printStringAtAA (EpaSpan r) s = printStringAtKw' r s +printStringAtAA (EpaDelta d) s = do pe <- getPriorEndD p1 <- getPosP printStringAtLsDelta d s @@ -476,18 +473,18 @@ markExternalSourceText l (SourceText txt) _ = printStringAtKw' (realSrcSpan l) t markAddEpAnn :: AddEpAnn -> EPP () markAddEpAnn a@(AddEpAnn kw _) = mark [a] kw -markLocatedMAA :: EpAnn' a -> (a -> Maybe AddEpAnn) -> EPP () +markLocatedMAA :: EpAnn a -> (a -> Maybe AddEpAnn) -> EPP () markLocatedMAA EpAnnNotUsed _ = return () markLocatedMAA (EpAnn _ a _) f = case f a of Nothing -> return () Just aa -> markAddEpAnn aa -markLocatedAA :: EpAnn' a -> (a -> AddEpAnn) -> EPP () +markLocatedAA :: EpAnn a -> (a -> AddEpAnn) -> EPP () markLocatedAA EpAnnNotUsed _ = return () markLocatedAA (EpAnn _ a _) f = markKw (f a) -markLocatedAAL :: EpAnn' a -> (a -> [AddEpAnn]) -> AnnKeywordId -> EPP () +markLocatedAAL :: EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> EPP () markLocatedAAL EpAnnNotUsed _ _ = return () markLocatedAAL (EpAnn _ a _) f kw = go (f a) where @@ -496,7 +493,7 @@ markLocatedAAL (EpAnn _ a _) f kw = go (f a) | kw' == kw = mark [aa] kw | otherwise = go as -markLocatedAALS :: EpAnn' a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Maybe String -> EPP () +markLocatedAALS :: EpAnn a -> (a -> [AddEpAnn]) -> AnnKeywordId -> Maybe String -> EPP () markLocatedAALS an f kw Nothing = markLocatedAAL an f kw markLocatedAALS EpAnnNotUsed _ _ _ = return () markLocatedAALS (EpAnn _ a _) f kw (Just str) = go (f a) @@ -508,34 +505,34 @@ markLocatedAALS (EpAnn _ a _) f kw (Just str) = go (f a) -- --------------------------------------------------------------------- -markArrow :: EpAnn' TrailingAnn -> HsArrow GhcPs -> EPP () +markArrow :: EpAnn TrailingAnn -> HsArrow GhcPs -> EPP () markArrow EpAnnNotUsed _ = pure () markArrow an _mult = markKwT (anns an) -- --------------------------------------------------------------------- -markAnnCloseP :: EpAnn' AnnPragma -> EPP () +markAnnCloseP :: EpAnn AnnPragma -> EPP () markAnnCloseP an = markLocatedAALS an (pure . apr_close) AnnClose (Just "#-}") -markAnnOpenP :: EpAnn' AnnPragma -> SourceText -> String -> EPP () +markAnnOpenP :: EpAnn AnnPragma -> SourceText -> String -> EPP () markAnnOpenP an NoSourceText txt = markLocatedAALS an (pure . apr_open) AnnOpen (Just txt) markAnnOpenP an (SourceText txt) _ = markLocatedAALS an (pure . apr_open) AnnOpen (Just txt) -markAnnOpen :: EpAnn -> SourceText -> String -> EPP () +markAnnOpen :: EpAnn [AddEpAnn] -> SourceText -> String -> EPP () markAnnOpen an NoSourceText txt = markLocatedAALS an id AnnOpen (Just txt) markAnnOpen an (SourceText txt) _ = markLocatedAALS an id AnnOpen (Just txt) -markAnnOpen' :: Maybe EpaAnchor -> SourceText -> String -> EPP () +markAnnOpen' :: Maybe EpaLocation -> SourceText -> String -> EPP () markAnnOpen' ms NoSourceText txt = printStringAtMkw ms txt markAnnOpen' ms (SourceText txt) _ = printStringAtMkw ms txt -- --------------------------------------------------------------------- -markOpeningParen, markClosingParen :: EpAnn' AnnParen -> EPP () +markOpeningParen, markClosingParen :: EpAnn AnnParen -> EPP () markOpeningParen an = markParen an fst markClosingParen an = markParen an snd -markParen :: EpAnn' AnnParen -> (forall a. (a,a) -> a) -> EPP () +markParen :: EpAnn AnnParen -> (forall a. (a,a) -> a) -> EPP () markParen EpAnnNotUsed _ = return () markParen (EpAnn _ (AnnParen pt o c) _) f = markKwA (f $ kw pt) (f (o, c)) where @@ -544,34 +541,34 @@ markParen (EpAnn _ (AnnParen pt o c) _) f = markKwA (f $ kw pt) (f (o, c)) kw AnnParensSquare = (AnnOpenS, AnnCloseS) -markAnnKw :: EpAnn' a -> (a -> EpaAnchor) -> AnnKeywordId -> EPP () +markAnnKw :: EpAnn a -> (a -> EpaLocation) -> AnnKeywordId -> EPP () markAnnKw EpAnnNotUsed _ _ = return () markAnnKw (EpAnn _ a _) f kw = markKwA kw (f a) -markAnnKwAll :: EpAnn' a -> (a -> [EpaAnchor]) -> AnnKeywordId -> EPP () +markAnnKwAll :: EpAnn a -> (a -> [EpaLocation]) -> AnnKeywordId -> EPP () markAnnKwAll EpAnnNotUsed _ _ = return () markAnnKwAll (EpAnn _ a _) f kw = mapM_ (markKwA kw) (sort (f a)) -markAnnKwM :: EpAnn' a -> (a -> Maybe EpaAnchor) -> AnnKeywordId -> EPP () +markAnnKwM :: EpAnn a -> (a -> Maybe EpaLocation) -> AnnKeywordId -> EPP () markAnnKwM EpAnnNotUsed _ _ = return () markAnnKwM (EpAnn _ a _) f kw = go (f a) where go Nothing = return () go (Just s) = markKwA kw s -markALocatedA :: EpAnn' AnnListItem -> EPP () +markALocatedA :: EpAnn AnnListItem -> EPP () markALocatedA EpAnnNotUsed = return () markALocatedA (EpAnn _ a _) = markTrailing (lann_trailing a) -markEpAnn :: EpAnn -> AnnKeywordId -> EPP () +markEpAnn :: EpAnn [AddEpAnn] -> AnnKeywordId -> EPP () markEpAnn EpAnnNotUsed _ = return () markEpAnn (EpAnn _ a _) kw = mark a kw -markEpAnn' :: EpAnn' ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP () +markEpAnn' :: EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP () markEpAnn' EpAnnNotUsed _ _ = return () markEpAnn' (EpAnn _ a _) f kw = mark (f a) kw -markEpAnnAll :: EpAnn' ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP () +markEpAnnAll :: EpAnn ann -> (ann -> [AddEpAnn]) -> AnnKeywordId -> EPP () markEpAnnAll EpAnnNotUsed _ _ = return () markEpAnnAll (EpAnn _ a _) f kw = mapM_ markKw (sort anns) where @@ -598,12 +595,12 @@ markKw :: AddEpAnn -> EPP () markKw (AddEpAnn kw ss) = markKwA kw ss -- | This should be the main driver of the process, managing comments -markKwA :: AnnKeywordId -> EpaAnchor -> EPP () +markKwA :: AnnKeywordId -> EpaLocation -> EPP () markKwA kw aa = printStringAtAA aa (keywordToString (G kw)) -- --------------------------------------------------------------------- -markAnnList :: EpAnn' AnnList -> EPP () -> EPP () +markAnnList :: EpAnn AnnList -> EPP () -> EPP () markAnnList EpAnnNotUsed action = action markAnnList an@(EpAnn _ ann _) action = do p <- getPosP @@ -815,7 +812,7 @@ instance ExactPrint (InstDecl GhcPs) where -- --------------------------------------------------------------------- -exactDataFamInstDecl :: EpAnn -> TopLevelFlag -> (DataFamInstDecl GhcPs) -> EPP () +exactDataFamInstDecl :: EpAnn [AddEpAnn] -> TopLevelFlag -> (DataFamInstDecl GhcPs) -> EPP () exactDataFamInstDecl an top_lvl (DataFamInstDecl ( FamEqn { feqn_tycon = tycon , feqn_bndrs = bndrs @@ -1005,7 +1002,7 @@ instance ExactPrint (RuleDecl GhcPs) where -- inContext (Set.singleton Intercalate) $ mark GHC.AnnSemi -- markTrailingSemi -markActivation :: EpAnn' a -> (a -> [AddEpAnn]) -> Activation -> Annotated () +markActivation :: EpAnn a -> (a -> [AddEpAnn]) -> Activation -> Annotated () markActivation an fn act = do case act of ActiveBefore src phase -> do @@ -1109,7 +1106,7 @@ instance (ExactPrint body) => ExactPrint (FamEqn GhcPs body) where -- --------------------------------------------------------------------- exactHsFamInstLHS :: - EpAnn + EpAnn [AddEpAnn] -> LocatedN RdrName -- -> Maybe [LHsTyVarBndr () GhcPs] -> HsOuterTyVarBndrs () GhcPs @@ -1653,7 +1650,7 @@ instance ExactPrint (Sig GhcPs) where -- --------------------------------------------------------------------- -exactVarSig :: (ExactPrint a) => EpAnn' AnnSig -> [LocatedN RdrName] -> a -> EPP () +exactVarSig :: (ExactPrint a) => EpAnn AnnSig -> [LocatedN RdrName] -> a -> EPP () exactVarSig an vars ty = do mapM_ markAnnotated vars markLocatedAA an asDcolon @@ -2064,7 +2061,7 @@ instance ExactPrint (HsExpr GhcPs) where -- --------------------------------------------------------------------- exactDo :: (ExactPrint body) - => EpAnn' AnnList -> (HsStmtContext any) -> body -> EPP () + => EpAnn AnnList -> (HsStmtContext any) -> body -> EPP () exactDo an (DoExpr m) stmts = exactMdo an m AnnDo >> markAnnotatedWithLayout stmts exactDo an GhciStmtCtxt stmts = markLocatedAAL an al_rest AnnDo >> markAnnotatedWithLayout stmts exactDo an ArrowExpr stmts = markLocatedAAL an al_rest AnnDo >> markAnnotatedWithLayout stmts @@ -2073,7 +2070,7 @@ exactDo _ ListComp stmts = markAnnotatedWithLayout stmts exactDo _ MonadComp stmts = markAnnotatedWithLayout stmts exactDo _ _ _ = panic "pprDo" -- PatGuard, ParStmtCxt -exactMdo :: EpAnn' AnnList -> Maybe ModuleName -> AnnKeywordId -> EPP () +exactMdo :: EpAnn AnnList -> Maybe ModuleName -> AnnKeywordId -> EPP () exactMdo an Nothing kw = markLocatedAAL an al_rest kw exactMdo an (Just module_name) kw = markLocatedAALS an al_rest kw (Just n) where @@ -2582,7 +2579,7 @@ instance ExactPrint (ParStmtBlock GhcPs GhcPs) where getAnnotationEntry = const NoEntryVal exact (ParStmtBlock _ stmts _ _) = markAnnotated stmts -exactTransStmt :: EpAnn -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm -> EPP () +exactTransStmt :: EpAnn [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm -> EPP () exactTransStmt an by using ThenForm = do debugM $ "exactTransStmt:ThenForm" markEpAnn an AnnThen @@ -2817,7 +2814,7 @@ instance ExactPrint (FamilyDecl GhcPs) where -- Just eqns -> vcat $ map (ppr_fam_inst_eqn . unLoc) eqns ) -- _ -> (empty, empty) -exactFlavour :: EpAnn -> FamilyInfo GhcPs -> EPP () +exactFlavour :: EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> EPP () exactFlavour an DataFamily = markEpAnn an AnnData exactFlavour an OpenTypeFamily = markEpAnn an AnnType exactFlavour an (ClosedTypeFamily {}) = markEpAnn an AnnType @@ -2827,7 +2824,7 @@ exactFlavour an (ClosedTypeFamily {}) = markEpAnn an AnnType -- --------------------------------------------------------------------- -exactDataDefn :: EpAnn +exactDataDefn :: EpAnn [AddEpAnn] -> (Maybe (LHsContext GhcPs) -> EPP ()) -- Printing the header -> HsDataDefn GhcPs -> EPP () @@ -2852,7 +2849,7 @@ exactDataDefn an exactHdr mapM_ markAnnotated derivings return () -exactVanillaDeclHead :: EpAnn +exactVanillaDeclHead :: EpAnn [AddEpAnn] -> LocatedN RdrName -> LHsQTyVars GhcPs -> LexicalFixity @@ -3184,7 +3181,7 @@ instance ExactPrint (LocatedN RdrName) where markTrailing t markName :: NameAdornment - -> EpaAnchor -> Maybe (EpaAnchor,RdrName) -> EpaAnchor -> EPP () + -> EpaLocation -> Maybe (EpaLocation,RdrName) -> EpaLocation -> EPP () markName adorn open mname close = do let (kwo,kwc) = adornments adorn markKw (AddEpAnn kwo open) @@ -3208,7 +3205,7 @@ markTrailing ts = do -- --------------------------------------------------------------------- -- based on pp_condecls in Decls.hs -exact_condecls :: EpAnn -> [LConDecl GhcPs] -> EPP () +exact_condecls :: EpAnn [AddEpAnn] -> [LConDecl GhcPs] -> EPP () exact_condecls an cs | gadt_syntax -- In GADT syntax -- = hang (text "where") 2 (vcat (map ppr cs)) @@ -3828,7 +3825,7 @@ sourceTextToString (SourceText txt) _ = txt -- --------------------------------------------------------------------- -exactUserCon :: (ExactPrint con) => EpAnn -> con -> HsConPatDetails GhcPs -> EPP () +exactUserCon :: (ExactPrint con) => EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs -> EPP () exactUserCon _ c (InfixCon p1 p2) = markAnnotated p1 >> markAnnotated c >> markAnnotated p2 exactUserCon an c details = do markAnnotated c @@ -3868,7 +3865,7 @@ printStringAtLsDelta cl s = do -- --------------------------------------------------------------------- isGoodDeltaWithOffset :: DeltaPos -> LayoutStartCol -> Bool -isGoodDeltaWithOffset dp colOffset = isGoodDelta (DP l c) +isGoodDeltaWithOffset dp colOffset = isGoodDelta (deltaPos l c) where (l,c) = undelta (0,0) dp colOffset printQueuedComment :: (Monad m, Monoid w) => RealSrcSpan -> Comment -> DeltaPos -> EP w m () @@ -3877,7 +3874,7 @@ printQueuedComment loc Comment{commentContents} dp = do colOffset <- getLayoutOffsetP let (dr,dc) = undelta (0,0) dp colOffset -- do not lose comments against the left margin - when (isGoodDelta (DP dr (max 0 dc))) $ do + when (isGoodDelta (deltaPos dr (max 0 dc))) $ do printCommentAt (undelta p dp colOffset) commentContents setPriorEndASTD False loc p' <- getPosP @@ -3911,7 +3908,7 @@ printQueuedComment Comment{commentContents} dp = do -- withOffset :: (Monad m, Monoid w) => Annotation -> (EP w m a -> EP w m a) withOffset a = - local (\s -> s { epAnn = a, epContext = pushAcs (epContext s) }) + local (\s -> s { epAnn = a }) ------------------------------------------------------------------------ @@ -4083,7 +4080,8 @@ printString layout str = do modify (\s -> s { pLHS = LayoutStartCol c, pMarkLayout = False } ) -- Advance position, taking care of any newlines in the string - let strDP@(DP cr _cc) = dpFromString str + let strDP = dpFromString str + cr = getDeltaLine strDP p <- getPosP colOffset <- getLayoutOffsetP debugM $ "printString:(p,colOffset,strDP,cr)=" ++ show (p,colOffset,strDP,cr) diff --git a/utils/check-exact/Lookup.hs b/utils/check-exact/Lookup.hs index 8edf4ac1f0..18e4e32f6f 100644 --- a/utils/check-exact/Lookup.hs +++ b/utils/check-exact/Lookup.hs @@ -5,12 +5,7 @@ module Lookup , Comment(..) ) where --- import Language.Haskell.ExactPrint.Types import GHC (AnnKeywordId(..)) --- import GHC.Utils.Outputable hiding ( (<>) ) --- import Data.Data (Data) --- import GHC.Types.SrcLoc --- import GHC.Driver.Session import Types -- | Maps `AnnKeywordId` to the corresponding String representation. @@ -78,7 +73,6 @@ keywordToString kw = (G AnnLam ) -> "\\" (G AnnLarrow ) -> "<-" (G AnnLet ) -> "let" - -- (G AnnLolly ) -> "#->" (G AnnLollyU ) -> "⊸" (G AnnMdo ) -> "mdo" (G AnnMinus ) -> "-" @@ -93,8 +87,6 @@ keywordToString kw = (G AnnOpenEQU ) -> "⟦" (G AnnOpenP ) -> "(" (G AnnOpenPH ) -> "(#" - -- (G AnnOpenPE ) -> "$(" - -- (G AnnOpenPTE ) -> "$$(" (G AnnOpenS ) -> "[" (G AnnPattern ) -> "pattern" (G AnnPercent ) -> "%" diff --git a/utils/check-exact/Main.hs b/utils/check-exact/Main.hs index 0b5594fe20..a9618be40b 100644 --- a/utils/check-exact/Main.hs +++ b/utils/check-exact/Main.hs @@ -51,7 +51,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin -- "../../testsuite/tests/ghc-api/exactprint/LocToName.hs" (Just changeLocToName) -- "../../testsuite/tests/ghc-api/exactprint/LetIn1.hs" (Just changeLetIn1) -- "../../testsuite/tests/ghc-api/exactprint/WhereIn4.hs" (Just changeWhereIn4) - -- "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1) + "../../testsuite/tests/ghc-api/exactprint/AddDecl1.hs" (Just changeAddDecl1) -- "../../testsuite/tests/ghc-api/exactprint/AddDecl2.hs" (Just changeAddDecl2) -- "../../testsuite/tests/ghc-api/exactprint/AddDecl3.hs" (Just changeAddDecl3) -- "../../testsuite/tests/ghc-api/exactprint/LocalDecls.hs" (Just changeLocalDecls) @@ -63,7 +63,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl3.hs" (Just addLocaLDecl3) -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl4.hs" (Just addLocaLDecl4) -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl5.hs" (Just addLocaLDecl5) - -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just (Just addLocaLDecl6)) + -- "../../testsuite/tests/ghc-api/exactprint/AddLocalDecl6.hs" (Just addLocaLDecl6) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl1.hs" (Just rmDecl1) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl2.hs" (Just rmDecl2) -- "../../testsuite/tests/ghc-api/exactprint/RmDecl3.hs" (Just rmDecl3) @@ -75,8 +75,8 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin -- "../../testsuite/tests/ghc-api/exactprint/RmTypeSig2.hs" (Just rmTypeSig2) -- "../../testsuite/tests/ghc-api/exactprint/AddHiding1.hs" (Just addHiding1) -- "../../testsuite/tests/ghc-api/exactprint/AddHiding2.hs" (Just addHiding2) - -- "../../testsuite/tests/printer/Ppr001.hs" Nothing + -- "../../testsuite/tests/printer/Ppr001.hs" Nothing -- "../../testsuite/tests/ghc-api/annotations/CommentsTest.hs" Nothing -- "../../testsuite/tests/hiefile/should_compile/Constructors.hs" Nothing -- "../../testsuite/tests/hiefile/should_compile/Scopes.hs" Nothing @@ -172,7 +172,7 @@ _tt = testOneFile changers "/home/alanz/mysrc/git.haskell.org/worktree/exactprin -- "../../testsuite/tests/printer/Test16230.hs" Nothing -- "../../testsuite/tests/printer/Test16236.hs" Nothing -- "../../testsuite/tests/printer/Test17519.hs" Nothing - "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing + -- "../../testsuite/tests/printer/InTreeAnnotations1.hs" Nothing -- "../../testsuite/tests/qualifieddo/should_compile/qdocompile001.hs" Nothing -- "../../testsuite/tests/typecheck/should_fail/StrictBinds.hs" Nothing @@ -432,9 +432,9 @@ changeLetIn1 _libdir parsed [l2,_l1] = map wrapDecl $ bagToList bagDecls bagDecls' = listToBag $ concatMap decl2Bind [l2] (L (SrcSpanAnn _ le) e) = expr - a = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan le) (MovedAnchor (DP 0 1))) mempty noCom) le) + a = (SrcSpanAnn (EpAnn (Anchor (realSrcSpan le) (MovedAnchor (SameLine 1))) mempty emptyComments) le) expr' = L a e - in (HsLet (EpAnn anc (AnnsLet l (AD (DP 1 0))) cs) + in (HsLet (EpAnn anc (AnnsLet l (EpaDelta (DifferentLine 1 0))) cs) (HsValBinds x (ValBinds xv bagDecls' sigs)) expr') replace x = x @@ -445,7 +445,7 @@ changeLetIn1 _libdir parsed changeAddDecl1 :: Changer changeAddDecl1 libdir top = do Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2") - let decl' = setEntryDP' decl (DP 2 0) + let decl' = setEntryDP' decl (DifferentLine 2 0) let (p',(_,_),_) = runTransform mempty doAddDecl doAddDecl = everywhereM (mkM replaceTopLevelDecls) top @@ -457,7 +457,7 @@ changeAddDecl1 libdir top = do changeAddDecl2 :: Changer changeAddDecl2 libdir top = do Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2") - let decl' = setEntryDP' decl (DP 2 0) + let decl' = setEntryDP' decl (DifferentLine 2 0) let top' = anchorEof top let (p',(_,_),_) = runTransform mempty doAddDecl @@ -471,13 +471,13 @@ changeAddDecl2 libdir top = do changeAddDecl3 :: Changer changeAddDecl3 libdir top = do Right decl <- withDynFlags libdir (\df -> parseDecl df "<interactive>" "nn = n2") - let decl' = setEntryDP' decl (DP 2 0) + let decl' = setEntryDP' decl (DifferentLine 2 0) let (p',(_,_),_) = runTransform mempty doAddDecl doAddDecl = everywhereM (mkM replaceTopLevelDecls) top f d (l1:l2:ls) = l1:d:l2':ls where - l2' = setEntryDP' l2 (DP 2 0) + l2' = setEntryDP' l2 (DifferentLine 2 0) replaceTopLevelDecls :: ParsedSource -> Transform ParsedSource replaceTopLevelDecls m = insertAt f m decl' return p' @@ -489,8 +489,8 @@ changeLocalDecls :: Changer changeLocalDecls libdir (L l p) = do Right s@(L ls (SigD _ sig)) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int") Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") - let decl' = setEntryDP' (L ld decl) (DP 1 0) - let sig' = setEntryDP' (L ls sig) (DP 0 0) + let decl' = setEntryDP' (L ld decl) (DifferentLine 1 0) + let sig' = setEntryDP' (L ls sig) (SameLine 0) let (p',(_,_),_w) = runTransform mempty doAddLocal doAddLocal = everywhereM (mkM replaceLocalBinds) p replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) @@ -501,10 +501,10 @@ changeLocalDecls libdir (L l p) = do let oldDecls' = captureLineSpacing oldDecls let oldBinds = concatMap decl2Bind oldDecls' (os:oldSigs) = concatMap decl2Sig oldDecls' - os' = setEntryDP' os (DP 2 0) + os' = setEntryDP' os (DifferentLine 2 0) let sortKey = captureOrder decls let (EpAnn anc (AnnList (Just (Anchor anc2 _)) a b c dd) cs) = van - let van' = (EpAnn anc (AnnList (Just (Anchor anc2 (MovedAnchor (DP 1 4)))) a b c dd) cs) + let van' = (EpAnn anc (AnnList (Just (Anchor anc2 (MovedAnchor (DifferentLine 1 4)))) a b c dd) cs) let binds' = (HsValBinds van' (ValBinds sortKey (listToBag $ decl':oldBinds) (sig':os':oldSigs))) @@ -520,20 +520,20 @@ changeLocalDecls2 :: Changer changeLocalDecls2 libdir (L l p) = do Right d@(L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") Right s@(L ls (SigD _ sig)) <- withDynFlags libdir (\df -> parseDecl df "sig" "nn :: Int") - let decl' = setEntryDP' (L ld decl) (DP 1 0) - let sig' = setEntryDP' (L ls sig) (DP 0 2) + let decl' = setEntryDP' (L ld decl) (DifferentLine 1 0) + let sig' = setEntryDP' (L ls sig) (SameLine 2) let (p',(_,_),_w) = runTransform mempty doAddLocal doAddLocal = everywhereM (mkM replaceLocalBinds) p replaceLocalBinds :: LMatch GhcPs (LHsExpr GhcPs) -> Transform (LMatch GhcPs (LHsExpr GhcPs)) replaceLocalBinds (L lm (Match ma mln pats (GRHSs _ rhs EmptyLocalBinds{}))) = do newSpan <- uniqueSrcSpanT - let anc = (Anchor (rs newSpan) (MovedAnchor (DP 1 2))) - let anc2 = (Anchor (rs newSpan) (MovedAnchor (DP 1 4))) + let anc = (Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 2))) + let anc2 = (Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 4))) let an = EpAnn anc (AnnList (Just anc2) Nothing Nothing - [(undeltaSpan (rs newSpan) AnnWhere (DP 0 0))] []) - noCom + [(undeltaSpan (rs newSpan) AnnWhere (SameLine 0))] []) + emptyComments let decls = [s,d] let sortKey = captureOrder decls let binds = (HsValBinds an (ValBinds sortKey (listToBag $ [decl']) @@ -562,9 +562,9 @@ changeWhereIn3b _libdir (L l p) = do let decls0 = hsmodDecls p (decls,(_,_),w) = runTransform mempty (balanceCommentsList decls0) (de0:_:de1:d2:_) = decls - de0' = setEntryDP' de0 (DP 2 0) - de1' = setEntryDP' de1 (DP 2 0) - d2' = setEntryDP' d2 (DP 2 0) + de0' = setEntryDP' de0 (DifferentLine 2 0) + de1' = setEntryDP' de1 (DifferentLine 2 0) + d2' = setEntryDP' d2 (DifferentLine 2 0) decls' = d2':de1':de0':(tail decls) debugM $ unlines w debugM $ "changeWhereIn3b:de1':" ++ showAst de1' @@ -576,7 +576,7 @@ changeWhereIn3b _libdir (L l p) = do addLocaLDecl1 :: Changer addLocaLDecl1 libdir lp = do Right (L ld (ValD _ decl)) <- withDynFlags libdir (\df -> parseDecl df "decl" "nn = 2") - let decl' = setEntryDP' (L ld decl) (DP 1 4) + let decl' = setEntryDP' (L ld decl) (DifferentLine 1 4) doAddLocal = do (de1:d2:d3:_) <- hsDecls lp (de1'',d2') <- balanceComments de1 d2 @@ -600,7 +600,7 @@ addLocaLDecl2 libdir lp = do (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do newDecl' <- transferEntryDP' d newDecl - let d' = setEntryDP' d (DP 1 0) + let d' = setEntryDP' d (DifferentLine 1 0) return ((newDecl':d':ds),Nothing) replaceDecls lp [parent',d2'] @@ -620,7 +620,7 @@ addLocaLDecl3 libdir lp = do (de1'',d2') <- balanceComments de1 d2 (parent',_) <- modifyValD (getLocA de1) de1'' $ \_m (d:ds) -> do - let newDecl' = setEntryDP' newDecl (DP 1 0) + let newDecl' = setEntryDP' newDecl (DifferentLine 1 0) return (((d:ds) ++ [newDecl']),Nothing) replaceDecls (anchorEof lp) [parent',d2'] @@ -639,8 +639,8 @@ addLocaLDecl4 libdir lp = do doAddLocal = do (parent:ds) <- hsDecls lp - let newDecl' = setEntryDP' newDecl (DP 1 0) - let newSig' = setEntryDP' newSig (DP 1 4) + let newDecl' = setEntryDP' newDecl (DifferentLine 1 0) + let newSig' = setEntryDP' newSig (DifferentLine 1 4) (parent',_) <- modifyValD (getLocA parent) parent $ \_m decls -> do return ((decls++[newSig',newDecl']),Nothing) @@ -661,10 +661,10 @@ addLocaLDecl5 _libdir lp = do decls <- hsDecls lp [s1,de1,d2,d3] <- balanceCommentsList decls - let d3' = setEntryDP' d3 (DP 2 0) + let d3' = setEntryDP' d3 (DifferentLine 2 0) (de1',_) <- modifyValD (getLocA de1) de1 $ \_m _decls -> do - let d2' = setEntryDP' d2 (DP 1 0) + let d2' = setEntryDP' d2 (DifferentLine 1 0) return ([d2'],Nothing) replaceDecls lp [s1,de1',d3'] @@ -678,7 +678,7 @@ addLocaLDecl6 :: Changer addLocaLDecl6 libdir lp = do Right newDecl <- withDynFlags libdir (\df -> parseDecl df "decl" "x = 3") let - newDecl' = setEntryDP' newDecl (DP 1 4) + newDecl' = setEntryDP' newDecl (DifferentLine 1 4) doAddLocal = do decls0 <- hsDecls lp [de1'',d2] <- balanceCommentsList decls0 @@ -740,7 +740,7 @@ rmDecl3 _libdir lp = do [de1,d2] <- hsDecls lp (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1] -> do - let sd1' = setEntryDP' sd1 (DP 2 0) + let sd1' = setEntryDP' sd1 (DifferentLine 2 0) return ([],Just sd1') replaceDecls lp [de1',sd1,d2] @@ -760,7 +760,7 @@ rmDecl4 _libdir lp = do (de1',Just sd1) <- modifyValD (getLocA de1) de1 $ \_m [sd1,sd2] -> do sd2' <- transferEntryDP' sd1 sd2 - let sd1' = setEntryDP' sd1 (DP 2 0) + let sd1' = setEntryDP' sd1 (DifferentLine 2 0) return ([sd2'],Just sd1') replaceDecls (anchorEof lp) [de1',sd1] @@ -882,7 +882,7 @@ addHiding1 _libdir (L l p) = do (Just (AddEpAnn AnnCloseP d0)) [(AddEpAnn AnnHiding d1)] []) - noCom) l0) [v1,v2] + emptyComments) l0) [v1,v2] imp1' = imp1 { ideclHiding = Just (True,impHiding)} p' = p { hsmodImports = [L li imp1',imp2]} return (L l p') @@ -907,7 +907,7 @@ addHiding2 _libdir (L l p) = do (Just (AddEpAnn AnnCloseP d0)) [(AddEpAnn AnnHiding d1)] []) - noCom) (locA lh)) + 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))) diff --git a/utils/check-exact/Parsers.hs b/utils/check-exact/Parsers.hs index f1437869ee..03616f846a 100644 --- a/utils/check-exact/Parsers.hs +++ b/utils/check-exact/Parsers.hs @@ -44,16 +44,10 @@ module Parsers ( , postParseTransform ) where --- import Language.Haskell.GHC.ExactPrint.Annotate --- import Language.Haskell.GHC.ExactPrint.Delta import Preprocess import Types import Control.Monad.RWS --- import Data.Data (Data) - - --- import GHC.Paths (libdir) import qualified GHC hiding (parseModule) import qualified Control.Monad.IO.Class as GHC @@ -71,8 +65,6 @@ import qualified GHC.Utils.Error as GHC import qualified GHC.LanguageExtensions as LangExt --- import qualified Data.Map as Map - {-# ANN module "HLint: ignore Eta reduce" #-} {-# ANN module "HLint: ignore Redundant do" #-} {-# ANN module "HLint: ignore Reduce duplication" #-} @@ -98,8 +90,6 @@ parseWithECP :: (GHC.DisambECP w) -> String -> ParseResult (GHC.LocatedA w) parseWithECP dflags fileName parser s = - -- case runParser ff dflags fileName s of - -- case runParser (parser >>= \p -> GHC.runECP_P p) dflags fileName s of case runParser (parser >>= \p -> GHC.runPV $ GHC.unECP p) dflags fileName s of GHC.PFailed pst -> Left (fmap GHC.mkParserErr $ GHC.getErrorMessages pst) GHC.POk _ pmod -> Right pmod @@ -275,7 +265,6 @@ postParseTransform postParseTransform parseRes = fmap mkAnns parseRes where mkAnns (_cs, _, m) = m - -- (relativiseEpAnnsWithOptions opts cs m apianns, m) -- | Internal function. Initializes DynFlags value for parsing. -- diff --git a/utils/check-exact/Preprocess.hs b/utils/check-exact/Preprocess.hs index 904e76938e..58cb6d028c 100644 --- a/utils/check-exact/Preprocess.hs +++ b/utils/check-exact/Preprocess.hs @@ -213,7 +213,6 @@ getPreprocessedSrcDirectPrim cppOptions src_fn = do hsc_env <- GHC.getSession let dfs = GHC.hsc_dflags hsc_env new_env = hsc_env { GHC.hsc_dflags = injectCppOptions cppOptions dfs } - -- (dflags', hspp_fn) <- r <- GHC.liftIO $ GHC.preprocess new_env src_fn Nothing (Just (GHC.Cpp GHC.HsSrcFile)) case r of Left err -> error $ showErrorMessages err @@ -309,4 +308,3 @@ mergeBy cmp (allx@(x:xs)) (ally@(y:ys)) -- Someone please put this code out of its misery. | (x `cmp` y) <= EQ = x : mergeBy cmp xs ally | otherwise = y : mergeBy cmp allx ys - diff --git a/utils/check-exact/Transform.hs b/utils/check-exact/Transform.hs index 7d68da858a..044af3c784 100644 --- a/utils/check-exact/Transform.hs +++ b/utils/check-exact/Transform.hs @@ -118,8 +118,6 @@ import GHC hiding (parseModule, parsedSource) import GHC.Data.Bag import GHC.Data.FastString --- import qualified Data.Generics as SYB - import Data.Data import Data.List (sort, sortBy, find) import Data.Maybe @@ -130,7 +128,6 @@ import Data.Functor.Identity import Control.Monad.State import Control.Monad.Writer --- import Debug.Trace ------------------------------------------------------------------------------ -- Transformation of source elements @@ -274,14 +271,14 @@ captureMatchLineSpacing (L l (ValD x (FunBind a b (MG c (L d ms ) e) f))) captureMatchLineSpacing d = d captureLineSpacing :: Monoid t - => [LocatedAn t e] -> [GenLocated (SrcSpanAnn' (EpAnn' t)) e] + => [LocatedAn t e] -> [GenLocated (SrcSpanAnn' (EpAnn t)) e] captureLineSpacing [] = [] captureLineSpacing [d] = [d] captureLineSpacing (de1:d2:ds) = de1:captureLineSpacing (d2':ds) where (l1,_) = ss2pos $ rs $ getLocA de1 (l2,_) = ss2pos $ rs $ getLocA d2 - d2' = setEntryDP' d2 (DP (l2-l1) 0) + d2' = setEntryDP' d2 (deltaPos (l2-l1) 0) -- --------------------------------------------------------------------- @@ -297,8 +294,8 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (H L (SrcSpanAnn (EpAnn anc' _ _) _) _ -> anchor anc' -- TODO MovedAnchor? -- DP (line, col) = ss2delta (ss2pos $ anchor $ getLoc lc) r dc' = case dca of - AR r -> AddEpAnn kw (AD $ ss2delta (ss2posEnd rd) r) - AD _ -> AddEpAnn kw dca + EpaSpan r -> AddEpAnn kw (EpaDelta $ ss2delta (ss2posEnd rd) r) + EpaDelta _ -> AddEpAnn kw dca -- --------------------------------- @@ -307,16 +304,16 @@ captureTypeSigSpacing (L l (SigD x (TypeSig (EpAnn anc (AnnSig dc rs') cs) ns (H (L (SrcSpanAnn EpAnnNotUsed ll) b) -> let op = case dca of - AR r -> MovedAnchor (ss2delta (ss2posEnd r) (realSrcSpan ll)) - AD _ -> MovedAnchor (DP 0 1) - in (L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan ll) op) mempty noCom) ll) b) + EpaSpan r -> MovedAnchor (ss2delta (ss2posEnd r) (realSrcSpan ll)) + EpaDelta _ -> MovedAnchor (SameLine 1) + in (L (SrcSpanAnn (EpAnn (Anchor (realSrcSpan ll) op) mempty emptyComments) ll) b) (L (SrcSpanAnn (EpAnn (Anchor r op) a c) ll) b) -> let op' = case op of MovedAnchor _ -> op _ -> case dca of - AR dcr -> MovedAnchor (ss2delta (ss2posEnd dcr) r) - AD _ -> MovedAnchor (DP 0 1) + EpaSpan dcr -> MovedAnchor (ss2delta (ss2posEnd dcr) r) + EpaDelta _ -> MovedAnchor (SameLine 1) in (L (SrcSpanAnn (EpAnn (Anchor r op') a c) ll) b) captureTypeSigSpacing s = s @@ -366,7 +363,7 @@ addSimpleAnnT ast dp kds = do -- |Add a trailing comma annotation, unless there is already one addTrailingCommaT :: (Data a,Monad m) => Located a -> TransformT m () addTrailingCommaT ast = do - modifyAnnsT (addTrailingComma ast (DP 0 0)) + modifyAnnsT (addTrailingComma ast (SameLine 0)) -- --------------------------------------------------------------------- @@ -435,7 +432,7 @@ setPrecedingLinesDecl ld n c ans = setPrecedingLines ld n c ans -- | Adjust the entry annotations to provide an `n` line preceding gap setPrecedingLines :: (Data a) => LocatedA a -> Int -> Int -> Anns -> Anns -setPrecedingLines ast n c anne = setEntryDP ast (DP n c) anne +setPrecedingLines ast n c anne = setEntryDP ast (deltaPos n c) anne -- --------------------------------------------------------------------- @@ -444,7 +441,7 @@ setPrecedingLines ast n c anne = setEntryDP ast (DP n c) anne getEntryDP :: (Data a) => Anns -> Located a -> DeltaPos getEntryDP anns ast = case Map.lookup (mkAnnKey ast) anns of - Nothing -> DP 0 0 + Nothing -> SameLine 0 Just ann -> annTrueEntryDelta ann -- --------------------------------------------------------------------- @@ -468,7 +465,7 @@ setEntryDPDecl d dp = setEntryDP' d dp setEntryDP' :: (Monoid t) => LocatedAn t a -> DeltaPos -> LocatedAn t a setEntryDP' (L (SrcSpanAnn EpAnnNotUsed l) a) dp = L (SrcSpanAnn - (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) mempty noCom) + (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) mempty emptyComments) l) a setEntryDP' (L (SrcSpanAnn (EpAnn (Anchor r _) an (EpaComments [])) l) a) dp = L (SrcSpanAnn @@ -487,13 +484,13 @@ setEntryDP' (L (SrcSpanAnn (EpAnn (Anchor r _) an cs) l) a) dp where cs'' = setPriorComments cs (L (Anchor (anchor ca) (MovedAnchor dp)) c:cs') lc = head $ reverse $ (L ca c:cs') - DP line col = ss2delta (ss2pos $ anchor $ getLoc lc) r + delta = ss2delta (ss2pos $ anchor $ getLoc lc) r + line = getDeltaLine delta + col = deltaColumn delta -- TODO: this adjustment by 1 happens all over the place. Generalise it - edp' = if line == 0 then DP line col - else DP line (col - 1) + edp' = if line == 0 then SameLine col + else DifferentLine line (col - 1) edp = edp' `debug` ("setEntryDP' :" ++ showGhc (edp', (ss2pos $ anchor $ getLoc lc), r)) - -- edp = if line == 0 then DP (line, col) - -- else DP (line, col - 1) -- |Set the true entry 'DeltaPos' from the annotation for a given AST -- element. This is the 'DeltaPos' ignoring any comments. @@ -502,15 +499,15 @@ setEntryDP _ast _dp anns = anns -- --------------------------------------------------------------------- -addEpaAnchorDelta :: LayoutStartCol -> RealSrcSpan -> EpaAnchor -> EpaAnchor -addEpaAnchorDelta _off _anc (AD d) = AD d -addEpaAnchorDelta off anc (AR r) - = AD (adjustDeltaForOffset 0 off (ss2deltaEnd anc r)) +addEpaLocationDelta :: LayoutStartCol -> RealSrcSpan -> EpaLocation -> EpaLocation +addEpaLocationDelta _off _anc (EpaDelta d) = EpaDelta d +addEpaLocationDelta off anc (EpaSpan r) + = EpaDelta (adjustDeltaForOffset 0 off (ss2deltaEnd anc r)) -- Set the entry DP for an element coming after an existing keyword annotation -setEntryDPFromAnchor :: LayoutStartCol -> EpaAnchor -> LocatedA t -> LocatedA t -setEntryDPFromAnchor _off (AD _) (L la a) = L la a -setEntryDPFromAnchor off (AR anc) ll@(L la _) = setEntryDP' ll dp' +setEntryDPFromAnchor :: LayoutStartCol -> EpaLocation -> LocatedA t -> LocatedA t +setEntryDPFromAnchor _off (EpaDelta _) (L la a) = L la a +setEntryDPFromAnchor off (EpaSpan anc) ll@(L la _) = setEntryDP' ll dp' where r = case la of (SrcSpanAnn EpAnnNotUsed l) -> realSrcSpan l @@ -551,7 +548,7 @@ transferEntryDP (L (SrcSpanAnn EpAnnNotUsed _l1) _) (L (SrcSpanAnn (EpAnn anc2 a transferEntryDP' :: (Monad m) => LHsDecl GhcPs -> LHsDecl GhcPs -> TransformT m (LHsDecl GhcPs) transferEntryDP' la lb = do (L l2 b) <- transferEntryDP la lb - return (L l2 (pushDeclDP b (DP 0 0))) + return (L l2 (pushDeclDP b (SameLine 0))) -- There is an off-by-one in DPs. I *think* it has to do wether we -- calculate the final position when applying it against the stored @@ -559,8 +556,8 @@ transferEntryDP' la lb = do -- of it and come up with a canonical DP. This function adjusts a -- "comment space" DP to a "enterAnn" space one kludgeAnchor :: Anchor -> Anchor -kludgeAnchor a@(Anchor _ (MovedAnchor (DP 0 _))) = a -kludgeAnchor (Anchor a (MovedAnchor (DP r c))) = (Anchor a (MovedAnchor (DP r (c - 1)))) +kludgeAnchor a@(Anchor _ (MovedAnchor (SameLine _))) = a +kludgeAnchor (Anchor a (MovedAnchor (DifferentLine r c))) = (Anchor a (MovedAnchor (deltaPos r (c - 1)))) kludgeAnchor a = a pushDeclDP :: HsDecl GhcPs -> DeltaPos -> HsDecl GhcPs @@ -665,7 +662,6 @@ balanceCommentsMatch (L l (Match am mctxt pats (GRHSs xg grhss binds))) = do (SrcSpanAnn an1 _loc1) = l anc1 = addCommentOrigDeltas $ epAnnComments an1 cs1f = getFollowingComments anc1 - -- (move',stay') = break simpleBreak (commentsDeltas (anchorFromLocatedA (L l ())) cs1f) (move',stay') = break simpleBreak (trailingCommentsDeltas (anchorFromLocatedA (L l ())) cs1f) move = map snd move' stay = map snd stay' @@ -817,8 +813,8 @@ commentOrigDeltas lcs@(L _ (GHC.EpaComment _ pt):_) = go pt lcs op' = if r == 0 then MovedAnchor (ss2delta (r,c+1) la) else MovedAnchor (ss2delta (r,c) la) - op = if t == EpaEofComment && op' == MovedAnchor (DP 0 0) - then MovedAnchor (DP 1 0) + op = if t == EpaEofComment && op' == MovedAnchor (SameLine 0) + then MovedAnchor (DifferentLine 1 0) else op' addCommentOrigDeltas :: EpAnnComments -> EpAnnComments @@ -826,7 +822,7 @@ addCommentOrigDeltas (EpaComments cs) = EpaComments (commentOrigDeltas cs) addCommentOrigDeltas (EpaCommentsBalanced pcs fcs) = EpaCommentsBalanced (commentOrigDeltas pcs) (commentOrigDeltas fcs) -addCommentOrigDeltasAnn :: (EpAnn' a) -> (EpAnn' a) +addCommentOrigDeltasAnn :: (EpAnn a) -> (EpAnn a) addCommentOrigDeltasAnn EpAnnNotUsed = EpAnnNotUsed addCommentOrigDeltasAnn (EpAnn e a cs) = EpAnn e a (addCommentOrigDeltas cs) @@ -855,7 +851,7 @@ balanceSameLineComments (L la (Match anm mctxt pats (GRHSs x grhss lb))) = do where (SrcSpanAnn an1 _loc1) = la anc1 = addCommentOrigDeltas $ epAnnComments an1 - (EpAnn anc an _) = ga :: EpAnn' GrhsAnn + (EpAnn anc an _) = ga :: EpAnn GrhsAnn (csp,csf) = case anc1 of EpaComments cs -> ([],cs) EpaCommentsBalanced p f -> (p,f) @@ -894,7 +890,8 @@ balanceTrailingComments first second = do an1' = an1 { annFollowingComments = stay } ans' = Map.insert k1 an1' $ Map.insert k2 an2 ans - simpleBreak (_,DP r _c) = r > 0 + simpleBreak (_,SameLine _) = False + simpleBreak (_,DifferentLine _ _) = True ans <- getAnnsT let (ans',mov) = moveComments simpleBreak ans @@ -944,40 +941,40 @@ deltaAnchor (Anchor anc _) ss = Anchor anc (MovedAnchor dp) -- | Create a @SrcSpanAnn@ with a @MovedAnchor@ operation using the -- given @DeltaPos@. -noAnnSrcSpanDP :: (Monoid ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn' ann) +noAnnSrcSpanDP :: (Monoid ann) => SrcSpan -> DeltaPos -> SrcSpanAnn' (EpAnn ann) noAnnSrcSpanDP l dp - = SrcSpanAnn (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) mempty noCom) l + = SrcSpanAnn (EpAnn (Anchor (realSrcSpan l) (MovedAnchor dp)) mempty emptyComments) l -noAnnSrcSpanDP0 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn' ann) -noAnnSrcSpanDP0 l = noAnnSrcSpanDP l (DP 0 0) +noAnnSrcSpanDP0 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann) +noAnnSrcSpanDP0 l = noAnnSrcSpanDP l (SameLine 0) -noAnnSrcSpanDP1 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn' ann) -noAnnSrcSpanDP1 l = noAnnSrcSpanDP l (DP 0 1) +noAnnSrcSpanDP1 :: (Monoid ann) => SrcSpan -> SrcSpanAnn' (EpAnn ann) +noAnnSrcSpanDP1 l = noAnnSrcSpanDP l (SameLine 1) -noAnnSrcSpanDPn :: (Monoid ann) => SrcSpan -> Int -> SrcSpanAnn' (EpAnn' ann) -noAnnSrcSpanDPn l s = noAnnSrcSpanDP l (DP 0 s) +noAnnSrcSpanDPn :: (Monoid ann) => SrcSpan -> Int -> SrcSpanAnn' (EpAnn ann) +noAnnSrcSpanDPn l s = noAnnSrcSpanDP l (SameLine s) -d0 :: EpaAnchor -d0 = AD $ DP 0 0 +d0 :: EpaLocation +d0 = EpaDelta $ SameLine 0 -d1 :: EpaAnchor -d1 = AD $ DP 0 1 +d1 :: EpaLocation +d1 = EpaDelta $ SameLine 1 -dn :: Int -> EpaAnchor -dn n = AD $ DP 0 n +dn :: Int -> EpaLocation +dn n = EpaDelta $ SameLine n m0 :: AnchorOperation -m0 = MovedAnchor $ DP 0 0 +m0 = MovedAnchor $ SameLine 0 m1 :: AnchorOperation -m1 = MovedAnchor $ DP 0 1 +m1 = MovedAnchor $ SameLine 1 mn :: Int -> AnchorOperation -mn n = MovedAnchor $ DP 0 n +mn n = MovedAnchor $ SameLine n addComma :: SrcSpanAnnA -> SrcSpanAnnA addComma (SrcSpanAnn EpAnnNotUsed l) - = (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnListItem [AddCommaAnn d0]) noCom) l) + = (SrcSpanAnn (EpAnn (spanAsAnchor l) (AnnListItem [AddCommaAnn d0]) emptyComments) l) addComma (SrcSpanAnn (EpAnn anc (AnnListItem as) cs) l) = (SrcSpanAnn (EpAnn anc (AnnListItem (AddCommaAnn d0:as)) cs) l) @@ -1124,14 +1121,14 @@ instance HasDecls (LocatedA (HsExpr GhcPs)) where (EpAnn a (AnnsLet l i) cs) -> let off = case l of - (AR r) -> LayoutStartCol $ snd $ ss2pos r - (AD (DP 0 _)) -> LayoutStartCol 0 - (AD (DP _ c)) -> LayoutStartCol c + (EpaSpan r) -> LayoutStartCol $ snd $ ss2pos r + (EpaDelta (SameLine _)) -> LayoutStartCol 0 + (EpaDelta (DifferentLine _ c)) -> LayoutStartCol c ex'' = setEntryDPFromAnchor off i ex newDecls'' = case newDecls of [] -> newDecls - (d:ds) -> setEntryDPDecl d (DP 0 0) : ds - in ( EpAnn a (AnnsLet l (addEpaAnchorDelta off lastAnc i)) cs + (d:ds) -> setEntryDPDecl d (SameLine 0) : ds + in ( EpAnn a (AnnsLet l (addEpaLocationDelta off lastAnc i)) cs , ex'' , newDecls'') binds' <- replaceDeclsValbinds WithoutWhere binds newDecls' @@ -1398,26 +1395,26 @@ replaceDeclsValbinds w (EmptyLocalBinds _) new return (HsValBinds an (ValBinds sortKey decs sigs)) oldWhereAnnotation :: (Monad m) - => EpAnn' AnnList -> WithWhere -> RealSrcSpan -> TransformT m (EpAnn' AnnList) + => EpAnn AnnList -> WithWhere -> RealSrcSpan -> TransformT m (EpAnn AnnList) oldWhereAnnotation EpAnnNotUsed ww _oldSpan = do newSpan <- uniqueSrcSpanT let w = case ww of - WithWhere -> [AddEpAnn AnnWhere (AD (DP 0 0))] + WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0))] WithoutWhere -> [] - let anc2' = Anchor (rs newSpan) (MovedAnchor (DP 0 1)) + let anc2' = Anchor (rs newSpan) (MovedAnchor (SameLine 1)) (anc, anc2) <- do newSpan' <- uniqueSrcSpanT - return ( Anchor (rs newSpan') (MovedAnchor (DP 1 2)) + return ( Anchor (rs newSpan') (MovedAnchor (DifferentLine 1 2)) , anc2') let an = EpAnn anc (AnnList (Just anc2) Nothing Nothing w []) - noCom + emptyComments return an oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = do - -- TODO: when we set DP (0,0) for the HsValBinds EpEpaAnchor, change the AnnList anchor to have the correct DP too + -- TODO: when we set DP (0,0) for the HsValBinds EpEpaLocation, change the AnnList anchor to have the correct DP too let (AnnList ancl o c _r t) = an let w = case ww of - WithWhere -> [AddEpAnn AnnWhere (AD (DP 0 0))] + WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0))] WithoutWhere -> [] (anc', ancl') <- do case ww of @@ -1428,17 +1425,17 @@ oldWhereAnnotation (EpAnn anc an cs) ww _oldSpan = do cs return an' -newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn' AnnList) +newWhereAnnotation :: (Monad m) => WithWhere -> TransformT m (EpAnn AnnList) newWhereAnnotation ww = do newSpan <- uniqueSrcSpanT - let anc = Anchor (rs newSpan) (MovedAnchor (DP 1 2)) - let anc2 = Anchor (rs newSpan) (MovedAnchor (DP 1 4)) + let anc = Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 2)) + let anc2 = Anchor (rs newSpan) (MovedAnchor (DifferentLine 1 4)) let w = case ww of - WithWhere -> [AddEpAnn AnnWhere (AD (DP 0 0))] + WithWhere -> [AddEpAnn AnnWhere (EpaDelta (SameLine 0))] WithoutWhere -> [] let an = EpAnn anc (AnnList (Just anc2) Nothing Nothing w []) - noCom + emptyComments return an -- --------------------------------------------------------------------- diff --git a/utils/check-exact/Types.hs b/utils/check-exact/Types.hs index 6717e45698..ac9ae10375 100644 --- a/utils/check-exact/Types.hs +++ b/utils/check-exact/Types.hs @@ -17,7 +17,6 @@ import GHC.Driver.Ppr import Data.Data (Data, toConstr,cast) import qualified Data.Map as Map -import qualified Data.Set as Set -- --------------------------------------------------------------------- -- | This structure holds a complete set of annotations for an AST @@ -63,14 +62,10 @@ mkAnnKey ld = type Pos = (Int,Int) -deltaRow, deltaColumn :: DeltaPos -> Int -deltaRow (DP r _) = r -deltaColumn (DP _ c) = c - -- --------------------------------------------------------------------- annNone :: Annotation -annNone = Ann (DP 0 0) [] [] [] Nothing Nothing +annNone = Ann (SameLine 0) [] [] [] Nothing Nothing data Annotation = Ann { @@ -130,132 +125,9 @@ declFun f (L l de) = -- --------------------------------------------------------------------- -data ACS' a = ACS - { acs :: !(Map.Map a Int) -- ^ how many levels each AstContext should - -- propagate down the AST. Removed when it hits zero - } deriving (Show) - -instance Semigroup (ACS' AstContext) where - ACS a <> ACS b = ACS (Map.unionWith max a b) - -- For Data.Map, mappend == union, which is a left-biased replace - -- for key collisions - -instance Monoid (ACS' AstContext) where - mempty = ACS mempty - -type AstContextSet = ACS' AstContext --- data AstContextSet = ACS --- { acs :: !(Map.Map AstContext Int) -- ^ how many levels each AstContext should --- -- propagate down the AST. Removed when it --- -- hits zero --- } deriving (Show) - -defaultACS :: AstContextSet -defaultACS = ACS Map.empty - --- instance Outputable AstContextSet where -instance (Show a) => Outputable (ACS' a) where - ppr x = text $ show x - -data AstContext = -- LambdaExpr - CaseAlt - | NoPrecedingSpace - | HasHiding - | AdvanceLine - | NoAdvanceLine - | Intercalate -- This item may have a list separator following - | InIE -- possible 'type' or 'pattern' - | PrefixOp - | PrefixOpDollar - | InfixOp -- RdrName may be used as an infix operator - | ListStart -- Identifies first element of a list in layout, so its indentation can me managed differently - | ListItem -- Identifies subsequent elements of a list in layout - | TopLevelDecl -- top level declaration - | NoDarrow - | AddVbar - | Deriving - | Parens -- TODO: Not currently used? - | ExplicitNeverActive - | InGadt - | InRecCon - | InClassDecl - | InSpliceDecl - | LeftMost -- Is this the leftmost operator in a chain of OpApps? - | InTypeApp -- HsTyVar in a TYPEAPP context. Has AnnAt - -- TODO:AZ: do we actually need this? - - -- Next four used to identify current list context - | CtxOnly - | CtxFirst - | CtxMiddle - | CtxLast - | CtxPos Int -- 0 for first, increasing for subsequent - - -- Next are used in tellContext to push context up the tree - | FollowingLine - deriving (Eq, Ord, Show) - - -data ListContexts = LC { lcOnly,lcInitial,lcMiddle,lcLast :: !(Set.Set AstContext) } - deriving (Eq,Show) - --- --------------------------------------------------------------------- - data Rigidity = NormalLayout | RigidLayout deriving (Eq, Ord, Show) --- -- --------------------------------------------------------------------- --- -- | This structure holds a complete set of annotations for an AST --- type Anns = Map.Map AnnKey Annotation - --- emptyAnns :: Anns --- emptyAnns = Map.empty - --- -- | For every @Located a@, use the @SrcSpan@ and constructor name of --- -- a as the key, to store the standard annotation. --- -- These are used to maintain context in the AP and EP monads --- data AnnKey = AnnKey SrcSpan AnnConName --- deriving (Eq, Data, Ord) --- deriving instance Ord SrcSpan - --- -- More compact Show instance --- instance Show AnnKey where --- show (AnnKey ss cn) = "AnnKey " ++ showPprUnsafe ss ++ " " ++ show cn - --- mkAnnKeyPrim :: (Data a) => Located a -> AnnKey --- mkAnnKeyPrim (L l a) = AnnKey l (annGetConstr a) - --- mkAnnKeyPrimA :: (Data a) => LocatedA a -> AnnKey --- mkAnnKeyPrimA (L l a) = AnnKey (locA l) (annGetConstr a) --- -- Holds the name of a constructor --- data AnnConName = CN { unConName :: String } --- deriving (Eq, Ord, Data) - --- -- More compact show instance --- instance Show AnnConName where --- show (CN s) = "CN " ++ show s - --- annGetConstr :: (Data a) => a -> AnnConName --- annGetConstr a = CN (show $ toConstr a) - --- -- |Make an unwrapped @AnnKey@ for the @LHsDecl@ case, a normal one otherwise. --- mkAnnKey :: (Data a) => Located a -> AnnKey --- mkAnnKey ld = --- case cast ld :: Maybe (LHsDecl GhcPs) of --- Just d -> declFun mkAnnKeyPrimA d --- Nothing -> mkAnnKeyPrim ld - - --- type Pos = (Int,Int) - --- -- | A relative positions, row then column --- newtype DeltaPos = DP (Int,Int) deriving (Show,Eq,Ord,Data) - --- deltaRow, deltaColumn :: DeltaPos -> Int --- deltaRow (DP (r, _)) = r --- deltaColumn (DP (_, c)) = c - --- --------------------------------------------------------------------- -- | A Haskell comment. The @AnnKeywordId@ is present if it has been converted -- from an @AnnKeywordId@ because the annotation must be interleaved into the diff --git a/utils/check-exact/Utils.hs b/utils/check-exact/Utils.hs index 0ac0bcdf91..e92ce96638 100644 --- a/utils/check-exact/Utils.hs +++ b/utils/check-exact/Utils.hs @@ -37,9 +37,8 @@ import qualified GHC.Types.Name.Occurrence as OccName (OccName(..),pprNameSpaceB import Control.Arrow import qualified Data.Map as Map -import qualified Data.Set as Set import Data.Data hiding ( Fixity ) -import Data.List (foldl', sortBy, elemIndex) +import Data.List (sortBy, elemIndex) import Debug.Trace import Types @@ -82,7 +81,9 @@ warn c _ = c -- | A good delta has no negative values. isGoodDelta :: DeltaPos -> Bool -isGoodDelta (DP ro co) = ro >= 0 && co >= 0 +isGoodDelta (SameLine co) = co >= 0 +isGoodDelta (DifferentLine ro co) = ro > 0 && co >= 0 + -- Note: DifferentLine invariant is ro is nonzero and positive -- | Create a delta from the current position to the start of the given @@ -116,7 +117,7 @@ ss2deltaStart rrs ss = ss2delta ref ss -- | Convert the start of the second @Pos@ to be an offset from the -- first. The assumption is the reference starts before the second @Pos@ pos2delta :: Pos -> Pos -> DeltaPos -pos2delta (refl,refc) (l,c) = DP lo co +pos2delta (refl,refc) (l,c) = deltaPos lo co where lo = l - refl co = if lo == 0 then c - refc @@ -125,14 +126,15 @@ pos2delta (refl,refc) (l,c) = DP lo co -- | Apply the delta to the current position, taking into account the -- current column offset if advancing to a new line undelta :: Pos -> DeltaPos -> LayoutStartCol -> Pos -undelta (l,c) (DP dl dc) (LayoutStartCol co) = (fl,fc) +undelta (l,c) (SameLine dc) (LayoutStartCol _co) = (l, c + dc) +undelta (l,_) (DifferentLine dl dc) (LayoutStartCol co) = (fl,fc) where + -- Note: invariant: dl > 0 fl = l + dl - fc = if dl == 0 then c + dc - else co + dc + fc = co + dc undeltaSpan :: RealSrcSpan -> AnnKeywordId -> DeltaPos -> AddEpAnn -undeltaSpan anchor kw dp = AddEpAnn kw (AR sp) +undeltaSpan anchor kw dp = AddEpAnn kw (EpaSpan sp) where (l,c) = undelta (ss2pos anchor) dp (LayoutStartCol 0) len = length (keywordToString (G kw)) @@ -144,41 +146,16 @@ undeltaSpan anchor kw dp = AddEpAnn kw (AR sp) -- > DP (0, 9) `addDP` DP (1, 5) == DP (1, 5) -- > DP (1, 4) `addDP` DP (1, 3) == DP (2, 3) addDP :: DeltaPos -> DeltaPos -> DeltaPos -addDP (DP a b) (DP c d) = - if c >= 1 then DP (a+c) d - else DP a (b+d) - --- | "Subtract" two @DeltaPos@ from each other, in the sense of calculating the --- remaining delta for the second after the first has been applied. --- invariant : if c = a `addDP` b --- then a `stepDP` c == b --- --- Cases where first DP is <= than second --- > DP (0, 1) `addDP` DP (0, 2) == DP (0, 1) --- > DP (1, 1) `addDP` DP (2, 0) == DP (1, 0) --- > DP (1, 3) `addDP` DP (1, 4) == DP (0, 1) --- > DP (1, 4) `addDP` DP (1, 4) == DP (1, 4) --- --- Cases where first DP is > than second --- > DP (0, 3) `addDP` DP (0, 2) == DP (0,1) -- advance one at least --- > DP (3, 3) `addDP` DP (2, 4) == DP (1, 4) -- go one line forward and to expected col --- > DP (3, 3) `addDP` DP (0, 4) == DP (0, 1) -- maintain col delta at least --- > DP (1, 21) `addDP` DP (1, 4) == DP (1, 4) -- go one line forward and to expected col -stepDP :: DeltaPos -> DeltaPos -> DeltaPos -stepDP (DP a b) (DP c d) - | (a,b) == (c,d) = DP a b - | a == c = if b < d then DP 0 (d - b) - else if d == 0 - then DP 1 0 - else DP c d - | a < c = DP (c - a) d - | otherwise = DP 1 d +addDP dp (DifferentLine c d) = DifferentLine (getDeltaLine dp+c) d +addDP (DifferentLine a b) (SameLine d) = DifferentLine a (b+d) +addDP (SameLine b) (SameLine d) = SameLine (b+d) -- --------------------------------------------------------------------- adjustDeltaForOffset :: Int -> LayoutStartCol -> DeltaPos -> DeltaPos -adjustDeltaForOffset _ _colOffset dp@(DP 0 _) = dp -- same line -adjustDeltaForOffset d (LayoutStartCol colOffset) (DP l c) = DP l (c - colOffset - d) +adjustDeltaForOffset _ _colOffset dp@(SameLine _) = dp +adjustDeltaForOffset d (LayoutStartCol colOffset) (DifferentLine l c) + = DifferentLine l (c - colOffset - d) -- --------------------------------------------------------------------- @@ -283,10 +260,10 @@ normaliseCommentText ('\r':xs) = normaliseCommentText xs normaliseCommentText (x:xs) = x:normaliseCommentText xs -- | Makes a comment which originates from a specific keyword. -mkKWComment :: AnnKeywordId -> EpaAnchor -> Comment -mkKWComment kw (AR ss) +mkKWComment :: AnnKeywordId -> EpaLocation -> Comment +mkKWComment kw (EpaSpan ss) = Comment (keywordToString $ G kw) (Anchor ss UnchangedAnchor) (Just kw) -mkKWComment kw (AD dp) +mkKWComment kw (EpaDelta dp) = Comment (keywordToString $ G kw) (Anchor placeholderRealSpan (MovedAnchor dp)) (Just kw) comment2dp :: (Comment, DeltaPos) -> (KeywordId, DeltaPos) @@ -304,18 +281,9 @@ getAnnotationEP la as = -- start of the current element. annTrueEntryDelta :: Annotation -> DeltaPos annTrueEntryDelta Ann{annEntryDelta, annPriorComments} = - foldr addDP (DP 0 0) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments ) + foldr addDP (SameLine 0) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments ) `addDP` annEntryDelta --- | Take an annotation and a required "true entry" and calculate an equivalent --- one relative to the last comment in the annPriorComments. -annCommentEntryDelta :: Annotation -> DeltaPos -> DeltaPos -annCommentEntryDelta Ann{annPriorComments} trueDP = dp - where - commentDP = - foldr addDP (DP 0 0) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments ) - dp = stepDP commentDP trueDP - -- | Return the DP of the first item that generates output, either a comment or the entry DP annLeadingCommentEntryDelta :: Annotation -> DeltaPos annLeadingCommentEntryDelta Ann{annPriorComments,annEntryDelta} = dp @@ -329,7 +297,10 @@ annLeadingCommentEntryDelta Ann{annPriorComments,annEntryDelta} = dp dpFromString :: String -> DeltaPos dpFromString xs = dpFromString' xs 0 0 where - dpFromString' "" line col = DP line col + dpFromString' "" line col = + if line == 0 + then SameLine col + else DifferentLine line col dpFromString' ('\n': cs) line _ = dpFromString' cs (line + 1) 0 dpFromString' (_:cs) line col = dpFromString' cs line (col + 1) @@ -355,56 +326,6 @@ name2String = showPprUnsafe -- --------------------------------------------------------------------- --- | Put the provided context elements into the existing set with fresh level --- counts -setAcs :: Set.Set AstContext -> AstContextSet -> AstContextSet -setAcs ctxt acs = setAcsWithLevel ctxt 3 acs - --- | Put the provided context elements into the existing set with given level --- counts --- setAcsWithLevel :: Set.Set AstContext -> Int -> AstContextSet -> AstContextSet --- setAcsWithLevel ctxt level (ACS a) = ACS a' --- where --- upd s (k,v) = Map.insert k v s --- a' = foldl' upd a $ zip (Set.toList ctxt) (repeat level) -setAcsWithLevel :: (Ord a) => Set.Set a -> Int -> ACS' a -> ACS' a -setAcsWithLevel ctxt level (ACS a) = ACS a' - where - upd s (k,v) = Map.insert k v s - a' = foldl' upd a $ zip (Set.toList ctxt) (repeat level) - --- --------------------------------------------------------------------- --- | Remove the provided context element from the existing set --- unsetAcs :: AstContext -> AstContextSet -> AstContextSet -unsetAcs :: (Ord a) => a -> ACS' a -> ACS' a -unsetAcs ctxt (ACS a) = ACS $ Map.delete ctxt a - --- --------------------------------------------------------------------- - --- | Are any of the contexts currently active? --- inAcs :: Set.Set AstContext -> AstContextSet -> Bool -inAcs :: (Ord a) => Set.Set a -> ACS' a -> Bool -inAcs ctxt (ACS a) = not $ Set.null $ Set.intersection ctxt (Set.fromList $ Map.keys a) - --- | propagate the ACS down a level, dropping all values which hit zero --- pushAcs :: AstContextSet -> AstContextSet -pushAcs :: ACS' a -> ACS' a -pushAcs (ACS a) = ACS $ Map.mapMaybe f a - where - f n - | n <= 1 = Nothing - | otherwise = Just (n - 1) - --- |Sometimes we have to pass the context down unchanged. Bump each count up by --- one so that it is unchanged after a @pushAcs@ call. --- bumpAcs :: AstContextSet -> AstContextSet -bumpAcs :: ACS' a -> ACS' a -bumpAcs (ACS a) = ACS $ Map.mapMaybe f a - where - f n = Just (n + 1) - --- --------------------------------------------------------------------- - occAttributes :: OccName.OccName -> String occAttributes o = "(" ++ ns ++ vo ++ tv ++ tc ++ d ++ ds ++ s ++ v ++ ")" where @@ -418,14 +339,6 @@ occAttributes o = "(" ++ ns ++ vo ++ tv ++ tc ++ d ++ ds ++ s ++ v ++ ")" s = if isSymOcc o then "Sym " else "" v = if isValOcc o then "Val " else "" -{- -data NameSpace = VarName -- Variables, including "real" data constructors - | DataName -- "Source" data constructors - | TvName -- Type variables - | TcClsName -- Type constructors and classes; Haskell has them - -- in the same name space for now. --} - -- --------------------------------------------------------------------- locatedAnAnchor :: LocatedAn a t -> RealSrcSpan @@ -434,15 +347,6 @@ locatedAnAnchor (L (SrcSpanAnn (EpAnn a _ _) _) _) = anchor a -- --------------------------------------------------------------------- --- showSDoc_ :: SDoc -> String --- showSDoc_ = showSDoc unsafeGlobalDynFlags - --- showSDocDebug_ :: SDoc -> String --- showSDocDebug_ = showSDocDebug unsafeGlobalDynFlags - - - -- --------------------------------------------------------------------- - showAst :: (Data a) => a -> String showAst ast = showSDocUnsafe diff --git a/utils/haddock b/utils/haddock -Subproject dabdee145c8da12aff4eebce7847f2af1a2ddc1 +Subproject cafb48118f7c111020663776845897e225607b4 |