Commit f83a5a68 authored by panne's avatar panne
Browse files

[project @ 2000-02-25 14:55:31 by panne]

Deprecations of variables now works, although the source location is
not yet reported correctly and the code needs some cleanup. Added a
new flag -fwarn-deprecations to the set of standard warnings. The
syntax of deprecations has been extended to deprecate types, classes,
or even constructors, although this does not work yet.
parent 72512afb
......@@ -15,6 +15,7 @@ import {-# SOURCE #-} HsMatches ( pprMatches, Match, pprGRHSs, GRHSs )
-- friends:
import HsTypes ( HsType )
import HsImpExp ( IE(..), ieName )
import CoreSyn ( CoreExpr )
import PprCore () -- Instances for Outputable
......@@ -263,9 +264,9 @@ data Sig name
data FixitySig name = FixitySig name Fixity SrcLoc
data Deprecation name
= DeprecMod DeprecTxt -- deprecation of a whole module
| DeprecName name DeprecTxt -- deprecation of a single name
-- We use exported entities for things to deprecate. Cunning trick (hack?):
-- `IEModuleContents undefined' is used for module deprecation.
data Deprecation name = Deprecation (IE name) DeprecTxt
type DeprecTxt = FAST_STRING -- reason/explanation for deprecation
\end{code}
......@@ -275,15 +276,17 @@ sigsForMe :: (name -> Bool) -> [Sig name] -> [Sig name]
sigsForMe f sigs
= filter sig_for_me sigs
where
sig_for_me (Sig n _ _) = f n
sig_for_me (ClassOpSig n _ _ _ _) = f n
sig_for_me (SpecSig n _ _) = f n
sig_for_me (InlineSig n _ _) = f n
sig_for_me (NoInlineSig n _ _) = f n
sig_for_me (SpecInstSig _ _) = False
sig_for_me (FixSig (FixitySig n _ _)) = f n
sig_for_me (DeprecSig (DeprecMod _) _) = False
sig_for_me (DeprecSig (DeprecName n _) _) = f n
sig_for_me (Sig n _ _) = f n
sig_for_me (ClassOpSig n _ _ _ _) = f n
sig_for_me (SpecSig n _ _) = f n
sig_for_me (InlineSig n _ _) = f n
sig_for_me (NoInlineSig n _ _) = f n
sig_for_me (SpecInstSig _ _) = False
sig_for_me (FixSig (FixitySig n _ _)) = f n
sig_for_me
(DeprecSig (Deprecation (IEModuleContents _) _) _) = False
sig_for_me
(DeprecSig (Deprecation d _) _) = f (ieName d)
isFixitySig :: Sig name -> Bool
isFixitySig (FixSig _) = True
......@@ -307,15 +310,7 @@ isPragSig other = False
instance (Outputable name) => Outputable (Sig name) where
ppr sig = ppr_sig sig
instance Outputable name => Outputable (FixitySig name) where
ppr (FixitySig name fixity loc) = sep [ppr fixity, ppr name]
instance Outputable name => Outputable (Deprecation name) where
ppr (DeprecMod txt)
= hsep [text "{-# DEPRECATED", doubleQuotes (ppr txt), text "#-}"]
ppr (DeprecName n txt)
= hsep [text "{-# DEPRECATED", ppr n, doubleQuotes (ppr txt), text "#-}"]
ppr_sig :: Outputable name => Sig name -> SDoc
ppr_sig (Sig var ty _)
= sep [ppr var <+> dcolon, nest 4 (ppr ty)]
......@@ -340,7 +335,17 @@ ppr_sig (FixSig fix_sig) = ppr fix_sig
ppr_sig (DeprecSig deprec _) = ppr deprec
ppr_phase Nothing = empty
instance Outputable name => Outputable (FixitySig name) where
ppr (FixitySig name fixity loc) = sep [ppr fixity, ppr name]
instance Outputable name => Outputable (Deprecation name) where
ppr (Deprecation (IEModuleContents _) txt)
= hsep [text "{-# DEPRECATED", doubleQuotes (ppr txt), text "#-}"]
ppr (Deprecation thing txt)
= hsep [text "{-# DEPRECATED", ppr thing, doubleQuotes (ppr txt), text "#-}"]
ppr_phase :: Maybe Int -> SDoc
ppr_phase Nothing = empty
ppr_phase (Just n) = int n
\end{code}
......@@ -52,17 +52,17 @@ All we actually declare here is the top-level structure for a module.
\begin{code}
data HsModule name pat
= HsModule
ModuleName -- module name
(Maybe Version) -- source interface version number
(Maybe [IE name]) -- export list; Nothing => export everything
-- Just [] => export *nothing* (???)
-- Just [...] => as you would expect...
[ImportDecl name] -- We snaffle interesting stuff out of the
-- imported interfaces early on, adding that
-- info to TyDecls/etc; so this list is
-- often empty, downstream.
[HsDecl name pat] -- Type, class, value, and interface signature decls
(Maybe (Deprecation name)) -- reason/explanation for deprecation of this module
ModuleName -- module name
(Maybe Version) -- source interface version number
(Maybe [IE name]) -- export list; Nothing => export everything
-- Just [] => export *nothing* (???)
-- Just [...] => as you would expect...
[ImportDecl name] -- We snaffle interesting stuff out of the
-- imported interfaces early on, adding that
-- info to TyDecls/etc; so this list is
-- often empty, downstream.
[HsDecl name pat] -- Type, class, value, and interface signature decls
(Maybe DeprecTxt) -- reason/explanation for deprecation of this module
SrcLoc
\end{code}
......
......@@ -68,6 +68,7 @@ module CmdLineOpts (
opt_WarnUnusedBinds,
opt_WarnUnusedImports,
opt_WarnUnusedMatches,
opt_WarnDeprecations,
-- profiling opts
opt_AutoSccsOnAllToplevs,
......@@ -358,6 +359,7 @@ opt_WarnTypeDefaults = lookUp SLIT("-fwarn-type-defaults")
opt_WarnUnusedBinds = lookUp SLIT("-fwarn-unused-binds")
opt_WarnUnusedImports = lookUp SLIT("-fwarn-unused-imports")
opt_WarnUnusedMatches = lookUp SLIT("-fwarn-unused-matches")
opt_WarnDeprecations = lookUp SLIT("-fwarn-deprecations")
-- profiling opts
opt_AutoSccsOnAllToplevs = lookUp SLIT("-fauto-sccs-on-all-toplevs")
......
......@@ -241,8 +241,9 @@ ifaceDeprecations if_hdl deprecations
ptext SLIT("##-}")
])
where
pprIfaceDeprec (DeprecMod txt) = doubleQuotes (ppr txt)
pprIfaceDeprec (DeprecName n txt) = ppr n <+> doubleQuotes (ppr txt)
-- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
pprIfaceDeprec (Deprecation (IEModuleContents _) txt) = doubleQuotes (ppr txt)
pprIfaceDeprec (Deprecation (IEVar n) txt) = ppr n <+> doubleQuotes (ppr txt)
\end{code}
%************************************************************************
......
{-
-----------------------------------------------------------------------------
$Id: Parser.y,v 1.23 2000/02/20 17:51:45 panne Exp $
$Id: Parser.y,v 1.24 2000/02/25 14:55:42 panne Exp $
Haskell grammar.
......@@ -218,8 +218,8 @@ module :: { RdrNameHsModule }
| srcloc body
{ HsModule mAIN_Name Nothing Nothing (fst $2) (snd $2) Nothing $1 }
maybemoddeprec :: { Maybe (Deprecation RdrName) }
: '{-# DEPRECATED' STRING '#-}' { Just (DeprecMod $2) }
maybemoddeprec :: { Maybe DeprecTxt }
: '{-# DEPRECATED' STRING '#-}' { Just $2 }
| {- empty -} { Nothing }
body :: { ([RdrNameImportDecl], [RdrNameHsDecl]) }
......@@ -480,17 +480,10 @@ deprecations :: { RdrBinding }
| deprecation { $1 }
| {- empty -} { RdrNullBind }
-- SUP: TEMPORARY HACK, not checking for `module Foo'
deprecation :: { RdrBinding }
: deprecated_names STRING
{ foldr1 RdrAndBindings [ RdrSig (DeprecSig (DeprecName n $2) l) | (l,n) <- $1 ] }
deprecated_names :: { [(SrcLoc,RdrName)] }
: deprecated_names ',' deprecated_name { $3 : $1 }
| deprecated_name { [$1] }
deprecated_name :: { (SrcLoc,RdrName) }
: srcloc var { ($1, $2) }
| srcloc tycon { ($1, $2) }
: srcloc exportlist STRING
{ foldr1 RdrAndBindings [ RdrSig (DeprecSig (Deprecation n $3) $1) | n <- $2 ] }
-----------------------------------------------------------------------------
-- Foreign import/export
......
......@@ -370,12 +370,12 @@ deprecs : {- empty -} { [] }
| deprecs deprec ';' { $2 : $1 }
deprec :: { RdrNameDeprecation }
deprec : STRING { DeprecMod $1 }
| deprec_name STRING { DeprecName $1 $2 }
deprec : STRING { Deprecation (IEModuleContents undefined) $1 }
| deprec_name STRING { Deprecation $1 $2 }
deprec_name :: { RdrName }
: var_name { $1 }
| tc_name { $1 }
-- SUP: TEMPORARY HACK
deprec_name :: { RdrNameIE }
: var_name { IEVar $1 }
-----------------------------------------------------------------------------
......
......@@ -15,8 +15,7 @@ import RnHsSyn ( RenamedHsModule, RenamedHsDecl,
)
import CmdLineOpts ( opt_HiMap, opt_D_dump_rn_trace,
opt_D_dump_rn, opt_D_dump_rn_stats,
opt_WarnUnusedBinds, opt_WarnUnusedImports
opt_D_dump_rn, opt_D_dump_rn_stats, opt_WarnDeprecations
)
import RnMonad
import RnNames ( getGlobalNames )
......@@ -24,21 +23,18 @@ import RnSource ( rnSourceDecls, rnDecl )
import RnIfaces ( getImportedInstDecls, importDecl, getImportVersions,
getImportedRules, loadHomeInterface, getSlurped, removeContext
)
import RnEnv ( availName, availNames, availsToNameSet,
warnUnusedImports, warnUnusedLocalBinds, mapFvRn, lookupImplicitOccRn,
import RnEnv ( availName, availsToNameSet,
warnUnusedImports, warnUnusedLocalBinds, lookupImplicitOccRn,
FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs
)
import Module ( Module, ModuleName, pprModule, mkSearchPath, mkThisModule )
import Name ( Name, isLocallyDefined,
NamedThing(..), ImportReason(..), Provenance(..),
pprOccName, nameOccName, nameUnique,
getNameProvenance, isUserImportedExplicitlyName,
import Module ( Module, ModuleName, mkSearchPath, mkThisModule )
import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
nameOccName, nameUnique, isUserImportedExplicitlyName,
maybeWiredInTyConName, maybeWiredInIdName, isWiredInName
)
import OccName ( occNameFlavour )
import Id ( idType )
import DataCon ( dataConTyCon, dataConType )
import TyCon ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
import RdrName ( RdrName )
import TyCon ( isSynTyCon, getSynTyConDefn )
import NameSet
import PrelMods ( mAIN_Name, pREL_MAIN_Name )
import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
......@@ -47,12 +43,10 @@ import Type ( namesOfType, funTyCon )
import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
import BasicTypes ( NewOrData(..) )
import Bag ( isEmptyBag, bagToList )
import FiniteMap ( fmToList, delListFromFM, addToFM, sizeFM, eltsFM )
import FiniteMap ( eltsFM )
import UniqSupply ( UniqSupply )
import UniqFM ( lookupUFM )
import Util ( equivClasses )
import Maybes ( maybeToBool )
import SrcLoc ( mkBuiltinSrcLoc )
import Outputable
\end{code}
......@@ -90,6 +84,8 @@ renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ l
\begin{code}
rename :: RdrNameHsModule
-> RnMG (Maybe (Module, RenamedHsModule, InterfaceDetails, RnNameSupply, [ModuleName]), IO ())
rename this_mod@(HsModule mod_name vers _ imports local_decls mod_deprec loc)
= -- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_mod `thenRn` \ maybe_stuff ->
......@@ -123,14 +119,9 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls mod_deprec loc)
-- COLLECT ALL DEPRECATIONS
deprec_sigs = [ ds | ValD bnds <- rn_local_decls, ds <- collectDeprecs bnds ]
(rn_mod_deprec, deprecs) = case mod_deprec of
Nothing -> (Nothing, deprec_sigs)
Just (DeprecMod t) -> let dm = DeprecMod t in (Just dm, dm:deprec_sigs)
collectDeprecs EmptyBinds = []
collectDeprecs (ThenBinds x y) = collectDeprecs x ++ collectDeprecs y
collectDeprecs (MonoBind _ sigs _) = [ d | DeprecSig d _ <- sigs ]
deprecs = case mod_deprec of
Nothing -> deprec_sigs
Just txt -> Deprecation (IEModuleContents undefined) txt : deprec_sigs
in
-- EXIT IF ERRORS FOUND
......@@ -157,7 +148,7 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls mod_deprec loc)
renamed_module = HsModule mod_name vers
trashed_exports trashed_imports
rn_all_decls
rn_mod_deprec
mod_deprec
loc
in
rnDump rn_imp_decls rn_all_decls `thenRn` \ dump_action ->
......@@ -169,6 +160,10 @@ rename this_mod@(HsModule mod_name vers _ imports local_decls mod_deprec loc)
where
trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
trashed_imports = {-trace "rnSource:trashed_imports"-} []
collectDeprecs EmptyBinds = []
collectDeprecs (ThenBinds x y) = collectDeprecs x ++ collectDeprecs y
collectDeprecs (MonoBind _ sigs _) = [ d | DeprecSig d _ <- sigs ]
\end{code}
@implicitFVs@ forces the renamer to slurp in some things which aren't
......@@ -523,6 +518,7 @@ getInstDeclGates other = emptyFVs
%*********************************************************
\begin{code}
reportUnusedNames :: GlobalRdrEnv -> NameEnv AvailInfo -> ExportEnv -> NameSet -> RnM d ()
reportUnusedNames gbl_env avail_env (ExportEnv export_avails _ _) mentioned_names
= let
used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
......@@ -545,10 +541,26 @@ reportUnusedNames gbl_env avail_env (ExportEnv export_avails _ _) mentioned_name
-- Filter out the ones only defined implicitly
bad_locals = [n | n <- defined_but_not_used, isLocallyDefined n]
bad_imps = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n]
non_locally_used = [ n | n <- nameSetToList really_used_names, not (isLocallyDefined n) ]
deprec_used deprec_env = [ (n,txt) | n <- non_locally_used, Just txt <- [lookupNameEnv deprec_env n] ]
in
warnUnusedLocalBinds bad_locals `thenRn_`
traceRn (text "really used and non-locally defined" <> colon <+>
nest 4 (fsep (punctuate comma [ text (occNameFlavour (nameOccName n)) <+> ppr n
| n <- non_locally_used]))) `thenRn_`
getIfacesRn `thenRn` \ ifaces ->
if opt_WarnDeprecations
then mapRn_ warnDeprec (deprec_used (iDeprecs ifaces))
else returnRn () `thenRn_`
warnUnusedLocalBinds bad_locals `thenRn_`
warnUnusedImports bad_imps
warnDeprec :: (Name, DeprecTxt) -> RnM d ()
warnDeprec (name, txt)
= pushSrcLocRn (getSrcLoc name) $
addWarnRn $
sep [ text "Using deprecated entity" <+> ppr name <> colon, nest 4 (ppr txt) ]
rnDump :: [RenamedHsDecl] -- Renamed imported decls
-> [RenamedHsDecl] -- Renamed local decls
-> RnMG (IO ())
......
......@@ -541,10 +541,11 @@ renameSig lookup_occ_nm (FixSig (FixitySig v fix src_loc))
lookup_occ_nm v `thenRn` \ new_v ->
returnRn (FixSig (FixitySig new_v fix src_loc), unitFV new_v)
renameSig lookup_occ_nm (DeprecSig (DeprecName v txt) src_loc)
-- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
renameSig lookup_occ_nm (DeprecSig (Deprecation (IEVar v) txt) src_loc)
= pushSrcLocRn src_loc $
lookup_occ_nm v `thenRn` \ new_v ->
returnRn (DeprecSig (DeprecName new_v txt) src_loc, unitFV new_v)
returnRn (DeprecSig (Deprecation (IEVar new_v) txt) src_loc, unitFV new_v)
renameSig lookup_occ_nm (InlineSig v p src_loc)
= pushSrcLocRn src_loc $
......@@ -559,14 +560,17 @@ renameSig lookup_occ_nm (NoInlineSig v p src_loc)
Checking for distinct signatures; oh, so boring
\begin{code}
cmp_sig :: RenamedSig -> RenamedSig -> Ordering
cmp_sig (Sig n1 _ _) (Sig n2 _ _) = n1 `compare` n2
cmp_sig (DeprecSig (DeprecName n1 _) _) (DeprecSig (DeprecName n2 _) _) = n1 `compare` n2
cmp_sig (InlineSig n1 _ _) (InlineSig n2 _ _) = n1 `compare` n2
cmp_sig (NoInlineSig n1 _ _) (NoInlineSig n2 _ _) = n1 `compare` n2
cmp_sig (SpecInstSig ty1 _) (SpecInstSig ty2 _) = cmpHsType compare ty1 ty2
cmp_sig (SpecSig n1 ty1 _) (SpecSig n2 ty2 _)
cmp_sig (Sig n1 _ _) (Sig n2 _ _) = n1 `compare` n2
-- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
cmp_sig (DeprecSig (Deprecation (IEVar n1) _) _)
(DeprecSig (Deprecation (IEVar n2) _) _) = n1 `compare` n2
cmp_sig (InlineSig n1 _ _) (InlineSig n2 _ _) = n1 `compare` n2
cmp_sig (NoInlineSig n1 _ _) (NoInlineSig n2 _ _) = n1 `compare` n2
cmp_sig (SpecInstSig ty1 _) (SpecInstSig ty2 _) = cmpHsType compare ty1 ty2
cmp_sig (SpecSig n1 ty1 _) (SpecSig n2 ty2 _)
= -- may have many specialisations for one value;
-- but not ones that are exactly the same...
thenCmp (n1 `compare` n2) (cmpHsType compare ty1 ty2)
......
......@@ -341,15 +341,16 @@ loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
mkImportedGlobalFromRdrName var `thenRn` \ var_name ->
returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
-- SUP: TEMPORARY HACK, ignoring module deprecations and constructors for now
loadDeprec :: Module -> DeprecationEnv -> RdrNameDeprecation -> RnM d DeprecationEnv
loadDeprec mod deprec_env (DeprecMod txt)
loadDeprec mod deprec_env (Deprecation (IEModuleContents _) txt)
= traceRn (text "module deprecation not yet implemented:" <+> ppr mod <> colon <+> ppr txt) `thenRn_`
returnRn deprec_env
loadDeprec mod deprec_env (DeprecName rdr_name txt)
loadDeprec mod deprec_env (Deprecation (IEVar rdr_name) txt)
= setModuleRn (moduleName mod) $
mkImportedGlobalFromRdrName rdr_name `thenRn` \ name ->
traceRn (text "loaded deprecation for" <+> ppr name <> colon <+> ppr txt) `thenRn_`
returnRn (addToNameEnv deprec_env name (DeprecName name txt))
returnRn (addToNameEnv deprec_env name txt)
\end{code}
......
......@@ -195,7 +195,7 @@ type FixityEnv = NameEnv RenamedFixitySig
-- fixity declaration
--------------------------------
type DeprecationEnv = NameEnv RenamedDeprecation
type DeprecationEnv = NameEnv DeprecTxt
\end{code}
\begin{code}
......
......@@ -272,6 +272,8 @@ warnings that you get all the time are
-fwarn-overlapping-patterns
-fwarn-missing-methods
-fwarn-missing-fields
-fwarn-deprecations
-fwarn-duplicate-exports
these are turned off by -Wnot.
......@@ -280,6 +282,7 @@ these are turned off by -Wnot.
@StandardWarnings = ('-fwarn-overlapping-patterns',
'-fwarn-missing-methods',
'-fwarn-missing-fields',
'-fwarn-deprecations',
'-fwarn-duplicate-exports');
@MinusWOpts = (@StandardWarnings,
'-fwarn-unused-binds',
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment