[Git][ghc/ghc][master] EPA: Remove Location from WarningTxt source
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Wed Aug 9 01:28:28 UTC 2023
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
6eab07b2 by Alan Zimmerman at 2023-08-08T21:28:10-04:00
EPA: Remove Location from WarningTxt source
This is not needed.
- - - - -
5 changed files:
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Parser.y
- compiler/GHC/Unit/Module/Warnings.hs
- utils/check-exact/ExactPrint.hs
Changes:
=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -406,8 +406,8 @@ toIfaceWarnings (WarnSome vs ds) = IfWarnSome vs' ds'
ds' = [(occ, toIfaceWarningTxt txt) | (occ, txt) <- ds]
toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
-toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs)
-toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt (unLoc src) (map (toIfaceStringLiteralWithNames . unLoc) strs)
+toIfaceWarningTxt (WarningTxt mb_cat src strs) = IfWarningTxt (unLoc <$> mb_cat) src (map (toIfaceStringLiteralWithNames . unLoc) strs)
+toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName])
toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names)
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -595,8 +595,8 @@ fromIfaceWarnings = \case
fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn
fromIfaceWarningTxt = \case
- IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs)
- IfDeprecatedTxt src strs -> DeprecatedTxt (noLoc src) (noLoc <$> map fromIfaceStringLiteralWithNames strs)
+ IfWarningTxt mb_cat src strs -> WarningTxt (noLoc <$> mb_cat) src (noLoc <$> map fromIfaceStringLiteralWithNames strs)
+ IfDeprecatedTxt src strs -> DeprecatedTxt src (noLoc <$> map fromIfaceStringLiteralWithNames strs)
fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn
fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLoc names)
=====================================
compiler/GHC/Parser.y
=====================================
@@ -1971,10 +1971,10 @@ to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
: '{-# DEPRECATED' strings '#-}'
- {% fmap Just $ amsrp (sLL $1 $> $ DeprecatedTxt (sL1 $1 $ getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
+ {% fmap Just $ amsrp (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
(AnnPragma (mo $1) (mc $3) (fst $ unLoc $2)) }
| '{-# WARNING' warning_category strings '#-}'
- {% fmap Just $ amsrp (sLL $1 $> $ WarningTxt $2 (sL1 $1 $ getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))
+ {% fmap Just $ amsrp (sLL $1 $> $ WarningTxt $2 (getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))
(AnnPragma (mo $1) (mc $4) (fst $ unLoc $3))}
| {- empty -} { Nothing }
@@ -2003,7 +2003,7 @@ warning :: { OrdList (LWarnDecl GhcPs) }
: warning_category namelist strings
{% fmap unitOL $ acsA (\cs -> sLL $2 $>
(Warning (EpAnn (glR $2) (fst $ unLoc $3) cs) (unLoc $2)
- (WarningTxt $1 (noLoc NoSourceText) $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }
+ (WarningTxt $1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $3))) }
deprecations :: { OrdList (LWarnDecl GhcPs) }
: deprecations ';' deprecation
@@ -2026,7 +2026,7 @@ deprecations :: { OrdList (LWarnDecl GhcPs) }
deprecation :: { OrdList (LWarnDecl GhcPs) }
: namelist strings
{% fmap unitOL $ acsA (\cs -> sLL $1 $> $ (Warning (EpAnn (glR $1) (fst $ unLoc $2) cs) (unLoc $1)
- (DeprecatedTxt (noLoc NoSourceText) $ map stringLiteralToHsDocWst $ snd $ unLoc $2))) }
+ (DeprecatedTxt NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $2))) }
strings :: { Located ([AddEpAnn],[Located StringLiteral]) }
: STRING { sL1 $1 ([],[L (gl $1) (getStringLiteral $1)]) }
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -192,10 +192,10 @@ data WarningTxt pass
(Maybe (Located WarningCategory))
-- ^ Warning category attached to this WARNING pragma, if any;
-- see Note [Warning categories]
- (Located SourceText)
+ SourceText
[Located (WithHsDocIdentifiers StringLiteral pass)]
| DeprecatedTxt
- (Located SourceText)
+ SourceText
[Located (WithHsDocIdentifiers StringLiteral pass)]
deriving Generic
@@ -229,7 +229,7 @@ deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
instance Outputable (WarningTxt pass) where
ppr (WarningTxt mcat lsrc ws)
- = case unLoc lsrc of
+ = case lsrc of
NoSourceText -> pp_ws ws
SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
where
@@ -237,7 +237,7 @@ instance Outputable (WarningTxt pass) where
ppr (DeprecatedTxt lsrc ds)
- = case unLoc lsrc of
+ = case lsrc of
NoSourceText -> pp_ws ds
SourceText src -> ftext src <+> pp_ws ds <+> text "#-}"
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -1408,21 +1408,21 @@ instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
getAnnotationEntry = entryFromLocatedA
setAnnotationAnchor = setAnchorAn
- exact (L (SrcSpanAnn an l) (WarningTxt mb_cat (L la src) ws)) = do
+ exact (L (SrcSpanAnn an l) (WarningTxt mb_cat src ws)) = do
an0 <- markAnnOpenP an src "{-# WARNING"
an1 <- markEpAnnL an0 lapr_rest AnnOpenS
ws' <- markAnnotated ws
an2 <- markEpAnnL an1 lapr_rest AnnCloseS
an3 <- markAnnCloseP an2
- return (L (SrcSpanAnn an3 l) (WarningTxt mb_cat (L la src) ws'))
+ return (L (SrcSpanAnn an3 l) (WarningTxt mb_cat src ws'))
- exact (L (SrcSpanAnn an l) (DeprecatedTxt (L ls src) ws)) = do
+ exact (L (SrcSpanAnn an l) (DeprecatedTxt src ws)) = do
an0 <- markAnnOpenP an src "{-# DEPRECATED"
an1 <- markEpAnnL an0 lapr_rest AnnOpenS
ws' <- markAnnotated ws
an2 <- markEpAnnL an1 lapr_rest AnnCloseS
an3 <- markAnnCloseP an2
- return (L (SrcSpanAnn an3 l) (DeprecatedTxt (L ls src) ws'))
+ return (L (SrcSpanAnn an3 l) (DeprecatedTxt src ws'))
-- ---------------------------------------------------------------------
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6eab07b26ee46813683a8409871132d740805ec6
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/6eab07b26ee46813683a8409871132d740805ec6
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/20230808/0eae5472/attachment-0001.html>
More information about the ghc-commits
mailing list