Commit 9dacfcbf authored by Ian Lynagh's avatar Ian Lynagh

Remove getDOpts; use getDynFlags instead

parent 3220e571
......@@ -345,7 +345,7 @@ dsFExport fn_id co ext_name cconv isDyn = do
-- The function returns t
Nothing -> (orig_res_ty, False)
dflags <- getDOpts
dflags <- getDynFlags
return $
mkFExportCBits dflags ext_name
(if isDyn then Nothing else Just fn_id)
......
......@@ -267,7 +267,7 @@ initDsTc thing_inside
= do { this_mod <- getModule
; tcg_env <- getGblEnv
; msg_var <- getErrsVar
; dflags <- getDOpts
; dflags <- getDynFlags
; let type_env = tcg_type_env tcg_env
rdr_env = tcg_rdr_env tcg_env
ds_envs = mkDsEnvs dflags this_mod rdr_env type_env msg_var
......
......@@ -76,7 +76,7 @@ readBinIface :: CheckHiWay -> TraceBinIFaceReading -> FilePath
-> TcRnIf a b ModIface
readBinIface checkHiWay traceBinIFaceReading hi_path = do
ncu <- mkNameCacheUpdater
dflags <- getDOpts
dflags <- getDynFlags
liftIO $ readBinIface_ dflags checkHiWay traceBinIFaceReading hi_path ncu
readBinIface_ :: DynFlags -> CheckHiWay -> TraceBinIFaceReading -> FilePath
......
......@@ -188,7 +188,7 @@ loadInterface doc_str mod from
; traceIf (text "Considering whether to load" <+> ppr mod <+> ppr from)
-- Check whether we have the interface already
; dflags <- getDOpts
; dflags <- getDynFlags
; case lookupIfaceByModule dflags hpt (eps_PIT eps) mod of {
Just iface
-> return (Succeeded iface) ; -- Already loaded
......@@ -489,7 +489,7 @@ findAndReadIface doc_str mod hi_boot_file
nest 4 (ptext (sLit "reason:") <+> doc_str)])
-- Check for GHC.Prim, and return its static interface
; dflags <- getDOpts
; dflags <- getDynFlags
; if mod == gHC_PRIM
then return (Succeeded (ghcPrimIface,
"<built in interface for GHC.Prim>"))
......@@ -526,7 +526,7 @@ findAndReadIface doc_str mod hi_boot_file
}}
; err -> do
{ traceIf (ptext (sLit "...not found"))
; dflags <- getDOpts
; dflags <- getDynFlags
; return (Failed (cannotFindInterface dflags
(moduleName mod) err)) }
}
......
......@@ -1112,7 +1112,7 @@ checkShadowedOccs (global_env,local_env) loc_occs
-- Returns False for record selectors that are shadowed, when
-- punning or wild-cards are on (cf Trac #2723)
is_shadowed_gre gre@(GRE { gre_par = ParentIs _ })
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; if (xopt Opt_RecordPuns dflags || xopt Opt_RecordWildCards dflags)
then do { is_fld <- is_rec_fld gre; return (not is_fld) }
else return True }
......
......@@ -1239,7 +1239,7 @@ checkStmt :: HsStmtContext Name
-> LStmt RdrName
-> RnM ()
checkStmt ctxt (L _ stmt)
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; case okStmt dflags ctxt stmt of
Nothing -> return ()
Just extra -> addErr (msg $$ extra) }
......
......@@ -200,7 +200,7 @@ rnImportDecl this_mod
-- and indeed we shouldn't do it here because the existence of
-- the non-boot module depends on the compilation order, which
-- is not deterministic. The hs-boot test can show this up.
dflags <- getDOpts
dflags <- getDynFlags
warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
(warnRedundantSourceImport imp_mod_name)
when (mod_safe && not (safeImportsOn dflags)) $
......@@ -964,7 +964,7 @@ rnExports explicit_mod exports
-- written "module Main where ..."
-- Reason: don't want to complain about 'main' not in scope
-- in interactive mode
; dflags <- getDOpts
; dflags <- getDynFlags
; let real_exports
| explicit_mod = exports
| ghcLink dflags == LinkInMemory = Nothing
......
......@@ -749,7 +749,7 @@ rnTyClDecls :: [Name] -> [[LTyClDecl RdrName]]
-- Rename the declarations and do depedency analysis on them
rnTyClDecls extra_deps tycl_ds
= do { ds_w_fvs <- mapM (wrapLocFstM (rnTyClDecl Nothing)) (concat tycl_ds)
; thisPkg <- fmap thisPackage getDOpts
; thisPkg <- fmap thisPackage getDynFlags
; let add_boot_deps :: FreeVars -> FreeVars
-- See Note [Extra dependencies from .hs-boot files]
add_boot_deps fvs | any (isInPackage thisPkg) (nameSetToList fvs)
......
......@@ -21,6 +21,7 @@ import TypeRep
import TcMType
import TcRnMonad
import TyCon
import DynFlags
import Name
import Module
import SrcLoc
......@@ -92,7 +93,7 @@ listToSet l = Map.fromList (zip l (repeat ()))
checkFamInstConsistency :: [Module] -> [Module] -> TcM ()
checkFamInstConsistency famInstMods directlyImpMods
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; (eps, hpt) <- getEpsAndHpt
; let { -- Fetch the iface of a given module. Must succeed as
......
......@@ -377,7 +377,7 @@ syntaxNameCtxt name orig ty tidy_env = do
\begin{code}
getOverlapFlag :: TcM OverlapFlag
getOverlapFlag
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; let overlap_ok = xopt Opt_OverlappingInstances dflags
incoherent_ok = xopt Opt_IncoherentInstances dflags
safeOverlap = safeLanguageOn dflags
......
......@@ -332,7 +332,7 @@ tcPolyBinds top_lvl sig_fn prag_fn rec_group rec_tc bind_list
-- (as determined by sig_fn), returning a TcSigInfo for each
; tc_sig_fn <- tcInstSigs sig_fn binder_names
; dflags <- getDOpts
; dflags <- getDynFlags
; type_env <- getLclTypeEnv
; let plan = decideGeneralisationPlan dflags type_env
binder_names bind_list tc_sig_fn
......@@ -604,7 +604,7 @@ tcImpPrags :: [LSig Name] -> TcM [LTcSpecPrag]
-- SPECIALISE pragamas for imported things
tcImpPrags prags
= do { this_mod <- getModule
; dflags <- getDOpts
; dflags <- getDynFlags
; if (not_specialising dflags) then
return []
else
......
......@@ -363,7 +363,7 @@ mkGenericDefMethBind clas inst_tys sel_id dm_name
= -- A generic default method
-- If the method is defined generically, we only have to call the
-- dm_name.
do { dflags <- getDOpts
do { dflags <- getDynFlags
; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Filling in method body"
(vcat [ppr clas <+> ppr inst_tys,
nest 2 (ppr sel_id <+> equals <+> ppr rhs)]))
......
......@@ -331,7 +331,7 @@ tcDeriving tycl_decls inst_decls deriv_decls
; (inst_info, rn_binds, rn_dus) <-
renameDeriv is_boot (inst_infos ++ (bagToList extraInstances)) binds
; dflags <- getDOpts
; dflags <- getDynFlags
; liftIO (dumpIfSet_dyn dflags Opt_D_dump_deriv "Derived instances"
(ddump_deriving inst_info rn_binds newTyCons famInsts))
......@@ -617,7 +617,7 @@ mkEqnHelp orig tvs cls cls_tys tc_app mtheta
mk_alg_eqn tycon tc_args
| className cls `elem` typeableClassNames
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; case checkTypeableConditions (dflags, tycon) of
Just err -> bale_out err
Nothing -> mk_typeable_eqn orig tvs cls tycon tc_args mtheta }
......@@ -641,7 +641,7 @@ mkEqnHelp orig tvs cls cls_tys tc_app mtheta
; unless (isNothing mtheta || not hidden_data_cons)
(bale_out (derivingHiddenErr tycon))
; dflags <- getDOpts
; dflags <- getDynFlags
; if isDataTyCon rep_tc then
mkDataTypeEqn orig dflags tvs cls cls_tys
tycon tc_args rep_tc rep_tc_args mtheta
......
......@@ -558,7 +558,7 @@ tcGetDefaultTys :: Bool -- True <=> interactive context
(Bool, -- True <=> Use overloaded strings
Bool)) -- True <=> Use extended defaulting rules
tcGetDefaultTys interactive
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; let ovl_strings = xopt Opt_OverloadedStrings dflags
extended_defaults = interactive
|| xopt Opt_ExtendedDefaultRules dflags
......
......@@ -899,7 +899,7 @@ mkAmbigMsg ctxt cts
| isEmptyVarSet ambig_tv_set
= return (ctxt, False, empty)
| otherwise
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; (ctxt', gbl_docs) <- findGlobals ctxt ambig_tv_set
; return (ctxt', True, mk_msg dflags gbl_docs) }
where
......
......@@ -325,7 +325,7 @@ tcExpr (SectionR op arg2) res_ty
tcExpr (SectionL arg1 op) res_ty
= do { (op', op_ty) <- tcInferFun op
; dflags <- getDOpts -- Note [Left sections]
; dflags <- getDynFlags -- Note [Left sections]
; let n_reqd_args | xopt Opt_PostfixOperators dflags = 1
| otherwise = 2
......
......@@ -246,14 +246,14 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar
check False (illegalForeignTyErr empty sig_ty)
return idecl
(arg1_ty:arg_tys) -> do
dflags <- getDOpts
dflags <- getDynFlags
check (isFFIDynArgumentTy arg1_ty)
(illegalForeignTyErr argument arg1_ty)
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
return idecl
| cconv == PrimCallConv = do
dflags <- getDOpts
dflags <- getDynFlags
check (xopt Opt_GHCForeignImportPrim dflags)
(text "Use -XGHCForeignImportPrim to allow `foreign import prim'.")
checkCg (checkCOrAsmOrLlvmOrDotNetOrInterp)
......@@ -268,7 +268,7 @@ tcCheckFIType sig_ty arg_tys res_ty idecl@(CImport cconv safety _ (CFunction tar
checkCg checkCOrAsmOrLlvmOrDotNetOrInterp
checkCConv cconv
checkCTarget target
dflags <- getDOpts
dflags <- getDynFlags
checkForeignArgs (isFFIArgumentTy dflags safety) arg_tys
checkForeignRes nonIOok checkSafe (isFFIImportResultTy dflags) res_ty
checkMissingAmpersand dflags arg_tys res_ty
......@@ -383,7 +383,7 @@ checkForeignRes non_io_result_ok check_safe pred_res_ty ty
-- Case for non-IO result type with FFI Import
_ -> do
dflags <- getDOpts
dflags <- getDynFlags
case (pred_res_ty ty && non_io_result_ok) of
-- handle normal typecheck fail, we want to handle this first and
-- only report safe haskell errors if the normal type check is OK.
......@@ -440,7 +440,7 @@ checkCOrAsmOrLlvmOrDotNetOrInterp _
checkCg :: (HscTarget -> Maybe SDoc) -> TcM ()
checkCg check = do
dflags <- getDOpts
dflags <- getDynFlags
let target = hscTarget dflags
case target of
HscNothing -> return ()
......@@ -456,7 +456,7 @@ Calling conventions
checkCConv :: CCallConv -> TcM ()
checkCConv CCallConv = return ()
checkCConv CApiConv = return ()
checkCConv StdCallConv = do dflags <- getDOpts
checkCConv StdCallConv = do dflags <- getDynFlags
let platform = targetPlatform dflags
unless (platformArch platform == ArchX86) $
-- This is a warning, not an error. see #3336
......
......@@ -117,7 +117,7 @@ genGenericRepExtras tc mod =
genDtMeta :: (TyCon, MetaTyCons) -> TcM BagDerivStuff
genDtMeta (tc,metaDts) =
do loc <- getSrcSpanM
dflags <- getDOpts
dflags <- getDynFlags
dClas <- tcLookupClass datatypeClassName
let new_dfun_name clas tycon = newDFunName clas [mkTyConApp tycon []] loc
d_dfun_name <- new_dfun_name dClas tc
......
......@@ -399,7 +399,7 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
-- Check that if the module is compiled with -XSafe, there are no
-- hand written instances of Typeable as then unsafe casts could be
-- performed. Derived instances are OK.
; dflags <- getDOpts
; dflags <- getDynFlags
; when (safeLanguageOn dflags) $
mapM_ (\x -> when (typInstCheck x)
(addErrAt (getSrcSpan $ iSpec x) typInstErr))
......
......@@ -1180,7 +1180,7 @@ check_valid_theta :: UserTypeCtxt -> [PredType] -> TcM ()
check_valid_theta _ []
= return ()
check_valid_theta ctxt theta = do
dflags <- getDOpts
dflags <- getDynFlags
warnTc (notNull dups) (dupPredWarn dups)
mapM_ (check_pred_ty dflags ctxt) theta
where
......@@ -1487,7 +1487,7 @@ We can also have instances for functions: @instance Foo (a -> b) ...@.
\begin{code}
checkValidInstHead :: UserTypeCtxt -> Class -> [Type] -> TcM ()
checkValidInstHead ctxt clas tys
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
-- Check language restrictions;
-- but not for SPECIALISE isntance pragmas
......
......@@ -983,7 +983,7 @@ checkMain :: TcM TcGblEnv
-- If we are in module Main, check that 'main' is defined.
checkMain
= do { tcg_env <- getGblEnv ;
dflags <- getDOpts ;
dflags <- getDynFlags ;
check_main dflags tcg_env
}
......@@ -1065,7 +1065,7 @@ getMainFun dflags = case (mainFunIs dflags) of
checkMainExported :: TcGblEnv -> TcM ()
checkMainExported tcg_env = do
dflags <- getDOpts
dflags <- getDynFlags
case tcg_main tcg_env of
Nothing -> return () -- not the main module
Just main_name -> do
......@@ -1677,7 +1677,7 @@ rnDump doc = do { dumpOptTcRn Opt_D_dump_rn (mkDumpDoc "Renamer" doc) }
tcDump :: TcGblEnv -> TcRn ()
tcDump env
= do { dflags <- getDOpts ;
= do { dflags <- getDynFlags ;
-- Dump short output if -ddump-types or -ddump-tc
when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
......@@ -1694,7 +1694,7 @@ tcDump env
tcCoreDump :: ModGuts -> TcM ()
tcCoreDump mod_guts
= do { dflags <- getDOpts ;
= do { dflags <- getDynFlags ;
when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags)
(dumpTcRn (pprModGuts mod_guts)) ;
......
......@@ -254,17 +254,14 @@ setEnvs (gbl_env, lcl_env) = updEnv (\ env -> env { env_gbl = gbl_env, env_lcl =
Command-line flags
\begin{code}
getDOpts :: TcRnIf gbl lcl DynFlags
getDOpts = do { env <- getTopEnv; return (hsc_dflags env) }
xoptM :: ExtensionFlag -> TcRnIf gbl lcl Bool
xoptM flag = do { dflags <- getDOpts; return (xopt flag dflags) }
xoptM flag = do { dflags <- getDynFlags; return (xopt flag dflags) }
doptM :: DynFlag -> TcRnIf gbl lcl Bool
doptM flag = do { dflags <- getDOpts; return (dopt flag dflags) }
doptM flag = do { dflags <- getDynFlags; return (dopt flag dflags) }
woptM :: WarningFlag -> TcRnIf gbl lcl Bool
woptM flag = do { dflags <- getDOpts; return (wopt flag dflags) }
woptM flag = do { dflags <- getDynFlags; return (wopt flag dflags) }
setXOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a
setXOptM flag = updEnv (\ env@(Env { env_top = top }) ->
......@@ -457,7 +454,7 @@ traceOptTcRn flag doc = ifDOptM flag $ do
dumpTcRn :: SDoc -> TcRn ()
dumpTcRn doc = do { rdr_env <- getGlobalRdrEnv
; dflags <- getDOpts
; dflags <- getDynFlags
; liftIO (printForUser stderr (mkPrintUnqualified dflags rdr_env) doc) }
debugDumpTcRn :: SDoc -> TcRn ()
......@@ -626,7 +623,7 @@ mkLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ErrMsg
mkLongErrAt loc msg extra
= do { traceTc "Adding error:" (mkLocMessage SevError loc (msg $$ extra)) ;
rdr_env <- getGlobalRdrEnv ;
dflags <- getDOpts ;
dflags <- getDynFlags ;
return $ mkLongErrMsg loc (mkPrintUnqualified dflags rdr_env) msg extra }
addLongErrAt :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()
......@@ -649,7 +646,7 @@ reportWarning warn
dumpDerivingInfo :: SDoc -> TcM ()
dumpDerivingInfo doc
= do { dflags <- getDOpts
= do { dflags <- getDynFlags
; when (dopt Opt_D_dump_deriv dflags) $ do
{ rdr_env <- getGlobalRdrEnv
; let unqual = mkPrintUnqualified dflags rdr_env
......@@ -719,7 +716,7 @@ tryTcErrs :: TcRn a -> TcRn (Messages, Maybe a)
-- there might be warnings
tryTcErrs thing
= do { (msgs, res) <- tryTc thing
; dflags <- getDOpts
; dflags <- getDynFlags
; let errs_found = errorsFound dflags msgs
; return (msgs, case res of
Nothing -> Nothing
......@@ -775,7 +772,7 @@ ifErrsM :: TcRn r -> TcRn r -> TcRn r
ifErrsM bale_out normal
= do { errs_var <- getErrsVar ;
msgs <- readTcRef errs_var ;
dflags <- getDOpts ;
dflags <- getDynFlags ;
if errorsFound dflags msgs then
bale_out
else
......@@ -908,7 +905,7 @@ add_warn msg extra_info
add_warn_at :: SrcSpan -> MsgDoc -> MsgDoc -> TcRn ()
add_warn_at loc msg extra_info
= do { rdr_env <- getGlobalRdrEnv ;
dflags <- getDOpts ;
dflags <- getDynFlags ;
let { warn = mkLongWarnMsg loc (mkPrintUnqualified dflags rdr_env)
msg extra_info } ;
reportWarning warn }
......
......@@ -923,7 +923,7 @@ emitFrozenError fl ev depth
; wrapTcS (TcM.writeTcRef inert_ref inerts_new) }
instance HasDynFlags TcS where
getDynFlags = wrapTcS TcM.getDOpts
getDynFlags = wrapTcS getDynFlags
getTcSContext :: TcS SimplContext
getTcSContext = TcS (return . tcs_context)
......
......@@ -72,6 +72,7 @@ import Pair
import Unique
import Data.Maybe
import BasicTypes
import DynFlags
import Panic
import FastString
import Control.Monad ( when )
......@@ -1106,7 +1107,7 @@ tcLookupTh name
else do -- It's imported
{ (eps,hpt) <- getEpsAndHpt
; dflags <- getDOpts
; dflags <- getDynFlags
; case lookupType dflags hpt (eps_PTE eps) name of
Just thing -> return (AGlobal thing)
Nothing -> do { thing <- tcImportDecl name
......
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