1 Apr
2026
1 Apr
'26
3:59 a.m.
Vladislav Zavialov pushed to branch wip/int-index/epa-parens at Glasgow Haskell Compiler / GHC
Commits:
ef641c07 by Vladislav Zavialov at 2026-04-01T06:59:09+03:00
EPA: Use AnnParen for tuples and sums
Summary of changes
* Do not use AnnParen in XListTy, replace it with EpToken "[" and "]"
* Specialise AnnParen to tuple/sums by dropping the AnnParensSquare
and keeping only AnnParens and AnnParensHash
* Use AnnParen in XExplicitTuple
* Use AnnParen in XExplicitTupleTy
* Use AnnParen in XTuplePat
* Use AnnParen in XExplicitSum (via AnnExplicitSum)
* Use AnnParen in XSumPat (via EpAnnSumPat)
This is a refactoring with no user-facing changes.
- - - - -
13 changed files:
- compiler/GHC/Hs/Dump.hs
- compiler/GHC/Hs/Expr.hs
- compiler/GHC/Hs/Pat.hs
- compiler/GHC/Hs/Type.hs
- compiler/GHC/Parser.y
- compiler/GHC/Parser/Annotation.hs
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/ghc-api/T25121_status.stdout
- testsuite/tests/parser/should_compile/DumpParsedAst.stderr
- testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
- testsuite/tests/parser/should_compile/KindSigs.stderr
- testsuite/tests/parser/should_compile/T20452.stderr
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Hs/Dump.hs
=====================================
@@ -221,7 +221,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
NoBlankEpAnnotations -> parens (case ap of
(AnnParens o c) -> text "AnnParens" $$ vcat [showAstData' o, showAstData' c]
(AnnParensHash o c) -> text "AnnParensHash" $$ vcat [showAstData' o, showAstData' c]
- (AnnParensSquare o c) -> text "AnnParensSquare" $$ vcat [showAstData' o, showAstData' c]
)
annClassDecl :: AnnClassDecl -> SDoc
=====================================
compiler/GHC/Hs/Expr.hs
=====================================
@@ -263,7 +263,7 @@ type instance XPar GhcPs = (EpToken "(", EpToken ")")
type instance XPar GhcRn = NoExtField
type instance XPar GhcTc = NoExtField
-type instance XExplicitTuple GhcPs = (EpaLocation, EpaLocation)
+type instance XExplicitTuple GhcPs = AnnParen
type instance XExplicitTuple GhcRn = NoExtField
type instance XExplicitTuple GhcTc = NoExtField
@@ -556,14 +556,13 @@ mkHsVarWithUserRdr rdr n = HsVar noExtField $
data AnnExplicitSum
= AnnExplicitSum {
- aesOpen :: EpaLocation,
+ aesParens :: AnnParen,
aesBarsBefore :: [EpToken "|"],
- aesBarsAfter :: [EpToken "|"],
- aesClose :: EpaLocation
+ aesBarsAfter :: [EpToken "|"]
} deriving Data
instance NoAnn AnnExplicitSum where
- noAnn = AnnExplicitSum noAnn noAnn noAnn noAnn
+ noAnn = AnnExplicitSum noAnn noAnn noAnn
data AnnFieldLabel
= AnnFieldLabel {
=====================================
compiler/GHC/Hs/Pat.hs
=====================================
@@ -113,7 +113,7 @@ type instance XListPat GhcRn = NoExtField
type instance XListPat GhcTc = Type
-- List element type, for use in hsPatType.
-type instance XTuplePat GhcPs = (EpaLocation, EpaLocation)
+type instance XTuplePat GhcPs = AnnParen
type instance XTuplePat GhcRn = NoExtField
type instance XTuplePat GhcTc = [Type]
@@ -260,13 +260,13 @@ discarded inside tcMatchPats, where we know if visible pattern retained or erase
-- API Annotations types
data EpAnnSumPat = EpAnnSumPat
- { sumPatParens :: (EpaLocation, EpaLocation)
+ { sumPatParens :: AnnParen
, sumPatVbarsBefore :: [EpToken "|"]
, sumPatVbarsAfter :: [EpToken "|"]
} deriving Data
instance NoAnn EpAnnSumPat where
- noAnn = EpAnnSumPat (noAnn, noAnn) [] []
+ noAnn = EpAnnSumPat noAnn [] []
-- ---------------------------------------------------------------------
=====================================
compiler/GHC/Hs/Type.hs
=====================================
@@ -430,7 +430,7 @@ type instance XQualTy (GhcPass _) = NoExtField
type instance XTyVar (GhcPass _) = EpToken "'"
type instance XAppTy (GhcPass _) = NoExtField
type instance XFunTy (GhcPass _) = NoExtField
-type instance XListTy (GhcPass _) = AnnParen
+type instance XListTy (GhcPass _) = (EpToken "[", EpToken "]")
type instance XTupleTy (GhcPass _) = AnnParen
type instance XSumTy (GhcPass _) = AnnParen
type instance XOpTy (GhcPass _) = NoExtField
@@ -455,7 +455,7 @@ type instance XExplicitListTy GhcPs = (EpToken "'", EpToken "[", EpToken "]")
type instance XExplicitListTy GhcRn = NoExtField
type instance XExplicitListTy GhcTc = Kind
-type instance XExplicitTupleTy GhcPs = (EpToken "'", EpToken "(", EpToken ")")
+type instance XExplicitTupleTy GhcPs = (EpToken "'", AnnParen)
type instance XExplicitTupleTy GhcRn = NoExtField
type instance XExplicitTupleTy GhcTc = [Kind]
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2370,14 +2370,14 @@ atype :: { LHsType GhcPs }
| '(' ktype ')' {% amsA' (sLL $1 $> $ HsParTy (epTok $1, epTok $3) $2) }
-- see Note [Promotion] for the followings
| SIMPLEQUOTE '(' ')' {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
- ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $3) IsPromoted []) }}
+ ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1, AnnParens (epTok $2) (epTok $3)) IsPromoted []) }}
| SIMPLEQUOTE gen_qcon {% amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted $2) }
| SIMPLEQUOTE sysdcon_nolist {% do { requireLTPuns PEP_QuoteDisambiguation $1 (reLoc $>)
; amsA' (sLL $1 $> $ HsTyVar (epTok $1) IsPromoted (L (getLoc $2) $ nameRdrName (dataConName (unLoc $2)))) }}
| SIMPLEQUOTE '(' ktype ',' comma_types1 ')'
{% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
; h <- addTrailingCommaA $3 (epTok $4)
- ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1,epTok $2,epTok $6) IsPromoted (h : $5)) }}
+ ; amsA' (sLL $1 $> $ HsExplicitTupleTy (epTok $1, AnnParens (epTok $2) (epTok $6)) IsPromoted (h : $5)) }}
| '[' ']' {% withCombinedComments $1 $> (mkListSyntaxTy0 (epTok $1) (epTok $2)) }
| SIMPLEQUOTE '[' comma_types0 ']' {% do { requireLTPuns PEP_QuoteDisambiguation $1 $>
; amsA' (sLL $1 $> $ HsExplicitListTy (epTok $1, epTok $2, epTok $4) IsPromoted $3) }}
@@ -3185,7 +3185,7 @@ aexp2 :: { ECP }
| '(' tup_exprs ')' { ECP $
$2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Boxed $2
- (glR $1,glR $3)}
+ (AnnParens (epTok $1) (epTok $3))}
| '(' orpats(exp2) ')' {% do
{ pat <- hintOrPats (sL1a $2 (OrPat NoExtField (unLoc $2)))
@@ -3201,11 +3201,11 @@ aexp2 :: { ECP }
| '(#' texp '#)' { ECP $
unECP $2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed (Tuple [Right $2])
- (glR $1,glR $3) }
+ (AnnParensHash (epTok $1) (epTok $3)) }
| '(#' tup_exprs '#)' { ECP $
$2 >>= \ $2 ->
mkSumOrTuplePV (noAnnSrcSpan $ comb2 $1 $>) Unboxed $2
- (glR $1,glR $3) }
+ (AnnParensHash (epTok $1) (epTok $3)) }
| '[' list ']' { ECP $ $2 (comb2 $1 $>) (glR $1,glR $3) }
| '_' { ECP $ mkHsWildCardPV (getLoc $1) }
=====================================
compiler/GHC/Parser/Annotation.hs
=====================================
@@ -552,12 +552,11 @@ data AnnListBrackets
-- Annotations for parenthesised elements, such as tuples, lists
-- ---------------------------------------------------------------------
--- | exact print annotation for an item having surrounding "brackets", such as
--- tuples or lists
+-- | exact print annotation for an item having parentheses, with or without
+-- the hash symbol, e.g. tuples, unboxed tuples, unboxed sums
data AnnParen
= AnnParens (EpToken "(") (EpToken ")") -- ^ '(', ')'
| AnnParensHash (EpToken "(#") (EpToken "#)") -- ^ '(#', '#)'
- | AnnParensSquare (EpToken "[") (EpToken "]") -- ^ '[', ']'
deriving Data
-- ---------------------------------------------------------------------
@@ -1219,7 +1218,6 @@ instance (Outputable e)
instance Outputable AnnParen where
ppr (AnnParens o c) = text "AnnParens" <+> ppr o <+> ppr c
ppr (AnnParensHash o c) = text "AnnParensHash" <+> ppr o <+> ppr c
- ppr (AnnParensSquare o c) = text "AnnParensSquare" <+> ppr o <+> ppr c
instance Outputable AnnListItem where
ppr (AnnListItem ts) = text "AnnListItem" <+> ppr ts
=====================================
compiler/GHC/Parser/PostProcess.hs
=====================================
@@ -1223,17 +1223,11 @@ checkContext orig_t@(L (EpAnn l _ cs) _orig_t) =
-- With NoListTuplePuns, contexts are parsed as data constructors, which causes failure
-- downstream.
-- This converts them just like when they are parsed as types in the punned case.
- check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (q,o,c) _ ts))
- = punsAllowed >>= \case
- True -> unprocessed
- False -> do
- let
- (op, cp) = case q of
- EpTok ql -> ([EpTok ql], [c])
- _ -> ([o], [c])
- mkCTuple (oparens ++ op, cp ++ cparens, cs) ts
+ check (oparens,cparens,cs) (L _l (HsExplicitTupleTy (_, AnnParens o c) NotPromoted ts))
+ = mkCTuple (oparens ++ [o], c : cparens, cs) ts
+
check (opi,cpi,csi) (L _lp1 (HsParTy (o,c) ty))
- -- to be sure HsParTy doesn't get into the way
+ -- to be sure HsParTy doesn't get in the way
= check (o:opi, c:cpi, csi) ty
-- No need for anns, returning original
@@ -1264,11 +1258,10 @@ checkContextExpr orig_expr@(L (EpAnn l _ cs) _) =
where
check :: ([EpToken "("],[EpToken ")"],EpAnnComments)
-> LHsExpr GhcPs -> PV (LocatedC [LHsExpr GhcPs])
- check (oparens,cparens,cs) (L _ (ExplicitTuple (ap_open, ap_close) tup_args boxity))
+ check (oparens,cparens,cs) (L _ (ExplicitTuple (AnnParens open_tok close_tok) tup_args Boxed))
-- Neither unboxed tuples (#e1,e2#) nor tuple sections (e1,,e2,) can be a context
- | isBoxed boxity
- , Just es <- tupArgsPresent_maybe tup_args
- = mkCTuple (oparens ++ [EpTok ap_open], EpTok ap_close : cparens, cs) es
+ | Just es <- tupArgsPresent_maybe tup_args
+ = mkCTuple (oparens ++ [open_tok], close_tok : cparens, cs) es
check (opi, cpi, csi) (L _ (HsPar (open_tok, close_tok) expr))
= check (opi ++ [open_tok], close_tok : cpi, csi) expr
check (oparens,cparens,cs) (L _ (HsVar _ (L (EpAnn _ (NameAnnOnly (NameParens open closed) []) _) name)))
@@ -1841,7 +1834,7 @@ class (b ~ (Body b) GhcPs, AnnoBody b) => DisambECP b where
mkHsBangPatPV :: SrcSpan -> LocatedA b -> EpToken "!" -> PV (LocatedA b)
-- | Disambiguate tuple sections and unboxed sums
mkSumOrTuplePV
- :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> (EpaLocation, EpaLocation) -> PV (LocatedA b)
+ :: SrcSpanAnnA -> Boxity -> SumOrTuple b -> AnnParen -> PV (LocatedA b)
-- | Disambiguate "type t" (embedded type)
mkHsEmbTyPV :: SrcSpan -> EpToken "type" -> LHsType GhcPs -> PV (LocatedA b)
-- | Validate infixexp LHS to reject unwanted {-# SCC ... #-} pragmas
@@ -3663,7 +3656,7 @@ hintBangPat span e = do
addError $ mkPlainErrorMsgEnvelope span $ PsErrIllegalBangPattern e
mkSumOrTupleExpr :: SrcSpanAnnA -> Boxity -> SumOrTuple (HsExpr GhcPs)
- -> (EpaLocation, EpaLocation)
+ -> AnnParen
-> PV (LHsExpr GhcPs)
-- Tuple
@@ -3678,15 +3671,15 @@ mkSumOrTupleExpr l@(EpAnn anc an csIn) boxity (Tuple es) anns = do
-- Sum
-- mkSumOrTupleExpr l Unboxed (Sum alt arity e) =
-- return $ L l (ExplicitSum noExtField alt arity e)
-mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) (o, c) = do
- let an = AnnExplicitSum o barsp barsa c
+mkSumOrTupleExpr l@(EpAnn anc anIn csIn) Unboxed (Sum alt arity e barsp barsa) anns = do
+ let an = AnnExplicitSum anns barsp barsa
!cs <- getCommentsFor (locA l)
return $ L (EpAnn anc anIn (csIn Semi.<> cs)) (ExplicitSum an alt arity e)
mkSumOrTupleExpr l Boxed a@Sum{} _ =
addFatalError $ mkPlainErrorMsgEnvelope (locA l) $ PsErrUnsupportedBoxedSumExpr a
mkSumOrTuplePat
- :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> (EpaLocation, EpaLocation)
+ :: SrcSpanAnnA -> Boxity -> SumOrTuple (PatBuilder GhcPs) -> AnnParen
-> PV (LocatedA (PatBuilder GhcPs))
-- Tuple
@@ -3842,7 +3835,7 @@ mkTupleSyntaxTy parOpen args parClose =
HsExplicitTupleTy annsKeyword NotPromoted args
annParen = AnnParens parOpen parClose
- annsKeyword = (NoEpTok, parOpen, parClose)
+ annsKeyword = (NoEpTok, annParen)
-- | Decide whether to parse tuple con syntax @(,)@ in a type as a
-- type or data constructor, based on the extension @ListTuplePuns@.
@@ -3894,7 +3887,7 @@ mkListSyntaxTy1 brkOpen t brkClose =
HsExplicitListTy annsKeyword NotPromoted [t]
annsKeyword = (NoEpTok, brkOpen, brkClose)
- annParen = AnnParensSquare brkOpen brkClose
+ annParen = (brkOpen, brkClose)
parseError :: HsExpr GhcPs
parseError = HsHole HoleError
=====================================
testsuite/tests/ghc-api/T25121_status.stdout
=====================================
@@ -18,8 +18,8 @@ X(ExplicitList) mismatch
>>> AnnList ()
<<< ((EpToken "'"),(EpToken "["),(EpToken "]"))
X(ExplicitTuple) mismatch
- >>> ((EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment]),(EpaLocation' [GenLocated (EpaLocation' NoComments) EpaComment]))
- <<< ((EpToken "'"),(EpToken "("),(EpToken ")"))
+ >>> AnnParen
+ <<< ((EpToken "'"),AnnParen)
X(Hole) mismatch
>>> HoleKind
<<< EpToken "_"
=====================================
testsuite/tests/parser/should_compile/DumpParsedAst.stderr
=====================================
@@ -265,7 +265,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpParsedAst.hs:9:16 }))
(EpTok
@@ -647,7 +647,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpParsedAst.hs:10:27 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
=====================================
@@ -596,7 +596,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:12:27 }))
(EpTok
@@ -701,7 +701,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:11:16 }))
(EpTok
@@ -1896,7 +1896,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:31:12 }))
(EpTok
@@ -1961,7 +1961,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { DumpRenamedAst.hs:32:10 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/KindSigs.stderr
=====================================
@@ -728,7 +728,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:19:12 }))
(EpTok
@@ -1417,13 +1417,14 @@
(EpaComments
[]))
(HsExplicitTupleTy
- ((,,)
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:28:16 }))
- (EpTok
- (EpaSpan { KindSigs.hs:28:17 }))
- (EpTok
- (EpaSpan { KindSigs.hs:28:44 })))
+ (AnnParens
+ (EpTok
+ (EpaSpan { KindSigs.hs:28:17 }))
+ (EpTok
+ (EpaSpan { KindSigs.hs:28:44 }))))
(IsPromoted)
[(L
(EpAnn
@@ -1501,7 +1502,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { KindSigs.hs:28:34 }))
(EpTok
=====================================
testsuite/tests/parser/should_compile/T20452.stderr
=====================================
@@ -453,7 +453,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { T20452.hs:8:57 }))
(EpTok
@@ -699,7 +699,7 @@
(EpaComments
[]))
(HsListTy
- (AnnParensSquare
+ ((,)
(EpTok
(EpaSpan { T20452.hs:9:57 }))
(EpTok
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -857,9 +857,6 @@ markParenO (AnnParens o c) = do
markParenO (AnnParensHash o c) = do
o' <- markEpToken o
return (AnnParensHash o' c)
-markParenO (AnnParensSquare o c) = do
- o' <- markEpToken o
- return (AnnParensSquare o' c)
markParenC :: (Monad m, Monoid w) => AnnParen -> EP w m AnnParen
markParenC (AnnParens o c) = do
@@ -868,9 +865,6 @@ markParenC (AnnParens o c) = do
markParenC (AnnParensHash o c) = do
c' <- markEpToken c
return (AnnParensHash o c')
-markParenC (AnnParensSquare o c) = do
- c' <- markEpToken c
- return (AnnParensSquare o c')
-- ---------------------------------------------------------------------
-- Bare bones Optics
@@ -1014,15 +1008,14 @@ lsnd k parent = fmap (\new -> (fst parent, new))
-- -------------------------------------
-- data AnnExplicitSum
-- = AnnExplicitSum {
--- aesOpen :: EpaLocation,
+-- aesParens :: AnnParen,
-- aesBarsBefore :: [EpToken "|"],
--- aesBarsAfter :: [EpToken "|"],
--- aesClose :: EpaLocation
+-- aesBarsAfter :: [EpToken "|"]
-- } deriving Data
-laesOpen :: Lens AnnExplicitSum EpaLocation
-laesOpen k parent = fmap (\new -> parent { aesOpen = new })
- (k (aesOpen parent))
+laesParens :: Lens AnnExplicitSum AnnParen
+laesParens k parent = fmap (\new -> parent { aesParens = new })
+ (k (aesParens parent))
laesBarsBefore :: Lens AnnExplicitSum [EpToken "|"]
laesBarsBefore k parent = fmap (\new -> parent { aesBarsBefore = new })
@@ -1032,10 +1025,6 @@ laesBarsAfter :: Lens AnnExplicitSum [EpToken "|"]
laesBarsAfter k parent = fmap (\new -> parent { aesBarsAfter = new })
(k (aesBarsAfter parent))
-laesClose :: Lens AnnExplicitSum EpaLocation
-laesClose k parent = fmap (\new -> parent { aesClose = new })
- (k (aesClose parent))
-
-- -------------------------------------
-- data AnnFieldLabel
-- = AnnFieldLabel {
@@ -1182,12 +1171,12 @@ lga_sep k parent = fmap (\new -> parent { ga_sep = new })
-- ---------------------------------------------------------------------
-- data EpAnnSumPat = EpAnnSumPat
--- { sumPatParens :: (EpaLocation, EpaLocation)
+-- { sumPatParens :: AnnParen
-- , sumPatVbarsBefore :: [EpToken "|"]
-- , sumPatVbarsAfter :: [EpToken "|"]
-- } deriving Data
-lsumPatParens :: Lens EpAnnSumPat (EpaLocation, EpaLocation)
+lsumPatParens :: Lens EpAnnSumPat AnnParen
lsumPatParens k parent = fmap (\new -> parent { sumPatParens = new })
(k (sumPatParens parent))
@@ -2929,23 +2918,21 @@ instance ExactPrint (HsExpr GhcPs) where
expr' <- markAnnotated expr
return (SectionR an op' expr')
- exact (ExplicitTuple (o,c) args b) = do
- o0 <- if b == Boxed then printStringAtAA o "("
- else printStringAtAA o "(#"
+ exact (ExplicitTuple an args b) = do
+ an0 <- markOpeningParen an
args' <- mapM markAnnotated args
- c0 <- if b == Boxed then printStringAtAA c ")"
- else printStringAtAA c "#)"
+ an1 <- markClosingParen an0
debugM $ "ExplicitTuple done"
- return (ExplicitTuple (o0,c0) args' b)
+ return (ExplicitTuple an1 args' b)
exact (ExplicitSum an alt arity expr) = do
- an0 <- markLensFun an laesOpen (\loc -> printStringAtAA loc "(#")
+ an0 <- markLensFun an laesParens markOpeningParen
an1 <- markLensFun an0 laesBarsBefore (\locs -> mapM markEpToken locs)
expr' <- markAnnotated expr
an2 <- markLensFun an1 laesBarsAfter (\locs -> mapM markEpToken locs)
- an3 <- markLensFun an2 laesClose (\loc -> printStringAtAA loc "#)")
+ an3 <- markLensFun an2 laesParens markClosingParen
return (ExplicitSum an3 alt arity expr')
exact (HsCase an e alts) = do
@@ -3954,11 +3941,11 @@ instance ExactPrint (HsType GhcPs) where
(mult', ty1') <- markMultAnnOf mult (markAnnotated ty1)
ty2' <- markAnnotated ty2
return (HsFunTy an mult' ty1' ty2')
- exact (HsListTy an tys) = do
- an0 <- markOpeningParen an
- tys' <- markAnnotated tys
- an1 <- markClosingParen an0
- return (HsListTy an1 tys')
+ exact (HsListTy (o,c) t) = do
+ o' <- markEpToken o
+ t' <- markAnnotated t
+ c' <- markEpToken c
+ return (HsListTy (o',c') t')
exact (HsTupleTy an con tys) = do
an0 <- markOpeningParen an
tys' <- markAnnotated tys
@@ -4010,14 +3997,14 @@ instance ExactPrint (HsType GhcPs) where
tys' <- markAnnotated tys
c' <- markEpToken c
return (HsExplicitListTy (sq',o',c') prom tys')
- exact (HsExplicitTupleTy (sq, o, c) prom tys) = do
+ exact (HsExplicitTupleTy (sq, an) prom tys) = do
sq' <- if (isPromoted prom)
then markEpToken sq
else return sq
- o' <- markEpToken o
+ an0 <- markOpeningParen an
tys' <- markAnnotated tys
- c' <- markEpToken c
- return (HsExplicitTupleTy (sq', o', c') prom tys')
+ an1 <- markClosingParen an0
+ return (HsExplicitTupleTy (sq', an1) prom tys')
exact (HsTyLit an lit) = do
lit' <- withPpr lit
return (HsTyLit an lit')
@@ -4688,22 +4675,18 @@ instance ExactPrint (Pat GhcPs) where
(an', pats') <- markAnnList' an (markAnnotated pats)
return (ListPat an' pats')
- exact (TuplePat (o,c) pats boxity) = do
- o0 <- case boxity of
- Boxed -> printStringAtAA o "("
- Unboxed -> printStringAtAA o "(#"
+ exact (TuplePat an pats boxity) = do
+ an0 <- markOpeningParen an
pats' <- markAnnotated pats
- c0 <- case boxity of
- Boxed -> printStringAtAA c ")"
- Unboxed -> printStringAtAA c "#)"
- return (TuplePat (o0,c0) pats' boxity)
+ an1 <- markClosingParen an0
+ return (TuplePat an1 pats' boxity)
exact (SumPat an pat alt arity) = do
- an0 <- markLensFun an (lsumPatParens . lfst) (\loc -> printStringAtAA loc "(#")
+ an0 <- markLensFun an lsumPatParens markOpeningParen
an1 <- markLensFun an0 lsumPatVbarsBefore (\locs -> mapM markEpToken locs)
pat' <- markAnnotated pat
an2 <- markLensFun an1 lsumPatVbarsAfter (\locs -> mapM markEpToken locs)
- an3 <- markLensFun an2 (lsumPatParens . lsnd) (\loc -> printStringAtAA loc "#)")
+ an3 <- markLensFun an2 lsumPatParens markClosingParen
return (SumPat an3 pat' alt arity)
exact (OrPat an pats) = do
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef641c0749cadb3badf2cb87ee9d76c15f96a8f7
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/ef641c0749cadb3badf2cb87ee9d76c15f96a8f7
You're receiving this email because of your account on gitlab.haskell.org.