summaryrefslogtreecommitdiff
path: root/compiler/GHC/Parser
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2021-08-22 09:13:30 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2021-09-08 16:58:51 -0400
commit86e5a6c34128a20d04808fcffcc49623a5d967bf (patch)
tree1d98c5a6049c707c66ab2b9c3247697d4578b4a8 /compiler/GHC/Parser
parent9fc0fe008c13782cb7b1962b0ebed0bb09ecfb6f (diff)
downloadhaskell-86e5a6c34128a20d04808fcffcc49623a5d967bf.tar.gz
EPA: Capture '+' location for NPlusKPat
The location of the plus symbol was being discarded, we now capture it. Closes #20243
Diffstat (limited to 'compiler/GHC/Parser')
-rw-r--r--compiler/GHC/Parser/Annotation.hs6
-rw-r--r--compiler/GHC/Parser/PostProcess.hs7
2 files changed, 9 insertions, 4 deletions
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 19925b0678..a914a14b71 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -13,7 +13,7 @@ module GHC.Parser.Annotation (
-- * In-tree Exact Print Annotations
AddEpAnn(..),
- EpaLocation(..), epaLocationRealSrcSpan,
+ EpaLocation(..), epaLocationRealSrcSpan, epaLocationFromSrcAnn,
DeltaPos(..), deltaPos, getDeltaLine,
EpAnn(..), Anchor(..), AnchorOperation(..),
@@ -440,6 +440,10 @@ epaLocationRealSrcSpan :: EpaLocation -> RealSrcSpan
epaLocationRealSrcSpan (EpaSpan r) = r
epaLocationRealSrcSpan (EpaDelta _) = panic "epaLocationRealSrcSpan"
+epaLocationFromSrcAnn :: SrcAnn ann -> EpaLocation
+epaLocationFromSrcAnn (SrcSpanAnn EpAnnNotUsed l) = EpaSpan (realSrcSpan l)
+epaLocationFromSrcAnn (SrcSpanAnn (EpAnn anc _ _) _) = EpaSpan (anchor anc)
+
instance Outputable EpaLocation where
ppr (EpaSpan r) = text "EpaSpan" <+> ppr r
ppr (EpaDelta d) = text "EpaDelta" <+> ppr d
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index af92355240..957e0f28a5 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -1146,11 +1146,12 @@ checkAPat loc e0 = do
-- n+k patterns
PatBuilderOpApp
(L _ (PatBuilderVar (L nloc n)))
- (L _ plus)
+ (L l plus)
(L lloc (PatBuilderOverLit lit@(OverLit {ol_val = HsIntegral {}})))
- anns
+ (EpAnn anc _ cs)
| nPlusKPatterns && (plus == plus_RDR)
- -> return (mkNPlusKPat (L nloc n) (L (locA lloc) lit) anns)
+ -> return (mkNPlusKPat (L nloc n) (L (locA lloc) lit)
+ (EpAnn anc (epaLocationFromSrcAnn l) cs))
-- Improve error messages for the @-operator when the user meant an @-pattern
PatBuilderOpApp _ op _ _ | opIsAt (unLoc op) -> do