[Git][ghc/ghc][master] EPA: When splitting out header comments, keep ones for first decl
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Dec 14 03:20:41 UTC 2022
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
9f301189 by Alan Zimmerman at 2022-12-13T22:19:50-05:00
EPA: When splitting out header comments, keep ones for first decl
Any comments immediately preceding the first declaration are no longer
kept as header comments, but attach to the first declaration instead.
- - - - -
5 changed files:
- compiler/GHC/Parser/Lexer.x
- testsuite/tests/ghc-api/exactprint/Test20239.stderr
- testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
- testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
- testsuite/tests/printer/Ppr031.hs
Changes:
=====================================
compiler/GHC/Parser/Lexer.x
=====================================
@@ -3676,6 +3676,25 @@ allocateComments ss comment_q =
in
(comment_q', reverse newAnns)
+-- Comments appearing without a line-break before the first
+-- declaration are associated with the declaration
+splitPriorComments
+ :: RealSrcSpan
+ -> [LEpaComment]
+ -> ([LEpaComment], [LEpaComment])
+splitPriorComments ss prior_comments =
+ let
+ -- True if there is only one line between the earlier and later span
+ cmp later earlier
+ = srcSpanStartLine later - srcSpanEndLine earlier == 1
+
+ go decl _ [] = ([],decl)
+ go decl r (c@(L l _):cs) = if cmp r (anchor l)
+ then go (c:decl) (anchor l) cs
+ else (reverse (c:cs), decl)
+ in
+ go [] ss prior_comments
+
allocatePriorComments
:: RealSrcSpan
-> [LEpaComment]
@@ -3684,12 +3703,13 @@ allocatePriorComments
allocatePriorComments ss comment_q mheader_comments =
let
cmp (L l _) = anchor l <= ss
- (before,after) = partition cmp comment_q
- newAnns = before
+ (newAnns,after) = partition cmp comment_q
comment_q'= after
+ (prior_comments, decl_comments) = splitPriorComments ss newAnns
in
case mheader_comments of
- Strict.Nothing -> (Strict.Just (reverse newAnns), comment_q', [])
+ Strict.Nothing -> (Strict.Just prior_comments, comment_q', decl_comments)
+ -- Strict.Nothing -> (Strict.Just [], comment_q', newAnns)
Strict.Just _ -> (mheader_comments, comment_q', reverse newAnns)
allocateFinalComments
=====================================
testsuite/tests/ghc-api/exactprint/Test20239.stderr
=====================================
@@ -19,14 +19,7 @@
[]
[]))
(EpaCommentsBalanced
- [(L
- (Anchor
- { Test20239.hs:3:1-28 }
- (UnchangedAnchor))
- (EpaComment
- (EpaLineComment
- "-- | Leading Haddock Comment")
- { Test20239.hs:1:18-22 }))]
+ []
[(L
(Anchor
{ Test20239.hs:8:1 }
@@ -53,6 +46,14 @@
[])
(EpaComments
[(L
+ (Anchor
+ { Test20239.hs:3:1-28 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- | Leading Haddock Comment")
+ { Test20239.hs:1:18-22 }))
+ ,(L
(Anchor
{ Test20239.hs:7:34-63 }
(UnchangedAnchor))
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.hs
=====================================
@@ -4,6 +4,10 @@
-}
module DumpParsedAstComments where
+-- Other comment
+
+-- comment 1 for foo
+-- comment 2 for foo
foo = do
-- normal comment
1
=====================================
testsuite/tests/parser/should_compile/DumpParsedAstComments.stderr
=====================================
@@ -34,15 +34,23 @@
(UnchangedAnchor))
(EpaComment
(EpaBlockComment
- "{-\n Block comment at the beginning\n -}")
- { DumpParsedAstComments.hs:1:1-28 }))]
+ "{-/n Block comment at the beginning/n -}")
+ { DumpParsedAstComments.hs:1:1-28 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:7:1-16 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- Other comment")
+ { DumpParsedAstComments.hs:5:30-34 }))]
[(L
(Anchor
- { DumpParsedAstComments.hs:13:1 }
+ { DumpParsedAstComments.hs:17:1 }
(UnchangedAnchor))
(EpaComment
(EpaEofComment)
- { DumpParsedAstComments.hs:13:1 }))]))
+ { DumpParsedAstComments.hs:17:1 }))]))
(VirtualBraces
(1))
(Nothing)
@@ -56,47 +64,63 @@
[(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,1)-(9,3) }
+ { DumpParsedAstComments.hs:(11,1)-(13,3) }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:11:1-20 }
+ { DumpParsedAstComments.hs:9:1-20 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- comment 1 for foo")
+ { DumpParsedAstComments.hs:7:1-16 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:10:1-20 }
+ (UnchangedAnchor))
+ (EpaComment
+ (EpaLineComment
+ "-- comment 2 for foo")
+ { DumpParsedAstComments.hs:9:1-20 }))
+ ,(L
+ (Anchor
+ { DumpParsedAstComments.hs:15:1-20 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- | Haddock comment")
- { DumpParsedAstComments.hs:9:3
- }))])) { DumpParsedAstComments.hs:(7,1)-(9,3) })
+ { DumpParsedAstComments.hs:13:3
+ }))])) { DumpParsedAstComments.hs:(11,1)-(13,3) })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:7:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
(Unqual
{OccName: foo}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,1)-(9,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
})
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,1)-(9,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,1)-(13,3)
})
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,1)-(9,3) }
+ { DumpParsedAstComments.hs:(11,1)-(13,3) }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:7:1-3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:11:1-3 })
(Unqual
{OccName: foo}))
(Prefix)
@@ -108,72 +132,72 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:(7,5)-(9,3) })
+ { DumpParsedAstComments.hs:(11,5)-(13,3) })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,5)-(9,3) }
+ { DumpParsedAstComments.hs:(11,5)-(13,3) }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:7:5 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:11:5 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(7,7)-(9,3)
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:(11,7)-(13,3)
})
(HsDo
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:(7,7)-(9,3) }
+ { DumpParsedAstComments.hs:(11,7)-(13,3) }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
- [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:7:7-8 }))]
+ [(AddEpAnn AnnDo (EpaSpan { DumpParsedAstComments.hs:11:7-8 }))]
[])
(EpaComments
[(L
(Anchor
- { DumpParsedAstComments.hs:8:3-19 }
+ { DumpParsedAstComments.hs:12:3-19 }
(UnchangedAnchor))
(EpaComment
(EpaLineComment
"-- normal comment")
- { DumpParsedAstComments.hs:7:7-8 }))]))
+ { DumpParsedAstComments.hs:11:7-8 }))]))
(DoExpr
(Nothing))
(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor))
(AnnList
(Just
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor)))
(Nothing)
(Nothing)
[]
[])
(EpaComments
- [])) { DumpParsedAstComments.hs:9:3 })
+ [])) { DumpParsedAstComments.hs:13:3 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
(BodyStmt
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:9:3 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:13:3 })
(HsOverLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:9:3 }
+ { DumpParsedAstComments.hs:13:3 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
@@ -192,37 +216,37 @@
,(L
(SrcSpanAnn (EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:1-23 }
+ { DumpParsedAstComments.hs:16:1-23 }
(UnchangedAnchor))
(AnnListItem
[])
(EpaComments
- [])) { DumpParsedAstComments.hs:12:1-23 })
+ [])) { DumpParsedAstComments.hs:16:1-23 })
(ValD
(NoExtField)
(FunBind
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
(Unqual
{OccName: main}))
(MG
(FromSource)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
[(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-23 })
(Match
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:1-23 }
+ { DumpParsedAstComments.hs:16:1-23 }
(UnchangedAnchor))
[]
(EpaComments
[]))
(FunRhs
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:1-4 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:1-4 })
(Unqual
{OccName: main}))
(Prefix)
@@ -234,42 +258,42 @@
[(L
(SrcSpanAnn
(EpAnnNotUsed)
- { DumpParsedAstComments.hs:12:6-23 })
+ { DumpParsedAstComments.hs:16:6-23 })
(GRHS
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:6-23 }
+ { DumpParsedAstComments.hs:16:6-23 }
(UnchangedAnchor))
(GrhsAnn
(Nothing)
- (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:12:6 })))
+ (AddEpAnn AnnEqual (EpaSpan { DumpParsedAstComments.hs:16:6 })))
(EpaComments
[]))
[]
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-23 })
(HsApp
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:8-23 }
+ { DumpParsedAstComments.hs:16:8-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
[]))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
(HsVar
(NoExtField)
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:8-15 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:8-15 })
(Unqual
{OccName: putStrLn}))))
(L
- (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:12:17-23 })
+ (SrcSpanAnn (EpAnnNotUsed) { DumpParsedAstComments.hs:16:17-23 })
(HsLit
(EpAnn
(Anchor
- { DumpParsedAstComments.hs:12:17-23 }
+ { DumpParsedAstComments.hs:16:17-23 }
(UnchangedAnchor))
(NoEpAnns)
(EpaComments
=====================================
testsuite/tests/printer/Ppr031.hs
=====================================
@@ -1,4 +1,5 @@
{-# LANGUAGE ImplicitParams, NamedFieldPuns, ParallelListComp, PatternGuards #-}
+
spec :: Spec
spec = do
describe "split4'8" $ do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f3011896aa3dc8cc14bd61ccb68ab09e17c330e
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/9f3011896aa3dc8cc14bd61ccb68ab09e17c330e
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/20221213/c210af32/attachment-0001.html>
More information about the ghc-commits
mailing list