recursion-ninja pushed to branch wip/fix-26636 at Glasgow Haskell Compiler / GHC
Commits:
2c2a3ef3 by Cheng Shao at 2025-12-15T11:51:53-05:00
docs: drop obsolete warning about -fexternal-interpreter on windows
This patch drops an obsolete warning about -fexternal-interpreter not
supported on windows; it is supported since a long time ago, including
the profiled way.
- - - - -
68573aa5 by Marc Scholten at 2025-12-15T11:53:00-05:00
haddock: Drop Haddock.Backends.HaddockDB as it's unused
- - - - -
966b38e1 by Recursion Ninja at 2025-12-16T10:26:16-05:00
Removing the 'Data' instance for 'InstEnv'.
The 'Data' instance is blocking work on Trees that Grow, and the
'Data' instance seem to have been added without a clear purpose.
- - - - -
d9ed19cf by Recursion Ninja at 2025-12-16T10:26:40-05:00
'Decouple Language.Haskell.Syntax.Decls' from 'GHC.Unit.Module.Warnings'
- - - - -
26 changed files:
- compiler/GHC/Builtin/Utils.hs
- compiler/GHC/Core/InstEnv.hs
- compiler/GHC/Hs/Decls.hs
- compiler/GHC/Hs/Instances.hs
- compiler/GHC/Iface/Syntax.hs
- compiler/GHC/Iface/Warnings.hs
- compiler/GHC/Parser.y
- compiler/GHC/Rename/Module.hs
- compiler/GHC/Rename/Utils.hs
- compiler/GHC/Tc/Deriv.hs
- compiler/GHC/Tc/Deriv/Utils.hs
- compiler/GHC/Tc/Errors/Ppr.hs
- compiler/GHC/Tc/Errors/Types.hs
- compiler/GHC/Tc/Types/Origin.hs
- compiler/GHC/Tc/Utils/Instantiate.hs
- compiler/GHC/Types/DefaultEnv.hs
- compiler/GHC/Types/Error/Codes.hs
- compiler/GHC/Unit/Module/Warnings.hs
- compiler/Language/Haskell/Syntax/Decls.hs
- compiler/Language/Haskell/Syntax/Extension.hs
- docs/users_guide/ghci.rst
- testsuite/tests/diagnostic-codes/codes.stdout
- utils/check-exact/ExactPrint.hs
- utils/haddock/haddock-api/haddock-api.cabal
- − utils/haddock/haddock-api/src/Haddock/Backends/HaddockDB.hs
- utils/haddock/haddock-api/src/Haddock/Interface/Create.hs
Changes:
=====================================
compiler/GHC/Builtin/Utils.hs
=====================================
@@ -79,6 +79,7 @@ import GHC.Utils.Panic
import GHC.Utils.Constants (debugIsOn)
import GHC.Parser.Annotation
import GHC.Hs.Doc
+import GHC.Hs.Extension (GhcPass)
import GHC.Unit.Module.ModIface (IfaceExport)
import GHC.Unit.Module.Warnings
@@ -263,7 +264,7 @@ ghcPrimNames
]
-- See Note [GHC.Prim Deprecations]
-ghcPrimWarns :: Warnings a
+ghcPrimWarns :: Warnings (GhcPass p)
ghcPrimWarns = WarnSome
-- declaration warnings
(map mk_decl_dep primOpDeprecations)
=====================================
compiler/GHC/Core/InstEnv.hs
=====================================
@@ -7,7 +7,7 @@
The bits common to GHC.Tc.TyCl.Instance and GHC.Tc.Deriv.
-}
-{-# LANGUAGE DeriveDataTypeable, DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric #-}
module GHC.Core.InstEnv (
DFunId, InstMatch, ClsInstLookupResult,
@@ -55,7 +55,6 @@ import GHC.Types.Name.Set
import GHC.Types.Basic
import GHC.Types.Id
import GHC.Generics (Generic)
-import Data.Data ( Data )
import Data.List.NonEmpty ( NonEmpty (..), nonEmpty )
import qualified Data.List.NonEmpty as NE
import Data.Maybe ( isJust )
@@ -114,7 +113,6 @@ data ClsInst
-- See Note [Implementation of deprecated instances]
-- in GHC.Tc.Solver.Dict
}
- deriving Data
-- | A fuzzy comparison function for class instances, intended for sorting
-- instances before displaying them to the user.
=====================================
compiler/GHC/Hs/Decls.hs
=====================================
@@ -1391,7 +1391,6 @@ type instance XXWarnDecls (GhcPass _) = DataConCantHappen
type instance XWarning (GhcPass _) = (NamespaceSpecifier, (EpToken "[", EpToken "]"))
type instance XXWarnDecl (GhcPass _) = DataConCantHappen
-
instance OutputableBndrId p
=> Outputable (WarnDecls (GhcPass p)) where
ppr (Warnings ext decls)
@@ -1411,7 +1410,7 @@ instance OutputableBndrId p
<+> ppr txt
where
ppr_category = case txt of
- WarningTxt (Just cat) _ _ -> ppr cat
+ WarningTxt _ (Just cat) _ -> ppr cat
_ -> empty
{-
=====================================
compiler/GHC/Hs/Instances.hs
=====================================
@@ -35,6 +35,7 @@ import GHC.Hs.ImpExp
import GHC.Parser.Annotation
import GHC.Types.Name.Reader (WithUserRdr(..))
import GHC.Data.BooleanFormula (BooleanFormula(..))
+import Language.Haskell.Syntax.Decls
import Language.Haskell.Syntax.Extension (Anno)
-- ---------------------------------------------------------------------
@@ -276,6 +277,14 @@ deriving instance Data (WarnDecl GhcPs)
deriving instance Data (WarnDecl GhcRn)
deriving instance Data (WarnDecl GhcTc)
+deriving instance Data (WarningTxt GhcPs)
+deriving instance Data (WarningTxt GhcRn)
+deriving instance Data (WarningTxt GhcTc)
+
+deriving instance Data (InWarningCategory GhcPs)
+deriving instance Data (InWarningCategory GhcRn)
+deriving instance Data (InWarningCategory GhcTc)
+
-- deriving instance (DataIdLR p p) => Data (AnnDecl p)
deriving instance Data (AnnProvenance GhcPs)
deriving instance Data (AnnProvenance GhcRn)
=====================================
compiler/GHC/Iface/Syntax.hs
=====================================
@@ -424,8 +424,8 @@ data IfaceWarnings
[(IfExtName, IfaceWarningTxt)]
data IfaceWarningTxt
- = IfWarningTxt (Maybe WarningCategory) SourceText [(IfaceStringLiteral, [IfExtName])]
- | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])]
+ = IfWarningTxt SourceText (Maybe WarningCategory) [(IfaceStringLiteral, [IfExtName])]
+ | IfDeprecatedTxt SourceText [(IfaceStringLiteral, [IfExtName])]
data IfaceStringLiteral
= IfStringLiteral SourceText FastString
@@ -664,7 +664,7 @@ fromIfaceWarnings = \case
fromIfaceWarningTxt :: IfaceWarningTxt -> WarningTxt GhcRn
fromIfaceWarningTxt = \case
- IfWarningTxt mb_cat src strs -> WarningTxt (noLocA . fromWarningCategory <$> mb_cat) src (noLocA <$> map fromIfaceStringLiteralWithNames strs)
+ IfWarningTxt src mb_cat strs -> WarningTxt src (noLocA . fromWarningCategory <$> mb_cat) (noLocA <$> map fromIfaceStringLiteralWithNames strs)
IfDeprecatedTxt src strs -> DeprecatedTxt src (noLocA <$> map fromIfaceStringLiteralWithNames strs)
fromIfaceStringLiteralWithNames :: (IfaceStringLiteral, [IfExtName]) -> WithHsDocIdentifiers StringLiteral GhcRn
=====================================
compiler/GHC/Iface/Warnings.hs
=====================================
@@ -23,7 +23,7 @@ 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 . iwc_wc . unLoc <$> mb_cat) src (map (toIfaceStringLiteralWithNames . unLoc) strs)
+toIfaceWarningTxt (WarningTxt src mb_cat strs) = IfWarningTxt src (unLoc . iwc_wc . unLoc <$> mb_cat) (map (toIfaceStringLiteralWithNames . unLoc) strs)
toIfaceWarningTxt (DeprecatedTxt src strs) = IfDeprecatedTxt src (map (toIfaceStringLiteralWithNames . unLoc) strs)
toIfaceStringLiteralWithNames :: WithHsDocIdentifiers StringLiteral GhcRn -> (IfaceStringLiteral, [IfExtName])
=====================================
compiler/GHC/Parser.y
=====================================
@@ -2053,12 +2053,12 @@ maybe_warning_pragma :: { Maybe (LWarningTxt GhcPs) }
{% fmap Just $ amsr (sLL $1 $> $ DeprecatedTxt (getDEPRECATED_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $2))
(AnnPragma (glR $1) (epTok $3) (fst $ unLoc $2) noAnn noAnn noAnn noAnn) }
| '{-# WARNING' warning_category strings '#-}'
- {% fmap Just $ amsr (sLL $1 $> $ WarningTxt $2 (getWARNING_PRAGs $1) (map stringLiteralToHsDocWst $ snd $ unLoc $3))
+ {% fmap Just $ amsr (sLL $1 $> $ WarningTxt (getWARNING_PRAGs $1) $2 (map stringLiteralToHsDocWst $ snd $ unLoc $3))
(AnnPragma (glR $1) (epTok $4) (fst $ unLoc $3) noAnn noAnn noAnn noAnn)}
| {- empty -} { Nothing }
-warning_category :: { Maybe (LocatedE InWarningCategory) }
- : 'in' STRING { Just (reLoc $ sLL $1 $> $ InWarningCategory (epTok $1) (getSTRINGs $2)
+warning_category :: { Maybe (LocatedE (InWarningCategory GhcPs)) }
+ : 'in' STRING { Just (reLoc $ sLL $1 $> $ InWarningCategory (epTok $1, getSTRINGs $2)
(reLoc $ sL1 $2 $ mkWarningCategory (getSTRING $2))) }
| {- empty -} { Nothing }
@@ -2083,7 +2083,7 @@ warning :: { OrdList (LWarnDecl GhcPs) }
: warning_category namespace_spec namelist strings
{% fmap unitOL $ amsA' (L (comb4 $1 $2 $3 $4)
(Warning (unLoc $2, fst $ unLoc $4) (unLoc $3)
- (WarningTxt $1 NoSourceText $ map stringLiteralToHsDocWst $ snd $ unLoc $4))) }
+ (WarningTxt NoSourceText $1 (map stringLiteralToHsDocWst $ snd $ unLoc $4)))) }
namespace_spec :: { Located NamespaceSpecifier }
: 'type' { sL1 $1 $ TypeNamespaceSpecifier (epTok $1) }
=====================================
compiler/GHC/Rename/Module.hs
=====================================
@@ -320,12 +320,16 @@ rnSrcWarnDecls bndr_set decls'
rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y))
rnWarningTxt :: WarningTxt GhcPs -> RnM (WarningTxt GhcRn)
-rnWarningTxt (WarningTxt mb_cat st wst) = do
- forM_ mb_cat $ \(L _ (InWarningCategory _ _ (L loc cat))) ->
- unless (validWarningCategory cat) $
- addErrAt (locA loc) (TcRnInvalidWarningCategory cat)
+rnWarningTxt (WarningTxt st mb_cat wst) = do
+ mb_cat' <- case mb_cat of
+ Nothing -> pure Nothing
+ Just (L x (InWarningCategory y (L loc cat))) -> do
+ unless (validWarningCategory cat) $
+ addErrAt (locA loc) (TcRnInvalidWarningCategory cat)
+ pure . Just $ L x (InWarningCategory y (L loc cat))
wst' <- traverse (traverse rnHsDoc) wst
- pure (WarningTxt mb_cat st wst')
+ pure (WarningTxt st mb_cat' wst')
+
rnWarningTxt (DeprecatedTxt st wst) = do
wst' <- traverse (traverse rnHsDoc) wst
pure (DeprecatedTxt st wst')
=====================================
compiler/GHC/Rename/Utils.hs
=====================================
@@ -69,7 +69,6 @@ import GHC.Data.Bag ( mapBagM, headMaybe )
import Control.Monad
import GHC.Settings.Constants ( mAX_TUPLE_SIZE, mAX_CTUPLE_SIZE )
import GHC.Unit.Module
-import GHC.Unit.Module.Warnings ( WarningTxt(..) )
import GHC.Iface.Load
import qualified GHC.LanguageExtensions as LangExt
=====================================
compiler/GHC/Tc/Deriv.hs
=====================================
@@ -57,7 +57,6 @@ import GHC.Types.Var.Env
import GHC.Types.Var.Set
import GHC.Types.SrcLoc
-import GHC.Unit.Module.Warnings
import GHC.Builtin.Names
import GHC.Utils.Error
=====================================
compiler/GHC/Tc/Deriv/Utils.hs
=====================================
@@ -52,7 +52,6 @@ import GHC.Core.Type
import GHC.Hs
import GHC.Driver.Session
import GHC.Unit.Module (getModule)
-import GHC.Unit.Module.Warnings
import GHC.Unit.Module.ModIface (mi_fix)
import GHC.Iface.Load (loadInterfaceForName)
=====================================
compiler/GHC/Tc/Errors/Ppr.hs
=====================================
@@ -1841,7 +1841,7 @@ instance Diagnostic TcRnMessage where
nest 2 (vcat (map (ppr . hsDocString . unLoc) msg)) ]
where
(extra, msg) = case txt of
- WarningTxt _ _ msg -> ("", msg)
+ WarningTxt _ _ msg -> ("", msg)
DeprecatedTxt _ msg -> (" is deprecated", msg)
TcRnRedundantSourceImport mod_name
-> mkSimpleDecorated $
=====================================
compiler/GHC/Tc/Errors/Types.hs
=====================================
@@ -221,7 +221,6 @@ import GHC.Types.DefaultEnv (ClassDefaults)
import GHC.Unit.Types (Module)
import GHC.Unit.State (UnitState)
-import GHC.Unit.Module.Warnings (WarningCategory, WarningTxt)
import GHC.Unit.Module.ModIface (ModIface)
import GHC.Utils.Outputable
=====================================
compiler/GHC/Tc/Types/Origin.hs
=====================================
@@ -67,7 +67,6 @@ import GHC.Core.PatSyn
import GHC.Core.Multiplicity ( scaledThing )
import GHC.Unit.Module
-import GHC.Unit.Module.Warnings
import GHC.Types.Id
import GHC.Types.Name
import GHC.Types.Name.Reader
=====================================
compiler/GHC/Tc/Utils/Instantiate.hs
=====================================
@@ -91,7 +91,6 @@ import GHC.Utils.Unique (sameUnique)
import GHC.Unit.State
import GHC.Unit.External
-import GHC.Unit.Module.Warnings
import Data.List ( mapAccumL )
import qualified Data.List.NonEmpty as NE
=====================================
compiler/GHC/Types/DefaultEnv.hs
=====================================
@@ -21,13 +21,12 @@ where
import GHC.Core.Class (Class (className))
import GHC.Prelude
-import GHC.Hs.Extension (GhcRn)
+import GHC.Hs
import GHC.Tc.Utils.TcType (Type)
import GHC.Types.Name (Name, nameUnique, stableNameCmp)
import GHC.Types.Name.Env
import GHC.Types.Unique.FM (lookupUFM_Directly)
import GHC.Types.SrcLoc (SrcSpan)
-import GHC.Unit.Module.Warnings (WarningTxt)
import GHC.Unit.Types (Module)
import GHC.Utils.Outputable
=====================================
compiler/GHC/Types/Error/Codes.hs
=====================================
@@ -768,6 +768,7 @@ type family GhcDiagnosticCode c = n | n -> c where
-- TcRnPragmaWarning
GhcDiagnosticCode "WarningTxt" = 63394
GhcDiagnosticCode "DeprecatedTxt" = 68441
+ GhcDiagnosticCode "XWarningTxt" = 68077
-- TcRnRunSliceFailure/ConversionFail
GhcDiagnosticCode "IllegalOccName" = 55017
=====================================
compiler/GHC/Unit/Module/Warnings.hs
=====================================
@@ -11,6 +11,9 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeFamilies #-}
+-- Eq instances for WarningTxt, InWarningCategory
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
-- | Warnings for a module
module GHC.Unit.Module.Warnings
( WarningCategory(..)
@@ -48,7 +51,7 @@ where
import GHC.Prelude
-import GHC.Data.FastString (FastString, mkFastString, unpackFS)
+import GHC.Data.FastString (mkFastString, unpackFS)
import GHC.Types.SourceText
import GHC.Types.Name.Occurrence
import GHC.Types.Name.Env
@@ -65,77 +68,15 @@ import GHC.Utils.Binary
import GHC.Unicode
import Language.Haskell.Syntax.Extension
+import Language.Haskell.Syntax.Decls
-import Data.Data
import Data.List (isPrefixOf)
-import GHC.Generics ( Generic )
-import Control.DeepSeq
-
-
-{-
-Note [Warning categories]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-See GHC Proposal 541 for the design of the warning categories feature:
-https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0541-wa...
-
-A WARNING pragma may be annotated with a category such as "x-partial" written
-after the 'in' keyword, like this:
-
- {-# WARNING in "x-partial" head "This function is partial..." #-}
-
-This is represented by the 'Maybe (Located WarningCategory)' field in
-'WarningTxt'. The parser will accept an arbitrary string as the category name,
-then the renamer (in 'rnWarningTxt') will check it contains only valid
-characters, so we can generate a nicer error message than a parse error.
-
-The corresponding warnings can then be controlled with the -Wx-partial,
--Wno-x-partial, -Werror=x-partial and -Wwarn=x-partial flags. Such a flag is
-distinguished from an 'unrecognisedWarning' by the flag parser testing
-'validWarningCategory'. The 'x-' prefix means we can still usually report an
-unrecognised warning where the user has made a mistake.
-
-A DEPRECATED pragma may not have a user-defined category, and is always treated
-as belonging to the special category 'deprecations'. Similarly, a WARNING
-pragma without a category belongs to the 'deprecations' category.
-Thus the '-Wdeprecations' flag will enable all of the following:
-
- {-# WARNING in "deprecations" foo "This function is deprecated..." #-}
- {-# WARNING foo "This function is deprecated..." #-}
- {-# DEPRECATED foo "This function is deprecated..." #-}
-
-The '-Wwarnings-deprecations' flag is supported for backwards compatibility
-purposes as being equivalent to '-Wdeprecations'.
-
-The '-Wextended-warnings' warning group collects together all warnings with
-user-defined categories, so they can be enabled or disabled
-collectively. Moreover they are treated as being part of other warning groups
-such as '-Wdefault' (see 'warningGroupIncludesExtendedWarnings').
-
-'DynFlags' and 'DiagOpts' each contain a set of enabled and a set of fatal
-warning categories, just as they do for the finite enumeration of 'WarningFlag's
-built in to GHC. These are represented as 'WarningCategorySet's to allow for
-the possibility of them being infinite.
-
--}
-data InWarningCategory
- = InWarningCategory
- { iwc_in :: !(EpToken "in"),
- iwc_st :: !SourceText,
- iwc_wc :: (LocatedE WarningCategory)
- } deriving Data
-fromWarningCategory :: WarningCategory -> InWarningCategory
-fromWarningCategory wc = InWarningCategory noAnn NoSourceText (noLocA wc)
-
-
--- See Note [Warning categories]
-newtype WarningCategory = WarningCategory FastString
- deriving stock Data
- deriving newtype (Binary, Eq, Outputable, Show, Uniquable, NFData)
-
-mkWarningCategory :: FastString -> WarningCategory
-mkWarningCategory = WarningCategory
+fromWarningCategory ::
+ HasAnnotation (Anno WarningCategory) =>
+ WarningCategory -> InWarningCategory (GhcPass p)
+fromWarningCategory wc = InWarningCategory (noAnn, NoSourceText) (noLocA wc)
-- | The @deprecations@ category is used for all DEPRECATED pragmas and for
-- WARNING pragmas that do not specify a category.
@@ -153,7 +94,6 @@ validWarningCategory cat@(WarningCategory c) =
s = unpackFS c
is_allowed c = isAlphaNum c || c == '\'' || c == '-'
-
-- | A finite or infinite set of warning categories.
--
-- Unlike 'WarningFlag', there are (in principle) infinitely many warning
@@ -198,66 +138,74 @@ deleteWarningCategorySet c (CofiniteWarningCategorySet s) = CofiniteWarningCateg
type LWarningTxt pass = XRec pass (WarningTxt pass)
--- | Warning Text
---
--- reason/explanation from a WARNING or DEPRECATED pragma
-data WarningTxt pass
- = WarningTxt
- (Maybe (LocatedE InWarningCategory))
- -- ^ Warning category attached to this WARNING pragma, if any;
- -- see Note [Warning categories]
- SourceText
- [LocatedE (WithHsDocIdentifiers StringLiteral pass)]
- | DeprecatedTxt
- SourceText
- [LocatedE (WithHsDocIdentifiers StringLiteral pass)]
- deriving Generic
-
-- | To which warning category does this WARNING or DEPRECATED pragma belong?
-- See Note [Warning categories].
-warningTxtCategory :: WarningTxt pass -> WarningCategory
-warningTxtCategory (WarningTxt (Just (L _ (InWarningCategory _ _ (L _ cat)))) _ _) = cat
+warningTxtCategory :: WarningTxt (GhcPass p) -> WarningCategory
+warningTxtCategory (WarningTxt _ (Just (L _ (InWarningCategory _ (L _ cat)))) _) = cat
warningTxtCategory _ = defaultWarningCategory
+
-- | The message that the WarningTxt was specified to output
-warningTxtMessage :: WarningTxt p -> [LocatedE (WithHsDocIdentifiers StringLiteral p)]
-warningTxtMessage (WarningTxt _ _ m) = m
+warningTxtMessage :: WarningTxt (GhcPass p) -> [LocatedE (WithHsDocIdentifiers StringLiteral (GhcPass p))]
+warningTxtMessage (WarningTxt _ _ m) = m
warningTxtMessage (DeprecatedTxt _ m) = m
-- | True if the 2 WarningTxts have the same category and messages
-warningTxtSame :: WarningTxt p1 -> WarningTxt p2 -> Bool
+warningTxtSame :: WarningTxt (GhcPass p) -> WarningTxt (GhcPass p) -> Bool
warningTxtSame w1 w2
= warningTxtCategory w1 == warningTxtCategory w2
&& literal_message w1 == literal_message w2
&& same_type
where
- literal_message :: WarningTxt p -> [StringLiteral]
+ literal_message :: WarningTxt (GhcPass p) -> [StringLiteral]
literal_message = map (hsDocString . unLoc) . warningTxtMessage
same_type | DeprecatedTxt {} <- w1, DeprecatedTxt {} <- w2 = True
- | WarningTxt {} <- w1, WarningTxt {} <- w2 = True
+ | WarningTxt {} <- w1, WarningTxt {} <- w2 = True
| otherwise = False
-deriving instance Eq InWarningCategory
+instance Outputable (InWarningCategory (GhcPass pass)) where
+ ppr (InWarningCategory _ wt) = text "in" <+> doubleQuotes (ppr wt)
-deriving instance (Eq (IdP pass)) => Eq (WarningTxt pass)
-deriving instance (Data pass, Data (IdP pass)) => Data (WarningTxt pass)
+type instance XDeprecatedTxt (GhcPass _) = SourceText
+type instance XWarningTxt (GhcPass _) = SourceText
+type instance XXWarningTxt (GhcPass _) = DataConCantHappen
+type instance XInWarningCategory (GhcPass _) = (EpToken "in", SourceText)
+type instance XXInWarningCategory (GhcPass _) = DataConCantHappen
+type instance Anno (WithHsDocIdentifiers StringLiteral pass) = EpaLocation
+type instance Anno (InWarningCategory (GhcPass pass)) = EpaLocation
+type instance Anno (WarningCategory) = EpaLocation
type instance Anno (WarningTxt (GhcPass pass)) = SrcSpanAnnP
-instance Outputable InWarningCategory where
- ppr (InWarningCategory _ _ wt) = text "in" <+> doubleQuotes (ppr wt)
+deriving stock instance Eq (WarningTxt GhcPs)
+deriving stock instance Eq (WarningTxt GhcRn)
+deriving stock instance Eq (WarningTxt GhcTc)
+
+deriving stock instance Eq (InWarningCategory GhcPs)
+deriving stock instance Eq (InWarningCategory GhcRn)
+deriving stock instance Eq (InWarningCategory GhcTc)
+
+-- TODO: Move to respecitive type-class definition modules after removing
+-- the Language.Haskell.Syntax.Decls module's dependency on GHC.Hs.Doc.
+-- Subsequently, create a Language.Haskell.Syntax.Decls.Warnings sub-module
+-- with the "warning declaration" types and have Language.Haskell.Syntax.Decls
+-- re-export Language.Haskell.Syntax.Decls.Warnings. This will prevent cyclic
+-- import, but it will only work once GHC.Hs.Doc is no longer a GHC dependency.
+deriving instance Binary WarningCategory
+deriving instance Outputable WarningCategory
-instance Outputable (WarningTxt pass) where
- ppr (WarningTxt mcat lsrc ws)
+deriving instance Uniquable WarningCategory
+
+instance Outputable (WarningTxt (GhcPass pass)) where
+ ppr (WarningTxt lsrc mcat ws)
= case lsrc of
NoSourceText -> pp_ws ws
SourceText src -> ftext src <+> ctg_doc <+> pp_ws ws <+> text "#-}"
where
ctg_doc = maybe empty (\ctg -> ppr ctg) mcat
-
- ppr (DeprecatedTxt lsrc ds)
+ ppr (DeprecatedTxt lsrc ds)
= case lsrc of
NoSourceText -> pp_ws ds
SourceText src -> ftext src <+> pp_ws ds <+> text "#-}"
@@ -270,7 +218,7 @@ pp_ws ws
<+> text "]"
-pprWarningTxtForMsg :: WarningTxt p -> SDoc
+pprWarningTxtForMsg :: WarningTxt (GhcPass pass) -> SDoc
pprWarningTxtForMsg (WarningTxt _ _ ws)
= doubleQuotes (vcat (map (ftext . sl_fs . hsDocString . unLoc) ws))
pprWarningTxtForMsg (DeprecatedTxt _ ds)
@@ -316,8 +264,6 @@ type DeclWarnOccNames pass = [(OccName, WarningTxt pass)]
-- | Names that are deprecated as exports
type ExportWarnNames pass = [(Name, WarningTxt pass)]
-deriving instance Eq (IdP pass) => Eq (Warnings pass)
-
emptyWarn :: Warnings p
emptyWarn = WarnSome [] []
=====================================
compiler/Language/Haskell/Syntax/Decls.hs
=====================================
@@ -1,10 +1,11 @@
-
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
@@ -83,7 +84,18 @@ module Language.Haskell.Syntax.Decls (
FamilyResultSig(..), LFamilyResultSig, InjectivityAnn(..), LInjectivityAnn,
-- * Grouping
- HsGroup(..)
+ HsGroup(..),
+
+ -- * Warnings
+ WarningTxt(..),
+ WarningCategory(..),
+ mkWarningCategory,
+ InWarningCategory(..),
+ -- ** Extension
+ XDeprecatedTxt,
+ XWarningTxt,
+ XXWarningTxt,
+ XInWarningCategory,
) where
-- friends:
@@ -101,12 +113,14 @@ import GHC.Types.Basic (TopLevelFlag, OverlapMode, RuleName, Activation
,TyConFlavour(..), TypeOrData(..), NewOrData(..))
import GHC.Types.ForeignCall (CType, CCallConv, Safety, Header, CLabelString, CCallTarget, CExportSpec)
-import GHC.Unit.Module.Warnings (WarningTxt)
-
+import GHC.Data.FastString (FastString)
import GHC.Hs.Doc (LHsDoc) -- ROMES:TODO Discuss in #21592 whether this is parsed AST or base AST
+import GHC.Hs.Doc (WithHsDocIdentifiers)
+import GHC.Types.SourceText (StringLiteral)
-import Control.Monad
+import Control.DeepSeq
import Control.Exception (assert)
+import Control.Monad
import Data.Data hiding (TyCon, Fixity, Infix)
import Data.Maybe
import Data.String
@@ -117,6 +131,8 @@ import Prelude (Show)
import Data.Foldable
import Data.Traversable
import Data.List.NonEmpty (NonEmpty (..))
+import GHC.Generics ( Generic )
+
{-
************************************************************************
@@ -1589,3 +1605,85 @@ data RoleAnnotDecl pass
(LIdP pass) -- type constructor
[XRec pass (Maybe Role)] -- optional annotations
| XRoleAnnotDecl !(XXRoleAnnotDecl pass)
+
+{-
+************************************************************************
+* *
+\subsection[WarnAnnot]{Warning annotations}
+* *
+************************************************************************
+-}
+
+-- | Warning Text
+--
+-- reason/explanation from a WARNING or DEPRECATED pragma
+data WarningTxt pass
+ = DeprecatedTxt
+ (XDeprecatedTxt pass)
+ [XRec pass (WithHsDocIdentifiers StringLiteral pass)]
+ | WarningTxt
+ (XWarningTxt pass)
+ (Maybe (XRec pass (InWarningCategory pass)))
+ -- ^ Warning category attached to this WARNING pragma, if any;
+ -- see Note [Warning categories]
+ [XRec pass (WithHsDocIdentifiers StringLiteral pass)]
+ | XWarningTxt !(XXWarningTxt pass)
+ deriving Generic
+
+{-
+Note [Warning categories]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+See GHC Proposal 541 for the design of the warning categories feature:
+https://github.com/ghc-proposals/ghc-proposals/blob/master/proposals/0541-wa...
+
+A WARNING pragma may be annotated with a category such as "x-partial" written
+after the 'in' keyword, like this:
+
+ {-# WARNING in "x-partial" head "This function is partial..." #-}
+
+This is represented by the 'Maybe (Located WarningCategory)' field in
+'WarningTxt'. The parser will accept an arbitrary string as the category name,
+then the renamer (in 'rnWarningTxt') will check it contains only valid
+characters, so we can generate a nicer error message than a parse error.
+
+The corresponding warnings can then be controlled with the -Wx-partial,
+-Wno-x-partial, -Werror=x-partial and -Wwarn=x-partial flags. Such a flag is
+distinguished from an 'unrecognisedWarning' by the flag parser testing
+'validWarningCategory'. The 'x-' prefix means we can still usually report an
+unrecognised warning where the user has made a mistake.
+
+A DEPRECATED pragma may not have a user-defined category, and is always treated
+as belonging to the special category 'deprecations'. Similarly, a WARNING
+pragma without a category belongs to the 'deprecations' category.
+Thus the '-Wdeprecations' flag will enable all of the following:
+
+ {-# WARNING in "deprecations" foo "This function is deprecated..." #-}
+ {-# WARNING foo "This function is deprecated..." #-}
+ {-# DEPRECATED foo "This function is deprecated..." #-}
+The '-Wwarnings-deprecations' flag is supported for backwards compatibility
+purposes as being equivalent to '-Wdeprecations'.
+
+The '-Wextended-warnings' warning group collects together all warnings with
+user-defined categories, so they can be enabled or disabled
+collectively. Moreover they are treated as being part of other warning groups
+such as '-Wdefault' (see 'warningGroupIncludesExtendedWarnings').
+
+'DynFlags' and 'DiagOpts' each contain a set of enabled and a set of fatal
+warning categories, just as they do for the finite enumeration of 'WarningFlag's
+built in to GHC. These are represented as 'WarningCategorySet's to allow for
+the possibility of them being infinite.
+
+-}
+data InWarningCategory pass
+ = InWarningCategory
+ { iwc_st :: (XInWarningCategory pass),
+ iwc_wc :: (XRec pass WarningCategory)
+ }
+ | XInWarningCategory !(XXInWarningCategory pass)
+
+newtype WarningCategory = WarningCategory FastString
+ deriving stock (Data)
+ deriving newtype (Eq, Show, NFData)
+
+mkWarningCategory :: FastString -> WarningCategory
+mkWarningCategory = WarningCategory
=====================================
compiler/Language/Haskell/Syntax/Extension.hs
=====================================
@@ -421,6 +421,17 @@ type family XXWarnDecls x
type family XWarning x
type family XXWarnDecl x
+-- -------------------------------------
+-- WarningTxt type families
+type family XDeprecatedTxt x
+type family XWarningTxt x
+type family XXWarningTxt x
+
+-- -------------------------------------
+-- InWarningCategory type families
+type family XInWarningCategory x
+type family XXInWarningCategory x
+
-- -------------------------------------
-- AnnDecl type families
type family XHsAnnotation x
=====================================
docs/users_guide/ghci.rst
=====================================
@@ -1216,10 +1216,6 @@ Stack Traces in GHCi
.. index::
simple: stack trace; in GHCi
-[ This is an experimental feature enabled by the new
-``-fexternal-interpreter`` flag that was introduced in GHC 8.0.1. It
-is currently not supported on Windows.]
-
GHCi can use the profiling system to collect stack trace information
when running interpreted code. To gain access to stack traces, start
GHCi like this:
=====================================
testsuite/tests/diagnostic-codes/codes.stdout
=====================================
@@ -70,6 +70,7 @@
[GHC-99991] is untested (constructor = TyVarMissingInEnv)
[GHC-92834] is untested (constructor = BadCoercionRole)
[GHC-93008] is untested (constructor = HsigShapeSortMismatch)
+[GHC-68077] is untested (constructor = XWarningTxt)
[GHC-68444] is untested (constructor = SumAltArityExceeded)
[GHC-63966] is untested (constructor = IllegalSumAlt)
[GHC-28709] is untested (constructor = MalformedType)
=====================================
utils/check-exact/ExactPrint.hs
=====================================
@@ -53,7 +53,6 @@ import GHC.Types.PkgQual
import GHC.Types.SourceText
import GHC.Types.SrcLoc
import GHC.Types.Var
-import GHC.Unit.Module.Warnings
import GHC.Utils.Misc
import GHC.Utils.Outputable hiding ( (<>) )
import GHC.Utils.Panic
@@ -1570,14 +1569,14 @@ instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
getAnnotationEntry = entryFromLocatedA
setAnnotationAnchor = setAnchorAn
- exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (WarningTxt mb_cat src ws)) = do
+ exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (WarningTxt src mb_cat ws)) = do
o' <- markAnnOpen'' o src "{-# WARNING"
mb_cat' <- markAnnotated mb_cat
os' <- markEpToken os
ws' <- markAnnotated ws
cs' <- markEpToken cs
c' <- markEpToken c
- return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (WarningTxt mb_cat' src ws'))
+ return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (WarningTxt src mb_cat' ws'))
exact (L (EpAnn l (AnnPragma o c (os,cs) l1 l2 t m) css) (DeprecatedTxt src ws)) = do
o' <- markAnnOpen'' o src "{-# DEPRECATED"
@@ -1587,14 +1586,14 @@ instance ExactPrint (LocatedP (WarningTxt GhcPs)) where
c' <- markEpToken c
return (L (EpAnn l (AnnPragma o' c' (os',cs') l1 l2 t m) css) (DeprecatedTxt src ws'))
-instance ExactPrint InWarningCategory where
+instance Typeable p => ExactPrint (InWarningCategory (GhcPass p)) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (InWarningCategory tkIn source (L l wc)) = do
+ exact (InWarningCategory (tkIn, source) (L l wc)) = do
tkIn' <- markEpToken tkIn
L l' (_,wc') <- markAnnotated (L l (source, wc))
- return (InWarningCategory tkIn' source (L l' wc'))
+ return (InWarningCategory (tkIn', source) (L l' wc'))
instance ExactPrint (SourceText, WarningCategory) where
getAnnotationEntry _ = NoEntryVal
@@ -1935,14 +1934,14 @@ instance ExactPrint (WarnDecl GhcPs) where
getAnnotationEntry _ = NoEntryVal
setAnnotationAnchor a _ _ _ = a
- exact (Warning (ns_spec, (o,c)) lns (WarningTxt mb_cat src ls )) = do
+ exact (Warning (ns_spec, (o,c)) lns (WarningTxt src mb_cat ls )) = do
mb_cat' <- markAnnotated mb_cat
ns_spec' <- exactNsSpec ns_spec
lns' <- markAnnotated lns
o' <- markEpToken o
ls' <- markAnnotated ls
c' <- markEpToken c
- return (Warning (ns_spec', (o',c')) lns' (WarningTxt mb_cat' src ls'))
+ return (Warning (ns_spec', (o',c')) lns' (WarningTxt src mb_cat' ls'))
exact (Warning (ns_spec, (o,c)) lns (DeprecatedTxt src ls)) = do
ns_spec' <- exactNsSpec ns_spec
=====================================
utils/haddock/haddock-api/haddock-api.cabal
=====================================
@@ -139,7 +139,6 @@ library
Haddock.Backends.Xhtml.Types
Haddock.Backends.Xhtml.Utils
Haddock.Backends.LaTeX
- Haddock.Backends.HaddockDB
Haddock.Backends.Hoogle
Haddock.Backends.Hyperlinker
Haddock.Backends.Hyperlinker.Parser
=====================================
utils/haddock/haddock-api/src/Haddock/Backends/HaddockDB.hs deleted
=====================================
@@ -1,178 +0,0 @@
------------------------------------------------------------------------------
-
------------------------------------------------------------------------------
-
--- |
--- Module : Haddock.Backends.HaddockDB
--- Copyright : (c) Simon Marlow 2003
--- License : BSD-like
---
--- Maintainer : haddock@projects.haskell.org
--- Stability : experimental
--- Portability : portable
-module Haddock.Backends.HaddockDB (ppDocBook) where
-
-{-
-import HaddockTypes
-import HaddockUtil
-import HsSyn2
-
-import Text.PrettyPrint
--}
-
------------------------------------------------------------------------------
--- Printing the results in DocBook format
-
-ppDocBook :: a
-ppDocBook = error "not working"
-
-{-
-ppDocBook :: FilePath -> [(Module, Interface)] -> String
-ppDocBook odir mods = render (ppIfaces mods)
-
-ppIfaces mods
- = text "<!DOCTYPE BOOK PUBLIC \"-//OASIS//DTD DocBook V3.1//EN\" ["
- $$ text "]>"
- $$ text "<book>"
- $$ text "<bookinfo>"
- $$ text "<author><othername>HaskellDoc version 0.0</othername></author>"
- $$ text "</bookinfo>"
- $$ text "<article>"
- $$ vcat (map do_mod mods)
- $$ text "</article></book>"
- where
- do_mod (Module mod, iface)
- = text "