diff options
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 |