Remove getDOpts; use getDynFlags instead
authorIan Lynagh <igloo@earth.li>
Thu, 19 Jan 2012 13:31:54 +0000 (13:31 +0000)
committerIan Lynagh <igloo@earth.li>
Thu, 19 Jan 2012 13:31:54 +0000 (13:31 +0000)
24 files changed:
compiler/deSugar/DsForeign.lhs
compiler/deSugar/DsMonad.lhs
compiler/iface/BinIface.hs
compiler/iface/LoadIface.lhs
compiler/rename/RnEnv.lhs
compiler/rename/RnExpr.lhs
compiler/rename/RnNames.lhs
compiler/rename/RnSource.lhs
compiler/typecheck/FamInst.lhs
compiler/typecheck/Inst.lhs
compiler/typecheck/TcBinds.lhs
compiler/typecheck/TcClassDcl.lhs
compiler/typecheck/TcDeriv.lhs
compiler/typecheck/TcEnv.lhs
compiler/typecheck/TcErrors.lhs
compiler/typecheck/TcExpr.lhs
compiler/typecheck/TcForeign.lhs
compiler/typecheck/TcGenGenerics.lhs
compiler/typecheck/TcInstDcls.lhs
compiler/typecheck/TcMType.lhs
compiler/typecheck/TcRnDriver.lhs
compiler/typecheck/TcRnMonad.lhs
compiler/typecheck/TcSMonad.lhs
compiler/typecheck/TcSplice.lhs

index cce8ba7..b613fbd 100644 (file)
@@ -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)
index 1da9024..e68e6db 100644 (file)
@@ -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
index 6bf4da9..d821c13 100644 (file)
@@ -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
index 37379b5..107c24c 100644 (file)
@@ -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)) }
         }
index 89a498a..bd424e8 100644 (file)
@@ -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 }
index 0487733..7caae61 100644 (file)
@@ -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) }
index 1f9041e..68e6d02 100644 (file)
@@ -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
index c676a9b..175b9a7 100644 (file)
@@ -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)
index 6269051..98305e4 100644 (file)
@@ -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
index b589c26..a194d74 100644 (file)
@@ -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
index 3b9dda2..e14bd49 100644 (file)
@@ -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
index 77f1c42..ac1895f 100644 (file)
@@ -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)]))
index dda82ff..4db96c6 100644 (file)
@@ -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
index 915978b..ae320ce 100644 (file)
@@ -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
index be98308..56a42e7 100644 (file)
@@ -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
index a3b33bc..abcff85 100644 (file)
@@ -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
 
index c9c6a1e..c009343 100644 (file)
@@ -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
index 8bef059..1fbb7df 100644 (file)
@@ -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
index 2bf6164..8351b7b 100644 (file)
@@ -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))
index d92d80c..f63ec51 100644 (file)
@@ -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
index 4e46de9..908588b 100644 (file)
@@ -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)) ;
 
index 2c6461f..351a3e2 100644 (file)
@@ -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 }
index 240ba9c..660007d 100644 (file)
@@ -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)
index 56fa953..86e9855 100644 (file)
@@ -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