Commit dbb27b50 authored by simonmar's avatar simonmar
Browse files

[project @ 2000-10-17 13:22:10 by simonmar]

Flags hacking:

   - `dopt_GlasgowExts'  is now written `dopt Opt_GlasgowExts'
   - convert all the warning options into DynFlags
parent b732f90c
......@@ -14,8 +14,6 @@ module CoreLint (
import IO ( hPutStr, hPutStrLn, stdout )
import CmdLineOpts ( DynFlags, dopt_D_show_passes, dopt_DoCoreLinting,
opt_PprStyle_Debug )
import CoreSyn
import Rules ( RuleBase, pprRuleBase )
import CoreFVs ( idFreeVars, mustHaveLocalBinding )
......@@ -42,6 +40,7 @@ import Type ( Type, tyVarsOfType,
)
import TyCon ( TyCon, isPrimTyCon, tyConDataCons )
import BasicTypes ( RecFlag(..), isNonRec )
import CmdLineOpts
import Maybe
import Outputable
......@@ -61,7 +60,7 @@ and do Core Lint when necessary.
\begin{code}
beginPass :: DynFlags -> String -> IO ()
beginPass dflags pass_name
| dopt_D_show_passes dflags
| dopt Opt_D_show_passes dflags
= hPutStrLn stdout ("*** " ++ pass_name)
| otherwise
= return ()
......@@ -81,7 +80,7 @@ endPassWithRules dflags pass_name dump_flag binds rules
-- Report result size if required
-- This has the side effect of forcing the intermediate to be evaluated
if dopt_D_show_passes dflags then
if dopt Opt_D_show_passes dflags then
hPutStrLn stdout (" Result size = " ++ show (coreBindsSize binds))
else
return ()
......@@ -134,7 +133,7 @@ Outstanding issues:
lintCoreBindings :: DynFlags -> String -> [CoreBind] -> IO ()
lintCoreBindings dflags whoDunnit binds
| not (dopt_DoCoreLinting dflags)
| not (dopt Opt_DoCoreLinting dflags)
= return ()
lintCoreBindings dflags whoDunnit binds
......@@ -157,7 +156,7 @@ lintCoreBindings dflags whoDunnit binds
returnL ()
lint_bind (NonRec bndr rhs) = lintSingleBinding NonRecursive (bndr,rhs)
done_lint = doIfSet_dyn dflags dopt_D_show_passes
done_lint = doIfSet_dyn dflags (dopt Opt_D_show_passes)
(hPutStr stdout ("*** Core Linted result of " ++ whoDunnit ++ "\n"))
warn warnings
= vcat [
......@@ -198,7 +197,7 @@ lintUnfolding :: DynFlags
-> (Maybe Message, Maybe Message) -- (Nothing,_) => OK
lintUnfolding dflags locn vars expr
| not (dopt_DoCoreLinting dflags)
| not (dopt Opt_DoCoreLinting dflags)
= (Nothing, Nothing)
| otherwise
......
......@@ -36,7 +36,7 @@ import CmdLineOpts ( opt_UF_CreationThreshold,
opt_UF_FunAppDiscount,
opt_UF_KeenessFactor,
opt_UF_DearOp, opt_UnfoldCasms,
DynFlags, dopt_D_dump_inlinings
DynFlags, DynFlag(..), dopt
)
import CoreSyn
import PprCore ( pprCoreExpr )
......@@ -613,7 +613,7 @@ callSiteInline dflags black_listed inline_call occ id arg_infos interesting_cont
in
#ifdef DEBUG
if dopt_D_dump_inlinings dflags then
if dopt Opt_D_dump_inlinings dflags then
pprTrace "Considering inlining"
(ppr id <+> vcat [text "black listed:" <+> ppr black_listed,
text "occ info:" <+> ppr occ,
......
......@@ -18,68 +18,16 @@ module CmdLineOpts (
switchIsOn,
isStaticHscFlag,
-- debugging opts
dopt_D_dump_absC,
dopt_D_dump_asm,
dopt_D_dump_cpranal,
dopt_D_dump_cse,
dopt_D_dump_deriv,
dopt_D_dump_ds,
dopt_D_dump_flatC,
dopt_D_dump_foreign,
dopt_D_dump_hi_diffs,
dopt_D_dump_inlinings,
dopt_D_dump_occur_anal,
dopt_D_dump_parsed,
dopt_D_dump_realC,
dopt_D_dump_rn,
dopt_D_dump_rules,
dopt_D_dump_simpl,
dopt_D_dump_simpl_iterations,
dopt_D_dump_simpl_stats,
dopt_D_dump_spec,
dopt_D_dump_stg,
dopt_D_dump_stranal,
dopt_D_dump_tc,
dopt_D_dump_types,
dopt_D_dump_usagesp,
dopt_D_dump_worker_wrapper,
dopt_D_show_passes,
dopt_D_dump_rn_trace,
dopt_D_dump_rn_stats,
dopt_D_dump_stix,
dopt_D_dump_minimal_imports,
dopt_D_source_stats,
dopt_D_verbose_core2core,
dopt_D_verbose_stg2stg,
dopt_DoCoreLinting,
dopt_DoStgLinting,
dopt_DoUSPLinting,
opt_PprStyle_NoPrags,
opt_PprUserLength,
opt_PprStyle_Debug,
dopt,
-- other dynamic flags
dopt_CoreToDo,
dopt_StgToDo,
-- warning opts
opt_WarnDuplicateExports,
opt_WarnHiShadows,
opt_WarnIncompletePatterns,
opt_WarnMissingFields,
opt_WarnMissingMethods,
opt_WarnMissingSigs,
opt_WarnNameShadowing,
opt_WarnOverlappingPatterns,
opt_WarnSimplePatterns,
opt_WarnTypeDefaults,
opt_WarnUnusedBinds,
opt_WarnUnusedImports,
opt_WarnUnusedMatches,
opt_WarnDeprecations,
-- profiling opts
opt_AutoSccsOnAllToplevs,
opt_AutoSccsOnExportedToplevs,
......@@ -92,9 +40,6 @@ module CmdLineOpts (
opt_AllStrict,
opt_DictsStrict,
opt_MaxContextReductionDepth,
dopt_AllowOverlappingInstances,
dopt_AllowUndecidableInstances,
dopt_GlasgowExts,
opt_Generics,
opt_IrrefutableTuples,
opt_NumbersStrict,
......@@ -237,7 +182,7 @@ data CoreToDo -- These are diff core-to-core passes,
| CoreDoWorkerWrapper
| CoreDoSpecialising
| CoreDoUSPInf
| CoreDoCPResult
| CoreDoCPResult
| CoreDoGlomBinds
| CoreCSE
......@@ -312,6 +257,21 @@ data DynFlag
| Opt_DoStgLinting
| Opt_DoUSPLinting
| Opt_WarnDuplicateExports
| Opt_WarnHiShadows
| Opt_WarnIncompletePatterns
| Opt_WarnMissingFields
| Opt_WarnMissingMethods
| Opt_WarnMissingSigs
| Opt_WarnNameShadowing
| Opt_WarnOverlappingPatterns
| Opt_WarnSimplePatterns
| Opt_WarnTypeDefaults
| Opt_WarnUnusedBinds
| Opt_WarnUnusedImports
| Opt_WarnUnusedMatches
| Opt_WarnDeprecations
-- language opts
| Opt_AllowOverlappingInstances
| Opt_AllowUndecidableInstances
......@@ -325,51 +285,8 @@ data DynFlags = DynFlags {
flags :: [DynFlag]
}
boolOpt :: DynFlag -> DynFlags -> Bool
boolOpt f dflags = f `elem` (flags dflags)
dopt_D_dump_all = boolOpt Opt_D_dump_all
dopt_D_dump_most = boolOpt Opt_D_dump_most
dopt_D_dump_absC = boolOpt Opt_D_dump_absC
dopt_D_dump_asm = boolOpt Opt_D_dump_asm
dopt_D_dump_cpranal = boolOpt Opt_D_dump_cpranal
dopt_D_dump_deriv = boolOpt Opt_D_dump_deriv
dopt_D_dump_ds = boolOpt Opt_D_dump_ds
dopt_D_dump_flatC = boolOpt Opt_D_dump_flatC
dopt_D_dump_foreign = boolOpt Opt_D_dump_foreign
dopt_D_dump_inlinings = boolOpt Opt_D_dump_inlinings
dopt_D_dump_occur_anal = boolOpt Opt_D_dump_occur_anal
dopt_D_dump_parsed = boolOpt Opt_D_dump_parsed
dopt_D_dump_realC = boolOpt Opt_D_dump_realC
dopt_D_dump_rn = boolOpt Opt_D_dump_rn
dopt_D_dump_simpl = boolOpt Opt_D_dump_simpl
dopt_D_dump_simpl_iterations = boolOpt Opt_D_dump_simpl_iterations
dopt_D_dump_spec = boolOpt Opt_D_dump_spec
dopt_D_dump_stg = boolOpt Opt_D_dump_stg
dopt_D_dump_stranal = boolOpt Opt_D_dump_stranal
dopt_D_dump_tc = boolOpt Opt_D_dump_tc
dopt_D_dump_types = boolOpt Opt_D_dump_types
dopt_D_dump_rules = boolOpt Opt_D_dump_rules
dopt_D_dump_usagesp = boolOpt Opt_D_dump_usagesp
dopt_D_dump_cse = boolOpt Opt_D_dump_cse
dopt_D_dump_worker_wrapper = boolOpt Opt_D_dump_worker_wrapper
dopt_D_show_passes = boolOpt Opt_D_show_passes
dopt_D_dump_rn_trace = boolOpt Opt_D_dump_rn_trace
dopt_D_dump_rn_stats = boolOpt Opt_D_dump_rn_stats
dopt_D_dump_stix = boolOpt Opt_D_dump_stix
dopt_D_dump_simpl_stats = boolOpt Opt_D_dump_simpl_stats
dopt_D_source_stats = boolOpt Opt_D_source_stats
dopt_D_verbose_core2core = boolOpt Opt_D_verbose_core2core
dopt_D_verbose_stg2stg = boolOpt Opt_D_verbose_stg2stg
dopt_D_dump_hi_diffs = boolOpt Opt_D_dump_hi_diffs
dopt_D_dump_minimal_imports = boolOpt Opt_D_dump_minimal_imports
dopt_DoCoreLinting = boolOpt Opt_DoCoreLinting
dopt_DoStgLinting = boolOpt Opt_DoStgLinting
dopt_DoUSPLinting = boolOpt Opt_DoUSPLinting
dopt_AllowOverlappingInstances = boolOpt Opt_AllowOverlappingInstances
dopt_AllowUndecidableInstances = boolOpt Opt_AllowUndecidableInstances
dopt_GlasgowExts = boolOpt Opt_GlasgowExts
dopt :: DynFlag -> DynFlags -> Bool
dopt f dflags = f `elem` (flags dflags)
dopt_CoreToDo :: DynFlags -> CoreToDo
dopt_CoreToDo = coreToDo
......@@ -381,6 +298,7 @@ data HscLang
= HscC
| HscAsm
| HscJava
| HscInterpreter
deriving Eq
dopt_HscLang :: DynFlags -> HscLang
......@@ -451,22 +369,6 @@ opt_PprStyle_NoPrags = lookUp SLIT("-dppr-noprags")
opt_PprStyle_Debug = lookUp SLIT("-dppr-debug")
opt_PprUserLength = lookup_def_int "-dppr-user-length" 5 --ToDo: give this a name
-- warning opts
opt_WarnDuplicateExports = lookUp SLIT("-fwarn-duplicate-exports")
opt_WarnHiShadows = lookUp SLIT("-fwarn-hi-shadowing")
opt_WarnIncompletePatterns = lookUp SLIT("-fwarn-incomplete-patterns")
opt_WarnMissingFields = lookUp SLIT("-fwarn-missing-fields")
opt_WarnMissingMethods = lookUp SLIT("-fwarn-missing-methods")
opt_WarnMissingSigs = lookUp SLIT("-fwarn-missing-signatures")
opt_WarnNameShadowing = lookUp SLIT("-fwarn-name-shadowing")
opt_WarnOverlappingPatterns = lookUp SLIT("-fwarn-overlapping-patterns")
opt_WarnSimplePatterns = lookUp SLIT("-fwarn-simple-patterns")
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")
opt_AutoSccsOnExportedToplevs = lookUp SLIT("-fauto-sccs-on-exported-toplevs")
......@@ -495,7 +397,7 @@ opt_UsageSPOn = lookUp SLIT("-fusagesp-on")
opt_UnboxStrictFields = lookUp SLIT("-funbox-strict-fields")
{-
The optional '-inpackage=P' flag tells what package
The optional '-inpackage=P' flag tells what package
we are compiling this module for.
The Prelude, for example is compiled with '-package prelude'
-}
......@@ -561,22 +463,8 @@ opt_UseLongRegs | opt_Unregisterised = 0
%************************************************************************
\begin{code}
isStaticHscFlag f =
isStaticHscFlag f =
f `elem` [
"-fwarn-duplicate-exports",
"-fwarn-hi-shadowing",
"-fwarn-incomplete-patterns",
"-fwarn-missing-fields",
"-fwarn-missing-methods",
"-fwarn-missing-signatures",
"-fwarn-name-shadowing",
"-fwarn-overlapping-patterns",
"-fwarn-simple-patterns",
"-fwarn-type-defaults",
"-fwarn-unused-binds",
"-fwarn-unused-imports",
"-fwarn-unused-matches",
"-fwarn-deprecations",
"-fauto-sccs-on-all-toplevs",
"-fauto-sccs-on-exported-toplevs",
"-fauto-sccs-on-individual-cafs",
......@@ -701,7 +589,7 @@ isAmongSimpl on_switches -- Switches mentioned later occur *earlier*
#endif
}
where
mk_assoc_elem k@(MaxSimplifierIterations lvl)
mk_assoc_elem k@(MaxSimplifierIterations lvl)
= (iBox (tagOf_SimplSwitch k), SwInt lvl)
mk_assoc_elem k@(SimplInlinePhase n)
= (iBox (tagOf_SimplSwitch k), SwInt n)
......
-----------------------------------------------------------------------------
-- $Id: DriverFlags.hs,v 1.4 2000/10/16 14:26:26 simonmar Exp $
-- $Id: DriverFlags.hs,v 1.5 2000/10/17 13:22:10 simonmar Exp $
--
-- Driver flags
--
......@@ -297,7 +297,8 @@ static_flags =
-----------------------------------------------------------------------------
-- parse the dynamic arguments
GLOBAL_VAR(v_DynFlags, error "no dynFlags", DynFlags)
GLOBAL_VAR(v_InitDynFlags, error "no InitDynFlags", DynFlags)
GLOBAL_VAR(v_DynFlags, error "no DynFlags", DynFlags)
setDynFlag f = do
dfs <- readIORef v_DynFlags
......@@ -364,6 +365,23 @@ dynamic_flags = [
, ( "DoStgLinting", NoArg (setDynFlag Opt_DoStgLinting) )
, ( "DoUSPLinting", NoArg (setDynFlag Opt_DoUSPLinting) )
------ Warnings ----------------------------------------------------
, ( "-fwarn-duplicate-exports", NoArg (setDynFlag Opt_WarnDuplicateExports) )
, ( "-fwarn-hi-shadowing", NoArg (setDynFlag Opt_WarnHiShadows) )
, ( "-fwarn-incomplete-patterns", NoArg (setDynFlag Opt_WarnIncompletePatterns) )
, ( "-fwarn-missing-fields", NoArg (setDynFlag Opt_WarnMissingFields) )
, ( "-fwarn-missing-methods", NoArg (setDynFlag Opt_WarnMissingMethods))
, ( "-fwarn-missing-signatures", NoArg (setDynFlag Opt_WarnMissingSigs) )
, ( "-fwarn-name-shadowing", NoArg (setDynFlag Opt_WarnNameShadowin) )
, ( "-fwarn-overlapping-patterns", NoArg (setDynFlag Opt_WarnOverlappingPatterns )) )
, ( "-fwarn-simple-patterns", NoArg (setDynFlag Opt_WarnSimplePatterns))
, ( "-fwarn-type-defaults", NoArg (setDynFlag Opt_WarnTypeDefaults) )
, ( "-fwarn-unused-binds", NoArg (setDynFlag Opt_WarnUnusedBinds) )
, ( "-fwarn-unused-imports", NoArg (setDynFlag Opt_WarnUnusedImports) )
, ( "-fwarn-unused-matches", NoArg (setDynFlag Opt_WarnUnusedMatches) )
, ( "-fwarn-deprecations", NoArg (setDynFlag Opt_WarnDeprecations) )
------ Machine dependant (-m<blah>) stuff ---------------------------
, ( "monly-2-regs", NoArg (updateState (\s -> s{stolen_x86_regs = 2}) ))
......@@ -447,12 +465,6 @@ build_hsc_opts = do
static <- (do s <- readIORef static; if s then return "-static" else return "")
l <- readIORef hsc_lang
let lang = case l of
HscC -> "-olang=C"
HscAsm -> "-olang=asm"
HscJava -> "-olang=java"
-- get hi-file suffix
hisuf <- readIORef hi_suf
......@@ -466,27 +478,8 @@ build_hsc_opts = do
import_dirs <- readIORef import_paths
package_import_dirs <- getPackageImportPath
let hi_map = "-himap=" ++
makeHiMap import_dirs hisuf
package_import_dirs package_hisuf
split_marker
hi_map_sep = "-himap-sep=" ++ [split_marker]
return
(
filtered_opts
++ [ hi_vers, static, verb, lang, hi_map, hi_map_sep ]
++ [ hi_vers, static, verb ]
)
makeHiMap
(import_dirs :: [String])
(hi_suffix :: String)
(package_import_dirs :: [String])
(package_hi_suffix :: String)
(split_marker :: Char)
= foldr (add_dir hi_suffix)
(foldr (add_dir package_hi_suffix) "" package_import_dirs)
import_dirs
where
add_dir hisuf dir str = dir ++ "%." ++ hisuf ++ split_marker : str
-----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.1 2000/10/11 15:31:43 simonmar Exp $
-- $Id: DriverMkDepend.hs,v 1.2 2000/10/17 13:22:10 simonmar Exp $
--
-- GHC Driver
--
......@@ -16,9 +16,9 @@ import DriverState
import DriverUtil
import DriverFlags
import TmpFiles
import Module
import Config
import Util
import CmdLineOpts
import IOExts
import Exception
......@@ -173,8 +173,8 @@ findDependency mod imp = do
let
(imp_mod, is_source) =
case imp of
MINormal str -> (str, False)
MISource str -> (str, True )
MINormal str -> (moduleNameString str, False)
MISource str -> (moduleNameString str, True )
imp_hi = imp_mod ++ '.':hisuf
imp_hiboot = imp_mod ++ ".hi-boot"
......
......@@ -7,7 +7,8 @@
module Finder (
Finder, -- = ModuleName -> IO (Maybe (Module, ModuleLocation))
newFinder, -- :: PackageConfigInfo -> IO Finder,
ModuleLocation(..)
ModuleLocation(..),
mkHomeModuleLocn
) where
#include "HsVersions.h"
......@@ -116,28 +117,28 @@ maybeHomeModule mod_name = do
lhs = basename ++ ".lhs"
case lookupFM home_cache hs of {
Just path -> mkHomeModuleLocn mod_name basename path hs;
Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) hs;
Nothing ->
case lookupFM home_cache lhs of {
Just path -> mkHomeModuleLocn mod_name basename path lhs;
Just path -> mkHomeModuleLocn mod_name (path ++ '/':basename) lhs;
Nothing -> return Nothing
}}
mkHomeModuleLocn mod_name basename path source_fn = do
mkHomeModuleLocn mod_name basename source_fn = do
-- figure out the .hi file name: it lives in the same dir as the
-- source, unless there's a -ohi flag on the command line.
ohi <- readIORef output_hi
hisuf <- readIORef hi_suf
let hifile = case ohi of
Nothing -> path ++ '/':basename ++ hisuf
Nothing -> basename ++ hisuf
Just fn -> fn
-- figure out the .o file name. It also lives in the same dir
-- as the source, but can be overriden by a -odir flag.
o_file <- odir_ify (path ++ '/':basename ++ '.':phaseInputExt Ln)
o_file <- odir_ify (basename ++ '.':phaseInputExt Ln)
return (Just (mkHomeModule mod_name,
ModuleLocation{
......
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.5 2000/10/11 16:26:04 simonmar Exp $
-- $Id: Main.hs,v 1.6 2000/10/17 13:22:11 simonmar Exp $
--
-- GHC Driver program
--
......@@ -161,6 +161,9 @@ main =
-- the rest of the arguments are "dynamic"
srcs <- processArgs dynamic_flags non_static []
-- save the "initial DynFlags" away
dyn_flags <- readIORef v_DynFlags
writeIORef v_InitDynFlags dyn_flags
-- complain about any unknown flags
let unknown_flags = [ f | ('-':f) <- srcs ]
......
......@@ -110,7 +110,7 @@ import Type ( Type, mkTyConTy, mkTyConApp, mkSigmaTy, mkTyVarTys,
TauType, ClassContext )
import Unique ( incrUnique, mkTupleTyConUnique, mkTupleDataConUnique )
import PrelNames
import CmdLineOpts ( DynFlags, dopt_GlasgowExts )
import CmdLineOpts
import Array
alpha_tyvar = [alphaTyVar]
......@@ -481,7 +481,7 @@ legalOutgoingTyCon dflags be_safe tc
= marshalableTyCon dflags tc
marshalableTyCon dflags tc
= (dopt_GlasgowExts dflags && isUnLiftedTyCon tc)
= (dopt Opt_GlasgowExts dflags && isUnLiftedTyCon tc)
|| boxedMarshalableTyCon tc
boxedMarshalableTyCon tc
......
......@@ -8,8 +8,6 @@ module RnEnv where -- Export everything
#include "HsVersions.h"
import CmdLineOpts ( opt_WarnNameShadowing, opt_WarnUnusedMatches,
opt_WarnUnusedBinds, opt_WarnUnusedImports )
import HsSyn
import RdrHsSyn ( RdrNameIE )
import RdrName ( RdrName, rdrNameModule, rdrNameOcc, isQual, isUnqual,
......@@ -40,6 +38,7 @@ import ListSetOps ( removeDups, equivClasses )
import Util ( thenCmp, sortLt )
import List ( nub )
import PrelNames ( mkUnboundName )
import CmdLineOpts
\end{code}
......@@ -319,9 +318,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 | opt_WarnNameShadowing -> mapRn_ (check_shadow name_env) rdr_names_w_loc
SourceMode | warn_shadow -> mapRn_ (check_shadow name_env) rdr_names_w_loc
other -> returnRn ()
) `thenRn_`
......@@ -683,8 +684,9 @@ mapFvRn f xs = mapRn f xs `thenRn` \ stuff ->
\begin{code}
warnUnusedModules :: [Module] -> RnM d ()
warnUnusedModules mods
| not opt_WarnUnusedImports = returnRn ()
| otherwise = mapRn_ (addWarnRn . unused_mod . moduleName) mods
= doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
if warn then mapRn_ (addWarnRn . unused_mod . moduleName) mods
else returnRn ()
where
unused_mod m = vcat [ptext SLIT("Module") <+> quotes (ppr m) <+>
text "is imported, but nothing from it is used",
......@@ -693,19 +695,19 @@ warnUnusedModules mods
warnUnusedImports :: [(Name,Provenance)] -> RnM d ()
warnUnusedImports names
| not opt_WarnUnusedImports
= returnRn () -- Don't force names unless necessary
| otherwise
= warnUnusedBinds names
= doptRn Opt_WarnUnusedImports `thenRn` \ warn ->
if warn then warnUnusedBinds names else return ()
warnUnusedLocalBinds, warnUnusedMatches :: [Name] -> RnM d ()
warnUnusedLocalBinds names
| not opt_WarnUnusedBinds = returnRn ()
| otherwise = warnUnusedBinds [(n,LocalDef) | n<-names]
= doptRn Opt_WarnUnusedBinds `thenRn` \ warn ->
if warn then warnUnusedBinds [(n,LocalDef) | n<-names]
else returnRn ()
warnUnusedMatches names
| opt_WarnUnusedMatches = warnUnusedGroup [(n,LocalDef) | n<-names]
| otherwise = returnRn ()
= doptRn Opt_WarnUnusedMatches `thenRn` \ warn ->
if warn then warnUnusedGroup [(n,LocalDef) | n<-names]
else returnRn ()
-------------------------
......
......@@ -51,7 +51,7 @@ import Name ( Name, OccName, NamedThing(..), getSrcLoc,
)
import Module ( Module, ModuleName, WhereFrom, moduleName )
import NameSet
import CmdLineOpts ( DynFlags, dopt_D_dump_rn_trace )
import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
import SrcLoc ( SrcLoc, generatedSrcLoc )
import Unique ( Unique )
import FiniteMap ( FiniteMap, emptyFM, listToFM, plusFM )
......@@ -85,7 +85,7 @@ ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok))
traceRn :: SDoc -> RnM d ()
traceRn msg
= doptsRn dopt_D_dump_rn_trace `thenRn` \b ->
= doptRn Opt_D_dump_rn_trace `thenRn` \b ->
if b then putDocRn msg else returnRn ()
putDocRn :: SDoc -> RnM d ()
......@@ -514,9 +514,9 @@ checkErrsRn (RnDown {rn_errs = errs_var}) l_down
= readIORef errs_var >>= \ (warns,errs) ->
return (isEmptyBag errs)
doptsRn :: (DynFlags -> Bool) -> RnM d Bool
doptsRn dopt (RnDown { rn_dflags = dflags}) l_down
= return (dopt dflags)
doptRn :: DynFlag -> RnM d Bool
doptRn dflag (RnDown { rn_dflags = dflags}) l_down
= return (dopt dflag dflags)
\end{code}
......
......@@ -10,8 +10,6 @@ module WorkWrap ( wwTopBinds, mkWrapper ) where
import CoreSyn
import CoreUnfold ( Unfolding, certainlyWillInline )
import CmdLineOpts ( DynFlags,
dopt_D_verbose_core2core, dopt_D_dump_worker_wrapper )
import CoreLint ( beginPass, endPass )
import CoreUtils ( exprType, exprEtaExpandArity )
import MkId ( mkWorkerId )
......@@ -25,6 +23,7 @@ import IdInfo ( mkStrictnessInfo, noStrictnessInfo, StrictnessInfo(..),
)
import Demand ( Demand, wwLazy )
import UniqSupply ( UniqSupply, initUs_, returnUs, thenUs, mapUs, getUniqueUs, UniqSM )
import CmdLineOpts
import WwLib
import Outputable
\end{code}
......@@ -71,8 +70,8 @@ wwTopBinds dflags us binds
let { binds' = workersAndWrappers us binds };
endPass dflags "Worker Wrapper binds"
(dopt_D_dump_worker_wrapper dflags ||
dopt_D_verbose_core2core dflags)
(dopt Opt_D_dump_worker_wrapper dflags ||
dopt Opt_D_verbose_core2core dflags)
binds'
}
\end{code}
......
......@@ -39,7 +39,6 @@ import PrelInfo ( nO_METHOD_BINDING_ERROR_ID )
import Class ( classTyVars, classBigSig, classSelIds, classTyCon, Class, ClassOpItem,
DefMeth (..) )
import Bag ( bagToList )
import CmdLineOpts ( dopt_GlasgowExts, opt_WarnMissingMethods, opt_PprStyle_Debug )
import MkId ( mkDictSelId, mkDataConId, mkDataConWrapId, mkDefaultMethodId )
import DataCon ( mkDataCon, notMarkedStrict )
import Id ( Id, idType, idName )
......@@ -52,6 +51,7 @@ import Type ( Type, ClassContext, mkTyVarTys, mkDictTys, mkSigmaTy, mkClassPred
)
import Var ( TyVar )
import VarSet ( mkVarSet, emptyVarSet )
import CmdLineOpts