[Git][ghc/ghc][master] EPA: Store leading AnnSemi for decllist in al_rest
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Mon Jul 17 06:49:28 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
654fdb98 by Alan Zimmerman at 2023-07-17T02:48:55-04:00
EPA: Store leading AnnSemi for decllist in al_rest
This simplifies the markAnnListA implementation in ExactPrint
- - - - -
4 changed files:
- compiler/GHC/Parser.y
- compiler/GHC/Parser/PostProcess.hs
- testsuite/tests/parser/should_compile/DumpSemis.stderr
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
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)
=====================================
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.
=====================================
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
=====================================
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
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/654fdb989d44e9bdc961f9af7b8171c551b37151
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/654fdb989d44e9bdc961f9af7b8171c551b37151
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230717/deb5b368/attachment-0001.html>
More information about the ghc-commits
mailing list