Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC

Commits:

9 changed files:

Changes:

  • compiler/GHC/Builtin/Utils.hs
    ... ... @@ -301,7 +301,7 @@ ghcPrimWarns = WarnSome
    301 301 
       []
    302 302 
       where
    303 303 
         mk_txt msg =
    304 
    -      DeprecatedTxt NoSourceText [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText (fastStringToShortText msg)) []]
    304 
    +      DeprecatedTxt (NoSourceText, noAnn) [noLocA $ WithHsDocIdentifiers (StringLiteral NoSourceText (fastStringToShortText msg)) []]
    305 305 
         mk_decl_dep (occ, msg) = (occ, mk_txt msg)
    306 306
    307 307 
     ghcPrimFixities :: [(OccName,Fixity)]

  • compiler/GHC/Hs/Decls.hs
    ... ... @@ -1043,7 +1043,7 @@ cidDeprecation :: forall p. IsPass p
    1043 1043 
     cidDeprecation = fmap unLoc . decl_deprecation (ghcPass @p)
    1044 1044 
       where
    1045 1045 
         decl_deprecation :: GhcPass p  -> ClsInstDecl (GhcPass p)
    1046 
    -                     -> Maybe (LocatedP (WarningTxt (GhcPass p)))
    1046 
    +                     -> Maybe (LocatedA (WarningTxt (GhcPass p)))
    1047 1047 
         decl_deprecation GhcPs (ClsInstDecl{ cid_ext = (depr, _) } )
    1048 1048 
           = depr
    1049 1049 
         decl_deprecation GhcRn (ClsInstDecl{ cid_ext = (depr, _) })
    ... ... @@ -1242,7 +1242,7 @@ derivDeprecation :: forall p. IsPass p
    1242 1242 
     derivDeprecation = fmap unLoc . decl_deprecation (ghcPass @p)
    1243 1243 
       where
    1244 1244 
         decl_deprecation :: GhcPass p  -> DerivDecl (GhcPass p)
    1245 
    -                     -> Maybe (LocatedP (WarningTxt (GhcPass p)))
    1245 
    +                     -> Maybe (LocatedA (WarningTxt (GhcPass p)))
    1246 1246 
         decl_deprecation GhcPs (DerivDecl{ deriv_ext = (depr, _) })
    1247 1247 
           = depr
    1248 1248 
         decl_deprecation GhcRn (DerivDecl{ deriv_ext = (depr, _) })

  • compiler/GHC/Hs/Dump.hs
    ... ... @@ -99,7 +99,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    99 99 
                   `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
    100 100 
                   `ext2Q` located
    101 101 
                   `extQ` srcSpanAnnA
    102 
    -              `extQ` srcSpanAnnP
    103 102 
                   `extQ` srcSpanAnnN
    104 103 
                   `extQ` srcSpanAnnBF
    105 104
    ... ... @@ -409,9 +408,6 @@ showAstData bs ba a0 = blankLine $$ showAstData' a0
    409 408 
                 srcSpanAnnA :: EpAnn [TrailingAnn] -> SDoc
    410 409 
                 srcSpanAnnA = locatedAnn'' (text "SrcSpanAnnA")
    411 410
    412 
    -            srcSpanAnnP :: EpAnn AnnPragma -> SDoc
    413 
    -            srcSpanAnnP = locatedAnn'' (text "SrcSpanAnnP")
    414 
    -
    415 411 
                 srcSpanAnnN :: EpAnn NameAnn -> SDoc
    416 412 
                 srcSpanAnnN = locatedAnn'' (text "SrcSpanAnnN")
    417 413

  • compiler/GHC/Iface/Syntax.hs
    ... ... @@ -83,7 +83,7 @@ import GHC.Core.TyCon ( Role (..), Injectivity(..), tyConBndrVisForAllTyFlag )
    83 83 
     import GHC.Core.DataCon (SrcStrictness(..), SrcUnpackedness(..))
    84 84 
     import GHC.Builtin.Types ( constraintKindTyConName )
    85 85 
     import GHC.Stg.EnforceEpt.TagSig
    86 
    -import GHC.Parser.Annotation (noLocA)
    86 
    +import GHC.Parser.Annotation (noLocA, noAnn)
    87 87 
     import GHC.Hs.Extension ( GhcPass, GhcRn, GhcTc )
    88 88 
     import GHC.Hs.Decls.Overlap ( OverlapFlag )
    89 89 
     import GHC.Hs.Doc ( WithHsDocIdentifiers(..) )
    ... ... @@ -666,8 +666,8 @@ fromIfaceWarnings = \case
    666 666
    667 667 
     fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn
    668 668 
     fromIfaceWarningTxt = \case
    669 
    -    IfWarningTxt src mb_cat strs -> WarningTxt src (noLocA . fromWarningCategory <$> mb_cat) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    670 
    -    IfDeprecatedTxt src strs -> DeprecatedTxt src (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    669 
    +    IfWarningTxt src mb_cat strs -> WarningTxt (src, noAnn) (noLocA . fromWarningCategory <$> mb_cat) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    670 
    +    IfDeprecatedTxt src strs -> DeprecatedTxt (src, noAnn) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
    671 671
    672 672 
     fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers (StringLiteral GhcRn) GhcRn
    673 673 
     fromIfaceStringLiteralWithNames (str, names) = WithHsDocIdentifiers (fromIfaceStringLiteral str) (map noLocA names)

  • compiler/GHC/Iface/Warnings.hs
    ... ... @@ -22,12 +22,11 @@ toIfaceWarnings (WarnSome vs ds) = IfWarnSome vs' ds'
    22 22 
         ds' = [(occ, toIfaceWarningTxt txt) | (occ, txt) <- ds]
    23 23
    24 24 
     toIfaceWarningTxt :: WarningTxt GhcRn -> IfaceWarningTxt
    25 
    -toIfaceWarningTxt (WarningTxt src mb_cat strs) = IfWarningTxt src (unLoc . iwc_wc . unLoc <$> mb_cat) (map (toIfaceStringLiteralWithNames . unLoc) strs)
    26 
    -toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
    25 
    +toIfaceWarningTxt (WarningTxt (src, _) mb_cat strs) = IfWarningTxt src (unLoc . iwc_wc . unLoc <$> mb_cat) (map (toIfaceStringLiteralWithNames . unLoc) strs)
    26 
    +toIfaceWarningTxt (DeprecatedTxt (src, _) strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
    27 27
    28 28 
     toIfaceStringLiteralWithNames :: WithHsDocIdentifiers (StringLiteral GhcRn) GhcRn -> (IfaceStringLiteral, [IfExtName])
    29 29 
     toIfaceStringLiteralWithNames (WithHsDocIdentifiers src names) = (toIfaceStringLiteral src, map unLoc names)
    30 30
    31 31 
     toIfaceStringLiteral :: StringLiteral GhcRn -> IfaceStringLiteral
    32 
    -toIfaceStringLiteral sLit =
    33 
    -  IfStringLiteral (stringLitSourceText sLit) (sl_fs sLit)
    32 
    +toIfaceStringLiteral sLit = IfStringLiteral (stringLitSourceText sLit) (sl_fs sLit)

  • compiler/GHC/Parser.y
    ... ... @@ -2077,11 +2077,13 @@ to varid (used for rule_vars), 'checkRuleTyVarBndrNames' must be updated.
    2077 2077
    2078 2078 
     maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
    2079 2079 
             : '{-# DEPRECATED' strings '#-}'
    2080 
    -                            {% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (snd $ unLoc $2))
    2081 
    -                                (AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn) }
    2080 
    +                            {% fmap Just $ amsA' (sLL $1 $> $
    2081 
    +                                DeprecatedTxt (getDEPRECATED_PRAGs $1, AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn)
    2082 
    +                                              (snd $ unLoc $2))}
    2082 2083 
             | '{-# WARNING' warning_category strings '#-}'
    2083 
    -                            {% fmap Just $ amsr (sLL $1 $> $ WarningTxt (getWARNING_PRAGs $1) $2 (snd $ unLoc $3))
    2084 
    -                                (AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)}
    2084 
    +                            {% fmap Just $ amsA' (sLL $1 $> $
    2085 
    +                                WarningTxt (getWARNING_PRAGs $1, AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)
    2086 
    +                                           $2 (snd $ unLoc $3))}
    2085 2087 
             |  {- empty -}      { Nothing }
    2086 2088
    2087 2089 
     warning_category :: { Maybe (LocatedE (InWarningCategory GhcPs)) }
    ... ... @@ -2110,7 +2112,7 @@ warning :: { OrdList (LWarnDecl GhcPs) }
    2110 2112 
             : warning_category namespace_spec namelist strings
    2111 2113 
                     {% fmap unitOL $ amsA' (L (comb4 $1 $2 $3 $4)
    2112 2114 
                          (Warning (fst $ unLoc $4) (unLoc $2) (unLoc $3)
    2113 
    -                              (WarningTxt NoSourceText $1 (snd $ unLoc $4)))) }
    2115 
    +                              (WarningTxt (NoSourceText, noAnn) $1 (snd $ unLoc $4)))) }
    2114 2116
    2115 2117 
     namespace_spec :: { Located (NamespaceSpecifier GhcPs) }
    2116 2118 
       : 'type'      { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }
    ... ... @@ -2138,7 +2140,7 @@ deprecations :: { OrdList (LWarnDecl GhcPs) }
    2138 2140 
     deprecation :: { OrdList (LWarnDecl GhcPs) }
    2139 2141 
             : namespace_spec namelist strings
    2140 2142 
                  {% fmap unitOL $ amsA' (sL (comb3 $1 $2 $>) $ (Warning (fst $ unLoc $3) (unLoc $1) (unLoc $2)
    2141 
    -                                          (DeprecatedTxt NoSourceText $ snd $ unLoc $3))) }
    2143 
    +                                          (DeprecatedTxt (NoSourceText, noAnn) $ snd $ unLoc $3))) }
    2142 2144
    2143 2145 
     strings :: { Located ((EpToken "[", EpToken "]"), [LocatedA (WithHsDocIdentifiers (StringLiteral GhcPs) GhcPs)]) }
    2144 2146 
         : STRING             { sL1 $1 (noAnn,[stringLiteralToHsDocWst (L (gl $1) (getStringLiteral $1))]) }

  • compiler/GHC/Parser/Annotation.hs
    ... ... @@ -27,9 +27,9 @@ module GHC.Parser.Annotation (
    27 27 
       EpAnnCO,
    28 28
    29 29 
       -- ** Annotations in 'GenLocated'
    30 
    -  LocatedA, LocatedN, LocatedAn, LocatedP,
    30 
    +  LocatedA, LocatedN, LocatedAn,
    31 31 
       LocatedE, LocatedBF,
    32 
    -  SrcSpanAnnA, SrcSpanAnnP, SrcSpanAnnN,
    32 
    +  SrcSpanAnnA, SrcSpanAnnN,
    33 33 
       SrcSpanAnnBF,
    34 34
    35 35 
       -- ** Annotation data types used in 'GenLocated'
    ... ... @@ -430,7 +430,6 @@ emptyComments = EpaComments []
    430 430 
     type LocatedA = GenLocated SrcSpanAnnA
    431 431 
     type LocatedN = GenLocated SrcSpanAnnN
    432 432
    433 
    -type LocatedP = GenLocated SrcSpanAnnP
    434 433 
     type LocatedBF = GenLocated SrcSpanAnnBF
    435 434
    436 435 
     -- | Annotation for items appearing in a list. They can have one or
    ... ... @@ -441,7 +440,6 @@ type SrcSpanAnnA = EpAnn [TrailingAnn]
    441 440 
     -- on the context, such as backticks.
    442 441 
     type SrcSpanAnnN = EpAnn NameAnn
    443 442
    444 
    -type SrcSpanAnnP = EpAnn AnnPragma
    445 443 
     type SrcSpanAnnBF = EpAnn AnnBooleanFormula
    446 444
    447 445 
     type LocatedE = GenLocated EpaLocation

  • compiler/GHC/Unit/Module/Warnings.hs
    ... ... @@ -158,8 +158,8 @@ warningTxtSame w1 w2
    158 158 
     instance Outputable (InWarningCategory (GhcPass pass)) where
    159 159 
       ppr (InWarningCategory _ wt) = text "in" <+> doubleQuotes (ppr wt)
    160 160
    161 
    -type instance XDeprecatedTxt       (GhcPass _) = SourceText
    162 
    -type instance XWarningTxt          (GhcPass _) = SourceText
    161 
    +type instance XDeprecatedTxt       (GhcPass _) = (SourceText, AnnPragma)
    162 
    +type instance XWarningTxt          (GhcPass _) = (SourceText, AnnPragma)
    163 163 
     type instance XXWarningTxt         (GhcPass _) = DataConCantHappen
    164 164 
     type instance XInWarningCategory   (GhcPass _) = (EpToken "in", SourceText)
    165 165 
     type instance XXInWarningCategory  (GhcPass _) = DataConCantHappen
    ... ... @@ -167,7 +167,7 @@ type instance XXInWarningCategory (GhcPass _) = DataConCantHappen
    167 167 
     type instance Anno (WithHsDocIdentifiers (StringLiteral pass) pass) = SrcSpanAnnA
    168 168 
     type instance Anno (InWarningCategory (GhcPass pass)) = EpaLocation
    169 169 
     type instance Anno (WarningCategory) = EpaLocation
    170 
    -type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
    170 
    +type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnA
    171 171
    172 172 
     deriving stock instance Eq (WarningTxt GhcPs)
    173 173 
     deriving stock instance Eq (WarningTxt GhcRn)
    ... ... @@ -190,15 +190,15 @@ deriving instance Outputable WarningCategory
    190 190 
     instance Outputable (WarningTxt (GhcPass pass)) where
    191 191 
         ppr (WarningTxt lsrc mcat ws)
    192 192 
           = case lsrc of
    193 
    -            NoSourceText   -> pp_ws ws
    194 
    -            SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
    193 
    +            (NoSourceText, _)   -> pp_ws ws
    194 
    +            (SourceText src, _) -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
    195 195 
             where
    196 196 
               ctg_doc = maybe empty (\ctg -> ppr ctg) mcat
    197 197
    198 198 
         ppr (DeprecatedTxt lsrc ds)
    199 199 
           = case lsrc of
    200 
    -          NoSourceText   -> pp_ws ds
    201 
    -          SourceText src -> ftext src <+> pp_ws ds <+> text "#-}"
    200 
    +          (NoSourceText, _)   -> pp_ws ds
    201 
    +          (SourceText src, _) -> ftext src <+> pp_ws ds <+> text "#-}"
    202 202
    203 203 
     pp_ws :: [LocatedA (WithHsDocIdentifiers (StringLiteral (GhcPass p)) (GhcPass p))] -> SDoc
    204 204 
     pp_ws [l] = ppr $ unLoc l

  • utils/check-exact/ExactPrint.hs
    ... ... @@ -1555,26 +1555,26 @@ instance ExactPrint ModuleName where
    1555 1555
    1556 1556 
     -- ---------------------------------------------------------------------
    1557 1557
    1558 
    -instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
    1559 
    -  getAnnotationEntry = entryFromLocatedA
    1560 
    -  setAnnotationAnchor = setAnchorAn
    1558 
    +instance ExactPrint (WarningTxt GhcPs) where
    1559 
    +  getAnnotationEntry _ = NoEntryVal
    1560 
    +  setAnnotationAnchor a _ _ _ = a
    1561 1561
    1562 
    -  exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (WarningTxt src mb_cat ws)) = do
    1562 
    +  exact (WarningTxt (src, AnnPragma o c (os,cs) l1 l2 t m) mb_cat ws) = do
    1563 1563 
         o' <- markAnnOpen'' o src "{-# WARNING"
    1564 1564 
         mb_cat' <- markAnnotated mb_cat
    1565 1565 
         os' <- markEpToken os
    1566 1566 
         ws' <- mapM markAnnotated ws
    1567 1567 
         cs' <- markEpToken cs
    1568 1568 
         c' <- markEpToken c
    1569 
    -    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (WarningTxt src mb_cat' ws'))
    1569 
    +    return (WarningTxt (src, AnnPragma o' c' (os',cs') l1 l2 t m) mb_cat' ws')
    1570 1570
    1571 
    -  exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (DeprecatedTxt src ws)) = do
    1571 
    +  exact (DeprecatedTxt (src, AnnPragma o c (os,cs) l1 l2 t m) ws) = do
    1572 1572 
         o' <- markAnnOpen'' o src "{-# DEPRECATED"
    1573 1573 
         os' <- markEpToken os
    1574 1574 
         ws' <- mapM markAnnotated ws
    1575 1575 
         cs' <- markEpToken cs
    1576 1576 
         c' <- markEpToken c
    1577 
    -    return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (DeprecatedTxt src ws'))
    1577 
    +    return (DeprecatedTxt (src, AnnPragma o' c' (os',cs') l1 l2 t m) ws')
    1578 1578
    1579 1579 
     instance ExactPrint (InWarningCategory GhcPs) where
    1580 1580 
       getAnnotationEntry _ = NoEntryVal

    • —
    View it on GitLab.
    You're receiving this email because of your account on gitlab.haskell.org. Manage all notifications · Help Notification message regarding https://gitlab.haskell.org/ghc/ghc/-/commit/b14d8d59d50527c8b396a3b768d6b92da6e398c9 at 1785956199