From 654fdb989d44e9bdc961f9af7b8171c551b37151 Mon Sep 17 00:00:00 2001
From: Alan Zimmerman <alan.zimm@gmail.com>
Date: Sat, 1 Jul 2023 18:52:57 +0100
Subject: [PATCH] EPA: Store leading AnnSemi for decllist in al_rest
This simplifies the markAnnListA implementation in ExactPrint
---
compiler/GHC/Parser.y | 17 ++++---
compiler/GHC/Parser/PostProcess.hs | 2 +-
.../parser/should_compile/DumpSemis.stderr | 17 +++----
utils/check-exact/ExactPrint.hs | 47 +++++++++----------
4 files changed, 38 insertions(+), 45 deletions(-)
diff --git a/compiler/GHC/Parser.y b/compiler/GHC/Parser.y
index 0624df411477..1c1c04816341 100644
--- a/compiler/GHC/Parser.y
+++ b/compiler/GHC/Parser.y
@@ -1707,9 +1707,9 @@ cvars1 :: { [RecordPatSynField GhcPs] }
where_decls :: { LocatedL (OrdList (LHsDecl GhcPs)) }
: 'where' '{' decls '}' {% amsrl (sLL $1 $> (snd $ unLoc $3))
- (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) [mj AnnWhere $1] (fst $ unLoc $3)) }
+ (AnnList (Just $ glR $3) (Just $ moc $2) (Just $ mcc $4) (mj AnnWhere $1: (fst $ unLoc $3)) []) }
| 'where' vocurly decls close {% amsrl (sLL $1 $3 (snd $ unLoc $3))
- (AnnList (Just $ glR $3) Nothing Nothing [mj AnnWhere $1] (fst $ unLoc $3))}
+ (AnnList (Just $ glR $3) Nothing Nothing (mj AnnWhere $1: (fst $ unLoc $3)) []) }
pattern_synonym_sig :: { LSig GhcPs }
: 'pattern' con_list '::' sigtype
@@ -1822,9 +1822,9 @@ where_inst :: { Located ([AddEpAnn]
-- Declarations in binding groups other than classes and instances
--
-decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) }
+decls :: { Located ([AddEpAnn], OrdList (LHsDecl GhcPs)) }
: decls ';' decl {% if isNilOL (snd $ unLoc $1)
- then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemi $2)
+ then return (sLL $1 $> ((fst $ unLoc $1) ++ (msemiA $2)
, unitOL $3))
else case (snd $ unLoc $1) of
SnocOL hs t -> do
@@ -1835,7 +1835,7 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) }
return (rest `seq` this `seq` these `seq`
(sLL $1 $> (fst $ unLoc $1, these))) }
| decls ';' {% if isNilOL (snd $ unLoc $1)
- then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemi $2)
+ then return (sLL $1 $> (((fst $ unLoc $1) ++ (msemiA $2)
,snd $ unLoc $1)))
else case (snd $ unLoc $1) of
SnocOL hs t -> do
@@ -1846,9 +1846,9 @@ decls :: { Located ([TrailingAnn], OrdList (LHsDecl GhcPs)) }
| {- empty -} { noLoc ([],nilOL) }
decllist :: { Located (AnnList,Located (OrdList (LHsDecl GhcPs))) }
- : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) [] (fst $ unLoc $2)
+ : '{' decls '}' { sLL $1 $> (AnnList (Just $ glR $2) (Just $ moc $1) (Just $ mcc $3) (fst $ unLoc $2) []
,sL1 $2 $ snd $ unLoc $2) }
- | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing [] (fst $ unLoc $2)
+ | vocurly decls close { L (gl $2) (AnnList (Just $ glR $2) Nothing Nothing (fst $ unLoc $2) []
,sL1 $2 $ snd $ unLoc $2) }
-- Binding groups other than those of class and instance declarations
@@ -4282,6 +4282,9 @@ mz a l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn a (srcSpan2e $ gl l)]
msemi :: Located e -> [TrailingAnn]
msemi l = if isZeroWidthSpan (gl l) then [] else [AddSemiAnn (srcSpan2e $ gl l)]
+msemiA :: Located e -> [AddEpAnn]
+msemiA l = if isZeroWidthSpan (gl l) then [] else [AddEpAnn AnnSemi (srcSpan2e $ gl l)]
+
msemim :: Located e -> Maybe EpaLocation
msemim l = if isZeroWidthSpan (gl l) then Nothing else Just (srcSpan2e $ gl l)
diff --git a/compiler/GHC/Parser/PostProcess.hs b/compiler/GHC/Parser/PostProcess.hs
index 8c665027e518..58758234083c 100644
--- a/compiler/GHC/Parser/PostProcess.hs
+++ b/compiler/GHC/Parser/PostProcess.hs
@@ -497,7 +497,7 @@ patch_anchor r1 (Anchor r0 op) = Anchor r op
fixValbindsAnn :: EpAnn AnnList -> EpAnn AnnList
fixValbindsAnn EpAnnNotUsed = EpAnnNotUsed
fixValbindsAnn (EpAnn anchor (AnnList ma o c r t) cs)
- = (EpAnn (widenAnchor anchor (map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs)
+ = (EpAnn (widenAnchor anchor (r ++ map trailingAnnToAddEpAnn t)) (AnnList ma o c r t) cs)
-- | The 'Anchor' for a stmtlist is based on either the location or
-- the first semicolon annotion.
diff --git a/testsuite/tests/parser/should_compile/DumpSemis.stderr b/testsuite/tests/parser/should_compile/DumpSemis.stderr
index 895bb5f4d042..cc79e18986a5 100644
--- a/testsuite/tests/parser/should_compile/DumpSemis.stderr
+++ b/testsuite/tests/parser/should_compile/DumpSemis.stderr
@@ -1517,17 +1517,12 @@
(AddEpAnn AnnOpenC (EpaSpan { DumpSemis.hs:34:13 })))
(Just
(AddEpAnn AnnCloseC (EpaSpan { DumpSemis.hs:34:31 })))
- []
- [(AddSemiAnn
- (EpaSpan { DumpSemis.hs:34:14 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:34:15 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:34:16 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:34:17 }))
- ,(AddSemiAnn
- (EpaSpan { DumpSemis.hs:34:18 }))])
+ [(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:14 }))
+ ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:15 }))
+ ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:16 }))
+ ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:17 }))
+ ,(AddEpAnn AnnSemi (EpaSpan { DumpSemis.hs:34:18 }))]
+ [])
(EpaComments
[]))
(ValBinds
diff --git a/utils/check-exact/ExactPrint.hs b/utils/check-exact/ExactPrint.hs
index 7cd8d18d994d..4ac3e406bb44 100644
--- a/utils/check-exact/ExactPrint.hs
+++ b/utils/check-exact/ExactPrint.hs
@@ -1176,32 +1176,27 @@ markKwT (AddVbarAnn ss) = AddVbarAnn <$> markKwA AnnVbar ss
-- ---------------------------------------------------------------------
markAnnList :: (Monad m, Monoid w)
- => Bool -> EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
-markAnnList reallyTrail ann action = do
- markAnnListA reallyTrail ann $ \a -> do
+ => EpAnn AnnList -> EP w m a -> EP w m (EpAnn AnnList, a)
+markAnnList ann action = do
+ markAnnListA ann $ \a -> do
r <- action
return (a,r)
markAnnListA :: (Monad m, Monoid w)
- => Bool -> EpAnn AnnList
+ => EpAnn AnnList
-> (EpAnn AnnList -> EP w m (EpAnn AnnList, a))
-> EP w m (EpAnn AnnList, a)
-markAnnListA _ EpAnnNotUsed action = do
+markAnnListA EpAnnNotUsed action = do
action EpAnnNotUsed
-markAnnListA reallyTrail an action = do
+markAnnListA an action = do
debugM $ "markAnnListA: an=" ++ showAst an
an0 <- markLensMAA an lal_open
- an1 <- if (not reallyTrail)
- then markTrailingL an0 lal_trailing
- else return an0
- an2 <- markEpAnnAllL an1 lal_rest AnnSemi
- (an3, r) <- action an2
- an4 <- markLensMAA an3 lal_close
- an5 <- if reallyTrail
- then markTrailingL an4 lal_trailing
- else return an4
- debugM $ "markAnnListA: an5=" ++ showAst an
- return (an5, r)
+ an1 <- markEpAnnAllL an0 lal_rest AnnSemi
+ (an2, r) <- action an1
+ an3 <- markLensMAA an2 lal_close
+ an4 <- markTrailingL an3 lal_trailing
+ debugM $ "markAnnListA: an4=" ++ showAst an
+ return (an4, r)
-- ---------------------------------------------------------------------
@@ -2297,12 +2292,12 @@ instance ExactPrint (HsLocalBinds GhcPs) where
when (not $ isEmptyValBinds valbinds) $ setExtraDP (Just anc)
_ -> return ()
- (an1, valbinds') <- markAnnList False an0 $ markAnnotatedWithLayout valbinds
+ (an1, valbinds') <- markAnnList an0 $ markAnnotatedWithLayout valbinds
debugM $ "exact HsValBinds: an1=" ++ showAst an1
return (HsValBinds an1 valbinds')
exact (HsIPBinds an bs) = do
- (as, ipb) <- markAnnList True an (markEpAnnL an lal_rest AnnWhere
+ (as, ipb) <- markAnnList an (markEpAnnL an lal_rest AnnWhere
>> markAnnotated bs
>>= \bs' -> return (HsIPBinds an bs'::HsLocalBinds GhcPs))
case ipb of
@@ -2845,7 +2840,7 @@ instance ExactPrint (HsExpr GhcPs) where
exact (HsDo an do_or_list_comp stmts) = do
debugM $ "HsDo"
- (an',stmts') <- markAnnListA True an $ \a -> exactDo a do_or_list_comp stmts
+ (an',stmts') <- markAnnListA an $ \a -> exactDo a do_or_list_comp stmts
return (HsDo an' do_or_list_comp stmts')
exact (ExplicitList an es) = do
@@ -3379,7 +3374,7 @@ instance (
exact (RecStmt an stmts a b c d e) = do
debugM $ "RecStmt"
an0 <- markEpAnnL an lal_rest AnnRec
- (an1, stmts') <- markAnnList True an0 (markAnnotated stmts)
+ (an1, stmts') <- markAnnList an0 (markAnnotated stmts)
return (RecStmt an1 stmts' a b c d e)
-- ---------------------------------------------------------------------
@@ -4400,7 +4395,7 @@ instance ExactPrint (LocatedL [LocatedA (IE GhcPs)]) where
an0 <- markEpAnnL an lal_rest AnnHiding
p <- getPosP
debugM $ "LocatedL [LIE:p=" ++ showPprUnsafe p
- (an1, ies') <- markAnnList True an0 (markAnnotated ies)
+ (an1, ies') <- markAnnList an0 (markAnnotated ies)
return (L (SrcSpanAnn an1 l) ies')
instance (ExactPrint (Match GhcPs (LocatedA body)))
@@ -4423,7 +4418,7 @@ instance ExactPrint (LocatedL [LocatedA (StmtLR GhcPs GhcPs (LocatedA (HsExpr Gh
setAnnotationAnchor = setAnchorAn
exact (L (SrcSpanAnn an l) stmts) = do
debugM $ "LocatedL [ExprLStmt"
- (an'', stmts') <- markAnnList True an $ do
+ (an'', stmts') <- markAnnList an $ do
case snocView stmts of
Just (initStmts, ls@(L _ (LastStmt _ _body _ _))) -> do
debugM $ "LocatedL [ExprLStmt: snocView"
@@ -4450,7 +4445,7 @@ instance ExactPrint (LocatedL [LocatedA (ConDeclField GhcPs)]) where
setAnnotationAnchor = setAnchorAn
exact (L (SrcSpanAnn an l) fs) = do
debugM $ "LocatedL [LConDeclField"
- (an', fs') <- markAnnList True an (markAnnotated fs)
+ (an', fs') <- markAnnList an (markAnnotated fs)
return (L (SrcSpanAnn an' l) fs')
instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
@@ -4458,7 +4453,7 @@ instance ExactPrint (LocatedL (BF.BooleanFormula (LocatedN RdrName))) where
setAnnotationAnchor = setAnchorAn
exact (L (SrcSpanAnn an l) bf) = do
debugM $ "LocatedL [LBooleanFormula"
- (an', bf') <- markAnnList True an (markAnnotated bf)
+ (an', bf') <- markAnnList an (markAnnotated bf)
return (L (SrcSpanAnn an' l) bf')
-- ---------------------------------------------------------------------
@@ -4616,7 +4611,7 @@ instance ExactPrint (Pat GhcPs) where
return (BangPat an0 pat')
exact (ListPat an pats) = do
- (an', pats') <- markAnnList True an (markAnnotated pats)
+ (an', pats') <- markAnnList an (markAnnotated pats)
return (ListPat an' pats')
exact (TuplePat an pats boxity) = do
--
GitLab