Skip to content
GitLab
Menu
Projects
Groups
Snippets
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
cae75f82
Commit
cae75f82
authored
Jul 20, 2008
by
Ian Lynagh
Browse files
Add a WARNING pragma
parent
35c21b89
Changes
21
Hide whitespace changes
Inline
Side-by-side
compiler/basicTypes/BasicTypes.lhs
View file @
cae75f82
...
...
@@ -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}
%************************************************************************
...
...
compiler/deSugar/Desugar.lhs
View file @
cae75f82
...
...
@@ -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_
deprec
s =
deprec
s,
tcg_
warn
s =
warn
s,
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_
deprec
s =
deprec
s,
mg_
warn
s =
warn
s,
mg_types = type_env,
mg_insts = insts,
mg_fam_insts = fam_insts,
...
...
compiler/hsSyn/HsDecls.lhs
View file @
cae75f82
...
...
@@ -27,7 +27,7 @@ module HsDecls (
ConDecl(..), ResType(..), ConDeclField(..), LConDecl,
HsConDeclDetails, hsConDeclArgTys,
DocDecl(..), LDocDecl, docDeclDoc,
Deprec
Decl(..), L
Deprec
Decl,
Warn
Decl(..), L
Warn
Decl,
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 (Deprec
Decl id)
|
WarningD (Warn
Decl 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_
dep
ds
:: [L
Deprec
Decl id],
hs_
warn
ds :: [L
Warn
Decl 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_
dep
ds = [], hs_ruleds = [],
hs_
warn
ds = [], 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_
dep
ds
=
dep
ds1,
hs_
warn
ds =
warn
ds1,
hs_ruleds = rulds1,
hs_docs = docs1 }
HsGroup {
...
...
@@ -150,7 +150,7 @@ appendGroups
hs_fixds = fixds2,
hs_defds = defds2,
hs_fords = fords2,
hs_
dep
ds
=
dep
ds2,
hs_
warn
ds =
warn
ds2,
hs_ruleds = rulds2,
hs_docs = docs2 }
=
...
...
@@ -162,7 +162,7 @@ appendGroups
hs_fixds = fixds1 ++ fixds2,
hs_defds = defds1 ++ defds2,
hs_fords = fords1 ++ fords2,
hs_
dep
ds
=
dep
ds1 ++
dep
ds2,
hs_
warn
ds =
warn
ds1 ++
warn
ds2,
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 (
Deprec
D
d
d)
= ppr
d
d
ppr (
Warning
D
w
d) = ppr
w
d
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_
dep
ds
= deprec_decls,
hs_
warn
ds = 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 L
Deprec
Decl name = Located (
Deprec
Decl name)
type L
Warn
Decl name = Located (
Warn
Decl name)
data
Deprec
Decl name =
Deprecation name Deprec
Txt
data
Warn
Decl name =
Warning name Warning
Txt
instance OutputableBndr name => Outputable (
Deprec
Decl name) where
ppr (
Deprecation
thing txt)
instance OutputableBndr name => Outputable (
Warn
Decl name) where
ppr (
Warning
thing txt)
= hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
\end{code}
compiler/hsSyn/HsSyn.lhs
View file @
cae75f82
...
...
@@ -35,7 +35,7 @@ import HsImpExp
import HsLit
import HsPat
import HsTypes
import BasicTypes ( Fixity,
Deprec
Txt )
import BasicTypes ( Fixity,
Warning
Txt )
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
Deprec
Txt) -- reason/explanation for deprecation of this module
(Maybe
Warning
Txt) -- reason/explanation for
warning/
deprecation of this module
(HaddockModInfo name) -- Haddock module info
(Maybe (HsDoc name)) -- Haddock module description
...
...
compiler/iface/BinIface.hs
View file @
cae75f82
...
...
@@ -373,7 +373,7 @@ instance Binary ModIface where
mi_exports
=
exports
,
mi_exp_hash
=
exp_hash
,
mi_fixities
=
fixities
,
mi_
deprecs
=
deprec
s
,
mi_
warns
=
warn
s
,
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
deprec
s
lazyPut
bh
warn
s
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_
deprec
s" #-}
lazyGet
bh
warns
<-
{-# SCC "bin_
warn
s" #-}
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
=
deprec
s
,
mi_
warns
=
warn
s
,
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
=
mkIface
Dep
Cache
deprec
s
,
mi_
warn
_fn
=
mkIface
Warn
Cache
warn
s
,
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
Deprecation
s
where
put_
bh
No
Deprec
s
=
putByte
bh
0
put_
bh
(
Deprec
All
t
)
=
do
putByte
bh
1
put_
bh
t
put_
bh
(
Deprec
Some
ts
)
=
do
putByte
bh
2
put_
bh
ts
instance
Binary
Warning
s
where
put_
bh
No
Warning
s
=
putByte
bh
0
put_
bh
(
Warn
All
t
)
=
do
putByte
bh
1
put_
bh
t
put_
bh
(
Warn
Some
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
...
...
compiler/iface/LoadIface.lhs
View file @
cae75f82
...
...
@@ -636,7 +636,7 @@ pprModIface iface
, vcat (map ppr (mi_fam_insts iface))
, vcat (map ppr (mi_rules iface))
, pprVectInfo (mi_vect_info iface)
, ppr
Deprecs (mi_deprec
s iface)
, ppr
(mi_warn
s 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}
...
...
compiler/iface/MkIface.lhs
View file @
cae75f82
...
...
@@ -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 = deprec
s,
mg_
warns = warn
s,
mg_hpc_info = hpc_info }
= mkIface_ hsc_env maybe_old_fingerprint
this_mod is_boot used_names deps rdr_env
fix_env
deprec
s hpc_info dir_imp_mods mod_details
fix_env
warn
s 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 = deprec
s,
tcg_
warns = warn
s,
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
deprec
s hpc_info (imp_mods imports) mod_details
fix_env
warn
s 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 ->
Deprecation
s -> HpcInfo
-> NameEnv FixItem ->
Warning
s -> HpcInfo
-> ImportedMods
-> ModDetails
-> IO (ModIface, Bool)
mkIface_ hsc_env maybe_old_fingerprint
this_mod is_boot used_names deps rdr_env fix_env src_
deprec
s hpc_info
this_mod is_boot used_names deps rdr_env fix_env src_
warn
s 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]
;
deprec
s = src_
deprec
s
;
warn
s = src_
warn
s
; 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 = deprec
s,
mi_
warns = warn
s,
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 = mkIface
Dep
Cache
deprec
s,
mi_
warn
_fn = mkIface
Warn
Cache
warn
s,
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_
deprec
s iface0)
mi_
warn
s iface0)
-- The interface hash depends on:
-- - the ABI hash, plus
...
...
compiler/main/DynFlags.hs
View file @
cae75f82
...
...
@@ -169,7 +169,7 @@ data DynFlag
|
Opt_WarnUnusedBinds
|
Opt_WarnUnusedImports
|
Opt_WarnUnusedMatches
|
Opt_WarnDeprecations
|
Opt_Warn
Warnings
Deprecations
|
Opt_WarnDeprecatedFlags
|
Opt_WarnDodgyImports
|
Opt_WarnOrphans
...
...
@@ -756,7 +756,7 @@ optLevelFlags
standardWarnings
::
[
DynFlag
]
standardWarnings
=
[
Opt_WarnDeprecations
,
=
[
Opt_Warn
Warnings
Deprecations
,
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_Warn
Warnings
Deprecations
,
const
Supported
),
(
"warn-deprecated-flags"
,
Opt_WarnDeprecatedFlags
,
const
Supported
),
(
"warn-orphans"
,
Opt_WarnOrphans
,
const
Supported
),
(
"warn-tabs"
,
Opt_WarnTabs
,
const
Supported
),
...
...
compiler/main/GHC.hs
View file @
cae75f82
...
...
@@ -994,7 +994,7 @@ mkModGuts coreModule = ModGuts {
mg_rules
=
[]
,
mg_binds
=
cm_binds
coreModule
,
mg_foreign
=
NoStubs
,
mg_
deprecs
=
NoDeprec
s
,
mg_
warns
=
NoWarning
s
,
mg_hpc_info
=
emptyHpcInfo
False
,
mg_modBreaks
=
emptyModBreaks
,
mg_vect_info
=
noVectInfo
,
...
...
compiler/main/HscTypes.lhs
View file @
cae75f82
...
...
@@ -32,8 +32,8 @@ module HscTypes (
icPrintUnqual, mkPrintUnqualified, extendInteractiveContext,
substInteractiveContext,
ModIface(..), mkIface
Dep
Cache, mkIfaceHashCache, mkIfaceFixCache,
emptyIface
Dep
Cache,
ModIface(..), mkIface
Warn
Cache, mkIfaceHashCache, mkIfaceFixCache,
emptyIface
Warn
Cache,
FixityEnv, FixItem(..), lookupFixity, emptyFixityEnv,
...
...
@@ -52,7 +52,7 @@ module HscTypes (
GenAvailInfo(..), AvailInfo, RdrAvailInfo,
IfaceExport,
Deprecations(..), DeprecTxt, plusDeprec
s,
Warnings(..), WarningTxt(..), plusWarn
s,
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
--
Deprecation
s
mi_
deprecs :: Deprecation
s,
--
Warning
s
mi_
warns :: Warning
s,
-- 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
Deprec
Txt, -- Cached lookup for mi_
deprec
s
mi_
warn
_fn :: Name -> Maybe
Warning
Txt, -- Cached lookup for mi_
warn
s
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, -- Deprecation
s declared in the module
mg_
warns
:: !
Warnings, -- Warning
s 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 = NoDeprec
s,
mi_
warns = NoWarning
s,
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 = emptyIface
Dep
Cache,
mi_
warn
_fn = emptyIface
Warn
Cache,
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}
------------------
Deprecation
s -------------------------
data
Deprecation
s
= No
Deprec
s
|
DeprecAll Deprec
Txt -- Whole module deprecated
|
Deprec
Some [(OccName,
Deprec
Txt)] -- Some specific things deprecated
------------------
Warning
s -------------------------
data
Warning
s
= No
Warning
s
|
WarnAll Warning
Txt -- Whole module deprecated
|
Warn
Some [(OccName,
Warning
Txt)] -- 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 )
mkIface
Dep
Cache ::
Deprecation
s -> Name -> Maybe
Deprec
Txt
mkIface
Dep
Cache No
Deprecs
= \_ -> Nothing
mkIface
Dep
Cache (
Deprec
All t)
= \_ -> Just t
mkIface
Dep
Cache (
Deprec
Some pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
mkIface
Warn
Cache ::
Warning
s -> Name -> Maybe
Warning
Txt
mkIface
Warn
Cache No
Warnings
= \_ -> Nothing
mkIface
Warn
Cache (
Warn
All t) = \_ -> Just t
mkIface
Warn
Cache (
Warn
Some pairs) = lookupOccEnv (mkOccEnv pairs) . nameOccName
emptyIface
Dep
Cache :: Name -> Maybe
Deprec
Txt
emptyIface
Dep
Cache _ = Nothing
emptyIface
Warn
Cache :: Name -> Maybe
Warning
Txt
emptyIface
Warn
Cache _ = Nothing
plus
Deprecs :: Deprecations -> Deprecations -> Deprecation
s
plus
Deprecs d NoDeprec
s = d
plus
Deprecs NoDeprec
s d = d
plus
Deprecs _ (Deprec
All t) =
Deprec
All t
plus
Deprecs (Deprec
All t) _ =
Deprec
All t
plus
Deprecs (Deprec
Some v1) (
Deprec
Some v2) =
Deprec
Some (v1 ++ v2)
plus
Warns :: Warnings -> Warnings -> Warning
s
plus
Warns d NoWarning
s = d
plus
Warns NoWarning
s d = d
plus
Warns _ (Warn
All t) =
Warn
All t
plus
Warns (Warn
All t) _ =
Warn
All t
plus
Warns (Warn
Some v1) (
Warn
Some v2) =
Warn
Some (v1 ++ v2)
\end{code}
...
...
@@ -1230,7 +1230,7 @@ data ExternalPackageState
-- * Fingerprint info
-- * Its exports
-- * Fixities
-- *
Deprecation
s
-- *
Warning
s
eps_PTE :: !PackageTypeEnv, -- Domain = external-package modules
...
...
compiler/parser/Lexer.x
View file @
cae75f82
...
...
@@ -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
...
...
compiler/parser/Parser.y.pp
View file @
cae75f82
...
...
@@ -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 maybemod
deprec
maybeexports '
where
' body
: maybedocheader '
module
' modid maybemod
warning
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
maybemod
deprec
maybeexports
'where'
header_body
:
maybedocheader
'module'
modid
maybemod
warning
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) }
:
deprec
list
STRING
{
toOL
[
LL
$
DeprecD
(
Deprecat
ion
n
(
getSTRING
$2
))
:
name
list STRING
{ toOL [ LL $
WarningD (Warning n
(Deprecat
edTxt
(getSTRING $2))
)
| n <- unLoc $1 ] }
...
...
@@ -1316,7 +1331,7 @@ exp10 :: { LHsExpr RdrName }
|
fexp
{
$1
}