Skip to content

GitLab

Commit cae75f82 authored by Ian Lynagh's avatar Ian Lynagh
Browse files
Options

Add a WARNING pragma

parent 35c21b89
Hide whitespace changes
Inline Side-by-side
Showing with 243 additions and 187 deletions
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_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,
......
compiler/hsSyn/HsDecls.lhs
View file @ cae75f82
......@@ -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}
compiler/hsSyn/HsSyn.lhs
View file @ cae75f82
......@@ -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
......
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 = 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
......
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)
, 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}
......
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 = 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
......
compiler/main/DynFlags.hs
View file @ cae75f82
......@@ -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 ),
......
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 = NoDeprecs,
mg_warns = NoWarnings,
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(..), 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
......
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 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 }