[Git][ghc/ghc][master] EPA: Use ExplicitBraces only in HsModule
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Apr 26 18:52:24 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
052e2bb6 by Alan Zimmerman at 2023-04-26T14:52:05-04:00
EPA: Use ExplicitBraces only in HsModule
!9018 brought in exact print annotations in LayoutInfo for open and
close braces at the top level.
But it retained them in the HsModule annotations too.
Remove the originals, so exact printing uses LayoutInfo
- - - - -
21 changed files:
- compiler/GHC/Hs.hs
- compiler/GHC/Parser.y
- 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/DumpSemis.stderr
- testsuite/tests/parser/should_compile/KindSigs.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/T20718b.stderr
- testsuite/tests/parser/should_compile/T20846.stderr
- testsuite/tests/printer/T18791.stderr
- testsuite/tests/printer/Test20297.stdout
- utils/check-exact/ExactPrint.hs
- utils/check-exact/Parsers.hs
Changes:
=====================================
compiler/GHC/Hs.hs
=====================================
@@ -101,7 +101,7 @@ deriving instance Data (HsModule GhcPs)
data AnnsModule
= AnnsModule {
am_main :: [AddEpAnn],
- am_decls :: AnnList,
+ am_decls :: [TrailingAnn],
am_eof :: Maybe (RealSrcSpan, RealSrcSpan) -- End of file and end of prior token
} deriving (Data, Eq)
=====================================
compiler/GHC/Parser.y
=====================================
@@ -925,20 +925,17 @@ maybemodwarning :: { Maybe (LocatedP (WarningTxt GhcPs)) }
(AnnPragma (mo $1) (mc $4) (fst $ unLoc $3))}
| {- empty -} { Nothing }
-body :: { (AnnList
+body :: { ([TrailingAnn]
,([LImportDecl GhcPs], [LHsDecl GhcPs])
,LayoutInfo GhcPs) }
- : '{' top '}' { (AnnList Nothing (Just $ moc $1) (Just $ mcc $3) [] (fst $2)
- , snd $2, explicitBraces $1 $3) }
- | vocurly top close { (AnnList Nothing Nothing Nothing [] (fst $2)
- , snd $2, VirtualBraces (getVOCURLY $1)) }
+ : '{' top '}' { (fst $2, snd $2, explicitBraces $1 $3) }
+ | vocurly top close { (fst $2, snd $2, VirtualBraces (getVOCURLY $1)) }
-body2 :: { (AnnList
+body2 :: { ([TrailingAnn]
,([LImportDecl GhcPs], [LHsDecl GhcPs])
,LayoutInfo GhcPs) }
- : '{' top '}' { (AnnList Nothing (Just $ moc $1) (Just $ mcc $3) [] (fst $2)
- , snd $2, explicitBraces $1 $3) }
- | missing_module_keyword top close { (AnnList Nothing Nothing Nothing [] [], snd $2, VirtualBraces leftmostColumn) }
+ : '{' top '}' { (fst $2, snd $2, explicitBraces $1 $3) }
+ | missing_module_keyword top close { ([], snd $2, VirtualBraces leftmostColumn) }
top :: { ([TrailingAnn]
@@ -957,14 +954,14 @@ header :: { Located (HsModule GhcPs) }
: 'module' modid maybemodwarning maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
acs (\cs -> (L loc (HsModule (XModulePs
- (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] []) Nothing) cs)
+ (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] Nothing) cs)
NoLayoutInfo $3 Nothing)
(Just $2) $4 $6 []
))) }
| 'signature' modid maybemodwarning maybeexports 'where' header_body
{% fileSrcSpan >>= \ loc ->
acs (\cs -> (L loc (HsModule (XModulePs
- (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] (AnnList Nothing Nothing Nothing [] []) Nothing) cs)
+ (EpAnn (spanAsAnchor loc) (AnnsModule [mj AnnModule $1,mj AnnWhere $5] [] Nothing) cs)
NoLayoutInfo $3 Nothing)
(Just $2) $4 $6 []
))) }
=====================================
testsuite/tests/ghc-api/exactprint/T22919.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T22919.hs:1:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T22919.hs:1:29-33 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ T22919.hs:3:1 }
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { Test20239.hs:1:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { Test20239.hs:1:18-22 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ Test20239.hs:8:1 }
=====================================
testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { ZeroWidthSemi.hs:1:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { ZeroWidthSemi.hs:1:22-26 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ ZeroWidthSemi.hs:9:1 }
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T17544.hs:3:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T17544.hs:3:15-19 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
[]
- [])
(Just
((,)
{ T17544.hs:57:1 }
=====================================
testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T17544_kw.hs:11:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T17544_kw.hs:13:13-17 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
[]
- [])
(Just
((,)
{ T17544_kw.hs:25:1 }
=====================================
testsuite/tests/module/mod185.stderr
=====================================
@@ -11,12 +11,7 @@
(UnchangedAnchor))
(AnnsModule
[]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ mod185.hs:6:1 }
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { DumpParsedAst.hs:5:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAst.hs:5:22-26 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ DumpParsedAst.hs:25:1 }
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -13,12 +13,7 @@
[(AddEpAnn AnnModule (EpaSpan { DumpParsedAstComments.hs:5:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { DumpParsedAstComments.hs:5:30-34
}))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ DumpParsedAstComments.hs:20:1 }
=====================================
testsuite/tests/parser/should_compile/DumpSemis.stderr
=====================================
@@ -12,23 +12,18 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { DumpSemis.hs:1:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { DumpSemis.hs:1:18-22 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [(AddSemiAnn
- (EpaSpan { DumpSemis.hs:4:1 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:4:2 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:4:3 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:4:4 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:4:7 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:4:8 }))])
+ [(AddSemiAnn
+ (EpaSpan { DumpSemis.hs:4:1 }))
+ ,(AddSemiAnn
+ (EpaSpan { DumpSemis.hs:4:2 }))
+ ,(AddSemiAnn
+ (EpaSpan { DumpSemis.hs:4:3 }))
+ ,(AddSemiAnn
+ (EpaSpan { DumpSemis.hs:4:4 }))
+ ,(AddSemiAnn
+ (EpaSpan { DumpSemis.hs:4:7 }))
+ ,(AddSemiAnn
+ (EpaSpan { DumpSemis.hs:4:8 }))]
(Just
((,)
{ DumpSemis.hs:46:1 }
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { KindSigs.hs:6:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { KindSigs.hs:6:17-21 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ KindSigs.hs:36:1 }
=====================================
testsuite/tests/parser/should_compile/T15323.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T15323.hs:3:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T15323.hs:3:15-19 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ T15323.hs:7:1 }
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T20452.hs:3:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T20452.hs:3:15-19 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ T20452.hs:10:1 }
=====================================
testsuite/tests/parser/should_compile/T20718.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T20718.hs:3:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T20718.hs:3:15-19 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ T20718.hs:12:1 }
=====================================
testsuite/tests/parser/should_compile/T20718b.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T20718b.hs:4:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T20718b.hs:4:16-20 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ T20718b.hs:8:1 }
=====================================
testsuite/tests/parser/should_compile/T20846.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T20846.hs:1:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T20846.hs:1:15-19 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ T20846.hs:5:1 }
=====================================
testsuite/tests/printer/T18791.stderr
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { T18791.hs:2:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { T18791.hs:2:15-19 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ T18791.hs:6:1 }
=====================================
testsuite/tests/printer/Test20297.stdout
=====================================
@@ -12,12 +12,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { Test20297.hs:2:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { Test20297.hs:2:18-22 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ Test20297.hs:12:1 }
@@ -357,12 +352,7 @@
(AnnsModule
[(AddEpAnn AnnModule (EpaSpan { Test20297.ppr.hs:2:1-6 }))
,(AddEpAnn AnnWhere (EpaSpan { Test20297.ppr.hs:2:18-22 }))]
- (AnnList
- (Nothing)
- (Nothing)
- (Nothing)
- []
- [])
+ []
(Just
((,)
{ Test20297.ppr.hs:9:25 }
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1203,24 +1203,6 @@ markAnnListA reallyTrail an action = do
debugM $ "markAnnListA: an5=" ++ showAst an
return (an5, r)
-
-markAnnList' :: (Monad m, Monoid w)
- => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
-markAnnList' reallyTrail an action = do
- p <- getPosP
- debugM $ "markAnnList : " ++ showPprUnsafe (p, an)
- an0 <- markLensMAA an lal_open
- an1 <- if (not reallyTrail)
- then markTrailingL an0 lal_trailing
- else return an0
- an2 <- markEpAnnAllL an1 lal_rest AnnSemi
- r <- action
- an3 <- markLensMAA an2 lal_close
- an4 <- if reallyTrail
- then markTrailingL an3 lal_trailing
- else return an3
- return (an4, r)
-
-- ---------------------------------------------------------------------
printComments :: (Monad m, Monoid w) => RealSrcSpan -> EP w m ()
@@ -1387,14 +1369,21 @@ instance ExactPrint (HsModule GhcPs) where
return (an1, Just m', mdeprec', mexports')
- let ann_decls = EpAnn (entry an) (am_decls $ anns an0) emptyComments
- (ann_decls', (decls', imports')) <- markAnnList' False ann_decls $ do
- imports' <- markTopLevelList imports
- decls' <- markTopLevelList decls
- return (decls', imports')
- let am_decls' = case ann_decls' of
- EpAnnNotUsed -> (am_decls $ anns an0)
- EpAnn _ r _ -> r
+ lo0 <- case lo of
+ ExplicitBraces open close -> do
+ open' <- markToken open
+ return (ExplicitBraces open' close)
+ _ -> return lo
+
+ am_decls' <- markTrailing (am_decls $ anns an0)
+ imports' <- markTopLevelList imports
+ decls' <- markTopLevelList decls
+
+ lo1 <- case lo0 of
+ ExplicitBraces open close -> do
+ close' <- markToken close
+ return (ExplicitBraces open close')
+ _ -> return lo
-- Print EOF
case am_eof $ anns an of
@@ -1406,7 +1395,7 @@ instance ExactPrint (HsModule GhcPs) where
let anf = an0 { anns = (anns an0) { am_decls = am_decls' }}
debugM $ "HsModule, anf=" ++ showAst anf
- return (HsModule (XModulePs anf lo mdeprec' mbDoc') mmn' mexports' imports' decls')
+ return (HsModule (XModulePs anf lo1 mdeprec' mbDoc') mmn' mexports' imports' decls')
-- ---------------------------------------------------------------------
=====================================
utils/check-exact/Parsers.hs
=====================================
@@ -276,16 +276,15 @@ fixModuleTrailingComments :: GHC.ParsedSource -> GHC.ParsedSource
fixModuleTrailingComments (GHC.L l p) = GHC.L l p'
where
an' = case GHC.hsmodAnn $ GHC.hsmodExt p of
- (GHC.EpAnn a an ocs) -> GHC.EpAnn a an (rebalance (GHC.am_decls an) ocs)
+ (GHC.EpAnn a an ocs) -> GHC.EpAnn a an (rebalance ocs)
unused -> unused
p' = p { GHC.hsmodExt = (GHC.hsmodExt p){ GHC.hsmodAnn = an' } }
- -- p' = error $ "fixModuleTrailingComments: an'=" ++ showAst an'
- rebalance :: GHC.AnnList -> GHC.EpAnnComments -> GHC.EpAnnComments
- rebalance al cs = cs'
+ rebalance :: GHC.EpAnnComments -> GHC.EpAnnComments
+ rebalance cs = cs'
where
- cs' = case GHC.al_close al of
- Just (GHC.AddEpAnn _ (GHC.EpaSpan ss _)) ->
+ cs' = case GHC.hsmodLayout $ GHC.hsmodExt p of
+ GHC.ExplicitBraces _ (GHC.L (GHC.TokenLoc (GHC.EpaSpan ss _)) _) ->
let
pc = GHC.priorComments cs
fc = GHC.getFollowingComments cs
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/052e2bb629abc97b394b9de2394eb36cbed9385f
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/052e2bb629abc97b394b9de2394eb36cbed9385f
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/20230426/ee7aa2a2/attachment-0001.html>
More information about the ghc-commits
mailing list