[Git][ghc/ghc][wip/az/epa-remove-loc-from-warningtxt] EPA: Remove Location from WarningTxt source

Alan Zimmerman (@alanz) gitlab at gitlab.haskell.org
Mon Aug 7 20:11:16 UTC 2023



Alan Zimmerman pushed to branch wip/az/epa-remove-loc-from-warningtxt at Glasgow Haskell Compiler / GHC


Commits:
7f705531 by Alan Zimmerman at 2023-08-07T21:11:00+01: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/7f7055318ac74086a33165fc3838c9246be92261

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/7f7055318ac74086a33165fc3838c9246be92261
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/20230807/5b823b4f/attachment-0001.html>


More information about the ghc-commits mailing list