From 2f8e3a254a20f4573aec26fc85ab74b51d661472 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Mon, 15 Apr 2024 22:31:39 +0100
Subject: [PATCH] EPA: Avoid duplicated comments in splice decls
Contributes to #24669
---
compiler/GHC/Parser.y | 5 ++---
compiler/GHC/Parser/PostProcess.hs | 23 ++++++++++-------------
2 files changed, 12 insertions(+), 16 deletions(-)
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 171e174e2a71..2e036d021b88 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1257,8 +1257,7 @@ topdecl :: { LHsDecl GhcPs }
-- but we treat an arbitrary expression just as if
-- it had a $(..) wrapped around it
| infixexp {% runPV (unECP $1) >>= \ $1 ->
- do { d <- mkSpliceDecl $1
- ; commentsPA d }}
+ commentsPA $ mkSpliceDecl $1 }
-- Type classes
--
@@ -2603,7 +2602,7 @@ decl :: { LHsDecl GhcPs }
-- Why do we only allow naked declaration splices in top-level
-- declarations and not here? Short answer: because readFail009
-- fails terribly with a panic in cvBindsAndSigs otherwise.
- | splice_exp {% mkSpliceDecl $1 }
+ | splice_exp { mkSpliceDecl $1 }
rhs :: { Located (GRHSs GhcPs (LHsExpr GhcPs)) }
: '=' exp wherebinds {% runPV (unECP $2) >>= \ $2 ->
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index ebb05f97c823..edac4773113d 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -385,7 +385,7 @@ mkFamDecl loc info topLevel lhs ksig injAnn annsIn
OpenTypeFamily -> empty
ClosedTypeFamily {} -> whereDots
-mkSpliceDecl :: LHsExpr GhcPs -> P (LHsDecl GhcPs)
+mkSpliceDecl :: LHsExpr GhcPs -> (LHsDecl GhcPs)
-- If the user wrote
-- [pads| ... ] then return a QuasiQuoteD
-- $(e) then return a SpliceD
@@ -396,18 +396,15 @@ mkSpliceDecl :: LHsExpr GhcPs -> P (LHsDecl GhcPs)
-- Typed splices are not allowed at the top level, thus we do not represent them
-- as spliced declaration. See #10945
mkSpliceDecl lexpr@(L loc expr)
- | HsUntypedSplice _ splice@(HsUntypedSpliceExpr {}) <- expr = do
- !cs <- getCommentsFor (locA loc)
- return $ L (addCommentsToEpAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField (L loc splice) DollarSplice)
-
- | HsUntypedSplice _ splice@(HsQuasiQuote {}) <- expr = do
- cs <- getCommentsFor (locA loc)
- return $ L (addCommentsToEpAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField (L loc splice) DollarSplice)
-
- | otherwise = do
- !cs <- getCommentsFor (locA loc)
- return $ L (addCommentsToEpAnn loc cs) $ SpliceD noExtField (SpliceDecl noExtField
- (L loc (HsUntypedSpliceExpr noAnn lexpr))
+ | HsUntypedSplice _ splice@(HsUntypedSpliceExpr {}) <- expr
+ = L loc $ SpliceD noExtField (SpliceDecl noExtField (L (l2l loc) splice) DollarSplice)
+
+ | HsUntypedSplice _ splice@(HsQuasiQuote {}) <- expr
+ = L loc $ SpliceD noExtField (SpliceDecl noExtField (L (l2l loc) splice) DollarSplice)
+
+ | otherwise
+ = L loc $ SpliceD noExtField (SpliceDecl noExtField
+ (L (l2l loc) (HsUntypedSpliceExpr noAnn (la2la lexpr)))
BareSplice)
mkRoleAnnotDecl :: SrcSpan
--
GitLab