From f859d61c4832b16ae3b4dd14aad5cb41b0051de3 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Tue, 29 Oct 2024 18:15:02 +0000
Subject: [PATCH] EPA: use explicit vertical bar token for ExplicitSum / SumPat
---
compiler/GHC/Hs/Expr.hs | 4 ++--
compiler/GHC/Hs/Pat.hs | 4 ++--
compiler/GHC/Parser.y | 16 +++++++---------
compiler/GHC/Parser/Annotation.hs | 2 +-
compiler/GHC/Parser/Types.hs | 2 +-
utils/check-exact/ExactPrint.hs | 26 +++++++++++++-------------
6 files changed, 26 insertions(+), 28 deletions(-)
diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 95cbb9e7f12..ee0112e6ee9 100644
--- a/compiler/GHC/Hs/Expr.hs
+++ b/compiler/GHC/Hs/Expr.hs
@@ -419,8 +419,8 @@ arrowToHsExpr = expandHsArrow (HsVar noExtField)
data AnnExplicitSum
= AnnExplicitSum {
aesOpen :: EpaLocation,
- aesBarsBefore :: [EpaLocation],
- aesBarsAfter :: [EpaLocation],
+ aesBarsBefore :: [EpToken "|"],
+ aesBarsAfter :: [EpToken "|"],
aesClose :: EpaLocation
} deriving Data
diff --git a/compiler/GHC/Hs/Pat.hs b/compiler/GHC/Hs/Pat.hs
index e4a87c5fa83..0eeaf658cf9 100644
--- a/compiler/GHC/Hs/Pat.hs
+++ b/compiler/GHC/Hs/Pat.hs
@@ -273,8 +273,8 @@ discarded inside tcMatchPats, where we know if visible pattern retained or erase
data EpAnnSumPat = EpAnnSumPat
{ sumPatParens :: (EpaLocation, EpaLocation)
- , sumPatVbarsBefore :: [EpaLocation]
- , sumPatVbarsAfter :: [EpaLocation]
+ , sumPatVbarsBefore :: [EpToken "|"]
+ , sumPatVbarsAfter :: [EpToken "|"]
} deriving Data
instance NoAnn EpAnnSumPat where
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 3f89ccea2b8..98c99d00838 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -3280,13 +3280,11 @@ tup_exprs :: { forall b. DisambECP b => PV (SumOrTuple b) }
; return (Tuple (cos ++ $2)) } }
| texp bars { unECP $1 >>= \ $1 -> return $
- (Sum 1 (snd $2 + 1) $1 [] (map srcSpan2e $ fst $2)) }
+ (Sum 1 (snd $2 + 1) $1 [] (fst $2)) }
| bars texp bars0
{ unECP $2 >>= \ $2 -> return $
- (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2
- (map srcSpan2e $ fst $1)
- (map srcSpan2e $ fst $3)) }
+ (Sum (snd $1 + 1) (snd $1 + snd $3 + 1) $2 (fst $1) (fst $3)) }
-- Always starts with commas; always follows an expr
commas_tup_tail :: { forall b. DisambECP b => PV (SrcSpan,[Either (EpAnn Bool) (LocatedA b)]) }
@@ -3827,7 +3825,7 @@ ntgtycon :: { LocatedN RdrName } -- A "general" qualified tycon, excluding unit
; amsr (sLL $1 $> n) (NameAnnCommas (NameParensHash (epTok $1) (epTok $3)) (map srcSpan2e (fst $2)) []) }}
| '(#' bars '#)' {% do { requireLTPuns PEP_SumSyntaxType $1 $>
; amsr (sLL $1 $> $ (getRdrName (sumTyCon (snd $2 + 1))))
- (NameAnnBars (epTok $1, epTok $3) (map srcSpan2e (fst $2)) []) } }
+ (NameAnnBars (epTok $1, epTok $3) (fst $2) []) } }
| '(' '->' ')' {% amsr (sLL $1 $> $ getRdrName unrestrictedFunTyCon)
(NameAnnRArrow (Just $ epTok $1) (epUniTok $2) (Just $ epTok $3) []) }
@@ -4160,13 +4158,13 @@ commas :: { ([SrcSpan],Int) } -- One or more commas
: commas ',' { ((fst $1)++[gl $2],snd $1 + 1) }
| ',' { ([gl $1],1) }
-bars0 :: { ([SrcSpan],Int) } -- Zero or more bars
+bars0 :: { ([EpToken "|"],Int) } -- Zero or more bars
: bars { $1 }
| { ([], 0) }
-bars :: { ([SrcSpan],Int) } -- One or more bars
- : bars '|' { ((fst $1)++[gl $2],snd $1 + 1) }
- | '|' { ([gl $1],1) }
+bars :: { ([EpToken "|"],Int) } -- One or more bars
+ : bars '|' { ((fst $1)++[epTok $2],snd $1 + 1) }
+ | '|' { ([epTok $1],1) }
{
happyError :: P a
diff --git a/compiler/GHC/Parser/Annotation.hs b/compiler/GHC/Parser/Annotation.hs
index 3bd6864cff5..f37de57d979 100644
--- a/compiler/GHC/Parser/Annotation.hs
+++ b/compiler/GHC/Parser/Annotation.hs
@@ -608,7 +608,7 @@ data NameAnn
-- | Used for @(# | | #)@
| NameAnnBars {
nann_parensh :: (EpToken "(#", EpToken "#)"),
- nann_bars :: [EpaLocation],
+ nann_bars :: [EpToken "|"],
nann_trailing :: [TrailingAnn]
}
-- | Used for @()@, @(##)@, @[]@
diff --git a/compiler/GHC/Parser/Types.hs b/compiler/GHC/Parser/Types.hs
index b0b683adaa2..6a6abd50974 100644
--- a/compiler/GHC/Parser/Types.hs
+++ b/compiler/GHC/Parser/Types.hs
@@ -27,7 +27,7 @@ import GHC.Parser.Annotation
import Language.Haskell.Syntax
data SumOrTuple b
- = Sum ConTag Arity (LocatedA b) [EpaLocation] [EpaLocation]
+ = Sum ConTag Arity (LocatedA b) [EpToken "|"] [EpToken "|"]
-- ^ Last two are the locations of the '|' before and after the payload
| Tuple [Either (EpAnn Bool) (LocatedA b)]
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 0594c95a83d..2a37e62875f 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1036,8 +1036,8 @@ lsnd k parent = fmap (\new -> (fst parent, new))
-- data AnnExplicitSum
-- = AnnExplicitSum {
-- aesOpen :: EpaLocation,
--- aesBarsBefore :: [EpaLocation],
--- aesBarsAfter :: [EpaLocation],
+-- aesBarsBefore :: [EpToken "|"],
+-- aesBarsAfter :: [EpToken "|"],
-- aesClose :: EpaLocation
-- } deriving Data
@@ -1045,11 +1045,11 @@ laesOpen :: Lens AnnExplicitSum EpaLocation
laesOpen k parent = fmap (\new -> parent { aesOpen = new })
(k (aesOpen parent))
-laesBarsBefore :: Lens AnnExplicitSum [EpaLocation]
+laesBarsBefore :: Lens AnnExplicitSum [EpToken "|"]
laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })
(k (aesBarsBefore parent))
-laesBarsAfter :: Lens AnnExplicitSum [EpaLocation]
+laesBarsAfter :: Lens AnnExplicitSum [EpToken "|"]
laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })
(k (aesBarsAfter parent))
@@ -1215,19 +1215,19 @@ lga_sep k parent = fmap (\new -> parent { ga_sep = new })
-- ---------------------------------------------------------------------
-- data EpAnnSumPat = EpAnnSumPat
-- { sumPatParens :: (EpaLocation, EpaLocation)
--- , sumPatVbarsBefore :: [EpaLocation]
--- , sumPatVbarsAfter :: [EpaLocation]
+-- , sumPatVbarsBefore :: [EpToken "|"]
+-- , sumPatVbarsAfter :: [EpToken "|"]
-- } deriving Data
lsumPatParens :: Lens EpAnnSumPat (EpaLocation, EpaLocation)
lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })
(k (sumPatParens parent))
-lsumPatVbarsBefore :: Lens EpAnnSumPat [EpaLocation]
+lsumPatVbarsBefore :: Lens EpAnnSumPat [EpToken "|"]
lsumPatVbarsBefore k parent = fmap (\new -> parent { sumPatVbarsBefore = new })
(k (sumPatVbarsBefore parent))
-lsumPatVbarsAfter :: Lens EpAnnSumPat [EpaLocation]
+lsumPatVbarsAfter :: Lens EpAnnSumPat [EpToken "|"]
lsumPatVbarsAfter k parent = fmap (\new -> parent { sumPatVbarsAfter = new })
(k (sumPatVbarsAfter parent))
@@ -2985,9 +2985,9 @@ instance ExactPrint (HsExpr GhcPs) where
exact (ExplicitSum an alt arity expr) = do
an0 <- markLensFun an laesOpen (\loc -> printStringAtAA loc "(#")
- an1 <- markLensFun an0 laesBarsBefore (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+ an1 <- markLensFun an0 laesBarsBefore (\locs -> mapM markEpToken locs)
expr' <- markAnnotated expr
- an2 <- markLensFun an1 laesBarsAfter (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+ an2 <- markLensFun an1 laesBarsAfter (\locs -> mapM markEpToken locs)
an3 <- markLensFun an2 laesClose (\loc -> printStringAtAA loc "#)")
return (ExplicitSum an3 alt arity expr')
@@ -4191,7 +4191,7 @@ instance ExactPrint (LocatedN RdrName) where
return (NameAnnCommas a1 commas' t)
NameAnnBars (o,c) bars t -> do
o' <- markEpToken o
- bars' <- forM bars (\loc -> printStringAtAAC NoCaptureComments loc "|")
+ bars' <- mapM markEpToken bars
c' <- markEpToken c
return (NameAnnBars (o',c') bars' t)
NameAnnOnly a t -> do
@@ -4684,9 +4684,9 @@ instance ExactPrint (Pat GhcPs) where
exact (SumPat an pat alt arity) = do
an0 <- markLensFun an (lsumPatParens . lfst) (\loc -> printStringAtAA loc "(#")
- an1 <- markLensFun an0 lsumPatVbarsBefore (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+ an1 <- markLensFun an0 lsumPatVbarsBefore (\locs -> mapM markEpToken locs)
pat' <- markAnnotated pat
- an2 <- markLensFun an1 lsumPatVbarsAfter (\locs -> mapM (\l -> printStringAtAA l "|") locs)
+ an2 <- markLensFun an1 lsumPatVbarsAfter (\locs -> mapM markEpToken locs)
an3 <- markLensFun an2 (lsumPatParens . lsnd) (\loc -> printStringAtAA loc "#)")
return (SumPat an3 pat' alt arity)
--
GitLab