[Git][ghc/ghc][wip/az/epa-hslet-tokens] EPA: Remove last EpAnn from extension points
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Wed Dec 13 21:13:02 UTC 2023
Alan Zimmerman pushed to branch wip/az/epa-hslet-tokens at Glasgow Haskell Compiler / GHC
Commits:
ad7a0bb4 by Alan Zimmerman at 2023-12-13T21:10:28+00:00
EPA: Remove last EpAnn from extension points
- - - - -
30 changed files:
- compiler/GHC/Hs/Binds.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/ImpExp.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Hs/Utils.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- compiler/GHC/Parser/Types.hs
- testsuite/tests/ghc-api/exactprint/T22919.stderr
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
- testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
- testsuite/tests/module/mod185.stderr
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T14189.stderr
- testsuite/tests/parser/should_compile/T15323.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- testsuite/tests/parser/should_compile/T20718.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test20297.stdout
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Hs/Binds.hs
=====================================
@@ -132,7 +132,7 @@ type instance XXHsBindsLR GhcPs pR = DataConCantHappen
type instance XXHsBindsLR GhcRn pR = DataConCantHappen
type instance XXHsBindsLR GhcTc pR = AbsBinds
-type instance XPSB (GhcPass idL) GhcPs = EpAnn [AddEpAnn]
+type instance XPSB (GhcPass idL) GhcPs = [AddEpAnn]
type instance XPSB (GhcPass idL) GhcRn = NameSet -- Post renaming, FVs. See Note [Bind free vars]
type instance XPSB (GhcPass idL) GhcTc = NameSet
@@ -646,7 +646,7 @@ isEmptyIPBindsTc :: HsIPBinds GhcTc -> Bool
isEmptyIPBindsTc (IPBinds ds is) = null is && isEmptyTcEvBinds ds
-- EPA annotations in GhcPs, dictionary Id in GhcTc
-type instance XCIPBind GhcPs = EpAnn [AddEpAnn]
+type instance XCIPBind GhcPs = [AddEpAnn]
type instance XCIPBind GhcRn = NoExtField
type instance XCIPBind GhcTc = Id
type instance XXIPBind (GhcPass p) = DataConCantHappen
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -362,7 +362,7 @@ type instance XClassDecl GhcTc = NameSet -- FVs
type instance XXTyClDecl (GhcPass _) = DataConCantHappen
-type instance XCTyFamInstDecl (GhcPass _) = EpAnn [AddEpAnn]
+type instance XCTyFamInstDecl (GhcPass _) = [AddEpAnn]
type instance XXTyFamInstDecl (GhcPass _) = DataConCantHappen
------------- Pretty printing FamilyDecls -----------
@@ -512,7 +512,7 @@ pprTyClDeclFlavour (DataDecl { tcdDataDefn = HsDataDefn { dd_cons = nd } })
instance OutputableBndrId p => Outputable (FunDep (GhcPass p)) where
ppr = pprFunDep
-type instance XCFunDep (GhcPass _) = EpAnn [AddEpAnn]
+type instance XCFunDep (GhcPass _) = [AddEpAnn]
type instance XXFunDep (GhcPass _) = DataConCantHappen
pprFundeps :: OutputableBndrId p => [FunDep (GhcPass p)] -> SDoc
@@ -546,7 +546,7 @@ type instance XCKindSig (GhcPass _) = NoExtField
type instance XTyVarSig (GhcPass _) = NoExtField
type instance XXFamilyResultSig (GhcPass _) = DataConCantHappen
-type instance XCFamilyDecl (GhcPass _) = EpAnn [AddEpAnn]
+type instance XCFamilyDecl (GhcPass _) = [AddEpAnn]
type instance XXFamilyDecl (GhcPass _) = DataConCantHappen
@@ -573,7 +573,7 @@ resultVariableName _ = Nothing
------------- Pretty printing FamilyDecls -----------
-type instance XCInjectivityAnn (GhcPass _) = EpAnn [AddEpAnn]
+type instance XCInjectivityAnn (GhcPass _) = [AddEpAnn]
type instance XXInjectivityAnn (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
@@ -620,7 +620,7 @@ instance OutputableBndrId p
type instance XCHsDataDefn (GhcPass _) = NoExtField
type instance XXHsDataDefn (GhcPass _) = DataConCantHappen
-type instance XCHsDerivingClause (GhcPass _) = EpAnn [AddEpAnn]
+type instance XCHsDerivingClause (GhcPass _) = [AddEpAnn]
type instance XXHsDerivingClause (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
@@ -665,11 +665,11 @@ type instance XXStandaloneKindSig (GhcPass p) = DataConCantHappen
standaloneKindSigName :: StandaloneKindSig (GhcPass p) -> IdP (GhcPass p)
standaloneKindSigName (StandaloneKindSig _ lname _) = unLoc lname
-type instance XConDeclGADT GhcPs = (EpUniToken "::" "∷", EpAnn [AddEpAnn])
+type instance XConDeclGADT GhcPs = (EpUniToken "::" "∷", [AddEpAnn])
type instance XConDeclGADT GhcRn = NoExtField
type instance XConDeclGADT GhcTc = NoExtField
-type instance XConDeclH98 GhcPs = EpAnn [AddEpAnn]
+type instance XConDeclH98 GhcPs = [AddEpAnn]
type instance XConDeclH98 GhcRn = NoExtField
type instance XConDeclH98 GhcTc = NoExtField
@@ -1047,15 +1047,15 @@ instance OutputableBndrId p
************************************************************************
-}
-type instance XStockStrategy GhcPs = EpAnn [AddEpAnn]
+type instance XStockStrategy GhcPs = [AddEpAnn]
type instance XStockStrategy GhcRn = NoExtField
type instance XStockStrategy GhcTc = NoExtField
-type instance XAnyClassStrategy GhcPs = EpAnn [AddEpAnn]
+type instance XAnyClassStrategy GhcPs = [AddEpAnn]
type instance XAnyClassStrategy GhcRn = NoExtField
type instance XAnyClassStrategy GhcTc = NoExtField
-type instance XNewtypeStrategy GhcPs = EpAnn [AddEpAnn]
+type instance XNewtypeStrategy GhcPs = [AddEpAnn]
type instance XNewtypeStrategy GhcRn = NoExtField
type instance XNewtypeStrategy GhcTc = NoExtField
@@ -1063,7 +1063,7 @@ type instance XViaStrategy GhcPs = XViaStrategyPs
type instance XViaStrategy GhcRn = LHsSigType GhcRn
type instance XViaStrategy GhcTc = Type
-data XViaStrategyPs = XViaStrategyPs (EpAnn [AddEpAnn]) (LHsSigType GhcPs)
+data XViaStrategyPs = XViaStrategyPs [AddEpAnn] (LHsSigType GhcPs)
instance OutputableBndrId p
=> Outputable (DerivStrategy (GhcPass p)) where
@@ -1102,7 +1102,7 @@ mapDerivStrategy f ds = foldDerivStrategy ds (ViaStrategy . f) ds
************************************************************************
-}
-type instance XCDefaultDecl GhcPs = EpAnn [AddEpAnn]
+type instance XCDefaultDecl GhcPs = [AddEpAnn]
type instance XCDefaultDecl GhcRn = NoExtField
type instance XCDefaultDecl GhcTc = NoExtField
@@ -1121,11 +1121,11 @@ instance OutputableBndrId p
************************************************************************
-}
-type instance XForeignImport GhcPs = EpAnn [AddEpAnn]
+type instance XForeignImport GhcPs = [AddEpAnn]
type instance XForeignImport GhcRn = NoExtField
type instance XForeignImport GhcTc = Coercion
-type instance XForeignExport GhcPs = EpAnn [AddEpAnn]
+type instance XForeignExport GhcPs = [AddEpAnn]
type instance XForeignExport GhcRn = NoExtField
type instance XForeignExport GhcTc = Coercion
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -430,7 +430,7 @@ instance NoAnn AnnsIf where
type instance XSCC (GhcPass _) = (EpAnn AnnPragma, SourceText)
type instance XXPragE (GhcPass _) = DataConCantHappen
-type instance XCDotFieldOcc (GhcPass _) = EpAnn AnnFieldLabel
+type instance XCDotFieldOcc (GhcPass _) = AnnFieldLabel
type instance XXDotFieldOcc (GhcPass _) = DataConCantHappen
type instance XPresent (GhcPass _) = NoExtField
@@ -1119,7 +1119,7 @@ instance (Outputable a, Outputable b) => Outputable (HsExpansion a b) where
************************************************************************
-}
-type instance XCmdArrApp GhcPs = EpAnn AddEpAnn
+type instance XCmdArrApp GhcPs = AddEpAnn
type instance XCmdArrApp GhcRn = NoExtField
type instance XCmdArrApp GhcTc = Type
@@ -1127,20 +1127,20 @@ type instance XCmdArrForm GhcPs = AnnList
type instance XCmdArrForm GhcRn = NoExtField
type instance XCmdArrForm GhcTc = NoExtField
-type instance XCmdApp (GhcPass _) = EpAnnCO
+type instance XCmdApp (GhcPass _) = NoExtField
type instance XCmdLam (GhcPass _) = NoExtField
type instance XCmdPar GhcPs = (EpToken "(", EpToken ")")
type instance XCmdPar GhcRn = NoExtField
type instance XCmdPar GhcTc = NoExtField
-type instance XCmdCase GhcPs = EpAnn EpAnnHsCase
+type instance XCmdCase GhcPs = EpAnnHsCase
type instance XCmdCase GhcRn = NoExtField
type instance XCmdCase GhcTc = NoExtField
-type instance XCmdLamCase (GhcPass _) = EpAnn [AddEpAnn]
+type instance XCmdLamCase (GhcPass _) = [AddEpAnn]
-type instance XCmdIf GhcPs = EpAnn AnnsIf
+type instance XCmdIf GhcPs = AnnsIf
type instance XCmdIf GhcRn = NoExtField
type instance XCmdIf GhcTc = NoExtField
@@ -1148,7 +1148,7 @@ type instance XCmdLet GhcPs = (EpToken "let", EpToken "in")
type instance XCmdLet GhcRn = NoExtField
type instance XCmdLet GhcTc = NoExtField
-type instance XCmdDo GhcPs = EpAnn AnnList
+type instance XCmdDo GhcPs = AnnList
type instance XCmdDo GhcRn = NoExtField
type instance XCmdDo GhcTc = Type
@@ -1342,7 +1342,7 @@ data MatchGroupTc
type instance XXMatchGroup (GhcPass _) b = DataConCantHappen
-type instance XCMatch (GhcPass _) b = EpAnn [AddEpAnn]
+type instance XCMatch (GhcPass _) b = [AddEpAnn]
type instance XXMatch (GhcPass _) b = DataConCantHappen
instance (OutputableBndrId pr, Outputable body)
@@ -1513,7 +1513,7 @@ data RecStmtTc =
type instance XLastStmt (GhcPass _) (GhcPass _) b = NoExtField
-type instance XBindStmt (GhcPass _) GhcPs b = EpAnn [AddEpAnn]
+type instance XBindStmt (GhcPass _) GhcPs b = [AddEpAnn]
type instance XBindStmt (GhcPass _) GhcRn b = XBindStmtRn
type instance XBindStmt (GhcPass _) GhcTc b = XBindStmtTc
@@ -1537,17 +1537,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 [AddEpAnn]
+type instance XLetStmt (GhcPass _) (GhcPass _) b = [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 [AddEpAnn]
+type instance XTransStmt (GhcPass _) GhcPs b = [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 = AnnList
type instance XRecStmt (GhcPass _) GhcRn b = NoExtField
type instance XRecStmt (GhcPass _) GhcTc b = RecStmtTc
=====================================
compiler/GHC/Hs/ImpExp.hs
=====================================
@@ -212,28 +212,28 @@ type instance XIEVar GhcTc = NoExtField
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
-type instance XIEThingAbs GhcPs = (Maybe (LWarningTxt GhcPs), EpAnn [AddEpAnn])
-type instance XIEThingAbs GhcRn = (Maybe (LWarningTxt GhcRn), EpAnn [AddEpAnn])
-type instance XIEThingAbs GhcTc = EpAnn [AddEpAnn]
+type instance XIEThingAbs GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])
+type instance XIEThingAbs GhcRn = (Maybe (LWarningTxt GhcRn), [AddEpAnn])
+type instance XIEThingAbs GhcTc = [AddEpAnn]
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
-type instance XIEThingAll GhcPs = (Maybe (LWarningTxt GhcPs), EpAnn [AddEpAnn])
-type instance XIEThingAll GhcRn = (Maybe (LWarningTxt GhcRn), EpAnn [AddEpAnn])
-type instance XIEThingAll GhcTc = EpAnn [AddEpAnn]
+type instance XIEThingAll GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])
+type instance XIEThingAll GhcRn = (Maybe (LWarningTxt GhcRn), [AddEpAnn])
+type instance XIEThingAll GhcTc = [AddEpAnn]
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
-type instance XIEThingWith GhcPs = (Maybe (LWarningTxt GhcPs), EpAnn [AddEpAnn])
-type instance XIEThingWith GhcRn = (Maybe (LWarningTxt GhcRn), EpAnn [AddEpAnn])
-type instance XIEThingWith GhcTc = EpAnn [AddEpAnn]
+type instance XIEThingWith GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])
+type instance XIEThingWith GhcRn = (Maybe (LWarningTxt GhcRn), [AddEpAnn])
+type instance XIEThingWith GhcTc = [AddEpAnn]
-- The additional field of type 'Maybe (WarningTxt pass)' holds information
-- about export deprecation annotations and is thus set to Nothing when `IE`
-- is used in an import list (since export deprecation can only be used in exports)
-type instance XIEModuleContents GhcPs = (Maybe (LWarningTxt GhcPs), EpAnn [AddEpAnn])
+type instance XIEModuleContents GhcPs = (Maybe (LWarningTxt GhcPs), [AddEpAnn])
type instance XIEModuleContents GhcRn = Maybe (LWarningTxt GhcRn)
type instance XIEModuleContents GhcTc = NoExtField
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -92,7 +92,7 @@ type instance XWildPat GhcTc = Type
type instance XVarPat (GhcPass _) = NoExtField
-type instance XLazyPat GhcPs = EpAnn [AddEpAnn] -- For '~'
+type instance XLazyPat GhcPs = [AddEpAnn] -- For '~'
type instance XLazyPat GhcRn = NoExtField
type instance XLazyPat GhcTc = NoExtField
@@ -104,11 +104,11 @@ type instance XParPat GhcPs = (EpToken "(", EpToken ")")
type instance XParPat GhcRn = NoExtField
type instance XParPat GhcTc = NoExtField
-type instance XBangPat GhcPs = EpAnn [AddEpAnn] -- For '!'
+type instance XBangPat GhcPs = [AddEpAnn] -- For '!'
type instance XBangPat GhcRn = NoExtField
type instance XBangPat GhcTc = NoExtField
-type instance XListPat GhcPs = EpAnn AnnList
+type instance XListPat GhcPs = AnnList
-- After parsing, ListPat can refer to a built-in Haskell list pattern
-- or an overloaded list pattern.
type instance XListPat GhcRn = NoExtField
@@ -118,19 +118,19 @@ type instance XListPat GhcRn = NoExtField
type instance XListPat GhcTc = Type
-- List element type, for use in hsPatType.
-type instance XTuplePat GhcPs = EpAnn [AddEpAnn]
+type instance XTuplePat GhcPs = [AddEpAnn]
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]
-type instance XSumPat GhcPs = EpAnn EpAnnSumPat
+type instance XSumPat GhcPs = EpAnnSumPat
type instance XSumPat GhcRn = NoExtField
type instance XSumPat GhcTc = [Type]
-type instance XConPat GhcPs = EpAnn [AddEpAnn]
+type instance XConPat GhcPs = [AddEpAnn]
type instance XConPat GhcRn = NoExtField
type instance XConPat GhcTc = ConPatTc
-type instance XViewPat GhcPs = EpAnn [AddEpAnn]
+type instance XViewPat GhcPs = [AddEpAnn]
type instance XViewPat GhcRn = Maybe (HsExpr GhcRn)
-- The @HsExpr GhcRn@ gives an inverse to the view function.
-- This is used for overloaded lists in particular.
@@ -146,15 +146,15 @@ type instance XSplicePat GhcTc = DataConCantHappen
type instance XLitPat (GhcPass _) = NoExtField
-type instance XNPat GhcPs = EpAnn [AddEpAnn]
-type instance XNPat GhcRn = EpAnn [AddEpAnn]
+type instance XNPat GhcPs = [AddEpAnn]
+type instance XNPat GhcRn = [AddEpAnn]
type instance XNPat GhcTc = Type
-type instance XNPlusKPat GhcPs = EpAnn EpaLocation -- Of the "+"
+type instance XNPlusKPat GhcPs = EpaLocation -- Of the "+"
type instance XNPlusKPat GhcRn = NoExtField
type instance XNPlusKPat GhcTc = Type
-type instance XSigPat GhcPs = EpAnn [AddEpAnn]
+type instance XSigPat GhcPs = [AddEpAnn]
type instance XSigPat GhcRn = NoExtField
type instance XSigPat GhcTc = Type
@@ -179,7 +179,7 @@ type instance XConPatTyArg GhcPs = EpToken "@"
type instance XConPatTyArg GhcRn = NoExtField
type instance XConPatTyArg GhcTc = NoExtField
-type instance XHsFieldBind _ = EpAnn [AddEpAnn]
+type instance XHsFieldBind _ = [AddEpAnn]
-- ---------------------------------------------------------------------
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -470,7 +470,7 @@ pprHsArrow (HsUnrestrictedArrow _) = pprArrowWithMultiplicity visArgTypeLike (Le
pprHsArrow (HsLinearArrow _) = pprArrowWithMultiplicity visArgTypeLike (Left True)
pprHsArrow (HsExplicitMult _ p) = pprArrowWithMultiplicity visArgTypeLike (Right (ppr p))
-type instance XConDeclField (GhcPass _) = EpAnn [AddEpAnn]
+type instance XConDeclField (GhcPass _) = [AddEpAnn]
type instance XXConDeclField (GhcPass _) = DataConCantHappen
instance OutputableBndrId p
=====================================
compiler/GHC/Hs/Utils.hs
=====================================
@@ -338,9 +338,9 @@ mkHsCompAnns :: HsDoFlavour -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> AnnList
-> HsExpr GhcPs
-mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> EpAnn [AddEpAnn]
+mkNPat :: LocatedAn NoEpAnns (HsOverLit GhcPs) -> Maybe (SyntaxExpr GhcPs) -> [AddEpAnn]
-> Pat GhcPs
-mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpAnn EpaLocation
+mkNPlusKPat :: LocatedN RdrName -> LocatedAn NoEpAnns (HsOverLit GhcPs) -> EpaLocation
-> Pat GhcPs
-- NB: The following functions all use noSyntaxExpr: the generated expressions
@@ -349,7 +349,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 [AddEpAnn] -> LPat GhcPs -> LocatedA (bodyR GhcPs)
+mkPsBindStmt :: [AddEpAnn] -> LPat GhcPs -> LocatedA (bodyR GhcPs)
-> StmtLR GhcPs GhcPs (LocatedA (bodyR GhcPs))
mkRnBindStmt :: LPat GhcRn -> LocatedA (bodyR GhcRn)
-> StmtLR GhcRn GhcRn (LocatedA (bodyR GhcRn))
@@ -373,7 +373,7 @@ mkRecStmt :: forall (idL :: Pass) bodyR.
(Anno (StmtLR (GhcPass idL) GhcPs bodyR))
(StmtLR (GhcPass idL) GhcPs bodyR)]
~ SrcSpanAnnL)
- => EpAnn AnnList
+ => AnnList
-> LocatedL [LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt anns stmts = (emptyRecStmt' anns :: StmtLR (GhcPass idL) GhcPs bodyR)
@@ -401,7 +401,7 @@ mkHsIf :: LHsExpr GhcPs -> LHsExpr GhcPs -> LHsExpr GhcPs -> AnnsIf
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 AnnsIf
+mkHsCmdIf :: LHsExpr GhcPs -> LHsCmd GhcPs -> LHsCmd GhcPs -> AnnsIf
-> HsCmd GhcPs
mkHsCmdIf c a b anns = HsCmdIf anns noSyntaxExpr c a b
@@ -409,17 +409,17 @@ mkNPat lit neg anns = NPat anns lit neg noSyntaxExpr
mkNPlusKPat id lit anns
= NPlusKPat anns id lit (unLoc lit) noSyntaxExpr noSyntaxExpr
-mkTransformStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
+mkTransformStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-mkTransformByStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
+mkTransformByStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> LHsExpr GhcPs -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-mkGroupUsingStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
+mkGroupUsingStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-mkGroupByUsingStmt :: EpAnn [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
+mkGroupByUsingStmt :: [AddEpAnn] -> [ExprLStmt GhcPs] -> LHsExpr GhcPs
-> LHsExpr GhcPs
-> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
-emptyTransStmt :: EpAnn [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
+emptyTransStmt :: [AddEpAnn] -> StmtLR GhcPs GhcPs (LHsExpr GhcPs)
emptyTransStmt anns = TransStmt { trS_ext = anns
, trS_form = panic "emptyTransStmt: form"
, trS_stmts = [], trS_bndrs = []
@@ -468,7 +468,7 @@ emptyRecStmtName = emptyRecStmt' noExtField
emptyRecStmtId = emptyRecStmt' unitRecStmtTc
-- a panic might trigger during zonking
-mkLetStmt :: EpAnn [AddEpAnn] -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
+mkLetStmt :: [AddEpAnn] -> HsLocalBinds GhcPs -> StmtLR GhcPs GhcPs (LocatedA b)
mkLetStmt anns binds = LetStmt anns binds
-------------------------------
@@ -846,7 +846,7 @@ mkVarBind var rhs = L (getLoc rhs) $
var_id = var, var_rhs = rhs }
mkPatSynBind :: LocatedN RdrName -> HsPatSynDetails GhcPs
- -> LPat GhcPs -> HsPatSynDir GhcPs -> EpAnn [AddEpAnn] -> HsBind GhcPs
+ -> LPat GhcPs -> HsPatSynDir GhcPs -> [AddEpAnn] -> HsBind GhcPs
mkPatSynBind name details lpat dir anns = PatSynBind noExtField psb
where
psb = PSB{ psb_ext = anns
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1022,7 +1022,7 @@ export :: { OrdList (LIE GhcPs) }
; return $ unitOL $ reLoc $ sL span $ impExp } }
| maybe_warning_pragma 'module' modid {% do { let { span = (maybe comb2 comb3 $1) $2 $>
; anchor = (maybe glR (\loc -> spanAsAnchor . comb2 loc) $1) $2 }
- ; locImpExp <- acs (\cs -> sL span (IEModuleContents ($1, EpAnn anchor [mj AnnModule $2] cs) $3))
+ ; locImpExp <- return (sL span (IEModuleContents ($1, [mj AnnModule $2]) $3))
; return $ unitOL $ reLoc $ locImpExp } }
| maybe_warning_pragma 'pattern' qcon { let span = (maybe comb2 comb3 $1) $2 $>
in unitOL $ reLoc $ sL span $ IEVar $1 (sLLa $2 $> (IEPattern (glAA $2) $3)) }
@@ -1193,7 +1193,7 @@ importlist1 :: { OrdList (LIE GhcPs) }
import :: { OrdList (LIE GhcPs) }
: qcname_ext export_subspec {% fmap (unitOL . reLoc . (sLL $1 $>)) $ mkModuleImpExp Nothing (fst $ unLoc $2) $1 (snd $ unLoc $2) }
- | 'module' modid {% fmap (unitOL . reLoc) $ acs (\cs -> sLL $1 $> (IEModuleContents (Nothing, EpAnn (glEE $1 $>) [mj AnnModule $1] cs) $2)) }
+ | 'module' modid {% fmap (unitOL . reLoc) $ return (sLL $1 $> (IEModuleContents (Nothing, [mj AnnModule $1]) $2)) }
| 'pattern' qcon { unitOL $ reLoc $ sLL $1 $> $ IEVar Nothing (sLLa $1 $> (IEPattern (glAA $1) $2)) }
-----------------------------------------------------------------------------
@@ -1254,9 +1254,9 @@ topdecl :: { LHsDecl GhcPs }
| inst_decl { sL1a $1 (InstD noExtField (unLoc $1)) }
| stand_alone_deriving { sL1a $1 (DerivD noExtField (unLoc $1)) }
| role_annot { sL1a $1 (RoleAnnotD noExtField (unLoc $1)) }
- | 'default' '(' comma_types0 ')' {% acsA (\cs -> sLL $1 $>
- (DefD noExtField (DefaultDecl (EpAnn (glEE $1 $>) [mj AnnDefault $1,mop $2,mcp $4] cs) $3))) }
- | 'foreign' fdecl {% acsA (\cs -> sLL $1 $> ((snd $ unLoc $2) (EpAnn (glEE $1 $>) (mj AnnForeign $1:(fst $ unLoc $2)) cs))) }
+ | 'default' '(' comma_types0 ')' {% amsA' (sLL $1 $>
+ (DefD noExtField (DefaultDecl [mj AnnDefault $1,mop $2,mcp $4] $3))) }
+ | 'foreign' fdecl {% amsA' (sLL $1 $> ((snd $ unLoc $2) (mj AnnForeign $1:(fst $ unLoc $2)))) }
| '{-# DEPRECATED' deprecations '#-}' {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ([mo $1,mc $3], (getDEPRECATED_PRAGs $1)) (fromOL $2))) }
| '{-# WARNING' warnings '#-}' {% amsA' (sLL $1 $> $ WarningD noExtField (Warnings ([mo $1,mc $3], (getWARNING_PRAGs $1)) (fromOL $2))) }
| '{-# RULES' rules '#-}' {% amsA' (sLL $1 $> $ RuleD noExtField (HsRules ([mo $1,mc $3], (getRULES_PRAGs $1)) (reverse $2))) }
@@ -1393,18 +1393,17 @@ overlap_pragma :: { Maybe (LocatedP OverlapMode) }
| {- empty -} { Nothing }
deriv_strategy_no_via :: { LDerivStrategy GhcPs }
- : 'stock' {% acsA (\cs -> sL1 $1 (StockStrategy (EpAnn (glR $1) [mj AnnStock $1] cs))) }
- | 'anyclass' {% acsA (\cs -> sL1 $1 (AnyclassStrategy (EpAnn (glR $1) [mj AnnAnyclass $1] cs))) }
- | 'newtype' {% acsA (\cs -> sL1 $1 (NewtypeStrategy (EpAnn (glR $1) [mj AnnNewtype $1] cs))) }
+ : 'stock' {% amsA' (sL1 $1 (StockStrategy [mj AnnStock $1])) }
+ | 'anyclass' {% amsA' (sL1 $1 (AnyclassStrategy [mj AnnAnyclass $1])) }
+ | 'newtype' {% amsA' (sL1 $1 (NewtypeStrategy [mj AnnNewtype $1])) }
deriv_strategy_via :: { LDerivStrategy GhcPs }
- : 'via' sigktype {% acsA (\cs -> sLL $1 $> (ViaStrategy (XViaStrategyPs (EpAnn (glEE $1 $>) [mj AnnVia $1] cs)
- $2))) }
+ : 'via' sigktype {% amsA' (sLL $1 $> (ViaStrategy (XViaStrategyPs [mj AnnVia $1] $2))) }
deriv_standalone_strategy :: { Maybe (LDerivStrategy GhcPs) }
- : 'stock' {% fmap Just $ acsA (\cs -> sL1 $1 (StockStrategy (EpAnn (glR $1) [mj AnnStock $1] cs))) }
- | 'anyclass' {% fmap Just $ acsA (\cs -> sL1 $1 (AnyclassStrategy (EpAnn (glR $1) [mj AnnAnyclass $1] cs))) }
- | 'newtype' {% fmap Just $ acsA (\cs -> sL1 $1 (NewtypeStrategy (EpAnn (glR $1) [mj AnnNewtype $1] cs))) }
+ : 'stock' {% fmap Just $ amsA' (sL1 $1 (StockStrategy [mj AnnStock $1])) }
+ | 'anyclass' {% fmap Just $ amsA' (sL1 $1 (AnyclassStrategy [mj AnnAnyclass $1])) }
+ | 'newtype' {% fmap Just $ amsA' (sL1 $1 (NewtypeStrategy [mj AnnNewtype $1])) }
| deriv_strategy_via { Just $1 }
| {- empty -} { Nothing }
@@ -1417,7 +1416,7 @@ opt_injective_info :: { Located ([AddEpAnn], Maybe (LInjectivityAnn GhcPs)) }
injectivity_cond :: { LInjectivityAnn GhcPs }
: tyvarid '->' inj_varids
- {% acsA (\cs -> sLL $1 $> (InjectivityAnn (EpAnn (glR $1) [mu AnnRarrow $2] cs) $1 (reverse (unLoc $3)))) }
+ {% amsA' (sLL $1 $> (InjectivityAnn [mu AnnRarrow $2] $1 (reverse (unLoc $3)))) }
inj_varids :: { Located [LocatedN RdrName] }
: inj_varids tyvarid { sLL $1 $> ($2 : unLoc $1) }
@@ -1657,21 +1656,21 @@ role : VARID { sL1 $1 $ Just $ getVARID $1 }
pattern_synonym_decl :: { LHsDecl GhcPs }
: 'pattern' pattern_synonym_lhs '=' pat
{% let (name, args, as ) = $2 in
- acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4
+ amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4
ImplicitBidirectional
- (EpAnn (glEE $1 $>) (as ++ [mj AnnPattern $1, mj AnnEqual $3]) cs)) }
+ (as ++ [mj AnnPattern $1, mj AnnEqual $3])) }
| 'pattern' pattern_synonym_lhs '<-' pat
{% let (name, args, as) = $2 in
- acsA (\cs -> sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional
- (EpAnn (glEE $1 $>) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs)) }
+ amsA' (sLL $1 $> . ValD noExtField $ mkPatSynBind name args $4 Unidirectional
+ (as ++ [mj AnnPattern $1,mu AnnLarrow $3])) }
| 'pattern' pattern_synonym_lhs '<-' pat where_decls
{% do { let (name, args, as) = $2
; mg <- mkPatSynMatchGroup name $5
- ; acsA (\cs -> sLL $1 $> . ValD noExtField $
+ ; amsA' (sLL $1 $> . ValD noExtField $
mkPatSynBind name args $4 (ExplicitBidirectional mg)
- (EpAnn (glEE $1 $>) (as ++ [mj AnnPattern $1,mu AnnLarrow $3]) cs))
+ (as ++ [mj AnnPattern $1,mu AnnLarrow $3]))
}}
pattern_synonym_lhs :: { (LocatedN RdrName, HsPatSynDetails GhcPs, [AddEpAnn]) }
@@ -2026,7 +2025,7 @@ deprecations :: { OrdList (LWarnDecl GhcPs) }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
deprecation :: { OrdList (LWarnDecl GhcPs) }
: namelist strings
- {% fmap unitOL $ acsA (\cs -> sLL $1 $> $ (Warning (fst $ unLoc $2) (unLoc $1)
+ {% fmap unitOL $ amsA' (sLL $1 $> $ (Warning (fst $ unLoc $2) (unLoc $1)
(DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $2))) }
strings :: { Located ([AddEpAnn],[Located StringLiteral]) }
@@ -2051,19 +2050,19 @@ stringlist :: { Located (OrdList (Located StringLiteral)) }
-- Annotations
annotation :: { LHsDecl GhcPs }
: '{-# ANN' name_var aexp '#-}' {% runPV (unECP $3) >>= \ $3 ->
- acsA (\cs -> sLL $1 $> (AnnD noExtField $ HsAnnotation
+ amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation
(AnnPragma (mo $1) (mc $4) [],
(getANN_PRAGs $1))
(ValueAnnProvenance $2) $3)) }
| '{-# ANN' 'type' otycon aexp '#-}' {% runPV (unECP $4) >>= \ $4 ->
- acsA (\cs -> sLL $1 $> (AnnD noExtField $ HsAnnotation
+ amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation
(AnnPragma (mo $1) (mc $5) [mj AnnType $2],
(getANN_PRAGs $1))
(TypeAnnProvenance $3) $4)) }
| '{-# ANN' 'module' aexp '#-}' {% runPV (unECP $3) >>= \ $3 ->
- acsA (\cs -> sLL $1 $> (AnnD noExtField $ HsAnnotation
+ amsA' (sLL $1 $> (AnnD noExtField $ HsAnnotation
(AnnPragma (mo $1) (mc $4) [mj AnnModule $2],
(getANN_PRAGs $1))
ModuleAnnProvenance $3)) }
@@ -2071,7 +2070,7 @@ annotation :: { LHsDecl GhcPs }
-----------------------------------------------------------------------------
-- Foreign import and export declarations
-fdecl :: { Located ([AddEpAnn],EpAnn [AddEpAnn] -> HsDecl GhcPs) }
+fdecl :: { Located ([AddEpAnn], [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)) }
@@ -2361,8 +2360,8 @@ fds1 :: { Located [LHsFunDep GhcPs] }
| fd { sL1 $1 [$1] }
fd :: { LHsFunDep GhcPs }
- : varids0 '->' varids0 {% acsA (\cs -> L (comb3 $1 $2 $3)
- (FunDep (EpAnn (spanAsAnchor (comb3 $1 $2 $3)) [mu AnnRarrow $2] cs)
+ : varids0 '->' varids0 {% amsA' (L (comb3 $1 $2 $3)
+ (FunDep [mu AnnRarrow $2]
(reverse (unLoc $1))
(reverse (unLoc $3)))) }
@@ -2460,17 +2459,16 @@ constrs1 :: { Located [LConDecl GhcPs] }
constr :: { LConDecl GhcPs }
: forall context '=>' constr_stuff
- {% acsA (\cs -> let (con,details) = unLoc $4 in
+ {% amsA' (let (con,details) = unLoc $4 in
(L (comb4 $1 $2 $3 $4) (mkConDeclH98
- (EpAnn (spanAsAnchor (comb4 $1 $2 $3 $4))
- (mu AnnDarrow $3:(fst $ unLoc $1)) cs)
+ (mu AnnDarrow $3:(fst $ unLoc $1))
con
(snd $ unLoc $1)
(Just $2)
details))) }
| forall constr_stuff
- {% acsA (\cs -> let (con,details) = unLoc $2 in
- (L (comb2 $1 $2) (mkConDeclH98 (EpAnn (spanAsAnchor (comb2 $1 $2)) (fst $ unLoc $1) cs)
+ {% amsA' (let (con,details) = unLoc $2 in
+ (L (comb2 $1 $2) (mkConDeclH98 (fst $ unLoc $1)
con
(snd $ unLoc $1)
Nothing -- No context
@@ -2498,8 +2496,8 @@ fielddecls1 :: { [LConDeclField GhcPs] }
fielddecl :: { LConDeclField GhcPs }
-- A list because of f,g :: Int
: sig_vars '::' ctype
- {% acsA (\cs -> L (comb2 $1 $3)
- (ConDeclField (EpAnn (glEE $1 $>) [mu AnnDcolon $2] cs)
+ {% amsA' (L (comb2 $1 $3)
+ (ConDeclField [mu AnnDcolon $2]
(reverse (map (\ln@(L l n)
-> L (fromTrailingN l) $ FieldOcc noExtField (L (noTrailingN l) n)) (unLoc $1))) $3 Nothing))}
@@ -2518,15 +2516,15 @@ derivings :: { Located (HsDeriving GhcPs) }
deriving :: { LHsDerivingClause GhcPs }
: 'deriving' deriv_clause_types
{% let { full_loc = comb2 $1 $> }
- in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glEE $1 $>) [mj AnnDeriving $1] cs) Nothing $2) }
+ in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] Nothing $2) }
| 'deriving' deriv_strategy_no_via deriv_clause_types
{% let { full_loc = comb2 $1 $> }
- in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glEE $1 $>) [mj AnnDeriving $1] cs) (Just $2) $3) }
+ in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] (Just $2) $3) }
| 'deriving' deriv_clause_types deriv_strategy_via
{% let { full_loc = comb2 $1 $> }
- in acsA (\cs -> L full_loc $ HsDerivingClause (EpAnn (glEE $1 $>) [mj AnnDeriving $1] cs) (Just $3) $2) }
+ in amsA' (L full_loc $ HsDerivingClause [mj AnnDeriving $1] (Just $3) $2) }
deriv_clause_types :: { LDerivClauseTys GhcPs }
: qtycon { let { tc = sL1a $1 $ mkHsImplicitSigType $
@@ -2708,22 +2706,22 @@ exp :: { ECP }
| infixexp '-<' exp {% runPV (unECP $1) >>= \ $1 ->
runPV (unECP $3) >>= \ $3 ->
fmap ecpFromCmd $
- acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glEE $1 $>) (mu Annlarrowtail $2) cs) $1 $3
+ amsA' (sLL $1 $> $ HsCmdArrApp (mu Annlarrowtail $2) $1 $3
HsFirstOrderApp True) }
| infixexp '>-' exp {% runPV (unECP $1) >>= \ $1 ->
runPV (unECP $3) >>= \ $3 ->
fmap ecpFromCmd $
- acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glEE $1 $>) (mu Annrarrowtail $2) cs) $3 $1
+ amsA' (sLL $1 $> $ HsCmdArrApp (mu Annrarrowtail $2) $3 $1
HsFirstOrderApp False) }
| infixexp '-<<' exp {% runPV (unECP $1) >>= \ $1 ->
runPV (unECP $3) >>= \ $3 ->
fmap ecpFromCmd $
- acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glEE $1 $>) (mu AnnLarrowtail $2) cs) $1 $3
+ amsA' (sLL $1 $> $ HsCmdArrApp (mu AnnLarrowtail $2) $1 $3
HsHigherOrderApp True) }
| infixexp '>>-' exp {% runPV (unECP $1) >>= \ $1 ->
runPV (unECP $3) >>= \ $3 ->
fmap ecpFromCmd $
- acsA (\cs -> sLL $1 $> $ HsCmdArrApp (EpAnn (glEE $1 $>) (mu AnnRarrowtail $2) cs) $3 $1
+ amsA' (sLL $1 $> $ HsCmdArrApp (mu AnnRarrowtail $2) $3 $1
HsHigherOrderApp False) }
-- See Note [%shift: exp -> infixexp]
| infixexp %shift { $1 }
@@ -2872,7 +2870,7 @@ aexp :: { ECP }
mkHsLamPV (comb2 $1 $>) LamSingle
(sLLl $1 $>
[sLLa $1 $>
- $ Match { m_ext = EpAnn (glEE $1 $>) [] emptyComments
+ $ Match { m_ext = []
, m_ctxt = LamAlt LamSingle
, m_pats = $2
, m_grhss = unguardedGRHSs (comb2 $3 $4) $4 (EpAnn (glR $3) (GrhsAnn Nothing (mu AnnRarrow $3)) emptyComments) }])
@@ -2942,7 +2940,7 @@ aexp1 :: { ECP }
| aexp1 TIGHT_INFIX_PROJ field
{% runPV (unECP $1) >>= \ $1 ->
fmap ecpFromExp $ amsA' (
- let fl = sLLa $2 $> (DotFieldOcc ((EpAnn (glR $2) (AnnFieldLabel (Just $ glAA $2)) emptyComments)) $3) in
+ let fl = sLLa $2 $> (DotFieldOcc (AnnFieldLabel (Just $ glAA $2)) $3) in
sLL $1 $> $ mkRdrGetField $1 fl) }
@@ -3031,8 +3029,8 @@ projection :: { Located (NonEmpty (LocatedAn NoEpAnns (DotFieldOcc GhcPs))) }
projection
-- See Note [Whitespace-sensitive operator parsing] in GHC.Parsing.Lexer
: projection TIGHT_INFIX_PROJ field
- {% acs (\cs -> sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (EpAnn (glEE $1 $>) (AnnFieldLabel (Just $ glAA $2)) cs) $3) `NE.cons` unLoc $1)) }
- | PREFIX_PROJ field {% acs (\cs -> sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (EpAnn (glEE $1 $>) (AnnFieldLabel (Just $ glAA $1)) cs) $2) :| [])) }
+ { sLL $1 $> ((sLLa $2 $> $ DotFieldOcc (AnnFieldLabel (Just $ glAA $2)) $3) `NE.cons` unLoc $1) }
+ | PREFIX_PROJ field { sLL $1 $> ((sLLa $1 $> $ DotFieldOcc (AnnFieldLabel (Just $ glAA $1)) $2) :| [])}
splice_exp :: { LHsExpr GhcPs }
: splice_untyped { fmap (HsUntypedSplice noExtField) (reLoc $1) }
@@ -3233,7 +3231,7 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau
(h:t) -> do
h' <- addTrailingCommaA h (gl $2)
return (sLL $1 $> ($3 : (h':t))) }
- | transformqual {% return (sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])]) }
+ | transformqual { sLL $1 $> [L (getLocAnn $1) ((unLoc $1) (glRR $1) [])] }
| qual {% runPV $1 >>= \ $1 ->
return $ sL1 $1 [$1] }
-- | transformquals1 ',' '{|' pquals '|}' { sLL $1 $> ($4 : unLoc $1) }
@@ -3247,22 +3245,19 @@ squals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] } -- In reverse order, becau
transformqual :: { Located (RealSrcSpan -> [LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs (LHsExpr GhcPs)) }
-- Function is applied to a list of stmts *in order*
: 'then' exp {% runPV (unECP $2) >>= \ $2 ->
- acs (\cs->
- sLL $1 $> (\r ss -> (mkTransformStmt (EpAnn (anc r) [mj AnnThen $1] cs) ss $2))) }
+ return (
+ sLL $1 $> (\r ss -> (mkTransformStmt [mj AnnThen $1] ss $2))) }
| 'then' exp 'by' exp {% runPV (unECP $2) >>= \ $2 ->
runPV (unECP $4) >>= \ $4 ->
- acs (\cs -> sLL $1 $> (
- \r ss -> (mkTransformByStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnBy $3] cs) ss $2 $4))) }
+ return (sLL $1 $> (\r ss -> (mkTransformByStmt [mj AnnThen $1,mj AnnBy $3] ss $2 $4))) }
| 'then' 'group' 'using' exp
{% runPV (unECP $4) >>= \ $4 ->
- acs (\cs -> sLL $1 $> (
- \r ss -> (mkGroupUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] cs) ss $4))) }
+ return (sLL $1 $> (\r ss -> (mkGroupUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnUsing $3] ss $4))) }
| 'then' 'group' 'by' exp 'using' exp
{% runPV (unECP $4) >>= \ $4 ->
runPV (unECP $6) >>= \ $6 ->
- acs (\cs -> sLL $1 $> (
- \r ss -> (mkGroupByUsingStmt (EpAnn (anc r) [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] cs) ss $4 $6))) }
+ return (sLL $1 $> (\r ss -> (mkGroupByUsingStmt [mj AnnThen $1,mj AnnGroup $2,mj AnnBy $3,mj AnnUsing $5] ss $4 $6))) }
-- Note that 'group' is a special_id, which means that you can enable
-- TransformListComp while still using Data.List.group. However, this
@@ -3325,7 +3320,7 @@ alts1(PATS) :: { forall b. DisambECP b => PV (Located ([AddEpAnn],[LMatch GhcPs
alt(PATS) :: { forall b. DisambECP b => PV (LMatch GhcPs (LocatedA b)) }
: PATS alt_rhs { $2 >>= \ $2 ->
acsA (\cs -> sLLAsl $1 $>
- (Match { m_ext = EpAnn (listAsAnchor $1 $>) [] cs
+ (Match { m_ext = []
, m_ctxt = CaseAlt -- for \case and \cases, this will be changed during post-processing
, m_pats = $1
, m_grhss = unLoc $2 }))}
@@ -3434,18 +3429,14 @@ e_stmt :: { LStmt GhcPs (LHsExpr GhcPs) }
stmt :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }
: qual { $1 }
| 'rec' stmtlist { $2 >>= \ $2 ->
- acsA (\cs -> (sLL $1 $> $ mkRecStmt
- (EpAnn (glEE $1 $>) (hsDoAnn $1 $2 AnnRec) cs)
- $2)) }
+ amsA' (sLL $1 $> $ mkRecStmt (hsDoAnn $1 $2 AnnRec) $2) }
qual :: { forall b. DisambECP b => PV (LStmt GhcPs (LocatedA b)) }
: bindpat '<-' exp { unECP $3 >>= \ $3 ->
- acsA (\cs -> sLL $1 $>
- $ mkPsBindStmt (EpAnn (glEE $1 $>) [mu AnnLarrow $2] cs) $1 $3) }
+ amsA' (sLL $1 $> $ mkPsBindStmt [mu AnnLarrow $2] $1 $3) }
| exp { unECP $1 >>= \ $1 ->
return $ sL1a $1 $ mkBodyStmt $1 }
- | 'let' binds { acsA (\cs -> (sLL $1 $>
- $ mkLetStmt (EpAnn (glEE $1 $>) [mj AnnLet $1] cs) (unLoc $2))) }
+ | 'let' binds { amsA' (sLL $1 $> $ mkLetStmt [mj AnnLet $1] (unLoc $2)) }
-----------------------------------------------------------------------------
-- Record Field Update/Construction
@@ -3466,13 +3457,13 @@ fbinds1 :: { forall b. DisambECP b => PV ([Fbind b], Maybe SrcSpan) }
fbind :: { forall b. DisambECP b => PV (Fbind b) }
: qvar '=' texp { unECP $3 >>= \ $3 ->
- fmap Left $ acsA (\cs -> sLL $1 $> $ HsFieldBind (EpAnn (glR $1) [mj AnnEqual $2] cs) (sL1a $1 $ mkFieldOcc $1) $3 False) }
+ fmap Left $ amsA' (sLL $1 $> $ HsFieldBind [mj AnnEqual $2] (sL1a $1 $ mkFieldOcc $1) $3 False) }
-- RHS is a 'texp', allowing view patterns (#6038)
-- and, incidentally, sections. Eg
-- f (R { x = show -> s }) = ...
| qvar { placeHolderPunRhs >>= \rhs ->
- fmap Left $ acsA (\cs -> sL1 $1 $ HsFieldBind (EpAnn (glR $1) [] cs) (sL1a $1 $ mkFieldOcc $1) rhs True) }
+ fmap Left $ amsA' (sL1 $1 $ HsFieldBind [] (sL1a $1 $ mkFieldOcc $1) rhs True) }
-- In the punning case, use a place-holder
-- The renamer fills in the final value
@@ -3483,7 +3474,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) }
let top = sL1a $1 $ DotFieldOcc noAnn $1
((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)
lf' = comb2 $2 (L lf ())
- fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t
+ fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ glAA $2)) f) : t
final = last fields
l = comb2 $1 $3
isPun = False
@@ -3499,7 +3490,7 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) }
let top = sL1a $1 $ DotFieldOcc noAnn $1
((L lf (DotFieldOcc _ f)):t) = reverse (unLoc $3)
lf' = comb2 $2 (L lf ())
- fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (EpAnn (spanAsAnchor lf') (AnnFieldLabel (Just $ glAA $2)) emptyComments) f) : t
+ fields = top : L (noAnnSrcSpan lf') (DotFieldOcc (AnnFieldLabel (Just $ glAA $2)) f) : t
final = last fields
l = comb2 $1 $3
isPun = True
@@ -3510,10 +3501,8 @@ fbind :: { forall b. DisambECP b => PV (Fbind b) }
fieldToUpdate :: { Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)] }
fieldToUpdate
-- See Note [Whitespace-sensitive operator parsing] in Lexer.x
- : fieldToUpdate TIGHT_INFIX_PROJ field {% getCommentsFor (getLocA $3) >>= \cs ->
- return (sLL $1 $> ((sLLa $2 $> (DotFieldOcc (EpAnn (glR $2) (AnnFieldLabel $ Just $ glAA $2) cs) $3)) : unLoc $1)) }
- | field {% getCommentsFor (getLocA $1) >>= \cs ->
- return (sL1 $1 [sL1a $1 (DotFieldOcc (EpAnn (glR $1) (AnnFieldLabel Nothing) cs) $1)]) }
+ : fieldToUpdate TIGHT_INFIX_PROJ field { sLL $1 $> ((sLLa $2 $> (DotFieldOcc (AnnFieldLabel $ Just $ glAA $2) $3)) : unLoc $1) }
+ | field { sL1 $1 [sL1a $1 (DotFieldOcc (AnnFieldLabel Nothing) $1)] }
-----------------------------------------------------------------------------
-- Implicit Parameter Bindings
@@ -3534,7 +3523,7 @@ dbinds :: { Located [LIPBind GhcPs] } -- reversed
dbind :: { LIPBind GhcPs }
dbind : ipvar '=' exp {% runPV (unECP $3) >>= \ $3 ->
- acsA (\cs -> sLL $1 $> (IPBind (EpAnn (glEE $1 $>) [mj AnnEqual $2] cs) (reLoc $1) $3)) }
+ amsA' (sLL $1 $> (IPBind [mj AnnEqual $2] (reLoc $1) $3)) }
ipvar :: { Located HsIPName }
: IPDUPVARID { sL1 $1 (HsIPName (getIPDUPVARID $1)) }
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -351,9 +351,8 @@ mkTyFamInst :: SrcSpan
-> [AddEpAnn]
-> P (LInstDecl GhcPs)
mkTyFamInst loc eqn anns = do
- cs <- getCommentsFor loc
return (L (noAnnSrcSpan loc) (TyFamInstD noExtField
- (TyFamInstDecl (EpAnn (spanAsAnchor loc) anns cs) eqn)))
+ (TyFamInstDecl anns eqn)))
mkFamDecl :: SrcSpan
-> FamilyInfo GhcPs
@@ -365,13 +364,10 @@ mkFamDecl :: SrcSpan
-> P (LTyClDecl GhcPs)
mkFamDecl loc info topLevel lhs ksig injAnn annsIn
= do { (tc, tparams, fixity, ann) <- checkTyClHdr False lhs
- ; cs1 <- getCommentsFor loc -- Add any API Annotations to the top SrcSpan [temp]
; tyvars <- 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 emptyComments) ann (cs1 Semi.<> cs2)
; return (L (noAnnSrcSpan loc) (FamDecl noExtField
(FamilyDecl
- { fdExt = anns'
+ { fdExt = annsIn Semi.<> ann
, fdTopLevel = topLevel
, fdInfo = info, fdLName = tc
, fdTyVars = tyvars
@@ -776,7 +772,7 @@ recordPatSynErr loc pat =
addFatalError $ mkPlainErrorMsgEnvelope loc $
(PsErrRecordSyntaxInPatSynDecl pat)
-mkConDeclH98 :: EpAnn [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
+mkConDeclH98 :: [AddEpAnn] -> LocatedN RdrName -> Maybe [LHsTyVarBndr Specificity GhcPs]
-> Maybe (LHsContext GhcPs) -> HsConDeclH98Details GhcPs
-> ConDecl GhcPs
@@ -802,8 +798,6 @@ mkGadtDecl :: SrcSpan
-> LHsSigType GhcPs
-> P (LConDecl GhcPs)
mkGadtDecl loc names dcol ty = do
- cs <- getCommentsFor loc
- let l = noAnnSrcSpan loc
(args, res_ty, annsa, csa) <-
case body_ty of
@@ -820,14 +814,14 @@ mkGadtDecl loc names dcol ty = do
let (anns, cs, arg_types, res_type) = splitHsFunType body_ty
return (PrefixConGADT noExtField arg_types, res_type, anns, cs)
- let an = EpAnn (spanAsAnchor loc) annsa (cs Semi.<> csa)
-
let bndrs_loc = case outer_bndrs of
HsOuterImplicit{} -> getLoc ty
HsOuterExplicit an _ -> EpAnn (entry an) noAnn emptyComments
+ let l = EpAnn (spanAsAnchor loc) noAnn csa
+
pure $ L l ConDeclGADT
- { con_g_ext = (dcol, an)
+ { con_g_ext = (dcol, annsa)
, con_names = names
, con_bndrs = L bndrs_loc outer_bndrs
, con_mb_cxt = mcxt
@@ -1238,10 +1232,10 @@ checkAPat loc e0 = do
(L _ (PatBuilderVar (L nloc n)))
(L l plus)
(L lloc (PatBuilderOverLit lit@(OverLit {ol_val = HsIntegral {}})))
- (EpAnn anc _ cs)
+ _
| nPlusKPatterns && (plus == plus_RDR)
-> return (mkNPlusKPat (L nloc n) (L (l2l lloc) lit)
- (EpAnn anc (entry l) cs))
+ (entry l))
-- Improve error messages for the @-operator when the user meant an @-pattern
PatBuilderOpApp _ op _ _ | opIsAt (unLoc op) -> do
@@ -1323,9 +1317,8 @@ checkFunBind :: SrcStrictness
checkFunBind strictness locF ann fun is_infix pats (L _ grhss)
= do ps <- runPV_details extraDetails (mapM checkLPat pats)
let match_span = noAnnSrcSpan $ locF
- cs <- getCommentsFor locF
return (makeFunBind fun (L (noAnnSrcSpan $ locA match_span)
- [L match_span (Match { m_ext = EpAnn (spanAsAnchor locF) ann cs
+ [L match_span (Match { m_ext = ann
, m_ctxt = FunRhs
{ mc_fun = fun
, mc_fixity = is_infix
@@ -1353,10 +1346,10 @@ checkPatBind :: SrcSpan
-> LPat GhcPs
-> Located (GRHSs GhcPs (LHsExpr GhcPs))
-> P (HsBind GhcPs)
-checkPatBind loc annsIn (L _ (BangPat (EpAnn _ ans cs) (L _ (VarPat _ v))))
+checkPatBind loc annsIn (L _ (BangPat ans (L _ (VarPat _ v))))
(L _match_span grhss)
= return (makeFunBind v (L (noAnnSrcSpan loc)
- [L (noAnnSrcSpan loc) (m (EpAnn (spanAsAnchor loc) (ans++annsIn) cs) v)]))
+ [L (noAnnSrcSpan loc) (m (ans++annsIn) v)]))
where
m a v = Match { m_ext = a
, m_ctxt = FunRhs { mc_fun = v
@@ -1407,7 +1400,7 @@ isFunLhs e = go e [] [] []
(o,c) = mkParensEpAnn (realSrcSpan $ locA l)
in
go e es (o:ops) (c:cps)
- go (L loc (PatBuilderOpApp l (L loc' op) r (EpAnn loca anns cs))) es ops cps
+ go (L loc (PatBuilderOpApp l (L loc' op) r anns)) es ops cps
| not (isRdrDataCon op) -- We have found the function!
= return (Just (L loc' op, Infix, (l:r:es), (anns ++ reverse ops ++ cps)))
| otherwise -- Infix data con; keep going
@@ -1417,7 +1410,7 @@ isFunLhs e = go e [] [] []
-> return (Just (op', Infix, j : op_app : es', anns'))
where
op_app = L loc (PatBuilderOpApp k
- (L loc' op) r (EpAnn loca (reverse ops++cps) cs))
+ (L loc' op) r (reverse ops++cps))
_ -> return Nothing }
go _ _ _ _ = return Nothing
@@ -1678,7 +1671,7 @@ instance DisambECP (HsCmd GhcPs) where
mkHsLamPV l lam_variant (L lm m) anns = do
cs <- getCommentsFor l
let mg = mkLamCaseMatchGroup FromSource lam_variant (L lm m)
- return $ L (noAnnSrcSpan l) (HsCmdLam (EpAnn (spanAsAnchor l) anns cs) lam_variant mg)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdLam anns lam_variant mg)
mkHsLetPV l tkLet bs tkIn e = do
cs <- getCommentsFor l
@@ -1696,23 +1689,22 @@ instance DisambECP (HsCmd GhcPs) where
mkHsCasePV l c (L lm m) anns = do
cs <- getCommentsFor l
let mg = mkMatchGroup FromSource (L lm m)
- return $ L (noAnnSrcSpan l) (HsCmdCase (EpAnn (spanAsAnchor l) anns cs) c mg)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdCase anns c mg)
type FunArg (HsCmd GhcPs) = HsExpr GhcPs
superFunArg m = m
mkHsAppPV l c e = do
- cs <- getCommentsFor (locA l)
checkCmdBlockArguments c
checkExpBlockArguments e
- return $ L l (HsCmdApp (comment (realSrcSpan $ locA l) cs) c e)
+ return $ L l (HsCmdApp noExtField c e)
mkHsAppTypePV l c _ t = cmdFail (locA l) (ppr c <+> text "@" <> ppr t)
mkHsIfPV l c semi1 a semi2 b anns = do
checkDoAndIfThenElse PsErrSemiColonsInCondCmd c semi1 a semi2 b
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (mkHsCmdIf c a b (EpAnn (spanAsAnchor l) anns cs))
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (mkHsCmdIf c a b anns)
mkHsDoPV l Nothing stmts anns = do
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (HsCmdDo (EpAnn (spanAsAnchor l) anns cs) stmts)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsCmdDo anns stmts)
mkHsDoPV l (Just m) _ _ = addFatalError $ mkPlainErrorMsgEnvelope l $ PsErrQualifiedDoInCmd m
mkHsParPV l lpar c rpar = do
cs <- getCommentsFor l
@@ -1763,7 +1755,7 @@ instance DisambECP (HsExpr GhcPs) where
ecpFromExp' = return
mkHsProjUpdatePV l fields arg isPun anns = do
cs <- getCommentsFor l
- return $ mkRdrProjUpdate (noAnnSrcSpan l) fields arg isPun (EpAnn (spanAsAnchor l) anns cs)
+ return $ mkRdrProjUpdate (EpAnn (spanAsAnchor l) noAnn cs) fields arg isPun anns
mkHsLetPV l tkLet bs tkIn c = do
cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (HsLet (tkLet, tkIn) bs c)
@@ -1862,8 +1854,7 @@ instance DisambECP (PatBuilder GhcPs) where
superInfixOp m = m
mkHsOpAppPV l p1 op p2 = do
cs <- getCommentsFor l
- let anns = EpAnn (spanAsAnchor l) [] cs
- return $ L (noAnnSrcSpan l) $ PatBuilderOpApp p1 op p2 anns
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) $ PatBuilderOpApp p1 op p2 []
mkHsLamPV l lam_variant _ _ = addFatalError $ mkPlainErrorMsgEnvelope l (PsErrLambdaInPat lam_variant)
@@ -1887,12 +1878,11 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsWildCardPV l = return $ L l (PatBuilderPat (WildPat noExtField))
mkHsTySigPV l b sig anns = do
p <- checkLPat b
- cs <- getCommentsFor (locA l)
- return $ L l (PatBuilderPat (SigPat (EpAnn (spanAsAnchor $ locA l) anns cs) p (mkHsPatSigType noAnn sig)))
+ return $ L l (PatBuilderPat (SigPat anns p (mkHsPatSigType noAnn sig)))
mkHsExplicitListPV l xs anns = do
ps <- traverse checkLPat xs
cs <- getCommentsFor l
- return (L (noAnnSrcSpan l) (PatBuilderPat (ListPat (EpAnn (spanAsAnchor l) anns cs) ps)))
+ return (L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (ListPat anns ps)))
mkHsSplicePV (L l sp) = do
cs <- getCommentsFor l
return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (SplicePat noExtField sp))
@@ -1902,20 +1892,19 @@ instance DisambECP (PatBuilder GhcPs) where
then addFatalError $ mkPlainErrorMsgEnvelope l PsErrOverloadedRecordDotInvalid
else do
cs <- getCommentsFor l
- r <- mkPatRec a (mk_rec_fields fs ddLoc) (EpAnn (spanAsAnchor l) anns cs)
- checkRecordSyntax (L (noAnnSrcSpan l) r)
+ r <- mkPatRec a (mk_rec_fields fs ddLoc) anns
+ checkRecordSyntax (L (EpAnn (spanAsAnchor l) noAnn cs) r)
mkHsNegAppPV l (L lp p) anns = do
lit <- case p of
PatBuilderOverLit pos_lit -> return (L (l2l lp) pos_lit)
_ -> patFail l $ PsErrInPat p PEIP_NegApp
cs <- getCommentsFor l
- let an = EpAnn (spanAsAnchor l) anns cs
- return $ L (noAnnSrcSpan l) (PatBuilderPat (mkNPat lit (Just noSyntaxExpr) an))
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (mkNPat lit (Just noSyntaxExpr) anns))
mkHsSectionR_PV l op p = patFail l (PsErrParseRightOpSectionInPat (unLoc op) (unLoc p))
mkHsViewPatPV l a b anns = do
p <- checkLPat b
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (PatBuilderPat (ViewPat (EpAnn (spanAsAnchor l) anns cs) a p))
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (ViewPat anns a p))
mkHsAsPatPV l v at e = do
p <- checkLPat e
cs <- getCommentsFor l
@@ -1923,13 +1912,13 @@ instance DisambECP (PatBuilder GhcPs) where
mkHsLazyPatPV l e a = do
p <- checkLPat e
cs <- getCommentsFor l
- return $ L (noAnnSrcSpan l) (PatBuilderPat (LazyPat (EpAnn (spanAsAnchor l) a cs) p))
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat (LazyPat a p))
mkHsBangPatPV l e an = do
p <- checkLPat e
cs <- getCommentsFor l
- let pb = BangPat (EpAnn (spanAsAnchor l) an cs) p
+ let pb = BangPat an p
hintBangPat l pb
- return $ L (noAnnSrcSpan l) (PatBuilderPat pb)
+ return $ L (EpAnn (spanAsAnchor l) noAnn cs) (PatBuilderPat pb)
mkSumOrTuplePV = mkSumOrTuplePat
mkHsEmbTyPV l toktype ty =
return $ L (noAnnSrcSpan l) $
@@ -1965,7 +1954,7 @@ checkUnboxedLitPat (L loc lit) =
mkPatRec ::
LocatedA (PatBuilder GhcPs) ->
HsRecFields GhcPs (LocatedA (PatBuilder GhcPs)) ->
- EpAnn [AddEpAnn] ->
+ [AddEpAnn] ->
PV (PatBuilder GhcPs)
mkPatRec (unLoc -> PatBuilderVar c) (HsRecFields fs dd) anns
| isRdrDataCon (unLoc c)
@@ -2694,7 +2683,7 @@ checkNewOrData span name is_type_data = curry $ \ case
mkImport :: Located CCallConv
-> Located Safety
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
- -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
+ -> P ([AddEpAnn] -> HsDecl GhcPs)
mkImport cconv safety (L loc (StringLiteral esrc entity _), v, ty) =
case unLoc cconv of
CCallConv -> returnSpec =<< mkCImport
@@ -2804,7 +2793,7 @@ parseCImport cconv safety nm str sourceText =
--
mkExport :: Located CCallConv
-> (Located StringLiteral, LocatedN RdrName, LHsSigType GhcPs)
- -> P (EpAnn [AddEpAnn] -> HsDecl GhcPs)
+ -> P ([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
@@ -2837,17 +2826,17 @@ data ImpExpQcSpec = ImpExpQcName (LocatedN RdrName)
mkModuleImpExp :: Maybe (LWarningTxt GhcPs) -> [AddEpAnn] -> LocatedA ImpExpQcSpec
-> ImpExpSubSpec -> P (IE GhcPs)
mkModuleImpExp warning anns (L l specname) subs = do
- cs <- getCommentsFor (locA l) -- AZ: IEVar can discard comments
- let ann = EpAnn (spanAsAnchor $ maybe (locA l) getLocA warning) anns cs
+ -- cs <- getCommentsFor (locA l) -- AZ: IEVar can discard comments
+ -- let ann = EpAnn (spanAsAnchor $ maybe (locA l) getLocA warning) anns cs
case subs of
ImpExpAbs
| isVarNameSpace (rdrNameSpace name)
-> return $ IEVar warning
(L l (ieNameFromSpec specname))
- | otherwise -> IEThingAbs (warning, ann) . L l <$> nameT
- ImpExpAll -> IEThingAll (warning, ann) . L l <$> nameT
+ | otherwise -> IEThingAbs (warning, anns) . L l <$> nameT
+ ImpExpAll -> IEThingAll (warning, anns) . L l <$> nameT
ImpExpList xs ->
- (\newName -> IEThingWith (warning, ann) (L l newName)
+ (\newName -> IEThingWith (warning, anns) (L l newName)
NoIEWildcard (wrapped xs)) <$> nameT
ImpExpAllWith xs ->
do allowed <- getBit PatternSynonymsBit
@@ -2859,7 +2848,7 @@ mkModuleImpExp warning anns (L l specname) subs = do
ies :: [LocatedA (IEWrappedName GhcPs)]
ies = wrapped $ filter (not . isImpExpQcWildcard . unLoc) xs
in (\newName
- -> IEThingWith (warning, ann) (L l newName) pos ies)
+ -> IEThingWith (warning, anns) (L l newName) pos ies)
<$> nameT
else addFatalError $ mkPlainErrorMsgEnvelope (locA l) $
PsErrIllegalPatSynExport
@@ -3138,8 +3127,7 @@ mkSumOrTuplePat
-- Tuple
mkSumOrTuplePat l boxity (Tuple ps) anns = do
ps' <- traverse toTupPat ps
- cs <- getCommentsFor (locA l)
- return $ L l (PatBuilderPat (TuplePat (EpAnn (spanAsAnchor $ locA l) anns cs) ps' boxity))
+ return $ L l (PatBuilderPat (TuplePat anns ps' boxity))
where
toTupPat :: Either (EpAnn Bool) (LocatedA (PatBuilder GhcPs)) -> PV (LPat GhcPs)
-- Ignore the element location so that the error message refers to the
@@ -3152,8 +3140,7 @@ mkSumOrTuplePat l boxity (Tuple ps) anns = do
-- Sum
mkSumOrTuplePat l Unboxed (Sum alt arity p barsb barsa) anns = do
p' <- checkLPat p
- cs <- getCommentsFor (locA l)
- let an = EpAnn (spanAsAnchor $ locA l) (EpAnnSumPat anns barsb barsa) cs
+ let an = EpAnnSumPat anns barsb barsa
return $ L l (PatBuilderPat (SumPat an p' alt arity))
mkSumOrTuplePat l Boxed a at Sum{} _ =
addFatalError $
@@ -3214,7 +3201,7 @@ mkRdrProjection flds anns =
}
mkRdrProjUpdate :: SrcSpanAnnA -> Located [LocatedAn NoEpAnns (DotFieldOcc GhcPs)]
- -> LHsExpr GhcPs -> Bool -> EpAnn [AddEpAnn]
+ -> LHsExpr GhcPs -> Bool -> [AddEpAnn]
-> LHsRecProj GhcPs (LHsExpr GhcPs)
mkRdrProjUpdate _ (L _ []) _ _ _ = panic "mkRdrProjUpdate: The impossible has happened!"
mkRdrProjUpdate loc (L l flds) arg isPun anns =
=====================================
compiler/GHC/Parser/Types.hs
=====================================
@@ -57,7 +57,7 @@ data PatBuilder p
| PatBuilderApp (LocatedA (PatBuilder p)) (LocatedA (PatBuilder p))
| PatBuilderAppType (LocatedA (PatBuilder p)) (EpToken "@") (HsTyPat GhcPs)
| PatBuilderOpApp (LocatedA (PatBuilder p)) (LocatedN RdrName)
- (LocatedA (PatBuilder p)) (EpAnn [AddEpAnn])
+ (LocatedA (PatBuilder p)) [AddEpAnn]
| PatBuilderVar (LocatedN RdrName)
| PatBuilderOverLit (HsOverLit GhcPs)
=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -80,11 +80,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { T22919.hs:2:1-9 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -124,11 +124,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaSpan { Test20239.hs:5:36-55 })
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { Test20239.hs:5:36-49 })
@@ -176,11 +172,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaSpan { Test20239.hs:7:36-86 })
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { Test20239.hs:7:36-48 })
=====================================
testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
=====================================
@@ -92,11 +92,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { ZeroWidthSemi.hs:6:1-5 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -796,11 +796,7 @@
(EpaComments
[]))
(FamilyDecl
- (EpAnn
- (EpaSpan { T17544.hs:22:20-28 })
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:22:20-23 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnData (EpaSpan { T17544.hs:22:20-23 }))]
(DataFamily)
(NotTopLevel)
(L
@@ -988,11 +984,7 @@
(EpUniTok
(EpaSpan { T17544.hs:25:10-11 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544.hs:25:5-18 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
@@ -1133,11 +1125,7 @@
(EpaComments
[]))
(FamilyDecl
- (EpAnn
- (EpaSpan { T17544.hs:28:20-28 })
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:28:20-23 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnData (EpaSpan { T17544.hs:28:20-23 }))]
(DataFamily)
(NotTopLevel)
(L
@@ -1325,11 +1313,7 @@
(EpUniTok
(EpaSpan { T17544.hs:31:10-11 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544.hs:31:5-18 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
@@ -1470,11 +1454,7 @@
(EpaComments
[]))
(FamilyDecl
- (EpAnn
- (EpaSpan { T17544.hs:34:20-28 })
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:34:20-23 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnData (EpaSpan { T17544.hs:34:20-23 }))]
(DataFamily)
(NotTopLevel)
(L
@@ -1662,11 +1642,7 @@
(EpUniTok
(EpaSpan { T17544.hs:37:10-11 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544.hs:37:5-18 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
@@ -1807,11 +1783,7 @@
(EpaComments
[]))
(FamilyDecl
- (EpAnn
- (EpaSpan { T17544.hs:40:20-28 })
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:40:20-23 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnData (EpaSpan { T17544.hs:40:20-23 }))]
(DataFamily)
(NotTopLevel)
(L
@@ -1999,11 +1971,7 @@
(EpUniTok
(EpaSpan { T17544.hs:43:10-11 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544.hs:43:5-18 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
@@ -2144,11 +2112,7 @@
(EpaComments
[]))
(FamilyDecl
- (EpAnn
- (EpaSpan { T17544.hs:46:20-28 })
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:46:20-23 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnData (EpaSpan { T17544.hs:46:20-23 }))]
(DataFamily)
(NotTopLevel)
(L
@@ -2336,11 +2300,7 @@
(EpUniTok
(EpaSpan { T17544.hs:49:10-11 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544.hs:49:5-18 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
@@ -2481,11 +2441,7 @@
(EpaComments
[]))
(FamilyDecl
- (EpAnn
- (EpaSpan { T17544.hs:52:21-30 })
- [(AddEpAnn AnnData (EpaSpan { T17544.hs:52:21-24 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnData (EpaSpan { T17544.hs:52:21-24 }))]
(DataFamily)
(NotTopLevel)
(L
@@ -2673,11 +2629,7 @@
(EpUniTok
(EpaSpan { T17544.hs:55:11-12 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544.hs:55:5-20 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -89,11 +89,7 @@
(EpUniTok
(EpaSpan { T17544_kw.hs:16:15-16 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544_kw.hs:16:9-20 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
@@ -194,11 +190,7 @@
(EpUniTok
(EpaSpan { T17544_kw.hs:19:15-16 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T17544_kw.hs:19:9-26 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
=====================================
testsuite/tests/module/mod185.stderr
=====================================
@@ -101,11 +101,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { mod185.hs:5:1-24 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -109,11 +109,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:7:14-17 })
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:7:14-17 })
@@ -138,11 +134,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:7:21-30 })
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:7:21-24 })
@@ -290,14 +282,10 @@
(FamDecl
(NoExtField)
(FamilyDecl
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:(10,1)-(12,24) })
- [(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 }))]
- (EpaComments
- []))
+ [(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 }))]
(ClosedTypeFamily
(Just
[(L
@@ -728,11 +716,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:15:21-29 })
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { DumpParsedAst.hs:15:21-23 })
@@ -984,14 +968,10 @@
(FamDecl
(NoExtField)
(FamilyDecl
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:(18,1)-(19,30) })
- [(AddEpAnn AnnType (EpaSpan { DumpParsedAst.hs:18:1-4 }))
- ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:18:6-11 }))
- ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:18:42-43 }))
- ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:18:50-54 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnType (EpaSpan { DumpParsedAst.hs:18:1-4 }))
+ ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:18:6-11 }))
+ ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:18:42-43 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:18:50-54 }))]
(ClosedTypeFamily
(Just
[(L
@@ -1350,13 +1330,9 @@
(FamDecl
(NoExtField)
(FamilyDecl
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:21:1-33 })
- [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:21:1-4 }))
- ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:21:6-11 }))
- ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:21:17-18 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnData (EpaSpan { DumpParsedAst.hs:21:1-4 }))
+ ,(AddEpAnn AnnFamily (EpaSpan { DumpParsedAst.hs:21:6-11 }))
+ ,(AddEpAnn AnnDcolon (EpaSpan { DumpParsedAst.hs:21:17-18 }))]
(DataFamily)
(TopLevel)
(L
@@ -1699,11 +1675,7 @@
(EpUniTok
(EpaSpan { DumpParsedAst.hs:23:7-8 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:23:3-45 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
@@ -2005,11 +1977,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpParsedAst.hs:25:1-23 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -101,11 +101,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpParsedAstComments.hs:9:1-7 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -216,11 +212,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpParsedAstComments.hs:(14,1)-(16,3) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -363,11 +355,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpParsedAstComments.hs:19:1-23 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -49,11 +49,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -244,11 +240,7 @@
(FamDecl
(NoExtField)
(FamilyDecl
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(ClosedTypeFamily
(Just
[(L
@@ -666,11 +658,7 @@
(FamDecl
(NoExtField)
(FamilyDecl
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(DataFamily)
(TopLevel)
(L
@@ -1425,11 +1413,7 @@
(FamDecl
(NoExtField)
(FamilyDecl
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(ClosedTypeFamily
(Just
[(L
@@ -1960,11 +1944,7 @@
(EpaComments
[]))
(FamilyDecl
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(OpenTypeFamily)
(NotTopLevel)
(L
@@ -2119,11 +2099,7 @@
(EpaComments
[]))
(TyFamInstDecl
- (EpAnn
- (EpaSpan { DumpRenamedAst.hs:32:3-27 })
- [(AddEpAnn AnnType (EpaSpan { DumpRenamedAst.hs:32:3-6 }))]
- (EpaComments
- []))
+ [(AddEpAnn AnnType (EpaSpan { DumpRenamedAst.hs:32:3-6 }))]
(FamEqn
[]
(L
@@ -2404,11 +2380,7 @@
(IEThingAbs
((,)
(Nothing)
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- [])))
+ [])
(L
(EpAnn
(EpaSpan { DumpRenamedAst.hs:7:19-22 })
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -264,11 +264,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:(10,1)-(12,3) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -559,11 +555,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:(15,1)-(19,3) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -809,11 +801,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:22:1-30 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -1014,11 +1002,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:24:1-13 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -1111,11 +1095,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:25:1-13 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -1209,11 +1189,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:26:1-13 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -1677,11 +1653,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:32:1-7 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -1794,11 +1766,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:34:8-35 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -1906,11 +1874,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:34:19-21 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -2006,11 +1970,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:34:24-26 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -2123,11 +2083,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:(36,1)-(44,4) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -2233,11 +2189,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:39:6-13 })
- []
- (EpaComments
- []))
+ []
(CaseAlt)
[(L
(EpAnn
@@ -2247,11 +2199,7 @@
(EpaComments
[]))
(NPat
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { DumpSemis.hs:39:6 })
@@ -2308,11 +2256,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:40:6-13 })
- []
- (EpaComments
- []))
+ []
(CaseAlt)
[(L
(EpAnn
@@ -2322,11 +2266,7 @@
(EpaComments
[]))
(NPat
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { DumpSemis.hs:40:6 })
@@ -2385,11 +2325,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:41:6-13 })
- []
- (EpaComments
- []))
+ []
(CaseAlt)
[(L
(EpAnn
@@ -2399,11 +2335,7 @@
(EpaComments
[]))
(NPat
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { DumpSemis.hs:41:6 })
@@ -2464,11 +2396,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { DumpSemis.hs:42:6-13 })
- []
- (EpaComments
- []))
+ []
(CaseAlt)
[(L
(EpAnn
@@ -2478,11 +2406,7 @@
(EpaComments
[]))
(NPat
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { DumpSemis.hs:42:6 })
=====================================
testsuite/tests/parser/should_compile/DumpTypecheckedAst.stderr
=====================================
@@ -1951,11 +1951,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -80,13 +80,9 @@
(FamDecl
(NoExtField)
(FamilyDecl
- (EpAnn
- (EpaSpan { KindSigs.hs:(11,1)-(12,21) })
- [(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
- []))
+ [(AddEpAnn AnnType (EpaSpan { KindSigs.hs:11:1-4 }))
+ ,(AddEpAnn AnnFamily (EpaSpan { KindSigs.hs:11:6-11 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:11:19-23 }))]
(ClosedTypeFamily
(Just
[(L
@@ -938,11 +934,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { KindSigs.hs:23:1-12 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -1601,11 +1593,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { KindSigs.hs:35:1-11 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/T14189.stderr
=====================================
@@ -156,11 +156,7 @@
(EpaComments
[]))
(ConDeclField
- (EpAnn
- (EpaDelta (SameLine 0) [])
- []
- (EpaComments
- []))
+ []
[(L
(EpAnn
(EpaSpan { T14189.hs:6:33 })
@@ -259,12 +255,8 @@
(IEThingWith
((,)
(Nothing)
- (EpAnn
- (EpaSpan { T14189.hs:3:3-8 })
- [(AddEpAnn AnnOpenP (EpaSpan { T14189.hs:3:10 }))
- ,(AddEpAnn AnnCloseP (EpaSpan { T14189.hs:3:15 }))]
- (EpaComments
- [])))
+ [(AddEpAnn AnnOpenP (EpaSpan { T14189.hs:3:10 }))
+ ,(AddEpAnn AnnCloseP (EpaSpan { T14189.hs:3:15 }))])
(L
(EpAnn
(EpaSpan { T14189.hs:3:3-8 })
=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -96,11 +96,7 @@
(EpUniTok
(EpaSpan { T15323.hs:6:17-18 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T15323.hs:6:5-54 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -113,11 +113,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaSpan { T20452.hs:5:26-31 })
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { T20452.hs:5:26-31 })
@@ -217,11 +213,7 @@
(EpaComments
[]))
(ConDeclH98
- (EpAnn
- (EpaSpan { T20452.hs:6:26-31 })
- []
- (EpaComments
- []))
+ []
(L
(EpAnn
(EpaSpan { T20452.hs:6:26-31 })
=====================================
testsuite/tests/parser/should_compile/T20718.stderr
=====================================
@@ -114,11 +114,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { T20718.hs:8:1-5 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -101,11 +101,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { T20846.hs:4:1-18 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
testsuite/tests/printer/T18791.stderr
=====================================
@@ -77,11 +77,7 @@
(EpUniTok
(EpaSpan { T18791.hs:5:7-8 })
(NormalSyntax))
- (EpAnn
- (EpaSpan { T18791.hs:5:3-17 })
- []
- (EpaComments
- [])))
+ [])
(:|
(L
(EpAnn
=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -80,11 +80,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { Test20297.hs:(5,1)-(7,7) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -204,11 +200,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { Test20297.hs:(9,1)-(11,26) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -318,11 +310,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { Test20297.hs:11:9-26 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -499,11 +487,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { Test20297.ppr.hs:(3,1)-(5,7) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -611,11 +595,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { Test20297.ppr.hs:(6,1)-(9,24) })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
@@ -719,11 +699,7 @@
(EpaComments
[]))
(Match
- (EpAnn
- (EpaSpan { Test20297.ppr.hs:9:7-24 })
- []
- (EpaComments
- []))
+ []
(FunRhs
(L
(EpAnn
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -608,23 +608,8 @@ flushComments trailing_anns = do
-- |In order to interleave annotations into the stream, we turn them into
-- comments. They are removed from the annotation to avoid duplication.
annotationsToComments :: (Monad m, Monoid w)
- => EpAnn a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m (EpAnn a)
-annotationsToComments (EpAnn anc a cs) l kws = do
- let (newComments, newAnns) = go ([],[]) (view l a)
- addComments newComments
- return (EpAnn anc (set l (reverse newAnns) a) cs)
- where
- keywords = Set.fromList kws
-
- go :: ([Comment], [AddEpAnn]) -> [AddEpAnn] -> ([Comment], [AddEpAnn])
- go acc [] = acc
- go (cs',ans) ((AddEpAnn k ss) : ls)
- | Set.member k keywords = go ((mkKWComment k (epaToNoCommentsLocation ss)):cs', ans) ls
- | otherwise = go (cs', (AddEpAnn k ss):ans) ls
-
-annotationsToComments' :: (Monad m, Monoid w)
=> a -> Lens a [AddEpAnn] -> [AnnKeywordId] -> EP w m a
-annotationsToComments' a l kws = do
+annotationsToComments a l kws = do
let (newComments, newAnns) = go ([],[]) (view l a)
addComments newComments
return (set l (reverse newAnns) a)
@@ -723,10 +708,10 @@ printStringAtAA :: (Monad m, Monoid w) => EpaLocation -> String -> EP w m EpaLoc
printStringAtAA el str = printStringAtAAC CaptureComments el str
printStringAtAAL :: (Monad m, Monoid w)
- => EpAnn a -> Lens a EpaLocation -> String -> EP w m (EpAnn a)
-printStringAtAAL (EpAnn anc an cs) l str = do
+ => a -> Lens a EpaLocation -> String -> EP w m a
+printStringAtAAL an l str = do
r <- printStringAtAAC CaptureComments (view l an) str
- return (EpAnn anc (set l r an) cs)
+ return (set l r an)
printStringAtAAC :: (Monad m, Monoid w)
=> CaptureComments -> EpaLocation -> String -> EP w m EpaLocation
@@ -1328,14 +1313,8 @@ markLensKw' a l kw = do
return (set l loc a)
markAnnKwAllL :: (Monad m, Monoid w)
- => EpAnn a -> Lens a [EpaLocation] -> AnnKeywordId -> EP w m (EpAnn a)
-markAnnKwAllL (EpAnn anc a cs) l kw = do
- anns <- mapM (markKwA kw) (view l a)
- return (EpAnn anc (set l anns a) cs)
-
-markAnnKwAllL' :: (Monad m, Monoid w)
=> a -> Lens a [EpaLocation] -> AnnKeywordId -> EP w m a
-markAnnKwAllL' a l kw = do
+markAnnKwAllL a l kw = do
anns <- mapM (markKwA kw) (view l a)
return (set l anns a)
@@ -1456,6 +1435,13 @@ markAnnList ann action = do
r <- action
return (a,r)
+markAnnList' :: (Monad m, Monoid w)
+ => AnnList -> EP w m a -> EP w m (AnnList, a)
+markAnnList' ann action = do
+ markAnnListA' ann $ \a -> do
+ r <- action
+ return (a,r)
+
markAnnListA :: (Monad m, Monoid w)
=> EpAnn AnnList
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
@@ -2003,29 +1989,26 @@ instance ExactPrint (DerivDecl GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (ForeignDecl GhcPs) where
- getAnnotationEntry (ForeignImport an _ _ _) = fromAnn an
- getAnnotationEntry (ForeignExport an _ _ _) = fromAnn an
-
- setAnnotationAnchor (ForeignImport an a b c) anc ts cs = ForeignImport (setAnchorEpa an anc ts cs) a b c
- setAnnotationAnchor (ForeignExport an a b c) anc ts cs = ForeignExport (setAnchorEpa an anc ts cs) a b c
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (ForeignImport an n ty fimport) = do
- an0 <- markEpAnnL an lidl AnnForeign
- an1 <- markEpAnnL an0 lidl AnnImport
+ an0 <- markEpAnnL' an lidl AnnForeign
+ an1 <- markEpAnnL' an0 lidl AnnImport
fimport' <- markAnnotated fimport
n' <- markAnnotated n
- an2 <- markEpAnnL an1 lidl AnnDcolon
+ an2 <- markEpAnnL' an1 lidl AnnDcolon
ty' <- markAnnotated ty
return (ForeignImport an2 n' ty' fimport')
exact (ForeignExport an n ty fexport) = do
- an0 <- markEpAnnL an lidl AnnForeign
- an1 <- markEpAnnL an0 lidl AnnExport
+ an0 <- markEpAnnL' an lidl AnnForeign
+ an1 <- markEpAnnL' an0 lidl AnnExport
fexport' <- markAnnotated fexport
n' <- markAnnotated n
- an2 <- markEpAnnL an1 lidl AnnDcolon
+ an2 <- markEpAnnL' an1 lidl AnnDcolon
ty' <- markAnnotated ty
return (ForeignExport an2 n' ty' fexport')
@@ -2378,12 +2361,12 @@ instance ExactPrint (ClsInstDecl GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (TyFamInstDecl GhcPs) where
- getAnnotationEntry (TyFamInstDecl an _) = fromAnn an
- setAnnotationAnchor (TyFamInstDecl an a) anc ts cs = TyFamInstDecl (setAnchorEpa an anc ts cs) a
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact d@(TyFamInstDecl { tfid_xtn = an, tfid_eqn = eqn }) = do
- an0 <- markEpAnnL an lidl AnnType
- an1 <- markEpAnnL an0 lidl AnnInstance
+ an0 <- markEpAnnL' an lidl AnnType
+ an1 <- markEpAnnL' an0 lidl AnnInstance
eqn' <- markAnnotated eqn
return (d { tfid_xtn = an1, tfid_eqn = eqn' })
@@ -2453,14 +2436,14 @@ instance ExactPrint (HsBind GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (PatSynBind GhcPs GhcPs) where
- getAnnotationEntry (PSB { psb_ext = an}) = fromAnn an
- setAnnotationAnchor p anc ts cs = p { psb_ext = setAnchorEpa (psb_ext p) anc ts cs}
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (PSB{ psb_ext = an
, psb_id = psyn, psb_args = details
, psb_def = pat
, psb_dir = dir }) = do
- an0 <- markEpAnnL an lidl AnnPattern
+ an0 <- markEpAnnL' an lidl AnnPattern
(an1, psyn', details') <-
case details of
InfixCon v1 v2 -> do
@@ -2475,25 +2458,25 @@ instance ExactPrint (PatSynBind GhcPs GhcPs) where
return (an0, psyn', PrefixCon tvs' vs')
RecCon vs -> do
psyn' <- markAnnotated psyn
- an1 <- markEpAnnL an0 lidl AnnOpenC -- '{'
+ an1 <- markEpAnnL' an0 lidl AnnOpenC -- '{'
vs' <- markAnnotated vs
- an2 <- markEpAnnL an1 lidl AnnCloseC -- '}'
+ an2 <- markEpAnnL' an1 lidl AnnCloseC -- '}'
return (an2, psyn', RecCon vs')
(an2, pat', dir') <-
case dir of
Unidirectional -> do
- an2 <- markEpAnnL an1 lidl AnnLarrow
+ an2 <- markEpAnnL' an1 lidl AnnLarrow
pat' <- markAnnotated pat
return (an2, pat', dir)
ImplicitBidirectional -> do
- an2 <- markEpAnnL an1 lidl AnnEqual
+ an2 <- markEpAnnL' an1 lidl AnnEqual
pat' <- markAnnotated pat
return (an2, pat', dir)
ExplicitBidirectional mg -> do
- an2 <- markEpAnnL an1 lidl AnnLarrow
+ an2 <- markEpAnnL' an1 lidl AnnLarrow
pat' <- markAnnotated pat
- an3 <- markEpAnnL an2 lidl AnnWhere
+ an3 <- markEpAnnL' an2 lidl AnnWhere
mg' <- markAnnotated mg
return (an3, pat', ExplicitBidirectional mg')
@@ -2514,8 +2497,8 @@ instance ExactPrint (RecordPatSynField GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where
- getAnnotationEntry (Match ann _ _ _) = fromAnn ann
- setAnnotationAnchor (Match an a b c) anc ts cs = Match (setAnchorEpa an anc ts cs) a b c
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (Match an mctxt pats grhss) =
exactMatch (Match an mctxt pats grhss)
@@ -2523,8 +2506,8 @@ instance ExactPrint (Match GhcPs (LocatedA (HsCmd GhcPs))) where
-- -------------------------------------
instance ExactPrint (Match GhcPs (LocatedA (HsExpr GhcPs))) where
- getAnnotationEntry (Match ann _ _ _) = fromAnn ann
- setAnnotationAnchor (Match an a b c) anc ts cs = Match (setAnchorEpa an anc ts cs) a b c
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (Match an mctxt pats grhss) =
exactMatch (Match an mctxt pats grhss)
@@ -2543,7 +2526,7 @@ exactMatch (Match an mctxt pats grhss) = do
debugM $ "exact Match FunRhs:" ++ showPprUnsafe fun
an0' <-
case strictness of
- SrcStrict -> markEpAnnL an lidl AnnBang
+ SrcStrict -> markEpAnnL' an lidl AnnBang
_ -> pure an
case fixity of
Prefix -> do
@@ -2560,18 +2543,18 @@ exactMatch (Match an mctxt pats grhss) = do
p2' <- markAnnotated p2
return (an0', FunRhs fun' fixity strictness, [p1',p2'])
| otherwise -> do
- an0 <- markEpAnnL an0' lidl AnnOpenP
+ an0 <- markEpAnnL' an0' lidl AnnOpenP
p1' <- markAnnotated p1
fun' <- markAnnotated fun
p2' <- markAnnotated p2
- an1 <- markEpAnnL an0 lidl AnnCloseP
+ an1 <- markEpAnnL' an0 lidl AnnCloseP
rest' <- mapM markAnnotated rest
return (an1, FunRhs fun' fixity strictness, p1':p2':rest')
_ -> panic "FunRhs"
-- ToDo: why is LamSingle treated differently?
LamAlt LamSingle -> do
- an0' <- markEpAnnL an lidl AnnLam
+ an0' <- markEpAnnL' an lidl AnnLam
pats' <- markAnnotated pats
return (an0', LamAlt LamSingle, pats')
LamAlt v -> do
@@ -2676,12 +2659,12 @@ instance ExactPrint (HsIPBinds GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (IPBind GhcPs) where
- getAnnotationEntry (IPBind an _ _) = fromAnn an
- setAnnotationAnchor (IPBind an a b) anc ts cs = IPBind (setAnchorEpa an anc ts cs) a b
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (IPBind an lr rhs) = do
lr' <- markAnnotated lr
- an0 <- markEpAnnL an lidl AnnEqual
+ an0 <- markEpAnnL' an lidl AnnEqual
rhs' <- markAnnotated rhs
return (IPBind an0 lr' rhs')
@@ -2835,14 +2818,14 @@ instance ExactPrint (StandaloneKindSig GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (DefaultDecl GhcPs) where
- getAnnotationEntry (DefaultDecl an _) = fromAnn an
- setAnnotationAnchor (DefaultDecl an a) anc ts cs = DefaultDecl (setAnchorEpa an anc ts cs) a
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (DefaultDecl an tys) = do
- an0 <- markEpAnnL an lidl AnnDefault
- an1 <- markEpAnnL an0 lidl AnnOpenP
+ an0 <- markEpAnnL' an lidl AnnDefault
+ an1 <- markEpAnnL' an0 lidl AnnOpenP
tys' <- markAnnotated tys
- an2 <- markEpAnnL an1 lidl AnnCloseP
+ an2 <- markEpAnnL' an1 lidl AnnCloseP
return (DefaultDecl an2 tys')
-- ---------------------------------------------------------------------
@@ -3034,9 +3017,9 @@ instance ExactPrint (HsExpr GhcPs) where
exact (ExplicitSum an alt arity expr) = do
an0 <- markLensKw' an laesOpen AnnOpenPH
- an1 <- markAnnKwAllL' an0 laesBarsBefore AnnVbar
+ an1 <- markAnnKwAllL an0 laesBarsBefore AnnVbar
expr' <- markAnnotated expr
- an2 <- markAnnKwAllL' an1 laesBarsAfter AnnVbar
+ an2 <- markAnnKwAllL an1 laesBarsAfter AnnVbar
an3 <- markLensKw' an2 laesClose AnnClosePH
return (ExplicitSum an3 alt arity expr')
@@ -3330,14 +3313,15 @@ instance (ExactPrint body) => ExactPrint (HsRecFields GhcPs body) where
instance (ExactPrint body)
=> ExactPrint (HsFieldBind (LocatedA (FieldOcc GhcPs)) body) where
- getAnnotationEntry x = fromAnn (hfbAnn x)
- setAnnotationAnchor (HsFieldBind an f arg isPun) anc ts cs = (HsFieldBind (setAnchorEpa an anc ts cs) f arg isPun)
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
+
exact (HsFieldBind an f arg isPun) = do
debugM $ "HsFieldBind"
f' <- markAnnotated f
(an0, arg') <- if isPun then return (an, arg)
else do
- an0 <- markEpAnnL an lidl AnnEqual
+ an0 <- markEpAnnL' an lidl AnnEqual
arg' <- markAnnotated arg
return (an0, arg')
return (HsFieldBind an0 f' arg' isPun)
@@ -3346,15 +3330,15 @@ instance (ExactPrint body)
instance (ExactPrint body)
=> ExactPrint (HsFieldBind (LocatedAn NoEpAnns (FieldLabelStrings GhcPs)) body) where
- getAnnotationEntry x = fromAnn (hfbAnn x)
- setAnnotationAnchor (HsFieldBind an f arg isPun) anc ts cs = (HsFieldBind (setAnchorEpa an anc ts cs) f arg isPun)
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (HsFieldBind an f arg isPun) = do
debugM $ "HsFieldBind FieldLabelStrings"
f' <- markAnnotated f
(an0, arg') <- if isPun then return (an, arg)
else do
- an0 <- markEpAnnL an lidl AnnEqual
+ an0 <- markEpAnnL' an lidl AnnEqual
arg' <- markAnnotated arg
return (an0, arg')
return (HsFieldBind an0 f' arg' isPun)
@@ -3363,13 +3347,14 @@ instance (ExactPrint body)
instance (ExactPrint (LocatedA body))
=> ExactPrint (HsFieldBind (LocatedA (AmbiguousFieldOcc GhcPs)) (LocatedA body)) where
- getAnnotationEntry x = fromAnn (hfbAnn x)
- setAnnotationAnchor (HsFieldBind an f arg isPun) anc ts cs = (HsFieldBind (setAnchorEpa an anc ts cs) f arg isPun)
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
+
exact (HsFieldBind an f arg isPun) = do
debugM $ "HsRecUpdField"
f' <- markAnnotated f
an0 <- if isPun then return an
- else markEpAnnL an lidl AnnEqual
+ else markEpAnnL' an lidl AnnEqual
arg' <- if isPun
then return arg
else markAnnotated arg
@@ -3399,12 +3384,11 @@ instance ExactPrint (FieldLabelStrings GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (DotFieldOcc GhcPs) where
- getAnnotationEntry (DotFieldOcc an _) = fromAnn an
-
- setAnnotationAnchor (DotFieldOcc an a) anc ts cs = DotFieldOcc (setAnchorEpa an anc ts cs) a
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (DotFieldOcc an (L loc (FieldLabelString fs))) = do
- an0 <- markLensKwM an lafDot AnnDot
+ an0 <- markLensKwM' an lafDot AnnDot
-- The field name has a SrcSpanAnnN, print it as a
-- LocatedN RdrName
L loc' _ <- markAnnotated (L loc (mkVarUnqual fs))
@@ -3435,40 +3419,21 @@ instance ExactPrint (HsCmdTop GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (HsCmd GhcPs) where
- getAnnotationEntry (HsCmdArrApp an _ _ _ _) = fromAnn an
- getAnnotationEntry (HsCmdArrForm _ _ _ _ _ ) = NoEntryVal
- getAnnotationEntry (HsCmdApp an _ _ ) = fromAnn an
- getAnnotationEntry (HsCmdPar _ _) = NoEntryVal
- getAnnotationEntry (HsCmdCase an _ _) = fromAnn an
- getAnnotationEntry (HsCmdLam an _ _) = fromAnn an
- getAnnotationEntry (HsCmdIf an _ _ _ _) = fromAnn an
- getAnnotationEntry (HsCmdLet _ _ _) = NoEntryVal
- getAnnotationEntry (HsCmdDo an _) = fromAnn an
-
- setAnnotationAnchor (HsCmdArrApp an a b c d) anc ts cs = (HsCmdArrApp (setAnchorEpa an anc ts cs) a b c d)
- setAnnotationAnchor a@(HsCmdArrForm{}) _ _ _s = a
- setAnnotationAnchor (HsCmdApp an a b ) anc ts cs = (HsCmdApp (setAnchorEpa an anc ts cs) a b )
- setAnnotationAnchor (HsCmdLam an a b) anc ts cs = (HsCmdLam (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor a@(HsCmdPar _ _) _ _ _s = a
- setAnnotationAnchor (HsCmdCase an a b) anc ts cs = (HsCmdCase (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (HsCmdIf an a b c d) anc ts cs = (HsCmdIf (setAnchorEpa an anc ts cs) a b c d)
- setAnnotationAnchor a@(HsCmdLet _ _ _) _ _ _s = a
- setAnnotationAnchor (HsCmdDo an a) anc ts cs = (HsCmdDo (setAnchorEpa an anc ts cs) a)
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (HsCmdArrApp an arr arg o isRightToLeft) = do
if isRightToLeft
then do
arr' <- markAnnotated arr
- an0 <- markKw (anns an)
+ an0 <- markKw an
arg' <- markAnnotated arg
- let an1 = an{anns = an0}
- return (HsCmdArrApp an1 arr' arg' o isRightToLeft)
+ return (HsCmdArrApp an0 arr' arg' o isRightToLeft)
else do
arg' <- markAnnotated arg
- an0 <- markKw (anns an)
+ an0 <- markKw an
arr' <- markAnnotated arr
- let an1 = an {anns = an0}
- return (HsCmdArrApp an1 arr' arg' o isRightToLeft)
+ return (HsCmdArrApp an0 arr' arg' o isRightToLeft)
exact (HsCmdArrForm an e fixity mf cs) = do
an0 <- markLensMAA' an lal_open
@@ -3492,11 +3457,11 @@ instance ExactPrint (HsCmd GhcPs) where
return (HsCmdApp an e1' e2')
exact (HsCmdLam an lam_variant matches) = do
- an0 <- markEpAnnL an lidl AnnLam
+ an0 <- markEpAnnL' an lidl AnnLam
an1 <- case lam_variant of
LamSingle -> return an0
- LamCase -> markEpAnnL an0 lidl AnnCase
- LamCases -> markEpAnnL an0 lidl AnnCases
+ LamCase -> markEpAnnL' an0 lidl AnnCase
+ LamCases -> markEpAnnL' an0 lidl AnnCases
matches' <- markAnnotated matches
return (HsCmdLam an1 lam_variant matches')
@@ -3507,23 +3472,23 @@ instance ExactPrint (HsCmd GhcPs) where
return (HsCmdPar (lpar', rpar') e')
exact (HsCmdCase an e alts) = do
- an0 <- markLensKw an lhsCaseAnnCase AnnCase
+ an0 <- markLensKw' an lhsCaseAnnCase AnnCase
e' <- markAnnotated e
- an1 <- markLensKw an0 lhsCaseAnnOf AnnOf
- an2 <- markEpAnnL an1 lhsCaseAnnsRest AnnOpenC
- an3 <- markEpAnnAllL an2 lhsCaseAnnsRest AnnSemi
+ an1 <- markLensKw' an0 lhsCaseAnnOf AnnOf
+ an2 <- markEpAnnL' an1 lhsCaseAnnsRest AnnOpenC
+ an3 <- markEpAnnAllL' an2 lhsCaseAnnsRest AnnSemi
alts' <- markAnnotated alts
- an4 <- markEpAnnL an3 lhsCaseAnnsRest AnnCloseC
+ an4 <- markEpAnnL' an3 lhsCaseAnnsRest AnnCloseC
return (HsCmdCase an4 e' alts')
exact (HsCmdIf an a e1 e2 e3) = do
- an0 <- markLensKw an laiIf AnnIf
+ an0 <- markLensKw' an laiIf AnnIf
e1' <- markAnnotated e1
- an1 <- markLensKwM an0 laiThenSemi AnnSemi
- an2 <- markLensKw an1 laiThen AnnThen
+ an1 <- markLensKwM' an0 laiThenSemi AnnSemi
+ an2 <- markLensKw' an1 laiThen AnnThen
e2' <- markAnnotated e2
- an3 <- markLensKwM an2 laiElseSemi AnnSemi
- an4 <- markLensKw an3 laiElse AnnElse
+ an3 <- markLensKwM' an2 laiElseSemi AnnSemi
+ an4 <- markLensKw' an3 laiElse AnnElse
e3' <- markAnnotated e3
return (HsCmdIf an4 a e1' e2' e3')
@@ -3537,7 +3502,7 @@ instance ExactPrint (HsCmd GhcPs) where
exact (HsCmdDo an es) = do
debugM $ "HsCmdDo"
- an0 <- markEpAnnL an lal_rest AnnDo
+ an0 <- markEpAnnL' an lal_rest AnnDo
es' <- markAnnotated es
return (HsCmdDo an0 es')
@@ -3549,27 +3514,8 @@ instance (
Anno [GenLocated SrcSpanAnnA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))] ~ SrcSpanAnnL,
(ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (body GhcPs)))])))
=> ExactPrint (StmtLR GhcPs GhcPs (LocatedA (body GhcPs))) where
- getAnnotationEntry (LastStmt _ _ _ _) = NoEntryVal
- getAnnotationEntry (BindStmt an _ _) = fromAnn an
- getAnnotationEntry (ApplicativeStmt _ _ _) = NoEntryVal
- getAnnotationEntry (BodyStmt _ _ _ _) = NoEntryVal
- getAnnotationEntry (LetStmt an _) = fromAnn an
- getAnnotationEntry (ParStmt _ _ _ _) = NoEntryVal
- getAnnotationEntry (TransStmt an _ _ _ _ _ _ _ _) = fromAnn an
- getAnnotationEntry (RecStmt an _ _ _ _ _ _) = fromAnn an
-
- -----------------------------------------------------------------
-
- setAnnotationAnchor a@(LastStmt _ _ _ _) _ _ _s = a
- setAnnotationAnchor (BindStmt an a b) anc ts cs = (BindStmt (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor a@(ApplicativeStmt _ _ _) _ _ _s = a
- setAnnotationAnchor a@(BodyStmt _ _ _ _) _ _ _s = a
- setAnnotationAnchor (LetStmt an a) anc ts cs = (LetStmt (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor a@(ParStmt _ _ _ _) _ _ _s = a
- setAnnotationAnchor (TransStmt an a b c d e f g h) anc ts cs = (TransStmt (setAnchorEpa an anc ts cs) a b c d e f g h)
- setAnnotationAnchor (RecStmt an a b c d e f) anc ts cs = (RecStmt (setAnchorEpa an anc ts cs) a b c d e f)
-
- -----------------------------------------------------------------
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _s = a
exact (LastStmt a body b c) = do
debugM $ "LastStmt"
@@ -3579,7 +3525,7 @@ instance (
exact (BindStmt an pat body) = do
debugM $ "BindStmt"
pat' <- markAnnotated pat
- an0 <- markEpAnnL an lidl AnnLarrow
+ an0 <- markEpAnnL' an lidl AnnLarrow
body' <- markAnnotated body
return (BindStmt an0 pat' body')
@@ -3593,7 +3539,7 @@ instance (
exact (LetStmt an binds) = do
debugM $ "LetStmt"
- an0 <- markEpAnnL an lidl AnnLet
+ an0 <- markEpAnnL' an lidl AnnLet
binds' <- markAnnotated binds
return (LetStmt an0 binds')
@@ -3610,8 +3556,8 @@ instance (
exact (RecStmt an stmts a b c d e) = do
debugM $ "RecStmt"
- an0 <- markEpAnnL an lal_rest AnnRec
- (an1, stmts') <- markAnnList an0 (markAnnotated stmts)
+ an0 <- markEpAnnL' an lal_rest AnnRec
+ (an1, stmts') <- markAnnList' an0 (markAnnotated stmts)
return (RecStmt an1 stmts' a b c d e)
-- ---------------------------------------------------------------------
@@ -3624,29 +3570,29 @@ instance ExactPrint (ParStmtBlock GhcPs GhcPs) where
return (ParStmtBlock a stmts' b c)
exactTransStmt :: (Monad m, Monoid w)
- => EpAnn [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm
- -> EP w m (EpAnn [AddEpAnn], Maybe (LHsExpr GhcPs), (LHsExpr GhcPs))
+ => [AddEpAnn] -> Maybe (LHsExpr GhcPs) -> (LHsExpr GhcPs) -> TransForm
+ -> EP w m ([AddEpAnn], Maybe (LHsExpr GhcPs), (LHsExpr GhcPs))
exactTransStmt an by using ThenForm = do
debugM $ "exactTransStmt:ThenForm"
- an0 <- markEpAnnL an lidl AnnThen
+ an0 <- markEpAnnL' an lidl AnnThen
using' <- markAnnotated using
case by of
Nothing -> return (an0, by, using')
Just b -> do
- an1 <- markEpAnnL an0 lidl AnnBy
+ an1 <- markEpAnnL' an0 lidl AnnBy
b' <- markAnnotated b
return (an1, Just b', using')
exactTransStmt an by using GroupForm = do
debugM $ "exactTransStmt:GroupForm"
- an0 <- markEpAnnL an lidl AnnThen
- an1 <- markEpAnnL an0 lidl AnnGroup
+ an0 <- markEpAnnL' an lidl AnnThen
+ an1 <- markEpAnnL' an0 lidl AnnGroup
(an2, by') <- case by of
Nothing -> return (an1, by)
Just b -> do
- an2 <- markEpAnnL an1 lidl AnnBy
+ an2 <- markEpAnnL' an1 lidl AnnBy
b' <- markAnnotated b
return (an2, Just b')
- an3 <- markEpAnnL an2 lidl AnnUsing
+ an3 <- markEpAnnL' an2 lidl AnnUsing
using' <- markAnnotated using
return (an3, by', using')
@@ -3666,7 +3612,7 @@ instance ExactPrint (TyClDecl GhcPs) where
-- There may be arbitrary parens around parts of the constructor
-- that are infix. Turn these into comments so that they feed
-- into the right place automatically
- an0 <- annotationsToComments' an lidl [AnnOpenP,AnnCloseP]
+ an0 <- annotationsToComments an lidl [AnnOpenP,AnnCloseP]
an1 <- markEpAnnL' an0 lidl AnnType
(_anx, ltycon', tyvars',_,_) <- exactVanillaDeclHead ltycon tyvars fixity Nothing
@@ -3734,7 +3680,7 @@ instance ExactPrint (TyClDecl GhcPs) where
tcdDocs = _docs})
where
top_matter = do
- an' <- annotationsToComments' an lidl [AnnOpenP, AnnCloseP]
+ an' <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]
an0 <- markEpAnnL' an' lidl AnnClass
(_, lclas', tyvars',_,context') <- exactVanillaDeclHead lclas tyvars fixity context
(an1, fds') <- if (null fds)
@@ -3750,20 +3696,20 @@ instance ExactPrint (TyClDecl GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (FunDep GhcPs) where
- getAnnotationEntry (FunDep an _ _) = fromAnn an
- setAnnotationAnchor (FunDep an a b) anc ts cs = FunDep (setAnchorEpa an anc ts cs) a b
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (FunDep an ls rs') = do
ls' <- markAnnotated ls
- an0 <- markEpAnnL an lidl AnnRarrow
+ an0 <- markEpAnnL' an lidl AnnRarrow
rs'' <- markAnnotated rs'
return (FunDep an0 ls' rs'')
-- ---------------------------------------------------------------------
instance ExactPrint (FamilyDecl GhcPs) where
- getAnnotationEntry (FamilyDecl { fdExt = an }) = fromAnn an
- setAnnotationAnchor x anc ts cs = x { fdExt = setAnchorEpa (fdExt x) anc ts cs}
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (FamilyDecl { fdExt = an
, fdInfo = info
@@ -3782,23 +3728,23 @@ instance ExactPrint (FamilyDecl GhcPs) where
case mb_inj of
Nothing -> return (an3, mb_inj)
Just inj -> do
- an4 <- markEpAnnL an3 lidl AnnVbar
+ an4 <- markEpAnnL' an3 lidl AnnVbar
inj' <- markAnnotated inj
return (an4, Just inj')
(an5, info') <-
case info of
ClosedTypeFamily mb_eqns -> do
- an5 <- markEpAnnL an4 lidl AnnWhere
- an6 <- markEpAnnL an5 lidl AnnOpenC
+ an5 <- markEpAnnL' an4 lidl AnnWhere
+ an6 <- markEpAnnL' an5 lidl AnnOpenC
(an7, mb_eqns') <-
case mb_eqns of
Nothing -> do
- an7 <- markEpAnnL an6 lidl AnnDotdot
+ an7 <- markEpAnnL' an6 lidl AnnDotdot
return (an7, mb_eqns)
Just eqns -> do
eqns' <- markAnnotated eqns
return (an6, Just eqns')
- an8 <- markEpAnnL an7 lidl AnnCloseC
+ an8 <- markEpAnnL' an7 lidl AnnCloseC
return (an8, ClosedTypeFamily mb_eqns')
_ -> return (an4, info)
return (FamilyDecl { fdExt = an5
@@ -3812,30 +3758,30 @@ instance ExactPrint (FamilyDecl GhcPs) where
where
exact_top_level an' =
case top_level of
- TopLevel -> markEpAnnL an' lidl AnnFamily
+ TopLevel -> markEpAnnL' an' lidl AnnFamily
NotTopLevel -> do
-- It seems that in some kind of legacy
-- mode the 'family' keyword is still
-- accepted.
- markEpAnnL an' lidl AnnFamily
+ markEpAnnL' an' lidl AnnFamily
exact_kind an' =
case result of
NoSig _ -> return (an', result)
KindSig x kind -> do
- an0 <- markEpAnnL an' lidl AnnDcolon
+ an0 <- markEpAnnL' an' lidl AnnDcolon
kind' <- markAnnotated kind
return (an0, KindSig x kind')
TyVarSig x tv_bndr -> do
- an0 <- markEpAnnL an' lidl AnnEqual
+ an0 <- markEpAnnL' an' lidl AnnEqual
tv_bndr' <- markAnnotated tv_bndr
return (an0, TyVarSig x tv_bndr')
-exactFlavour :: (Monad m, Monoid w) => EpAnn [AddEpAnn] -> FamilyInfo GhcPs -> EP w m (EpAnn [AddEpAnn])
-exactFlavour an DataFamily = markEpAnnL an lidl AnnData
-exactFlavour an OpenTypeFamily = markEpAnnL an lidl AnnType
-exactFlavour an (ClosedTypeFamily {}) = markEpAnnL an lidl AnnType
+exactFlavour :: (Monad m, Monoid w) => [AddEpAnn] -> FamilyInfo GhcPs -> EP w m [AddEpAnn]
+exactFlavour an DataFamily = markEpAnnL' an lidl AnnData
+exactFlavour an OpenTypeFamily = markEpAnnL' an lidl AnnType
+exactFlavour an (ClosedTypeFamily {}) = markEpAnnL' an lidl AnnType
-- ---------------------------------------------------------------------
@@ -3857,7 +3803,7 @@ exactDataDefn an exactHdr
, dd_kindSig = mb_sig
, dd_cons = condecls, dd_derivs = derivings }) = do
- an' <- annotationsToComments' an lidl [AnnOpenP, AnnCloseP]
+ an' <- annotationsToComments an lidl [AnnOpenP, AnnCloseP]
an0 <- case condecls of
DataTypeCons is_type_data _ -> do
@@ -3933,12 +3879,12 @@ exactVanillaDeclHead thing tvs@(HsQTvs { hsq_explicit = tyvars }) fixity context
-- ---------------------------------------------------------------------
instance ExactPrint (InjectivityAnn GhcPs) where
- getAnnotationEntry (InjectivityAnn an _ _) = fromAnn an
- setAnnotationAnchor (InjectivityAnn an a b) anc ts cs = InjectivityAnn (setAnchorEpa an anc ts cs) a b
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (InjectivityAnn an lhs rhs) = do
- an0 <- markEpAnnL an lidl AnnVbar
+ an0 <- markEpAnnL' an lidl AnnVbar
lhs' <- markAnnotated lhs
- an1 <- markEpAnnL an0 lidl AnnRarrow
+ an1 <- markEpAnnL' an0 lidl AnnRarrow
rhs' <- mapM markAnnotated rhs
return (InjectivityAnn an1 lhs' rhs')
@@ -4148,14 +4094,13 @@ instance ExactPrint (HsForAllTelescope GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (HsDerivingClause GhcPs) where
- getAnnotationEntry d@(HsDerivingClause{}) = fromAnn (deriv_clause_ext d)
- setAnnotationAnchor x anc ts cs = (x { deriv_clause_ext = setAnchorEpa (deriv_clause_ext x) anc ts cs})
- `debug` ("setAnnotationAnchor HsDerivingClause: (anc,cs):" ++ showAst (anc,cs))
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (HsDerivingClause { deriv_clause_ext = an
, deriv_clause_strategy = dcs
, deriv_clause_tys = dct }) = do
- an0 <- markEpAnnL an lidl AnnDeriving
+ an0 <- markEpAnnL' an lidl AnnDeriving
exact_strat_before
dct' <- markAnnotated dct
exact_strat_after
@@ -4171,27 +4116,20 @@ instance ExactPrint (HsDerivingClause GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (DerivStrategy GhcPs) where
- getAnnotationEntry (StockStrategy an) = fromAnn an
- getAnnotationEntry (AnyclassStrategy an) = fromAnn an
- getAnnotationEntry (NewtypeStrategy an) = fromAnn an
- getAnnotationEntry (ViaStrategy (XViaStrategyPs an _)) = fromAnn an
-
- setAnnotationAnchor (StockStrategy an) anc ts cs = (StockStrategy (setAnchorEpa an anc ts cs))
- setAnnotationAnchor (AnyclassStrategy an) anc ts cs = (AnyclassStrategy (setAnchorEpa an anc ts cs))
- setAnnotationAnchor (NewtypeStrategy an) anc ts cs = (NewtypeStrategy (setAnchorEpa an anc ts cs))
- setAnnotationAnchor (ViaStrategy (XViaStrategyPs an a)) anc ts cs = (ViaStrategy (XViaStrategyPs (setAnchorEpa an anc ts cs) a))
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (StockStrategy an) = do
- an0 <- markEpAnnL an lid AnnStock
+ an0 <- markEpAnnL' an lid AnnStock
return (StockStrategy an0)
exact (AnyclassStrategy an) = do
- an0 <- markEpAnnL an lid AnnAnyclass
+ an0 <- markEpAnnL' an lid AnnAnyclass
return (AnyclassStrategy an0)
exact (NewtypeStrategy an) = do
- an0 <- markEpAnnL an lid AnnNewtype
+ an0 <- markEpAnnL' an lid AnnNewtype
return (NewtypeStrategy an0)
exact (ViaStrategy (XViaStrategyPs an ty)) = do
- an0 <- markEpAnnL an lid AnnVia
+ an0 <- markEpAnnL' an lid AnnVia
ty' <- markAnnotated ty
return (ViaStrategy (XViaStrategyPs an0 ty'))
@@ -4354,11 +4292,8 @@ exact_condecls an cs
-- ---------------------------------------------------------------------
instance ExactPrint (ConDecl GhcPs) where
- getAnnotationEntry x@(ConDeclGADT{}) = fromAnn (snd (con_g_ext x))
- getAnnotationEntry x@(ConDeclH98{}) = fromAnn (con_ext x)
-
- setAnnotationAnchor x at ConDeclGADT{} anc ts cs = x { con_g_ext = fmap (\an -> setAnchorEpa an anc ts cs) (con_g_ext x) }
- setAnnotationAnchor x at ConDeclH98{} anc ts cs = x { con_ext = setAnchorEpa (con_ext x) anc ts cs}
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
-- based on pprConDecl
exact (ConDeclH98 { con_ext = an
@@ -4369,15 +4304,15 @@ instance ExactPrint (ConDecl GhcPs) where
, con_args = args
, con_doc = doc }) = do
an0 <- if has_forall
- then markEpAnnL an lidl AnnForall
+ then markEpAnnL' an lidl AnnForall
else return an
ex_tvs' <- mapM markAnnotated ex_tvs
an1 <- if has_forall
- then markEpAnnL an0 lidl AnnDot
+ then markEpAnnL' an0 lidl AnnDot
else return an0
mcxt' <- mapM markAnnotated mcxt
an2 <- if (isJust mcxt)
- then markEpAnnL an1 lidl AnnDarrow
+ then markEpAnnL' an1 lidl AnnDarrow
else return an1
(con', args') <- exact_details args
@@ -4425,7 +4360,7 @@ instance ExactPrint (ConDecl GhcPs) where
mcxt' <- mapM markAnnotated mcxt
an2 <- if (isJust mcxt)
- then markEpAnnL an1 lidl AnnDarrow
+ then markEpAnnL' an1 lidl AnnDarrow
else return an1
args' <-
case args of
@@ -4469,15 +4404,13 @@ instance ExactPrintTVFlag flag => ExactPrint (HsOuterTyVarBndrs flag GhcPs) wher
-- ---------------------------------------------------------------------
instance ExactPrint (ConDeclField GhcPs) where
- getAnnotationEntry f@(ConDeclField{}) = fromAnn (cd_fld_ext f)
-
- setAnnotationAnchor x anc ts cs = x { cd_fld_ext = setAnchorEpa (cd_fld_ext x) anc ts cs}
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (ConDeclField an names ftype mdoc) = do
names' <- markAnnotated names
- an0 <- markEpAnnL an lidl AnnDcolon
+ an0 <- markEpAnnL' an lidl AnnDcolon
ftype' <- markAnnotated ftype
- -- mdoc' <- mapM markAnnotated mdoc
return (ConDeclField an0 names' ftype' mdoc)
-- ---------------------------------------------------------------------
@@ -4617,23 +4550,8 @@ instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
-- =====================================================================
instance ExactPrint (IE GhcPs) where
- getAnnotationEntry (IEVar _ _) = NoEntryVal
- getAnnotationEntry (IEThingAbs (_, an) _) = fromAnn an
- getAnnotationEntry (IEThingAll (_, an) _) = fromAnn an
- getAnnotationEntry (IEThingWith (_, an) _ _ _) = fromAnn an
- getAnnotationEntry (IEModuleContents (_, an) _)= fromAnn an
- getAnnotationEntry (IEGroup _ _ _) = NoEntryVal
- getAnnotationEntry (IEDoc _ _) = NoEntryVal
- getAnnotationEntry (IEDocNamed _ _) = NoEntryVal
-
- setAnnotationAnchor a@(IEVar _ _) _ _ _s = a
- setAnnotationAnchor (IEThingAbs (depr, an) a) anc ts cs = (IEThingAbs (depr, setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (IEThingAll (depr, an) a) anc ts cs = (IEThingAll (depr, setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (IEThingWith (depr, an) a b c) anc ts cs = (IEThingWith (depr, setAnchorEpa an anc ts cs) a b c)
- setAnnotationAnchor (IEModuleContents (depr, an) a) anc ts cs = (IEModuleContents (depr, setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor a@(IEGroup _ _ _) _ _ _s = a
- setAnnotationAnchor a@(IEDoc _ _) _ _ _s = a
- setAnnotationAnchor a@(IEDocNamed _ _) _ _ _s = a
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (IEVar depr ln) = do
depr' <- markAnnotated depr
@@ -4646,15 +4564,15 @@ instance ExactPrint (IE GhcPs) where
exact (IEThingAll (depr, an) thing) = do
depr' <- markAnnotated depr
thing' <- markAnnotated thing
- an0 <- markEpAnnL an lidl AnnOpenP
- an1 <- markEpAnnL an0 lidl AnnDotdot
- an2 <- markEpAnnL an1 lidl AnnCloseP
+ an0 <- markEpAnnL' an lidl AnnOpenP
+ an1 <- markEpAnnL' an0 lidl AnnDotdot
+ an2 <- markEpAnnL' an1 lidl AnnCloseP
return (IEThingAll (depr', an2) thing')
exact (IEThingWith (depr, an) thing wc withs) = do
depr' <- markAnnotated depr
thing' <- markAnnotated thing
- an0 <- markEpAnnL an lidl AnnOpenP
+ an0 <- markEpAnnL' an lidl AnnOpenP
(an1, wc', withs') <-
case wc of
NoIEWildcard -> do
@@ -4663,16 +4581,16 @@ instance ExactPrint (IE GhcPs) where
IEWildcard pos -> do
let (bs, as) = splitAt pos withs
bs' <- markAnnotated bs
- an1 <- markEpAnnL an0 lidl AnnDotdot
- an2 <- markEpAnnL an1 lidl AnnComma
+ an1 <- markEpAnnL' an0 lidl AnnDotdot
+ an2 <- markEpAnnL' an1 lidl AnnComma
as' <- markAnnotated as
return (an2, wc, bs'++as')
- an2 <- markEpAnnL an1 lidl AnnCloseP
+ an2 <- markEpAnnL' an1 lidl AnnCloseP
return (IEThingWith (depr', an2) thing' wc' withs')
exact (IEModuleContents (depr, an) m) = do
depr' <- markAnnotated depr
- an0 <- markEpAnnL an lidl AnnModule
+ an0 <- markEpAnnL' an lidl AnnModule
m' <- markAnnotated m
return (IEModuleContents (depr', an0) m')
@@ -4706,41 +4624,8 @@ instance ExactPrint (IEWrappedName GhcPs) where
-- ---------------------------------------------------------------------
instance ExactPrint (Pat GhcPs) where
- getAnnotationEntry (WildPat _) = NoEntryVal
- getAnnotationEntry (VarPat _ _) = NoEntryVal
- getAnnotationEntry (LazyPat an _) = fromAnn an
- getAnnotationEntry (AsPat _ _ _) = NoEntryVal
- getAnnotationEntry (ParPat _ _) = NoEntryVal
- getAnnotationEntry (BangPat an _) = fromAnn an
- getAnnotationEntry (ListPat an _) = fromAnn an
- getAnnotationEntry (TuplePat an _ _) = fromAnn an
- getAnnotationEntry (SumPat an _ _ _) = fromAnn an
- getAnnotationEntry (ConPat an _ _) = fromAnn an
- getAnnotationEntry (ViewPat an _ _) = fromAnn an
- getAnnotationEntry (SplicePat _ _) = NoEntryVal
- getAnnotationEntry (LitPat _ _) = NoEntryVal
- getAnnotationEntry (NPat an _ _ _) = fromAnn an
- getAnnotationEntry (NPlusKPat an _ _ _ _ _) = fromAnn an
- getAnnotationEntry (SigPat an _ _) = fromAnn an
- getAnnotationEntry (EmbTyPat _ _) = NoEntryVal
-
- setAnnotationAnchor a@(WildPat _) _ _ _s = a
- setAnnotationAnchor a@(VarPat _ _) _ _ _s = a
- setAnnotationAnchor (LazyPat an a) anc ts cs = (LazyPat (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor a@(AsPat _ _ _) _ _ _s = a
- setAnnotationAnchor a@(ParPat _ _) _ _ _s = a
- setAnnotationAnchor (BangPat an a) anc ts cs = (BangPat (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (ListPat an a) anc ts cs = (ListPat (setAnchorEpa an anc ts cs) a)
- setAnnotationAnchor (TuplePat an a b) anc ts cs = (TuplePat (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (SumPat an a b c) anc ts cs = (SumPat (setAnchorEpa an anc ts cs) a b c)
- setAnnotationAnchor (ConPat an a b) anc ts cs = (ConPat (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor (ViewPat an a b) anc ts cs = (ViewPat (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor a@(SplicePat _ _) _ _ _s = a
- setAnnotationAnchor a@(LitPat _ _) _ _ _s = a
- setAnnotationAnchor (NPat an a b c) anc ts cs = (NPat (setAnchorEpa an anc ts cs) a b c)
- setAnnotationAnchor (NPlusKPat an a b c d e) anc ts cs = (NPlusKPat (setAnchorEpa an anc ts cs) a b c d e)
- setAnnotationAnchor (SigPat an a b) anc ts cs = (SigPat (setAnchorEpa an anc ts cs) a b)
- setAnnotationAnchor a@(EmbTyPat _ _) _ _ _s = a
+ getAnnotationEntry _ = NoEntryVal
+ setAnnotationAnchor a _ _ _ = a
exact (WildPat w) = do
anchor' <- getAnchorU
@@ -4756,7 +4641,7 @@ instance ExactPrint (Pat GhcPs) where
else return n
return (VarPat x n')
exact (LazyPat an pat) = do
- an0 <- markEpAnnL an lidl AnnTilde
+ an0 <- markEpAnnL' an lidl AnnTilde
pat' <- markAnnotated pat
return (LazyPat an0 pat')
exact (AsPat at n pat) = do
@@ -4771,30 +4656,30 @@ instance ExactPrint (Pat GhcPs) where
return (ParPat (lpar', rpar') pat')
exact (BangPat an pat) = do
- an0 <- markEpAnnL an lidl AnnBang
+ an0 <- markEpAnnL' an lidl AnnBang
pat' <- markAnnotated pat
return (BangPat an0 pat')
exact (ListPat an pats) = do
- (an', pats') <- markAnnList an (markAnnotated pats)
+ (an', pats') <- markAnnList' an (markAnnotated pats)
return (ListPat an' pats')
exact (TuplePat an pats boxity) = do
an0 <- case boxity of
- Boxed -> markEpAnnL an lidl AnnOpenP
- Unboxed -> markEpAnnL an lidl AnnOpenPH
+ Boxed -> markEpAnnL' an lidl AnnOpenP
+ Unboxed -> markEpAnnL' an lidl AnnOpenPH
pats' <- markAnnotated pats
an1 <- case boxity of
- Boxed -> markEpAnnL an0 lidl AnnCloseP
- Unboxed -> markEpAnnL an0 lidl AnnClosePH
+ Boxed -> markEpAnnL' an0 lidl AnnCloseP
+ Unboxed -> markEpAnnL' an0 lidl AnnClosePH
return (TuplePat an1 pats' boxity)
exact (SumPat an pat alt arity) = do
- an0 <- markEpAnnL an lsumPatParens AnnOpenPH
+ an0 <- markEpAnnL' an lsumPatParens AnnOpenPH
an1 <- markAnnKwAllL an0 lsumPatVbarsBefore AnnVbar
pat' <- markAnnotated pat
an2 <- markAnnKwAllL an1 lsumPatVbarsAfter AnnVbar
- an3 <- markEpAnnL an2 lsumPatParens AnnClosePH
+ an3 <- markEpAnnL' an2 lsumPatParens AnnClosePH
return (SumPat an3 pat' alt arity)
exact (ConPat an con details) = do
@@ -4802,7 +4687,7 @@ instance ExactPrint (Pat GhcPs) where
return (ConPat an' con' details')
exact (ViewPat an expr pat) = do
expr' <- markAnnotated expr
- an0 <- markEpAnnL an lidl AnnRarrow
+ an0 <- markEpAnnL' an lidl AnnRarrow
pat' <- markAnnotated pat
return (ViewPat an0 expr' pat')
exact (SplicePat x splice) = do
@@ -4811,7 +4696,7 @@ instance ExactPrint (Pat GhcPs) where
exact p@(LitPat _ lit) = printStringAdvance (hsLit2String lit) >> return p
exact (NPat an ol mn z) = do
an0 <- if (isJust mn)
- then markEpAnnL an lidl AnnMinus
+ then markEpAnnL' an lidl AnnMinus
else return an
ol' <- markAnnotated ol
return (NPat an0 ol' mn z)
@@ -4824,7 +4709,7 @@ instance ExactPrint (Pat GhcPs) where
exact (SigPat an pat sig) = do
pat' <- markAnnotated pat
- an0 <- markEpAnnL an lidl AnnDcolon
+ an0 <- markEpAnnL' an lidl AnnDcolon
sig' <- markAnnotated sig
return (SigPat an0 pat' sig')
@@ -4903,8 +4788,8 @@ sourceTextToString (SourceText txt) _ = unpackFS txt
-- ---------------------------------------------------------------------
exactUserCon :: (Monad m, Monoid w, ExactPrint con)
- => EpAnn [AddEpAnn] -> con -> HsConPatDetails GhcPs
- -> EP w m (EpAnn [AddEpAnn], con, HsConPatDetails GhcPs)
+ => [AddEpAnn] -> con -> HsConPatDetails GhcPs
+ -> EP w m ([AddEpAnn], con, HsConPatDetails GhcPs)
exactUserCon an c (InfixCon p1 p2) = do
p1' <- markAnnotated p1
c' <- markAnnotated c
@@ -4912,9 +4797,9 @@ exactUserCon an c (InfixCon p1 p2) = do
return (an, c', InfixCon p1' p2')
exactUserCon an c details = do
c' <- markAnnotated c
- an0 <- markEpAnnL an lidl AnnOpenC
+ an0 <- markEpAnnL' an lidl AnnOpenC
details' <- exactConArgs details
- an1 <- markEpAnnL an0 lidl AnnCloseC
+ an1 <- markEpAnnL' an0 lidl AnnCloseC
return (an1, c', details')
instance ExactPrint (HsConPatTyArg GhcPs) where
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad7a0bb4eaffd664d4c613b18b23b61750b533f1
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ad7a0bb4eaffd664d4c613b18b23b61750b533f1
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20231213/92096cb9/attachment-0001.html>
More information about the ghc-commits
mailing list