Arity,
- DeprecTxt,
+ WarningTxt(..),
Fixity(..), FixityDirection(..),
defaultFixity, maxPrecedence,
\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}
%************************************************************************
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,
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,
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,
| SigD (Sig id)
| DefD (DefaultDecl id)
| ForD (ForeignDecl id)
- | DeprecD (DeprecDecl id)
+ | WarningD (WarnDecl id)
| RuleD (RuleDecl id)
| SpliceD (SpliceDecl id)
| DocD (DocDecl 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]
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 = [] }
hs_fixds = fixds1,
hs_defds = defds1,
hs_fords = fords1,
- hs_depds = depds1,
+ hs_warnds = warnds1,
hs_ruleds = rulds1,
hs_docs = docs1 }
HsGroup {
hs_fixds = fixds2,
hs_defds = defds2,
hs_fords = fords2,
- hs_depds = depds2,
+ hs_warnds = warnds2,
hs_ruleds = rulds2,
hs_docs = docs2 }
=
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}
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
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 })
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}
import HsLit
import HsPat
import HsTypes
-import BasicTypes ( Fixity, DeprecTxt )
+import BasicTypes ( Fixity, WarningTxt )
import HsUtils
import HsDoc
-- 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
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,
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
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
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,
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 })
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
, 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]")
, 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}
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
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
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
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,
-- 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
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
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 }
}
(map fst sorted_decls,
export_hash,
orphan_hash,
- mi_deprecs iface0)
+ mi_warns iface0)
-- The interface hash depends on:
-- - the ABI hash, plus
| Opt_WarnUnusedBinds
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
- | Opt_WarnDeprecations
+ | Opt_WarnWarningsDeprecations
| Opt_WarnDeprecatedFlags
| Opt_WarnDodgyImports
| Opt_WarnOrphans
standardWarnings :: [DynFlag]
standardWarnings
- = [ Opt_WarnDeprecations,
+ = [ Opt_WarnWarningsDeprecations,
Opt_WarnDeprecatedFlags,
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
( "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 ),
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,
icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
substInteractiveContext,
- ModIface(..), mkIfaceDepCache, mkIfaceHashCache, mkIfaceFixCache,
- emptyIfaceDepCache,
+ ModIface(..), mkIfaceWarnCache, mkIfaceHashCache, mkIfaceFixCache,
+ emptyIfaceWarnCache,
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
IfaceExport,
- Deprecations(..), DeprecTxt, plusDeprecs,
+ Warnings(..), WarningTxt(..), plusWarns,
PackageInstEnv, PackageRuleBase,
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 )
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
-- 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
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
mi_exports = [],
mi_exp_hash = fingerprint0,
mi_fixities = [],
- mi_deprecs = NoDeprecs,
+ mi_warns = NoWarnings,
mi_insts = [],
mi_fam_insts = [],
mi_rules = [],
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
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.
-- 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}
-- * Fingerprint info
-- * Its exports
-- * Fixities
- -- * Deprecations
+ -- * Warnings
eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules
$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 }
| ITspec_inline_prag Bool -- SPECIALISE INLINE (or NOINLINE)
| ITsource_prag
| ITrules_prag
+ | ITwarning_prag
| ITdeprecated_prag
| ITline_prag
| ITscc_prag
import HsSyn
import RdrHsSyn
-import HscTypes ( IsBootInterface, DeprecTxt )
+import HscTypes ( IsBootInterface, WarningTxt(..) )
import Lexer
import RdrName
import TysWiredIn ( unitTyCon, unitDataCon, tupleTyCon, tupleCon, nilDataCon,
'{-# SCC' { L _ ITscc_prag }
'{-# GENERATED' { L _ ITgenerated_prag }
'{-# DEPRECATED' { L _ ITdeprecated_prag }
+ '{-# WARNING' { L _ ITwarning_prag }
'{-# UNPACK' { L _ ITunpack_prag }
'#-}' { L _ ITclose_prag }
-- 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) )}}
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 }
-- 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))}}
| 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 }
| '(' 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 }
-- 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 ] }
| 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 }
: 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
= 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
module RnNames (
rnImports, getLocalNonValBinders,
rnExports, extendGlobalRdrEnvRn,
- reportUnusedNames, finishDeprecations,
+ reportUnusedNames, finishWarnings,
) where
#include "HsVersions.h"
import SrcLoc
import FiniteMap
import ErrUtils
-import BasicTypes ( DeprecTxt )
+import BasicTypes ( WarningTxt(..) )
import DriverPhases ( isHsBoot )
import Util
import FastString
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
}
-- 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
%*********************************************************
\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
| 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,
-- 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]
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
import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcRnMonad
-import HscTypes ( Deprecations(..), plusDeprecs )
+import HscTypes ( Warnings(..), plusWarns )
import Class ( FunDep )
import Name ( Name, nameOccName )
import NameSet
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,
-- 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
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,
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) ;
\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]
-- 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}
-- 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");
-- 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,
tcg_rn_decls = maybe_rn_syntax emptyRnGroup,
tcg_binds = emptyLHsBinds,
- tcg_deprecs = NoDeprecs,
+ tcg_warns = NoWarnings,
tcg_insts = [],
tcg_fam_insts= [],
tcg_rules = [],
-- 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
</row>
<row>
- <entry><option>-fwarn-deprecations</option></entry>
- <entry>warn about uses of functions & types that are deprecated</entry>
+ <entry><option>-fwarn-warnings-deprecations</option></entry>
+ <entry>warn about uses of functions & types that have warnings or deprecated pragmas</entry>
<entry>dynamic</entry>
- <entry><option>-fno-warn-deprecations</option></entry>
+ <entry><option>-fno-warn-warnings-deprecations</option></entry>
</row>
<row>
don't recommend using this approach with GHC.</para>
</sect2>
- <sect2 id="deprecated-pragma">
- <title>DEPRECATED pragma</title>
- <indexterm><primary>DEPRECATED</primary>
- </indexterm>
+ <sect2 id="warning-deprecated-pragma">
+ <title>WARNING and DEPRECATED pragmas</title>
+ <indexterm><primary>WARNING</primary></indexterm>
+ <indexterm><primary>DEPRECATED</primary></indexterm>
- <para>The DEPRECATED pragma lets you specify that a particular
- function, class, or type, is deprecated. There are two
- forms.
+ <para>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.
<itemizedlist>
<listitem>
- <para>You can deprecate an entire module thus:</para>
+ <para>You can work on an entire module thus:</para>
<programlisting>
module Wibble {-# DEPRECATED "Use Wobble instead" #-} where
...
</programlisting>
+ <para>Or:</para>
+<programlisting>
+ module Wibble {-# WARNING "This is an unstable interface." #-} where
+ ...
+</programlisting>
<para>When you compile any module that import
<literal>Wibble</literal>, GHC will print the specified
message.</para>
</listitem>
<listitem>
- <para>You can deprecate a function, class, type, or data constructor, with the
- following top-level declaration:</para>
+ <para>You can attach a warning to a function, class, type, or data constructor, with the
+ following top-level declarations:</para>
<programlisting>
{-# DEPRECATED f, C, T "Don't use these" #-}
+ {-# WARNING unsafePerformIO "This is unsafe; I hope you know what you're doing" #-}
</programlisting>
<para>When you compile any module that imports and uses any
of the specified entities, GHC will print the specified
message.</para>
- <para> You can only deprecate entities declared at top level in the module
+ <para> 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 <literal>T</literal>
+ entities. A capitalised name, such as <literal>T</literal>
refers to <emphasis>either</emphasis> the type constructor <literal>T</literal>
<emphasis>or</emphasis> the data constructor <literal>T</literal>, 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 <xref linkend="infix-tycons"/>).</para>
+ both are in scope. If both are in scope, there is currently no way to
+ specify one without the other (c.f. fixities
+ <xref linkend="infix-tycons"/>).</para>
</listitem>
</itemizedlist>
- 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.
</para>
<para>You can suppress the warnings with the flag
- <option>-fno-warn-deprecations</option>.</para>
+ <option>-fno-warn-warnings-deprecations</option>.</para>
</sect2>
<sect2 id="inline-noinline-pragma">
of warnings which are generally likely to indicate bugs in your
program. These are:
<option>-fwarn-overlapping-patterns</option>,
- <option>-fwarn-deprecations</option>,
+ <option>-fwarn-warnings-deprecations</option>,
<option>-fwarn-deprecated-flags</option>,
<option>-fwarn-duplicate-exports</option>,
<option>-fwarn-missing-fields</option>,
<variablelist>
<varlistentry>
- <term><option>-fwarn-deprecations</option>:</term>
+ <term><option>-fwarn-warnings-deprecations</option>:</term>
<listitem>
- <indexterm><primary><option>-fwarn-deprecations</option></primary>
+ <indexterm><primary><option>-fwarn-warnings-deprecations</option></primary>
</indexterm>
+ <indexterm><primary>warnings</primary></indexterm>
<indexterm><primary>deprecations</primary></indexterm>
- <para>Causes a warning to be emitted when a deprecated
- function or type is used. Entities can be marked as
- deprecated using a pragma, see <xref
- linkend="deprecated-pragma"/>.</para>
+ <para>Causes a warning to be emitted when a
+ module, function or type with a WARNING or DEPRECATED pragma
+ is used. See <xref linkend="warning-deprecated-pragma"/> for more
+ details on the pragmas.</para>
<para>This option is on by default.</para>
</listitem>
projects / ghc-hetmet.git / commitdiff