[Git][ghc/ghc][wip/az/ghc-9.10-backports-1] EPA: Fix comments in mkListSyntaxTy0
Alan Zimmerman (@alanz)
gitlab at gitlab.haskell.org
Sun Apr 21 10:39:31 UTC 2024
Alan Zimmerman pushed to branch wip/az/ghc-9.10-backports-1 at Glasgow Haskell Compiler / GHC
Commits:
c8d25501 by Alan Zimmerman at 2024-04-21T10:41:35+01:00
EPA: Fix comments in mkListSyntaxTy0
Also extend the test to confirm.
Addresses #24669, 1 of 4
(cherry picked from commit f07015858fd79dca41983dbf3a249dfecd8d2eea)
- - - - -
3 changed files:
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/printer/AnnotationNoListTuplePuns.hs
- + testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
Changes:
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -3318,12 +3318,12 @@ withCombinedComments ::
HasLoc l2 =>
l1 ->
l2 ->
- (SrcSpan -> EpAnnComments -> P a) ->
+ (SrcSpan -> P a) ->
P (LocatedA a)
withCombinedComments start end use = do
cs <- getCommentsFor fullSpan
- a <- use fullSpan cs
- pure (L (noAnnSrcSpan fullSpan) a)
+ a <- use fullSpan
+ pure (L (EpAnn (spanAsAnchor fullSpan) noAnn cs) a)
where
fullSpan = combineSrcSpans (getHasLoc start) (getHasLoc end)
@@ -3363,15 +3363,14 @@ mkTupleSyntaxTycon boxity n =
mkListSyntaxTy0 :: EpaLocation
-> EpaLocation
-> SrcSpan
- -> EpAnnComments
-> P (HsType GhcPs)
-mkListSyntaxTy0 brkOpen brkClose span comments =
+mkListSyntaxTy0 brkOpen brkClose span =
punsIfElse enabled disabled
where
enabled = HsTyVar noAnn NotPromoted rn
-- attach the comments only to the RdrName since it's the innermost AST node
- rn = L (EpAnn fullLoc rdrNameAnn comments) listTyCon_RDR
+ rn = L (EpAnn fullLoc rdrNameAnn emptyComments) listTyCon_RDR
disabled =
HsExplicitListTy annsKeyword NotPromoted []
=====================================
testsuite/tests/printer/AnnotationNoListTuplePuns.hs
=====================================
@@ -1,17 +1,18 @@
{-# language NoListTuplePuns #-}
+{-# OPTIONS -ddump-parsed-ast #-}
module AnnotationNoListTuplePuns where
type A =
- -- comment pre
+ -- comment pre A
[
- -- comment inside
+ -- comment inside A
]
- -- comment post
+ -- comment post A
type B =
- -- comment pre
+ -- comment pre B
[
- -- comment inside
+ -- comment inside B
Bool
]
- -- comment post
+ -- comment post B
=====================================
testsuite/tests/printer/AnnotationNoListTuplePuns.stdout
=====================================
@@ -0,0 +1,323 @@
+
+==================== Parser AST ====================
+
+(L
+ { AnnotationNoListTuplePuns.hs:1:1 }
+ (HsModule
+ (XModulePs
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:1:1 })
+ (AnnsModule
+ [(AddEpAnn AnnModule (EpaSpan { AnnotationNoListTuplePuns.hs:3:1-6 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { AnnotationNoListTuplePuns.hs:3:34-38 }))]
+ []
+ []
+ (Just
+ ((,)
+ { AnnotationNoListTuplePuns.hs:19:1 }
+ { AnnotationNoListTuplePuns.hs:18:3-19 })))
+ (EpaCommentsBalanced
+ [(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:1:1-32 })
+ (EpaComment
+ (EpaBlockComment
+ "{-# language NoListTuplePuns #-}")
+ { AnnotationNoListTuplePuns.hs:1:1 }))
+ ,(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:2:1-33 })
+ (EpaComment
+ (EpaBlockComment
+ "{-# OPTIONS -ddump-parsed-ast #-}")
+ { AnnotationNoListTuplePuns.hs:1:1-32 }))]
+ [(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:18:3-19 })
+ (EpaComment
+ (EpaLineComment
+ "-- comment post B")
+ { AnnotationNoListTuplePuns.hs:17:3 }))]))
+ (EpVirtualBraces
+ (1))
+ (Nothing)
+ (Nothing))
+ (Just
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:3:8-32 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ {ModuleName: AnnotationNoListTuplePuns}))
+ (Nothing)
+ []
+ [(L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:(5,1)-(9,3) })
+ (AnnListItem
+ [])
+ (EpaComments
+ [(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:6:3-18 })
+ (EpaComment
+ (EpaLineComment
+ "-- comment pre A")
+ { AnnotationNoListTuplePuns.hs:5:8 }))]))
+ (TyClD
+ (NoExtField)
+ (SynDecl
+ [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.hs:5:1-4 }))
+ ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.hs:5:8 }))]
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:5:6 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: A}))
+ (HsQTvs
+ (NoExtField)
+ [])
+ (Prefix)
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:(7,3)-(9,3) })
+ (AnnListItem
+ [])
+ (EpaComments
+ [(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:8:5-23 })
+ (EpaComment
+ (EpaLineComment
+ "-- comment inside A")
+ { AnnotationNoListTuplePuns.hs:7:3 }))]))
+ (HsExplicitListTy
+ [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.hs:7:3 }))
+ ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.hs:9:3 }))]
+ (NotPromoted)
+ [])))))
+ ,(L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:(12,1)-(17,3) })
+ (AnnListItem
+ [])
+ (EpaComments
+ [(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:10:3-19 })
+ (EpaComment
+ (EpaLineComment
+ "-- comment post A")
+ { AnnotationNoListTuplePuns.hs:9:3 }))
+ ,(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:13:3-18 })
+ (EpaComment
+ (EpaLineComment
+ "-- comment pre B")
+ { AnnotationNoListTuplePuns.hs:12:8 }))]))
+ (TyClD
+ (NoExtField)
+ (SynDecl
+ [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.hs:12:1-4 }))
+ ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.hs:12:8 }))]
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:12:6 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: B}))
+ (HsQTvs
+ (NoExtField)
+ [])
+ (Prefix)
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:(14,3)-(17,3) })
+ (AnnListItem
+ [])
+ (EpaComments
+ [(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.hs:15:5-23 })
+ (EpaComment
+ (EpaLineComment
+ "-- comment inside B")
+ { AnnotationNoListTuplePuns.hs:14:3 }))]))
+ (HsExplicitListTy
+ [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.hs:14:3 }))
+ ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.hs:17:3 }))]
+ (NotPromoted)
+ [(L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:16:5-8 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.hs:16:5-8 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Bool}))))])))))]))
+
+
+
+==================== Parser AST ====================
+
+(L
+ { AnnotationNoListTuplePuns.ppr.hs:1:1 }
+ (HsModule
+ (XModulePs
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:1:1 })
+ (AnnsModule
+ [(AddEpAnn AnnModule (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:1-6 }))
+ ,(AddEpAnn AnnWhere (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:34-38 }))]
+ []
+ []
+ (Just
+ ((,)
+ { AnnotationNoListTuplePuns.ppr.hs:5:16 }
+ { AnnotationNoListTuplePuns.ppr.hs:5:15 })))
+ (EpaCommentsBalanced
+ [(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.ppr.hs:1:1-32 })
+ (EpaComment
+ (EpaBlockComment
+ "{-# language NoListTuplePuns #-}")
+ { AnnotationNoListTuplePuns.ppr.hs:1:1 }))
+ ,(L
+ (EpaSpan
+ { AnnotationNoListTuplePuns.ppr.hs:2:1-33 })
+ (EpaComment
+ (EpaBlockComment
+ "{-# OPTIONS -ddump-parsed-ast #-}")
+ { AnnotationNoListTuplePuns.ppr.hs:1:1-32 }))]
+ []))
+ (EpVirtualBraces
+ (1))
+ (Nothing)
+ (Nothing))
+ (Just
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:3:8-32 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ {ModuleName: AnnotationNoListTuplePuns}))
+ (Nothing)
+ []
+ [(L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:1-11 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (TyClD
+ (NoExtField)
+ (SynDecl
+ [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:1-4 }))
+ ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:8 }))]
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:6 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: A}))
+ (HsQTvs
+ (NoExtField)
+ [])
+ (Prefix)
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:10-11 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsExplicitListTy
+ [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:10 }))
+ ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:4:11 }))]
+ (NotPromoted)
+ [])))))
+ ,(L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:1-15 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (TyClD
+ (NoExtField)
+ (SynDecl
+ [(AddEpAnn AnnType (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:1-4 }))
+ ,(AddEpAnn AnnEqual (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:8 }))]
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:6 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: B}))
+ (HsQTvs
+ (NoExtField)
+ [])
+ (Prefix)
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:10-15 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsExplicitListTy
+ [(AddEpAnn AnnOpenS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:10 }))
+ ,(AddEpAnn AnnCloseS (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:15 }))]
+ (NotPromoted)
+ [(L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:11-14 })
+ (AnnListItem
+ [])
+ (EpaComments
+ []))
+ (HsTyVar
+ []
+ (NotPromoted)
+ (L
+ (EpAnn
+ (EpaSpan { AnnotationNoListTuplePuns.ppr.hs:5:11-14 })
+ (NameAnnTrailing
+ [])
+ (EpaComments
+ []))
+ (Unqual
+ {OccName: Bool}))))])))))]))
+
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8d25501884a6633b580bc1b347b7ca8f2d04fe6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/c8d25501884a6633b580bc1b347b7ca8f2d04fe6
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/20240421/e084de0a/attachment-0001.html>
More information about the ghc-commits
mailing list