diff options
author | Alan Zimmerman <alan.zimm@gmail.com> | 2023-04-25 23:24:27 +0100 |
---|---|---|
committer | Marge Bot <ben+marge-bot@smart-cactus.org> | 2023-04-26 14:52:05 -0400 |
commit | 052e2bb629abc97b394b9de2394eb36cbed9385f (patch) | |
tree | 3ae7f17afa7de56fbdfd0ee2aa8af3fbb3a23811 | |
parent | 77f506b888624b4fd30205fb8512f39435055a27 (diff) | |
download | haskell-052e2bb629abc97b394b9de2394eb36cbed9385f.tar.gz |
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 files changed, 57 insertions, 162 deletions
diff --git a/compiler/GHC/Hs.hs b/compiler/GHC/Hs.hs index eb66dc0f28..9ec3215dbd 100644 --- a/compiler/GHC/Hs.hs +++ b/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) diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y index bbbc12df56..d95d9d1512 100644 --- a/compiler/GHC/Parser.y +++ b/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 [] ))) } diff --git a/testsuite/tests/ghc-api/exactprint/T22919.stderr b/testsuite/tests/ghc-api/exactprint/T22919.stderr index eb4c9c9a4c..5215026856 100644 --- a/testsuite/tests/ghc-api/exactprint/T22919.stderr +++ b/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 } diff --git a/testsuite/tests/ghc-api/exactprint/Test20239.stderr b/testsuite/tests/ghc-api/exactprint/Test20239.stderr index cfe514f31e..6ed6a94a1f 100644 --- a/testsuite/tests/ghc-api/exactprint/Test20239.stderr +++ b/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 } diff --git a/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr b/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr index 45640ba26e..a148bb8309 100644 --- a/testsuite/tests/ghc-api/exactprint/ZeroWidthSemi.stderr +++ b/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 } diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr index 484a56ecc0..a9b337cd49 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544.stderr +++ b/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 } diff --git a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr b/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr index 1efed5e02e..e406cca52e 100644 --- a/testsuite/tests/haddock/should_compile_flag_haddock/T17544_kw.stderr +++ b/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 } diff --git a/testsuite/tests/module/mod185.stderr b/testsuite/tests/module/mod185.stderr index b9e5ee7849..e32cc1496d 100644 --- a/testsuite/tests/module/mod185.stderr +++ b/testsuite/tests/module/mod185.stderr @@ -11,12 +11,7 @@ (UnchangedAnchor)) (AnnsModule [] - (AnnList - (Nothing) - (Nothing) - (Nothing) - [] - []) + [] (Just ((,) { mod185.hs:6:1 } diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr index 677988f0df..b2dc86fece 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr b/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr index 5990fb171a..7fce349864 100644 --- a/testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr index 4e283a73fe..60eff755cb 100644 --- a/testsuite/tests/parser/should_compile/DumpSemis.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/KindSigs.stderr b/testsuite/tests/parser/should_compile/KindSigs.stderr index df228cb912..020d16aeb4 100644 --- a/testsuite/tests/parser/should_compile/KindSigs.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/T15323.stderr b/testsuite/tests/parser/should_compile/T15323.stderr index a3bc49d34f..e4911a91b3 100644 --- a/testsuite/tests/parser/should_compile/T15323.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/T20452.stderr b/testsuite/tests/parser/should_compile/T20452.stderr index f05cef65b8..af4da2d5a9 100644 --- a/testsuite/tests/parser/should_compile/T20452.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/T20718.stderr b/testsuite/tests/parser/should_compile/T20718.stderr index 16eeaa4e69..ebd35e96b7 100644 --- a/testsuite/tests/parser/should_compile/T20718.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/T20718b.stderr b/testsuite/tests/parser/should_compile/T20718b.stderr index 6370f1cbcc..48077c4b6b 100644 --- a/testsuite/tests/parser/should_compile/T20718b.stderr +++ b/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 } diff --git a/testsuite/tests/parser/should_compile/T20846.stderr b/testsuite/tests/parser/should_compile/T20846.stderr index 7cb906a78a..4a1981b6e1 100644 --- a/testsuite/tests/parser/should_compile/T20846.stderr +++ b/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 } diff --git a/testsuite/tests/printer/T18791.stderr b/testsuite/tests/printer/T18791.stderr index 28727aabf6..d7a0fb6b96 100644 --- a/testsuite/tests/printer/T18791.stderr +++ b/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 } diff --git a/testsuite/tests/printer/Test20297.stdout b/testsuite/tests/printer/Test20297.stdout index 180078c16a..586d9fae20 100644 --- a/testsuite/tests/printer/Test20297.stdout +++ b/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 } diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs index 04d0b831e6..5db255f765 100644 --- a/utils/check-exact/ExactPrint.hs +++ b/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') -- --------------------------------------------------------------------- diff --git a/utils/check-exact/Parsers.hs b/utils/check-exact/Parsers.hs index 8bcc26a90d..2eadcacab9 100644 --- a/utils/check-exact/Parsers.hs +++ b/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 |