From cae75f82226638691cfa1e85fc168f4b65ddce4d Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 20 Jul 2008 12:09:18 +0000 Subject: [PATCH] Add a WARNING pragma --- compiler/basicTypes/BasicTypes.lhs | 11 +++++-- compiler/deSugar/Desugar.lhs | 4 +-- compiler/hsSyn/HsDecls.lhs | 26 ++++++++-------- compiler/hsSyn/HsSyn.lhs | 4 +-- compiler/iface/BinIface.hs | 56 +++++++++++++++++++++------------- compiler/iface/LoadIface.lhs | 17 ++++++----- compiler/iface/MkIface.lhs | 20 ++++++------- compiler/main/DynFlags.hs | 6 ++-- compiler/main/GHC.hs | 2 +- compiler/main/HscTypes.lhs | 56 +++++++++++++++++----------------- compiler/parser/Lexer.x | 3 ++ compiler/parser/Parser.y.pp | 51 ++++++++++++++++++++----------- compiler/parser/RdrHsSyn.lhs | 4 +-- compiler/rename/RnNames.lhs | 58 +++++++++++++++++++----------------- compiler/rename/RnSource.lhs | 34 ++++++++++----------- compiler/typecheck/TcRnDriver.lhs | 6 ++-- compiler/typecheck/TcRnMonad.lhs | 2 +- compiler/typecheck/TcRnTypes.lhs | 2 +- docs/users_guide/flags.xml | 6 ++-- docs/users_guide/glasgow_exts.xml | 47 ++++++++++++++++------------- docs/users_guide/using.xml | 15 +++++----- 21 files changed, 243 insertions(+), 187 deletions(-) diff --git a/compiler/basicTypes/BasicTypes.lhs b/compiler/basicTypes/BasicTypes.lhs index 9d5b481..f782da3 100644 --- a/compiler/basicTypes/BasicTypes.lhs +++ b/compiler/basicTypes/BasicTypes.lhs @@ -19,7 +19,7 @@ module BasicTypes( Arity, - DeprecTxt, + WarningTxt(..), Fixity(..), FixityDirection(..), defaultFixity, maxPrecedence, @@ -95,7 +95,14 @@ initialVersion = 1 \begin{code} -type DeprecTxt = FastString -- reason/explanation for deprecation +-- reason/explanation from a WARNING or DEPRECATED pragma +data WarningTxt = WarningTxt FastString + | DeprecatedTxt FastString + deriving Eq + +instance Outputable WarningTxt where + ppr (WarningTxt w) = doubleQuotes (ftext w) + ppr (DeprecatedTxt d) = text "Deprecated:" <+> doubleQuotes (ftext d) \end{code} %************************************************************************ diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index 742bcb3..80b0dcb 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -64,7 +64,7 @@ deSugar hsc_env tcg_fix_env = fix_env, tcg_inst_env = inst_env, tcg_fam_inst_env = fam_inst_env, - tcg_deprecs = deprecs, + tcg_warns = warns, tcg_binds = binds, tcg_fords = fords, tcg_rules = rules, @@ -129,7 +129,7 @@ deSugar hsc_env mg_dir_imps = imp_mods imports, mg_rdr_env = rdr_env, mg_fix_env = fix_env, - mg_deprecs = deprecs, + mg_warns = warns, mg_types = type_env, mg_insts = insts, mg_fam_insts = fam_insts, diff --git a/compiler/hsSyn/HsDecls.lhs b/compiler/hsSyn/HsDecls.lhs index 9df546a..3a615f0 100644 --- a/compiler/hsSyn/HsDecls.lhs +++ b/compiler/hsSyn/HsDecls.lhs @@ -27,7 +27,7 @@ module HsDecls ( ConDecl(..), ResType(..), ConDeclField(..), LConDecl, HsConDeclDetails, hsConDeclArgTys, DocDecl(..), LDocDecl, docDeclDoc, - DeprecDecl(..), LDeprecDecl, + WarnDecl(..), LWarnDecl, HsGroup(..), emptyRdrGroup, emptyRnGroup, appendGroups, tcdName, tyClDeclNames, tyClDeclTyVars, isClassDecl, isSynDecl, isDataDecl, isTypeDecl, isFamilyDecl, @@ -79,7 +79,7 @@ data HsDecl id | SigD (Sig id) | DefD (DefaultDecl id) | ForD (ForeignDecl id) - | DeprecD (DeprecDecl id) + | WarningD (WarnDecl id) | RuleD (RuleDecl id) | SpliceD (SpliceDecl id) | DocD (DocDecl id) @@ -113,7 +113,7 @@ data HsGroup id hs_defds :: [LDefaultDecl id], hs_fords :: [LForeignDecl id], - hs_depds :: [LDeprecDecl id], + hs_warnds :: [LWarnDecl id], hs_ruleds :: [LRuleDecl id], hs_docs :: [LDocDecl id] @@ -125,7 +125,7 @@ emptyRnGroup = emptyGroup { hs_valds = emptyValBindsOut } emptyGroup = HsGroup { hs_tyclds = [], hs_instds = [], hs_derivds = [], hs_fixds = [], hs_defds = [], hs_fords = [], - hs_depds = [], hs_ruleds = [], + hs_warnds = [], hs_ruleds = [], hs_valds = error "emptyGroup hs_valds: Can't happen", hs_docs = [] } @@ -139,7 +139,7 @@ appendGroups hs_fixds = fixds1, hs_defds = defds1, hs_fords = fords1, - hs_depds = depds1, + hs_warnds = warnds1, hs_ruleds = rulds1, hs_docs = docs1 } HsGroup { @@ -150,7 +150,7 @@ appendGroups hs_fixds = fixds2, hs_defds = defds2, hs_fords = fords2, - hs_depds = depds2, + hs_warnds = warnds2, hs_ruleds = rulds2, hs_docs = docs2 } = @@ -162,7 +162,7 @@ appendGroups hs_fixds = fixds1 ++ fixds2, hs_defds = defds1 ++ defds2, hs_fords = fords1 ++ fords2, - hs_depds = depds1 ++ depds2, + hs_warnds = warnds1 ++ warnds2, hs_ruleds = rulds1 ++ rulds2, hs_docs = docs1 ++ docs2 } \end{code} @@ -177,7 +177,7 @@ instance OutputableBndr name => Outputable (HsDecl name) where ppr (ForD fd) = ppr fd ppr (SigD sd) = ppr sd ppr (RuleD rd) = ppr rd - ppr (DeprecD dd) = ppr dd + ppr (WarningD wd) = ppr wd ppr (SpliceD dd) = ppr dd ppr (DocD doc) = ppr doc @@ -187,7 +187,7 @@ instance OutputableBndr name => Outputable (HsGroup name) where hs_instds = inst_decls, hs_derivds = deriv_decls, hs_fixds = fix_decls, - hs_depds = deprec_decls, + hs_warnds = deprec_decls, hs_fords = foreign_decls, hs_defds = default_decls, hs_ruleds = rule_decls }) @@ -994,11 +994,11 @@ docDeclDoc (DocGroup _ d) = d We use exported entities for things to deprecate. \begin{code} -type LDeprecDecl name = Located (DeprecDecl name) +type LWarnDecl name = Located (WarnDecl name) -data DeprecDecl name = Deprecation name DeprecTxt +data WarnDecl name = Warning name WarningTxt -instance OutputableBndr name => Outputable (DeprecDecl name) where - ppr (Deprecation thing txt) +instance OutputableBndr name => Outputable (WarnDecl name) where + ppr (Warning thing txt) = hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"] \end{code} diff --git a/compiler/hsSyn/HsSyn.lhs b/compiler/hsSyn/HsSyn.lhs index 507eab6..6277f5c 100644 --- a/compiler/hsSyn/HsSyn.lhs +++ b/compiler/hsSyn/HsSyn.lhs @@ -35,7 +35,7 @@ import HsImpExp import HsLit import HsPat import HsTypes -import BasicTypes ( Fixity, DeprecTxt ) +import BasicTypes ( Fixity, WarningTxt ) import HsUtils import HsDoc @@ -61,7 +61,7 @@ data HsModule name -- info to TyDecls/etc; so this list is -- often empty, downstream. [LHsDecl name] -- Type, class, value, and interface signature decls - (Maybe DeprecTxt) -- reason/explanation for deprecation of this module + (Maybe WarningTxt) -- reason/explanation for warning/deprecation of this module (HaddockModInfo name) -- Haddock module info (Maybe (HsDoc name)) -- Haddock module description diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs index 75e0d64..a544b62 100644 --- a/compiler/iface/BinIface.hs +++ b/compiler/iface/BinIface.hs @@ -373,7 +373,7 @@ instance Binary ModIface where mi_exports = exports, mi_exp_hash = exp_hash, mi_fixities = fixities, - mi_deprecs = deprecs, + mi_warns = warns, mi_decls = decls, mi_insts = insts, mi_fam_insts = fam_insts, @@ -392,7 +392,7 @@ instance Binary ModIface where put_ bh exports put_ bh exp_hash put_ bh fixities - lazyPut bh deprecs + lazyPut bh warns put_ bh decls put_ bh insts put_ bh fam_insts @@ -413,7 +413,7 @@ instance Binary ModIface where exports <- {-# SCC "bin_exports" #-} get bh exp_hash <- get bh fixities <- {-# SCC "bin_fixities" #-} get bh - deprecs <- {-# SCC "bin_deprecs" #-} lazyGet bh + warns <- {-# SCC "bin_warns" #-} lazyGet bh decls <- {-# SCC "bin_tycldecls" #-} get bh insts <- {-# SCC "bin_insts" #-} get bh fam_insts <- {-# SCC "bin_fam_insts" #-} get bh @@ -433,7 +433,7 @@ instance Binary ModIface where mi_exports = exports, mi_exp_hash = exp_hash, mi_fixities = fixities, - mi_deprecs = deprecs, + mi_warns = warns, mi_decls = decls, mi_globals = Nothing, mi_insts = insts, @@ -443,7 +443,7 @@ instance Binary ModIface where mi_vect_info = vect_info, mi_hpc = hpc_info, -- And build the cached values - mi_dep_fn = mkIfaceDepCache deprecs, + mi_warn_fn = mkIfaceWarnCache warns, mi_fix_fn = mkIfaceFixCache fixities, mi_hash_fn = mkIfaceHashCache decls }) @@ -515,23 +515,39 @@ instance Binary Usage where return UsageHomeModule { usg_mod_name = nm, usg_mod_hash = mod, usg_exports = exps, usg_entities = ents } -instance Binary Deprecations where - put_ bh NoDeprecs = putByte bh 0 - put_ bh (DeprecAll t) = do - putByte bh 1 - put_ bh t - put_ bh (DeprecSome ts) = do - putByte bh 2 - put_ bh ts +instance Binary Warnings where + put_ bh NoWarnings = putByte bh 0 + put_ bh (WarnAll t) = do + putByte bh 1 + put_ bh t + put_ bh (WarnSome ts) = do + putByte bh 2 + put_ bh ts get bh = do - h <- getByte bh - case h of - 0 -> return NoDeprecs - 1 -> do aa <- get bh - return (DeprecAll aa) - _ -> do aa <- get bh - return (DeprecSome aa) + h <- getByte bh + case h of + 0 -> return NoWarnings + 1 -> do aa <- get bh + return (WarnAll aa) + _ -> do aa <- get bh + return (WarnSome aa) + +instance Binary WarningTxt where + put_ bh (WarningTxt w) = do + putByte bh 0 + put_ bh w + put_ bh (DeprecatedTxt d) = do + putByte bh 1 + put_ bh d + + get bh = do + h <- getByte bh + case h of + 0 -> do w <- get bh + return (WarningTxt w) + _ -> do d <- get bh + return (DeprecatedTxt d) ------------------------------------------------------------------------- -- Types from: BasicTypes diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 3e42fd4..73b0222 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -636,7 +636,7 @@ pprModIface iface , vcat (map ppr (mi_fam_insts iface)) , vcat (map ppr (mi_rules iface)) , pprVectInfo (mi_vect_info iface) - , pprDeprecs (mi_deprecs iface) + , ppr (mi_warns iface) ] where pp_boot | mi_boot iface = ptext (sLit "[boot]") @@ -709,12 +709,15 @@ pprVectInfo (IfaceVectInfo { ifaceVectInfoVar = vars , ptext (sLit "vectorised reused tycons:") <+> hsep (map ppr tyconsReuse) ] -pprDeprecs :: Deprecations -> SDoc -pprDeprecs NoDeprecs = empty -pprDeprecs (DeprecAll txt) = ptext (sLit "Deprecate all") <+> doubleQuotes (ftext txt) -pprDeprecs (DeprecSome prs) = ptext (sLit "Deprecate") <+> vcat (map pprDeprec prs) - where - pprDeprec (name, txt) = ppr name <+> doubleQuotes (ftext txt) +instance Outputable Warnings where + ppr = pprWarns + +pprWarns :: Warnings -> SDoc +pprWarns NoWarnings = empty +pprWarns (WarnAll txt) = ptext (sLit "Warn all") <+> ppr txt +pprWarns (WarnSome prs) = ptext (sLit "Warnings") + <+> vcat (map pprWarning prs) + where pprWarning (name, txt) = ppr name <+> ppr txt \end{code} diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index 79c09a8..f7f7348 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -126,11 +126,11 @@ mkIface hsc_env maybe_old_fingerprint mod_details mg_dir_imps = dir_imp_mods, mg_rdr_env = rdr_env, mg_fix_env = fix_env, - mg_deprecs = deprecs, + mg_warns = warns, mg_hpc_info = hpc_info } = mkIface_ hsc_env maybe_old_fingerprint this_mod is_boot used_names deps rdr_env - fix_env deprecs hpc_info dir_imp_mods mod_details + fix_env warns hpc_info dir_imp_mods mod_details -- | make an interface from the results of typechecking only. Useful -- for non-optimising compilation, or where we aren't generating any @@ -147,7 +147,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint mod_details tcg_imports = imports, tcg_rdr_env = rdr_env, tcg_fix_env = fix_env, - tcg_deprecs = deprecs, + tcg_warns = warns, tcg_hpc = other_hpc_info } = do @@ -156,7 +156,7 @@ mkIfaceTc hsc_env maybe_old_fingerprint mod_details let hpc_info = emptyHpcInfo other_hpc_info mkIface_ hsc_env maybe_old_fingerprint this_mod (isHsBoot hsc_src) used_names deps rdr_env - fix_env deprecs hpc_info (imp_mods imports) mod_details + fix_env warns hpc_info (imp_mods imports) mod_details mkUsedNames :: TcGblEnv -> IO NameSet @@ -208,12 +208,12 @@ mkDependencies mkIface_ :: HscEnv -> Maybe Fingerprint -> Module -> IsBootInterface -> NameSet -> Dependencies -> GlobalRdrEnv - -> NameEnv FixItem -> Deprecations -> HpcInfo + -> NameEnv FixItem -> Warnings -> HpcInfo -> ImportedMods -> ModDetails -> IO (ModIface, Bool) mkIface_ hsc_env maybe_old_fingerprint - this_mod is_boot used_names deps rdr_env fix_env src_deprecs hpc_info + this_mod is_boot used_names deps rdr_env fix_env src_warns hpc_info dir_imp_mods ModDetails{ md_insts = insts, md_fam_insts = fam_insts, @@ -240,7 +240,7 @@ mkIface_ hsc_env maybe_old_fingerprint -- Sigh: see Note [Root-main Id] in TcRnDriver ; fixities = [(occ,fix) | FixItem occ fix <- nameEnvElts fix_env] - ; deprecs = src_deprecs + ; warns = src_warns ; iface_rules = map (coreRuleToIfaceRule this_mod) rules ; iface_insts = map instanceToIfaceInst insts ; iface_fam_insts = map famInstToIfaceFamInst fam_insts @@ -262,7 +262,7 @@ mkIface_ hsc_env maybe_old_fingerprint mi_vect_info = iface_vect_info, mi_fixities = fixities, - mi_deprecs = deprecs, + mi_warns = warns, mi_globals = Just rdr_env, -- Left out deliberately: filled in by addVersionInfo @@ -278,7 +278,7 @@ mkIface_ hsc_env maybe_old_fingerprint mi_hpc = isHpcUsed hpc_info, -- And build the cached values - mi_dep_fn = mkIfaceDepCache deprecs, + mi_warn_fn = mkIfaceWarnCache warns, mi_fix_fn = mkIfaceFixCache fixities } } @@ -522,7 +522,7 @@ addFingerprints hsc_env mb_old_fingerprint iface0 new_decls (map fst sorted_decls, export_hash, orphan_hash, - mi_deprecs iface0) + mi_warns iface0) -- The interface hash depends on: -- - the ABI hash, plus diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 18c5f89..ad327bd 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -169,7 +169,7 @@ data DynFlag | Opt_WarnUnusedBinds | Opt_WarnUnusedImports | Opt_WarnUnusedMatches - | Opt_WarnDeprecations + | Opt_WarnWarningsDeprecations | Opt_WarnDeprecatedFlags | Opt_WarnDodgyImports | Opt_WarnOrphans @@ -756,7 +756,7 @@ optLevelFlags standardWarnings :: [DynFlag] standardWarnings - = [ Opt_WarnDeprecations, + = [ Opt_WarnWarningsDeprecations, Opt_WarnDeprecatedFlags, Opt_WarnOverlappingPatterns, Opt_WarnMissingFields, @@ -1407,7 +1407,7 @@ fFlags = [ ( "warn-unused-binds", Opt_WarnUnusedBinds, const Supported ), ( "warn-unused-imports", Opt_WarnUnusedImports, const Supported ), ( "warn-unused-matches", Opt_WarnUnusedMatches, const Supported ), - ( "warn-deprecations", Opt_WarnDeprecations, const Supported ), + ( "warn-warnings-deprecations", Opt_WarnWarningsDeprecations, const Supported ), ( "warn-deprecated-flags", Opt_WarnDeprecatedFlags, const Supported ), ( "warn-orphans", Opt_WarnOrphans, const Supported ), ( "warn-tabs", Opt_WarnTabs, const Supported ), diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 37e9047..87d07de 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -994,7 +994,7 @@ mkModGuts coreModule = ModGuts { mg_rules = [], mg_binds = cm_binds coreModule, mg_foreign = NoStubs, - mg_deprecs = NoDeprecs, + mg_warns = NoWarnings, mg_hpc_info = emptyHpcInfo False, mg_modBreaks = emptyModBreaks, mg_vect_info = noVectInfo, diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index 244b312..d5b6231 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -32,8 +32,8 @@ module HscTypes ( icPrintUnqual, mkPrintUnqualified, extendInteractiveContext, substInteractiveContext, - ModIface(..), mkIfaceDepCache, mkIfaceHashCache, mkIfaceFixCache, - emptyIfaceDepCache, + ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache, + emptyIfaceWarnCache, FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv, @@ -52,7 +52,7 @@ module HscTypes ( GenAvailInfo(..), AvailInfo, RdrAvailInfo, IfaceExport, - Deprecations(..), DeprecTxt, plusDeprecs, + Warnings(..), WarningTxt(..), plusWarns, PackageInstEnv, PackageRuleBase, @@ -101,7 +101,7 @@ import PrelNames ( gHC_PRIM ) import Packages hiding ( Version(..) ) import DynFlags ( DynFlags(..), isOneShot, HscTarget (..) ) import DriverPhases ( HscSource(..), isHsBoot, hscSourceString, Phase ) -import BasicTypes ( IPName, Fixity, defaultFixity, DeprecTxt ) +import BasicTypes ( IPName, Fixity, defaultFixity, WarningTxt(..) ) import OptimizationFuel ( OptFuelState ) import IfaceSyn import FiniteMap ( FiniteMap ) @@ -445,8 +445,8 @@ data ModIface mi_fixities :: [(OccName,Fixity)], -- NOT STRICT! we read this field lazily from the interface file - -- Deprecations - mi_deprecs :: Deprecations, + -- Warnings + mi_warns :: Warnings, -- NOT STRICT! we read this field lazily from the interface file -- Type, class and variable declarations @@ -485,7 +485,7 @@ data ModIface -- Cached environments for easy lookup -- These are computed (lazily) from other fields -- and are not put into the interface file - mi_dep_fn :: Name -> Maybe DeprecTxt, -- Cached lookup for mi_deprecs + mi_warn_fn :: Name -> Maybe WarningTxt, -- Cached lookup for mi_warns mi_fix_fn :: OccName -> Fixity, -- Cached lookup for mi_fixities mi_hash_fn :: OccName -> Maybe (OccName, Fingerprint), -- Cached lookup for mi_decls @@ -546,7 +546,7 @@ data ModGuts mg_rules :: ![CoreRule], -- Rules from this module mg_binds :: ![CoreBind], -- Bindings for this module mg_foreign :: !ForeignStubs, - mg_deprecs :: !Deprecations, -- Deprecations declared in the module + mg_warns :: !Warnings, -- Warnings declared in the module mg_hpc_info :: !HpcInfo, -- info about coverage tick boxes mg_modBreaks :: !ModBreaks, mg_vect_info :: !VectInfo, -- Pool of vectorised declarations @@ -656,7 +656,7 @@ emptyModIface mod mi_exports = [], mi_exp_hash = fingerprint0, mi_fixities = [], - mi_deprecs = NoDeprecs, + mi_warns = NoWarnings, mi_insts = [], mi_fam_insts = [], mi_rules = [], @@ -664,7 +664,7 @@ emptyModIface mod mi_globals = Nothing, mi_orphan_hash = fingerprint0, mi_vect_info = noIfaceVectInfo, - mi_dep_fn = emptyIfaceDepCache, + mi_warn_fn = emptyIfaceWarnCache, mi_fix_fn = emptyIfaceFixCache, mi_hash_fn = emptyIfaceHashCache, mi_hpc = False @@ -1004,11 +1004,11 @@ These types are defined here because they are mentioned in ModDetails, but they are mostly elaborated elsewhere \begin{code} ------------------- Deprecations ------------------------- -data Deprecations - = NoDeprecs - | DeprecAll DeprecTxt -- Whole module deprecated - | DeprecSome [(OccName,DeprecTxt)] -- Some specific things deprecated +------------------ Warnings ------------------------- +data Warnings + = NoWarnings + | WarnAll WarningTxt -- Whole module deprecated + | WarnSome [(OccName,WarningTxt)] -- Some specific things deprecated -- Only an OccName is needed because -- (1) a deprecation always applies to a binding -- defined in the module in which the deprecation appears. @@ -1031,20 +1031,20 @@ data Deprecations -- a Name to its fixity declaration. deriving( Eq ) -mkIfaceDepCache :: Deprecations -> Name -> Maybe DeprecTxt -mkIfaceDepCache NoDeprecs = \_ -> Nothing -mkIfaceDepCache (DeprecAll t) = \_ -> Just t -mkIfaceDepCache (DeprecSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName +mkIfaceWarnCache :: Warnings -> Name -> Maybe WarningTxt +mkIfaceWarnCache NoWarnings = \_ -> Nothing +mkIfaceWarnCache (WarnAll t) = \_ -> Just t +mkIfaceWarnCache (WarnSome pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName -emptyIfaceDepCache :: Name -> Maybe DeprecTxt -emptyIfaceDepCache _ = Nothing +emptyIfaceWarnCache :: Name -> Maybe WarningTxt +emptyIfaceWarnCache _ = Nothing -plusDeprecs :: Deprecations -> Deprecations -> Deprecations -plusDeprecs d NoDeprecs = d -plusDeprecs NoDeprecs d = d -plusDeprecs _ (DeprecAll t) = DeprecAll t -plusDeprecs (DeprecAll t) _ = DeprecAll t -plusDeprecs (DeprecSome v1) (DeprecSome v2) = DeprecSome (v1 ++ v2) +plusWarns :: Warnings -> Warnings -> Warnings +plusWarns d NoWarnings = d +plusWarns NoWarnings d = d +plusWarns _ (WarnAll t) = WarnAll t +plusWarns (WarnAll t) _ = WarnAll t +plusWarns (WarnSome v1) (WarnSome v2) = WarnSome (v1 ++ v2) \end{code} @@ -1230,7 +1230,7 @@ data ExternalPackageState -- * Fingerprint info -- * Its exports -- * Fixities - -- * Deprecations + -- * Warnings eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index 525d50b..b3cab49 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -248,6 +248,8 @@ $tab+ { warn Opt_WarnTabs (text "Tab character") } $whitechar* (NO(T?)INLINE|no(t?)inline) { token (ITspec_inline_prag False) } "{-#" $whitechar* (SOURCE|source) { token ITsource_prag } + "{-#" $whitechar* (WARNING|warning) + { token ITwarning_prag } "{-#" $whitechar* (DEPRECATED|deprecated) { token ITdeprecated_prag } "{-#" $whitechar* (SCC|scc) { token ITscc_prag } @@ -466,6 +468,7 @@ data Token | ITspec_inline_prag Bool -- SPECIALISE INLINE (or NOINLINE) | ITsource_prag | ITrules_prag + | ITwarning_prag | ITdeprecated_prag | ITline_prag | ITscc_prag diff --git a/compiler/parser/Parser.y.pp b/compiler/parser/Parser.y.pp index 4552fe2..86ce98c 100644 --- a/compiler/parser/Parser.y.pp +++ b/compiler/parser/Parser.y.pp @@ -28,7 +28,7 @@ module Parser ( parseModule, parseStmt, parseIdentifier, parseType, import HsSyn import RdrHsSyn -import HscTypes ( IsBootInterface, DeprecTxt ) +import HscTypes ( IsBootInterface, WarningTxt(..) ) import Lexer import RdrName import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon, @@ -262,6 +262,7 @@ incorrect. '{-# SCC' { L _ ITscc_prag } '{-# GENERATED' { L _ ITgenerated_prag } '{-# DEPRECATED' { L _ ITdeprecated_prag } + '{-# WARNING' { L _ ITwarning_prag } '{-# UNPACK' { L _ ITunpack_prag } '#-}' { L _ ITclose_prag } @@ -375,7 +376,7 @@ identifier :: { Located RdrName } -- know what they are doing. :-) module :: { Located (HsModule RdrName) } - : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' body + : maybedocheader 'module' modid maybemodwarning maybeexports 'where' body {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) -> return (L loc (HsModule (Just $3) $5 (fst $7) (snd $7) $4 info doc) )}} @@ -392,9 +393,10 @@ maybedocheader :: { (HaddockModInfo RdrName, Maybe (HsDoc RdrName)) } missing_module_keyword :: { () } : {- empty -} {% pushCurrentContext } -maybemoddeprec :: { Maybe DeprecTxt } - : '{-# DEPRECATED' STRING '#-}' { Just (getSTRING $2) } - | {- empty -} { Nothing } +maybemodwarning :: { Maybe WarningTxt } + : '{-# DEPRECATED' STRING '#-}' { Just (DeprecatedTxt (getSTRING $2)) } + | '{-# WARNING' STRING '#-}' { Just (WarningTxt (getSTRING $2)) } + | {- empty -} { Nothing } body :: { ([LImportDecl RdrName], [LHsDecl RdrName]) } : '{' top '}' { $2 } @@ -416,7 +418,7 @@ cvtopdecls :: { [LHsDecl RdrName] } -- Module declaration & imports only header :: { Located (HsModule RdrName) } - : maybedocheader 'module' modid maybemoddeprec maybeexports 'where' header_body + : maybedocheader 'module' modid maybemodwarning maybeexports 'where' header_body {% fileSrcSpan >>= \ loc -> case $1 of { (info, doc) -> return (L loc (HsModule (Just $3) $5 $7 [] $4 info doc))}} @@ -550,7 +552,8 @@ topdecl :: { OrdList (LHsDecl RdrName) } | stand_alone_deriving { unitOL (LL (DerivD (unLoc $1))) } | 'default' '(' comma_types0 ')' { unitOL (LL $ DefD (DefaultDecl $3)) } | 'foreign' fdecl { unitOL (LL (unLoc $2)) } - | '{-# DEPRECATED' deprecations '#-}' { $2 } + | '{-# DEPRECATED' deprecations '#-}' { $2 } + | '{-# WARNING' warnings '#-}' { $2 } | '{-# RULES' rules '#-}' { $2 } | decl { unLoc $1 } @@ -891,7 +894,19 @@ rule_var :: { RuleBndr RdrName } | '(' varid '::' ctype ')' { RuleBndrSig $2 $4 } ----------------------------------------------------------------------------- --- Deprecations (c.f. rules) +-- Warnings and deprecations (c.f. rules) + +warnings :: { OrdList (LHsDecl RdrName) } + : warnings ';' warning { $1 `appOL` $3 } + | warnings ';' { $1 } + | warning { $1 } + | {- empty -} { nilOL } + +-- SUP: TEMPORARY HACK, not checking for `module Foo' +warning :: { OrdList (LHsDecl RdrName) } + : namelist STRING + { toOL [ LL $ WarningD (Warning n (WarningTxt (getSTRING $2))) + | n <- unLoc $1 ] } deprecations :: { OrdList (LHsDecl RdrName) } : deprecations ';' deprecation { $1 `appOL` $3 } @@ -901,8 +916,8 @@ deprecations :: { OrdList (LHsDecl RdrName) } -- SUP: TEMPORARY HACK, not checking for `module Foo' deprecation :: { OrdList (LHsDecl RdrName) } - : depreclist STRING - { toOL [ LL $ DeprecD (Deprecation n (getSTRING $2)) + : namelist STRING + { toOL [ LL $ WarningD (Warning n (DeprecatedTxt (getSTRING $2))) | n <- unLoc $1 ] } @@ -1316,7 +1331,7 @@ exp10 :: { LHsExpr RdrName } | fexp { $1 } scc_annot :: { Located FastString } - : '_scc_' STRING {% (addWarning Opt_WarnDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ -> + : '_scc_' STRING {% (addWarning Opt_WarnWarningsDeprecations (getLoc $1) (text "_scc_ is deprecated; use an SCC pragma instead")) >>= \_ -> ( do scc <- getSCC $2; return $ LL scc ) } | '{-# SCC' STRING '#-}' {% do scc <- getSCC $2; return $ LL scc } @@ -1648,15 +1663,15 @@ ipvar :: { Located (IPName RdrName) } : IPDUPVARID { L1 (IPName (mkUnqual varName (getIPDUPVARID $1))) } ----------------------------------------------------------------------------- --- Deprecations +-- Warnings and deprecations -depreclist :: { Located [RdrName] } -depreclist : deprec_var { L1 [unLoc $1] } - | deprec_var ',' depreclist { LL (unLoc $1 : unLoc $3) } +namelist :: { Located [RdrName] } +namelist : name_var { L1 [unLoc $1] } + | name_var ',' namelist { LL (unLoc $1 : unLoc $3) } -deprec_var :: { Located RdrName } -deprec_var : var { $1 } - | con { $1 } +name_var :: { Located RdrName } +name_var : var { $1 } + | con { $1 } ----------------------------------------- -- Data constructors diff --git a/compiler/parser/RdrHsSyn.lhs b/compiler/parser/RdrHsSyn.lhs index aeb80a2..7b9dc14 100644 --- a/compiler/parser/RdrHsSyn.lhs +++ b/compiler/parser/RdrHsSyn.lhs @@ -347,8 +347,8 @@ add gp@(HsGroup {hs_defds = ts}) l (DefD d) ds = addl (gp { hs_defds = L l d : ts }) ds add gp@(HsGroup {hs_fords = ts}) l (ForD d) ds = addl (gp { hs_fords = L l d : ts }) ds -add gp@(HsGroup {hs_depds = ts}) l (DeprecD d) ds - = addl (gp { hs_depds = L l d : ts }) ds +add gp@(HsGroup {hs_warnds = ts}) l (WarningD d) ds + = addl (gp { hs_warnds = L l d : ts }) ds add gp@(HsGroup {hs_ruleds = ts}) l (RuleD d) ds = addl (gp { hs_ruleds = L l d : ts }) ds diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index e79bfba..7aad117 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -7,7 +7,7 @@ module RnNames ( rnImports, getLocalNonValBinders, rnExports, extendGlobalRdrEnvRn, - reportUnusedNames, finishDeprecations, + reportUnusedNames, finishWarnings, ) where #include "HsVersions.h" @@ -33,7 +33,7 @@ import Maybes import SrcLoc import FiniteMap import ErrUtils -import BasicTypes ( DeprecTxt ) +import BasicTypes ( WarningTxt(..) ) import DriverPhases ( isHsBoot ) import Util import FastString @@ -143,7 +143,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot let imp_mod = mi_module iface - deprecs = mi_deprecs iface + warns = mi_warns iface orph_iface = mi_orphan iface has_finsts = mi_finsts iface deps = mi_deps iface @@ -233,10 +233,10 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot } -- Complain if we import a deprecated module - ifOptM Opt_WarnDeprecations ( - case deprecs of - DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt) - _ -> return () + ifOptM Opt_WarnWarningsDeprecations ( + case warns of + WarnAll txt -> addWarn (moduleWarn imp_mod_name txt) + _ -> return () ) let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot @@ -966,23 +966,23 @@ check_occs ie occs names %********************************************************* \begin{code} -finishDeprecations :: DynFlags -> Maybe DeprecTxt - -> TcGblEnv -> RnM TcGblEnv --- (a) Report usasge of deprecated imports --- (b) If the whole module is deprecated, update tcg_deprecs --- All this happens only once per module -finishDeprecations dflags mod_deprec tcg_env +finishWarnings :: DynFlags -> Maybe WarningTxt + -> TcGblEnv -> RnM TcGblEnv +-- (a) Report usage of imports that are deprecated or have other warnings +-- (b) If the whole module is warned about or deprecated, update tcg_warns +-- All this happens only once per module +finishWarnings dflags mod_warn tcg_env = do { (eps,hpt) <- getEpsAndHpt - ; ifOptM Opt_WarnDeprecations $ + ; ifOptM Opt_WarnWarningsDeprecations $ mapM_ (check hpt (eps_PIT eps)) all_gres -- By this time, typechecking is complete, -- so the PIT is fully populated - -- Deal with a module deprecation; it overrides all existing deprecs - ; let new_deprecs = case mod_deprec of - Just txt -> DeprecAll txt - Nothing -> tcg_deprecs tcg_env - ; return (tcg_env { tcg_deprecs = new_deprecs }) } + -- Deal with a module deprecation; it overrides all existing warns + ; let new_warns = case mod_warn of + Just txt -> WarnAll txt + Nothing -> tcg_warns tcg_env + ; return (tcg_env { tcg_warns = new_warns }) } where used_names = allUses (tcg_dus tcg_env) -- Report on all deprecated uses; hence allUses @@ -992,7 +992,7 @@ finishDeprecations dflags mod_deprec tcg_env | name `elemNameSet` used_names , Just deprec_txt <- lookupImpDeprec dflags hpt pit gre = addWarnAt (importSpecLoc imp_spec) - (sep [ptext (sLit "Deprecated use of") <+> + (sep [ptext (sLit "In the use of") <+> pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> quotes (ppr name), (parens imp_msg) <> colon, @@ -1013,13 +1013,13 @@ finishDeprecations dflags mod_deprec tcg_env -- interface lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable - -> GlobalRdrElt -> Maybe DeprecTxt + -> GlobalRdrElt -> Maybe WarningTxt -- The name is definitely imported, so look in HPT, PIT lookupImpDeprec dflags hpt pit gre = case lookupIfaceByModule dflags hpt pit (nameModule name) of - Just iface -> mi_dep_fn iface name `mplus` -- Bleat if the thing, *or + Just iface -> mi_warn_fn iface name `mplus` -- Bleat if the thing, *or case gre_par gre of - ParentIs p -> mi_dep_fn iface p -- its parent*, is deprec'd + ParentIs p -> mi_warn_fn iface p -- its parent*, is warn'd NoParent -> Nothing Nothing -> Nothing -- See Note [Used names with interface not loaded] @@ -1428,10 +1428,14 @@ nullModuleExport :: ModuleName -> SDoc nullModuleExport mod = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing") -moduleDeprec :: ModuleName -> DeprecTxt -> SDoc -moduleDeprec mod txt - = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <+> ptext (sLit "is deprecated:"), - nest 4 (ppr txt) ] +moduleWarn :: ModuleName -> WarningTxt -> SDoc +moduleWarn mod (WarningTxt txt) + = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), + nest 4 (ppr txt) ] +moduleWarn mod (DeprecatedTxt txt) + = sep [ ptext (sLit "Module") <+> quotes (ppr mod) + <+> ptext (sLit "is deprecated:"), + nest 4 (ppr txt) ] implicitPreludeWarn :: SDoc implicitPreludeWarn diff --git a/compiler/rename/RnSource.lhs b/compiler/rename/RnSource.lhs index b64782d..6210a17 100644 --- a/compiler/rename/RnSource.lhs +++ b/compiler/rename/RnSource.lhs @@ -34,7 +34,7 @@ import HscTypes ( GenAvailInfo(..) ) import RnHsDoc ( rnHsDoc, rnMbLHsDoc ) import TcRnMonad -import HscTypes ( Deprecations(..), plusDeprecs ) +import HscTypes ( Warnings(..), plusWarns ) import Class ( FunDep ) import Name ( Name, nameOccName ) import NameSet @@ -104,7 +104,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, hs_instds = inst_decls, hs_derivds = deriv_decls, hs_fixds = fix_decls, - hs_depds = deprec_decls, + hs_warnds = warn_decls, hs_fords = foreign_decls, hs_defds = default_decls, hs_ruleds = rule_decls, @@ -169,7 +169,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, -- rename deprec decls; -- check for duplicates and ensure that deprecated things are defined locally -- at the moment, we don't keep these around past renaming - rn_deprecs <- rnSrcDeprecDecls deprec_decls ; + rn_warns <- rnSrcWarnDecls warn_decls ; -- (H) Rename Everything else @@ -187,7 +187,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, hs_instds = rn_inst_decls, hs_derivds = rn_deriv_decls, hs_fixds = rn_fix_decls, - hs_depds = [], -- deprecs are returned in the tcg_env + hs_warnds = [], -- warns are returned in the tcg_env -- (see below) not in the HsGroup hs_fords = rn_foreign_decls, hs_defds = rn_default_decls, @@ -204,7 +204,7 @@ rnSrcDecls shadowP group@(HsGroup {hs_valds = val_decls, final_tcg_env = let tcg_env' = (tcg_env `addTcgDUs` src_dus) in -- we return the deprecs in the env, not in the HsGroup above - tcg_env' { tcg_deprecs = tcg_deprecs tcg_env' `plusDeprecs` rn_deprecs }; + tcg_env' { tcg_warns = tcg_warns tcg_env' `plusWarns` rn_warns }; } ; traceRn (text "finish rnSrc" <+> ppr rn_group) ; @@ -300,17 +300,17 @@ gather them together. \begin{code} -- checks that the deprecations are defined locally, and that there are no duplicates -rnSrcDeprecDecls :: [LDeprecDecl RdrName] -> RnM Deprecations -rnSrcDeprecDecls [] - = returnM NoDeprecs +rnSrcWarnDecls :: [LWarnDecl RdrName] -> RnM Warnings +rnSrcWarnDecls [] + = returnM NoWarnings -rnSrcDeprecDecls decls +rnSrcWarnDecls decls = do { -- check for duplicates - ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupDeprecDecl lrdr')) deprec_rdr_dups + ; mappM_ (\ (lrdr:lrdr':_) -> addLocErr lrdr (dupWarnDecl lrdr')) warn_rdr_dups ; mappM (addLocM rn_deprec) decls `thenM` \ pairs_s -> - returnM (DeprecSome ((concat pairs_s))) } + returnM (WarnSome ((concat pairs_s))) } where - rn_deprec (Deprecation rdr_name txt) + rn_deprec (Warning rdr_name txt) -- ensures that the names are defined locally = lookupLocalDataTcNames rdr_name `thenM` \ names -> returnM [(nameOccName name, txt) | name <- names] @@ -318,13 +318,13 @@ rnSrcDeprecDecls decls -- look for duplicates among the OccNames; -- we check that the names are defined above -- invt: the lists returned by findDupsEq always have at least two elements - deprec_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y)) - (map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls) + warn_rdr_dups = findDupsEq (\ x -> \ y -> rdrNameOcc (unLoc x) == rdrNameOcc (unLoc y)) + (map (\ (L loc (Warning rdr_name _)) -> L loc rdr_name) decls) -dupDeprecDecl :: Located RdrName -> RdrName -> SDoc +dupWarnDecl :: Located RdrName -> RdrName -> SDoc -- Located RdrName -> DeprecDecl RdrName -> SDoc -dupDeprecDecl (L loc _) rdr_name - = vcat [ptext (sLit "Multiple deprecation declarations for") <+> quotes (ppr rdr_name), +dupWarnDecl (L loc _) rdr_name + = vcat [ptext (sLit "Multiple warning declarations for") <+> quotes (ppr rdr_name), ptext (sLit "also at ") <+> ppr loc] \end{code} diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 88695bc..bd76303 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -168,9 +168,9 @@ tcRnModule hsc_env hsc_src save_rn_syntax -- thing (especially via 'module Foo' export item) -- That is, only uses in the *body* of the module are complained about traceRn (text "rn3") ; - failIfErrsM ; -- finishDeprecations crashes sometimes + failIfErrsM ; -- finishWarnings crashes sometimes -- as a result of typechecker repairs (e.g. unboundNames) - tcg_env <- finishDeprecations (hsc_dflags hsc_env) mod_deprec tcg_env ; + tcg_env <- finishWarnings (hsc_dflags hsc_env) mod_deprec tcg_env ; -- Process the export list traceRn (text "rn4a: before exports"); @@ -338,7 +338,7 @@ tcRnExtCore hsc_env (HsExtCore this_mod decls src_binds) -- Stubs mg_rdr_env = emptyGlobalRdrEnv, mg_fix_env = emptyFixityEnv, - mg_deprecs = NoDeprecs, + mg_warns = NoWarnings, mg_foreign = NoStubs, mg_hpc_info = emptyHpcInfo False, mg_modBreaks = emptyModBreaks, diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 7f1a7fe..abdb44e 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -103,7 +103,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod do_this tcg_rn_decls = maybe_rn_syntax emptyRnGroup, tcg_binds = emptyLHsBinds, - tcg_deprecs = NoDeprecs, + tcg_warns = NoWarnings, tcg_insts = [], tcg_fam_insts= [], tcg_rules = [], diff --git a/compiler/typecheck/TcRnTypes.lhs b/compiler/typecheck/TcRnTypes.lhs index 20262c9..e70161c 100644 --- a/compiler/typecheck/TcRnTypes.lhs +++ b/compiler/typecheck/TcRnTypes.lhs @@ -219,7 +219,7 @@ data TcGblEnv -- Nothing <=> Don't retain renamed decls tcg_binds :: LHsBinds Id, -- Value bindings in this module - tcg_deprecs :: Deprecations, -- ...Deprecations + tcg_warns :: Warnings, -- ...Warnings and deprecations tcg_insts :: [Instance], -- ...Instances tcg_fam_insts :: [FamInst], -- ...Family instances tcg_rules :: [LRuleDecl Id], -- ...Rules diff --git a/docs/users_guide/flags.xml b/docs/users_guide/flags.xml index 8da67f8..f13d34c 100644 --- a/docs/users_guide/flags.xml +++ b/docs/users_guide/flags.xml @@ -1005,10 +1005,10 @@ - - warn about uses of functions & types that are deprecated + + warn about uses of functions & types that have warnings or deprecated pragmas dynamic - + diff --git a/docs/users_guide/glasgow_exts.xml b/docs/users_guide/glasgow_exts.xml index a100e43..0f55b9b 100644 --- a/docs/users_guide/glasgow_exts.xml +++ b/docs/users_guide/glasgow_exts.xml @@ -6162,56 +6162,63 @@ Assertion failures can be caught, see the documentation for the don't recommend using this approach with GHC. - - DEPRECATED pragma - DEPRECATED - + + WARNING and DEPRECATED pragmas + WARNING + DEPRECATED - The DEPRECATED pragma lets you specify that a particular - function, class, or type, is deprecated. There are two - forms. + The WARNING pragma allows you to attach an arbitrary warning + to a particular function, class, or type. + A DEPRECATED pragma lets you specify that + a particular function, class, or type is deprecated. + There are two ways of using these pragmas. - You can deprecate an entire module thus: + You can work on an entire module thus: module Wibble {-# DEPRECATED "Use Wobble instead" #-} where ... + Or: + + module Wibble {-# WARNING "This is an unstable interface." #-} where + ... + When you compile any module that import Wibble, GHC will print the specified message. - You can deprecate a function, class, type, or data constructor, with the - following top-level declaration: + You can attach a warning to a function, class, type, or data constructor, with the + following top-level declarations: {-# DEPRECATED f, C, T "Don't use these" #-} + {-# WARNING unsafePerformIO "This is unsafe; I hope you know what you're doing" #-} When you compile any module that imports and uses any of the specified entities, GHC will print the specified message. - You can only deprecate entities declared at top level in the module + You can only attach to entities declared at top level in the module being compiled, and you can only use unqualified names in the list of - entities being deprecated. A capitalised name, such as T + entities. A capitalised name, such as T refers to either the type constructor T or the data constructor T, or both if - both are in scope. If both are in scope, there is currently no way to deprecate - one without the other (c.f. fixities ). + both are in scope. If both are in scope, there is currently no way to + specify one without the other (c.f. fixities + ). - Any use of the deprecated item, or of anything from a deprecated - module, will be flagged with an appropriate message. However, - deprecations are not reported for - (a) uses of a deprecated function within its defining module, and - (b) uses of a deprecated function in an export list. + Warnings and deprecations are not reported for + (a) uses within the defining module, and + (b) uses in an export list. The latter reduces spurious complaints within a library in which one module gathers together and re-exports the exports of several others. You can suppress the warnings with the flag - . + . diff --git a/docs/users_guide/using.xml b/docs/users_guide/using.xml index 3c19be5..4b3024a 100644 --- a/docs/users_guide/using.xml +++ b/docs/users_guide/using.xml @@ -841,7 +841,7 @@ ghc -c Foo.hs of warnings which are generally likely to indicate bugs in your program. These are: , - , + , , , , @@ -919,15 +919,16 @@ ghc -c Foo.hs - : + : - + + warnings deprecations - Causes a warning to be emitted when a deprecated - function or type is used. Entities can be marked as - deprecated using a pragma, see . + Causes a warning to be emitted when a + module, function or type with a WARNING or DEPRECATED pragma + is used. See for more + details on the pragmas. This option is on by default. -- 1.7.10.4