diff --git a/compiler/GHC/Hs/Expr.hs b/compiler/GHC/Hs/Expr.hs
index 95cbb9e7f12af0fb95723ceb9fcaf5ef9491d4e7..ee0112e6ee992067c95410489111b011a13f6abc 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 e4a87c5fa831b8f541846ede3748da21e4471888..0eeaf658cf91619627ef68d47ca2da1a5f679545 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 3f89ccea2b8eb9dac4d29e05b0ea4affa25dd24f..98c99d00838335c8ce96ac822fc0cd6890d6f734 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 3bd6864cff5c760c8565f697c02ae45f392fc341..f37de57d9798979dd605314187f75bd657939edf 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 b0b683adaa247739f041bf02d267160ba54e51ed..6a6abd509741ad86640a30de094904bd0b85c19e 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 0594c95a83d73bcaa47923ce62d2adf55cd656ff..2a37e62875fb7a0119d317e4713d8ebf35dfd4cb 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)