Commit e7b69c55 authored by simonpj's avatar simonpj
Browse files

[project @ 2001-04-30 10:51:18 by simonpj]

-----------------------------
	Better filtering for warnings
	-----------------------------

* Add Opt_WarnMisc, to enable warnings not otherwise covered by Opt_Warn*
  in the renamer

* Add RnMonad.ifOptRn :: DynFlag -> RnM d a -> RnM d ()
  and use it many places instead of the clumsy direct code
parent 55d04fc7
......@@ -276,6 +276,7 @@ data DynFlag
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
| Opt_WarnDeprecations
| Opt_WarnMisc
-- language opts
| Opt_AllowOverlappingInstances
......@@ -381,7 +382,8 @@ standardWarnings
Opt_WarnOverlappingPatterns,
Opt_WarnMissingFields,
Opt_WarnMissingMethods,
Opt_WarnDuplicateExports
Opt_WarnDuplicateExports,
Opt_WarnMisc
]
minusWOpts
......
......@@ -688,8 +688,7 @@ printMinimalImports :: Module -- This module
-> FiniteMap ModuleName AvailEnv -- Minimal imports
-> RnMG ()
printMinimalImports this_mod unqual imps
= doptRn Opt_D_dump_minimal_imports `thenRn` \ dump_minimal ->
if not dump_minimal then returnRn () else
= ifOptRn Opt_D_dump_minimal_imports $
mapRn to_ies (fmToList imps) `thenRn` \ mod_ies ->
ioToRnM (do { h <- openFile filename WriteMode ;
......
......@@ -167,16 +167,16 @@ rnTopMonoBinds mbinds sigs
bndr_name_set = mkNameSet binder_names
in
renameSigsFVs (okBindSig bndr_name_set) sigs `thenRn` \ (siglist, sig_fvs) ->
doptRn Opt_WarnMissingSigs `thenRn` \ warnMissing ->
let
type_sig_vars = [n | Sig n _ _ <- siglist]
un_sigd_binders | warnMissing = nameSetToList (delListFromNameSet
bndr_name_set type_sig_vars)
| otherwise = []
in
mapRn_ missingSigWarn un_sigd_binders `thenRn_`
rn_mono_binds siglist mbinds `thenRn` \ (final_binds, bind_fvs) ->
ifOptRn Opt_WarnMissingSigs (
let
type_sig_vars = [n | Sig n _ _ <- siglist]
un_sigd_binders = nameSetToList (delListFromNameSet bndr_name_set type_sig_vars)
in
mapRn_ missingSigWarn un_sigd_binders
) `thenRn_`
rn_mono_binds siglist mbinds `thenRn` \ (final_binds, bind_fvs) ->
returnRn (final_binds, bind_fvs `plusFV` sig_fvs)
where
binder_rdr_names = collectMonoBinders mbinds
......
......@@ -494,12 +494,11 @@ bindLocatedLocalsRn doc_str rdr_names_w_loc enclosed_scope
-- Check for duplicate names
checkDupOrQualNames doc_str rdr_names_w_loc `thenRn_`
doptRn Opt_WarnNameShadowing `thenRn` \ warn_shadow ->
-- Warn about shadowing, but only in source modules
(case mode of
SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
other -> returnRn ()
SourceMode -> ifOptRn Opt_WarnNameShadowing $
mapRn_ (check_shadow name_env) rdr_names_w_loc
other -> returnRn ()
) `thenRn_`
newLocalsRn rdr_names_w_loc `thenRn` \ names ->
......@@ -915,9 +914,7 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
\begin{code}
warnUnusedModules :: [ModuleName] -> RnM d ()
warnUnusedModules mods
= doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
if warn then mapRn_ (addWarnRn . unused_mod) mods
else returnRn ()
= ifOptRn Opt_WarnUnusedImports (mapRn_ (addWarnRn . unused_mod) mods)
where
unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
text "is imported, but nothing from it is used",
......@@ -926,19 +923,14 @@ warnUnusedModules mods
warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
warnUnusedImports names
= doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
if warn then warnUnusedBinds names else returnRn ()
= ifOptRn Opt_WarnUnusedImports (warnUnusedBinds names)
warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
warnUnusedLocalBinds names
= doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
else returnRn ()
= ifOptRn Opt_WarnUnusedBinds (warnUnusedBinds [(n,LocalDef) | n<-names])
warnUnusedMatches names
= doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
else returnRn ()
= ifOptRn Opt_WarnUnusedMatches (warnUnusedGroup [(n,LocalDef) | n<-names])
-------------------------
......@@ -1012,8 +1004,7 @@ dupNamesErr descriptor ((name,loc) : dup_things)
warnDeprec :: Name -> DeprecTxt -> RnM d ()
warnDeprec name txt
= doptRn Opt_WarnDeprecations `thenRn` \ warn_drs ->
if not warn_drs then returnRn () else
= ifOptRn Opt_WarnDeprecations $
addWarnRn (sep [ text (occNameFlavour (nameOccName name)) <+>
quotes (ppr name) <+> text "is deprecated:",
nest 4 (ppr txt) ])
......
......@@ -93,14 +93,10 @@ ioToRnM_no_fail io rn_down g_down
(\ err -> panic "ioToRnM_no_fail: the I/O operation failed!")
traceRn :: SDoc -> RnM d ()
traceRn msg
= doptRn Opt_D_dump_rn_trace `thenRn` \b ->
if b then putDocRn msg else returnRn ()
traceRn msg = ifOptRn Opt_D_dump_rn_trace (putDocRn msg)
traceHiDiffsRn :: SDoc -> RnM d ()
traceHiDiffsRn msg
= doptRn Opt_D_dump_hi_diffs `thenRn` \b ->
if b then putDocRn msg else returnRn ()
traceHiDiffsRn msg = ifOptRn Opt_D_dump_hi_diffs (putDocRn msg)
putDocRn :: SDoc -> RnM d ()
putDocRn msg = ioToRnM (printErrs alwaysQualify msg) `thenRn_`
......@@ -575,6 +571,11 @@ doptRn :: DynFlag -> RnM d Bool
doptRn dflag (RnDown { rn_dflags = dflags}) l_down
= return (dopt dflag dflags)
ifOptRn :: DynFlag -> RnM d a -> RnM d ()
ifOptRn dflag thing_inside down@(RnDown { rn_dflags = dflags}) l_down
| dopt dflag dflags = thing_inside down l_down >> return ()
| otherwise = return ()
getDOptsRn :: RnM d DynFlags
getDOptsRn (RnDown { rn_dflags = dflags}) l_down
= return dflags
......
......@@ -161,9 +161,10 @@ importsFromImportDecl this_mod_name (ImportDecl imp_mod_name from qual_only as_m
else
-- Complain if we import a deprecated module
(case deprecs of
DeprecAll txt -> addWarnRn (moduleDeprec imp_mod_name txt)
other -> returnRn ()
ifOptRn Opt_WarnDeprecations (
case deprecs of
DeprecAll txt -> addWarnRn (moduleDeprec imp_mod_name txt)
other -> returnRn ()
) `thenRn_`
-- Filter the imports according to the import list
......@@ -323,7 +324,7 @@ filterImports mod from (Just (want_hiding, import_items)) total_avails
Just avail@(AvailTC _ [n]) -> -- This occurs when you import T(..), but
-- only export T abstractly. The single [n]
-- in the AvailTC is the type or class itself
addWarnRn (dodgyImportWarn mod item) `thenRn_`
ifOptRn opt_WarnMisc (addWarnRn (dodgyImportWarn mod item)) `thenRn_`
returnRn [(avail, [availName avail])]
Just avail -> returnRn [(avail, [availName avail])]
......
......@@ -633,13 +633,17 @@ rnForAll doc forall_tyvars ctxt ty
rnContext :: SDoc -> RdrNameContext -> RnMS RenamedContext
rnContext doc ctxt
= mapRn rn_pred ctxt `thenRn` \ theta ->
let
(_, dups) = removeDupsEq theta
-- We only have equality, not ordering
in
-- Check for duplicate assertions
-- If this isn't an error, then it ought to be:
mapRn (addWarnRn . dupClassAssertWarn theta) dups `thenRn_`
ifOptRn Opt_WarnMisc (
let
(_, dups) = removeDupsEq theta
-- We only have equality, not ordering
in
mapRn (addWarnRn . dupClassAssertWarn theta) dups
) `thenRn_`
returnRn theta
where
--Someone discovered that @CCallable@ and @CReturnable@
......@@ -854,11 +858,9 @@ badDataCon name
= hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
forAllWarn doc ty tyvar
= doptRn Opt_WarnUnusedMatches `thenRn` \ warn_unused -> case () of
() | not warn_unused -> returnRn ()
| otherwise
-> getModeRn `thenRn` \ mode ->
case mode of {
= ifOptRn Opt_WarnUnusedMatches $
getModeRn `thenRn` \ mode ->
case mode of {
#ifndef DEBUG
InterfaceMode -> returnRn () ; -- Don't warn of unused tyvars in interface files
-- unless DEBUG is on, in which case it is slightly
......
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