diff options
| author | Ian Lynagh <ian@well-typed.com> | 2012-10-16 15:28:26 +0100 |
|---|---|---|
| committer | Ian Lynagh <ian@well-typed.com> | 2012-10-16 16:08:38 +0100 |
| commit | cd33eefd0467ae7ee4d22f16fcaaccfd33f18cb5 (patch) | |
| tree | 30fb18578f1c5c81fef7ccc6ec5879a41fd4e5c0 /compiler | |
| parent | 6759e5a482d927870c90efe97b820d492785a6fd (diff) | |
| download | haskell-cd33eefd0467ae7ee4d22f16fcaaccfd33f18cb5.tar.gz | |
Some alpha renaming
Mostly d -> g (matching DynFlag -> GeneralFlag).
Also renamed if* to when*, matching the Haskell if/when names
Diffstat (limited to 'compiler')
97 files changed, 336 insertions, 336 deletions
diff --git a/compiler/basicTypes/Name.lhs b/compiler/basicTypes/Name.lhs index 76018614bf..32813e8ac3 100644 --- a/compiler/basicTypes/Name.lhs +++ b/compiler/basicTypes/Name.lhs @@ -466,7 +466,7 @@ pprExternal sty uniq mod occ name is_wired is_builtin | otherwise = pprModulePrefix sty mod name <> ppr_occ_name occ where pp_mod = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressModulePrefixes dflags + if gopt Opt_SuppressModulePrefixes dflags then empty else ppr mod <> dot @@ -496,7 +496,7 @@ pprModulePrefix :: PprStyle -> Module -> Name -> SDoc -- Print the "M." part of a name, based on whether it's in scope or not -- See Note [Printing original names] in HscTypes pprModulePrefix sty mod name = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressModulePrefixes dflags + if gopt Opt_SuppressModulePrefixes dflags then empty else case qualName sty name of -- See Outputable.QualifyName: @@ -511,7 +511,7 @@ ppr_underscore_unique :: Unique -> SDoc -- But suppress it if we aren't printing the uniques anyway ppr_underscore_unique uniq = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressUniques dflags + if gopt Opt_SuppressUniques dflags then empty else char '_' <> pprUnique uniq diff --git a/compiler/basicTypes/OccName.lhs b/compiler/basicTypes/OccName.lhs index 74fbeb7fff..6c70dc597a 100644 --- a/compiler/basicTypes/OccName.lhs +++ b/compiler/basicTypes/OccName.lhs @@ -272,7 +272,7 @@ pprOccName (OccName sp occ) | otherwise = empty pp_occ = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressUniques dflags + if gopt Opt_SuppressUniques dflags then text (strip_th_unique (unpackFS occ)) else ftext occ diff --git a/compiler/basicTypes/Var.lhs b/compiler/basicTypes/Var.lhs index 42c0e7f026..6d078d46e9 100644 --- a/compiler/basicTypes/Var.lhs +++ b/compiler/basicTypes/Var.lhs @@ -215,7 +215,7 @@ After CoreTidy, top-level LocalIds are turned into GlobalIds instance Outputable Var where ppr var = ppr (varName var) <+> ifPprDebug (brackets (ppr_debug var)) -- Printing the type on every occurrence is too much! --- <+> if (not (dopt Opt_SuppressVarKinds dflags)) +-- <+> if (not (gopt Opt_SuppressVarKinds dflags)) -- then ifPprDebug (text "::" <+> ppr (tyVarKind var) <+> text ")") -- else empty diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs index 04312321cc..259f31a1b8 100644 --- a/compiler/cmm/CLabel.hs +++ b/compiler/cmm/CLabel.hs @@ -819,7 +819,7 @@ labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool labelDynamic dflags this_pkg lbl = case lbl of -- is the RTS in a DLL or not? - RtsLabel _ -> not (dopt Opt_Static dflags) && (this_pkg /= rtsPackageId) + RtsLabel _ -> not (gopt Opt_Static dflags) && (this_pkg /= rtsPackageId) IdLabel n _ _ -> isDllName dflags this_pkg n @@ -827,7 +827,7 @@ labelDynamic dflags this_pkg lbl = -- its own shared library. CmmLabel pkg _ _ | os == OSMinGW32 -> - not (dopt Opt_Static dflags) && (this_pkg /= pkg) + not (gopt Opt_Static dflags) && (this_pkg /= pkg) | otherwise -> True @@ -845,14 +845,14 @@ labelDynamic dflags this_pkg lbl = -- When compiling in the "dyn" way, each package is to be -- linked into its own DLL. ForeignLabelInPackage pkgId -> - (not (dopt Opt_Static dflags)) && (this_pkg /= pkgId) + (not (gopt Opt_Static dflags)) && (this_pkg /= pkgId) else -- On Mac OS X and on ELF platforms, false positives are OK, -- so we claim that all foreign imports come from dynamic -- libraries True - PlainModuleInitLabel m -> not (dopt Opt_Static dflags) && this_pkg /= (modulePackageId m) + PlainModuleInitLabel m -> not (gopt Opt_Static dflags) && this_pkg /= (modulePackageId m) -- Note that DynamicLinkerLabels do NOT require dynamic linking themselves. _ -> False diff --git a/compiler/cmm/CmmInfo.hs b/compiler/cmm/CmmInfo.hs index dec6b5d09d..e952c831ff 100644 --- a/compiler/cmm/CmmInfo.hs +++ b/compiler/cmm/CmmInfo.hs @@ -366,7 +366,7 @@ mkStdInfoTable dflags (type_descr, closure_descr) cl_type srt_len layout_lit where prof_info - | dopt Opt_SccProfilingOn dflags = [type_descr, closure_descr] + | gopt Opt_SccProfilingOn dflags = [type_descr, closure_descr] | otherwise = [] type_lit = packHalfWordsCLit dflags (toStgHalfWord dflags (fromIntegral cl_type)) srt_len diff --git a/compiler/cmm/CmmParse.y b/compiler/cmm/CmmParse.y index dadf42a5eb..46d1d72b0c 100644 --- a/compiler/cmm/CmmParse.y +++ b/compiler/cmm/CmmParse.y @@ -1018,7 +1018,7 @@ pushStackFrame fields body = do withUpdFrameOff new_updfr_off body profilingInfo dflags desc_str ty_str - = if not (dopt Opt_SccProfilingOn dflags) + = if not (gopt Opt_SccProfilingOn dflags) then NoProfilingInfo else ProfilingInfo (stringToWord8s desc_str) (stringToWord8s ty_str) diff --git a/compiler/cmm/CmmPipeline.hs b/compiler/cmm/CmmPipeline.hs index 06bbd00838..dec4008f74 100644 --- a/compiler/cmm/CmmPipeline.hs +++ b/compiler/cmm/CmmPipeline.hs @@ -85,7 +85,7 @@ cpsTop hsc_env proc = return call_pps let noncall_pps = proc_points `setDifference` call_pps - when (not (setNull noncall_pps) && dopt Opt_D_dump_cmmz dflags) $ + when (not (setNull noncall_pps) && gopt Opt_D_dump_cmmz dflags) $ pprTrace "Non-call proc points: " (ppr noncall_pps) $ return () ----------- Sink and inline assignments *before* stack layout ----------- @@ -163,7 +163,7 @@ cpsTop hsc_env proc = = mapM_ (dumpWith dflags flag name) condPass flag pass g dumpflag dumpname = - if dopt flag dflags + if gopt flag dflags then do g <- return $ pass g dump dumpflag dumpname g @@ -186,7 +186,7 @@ runUniqSM m = do dumpGraph :: DynFlags -> GeneralFlag -> String -> CmmGraph -> IO () dumpGraph dflags flag name g = do - when (dopt Opt_DoCmmLinting dflags) $ do_lint g + when (gopt Opt_DoCmmLinting dflags) $ do_lint g dumpWith dflags flag name g where do_lint g = case cmmLintGraph dflags g of @@ -201,6 +201,6 @@ dumpWith dflags flag txt g = do -- them into files." Also, -ddump-cmmz doesn't play nicely -- with -ddump-to-file, since the headers get omitted. dumpIfSet_dyn dflags flag txt (ppr g) - when (not (dopt flag dflags)) $ + when (not (gopt flag dflags)) $ dumpIfSet_dyn dflags Opt_D_dump_cmmz txt (ppr g) diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index a2427df868..e07bd6459d 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -61,7 +61,7 @@ pprCs dflags cmms = pprCode CStyle (vcat $ map (\c -> split_marker $$ pprC c) cmms) where split_marker - | dopt Opt_SplitObjs dflags = ptext (sLit "__STG_SPLIT_MARKER") + | gopt Opt_SplitObjs dflags = ptext (sLit "__STG_SPLIT_MARKER") | otherwise = empty writeCs :: DynFlags -> Handle -> [RawCmmGroup] -> IO () diff --git a/compiler/cmm/SMRep.lhs b/compiler/cmm/SMRep.lhs index ac021df761..f39af7ce55 100644 --- a/compiler/cmm/SMRep.lhs +++ b/compiler/cmm/SMRep.lhs @@ -267,7 +267,7 @@ fixedHdrSize dflags = sTD_HDR_SIZE dflags + profHdrSize dflags -- (StgProfHeader in includes/rts/storage/Closures.h) profHdrSize :: DynFlags -> WordOff profHdrSize dflags - | dopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags + | gopt Opt_SccProfilingOn dflags = pROF_HDR_SIZE dflags | otherwise = 0 -- | The garbage collector requires that every closure is at least as diff --git a/compiler/codeGen/CgCallConv.hs b/compiler/codeGen/CgCallConv.hs index d548741e1f..e4095fd027 100644 --- a/compiler/codeGen/CgCallConv.hs +++ b/compiler/codeGen/CgCallConv.hs @@ -164,7 +164,7 @@ constructSlowCall amodes slowArgs :: DynFlags -> [(CgRep,CmmExpr)] -> [(CgRep,CmmExpr)] slowArgs _ [] = [] slowArgs dflags amodes - | dopt Opt_SccProfilingOn dflags = save_cccs ++ this_pat ++ slowArgs dflags rest + | gopt Opt_SccProfilingOn dflags = save_cccs ++ this_pat ++ slowArgs dflags rest | otherwise = this_pat ++ slowArgs dflags rest where (arg_pat, args, rest) = matchSlowPattern amodes diff --git a/compiler/codeGen/CgCase.lhs b/compiler/codeGen/CgCase.lhs index 0d86319057..595a30e7a1 100644 --- a/compiler/codeGen/CgCase.lhs +++ b/compiler/codeGen/CgCase.lhs @@ -653,7 +653,7 @@ saveCurrentCostCentre :: saveCurrentCostCentre = do dflags <- getDynFlags - if not (dopt Opt_SccProfilingOn dflags) + if not (gopt Opt_SccProfilingOn dflags) then returnFC (Nothing, noStmts) else do slot <- allocPrimStack PtrArg sp_rel <- getSpRelOffset slot diff --git a/compiler/codeGen/CgClosure.lhs b/compiler/codeGen/CgClosure.lhs index 11a5091c07..b5ce231856 100644 --- a/compiler/codeGen/CgClosure.lhs +++ b/compiler/codeGen/CgClosure.lhs @@ -482,8 +482,8 @@ emitBlackHoleCode is_single_entry = do -- Note the eager-blackholing check is here rather than in blackHoleOnEntry, -- because emitBlackHoleCode is called from CmmParse. - let eager_blackholing = not (dopt Opt_SccProfilingOn dflags) - && dopt Opt_EagerBlackHoling dflags + let eager_blackholing = not (gopt Opt_SccProfilingOn dflags) + && gopt Opt_EagerBlackHoling dflags -- Profiling needs slop filling (to support LDV -- profiling), so currently eager blackholing doesn't -- work with profiling. @@ -515,8 +515,8 @@ setupUpdate closure_info code tickyPushUpdateFrame dflags <- getDynFlags if blackHoleOnEntry closure_info && - not (dopt Opt_SccProfilingOn dflags) && - dopt Opt_EagerBlackHoling dflags + not (gopt Opt_SccProfilingOn dflags) && + gopt Opt_EagerBlackHoling dflags then pushBHUpdateFrame (CmmReg nodeReg) code else pushUpdateFrame (CmmReg nodeReg) code diff --git a/compiler/codeGen/CgCon.lhs b/compiler/codeGen/CgCon.lhs index 858de3a616..abb280ff11 100644 --- a/compiler/codeGen/CgCon.lhs +++ b/compiler/codeGen/CgCon.lhs @@ -185,7 +185,7 @@ because they don't support cross package data references well. buildDynCon' dflags platform binder _ con [arg_amode] | maybeIntLikeCon con - , platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags) + , platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags) , (_, CmmLit (CmmInt val _)) <- arg_amode , let val_int = (fromIntegral val) :: Int , val_int <= mAX_INTLIKE dflags && val_int >= mIN_INTLIKE dflags @@ -197,7 +197,7 @@ buildDynCon' dflags platform binder _ con [arg_amode] buildDynCon' dflags platform binder _ con [arg_amode] | maybeCharLikeCon con - , platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags) + , platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags) , (_, CmmLit (CmmInt val _)) <- arg_amode , let val_int = (fromIntegral val) :: Int , val_int <= mAX_CHARLIKE dflags && val_int >= mIN_CHARLIKE dflags @@ -324,7 +324,7 @@ cgReturnDataCon con amodes = do if isUnboxedTupleCon con then returnUnboxedTuple amodes -- when profiling we can't shortcut here, we have to enter the closure -- for it to be marked as "used" for LDV profiling. - else if dopt Opt_SccProfilingOn dflags then build_it_then (enter_it dflags) + else if gopt Opt_SccProfilingOn dflags then build_it_then (enter_it dflags) else ASSERT( amodes `lengthIs` dataConRepRepArity con ) do { EndOfBlockInfo _ sequel <- getEndOfBlockInfo ; case sequel of diff --git a/compiler/codeGen/CgExpr.lhs b/compiler/codeGen/CgExpr.lhs index 151947665f..70fb600901 100644 --- a/compiler/codeGen/CgExpr.lhs +++ b/compiler/codeGen/CgExpr.lhs @@ -396,7 +396,7 @@ mkRhsClosure dflags bndr cc bi && all isFollowableArg (map idCgRep fvs) && isUpdatable upd_flag && arity <= mAX_SPEC_AP_SIZE dflags - && not (dopt Opt_SccProfilingOn dflags) + && not (gopt Opt_SccProfilingOn dflags) -- not when profiling: we don't want to -- lose information about this particular -- thunk (e.g. its type) (#949) diff --git a/compiler/codeGen/CgForeignCall.hs b/compiler/codeGen/CgForeignCall.hs index 824a82635d..b0e6516f2d 100644 --- a/compiler/codeGen/CgForeignCall.hs +++ b/compiler/codeGen/CgForeignCall.hs @@ -215,7 +215,7 @@ emitSaveThreadState = do (stack_SP dflags)) stgSp emitCloseNursery -- and save the current cost centre stack in the TSO when profiling: - when (dopt Opt_SccProfilingOn dflags) $ + when (gopt Opt_SccProfilingOn dflags) $ stmtC (CmmStore (cmmOffset dflags stgCurrentTSO (tso_CCCS dflags)) curCCS) -- CurrentNursery->free = Hp+1; @@ -246,7 +246,7 @@ emitLoadThreadState = do ] emitOpenNursery -- and load the current cost centre stack from the TSO when profiling: - when (dopt Opt_SccProfilingOn dflags) $ + when (gopt Opt_SccProfilingOn dflags) $ stmtC $ storeCurCCS $ CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) (bWord dflags) diff --git a/compiler/codeGen/CgInfoTbls.hs b/compiler/codeGen/CgInfoTbls.hs index 94301af6ef..be16bf6adf 100644 --- a/compiler/codeGen/CgInfoTbls.hs +++ b/compiler/codeGen/CgInfoTbls.hs @@ -74,7 +74,7 @@ mkCmmInfo cl_info cit_prof = prof dflags, cit_srt = closureSRT cl_info }) where - prof dflags | not (dopt Opt_SccProfilingOn dflags) = NoProfilingInfo + prof dflags | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8 ty_descr_w8 = stringToWord8s (closureTypeDescr cl_info) val_descr_w8 = stringToWord8s (closureValDescr cl_info) @@ -254,7 +254,7 @@ stdInfoTableSizeW dflags = size_fixed + size_prof where size_fixed = 2 -- layout, type - size_prof | dopt Opt_SccProfilingOn dflags = 2 + size_prof | gopt Opt_SccProfilingOn dflags = 2 | otherwise = 0 stdInfoTableSizeB :: DynFlags -> ByteOff diff --git a/compiler/codeGen/CgParallel.hs b/compiler/codeGen/CgParallel.hs index fdc9846694..0e642cba59 100644 --- a/compiler/codeGen/CgParallel.hs +++ b/compiler/codeGen/CgParallel.hs @@ -40,7 +40,7 @@ doGranAllocate :: CmmExpr -> Code -- macro DO_GRAN_ALLOCATE doGranAllocate _hp = do dflags <- getDynFlags - when (dopt Opt_GranMacros dflags) $ panic "doGranAllocate" + when (gopt Opt_GranMacros dflags) $ panic "doGranAllocate" @@ -52,7 +52,7 @@ granFetchAndReschedule :: [(Id,GlobalReg)] -- Live registers granFetchAndReschedule regs node_reqd = do dflags <- getDynFlags let liveness = mkRegLiveness dflags regs 0 0 - when (dopt Opt_GranMacros dflags && + when (gopt Opt_GranMacros dflags && (node `elem` map snd regs || node_reqd)) $ do fetch reschedule liveness node_reqd @@ -90,7 +90,7 @@ granYield :: [(Id,GlobalReg)] -- Live registers granYield regs node_reqd = do dflags <- getDynFlags let liveness = mkRegLiveness dflags regs 0 0 - when (dopt Opt_GranMacros dflags && node_reqd) $ yield liveness + when (gopt Opt_GranMacros dflags && node_reqd) $ yield liveness yield :: StgWord -> Code yield _liveness = panic "granYield" diff --git a/compiler/codeGen/CgPrimOp.hs b/compiler/codeGen/CgPrimOp.hs index 9e5bc52a79..6185a2b07f 100644 --- a/compiler/codeGen/CgPrimOp.hs +++ b/compiler/codeGen/CgPrimOp.hs @@ -159,7 +159,7 @@ emitPrimOp dflags [res] GetCCSOfOp [arg] _live = stmtC (CmmAssign (CmmLocal res) val) where val - | dopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg) + | gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg) | otherwise = CmmLit (zeroCLit dflags) emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg] _live diff --git a/compiler/codeGen/CgProf.hs b/compiler/codeGen/CgProf.hs index 03e01b332a..c7ed0d50c3 100644 --- a/compiler/codeGen/CgProf.hs +++ b/compiler/codeGen/CgProf.hs @@ -139,11 +139,11 @@ enterCostCentreFun ccs closure vols = ifProfiling :: Code -> Code ifProfiling code = do dflags <- getDynFlags - if dopt Opt_SccProfilingOn dflags then code else nopC + if gopt Opt_SccProfilingOn dflags then code else nopC ifProfilingL :: DynFlags -> [a] -> [a] ifProfilingL dflags xs - | dopt Opt_SccProfilingOn dflags = xs + | gopt Opt_SccProfilingOn dflags = xs | otherwise = [] -- --------------------------------------------------------------------------- @@ -220,7 +220,7 @@ sizeof_ccs_words dflags emitSetCCC :: CostCentre -> Bool -> Bool -> Code emitSetCCC cc tick push = do dflags <- getDynFlags - if dopt Opt_SccProfilingOn dflags + if gopt Opt_SccProfilingOn dflags then do tmp <- newTemp (bWord dflags) -- TODO FIXME NOW pushCostCentre tmp curCCS cc when tick $ stmtC (bumpSccCount dflags (CmmReg (CmmLocal tmp))) diff --git a/compiler/codeGen/CgTailCall.lhs b/compiler/codeGen/CgTailCall.lhs index 3e64e6007d..b78415fffa 100644 --- a/compiler/codeGen/CgTailCall.lhs +++ b/compiler/codeGen/CgTailCall.lhs @@ -197,7 +197,7 @@ performTailCall fun_info arg_amodes pending_assts -- Test if closure is a constructor maybeSwitchOnCons dflags enterClosure eob | EndOfBlockInfo _ (CaseAlts lbl _ _) <- eob, - not (dopt Opt_SccProfilingOn dflags) + not (gopt Opt_SccProfilingOn dflags) -- we can't shortcut when profiling is on, because we have -- to enter a closure to mark it as "used" for LDV profiling = do { is_constr <- newLabelC diff --git a/compiler/codeGen/CgTicky.hs b/compiler/codeGen/CgTicky.hs index 21837e787b..898d3f0786 100644 --- a/compiler/codeGen/CgTicky.hs +++ b/compiler/codeGen/CgTicky.hs @@ -308,7 +308,7 @@ tickyAllocHeap hp ifTicky :: Code -> Code ifTicky code = do dflags <- getDynFlags - if dopt Opt_Ticky dflags then code + if gopt Opt_Ticky dflags then code else nopC addToMemLbl :: Width -> CLabel -> Int -> CmmStmt diff --git a/compiler/codeGen/ClosureInfo.lhs b/compiler/codeGen/ClosureInfo.lhs index f2cbc21d27..7371ca56a2 100644 --- a/compiler/codeGen/ClosureInfo.lhs +++ b/compiler/codeGen/ClosureInfo.lhs @@ -579,7 +579,7 @@ nodeMustPointToIt _ (LFCon _) = True -- 27/11/92. nodeMustPointToIt dflags (LFThunk _ no_fvs updatable NonStandardThunk _) - = updatable || not no_fvs || dopt Opt_SccProfilingOn dflags + = updatable || not no_fvs || gopt Opt_SccProfilingOn dflags -- For the non-updatable (single-entry case): -- -- True if has fvs (in which case we need access to them, and we @@ -651,7 +651,7 @@ getCallMethod :: DynFlags -> CallMethod getCallMethod dflags _ _ lf_info _ - | nodeMustPointToIt dflags lf_info && dopt Opt_Parallel dflags + | nodeMustPointToIt dflags lf_info && gopt Opt_Parallel dflags = -- If we're parallel, then we must always enter via node. -- The reason is that the closure may have been -- fetched since we allocated it. @@ -666,7 +666,7 @@ getCallMethod dflags name caf (LFReEntrant _ arity _ _) n_args getCallMethod dflags _ _ (LFCon con) n_args -- when profiling, we must always enter a closure when we use it, so -- that the closure can be recorded as used for LDV profiling. - | dopt Opt_SccProfilingOn dflags + | gopt Opt_SccProfilingOn dflags = EnterIt | otherwise = ASSERT( n_args == 0 ) @@ -689,7 +689,7 @@ getCallMethod _dflags _name _caf (LFThunk _ _ _updatable _std_form_info is_fun) -- So the right thing to do is just to enter the thing -- Old version: --- | updatable || dopt Opt_Ticky dflags -- to catch double entry +-- | updatable || gopt Opt_Ticky dflags -- to catch double entry -- = EnterIt -- | otherwise -- Jump direct to code for single-entry thunks -- = JumpToIt (thunkEntryLabel name caf std_form_info updatable) diff --git a/compiler/codeGen/StgCmm.hs b/compiler/codeGen/StgCmm.hs index 67aae3f6c0..944f5aab76 100644 --- a/compiler/codeGen/StgCmm.hs +++ b/compiler/codeGen/StgCmm.hs @@ -262,7 +262,7 @@ cgDataCon data_con maybeExternaliseId :: DynFlags -> Id -> FCode Id maybeExternaliseId dflags id - | dopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs + | gopt Opt_SplitObjs dflags, -- Externalise the name for -split-objs isInternalName name = do { mod <- getModuleName ; returnFC (setIdName id (externalise mod)) } | otherwise = returnFC id diff --git a/compiler/codeGen/StgCmmBind.hs b/compiler/codeGen/StgCmmBind.hs index 5e46dcfd65..439a2aa67e 100644 --- a/compiler/codeGen/StgCmmBind.hs +++ b/compiler/codeGen/StgCmmBind.hs @@ -273,7 +273,7 @@ mkRhsClosure dflags bndr _cc _bi && all (isGcPtrRep . idPrimRep . stripNV) fvs && isUpdatable upd_flag && arity <= mAX_SPEC_AP_SIZE dflags - && not (dopt Opt_SccProfilingOn dflags) + && not (gopt Opt_SccProfilingOn dflags) -- not when profiling: we don't want to -- lose information about this particular -- thunk (e.g. its type) (#949) @@ -574,8 +574,8 @@ emitBlackHoleCode is_single_entry node = do -- Note the eager-blackholing check is here rather than in blackHoleOnEntry, -- because emitBlackHoleCode is called from CmmParse. - let eager_blackholing = not (dopt Opt_SccProfilingOn dflags) - && dopt Opt_EagerBlackHoling dflags + let eager_blackholing = not (gopt Opt_SccProfilingOn dflags) + && gopt Opt_EagerBlackHoling dflags -- Profiling needs slop filling (to support LDV -- profiling), so currently eager blackholing doesn't -- work with profiling. @@ -603,8 +603,8 @@ setupUpdate closure_info node body dflags <- getDynFlags let bh = blackHoleOnEntry closure_info && - not (dopt Opt_SccProfilingOn dflags) && - dopt Opt_EagerBlackHoling dflags + not (gopt Opt_SccProfilingOn dflags) && + gopt Opt_EagerBlackHoling dflags lbl | bh = mkBHUpdInfoLabel | otherwise = mkUpdInfoLabel diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs index f865c37ad8..e4c42d203d 100644 --- a/compiler/codeGen/StgCmmClosure.hs +++ b/compiler/codeGen/StgCmmClosure.hs @@ -400,7 +400,7 @@ nodeMustPointToIt _ (LFCon _) = True -- 27/11/92. nodeMustPointToIt dflags (LFThunk _ no_fvs updatable NonStandardThunk _) - = updatable || not no_fvs || dopt Opt_SccProfilingOn dflags + = updatable || not no_fvs || gopt Opt_SccProfilingOn dflags -- For the non-updatable (single-entry case): -- -- True if has fvs (in which case we need access to them, and we @@ -472,7 +472,7 @@ getCallMethod :: DynFlags -> CallMethod getCallMethod dflags _name _ lf_info _n_args - | nodeMustPointToIt dflags lf_info && dopt Opt_Parallel dflags + | nodeMustPointToIt dflags lf_info && gopt Opt_Parallel dflags = -- If we're parallel, then we must always enter via node. -- The reason is that the closure may have been -- fetched since we allocated it. @@ -496,7 +496,7 @@ getCallMethod dflags name caf (LFThunk _ _ updatable std_form_info is_fun) n_arg -- is the fast-entry code] -- Since is_fun is False, we are *definitely* looking at a data value - | updatable || dopt Opt_Ticky dflags -- to catch double entry + | updatable || gopt Opt_Ticky dflags -- to catch double entry {- OLD: || opt_SMP I decided to remove this, because in SMP mode it doesn't matter if we enter the same thunk multiple times, so the optimisation @@ -852,7 +852,7 @@ enterIdLabel dflags id c mkProfilingInfo :: DynFlags -> Id -> String -> ProfilingInfo mkProfilingInfo dflags id val_descr - | not (dopt Opt_SccProfilingOn dflags) = NoProfilingInfo + | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo | otherwise = ProfilingInfo ty_descr_w8 val_descr_w8 where ty_descr_w8 = stringToWord8s (getTyDescription (idType id)) @@ -899,7 +899,7 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con) - prof | not (dopt Opt_SccProfilingOn dflags) = NoProfilingInfo + prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo | otherwise = ProfilingInfo ty_descr val_descr ty_descr = stringToWord8s $ occNameString $ getOccName $ dataConTyCon data_con diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs index 8e775dec51..ddc6d91d80 100644 --- a/compiler/codeGen/StgCmmCon.hs +++ b/compiler/codeGen/StgCmmCon.hs @@ -181,7 +181,7 @@ because they don't support cross package data references well. buildDynCon' dflags platform binder _cc con [arg] | maybeIntLikeCon con - , platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags) + , platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags) , StgLitArg (MachInt val) <- arg , val <= fromIntegral (mAX_INTLIKE dflags) -- Comparisons at type Integer! , val >= fromIntegral (mIN_INTLIKE dflags) -- ...ditto... @@ -195,7 +195,7 @@ buildDynCon' dflags platform binder _cc con [arg] buildDynCon' dflags platform binder _cc con [arg] | maybeCharLikeCon con - , platformOS platform /= OSMinGW32 || not (dopt Opt_PIC dflags) + , platformOS platform /= OSMinGW32 || not (gopt Opt_PIC dflags) , StgLitArg (MachChar val) <- arg , let val_int = ord val :: Int , val_int <= mAX_CHARLIKE dflags diff --git a/compiler/codeGen/StgCmmForeign.hs b/compiler/codeGen/StgCmmForeign.hs index 1830f7b6d6..e7925667a8 100644 --- a/compiler/codeGen/StgCmmForeign.hs +++ b/compiler/codeGen/StgCmmForeign.hs @@ -276,7 +276,7 @@ saveThreadState dflags = mkStore (cmmOffset dflags (CmmLoad (cmmOffset dflags stgCurrentTSO (tso_stackobj dflags)) (bWord dflags)) (stack_SP dflags)) stgSp <*> closeNursery dflags -- and save the current cost centre stack in the TSO when profiling: - <*> if dopt Opt_SccProfilingOn dflags then + <*> if gopt Opt_SccProfilingOn dflags then mkStore (cmmOffset dflags stgCurrentTSO (tso_CCCS dflags)) curCCS else mkNop @@ -308,7 +308,7 @@ loadThreadState dflags tso stack = do (rESERVED_STACK_WORDS dflags)), openNursery dflags, -- and load the current cost centre stack from the TSO when profiling: - if dopt Opt_SccProfilingOn dflags then + if gopt Opt_SccProfilingOn dflags then storeCurCCS (CmmLoad (cmmOffset dflags (CmmReg (CmmLocal tso)) (tso_CCCS dflags)) (ccsType dflags)) else mkNop] diff --git a/compiler/codeGen/StgCmmHeap.hs b/compiler/codeGen/StgCmmHeap.hs index c133ab00d4..7393faac9f 100644 --- a/compiler/codeGen/StgCmmHeap.hs +++ b/compiler/codeGen/StgCmmHeap.hs @@ -584,7 +584,7 @@ do_checks mb_stk_hwm checkYield mb_alloc_lit do_gc = do emitAssign hpReg bump_hp emit =<< mkCmmIfThen hp_oflo (alloc_n <*> mkBranch gc_id) else do - when (not (dopt Opt_OmitYields dflags) && checkYield) $ do + when (not (gopt Opt_OmitYields dflags) && checkYield) $ do -- Yielding if HpLim == 0 let yielding = CmmMachOp (mo_wordEq dflags) [CmmReg (CmmGlobal HpLim), diff --git a/compiler/codeGen/StgCmmHpc.hs b/compiler/codeGen/StgCmmHpc.hs index 85f4c161ad..c8e65ad126 100644 --- a/compiler/codeGen/StgCmmHpc.hs +++ b/compiler/codeGen/StgCmmHpc.hs @@ -38,7 +38,7 @@ initHpc _ (NoHpcInfo {}) = return () initHpc this_mod (HpcInfo tickCount _hashNo) = do dflags <- getDynFlags - when (dopt Opt_Hpc dflags) $ + when (gopt Opt_Hpc dflags) $ do emitDataLits (mkHpcTicksLabel this_mod) [ (CmmInt 0 W64) | _ <- take tickCount [0 :: Int ..] diff --git a/compiler/codeGen/StgCmmLayout.hs b/compiler/codeGen/StgCmmLayout.hs index 4742332107..87793ab20f 100644 --- a/compiler/codeGen/StgCmmLayout.hs +++ b/compiler/codeGen/StgCmmLayout.hs @@ -291,7 +291,7 @@ just more arguments that we are passing on the stack (cml_args). slowArgs :: DynFlags -> [(ArgRep, Maybe CmmExpr)] -> [(ArgRep, Maybe CmmExpr)] slowArgs _ [] = [] slowArgs dflags args -- careful: reps contains voids (V), but args does not - | dopt Opt_SccProfilingOn dflags + | gopt Opt_SccProfilingOn dflags = save_cccs ++ this_pat ++ slowArgs dflags rest_args | otherwise = this_pat ++ slowArgs dflags rest_args where @@ -547,7 +547,7 @@ stdInfoTableSizeW dflags = size_fixed + size_prof where size_fixed = 2 -- layout, type - size_prof | dopt Opt_SccProfilingOn dflags = 2 + size_prof | gopt Opt_SccProfilingOn dflags = 2 | otherwise = 0 stdInfoTableSizeB :: DynFlags -> ByteOff diff --git a/compiler/codeGen/StgCmmPrim.hs b/compiler/codeGen/StgCmmPrim.hs index 4e7a48264a..72dd664698 100644 --- a/compiler/codeGen/StgCmmPrim.hs +++ b/compiler/codeGen/StgCmmPrim.hs @@ -240,7 +240,7 @@ emitPrimOp dflags [res] GetCCSOfOp [arg] = emitAssign (CmmLocal res) val where val - | dopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg) + | gopt Opt_SccProfilingOn dflags = costCentreFrom dflags (cmmUntag dflags arg) | otherwise = CmmLit (zeroCLit dflags) emitPrimOp _ [res] GetCurrentCCSOp [_dummy_arg] diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index 1b218462e1..3307604a87 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -133,7 +133,7 @@ saveCurrentCostCentre :: FCode (Maybe LocalReg) -- Returns Nothing if profiling is off saveCurrentCostCentre = do dflags <- getDynFlags - if not (dopt Opt_SccProfilingOn dflags) + if not (gopt Opt_SccProfilingOn dflags) then return Nothing else do local_cc <- newTemp (ccType dflags) emitAssign (CmmLocal local_cc) curCCS @@ -196,13 +196,13 @@ enterCostCentreFun ccs closure = ifProfiling :: FCode () -> FCode () ifProfiling code = do dflags <- getDynFlags - if dopt Opt_SccProfilingOn dflags + if gopt Opt_SccProfilingOn dflags then code else return () ifProfilingL :: DynFlags -> [a] -> [a] ifProfilingL dflags xs - | dopt Opt_SccProfilingOn dflags = xs + | gopt Opt_SccProfilingOn dflags = xs | otherwise = [] @@ -214,7 +214,7 @@ initCostCentres :: CollectedCCs -> FCode () -- Emit the declarations initCostCentres (local_CCs, ___extern_CCs, singleton_CCSs) = do dflags <- getDynFlags - when (dopt Opt_SccProfilingOn dflags) $ + when (gopt Opt_SccProfilingOn dflags) $ do mapM_ emitCostCentreDecl local_CCs mapM_ emitCostCentreStackDecl singleton_CCSs @@ -280,7 +280,7 @@ sizeof_ccs_words dflags emitSetCCC :: CostCentre -> Bool -> Bool -> FCode () emitSetCCC cc tick push = do dflags <- getDynFlags - if not (dopt Opt_SccProfilingOn dflags) + if not (gopt Opt_SccProfilingOn dflags) then return () else do tmp <- newTemp (ccsType dflags) -- TODO FIXME NOW pushCostCentre tmp curCCS cc diff --git a/compiler/codeGen/StgCmmTicky.hs b/compiler/codeGen/StgCmmTicky.hs index 01babb212f..ffa5168a63 100644 --- a/compiler/codeGen/StgCmmTicky.hs +++ b/compiler/codeGen/StgCmmTicky.hs @@ -332,7 +332,7 @@ tickyAllocHeap hp ifTicky :: FCode () -> FCode () ifTicky code = do dflags <- getDynFlags - if dopt Opt_Ticky dflags then code + if gopt Opt_Ticky dflags then code else return () -- All the ticky-ticky counters are declared "unsigned long" in C diff --git a/compiler/coreSyn/CoreArity.lhs b/compiler/coreSyn/CoreArity.lhs index d89b67b68b..fbb98c2174 100644 --- a/compiler/coreSyn/CoreArity.lhs +++ b/compiler/coreSyn/CoreArity.lhs @@ -34,7 +34,7 @@ import TyCon ( isRecursiveTyCon, isClassTyCon ) import Coercion import BasicTypes import Unique -import DynFlags ( DynFlags, GeneralFlag(..), dopt ) +import DynFlags ( DynFlags, GeneralFlag(..), gopt ) import Outputable import FastString import Pair @@ -486,7 +486,7 @@ exprEtaExpandArity dflags cheap_app e where env = AE { ae_bndrs = [] , ae_cheap_fn = mk_cheap_fn dflags cheap_app - , ae_ped_bot = dopt Opt_PedanticBottoms dflags } + , ae_ped_bot = gopt Opt_PedanticBottoms dflags } has_lam (Tick _ e) = has_lam e has_lam (Lam b e) = isId b || has_lam e @@ -499,7 +499,7 @@ getBotArity _ = Nothing mk_cheap_fn :: DynFlags -> CheapAppFun -> CheapFun mk_cheap_fn dflags cheap_app - | not (dopt Opt_DictsCheap dflags) + | not (gopt Opt_DictsCheap dflags) = \e _ -> exprIsCheap' cheap_app e | otherwise = \e mb_ty -> exprIsCheap' cheap_app e diff --git a/compiler/coreSyn/CoreUnfold.lhs b/compiler/coreSyn/CoreUnfold.lhs index 7ed5d2b475..b02d06a418 100644 --- a/compiler/coreSyn/CoreUnfold.lhs +++ b/compiler/coreSyn/CoreUnfold.lhs @@ -908,7 +908,7 @@ callSiteInline dflags id active_unfolding lone_variable arg_infos cont_info | active_unfolding -> tryUnfolding dflags id lone_variable arg_infos cont_info unf_template is_top is_wf is_exp uf_arity guidance - | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags + | gopt Opt_D_dump_inlinings dflags && gopt Opt_D_verbose_core2core dflags -> pprTrace "Inactive unfolding:" (ppr id) Nothing | otherwise -> Nothing NoUnfolding -> Nothing @@ -923,7 +923,7 @@ tryUnfolding dflags id lone_variable is_wf is_exp uf_arity guidance -- uf_arity will typically be equal to (idArity id), -- but may be less for InlineRules - | dopt Opt_D_dump_inlinings dflags && dopt Opt_D_verbose_core2core dflags + | gopt Opt_D_dump_inlinings dflags && gopt Opt_D_verbose_core2core dflags = pprTrace ("Considering inlining: " ++ showSDocDump dflags (ppr id)) (vcat [text "arg infos" <+> ppr arg_infos, text "uf arity" <+> ppr uf_arity, diff --git a/compiler/coreSyn/MkExternalCore.lhs b/compiler/coreSyn/MkExternalCore.lhs index 8844818bdc..4c1d435bc8 100644 --- a/compiler/coreSyn/MkExternalCore.lhs +++ b/compiler/coreSyn/MkExternalCore.lhs @@ -44,7 +44,7 @@ import System.IO emitExternalCore :: DynFlags -> CgGuts -> IO () emitExternalCore dflags cg_guts - | dopt Opt_EmitExternalCore dflags + | gopt Opt_EmitExternalCore dflags = (do handle <- openFile corename WriteMode hPutStrLn handle (show (mkExternalCore dflags cg_guts)) hClose handle) diff --git a/compiler/coreSyn/PprCore.lhs b/compiler/coreSyn/PprCore.lhs index bc3dc7a7f3..cdae3bd7c7 100644 --- a/compiler/coreSyn/PprCore.lhs +++ b/compiler/coreSyn/PprCore.lhs @@ -119,7 +119,7 @@ ppr_expr add_par (Cast expr co) ptext (sLit "`cast`") <+> pprCo co] where pprCo co = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressCoercions dflags + if gopt Opt_SuppressCoercions dflags then ptext (sLit "...") else parens $ sep [ppr co, dcolon <+> pprEqPred (coercionKind co)] @@ -157,7 +157,7 @@ ppr_expr add_par expr@(App {}) ppr_expr add_par (Case expr var ty [(con,args,rhs)]) = sdocWithDynFlags $ \dflags -> - if dopt Opt_PprCaseAsLet dflags + if gopt Opt_PprCaseAsLet dflags then add_par $ sep [sep [ ptext (sLit "let") <+> char '{' @@ -252,7 +252,7 @@ ppr_case_pat con args pprArg :: OutputableBndr a => Expr a -> SDoc pprArg (Type ty) = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressTypeApplications dflags + if gopt Opt_SuppressTypeApplications dflags then empty else ptext (sLit "@") <+> pprParendType ty pprArg (Coercion co) = ptext (sLit "@~") <+> pprParendCo co @@ -293,7 +293,7 @@ pprTypedLamBinder bind_site debug_on var | not debug_on && isDeadBinder var -> char '_' | not debug_on, CaseBind <- bind_site -> -- No parens, no kind info pprUntypedBinder var - | dopt Opt_SuppressTypeSignatures dflags -> -- Suppress the signature + | gopt Opt_SuppressTypeSignatures dflags -> -- Suppress the signature pprUntypedBinder var | isTyVar var -> parens (pprKindedTyVarBndr var) | otherwise -> @@ -311,7 +311,7 @@ pprTypedLetBinder binder case () of _ | isTyVar binder -> pprKindedTyVarBndr binder - | dopt Opt_SuppressTypeSignatures dflags -> pprIdBndr binder + | gopt Opt_SuppressTypeSignatures dflags -> pprIdBndr binder | otherwise -> hang (pprIdBndr binder) 2 (dcolon <+> pprType (idType binder)) pprKindedTyVarBndr :: TyVar -> SDoc @@ -327,7 +327,7 @@ pprIdBndr id = ppr id <+> pprIdBndrInfo (idInfo id) pprIdBndrInfo :: IdInfo -> SDoc pprIdBndrInfo info = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressIdInfo dflags + if gopt Opt_SuppressIdInfo dflags then empty else megaSeqIdInfo info `seq` doc -- The seq is useful for poking on black holes where @@ -358,7 +358,7 @@ pprIdBndrInfo info ppIdInfo :: Id -> IdInfo -> SDoc ppIdInfo id info = sdocWithDynFlags $ \dflags -> - if dopt Opt_SuppressIdInfo dflags + if gopt Opt_SuppressIdInfo dflags then empty else showAttributes diff --git a/compiler/deSugar/Coverage.lhs b/compiler/deSugar/Coverage.lhs index 551355cb62..bc9fcf3b7e 100644 --- a/compiler/deSugar/Coverage.lhs +++ b/compiler/deSugar/Coverage.lhs @@ -90,8 +90,8 @@ addTicksToBinds dflags mod mod_loc exports tyCons binds = , this_mod = mod , tickishType = case hscTarget dflags of HscInterpreted -> Breakpoints - _ | dopt Opt_Hpc dflags -> HpcTicks - | dopt Opt_SccProfilingOn dflags + _ | gopt Opt_Hpc dflags -> HpcTicks + | gopt Opt_SccProfilingOn dflags -> ProfNotes | otherwise -> error "addTicksToBinds: No way to annotate!" }) @@ -145,7 +145,7 @@ mkModBreaks dflags count entries = do writeMixEntries :: DynFlags -> Module -> Int -> [MixEntry_] -> FilePath -> IO Int writeMixEntries dflags mod count entries filename - | not (dopt Opt_Hpc dflags) = return 0 + | not (gopt Opt_Hpc dflags) = return 0 | otherwise = do let hpc_dir = hpcDir dflags @@ -183,7 +183,7 @@ data TickDensity mkDensity :: DynFlags -> TickDensity mkDensity dflags - | dopt Opt_Hpc dflags = TickForCoverage + | gopt Opt_Hpc dflags = TickForCoverage | HscInterpreted <- hscTarget dflags = TickForBreakPoints | ProfAutoAll <- profAuto dflags = TickAllFunctions | ProfAutoTop <- profAuto dflags = TickTopFunctions @@ -269,7 +269,7 @@ addTickLHsBind (L pos (funBind@(FunBind { fun_id = (L _ id) }))) = do || id `elemVarSet` inline_ids -- See Note [inline sccs] - if inline && dopt Opt_SccProfilingOn dflags then return (L pos funBind) else do + if inline && gopt Opt_SccProfilingOn dflags then return (L pos funBind) else do (fvs, (MatchGroup matches' ty)) <- getFreeVars $ @@ -1084,7 +1084,7 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = dflags = tte_dflags env - count = countEntries && dopt Opt_ProfCountEntries dflags + count = countEntries && gopt Opt_ProfCountEntries dflags tickish = case tickishType env of HpcTicks -> HpcTick (this_mod env) c diff --git a/compiler/deSugar/Desugar.lhs b/compiler/deSugar/Desugar.lhs index ee606808d9..9a73893b44 100644 --- a/compiler/deSugar/Desugar.lhs +++ b/compiler/deSugar/Desugar.lhs @@ -108,9 +108,9 @@ deSugar hsc_env Just ([], nilOL, [], [], NoStubs, hpcInfo, emptyModBreaks)) _ -> do - let want_ticks = dopt Opt_Hpc dflags + let want_ticks = gopt Opt_Hpc dflags || target == HscInterpreted - || (dopt Opt_SccProfilingOn dflags + || (gopt Opt_SccProfilingOn dflags && case profAuto dflags of NoProfAuto -> False _ -> True) @@ -129,7 +129,7 @@ deSugar hsc_env ; ds_rules <- mapMaybeM dsRule rules ; ds_vects <- mapM dsVect vects ; let hpc_init - | dopt Opt_Hpc dflags = hpcInitCode mod ds_hpc_info + | gopt Opt_Hpc dflags = hpcInitCode mod ds_hpc_info | otherwise = empty ; return ( ds_ev_binds , foreign_prs `appOL` core_prs `appOL` spec_prs @@ -357,7 +357,7 @@ dsRule (L loc (HsRule name act vars lhs _tv_lhs rhs _fv_rhs)) = putSrcSpanDs loc $ do { let bndrs' = [var | RuleBndr (L _ var) <- vars] - ; lhs' <- unsetDOptM Opt_EnableRewriteRules $ + ; lhs' <- unsetGOptM Opt_EnableRewriteRules $ unsetWOptM Opt_WarnIdentities $ dsLExpr lhs -- Note [Desugaring RULE left hand sides] diff --git a/compiler/deSugar/DsExpr.lhs b/compiler/deSugar/DsExpr.lhs index c4ee50f54d..fb579ab672 100644 --- a/compiler/deSugar/DsExpr.lhs +++ b/compiler/deSugar/DsExpr.lhs @@ -297,7 +297,7 @@ dsExpr (ExplicitTuple tup_args boxity) dsExpr (HsSCC cc expr@(L loc _)) = do mod_name <- getModuleDs - count <- doptM Opt_ProfCountEntries + count <- goptM Opt_ProfCountEntries uniq <- newUnique Tick (ProfNote (mkUserCC cc mod_name loc uniq) count True) <$> dsLExpr expr @@ -687,8 +687,8 @@ dsExplicitList elt_ty xs = do { dflags <- getDynFlags ; xs' <- mapM dsLExpr xs ; let (dynamic_prefix, static_suffix) = spanTail is_static xs' - ; if dopt Opt_SimpleListLiterals dflags -- -fsimple-list-literals - || not (dopt Opt_EnableRewriteRules dflags) -- Rewrite rules off + ; if gopt Opt_SimpleListLiterals dflags -- -fsimple-list-literals + || not (gopt Opt_EnableRewriteRules dflags) -- Rewrite rules off -- Don't generate a build if there are no rules to eliminate it! -- See Note [Desugaring RULE left hand sides] in Desugar || null dynamic_prefix -- Avoid build (\c n. foldr c n xs)! diff --git a/compiler/deSugar/DsListComp.lhs b/compiler/deSugar/DsListComp.lhs index b590a92057..1b81e1a248 100644 --- a/compiler/deSugar/DsListComp.lhs +++ b/compiler/deSugar/DsListComp.lhs @@ -53,7 +53,7 @@ dsListComp lquals res_ty = do [elt_ty] -> elt_ty _ -> pprPanic "dsListComp" (ppr res_ty $$ ppr lquals) - if not (dopt Opt_EnableRewriteRules dflags) || dopt Opt_IgnoreInterfacePragmas dflags + if not (gopt Opt_EnableRewriteRules dflags) || gopt Opt_IgnoreInterfacePragmas dflags -- Either rules are switched off, or we are ignoring what there are; -- Either way foldr/build won't happen, so use the more efficient -- Wadler-style desugaring diff --git a/compiler/deSugar/DsMonad.lhs b/compiler/deSugar/DsMonad.lhs index 46c7bf269b..6ed0f64a06 100644 --- a/compiler/deSugar/DsMonad.lhs +++ b/compiler/deSugar/DsMonad.lhs @@ -9,7 +9,7 @@ module DsMonad ( DsM, mapM, mapAndUnzipM, initDs, initDsTc, fixDs, - foldlM, foldrM, ifDOptM, unsetDOptM, unsetWOptM, + foldlM, foldrM, whenGOptM, unsetGOptM, unsetWOptM, Applicative(..),(<$>), newLocalName, @@ -220,7 +220,7 @@ initDs hsc_env mod rdr_env type_env thing_inside -- * 'Data.Array.Parallel.Prim' iff '-fvectorise' specified. loadDAP thing_inside = do { dapEnv <- loadOneModule dATA_ARRAY_PARALLEL_NAME checkLoadDAP paErr - ; dappEnv <- loadOneModule dATA_ARRAY_PARALLEL_PRIM_NAME (doptM Opt_Vectorise) veErr + ; dappEnv <- loadOneModule dATA_ARRAY_PARALLEL_PRIM_NAME (goptM Opt_Vectorise) veErr ; updGblEnv (\env -> env {ds_dph_env = dapEnv `plusOccEnv` dappEnv }) thing_inside } where diff --git a/compiler/deSugar/Match.lhs b/compiler/deSugar/Match.lhs index c650e103a8..6f9c45584f 100644 --- a/compiler/deSugar/Match.lhs +++ b/compiler/deSugar/Match.lhs @@ -301,7 +301,7 @@ match vars@(v:_) ty eqns ; let grouped = groupEquations dflags tidy_eqns -- print the view patterns that are commoned up to help debug - ; ifDOptM Opt_D_dump_view_pattern_commoning (debug grouped) + ; whenGOptM Opt_D_dump_view_pattern_commoning (debug grouped) ; match_results <- mapM match_group grouped ; return (adjustMatchResult (foldr1 (.) aux_binds) $ diff --git a/compiler/ghci/Debugger.hs b/compiler/ghci/Debugger.hs index 9d10711dbc..55c18dec1e 100644 --- a/compiler/ghci/Debugger.hs +++ b/compiler/ghci/Debugger.hs @@ -147,7 +147,7 @@ bindSuspensions t = do showTerm :: GhcMonad m => Term -> m SDoc showTerm term = do dflags <- GHC.getSessionDynFlags - if dopt Opt_PrintEvldWithShow dflags + if gopt Opt_PrintEvldWithShow dflags then cPprTerm (liftM2 (++) (\_y->[cPprShowable]) cPprTermBase) term else cPprTerm cPprTermBase term where @@ -205,8 +205,8 @@ newGrimName userName = do pprTypeAndContents :: GhcMonad m => Id -> m SDoc pprTypeAndContents id = do dflags <- GHC.getSessionDynFlags - let pefas = dopt Opt_PrintExplicitForalls dflags - pcontents = dopt Opt_PrintBindContents dflags + let pefas = gopt Opt_PrintExplicitForalls dflags + pcontents = gopt Opt_PrintBindContents dflags pprdId = (pprTyThing pefas . AnId) id if pcontents then do @@ -227,4 +227,4 @@ pprTypeAndContents id = do traceOptIf :: GhcMonad m => GeneralFlag -> SDoc -> m () traceOptIf flag doc = do dflags <- GHC.getSessionDynFlags - when (dopt flag dflags) $ liftIO $ printInfoForUser dflags alwaysQualify doc + when (gopt flag dflags) $ liftIO $ printInfoForUser dflags alwaysQualify doc diff --git a/compiler/ghci/Linker.lhs b/compiler/ghci/Linker.lhs index f4a5ca5050..c3d5274120 100644 --- a/compiler/ghci/Linker.lhs +++ b/compiler/ghci/Linker.lhs @@ -814,7 +814,7 @@ dynLoadObjs dflags objs = do let -- When running TH for a non-dynamic way, we still need to make -- -l flags to link against the dynamic libraries, so we turn -- Opt_Static off - dflags1 = dopt_unset dflags Opt_Static + dflags1 = gopt_unset dflags Opt_Static dflags2 = dflags1 { -- We don't want to link the ldInputs in; we'll -- be calling dynLoadObjs with any objects that diff --git a/compiler/iface/FlagChecker.hs b/compiler/iface/FlagChecker.hs index e568d556f2..ca8cf28a09 100644 --- a/compiler/iface/FlagChecker.hs +++ b/compiler/iface/FlagChecker.hs @@ -43,7 +43,7 @@ fingerprintDynFlags dflags@DynFlags{..} this_mod nameio = paths = [ hcSuf ] -- -fprof-auto etc. - prof = if dopt Opt_SccProfilingOn dflags then fromEnum profAuto else 0 + prof = if gopt Opt_SccProfilingOn dflags then fromEnum profAuto else 0 in -- pprTrace "flags" (ppr (mainis, safeHs, lang, cpp, paths)) $ computeFingerprint nameio (mainis, safeHs, lang, cpp, paths, prof) diff --git a/compiler/iface/LoadIface.lhs b/compiler/iface/LoadIface.lhs index 6c5e7d38d9..f978577b23 100644 --- a/compiler/iface/LoadIface.lhs +++ b/compiler/iface/LoadIface.lhs @@ -247,7 +247,7 @@ loadInterface doc_str mod from -- If we do loadExport first the wrong info gets into the cache (unless we -- explicitly tag each export which seems a bit of a bore) - ; ignore_prags <- doptM Opt_IgnoreInterfacePragmas + ; ignore_prags <- goptM Opt_IgnoreInterfacePragmas ; new_eps_decls <- loadDecls ignore_prags (mi_decls iface) ; new_eps_insts <- mapM tcIfaceInst (mi_insts iface) ; new_eps_fam_insts <- mapM tcIfaceFamInst (mi_fam_insts iface) diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs index c63a2e5c1d..bf8edc4777 100644 --- a/compiler/iface/MkIface.lhs +++ b/compiler/iface/MkIface.lhs @@ -1131,7 +1131,7 @@ check_old_iface hsc_env mod_summary src_modified maybe_iface return $ Just iface src_changed - | dopt Opt_ForceRecomp (hsc_dflags hsc_env) = True + | gopt Opt_ForceRecomp (hsc_dflags hsc_env) = True | SourceModified <- src_modified = True | otherwise = False in do diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs index 19b5cfe405..37965185cf 100644 --- a/compiler/iface/TcIface.lhs +++ b/compiler/iface/TcIface.lhs @@ -256,7 +256,7 @@ typecheckIface iface -- information that we shouldn't. From a versioning point of view -- It's not actually *wrong* to do so, but in fact GHCi is unable -- to handle unboxed tuples, so it must not see unfoldings. - ignore_prags <- doptM Opt_IgnoreInterfacePragmas + ignore_prags <- goptM Opt_IgnoreInterfacePragmas -- Typecheck the decls. This is done lazily, so that the knot-tying -- within this single module work out right. In the If monad there is @@ -1272,7 +1272,7 @@ tcPragExpr name expr core_expr' <- tcIfaceExpr expr -- Check for type consistency in the unfolding - ifDOptM Opt_DoCoreLinting $ do + whenGOptM Opt_DoCoreLinting $ do in_scope <- get_in_scope case lintUnfolding noSrcLoc in_scope core_expr' of Nothing -> return () diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 207a237b7e..30786b6895 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -1261,7 +1261,7 @@ funPrologue dflags = concat $ map getReg $ activeStgRegs platform funEpilogue :: LlvmEnv -> Maybe [GlobalReg] -> UniqSM ([LlvmVar], LlvmStatements) -- Have information and liveness optimisation is enabled -funEpilogue env (Just live) | dopt Opt_RegLiveness dflags = do +funEpilogue env (Just live) | gopt Opt_RegLiveness dflags = do loads <- mapM loadExpr (activeStgRegs platform) let (vars, stmts) = unzip loads return (vars, concatOL stmts) diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index fc20ef4988..beaf7c8eec 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -56,7 +56,7 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps cmm_stream do { -- Lint each CmmGroup as it goes past ; let linted_cmm_stream = - if dopt Opt_DoCmmLinting dflags + if gopt Opt_DoCmmLinting dflags then Stream.mapM do_lint cmm_stream else cmm_stream diff --git a/compiler/main/DriverMkDepend.hs b/compiler/main/DriverMkDepend.hs index 953b2c4568..fecf28362a 100644 --- a/compiler/main/DriverMkDepend.hs +++ b/compiler/main/DriverMkDepend.hs @@ -335,7 +335,7 @@ endMkDependHS dflags dumpModCycles :: DynFlags -> [ModSummary] -> IO () dumpModCycles dflags mod_summaries - | not (dopt Opt_D_dump_mod_cycles dflags) + | not (gopt Opt_D_dump_mod_cycles dflags) = return () | null cycles diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs index d7b80e62fb..2326e57403 100644 --- a/compiler/main/DriverPipeline.hs +++ b/compiler/main/DriverPipeline.hs @@ -155,7 +155,7 @@ compile' (nothingCompiler, interactiveCompiler, batchCompiler) let hsc_env' = hsc_env { hsc_dflags = dflags' } -- -fforce-recomp should also work with --make - let force_recomp = dopt Opt_ForceRecomp dflags + let force_recomp = gopt Opt_ForceRecomp dflags source_modified | force_recomp || isNothing maybe_old_linkable = SourceModified | otherwise = source_modified0 @@ -320,7 +320,7 @@ link' dflags batch_attempt_linking hpt linking_needed <- linkingNeeded dflags linkables pkg_deps - if not (dopt Opt_ForceRecomp dflags) && not linking_needed + if not (gopt Opt_ForceRecomp dflags) && not linking_needed then do debugTraceMsg dflags 2 (text exe_file <+> ptext (sLit "is up to date, linking not required.")) return Succeeded else do @@ -410,7 +410,7 @@ ghcLinkInfoSectionName = ".debug-ghc-link-info" findHSLib :: DynFlags -> [String] -> String -> IO (Maybe FilePath) findHSLib dflags dirs lib = do - let batch_lib_file = if dopt Opt_Static dflags + let batch_lib_file = if gopt Opt_Static dflags then "lib" ++ lib <.> "a" else mkSOName (targetPlatform dflags) lib found <- filterM doesFileExist (map (</> batch_lib_file) dirs) @@ -434,7 +434,7 @@ compileFile hsc_env stop_phase (src, mb_phase) = do let dflags = hsc_dflags hsc_env - split = dopt Opt_SplitObjs dflags + split = gopt Opt_SplitObjs dflags mb_o_file = outputFile dflags ghc_link = ghcLink dflags -- Set by -c or -no-link @@ -675,9 +675,9 @@ getOutputFilename stop_phase output basename hcsuf = hcSuf dflags odir = objectDir dflags osuf = objectSuf dflags - keep_hc = dopt Opt_KeepHcFiles dflags - keep_s = dopt Opt_KeepSFiles dflags - keep_bc = dopt Opt_KeepLlvmFiles dflags + keep_hc = gopt Opt_KeepHcFiles dflags + keep_s = gopt Opt_KeepSFiles dflags + keep_bc = gopt Opt_KeepLlvmFiles dflags myPhaseInputExt HCc = hcsuf myPhaseInputExt MergeStub = osuf @@ -778,7 +778,7 @@ runPhase (Cpp sf) input_fn dflags0 if not (xopt Opt_Cpp dflags1) then do -- we have to be careful to emit warnings only once. - unless (dopt Opt_Pp dflags1) $ io $ handleFlagWarnings dflags1 warns + unless (gopt Opt_Pp dflags1) $ io $ handleFlagWarnings dflags1 warns -- no need to preprocess CPP, just pass input file along -- to the next phase of the pipeline. @@ -792,7 +792,7 @@ runPhase (Cpp sf) input_fn dflags0 (dflags2, unhandled_flags, warns) <- io $ parseDynamicFilePragma dflags0 src_opts io $ checkProcessArgsResult dflags2 unhandled_flags - unless (dopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns + unless (gopt Opt_Pp dflags2) $ io $ handleFlagWarnings dflags2 warns -- the HsPp pass below will emit warnings setDynFlags dflags2 @@ -804,7 +804,7 @@ runPhase (Cpp sf) input_fn dflags0 runPhase (HsPp sf) input_fn dflags = do - if not (dopt Opt_Pp dflags) then + if not (gopt Opt_Pp dflags) then -- no need to preprocess, just pass input file along -- to the next phase of the pipeline. return (Hsc sf, input_fn) @@ -1054,7 +1054,7 @@ runPhase cc_phase input_fn dflags _ -> return [] - let split_objs = dopt Opt_SplitObjs dflags + let split_objs = gopt Opt_SplitObjs dflags split_opt | hcc && split_objs = [ "-DUSE_SPLIT_MARKERS" ] | otherwise = [ ] @@ -1072,7 +1072,7 @@ runPhase cc_phase input_fn dflags -- By default, we turn this off with -ffloat-store unless -- the user specified -fexcess-precision. (if platformArch platform == ArchX86 && - not (dopt Opt_ExcessPrecision dflags) + not (gopt Opt_ExcessPrecision dflags) then [ "-ffloat-store" ] else []) ++ @@ -1324,7 +1324,7 @@ runPhase LlvmOpt input_fn dflags then [SysTools.Option (llvmOpts !! opt_lvl)] else [] tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier - | dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" + | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" | otherwise = "--enable-tbaa=false" @@ -1353,17 +1353,17 @@ runPhase LlvmLlc input_fn dflags let lc_opts = getOpts dflags opt_lc opt_lvl = max 0 (min 2 $ optLevel dflags) - rmodel | dopt Opt_PIC dflags = "pic" - | not (dopt Opt_Static dflags) = "dynamic-no-pic" + rmodel | gopt Opt_PIC dflags = "pic" + | not (gopt Opt_Static dflags) = "dynamic-no-pic" | otherwise = "static" tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier - | dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" + | gopt Opt_LlvmTBAA dflags = "--enable-tbaa=true" | otherwise = "--enable-tbaa=false" -- hidden debugging flag '-dno-llvm-mangler' to skip mangling - let next_phase = case dopt Opt_NoLlvmMangler dflags of + let next_phase = case gopt Opt_NoLlvmMangler dflags of False -> LlvmMangle - True | dopt Opt_SplitObjs dflags -> Splitter + True | gopt Opt_SplitObjs dflags -> Splitter True -> As output_fn <- phaseOutputFilename next_phase @@ -1407,7 +1407,7 @@ runPhase LlvmLlc input_fn dflags runPhase LlvmMangle input_fn dflags = do - let next_phase = if dopt Opt_SplitObjs dflags then Splitter else As + let next_phase = if gopt Opt_SplitObjs dflags then Splitter else As output_fn <- phaseOutputFilename next_phase io $ llvmFixupAsm dflags input_fn output_fn return (next_phase, output_fn) @@ -1449,7 +1449,7 @@ maybeMergeStub runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool runPhase_MoveBinary dflags input_fn - | WayPar `elem` ways dflags && not (dopt Opt_Static dflags) = + | WayPar `elem` ways dflags && not (gopt Opt_Static dflags) = panic ("Don't know how to combine PVM wrapper and dynamic wrapper") | WayPar `elem` ways dflags = do let sysMan = pgm_sysman dflags @@ -1490,7 +1490,7 @@ mkExtraObj dflags extn xs -- mkExtraObjToLinkIntoBinary :: DynFlags -> IO FilePath mkExtraObjToLinkIntoBinary dflags = do - when (dopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do + when (gopt Opt_NoHsMain dflags && haveRtsOptsFlags dflags) $ do log_action dflags dflags SevInfo noSrcSpan defaultUserStyle (text "Warning: -rtsopts and -with-rtsopts have no effect with -no-hs-main." $$ text " Call hs_init_ghc() from your main() function to set these options.") @@ -1499,7 +1499,7 @@ mkExtraObjToLinkIntoBinary dflags = do where main - | dopt Opt_NoHsMain dflags = empty + | gopt Opt_NoHsMain dflags = empty | otherwise = vcat [ ptext (sLit "#include \"Rts.h\""), ptext (sLit "extern StgClosure ZCMain_main_closure;"), @@ -1564,7 +1564,7 @@ getLinkInfo dflags dep_packages = do pkg_frameworks, rtsOpts dflags, rtsOptsEnabled dflags, - dopt Opt_NoHsMain dflags, + gopt Opt_NoHsMain dflags, extra_ld_inputs, getOpts dflags opt_l) -- @@ -1673,12 +1673,12 @@ linkBinary dflags o_files dep_packages = do get_pkg_lib_path_opts l | osElfTarget (platformOS platform) && dynLibLoader dflags == SystemDependent && - not (dopt Opt_Static dflags) - = let libpath = if dopt Opt_RelativeDynlibPaths dflags + not (gopt Opt_Static dflags) + = let libpath = if gopt Opt_RelativeDynlibPaths dflags then "$ORIGIN" </> (l `makeRelativeTo` full_output_fn) else l - rpath = if dopt Opt_RPath dflags + rpath = if gopt Opt_RPath dflags then ["-Wl,-rpath", "-Wl," ++ libpath] else [] in ["-L" ++ l, "-Wl,-rpath-link", "-Wl," ++ l] ++ rpath @@ -1835,7 +1835,7 @@ maybeCreateManifest -> IO [FilePath] -- extra objects to embed, maybe maybeCreateManifest dflags exe_filename | platformOS (targetPlatform dflags) == OSMinGW32 && - dopt Opt_GenManifest dflags + gopt Opt_GenManifest dflags = do let manifest_filename = exe_filename <.> "manifest" writeFile manifest_filename $ @@ -1858,7 +1858,7 @@ maybeCreateManifest dflags exe_filename -- foo.exe.manifest. However, for extra robustness, and so that -- we can move the binary around, we can embed the manifest in -- the binary itself using windres: - if not (dopt Opt_EmbedManifest dflags) then return [] else do + if not (gopt Opt_EmbedManifest dflags) then return [] else do rc_filename <- newTempName dflags "rc" rc_obj_filename <- newTempName dflags (objectSuf dflags) @@ -1994,7 +1994,7 @@ hscPostBackendPhase _ HsBootFile _ = StopLn hscPostBackendPhase dflags _ hsc_lang = case hsc_lang of HscC -> HCc - HscAsm | dopt Opt_SplitObjs dflags -> Splitter + HscAsm | gopt Opt_SplitObjs dflags -> Splitter | otherwise -> As HscLlvm -> LlvmOpt HscNothing -> StopLn diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 0a8c8c6719..bcc6358a76 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -21,9 +21,9 @@ module DynFlags ( FatalMessager, LogAction, FlushOut(..), FlushErr(..), ProfAuto(..), glasgowExtsFlags, - dopt, - dopt_set, - dopt_unset, + gopt, + gopt_set, + gopt_unset, wopt, wopt_set, wopt_unset, @@ -1355,16 +1355,16 @@ languageExtensions (Just Haskell2010) Opt_RelaxedPolyRec] -- | Test whether a 'GeneralFlag' is set -dopt :: GeneralFlag -> DynFlags -> Bool -dopt f dflags = fromEnum f `IntSet.member` flags dflags +gopt :: GeneralFlag -> DynFlags -> Bool +gopt f dflags = fromEnum f `IntSet.member` flags dflags -- | Set a 'GeneralFlag' -dopt_set :: DynFlags -> GeneralFlag -> DynFlags -dopt_set dfs f = dfs{ flags = IntSet.insert (fromEnum f) (flags dfs) } +gopt_set :: DynFlags -> GeneralFlag -> DynFlags +gopt_set dfs f = dfs{ flags = IntSet.insert (fromEnum f) (flags dfs) } -- | Unset a 'GeneralFlag' -dopt_unset :: DynFlags -> GeneralFlag -> DynFlags -dopt_unset dfs f = dfs{ flags = IntSet.delete (fromEnum f) (flags dfs) } +gopt_unset :: DynFlags -> GeneralFlag -> DynFlags +gopt_unset dfs f = dfs{ flags = IntSet.delete (fromEnum f) (flags dfs) } -- | Test whether a 'WarningFlag' is set wopt :: WarningFlag -> DynFlags -> Bool @@ -1413,7 +1413,7 @@ dynFlagDependencies = pluginModNames -- | Is the -fpackage-trust mode on packageTrustOn :: DynFlags -> Bool -packageTrustOn = dopt Opt_PackageTrust +packageTrustOn = gopt Opt_PackageTrust -- | Is Safe Haskell on in some way (including inference mode) safeHaskellOn :: DynFlags -> Bool @@ -1604,11 +1604,11 @@ updOptLevel n dfs = dfs2{ optLevel = final_n } where final_n = max 0 (min 2 n) -- Clamp to 0 <= n <= 2 - dfs1 = foldr (flip dopt_unset) dfs remove_dopts - dfs2 = foldr (flip dopt_set) dfs1 extra_dopts + dfs1 = foldr (flip gopt_unset) dfs remove_gopts + dfs2 = foldr (flip gopt_set) dfs1 extra_gopts - extra_dopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ] - remove_dopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ] + extra_gopts = [ f | (ns,f) <- optLevelFlags, final_n `elem` ns ] + remove_gopts = [ f | (ns,f) <- optLevelFlags, final_n `notElem` ns ] -- ----------------------------------------------------------------------------- -- StgToDo: abstraction of stg-to-stg passes to run. @@ -1623,7 +1623,7 @@ getStgToDo :: DynFlags -> [StgToDo] getStgToDo dflags = todo2 where - stg_stats = dopt Opt_StgStats dflags + stg_stats = gopt Opt_StgStats dflags todo1 = if stg_stats then [D_stg_stats] else [] @@ -1728,7 +1728,7 @@ safeFlagCheck cmdl dflags = -- throw error if -fpackage-trust by itself with no safe haskell flag False | not cmdl && packageTrustOn dflags - -> (dopt_unset dflags' Opt_PackageTrust, + -> (gopt_unset dflags' Opt_PackageTrust, [L (pkgTrustOnLoc dflags') $ "-fpackage-trust ignored;" ++ " must be specified with a Safe Haskell flag"] @@ -2823,8 +2823,8 @@ removeWay w = upd (\dfs -> dfs { ways = filter (w /=) (ways dfs) }) -------------------------- setGeneralFlag, unSetGeneralFlag :: GeneralFlag -> DynP () -setGeneralFlag f = upd (\dfs -> dopt_set dfs f) -unSetGeneralFlag f = upd (\dfs -> dopt_unset dfs f) +setGeneralFlag f = upd (\dfs -> gopt_set dfs f) +unSetGeneralFlag f = upd (\dfs -> gopt_unset dfs f) -------------------------- setWarningFlag, unSetWarningFlag :: WarningFlag -> DynP () @@ -3115,10 +3115,10 @@ picCCOpts dflags -- Don't generate "common" symbols - these are unwanted -- in dynamic libraries. - | dopt Opt_PIC dflags -> ["-fno-common", "-U __PIC__", "-D__PIC__"] + | gopt Opt_PIC dflags -> ["-fno-common", "-U __PIC__", "-D__PIC__"] | otherwise -> ["-mdynamic-no-pic"] OSMinGW32 -- no -fPIC for Windows - | dopt Opt_PIC dflags -> ["-U __PIC__", "-D__PIC__"] + | gopt Opt_PIC dflags -> ["-U __PIC__", "-D__PIC__"] | otherwise -> [] _ -- we need -fPIC for C files when we are compiling with -dynamic, @@ -3126,13 +3126,13 @@ picCCOpts dflags -- correctly. They need to reference data in the Haskell -- objects, but can't without -fPIC. See -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode - | dopt Opt_PIC dflags || not (dopt Opt_Static dflags) -> + | gopt Opt_PIC dflags || not (gopt Opt_Static dflags) -> ["-fPIC", "-U __PIC__", "-D__PIC__"] | otherwise -> [] picPOpts :: DynFlags -> [String] picPOpts dflags - | dopt Opt_PIC dflags = ["-U __PIC__", "-D__PIC__"] + | gopt Opt_PIC dflags = ["-U __PIC__", "-D__PIC__"] | otherwise = [] -- ----------------------------------------------------------------------------- @@ -3232,7 +3232,7 @@ makeDynFlagsConsistent dflags in loop dflags' warn | hscTarget dflags == HscLlvm && not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) && - (not (dopt Opt_Static dflags) || dopt Opt_PIC dflags) + (not (gopt Opt_Static dflags) || gopt Opt_PIC dflags) = if cGhcWithNativeCodeGen == "YES" then let dflags' = dflags { hscTarget = HscAsm } warn = "Using native code generator rather than LLVM, as LLVM is incompatible with -fPIC and -dynamic on this platform" @@ -3240,8 +3240,8 @@ makeDynFlagsConsistent dflags else ghcError $ CmdLineError "Can't use -fPIC or -dynamic on this platform" | os == OSDarwin && arch == ArchX86_64 && - not (dopt Opt_PIC dflags) - = loop (dopt_set dflags Opt_PIC) + not (gopt Opt_PIC dflags) + = loop (gopt_set dflags Opt_PIC) "Enabling -fPIC as it is always on for this platform" | otherwise = (dflags, []) where loc = mkGeneralSrcSpan (fsLit "when making flags consistent") diff --git a/compiler/main/ErrUtils.lhs b/compiler/main/ErrUtils.lhs index 1404782939..b13cded064 100644 --- a/compiler/main/ErrUtils.lhs +++ b/compiler/main/ErrUtils.lhs @@ -93,7 +93,7 @@ mkLocMessage :: Severity -> SrcSpan -> MsgDoc -> MsgDoc -- would look strange. Better to say explicitly "<no location info>". mkLocMessage severity locn msg = sdocWithDynFlags $ \dflags -> - let locn' = if dopt Opt_ErrorSpans dflags + let locn' = if gopt Opt_ErrorSpans dflags then ppr locn else ppr (srcSpanStart locn) in hang (locn' <> colon <+> sev_info) 4 msg @@ -194,7 +194,7 @@ doIfSet flag action | flag = action | otherwise = return () doIfSet_dyn :: DynFlags -> GeneralFlag -> IO () -> IO() -doIfSet_dyn dflags flag action | dopt flag dflags = action +doIfSet_dyn dflags flag action | gopt flag dflags = action | otherwise = return () -- ----------------------------------------------------------------------------- @@ -207,7 +207,7 @@ dumpIfSet dflags flag hdr doc dumpIfSet_dyn :: DynFlags -> GeneralFlag -> String -> SDoc -> IO () dumpIfSet_dyn dflags flag hdr doc - | dopt flag dflags || verbosity dflags >= 4 + | gopt flag dflags || verbosity dflags >= 4 = dumpSDoc dflags flag hdr doc | otherwise = return () @@ -264,7 +264,7 @@ dumpSDoc dflags flag hdr doc chooseDumpFile :: DynFlags -> GeneralFlag -> Maybe String chooseDumpFile dflags flag - | dopt Opt_DumpToFile dflags + | gopt Opt_DumpToFile dflags , Just prefix <- getPrefix = Just $ setDir (prefix ++ (beautifyDumpName flag)) diff --git a/compiler/main/Finder.lhs b/compiler/main/Finder.lhs index 1417dad061..f674b19183 100644 --- a/compiler/main/Finder.lhs +++ b/compiler/main/Finder.lhs @@ -612,7 +612,7 @@ cantFindErr cannot_find _ dflags mod_name find_result ptext (sLit "It is a member of the hidden package") <+> quotes (ppr pkg) <> dot $$ cabal_pkg_hidden_hint pkg cabal_pkg_hidden_hint pkg - | dopt Opt_BuildingCabalPackage dflags + | gopt Opt_BuildingCabalPackage dflags = case simpleParse (packageIdString pkg) of Just pid -> ptext (sLit "Perhaps you need to add") <+> diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index d41d9c9b78..2af8c6f608 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -22,7 +22,7 @@ module GHC ( needsTemplateHaskell, -- * Flags and settings - DynFlags(..), GeneralFlag(..), Severity(..), HscTarget(..), dopt, + DynFlags(..), GeneralFlag(..), Severity(..), HscTarget(..), gopt, GhcMode(..), GhcLink(..), defaultObjectTarget, parseDynamicFlags, getSessionDynFlags, setSessionDynFlags, diff --git a/compiler/main/GhcMake.hs b/compiler/main/GhcMake.hs index 6dd27029f1..62ac63fc1d 100644 --- a/compiler/main/GhcMake.hs +++ b/compiler/main/GhcMake.hs @@ -283,7 +283,7 @@ load how_much = do -- that main() is going to come from somewhere else. -- let ofile = outputFile dflags - let no_hs_main = dopt Opt_NoHsMain dflags + let no_hs_main = gopt Opt_NoHsMain dflags let main_mod = mainModIs dflags a_root_is_Main = any ((==main_mod).ms_mod) mod_graph @@ -562,7 +562,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs && all bco_ok scc object_ok ms - | dopt Opt_ForceRecomp (ms_hspp_opts ms) = False + | gopt Opt_ForceRecomp (ms_hspp_opts ms) = False | Just t <- ms_obj_date ms = t >= ms_hs_date ms && same_as_prev t | otherwise = False @@ -582,7 +582,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs -- a problem. bco_ok ms - | dopt Opt_ForceRecomp (ms_hspp_opts ms) = False + | gopt Opt_ForceRecomp (ms_hspp_opts ms) = False | otherwise = case lookupUFM hpt (ms_mod_name ms) of Just hmi | Just l <- hm_linkable hmi -> not (isObjectLinkable l) && @@ -1414,7 +1414,7 @@ preprocessFile hsc_env src_fn mb_phase (Just (buf, _time)) | Nothing <- mb_phase, Unlit _ <- startPhase src_fn = True -- note: local_opts is only required if there's no Unlit phase | xopt Opt_Cpp dflags' = True - | dopt Opt_Pp dflags' = True + | gopt Opt_Pp dflags' = True | otherwise = False when needs_preprocessing $ diff --git a/compiler/main/HeaderInfo.hs b/compiler/main/HeaderInfo.hs index 91902d6b77..f7ae35ff55 100644 --- a/compiler/main/HeaderInfo.hs +++ b/compiler/main/HeaderInfo.hs @@ -152,7 +152,7 @@ getOptionsFromFile dflags filename -- we already have an apparently-complete token. -- We therefore just turn Opt_Haddock off when doing the lazy -- lex. - dflags' = dopt_unset dflags Opt_Haddock + dflags' = gopt_unset dflags Opt_Haddock blockSize :: Int -- blockSize = 17 -- for testing :-) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index 62a472037b..d9949db1e4 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -1400,7 +1400,7 @@ tryNewCodeGen hsc_env this_mod data_tycons -- we generate one SRT for the whole module. let pipeline_stream - | dopt Opt_SplitObjs dflags + | gopt Opt_SplitObjs dflags = {-# SCC "cmmPipeline" #-} let run_pipeline us cmmgroup = do let (topSRT', us') = initUs us emptySRT @@ -1733,7 +1733,7 @@ hscCompileCoreExpr hsc_env srcspan ds_expr | otherwise = do let dflags = hsc_dflags hsc_env - let lint_on = dopt Opt_DoCoreLinting dflags + let lint_on = gopt Opt_DoCoreLinting dflags {- Simplify it -} simpl_expr <- simplifyExpr dflags ds_expr @@ -1779,8 +1779,8 @@ dumpIfaceStats hsc_env = do (ifaceStats eps) where dflags = hsc_dflags hsc_env - dump_rn_stats = dopt Opt_D_dump_rn_stats dflags - dump_if_trace = dopt Opt_D_dump_if_trace dflags + dump_rn_stats = gopt Opt_D_dump_rn_stats dflags + dump_if_trace = gopt Opt_D_dump_if_trace dflags {- ********************************************************************** diff --git a/compiler/main/HscTypes.lhs b/compiler/main/HscTypes.lhs index a56bcabea8..937d09a313 100644 --- a/compiler/main/HscTypes.lhs +++ b/compiler/main/HscTypes.lhs @@ -235,7 +235,7 @@ instance Exception GhcApiError -- -Werror is enabled, or print them out otherwise. printOrThrowWarnings :: DynFlags -> Bag WarnMsg -> IO () printOrThrowWarnings dflags warns - | dopt Opt_WarnIsError dflags + | gopt Opt_WarnIsError dflags = when (not (isEmptyBag warns)) $ do throwIO $ mkSrcErr $ warns `snocBag` warnIsErrorMsg dflags | otherwise diff --git a/compiler/main/InteractiveEval.hs b/compiler/main/InteractiveEval.hs index 806f8356e6..3f184d6278 100644 --- a/compiler/main/InteractiveEval.hs +++ b/compiler/main/InteractiveEval.hs @@ -380,7 +380,7 @@ sandboxIO :: DynFlags -> MVar Status -> IO [HValue] -> IO Status sandboxIO dflags statusMVar thing = mask $ \restore -> -- fork starts blocked let runIt = liftM Complete $ try (restore $ rethrow dflags thing) - in if dopt Opt_GhciSandbox dflags + in if gopt Opt_GhciSandbox dflags then do tid <- forkIO $ do res <- runIt putMVar statusMVar res -- empty: can't block withInterruptsSentTo tid $ takeMVar statusMVar @@ -403,8 +403,8 @@ rethrow :: DynFlags -> IO a -> IO a rethrow dflags io = Exception.catch io $ \se -> do -- If -fbreak-on-error, we break unconditionally, -- but with care of not breaking twice - if dopt Opt_BreakOnError dflags && - not (dopt Opt_BreakOnException dflags) + if gopt Opt_BreakOnError dflags && + not (gopt Opt_BreakOnException dflags) then poke exceptionFlag 1 else case fromException se of -- If it is a "UserInterrupt" exception, we allow @@ -433,7 +433,7 @@ withBreakAction step dflags breakMVar statusMVar act setBreakAction = do stablePtr <- newStablePtr onBreak poke breakPointIOAction stablePtr - when (dopt Opt_BreakOnException dflags) $ poke exceptionFlag 1 + when (gopt Opt_BreakOnException dflags) $ poke exceptionFlag 1 when step $ setStepFlag return stablePtr -- Breaking on exceptions is not enabled by default, since it @@ -706,7 +706,7 @@ rttiEnvironment hsc_env@HscEnv{hsc_IC=ic} = do ++ "improvement for a type")) hsc_env Just subst -> do let dflags = hsc_dflags hsc_env - when (dopt Opt_D_dump_rtti dflags) $ + when (gopt Opt_D_dump_rtti dflags) $ printInfoForUser dflags alwaysQualify $ fsep [text "RTTI Improvement for", ppr id, equals, ppr subst] diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 8a3f6f40fe..9204763ebf 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -252,11 +252,11 @@ setBatchPackageFlags :: DynFlags -> [PackageConfig] -> [PackageConfig] setBatchPackageFlags dflags pkgs = (maybeDistrustAll . maybeHideAll) pkgs where maybeHideAll pkgs' - | dopt Opt_HideAllPackages dflags = map hide pkgs' + | gopt Opt_HideAllPackages dflags = map hide pkgs' | otherwise = pkgs' maybeDistrustAll pkgs' - | dopt Opt_DistrustAllPackages dflags = map distrust pkgs' + | gopt Opt_DistrustAllPackages dflags = map distrust pkgs' | otherwise = pkgs' hide pkg = pkg{ exposed = False } @@ -792,7 +792,7 @@ mkPackageState dflags pkgs0 preload0 this_package = do let -- add base & rts to the preload packages basicLinkedPackages - | dopt Opt_AutoLinkPackages dflags + | gopt Opt_AutoLinkPackages dflags = filter (flip elemUFM pkg_db) [basePackageId, rtsPackageId] | otherwise = [] -- but in any case remove the current package from the set of @@ -895,7 +895,7 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p) tag = mkBuildTag (filter (not . wayRTSOnly) ways2) rts_tag = mkBuildTag ways2 - mkDynName | dopt Opt_Static dflags = id + mkDynName | gopt Opt_Static dflags = id | otherwise = (++ ("-ghc" ++ cProjectVersion)) addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag) @@ -947,7 +947,7 @@ lookupModuleWithSuggestions dflags m where pkg_state = pkgState dflags suggestions - | dopt Opt_HelpfulErrors dflags = fuzzyLookup (moduleNameString m) all_mods + | gopt Opt_HelpfulErrors dflags = fuzzyLookup (moduleNameString m) all_mods | otherwise = [] all_mods :: [(String, Module)] -- All modules @@ -1035,7 +1035,7 @@ isDllName :: DynFlags -> PackageId -> Name -> Bool -- the synbol comes from another dynamically-linked package, -- and applies on all platforms, not just Windows isDllName dflags this_pkg name - | dopt Opt_Static dflags = False + | gopt Opt_Static dflags = False | Just mod <- nameModule_maybe name = modulePackageId mod /= this_pkg | otherwise = False -- no, it is not even an external name diff --git a/compiler/main/SysTools.lhs b/compiler/main/SysTools.lhs index eeebe694ac..877bd6b4b4 100644 --- a/compiler/main/SysTools.lhs +++ b/compiler/main/SysTools.lhs @@ -375,7 +375,7 @@ runCpp :: DynFlags -> [Option] -> IO () runCpp dflags args = do let (p,args0) = pgm_P dflags args1 = args0 ++ args - args2 = if dopt Opt_WarnIsError dflags + args2 = if gopt Opt_WarnIsError dflags then Option "-Werror" : args1 else args1 mb_env <- getGccEnv args2 @@ -676,7 +676,7 @@ readElfSection _dflags section exe = do \begin{code} cleanTempDirs :: DynFlags -> IO () cleanTempDirs dflags - = unless (dopt Opt_KeepTmpFiles dflags) + = unless (gopt Opt_KeepTmpFiles dflags) $ do let ref = dirsToClean dflags ds <- readIORef ref removeTmpDirs dflags (Map.elems ds) @@ -684,7 +684,7 @@ cleanTempDirs dflags cleanTempFiles :: DynFlags -> IO () cleanTempFiles dflags - = unless (dopt Opt_KeepTmpFiles dflags) + = unless (gopt Opt_KeepTmpFiles dflags) $ do let ref = filesToClean dflags fs <- readIORef ref removeTmpFiles dflags fs @@ -692,7 +692,7 @@ cleanTempFiles dflags cleanTempFilesExcept :: DynFlags -> [FilePath] -> IO () cleanTempFilesExcept dflags dont_delete - = unless (dopt Opt_KeepTmpFiles dflags) + = unless (gopt Opt_KeepTmpFiles dflags) $ do let ref = filesToClean dflags files <- readIORef ref let (to_keep, to_delete) = partition (`elem` dont_delete) files @@ -1053,7 +1053,7 @@ linkDynLib dflags o_files dep_packages get_pkg_lib_path_opts l | osElfTarget (platformOS (targetPlatform dflags)) && dynLibLoader dflags == SystemDependent && - not (dopt Opt_Static dflags) + not (gopt Opt_Static dflags) = ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l] | otherwise = ["-L" ++ l] @@ -1097,7 +1097,7 @@ linkDynLib dflags o_files dep_packages , Option "-shared" ] ++ [ FileOption "-Wl,--out-implib=" (output_fn ++ ".a") - | dopt Opt_SharedImplib dflags + | gopt Opt_SharedImplib dflags ] ++ map (FileOption "") o_files ++ map Option ( diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index ebb8f4889a..e2010645b2 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -307,8 +307,8 @@ tidyProgram hsc_env (ModGuts { mg_module = mod }) = do { let { dflags = hsc_dflags hsc_env - ; omit_prags = dopt Opt_OmitInterfacePragmas dflags - ; expose_all = dopt Opt_ExposeAllUnfoldings dflags + ; omit_prags = gopt Opt_OmitInterfacePragmas dflags + ; expose_all = gopt Opt_ExposeAllUnfoldings dflags ; th = xopt Opt_TemplateHaskell dflags ; data_kinds = xopt Opt_DataKinds dflags ; no_trim_types = th || data_kinds @@ -373,14 +373,14 @@ tidyProgram hsc_env (ModGuts { mg_module = mod -- If the endPass didn't print the rules, but ddump-rules is -- on, print now - ; unless (dopt Opt_D_dump_simpl dflags) $ + ; unless (gopt Opt_D_dump_simpl dflags) $ Err.dumpIfSet_dyn dflags Opt_D_dump_rules (showSDoc dflags (ppr CoreTidy <+> ptext (sLit "rules"))) (pprRulesForUser tidy_rules) -- Print one-line size info ; let cs = coreBindsStats tidy_binds - ; when (dopt Opt_D_dump_core_stats dflags) + ; when (gopt Opt_D_dump_core_stats dflags) (log_action dflags dflags SevDump noSrcSpan defaultDumpStyle (ptext (sLit "Tidy size (terms,types,coercions)") <+> ppr (moduleName mod) <> colon diff --git a/compiler/nativeGen/AsmCodeGen.lhs b/compiler/nativeGen/AsmCodeGen.lhs index d0e4a17746..a233a8ffba 100644 --- a/compiler/nativeGen/AsmCodeGen.lhs +++ b/compiler/nativeGen/AsmCodeGen.lhs @@ -287,7 +287,7 @@ nativeCodeGen' dflags ncgImpl h us cmms return () where add_split tops - | dopt Opt_SplitObjs dflags = split_marker : tops + | gopt Opt_SplitObjs dflags = split_marker : tops | otherwise = tops split_marker = CmmProc mapEmpty mkSplitMarkerLabel (ListGraph []) @@ -356,8 +356,8 @@ cmmNativeGens dflags ncgImpl h us (cmm : cmms) impAcc profAcc count -- and then using 'seq' doesn't work, because the let -- apparently gets inlined first. lsPprNative <- return $! - if dopt Opt_D_dump_asm dflags - || dopt Opt_D_dump_asm_stats dflags + if gopt Opt_D_dump_asm dflags + || gopt Opt_D_dump_asm_stats dflags then native else [] @@ -432,8 +432,8 @@ cmmNativeGen dflags ncgImpl us cmm count -- allocate registers (alloced, usAlloc, ppr_raStatsColor, ppr_raStatsLinear) <- - if ( dopt Opt_RegsGraph dflags - || dopt Opt_RegsIterative dflags) + if ( gopt Opt_RegsGraph dflags + || gopt Opt_RegsIterative dflags) then do -- the regs usable for allocation let (alloc_regs :: UniqFM (UniqSet RealReg)) @@ -466,7 +466,7 @@ cmmNativeGen dflags ncgImpl us cmm count $ zip [0..] regAllocStats) let mPprStats = - if dopt Opt_D_dump_asm_stats dflags + if gopt Opt_D_dump_asm_stats dflags then Just regAllocStats else Nothing -- force evaluation of the Maybe to avoid space leak @@ -498,7 +498,7 @@ cmmNativeGen dflags ncgImpl us cmm count (vcat $ map (pprNatCmmDecl ncgImpl) alloced) let mPprStats = - if dopt Opt_D_dump_asm_stats dflags + if gopt Opt_D_dump_asm_stats dflags then Just (catMaybes regAllocStats) else Nothing -- force evaluation of the Maybe to avoid space leak @@ -1024,15 +1024,15 @@ cmmExprNative referenceKind expr = do -- to use the register table, so we replace these registers -- with the corresponding labels: CmmReg (CmmGlobal EagerBlackholeInfo) - | arch == ArchPPC && not (dopt Opt_PIC dflags) + | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_EAGER_BLACKHOLE_info"))) CmmReg (CmmGlobal GCEnter1) - | arch == ArchPPC && not (dopt Opt_PIC dflags) + | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_enter_1"))) CmmReg (CmmGlobal GCFun) - | arch == ArchPPC && not (dopt Opt_PIC dflags) + | arch == ArchPPC && not (gopt Opt_PIC dflags) -> cmmExprNative referenceKind $ CmmLit (CmmLabel (mkCmmCodeLabel rtsPackageId (fsLit "__stg_gc_fun"))) diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs index af4bb9e9ed..4153ea9bcb 100644 --- a/compiler/nativeGen/PIC.hs +++ b/compiler/nativeGen/PIC.hs @@ -160,7 +160,7 @@ cmmMakePicReference dflags lbl = CmmLit $ CmmLabel lbl - | (dopt Opt_PIC dflags || not (dopt Opt_Static dflags)) && absoluteLabel lbl + | (gopt Opt_PIC dflags || not (gopt Opt_Static dflags)) && absoluteLabel lbl = CmmMachOp (MO_Add (wordWidth dflags)) [ CmmReg (CmmGlobal PicBaseReg) , CmmLit $ picRelative @@ -220,7 +220,7 @@ howToAccessLabel howToAccessLabel dflags _ OSMinGW32 _ lbl -- Assume all symbols will be in the same PE, so just access them directly. - | dopt Opt_Static dflags + | gopt Opt_Static dflags = AccessDirectly -- If the target symbol is in another PE we need to access it via the @@ -256,7 +256,7 @@ howToAccessLabel dflags arch OSDarwin DataReference lbl -- we'd need to pass the current Module all the way in to -- this function. | arch /= ArchX86_64 - , dopt Opt_PIC dflags && externallyVisibleCLabel lbl + , gopt Opt_PIC dflags && externallyVisibleCLabel lbl = AccessViaSymbolPtr | otherwise @@ -306,7 +306,7 @@ howToAccessLabel dflags _ os _ _ -- if we don't dynamically link to Haskell code, -- it actually manages to do so without messing thins up. | osElfTarget os - , not (dopt Opt_PIC dflags) && dopt Opt_Static dflags + , not (gopt Opt_PIC dflags) && gopt Opt_Static dflags = AccessDirectly howToAccessLabel dflags arch os DataReference lbl @@ -320,7 +320,7 @@ howToAccessLabel dflags arch os DataReference lbl -- via a symbol pointer (see below for an explanation why -- PowerPC32 Linux is especially broken). | arch == ArchPPC - , dopt Opt_PIC dflags + , gopt Opt_PIC dflags -> AccessViaSymbolPtr | otherwise @@ -341,12 +341,12 @@ howToAccessLabel dflags arch os DataReference lbl howToAccessLabel dflags arch os CallReference lbl | osElfTarget os - , labelDynamic dflags (thisPackage dflags) lbl && not (dopt Opt_PIC dflags) + , labelDynamic dflags (thisPackage dflags) lbl && not (gopt Opt_PIC dflags) = AccessDirectly | osElfTarget os , arch /= ArchX86 - , labelDynamic dflags (thisPackage dflags) lbl && dopt Opt_PIC dflags + , labelDynamic dflags (thisPackage dflags) lbl && gopt Opt_PIC dflags = AccessViaStub howToAccessLabel dflags _ os _ lbl @@ -357,7 +357,7 @@ howToAccessLabel dflags _ os _ lbl -- all other platforms howToAccessLabel dflags _ _ _ _ - | not (dopt Opt_PIC dflags) + | not (gopt Opt_PIC dflags) = AccessDirectly | otherwise @@ -428,12 +428,12 @@ needImportedSymbols dflags arch os -- PowerPC Linux: -fPIC or -dynamic | osElfTarget os , arch == ArchPPC - = dopt Opt_PIC dflags || not (dopt Opt_Static dflags) + = gopt Opt_PIC dflags || not (gopt Opt_Static dflags) -- i386 (and others?): -dynamic but not -fPIC | osElfTarget os , arch /= ArchPPC_64 - = not (dopt Opt_Static dflags) && not (dopt Opt_PIC dflags) + = not (gopt Opt_Static dflags) && not (gopt Opt_PIC dflags) | otherwise = False @@ -455,7 +455,7 @@ gotLabel -- However, for PIC on x86, we need a small helper function. pprGotDeclaration :: DynFlags -> Arch -> OS -> SDoc pprGotDeclaration dflags ArchX86 OSDarwin - | dopt Opt_PIC dflags + | gopt Opt_PIC dflags = vcat [ ptext (sLit ".section __TEXT,__textcoal_nt,coalesced,no_toc"), ptext (sLit ".weak_definition ___i686.get_pc_thunk.ax"), @@ -475,7 +475,7 @@ pprGotDeclaration _ _ OSDarwin pprGotDeclaration dflags arch os | osElfTarget os , arch /= ArchPPC_64 - , not (dopt Opt_PIC dflags) + , not (gopt Opt_PIC dflags) = empty | osElfTarget os @@ -499,7 +499,7 @@ pprGotDeclaration _ _ _ pprImportedSymbol :: DynFlags -> Platform -> CLabel -> SDoc pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC, platformOS = OSDarwin }) importedLbl | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl - = case dopt Opt_PIC dflags of + = case gopt Opt_PIC dflags of False -> vcat [ ptext (sLit ".symbol_stub"), @@ -553,7 +553,7 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchPPC, platformOS pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS = OSDarwin }) importedLbl | Just (CodeStub, lbl) <- dynamicLinkerLabelInfo importedLbl - = case dopt Opt_PIC dflags of + = case gopt Opt_PIC dflags of False -> vcat [ ptext (sLit ".symbol_stub"), @@ -586,7 +586,7 @@ pprImportedSymbol dflags platform@(Platform { platformArch = ArchX86, platformOS ptext (sLit "\tjmp dyld_stub_binding_helper") ] $+$ vcat [ ptext (sLit ".section __DATA, __la_sym_ptr") - <> (if dopt Opt_PIC dflags then int 2 else int 3) + <> (if gopt Opt_PIC dflags then int 2 else int 3) <> ptext (sLit ",lazy_symbol_pointers"), ptext (sLit "L") <> pprCLabel platform lbl <> ptext (sLit "$lazy_ptr:"), ptext (sLit "\t.indirect_symbol") <+> pprCLabel platform lbl, @@ -622,7 +622,7 @@ pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _ -- section. -- The "official" GOT mechanism (label@got) isn't intended to be used -- in position dependent code, so we have to create our own "fake GOT" --- when not Opt_PIC && not (dopt Opt_Static dflags). +-- when not Opt_PIC && not (gopt Opt_Static dflags). -- -- 2) PowerPC Linux is just plain broken. -- While it's theoretically possible to use GOT offsets larger diff --git a/compiler/nativeGen/PPC/CodeGen.hs b/compiler/nativeGen/PPC/CodeGen.hs index 1f036aa43e..026e8933d7 100644 --- a/compiler/nativeGen/PPC/CodeGen.hs +++ b/compiler/nativeGen/PPC/CodeGen.hs @@ -1162,7 +1162,7 @@ genCCall' dflags gcp target dest_regs argsAndHints genSwitch :: DynFlags -> CmmExpr -> [Maybe BlockId] -> NatM InstrBlock genSwitch dflags expr ids - | dopt Opt_PIC dflags + | gopt Opt_PIC dflags = do (reg,e_code) <- getSomeReg expr tmp <- getNewRegNat II32 @@ -1196,7 +1196,7 @@ generateJumpTableForInstr :: DynFlags -> Instr -> Maybe (NatCmmDecl CmmStatics Instr) generateJumpTableForInstr dflags (BCTR ids (Just lbl)) = let jumpTable - | dopt Opt_PIC dflags = map jumpTableEntryRel ids + | gopt Opt_PIC dflags = map jumpTableEntryRel ids | otherwise = map (jumpTableEntry dflags) ids where jumpTableEntryRel Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags)) diff --git a/compiler/nativeGen/RegAlloc/Graph/Main.hs b/compiler/nativeGen/RegAlloc/Graph/Main.hs index 1611a710fb..57c150b6b0 100644 --- a/compiler/nativeGen/RegAlloc/Graph/Main.hs +++ b/compiler/nativeGen/RegAlloc/Graph/Main.hs @@ -91,9 +91,9 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code -- intermediate structures in the allocator - otherwise tell the -- allocator to ditch them early so we don't end up creating space leaks. let dump = or - [ dopt Opt_D_dump_asm_regalloc_stages dflags - , dopt Opt_D_dump_asm_stats dflags - , dopt Opt_D_dump_asm_conflicts dflags ] + [ gopt Opt_D_dump_asm_regalloc_stages dflags + , gopt Opt_D_dump_asm_stats dflags + , gopt Opt_D_dump_asm_conflicts dflags ] -- check that we're not running off down the garden path. when (spinCount > maxSpinCount) @@ -137,7 +137,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code let (graph_colored, rsSpill, rmCoalesce) = {-# SCC "ColorGraph" #-} Color.colorGraph - (dopt Opt_RegsIterative dflags) + (gopt Opt_RegsIterative dflags) spinCount regsFree triv spill graph @@ -160,7 +160,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code then do -- if -fasm-lint is turned on then validate the graph let graph_colored_lint = - if dopt Opt_DoAsmLinting dflags + if gopt Opt_DoAsmLinting dflags then Color.validateGraph (text "") True -- require all nodes to be colored graph_colored @@ -205,7 +205,7 @@ regAlloc_spin dflags spinCount triv regsFree slotsFree debug_codeGraphs code else do -- if -fasm-lint is turned on then validate the graph let graph_colored_lint = - if dopt Opt_DoAsmLinting dflags + if gopt Opt_DoAsmLinting dflags then Color.validateGraph (text "") False -- don't require nodes to be colored graph_colored diff --git a/compiler/nativeGen/SPARC/CodeGen.hs b/compiler/nativeGen/SPARC/CodeGen.hs index 9d6aeaafc9..aeb6d10acc 100644 --- a/compiler/nativeGen/SPARC/CodeGen.hs +++ b/compiler/nativeGen/SPARC/CodeGen.hs @@ -296,7 +296,7 @@ genCondJump bid bool = do genSwitch :: DynFlags -> CmmExpr -> [Maybe BlockId] -> NatM InstrBlock genSwitch dflags expr ids - | dopt Opt_PIC dflags + | gopt Opt_PIC dflags = error "MachCodeGen: sparc genSwitch PIC not finished\n" | otherwise diff --git a/compiler/nativeGen/X86/CodeGen.hs b/compiler/nativeGen/X86/CodeGen.hs index fbbc37e6c9..7ab30bf922 100644 --- a/compiler/nativeGen/X86/CodeGen.hs +++ b/compiler/nativeGen/X86/CodeGen.hs @@ -76,13 +76,13 @@ sse2Enabled = do -- calling convention specifies the use of xmm regs, -- and possibly other places. return True - ArchX86 -> return (dopt Opt_SSE2 dflags || dopt Opt_SSE4_2 dflags) + ArchX86 -> return (gopt Opt_SSE2 dflags || gopt Opt_SSE4_2 dflags) _ -> panic "sse2Enabled: Not an X86* arch" sse4_2Enabled :: NatM Bool sse4_2Enabled = do dflags <- getDynFlags - return (dopt Opt_SSE4_2 dflags) + return (gopt Opt_SSE4_2 dflags) if_sse2 :: NatM a -> NatM a -> NatM a if_sse2 sse2 x87 = do @@ -2291,7 +2291,7 @@ outOfLineCmmOp mop res args genSwitch :: DynFlags -> CmmExpr -> [Maybe BlockId] -> NatM InstrBlock genSwitch dflags expr ids - | dopt Opt_PIC dflags + | gopt Opt_PIC dflags = do (reg,e_code) <- getSomeReg expr lbl <- getNewLabelNat @@ -2352,7 +2352,7 @@ createJumpTable :: DynFlags -> [Maybe BlockId] -> Section -> CLabel -> GenCmmDecl (Alignment, CmmStatics) h g createJumpTable dflags ids section lbl = let jumpTable - | dopt Opt_PIC dflags = + | gopt Opt_PIC dflags = let jumpTableEntryRel Nothing = CmmStaticLit (CmmInt 0 (wordWidth dflags)) jumpTableEntryRel (Just blockid) diff --git a/compiler/parser/Lexer.x b/compiler/parser/Lexer.x index aaa4f054ba..3ffa7db7f7 100644 --- a/compiler/parser/Lexer.x +++ b/compiler/parser/Lexer.x @@ -1967,7 +1967,7 @@ mkPState flags buf loc = .|. explicitForallBit `setBitIf` xopt Opt_ExplicitForAll flags .|. bangPatBit `setBitIf` xopt Opt_BangPatterns flags .|. tyFamBit `setBitIf` xopt Opt_TypeFamilies flags - .|. haddockBit `setBitIf` dopt Opt_Haddock flags + .|. haddockBit `setBitIf` gopt Opt_Haddock flags .|. magicHashBit `setBitIf` xopt Opt_MagicHash flags .|. kindSigsBit `setBitIf` xopt Opt_KindSignatures flags .|. recursiveDoBit `setBitIf` xopt Opt_RecursiveDo flags @@ -1976,11 +1976,11 @@ mkPState flags buf loc = .|. datatypeContextsBit `setBitIf` xopt Opt_DatatypeContexts flags .|. transformComprehensionsBit `setBitIf` xopt Opt_TransformListComp flags .|. transformComprehensionsBit `setBitIf` xopt Opt_MonadComprehensions flags - .|. rawTokenStreamBit `setBitIf` dopt Opt_KeepRawTokenStream flags - .|. hpcBit `setBitIf` dopt Opt_Hpc flags + .|. rawTokenStreamBit `setBitIf` gopt Opt_KeepRawTokenStream flags + .|. hpcBit `setBitIf` gopt Opt_Hpc flags .|. alternativeLayoutRuleBit `setBitIf` xopt Opt_AlternativeLayoutRule flags .|. relaxedLayoutBit `setBitIf` xopt Opt_RelaxedLayout flags - .|. sccProfilingOnBit `setBitIf` dopt Opt_SccProfilingOn flags + .|. sccProfilingOnBit `setBitIf` gopt Opt_SccProfilingOn flags .|. nondecreasingIndentationBit `setBitIf` xopt Opt_NondecreasingIndentation flags .|. safeHaskellBit `setBitIf` safeImportsOn flags .|. traditionalRecordSyntaxBit `setBitIf` xopt Opt_TraditionalRecordSyntax flags @@ -2333,7 +2333,7 @@ reportLexError loc1 loc2 buf str lexTokenStream :: StringBuffer -> RealSrcLoc -> DynFlags -> ParseResult [Located Token] lexTokenStream buf loc dflags = unP go initState - where dflags' = dopt_set (dopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream + where dflags' = gopt_set (gopt_unset dflags Opt_Haddock) Opt_KeepRawTokenStream initState = mkPState dflags' buf loc go = do ltok <- lexer return diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index d1a2efdf6f..5d414940a8 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -580,9 +580,9 @@ nonZeroLit n = getLiteral n >>= guard . not . isZeroLit -- Rational value to that of Float/Double. We confuse host architecture -- and target architecture here, but it's convenient (and wrong :-). convFloating :: DynFlags -> Literal -> Literal -convFloating dflags (MachFloat f) | not (dopt Opt_ExcessPrecision dflags) = +convFloating dflags (MachFloat f) | not (gopt Opt_ExcessPrecision dflags) = MachFloat (toRational (fromRational f :: Float )) -convFloating dflags (MachDouble d) | not (dopt Opt_ExcessPrecision dflags) = +convFloating dflags (MachDouble d) | not (gopt Opt_ExcessPrecision dflags) = MachDouble (toRational (fromRational d :: Double)) convFloating _ l = l diff --git a/compiler/profiling/ProfInit.hs b/compiler/profiling/ProfInit.hs index 0866c03395..9fddc495d4 100644 --- a/compiler/profiling/ProfInit.hs +++ b/compiler/profiling/ProfInit.hs @@ -24,7 +24,7 @@ import Module profilingInitCode :: Module -> CollectedCCs -> SDoc profilingInitCode this_mod (local_CCs, ___extern_CCs, singleton_CCSs) = sdocWithDynFlags $ \dflags -> - if not (dopt Opt_SccProfilingOn dflags) + if not (gopt Opt_SccProfilingOn dflags) then empty else vcat [ text "static void prof_init_" <> ppr this_mod diff --git a/compiler/profiling/SCCfinal.lhs b/compiler/profiling/SCCfinal.lhs index a6fe565746..77e2cb78c0 100644 --- a/compiler/profiling/SCCfinal.lhs +++ b/compiler/profiling/SCCfinal.lhs @@ -51,7 +51,7 @@ stgMassageForProfiling dflags mod_name _us stg_binds = initMM mod_name (do_top_bindings stg_binds) (fixed_ccs, fixed_cc_stacks) - = if dopt Opt_AutoSccsOnIndividualCafs dflags + = if gopt Opt_AutoSccsOnIndividualCafs dflags then ([],[]) -- don't need "all CAFs" CC else ([all_cafs_cc], [all_cafs_ccs]) @@ -102,7 +102,7 @@ stgMassageForProfiling dflags mod_name _us stg_binds = do -- Top level CAF without a cost centre attached -- Attach CAF cc (collect if individual CAF ccs) - caf_ccs <- if dopt Opt_AutoSccsOnIndividualCafs dflags + caf_ccs <- if gopt Opt_AutoSccsOnIndividualCafs dflags then let cc = mkAutoCC binder modl CafCC ccs = mkSingletonCCS cc -- careful: the binder might be :Main.main, diff --git a/compiler/rename/RnBinds.lhs b/compiler/rename/RnBinds.lhs index a0aea6a582..dfead07797 100644 --- a/compiler/rename/RnBinds.lhs +++ b/compiler/rename/RnBinds.lhs @@ -463,7 +463,7 @@ rnBind _ (L loc bind@(PatBind { pat_lhs = pat -- which (a) is not that different from _v = rhs -- (b) is sometimes used to give a type sig for, -- or an occurrence of, a variable on the RHS - ; ifWOptM Opt_WarnUnusedBinds $ + ; whenWOptM Opt_WarnUnusedBinds $ when (null bndrs && not is_wild_pat) $ addWarn $ unusedPatBindWarn bind' diff --git a/compiler/rename/RnEnv.lhs b/compiler/rename/RnEnv.lhs index 6385e1b52d..f29d64c55c 100644 --- a/compiler/rename/RnEnv.lhs +++ b/compiler/rename/RnEnv.lhs @@ -619,7 +619,7 @@ lookupOccRn_maybe rdr_name -- imports. We can and should instead check the qualified import -- but at the moment this requires some refactoring so leave as a TODO ; dflags <- getDynFlags - ; let allow_qual = dopt Opt_ImplicitImportQualified dflags && + ; let allow_qual = gopt Opt_ImplicitImportQualified dflags && not (safeDirectImpsReq dflags) ; is_ghci <- getIsGHCi -- This test is not expensive, @@ -1307,7 +1307,7 @@ checkDupAndShadowedNames envs names ------------------------------------- checkShadowedOccs :: (GlobalRdrEnv, LocalRdrEnv) -> [(SrcSpan,OccName)] -> RnM () checkShadowedOccs (global_env,local_env) loc_occs - = ifWOptM Opt_WarnNameShadowing $ + = whenWOptM Opt_WarnNameShadowing $ do { traceRn (text "shadow" <+> ppr loc_occs) ; mapM_ check_shadow loc_occs } where @@ -1359,7 +1359,7 @@ unboundName wl rdr = unboundNameX wl rdr empty unboundNameX :: WhereLooking -> RdrName -> SDoc -> RnM Name unboundNameX where_look rdr_name extra - = do { show_helpful_errors <- doptM Opt_HelpfulErrors + = do { show_helpful_errors <- goptM Opt_HelpfulErrors ; let what = pprNonVarNameSpace (occNameSpace (rdrNameOcc rdr_name)) err = unknownNameErr what rdr_name $$ extra ; if not show_helpful_errors @@ -1538,7 +1538,7 @@ mapFvRnCPS f (x:xs) cont = f x $ \ x' -> \begin{code} warnUnusedTopBinds :: [GlobalRdrElt] -> RnM () warnUnusedTopBinds gres - = ifWOptM Opt_WarnUnusedBinds + = whenWOptM Opt_WarnUnusedBinds $ do isBoot <- tcIsHsBoot let noParent gre = case gre_par gre of NoParent -> True @@ -1556,7 +1556,7 @@ warnUnusedMatches = check_unused Opt_WarnUnusedMatches check_unused :: WarningFlag -> [Name] -> FreeVars -> RnM () check_unused flag bound_names used_names - = ifWOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names)) + = whenWOptM flag (warnUnusedLocals (filterOut (`elemNameSet` used_names) bound_names)) ------------------------- -- Helpers diff --git a/compiler/rename/RnExpr.lhs b/compiler/rename/RnExpr.lhs index 0d69d252f1..038f754406 100644 --- a/compiler/rename/RnExpr.lhs +++ b/compiler/rename/RnExpr.lhs @@ -100,7 +100,7 @@ finishHsVar :: Name -> RnM (HsExpr Name, FreeVars) -- when renaming infix expressions -- See Note [Adding the implicit parameter to 'assert'] finishHsVar name - = do { ignore_asserts <- doptM Opt_IgnoreAsserts + = do { ignore_asserts <- goptM Opt_IgnoreAsserts ; if ignore_asserts || not (name `hasKey` assertIdKey) then return (HsVar name, unitFV name) else do { e <- mkAssertErrorExpr diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 3409d77397..50baeffafe 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -183,7 +183,7 @@ rnImportDecl this_mod Just (False, _) -> return () -- Explicit import list _ | implicit -> return () -- Do not bleat for implicit imports | qual_only -> return () - | otherwise -> ifWOptM Opt_WarnMissingImportList $ + | otherwise -> whenWOptM Opt_WarnMissingImportList $ addWarn (missingImportListWarn imp_mod_name) iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg @@ -314,7 +314,7 @@ rnImportDecl this_mod } -- Complain if we import a deprecated module - ifWOptM Opt_WarnWarningsDeprecations ( + whenWOptM Opt_WarnWarningsDeprecations ( case warns of WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt _ -> return () @@ -651,11 +651,11 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) return [ (L loc ie, avail) | (ie,avail) <- stuff ] where -- Warn when importing T(..) if T was exported abstractly - emit_warning (DodgyImport n) = ifWOptM Opt_WarnDodgyImports $ + emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $ addWarn (dodgyImportWarn n) - emit_warning MissingImportList = ifWOptM Opt_WarnMissingImportList $ + emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $ addWarn (missingImportListItem ieRdr) - emit_warning BadImportW = ifWOptM Opt_WarnDodgyImports $ + emit_warning BadImportW = whenWOptM Opt_WarnDodgyImports $ addWarn (lookup_err_msg BadImport) run_lookup :: IELookupM a -> TcRn (Maybe a) @@ -1307,10 +1307,10 @@ warnUnusedImportDecls gbl_env ; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr (Set.elems uses) , ptext (sLit "Import usage") <+> ppr usage]) - ; ifWOptM Opt_WarnUnusedImports $ + ; whenWOptM Opt_WarnUnusedImports $ mapM_ warnUnusedImport usage - ; ifDOptM Opt_D_dump_minimal_imports $ + ; whenGOptM Opt_D_dump_minimal_imports $ printMinimalImports usage } where explicit_import (L _ decl) = unLoc (ideclName decl) /= pRELUDE_NAME diff --git a/compiler/rename/RnTypes.lhs b/compiler/rename/RnTypes.lhs index f8bbc3d68e..7867c5cbb8 100644 --- a/compiler/rename/RnTypes.lhs +++ b/compiler/rename/RnTypes.lhs @@ -799,7 +799,7 @@ ppr_opfix (op, fixity) = pp_op <+> brackets (ppr fixity) \begin{code} warnUnusedForAlls :: SDoc -> LHsTyVarBndrs RdrName -> [RdrName] -> TcM () warnUnusedForAlls in_doc bound mentioned_rdrs - = ifWOptM Opt_WarnUnusedMatches $ + = whenWOptM Opt_WarnUnusedMatches $ mapM_ add_warn bound_but_not_used where bound_names = hsLTyVarLocNames bound diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs index e0f31c9689..3917734056 100644 --- a/compiler/simplCore/CoreMonad.lhs +++ b/compiler/simplCore/CoreMonad.lhs @@ -142,8 +142,8 @@ endPass dflags pass binds rules ; lintPassResult dflags pass binds } where mb_flag = case coreDumpFlag pass of - Just flag | dopt flag dflags -> Just flag - | dopt Opt_D_verbose_core2core dflags -> Just flag + Just flag | gopt flag dflags -> Just flag + | gopt Opt_D_verbose_core2core dflags -> Just flag _ -> Nothing dumpIfSet :: DynFlags -> Bool -> CoreToDo -> SDoc -> SDoc -> IO () @@ -180,7 +180,7 @@ dumpPassResult dflags mb_flag hdr extra_info binds rules lintPassResult :: DynFlags -> CoreToDo -> CoreProgram -> IO () lintPassResult dflags pass binds - = when (dopt Opt_DoCoreLinting dflags) $ + = when (gopt Opt_DoCoreLinting dflags) $ do { let (warns, errs) = lintCoreBindings binds ; Err.showPass dflags ("Core Linted result of " ++ showPpr dflags pass) ; displayLintResults dflags pass warns errs binds } @@ -384,7 +384,7 @@ dumpSimplPhase dflags mode | Just spec_string <- shouldDumpSimplPhase dflags = match_spec spec_string | otherwise - = dopt Opt_D_verbose_core2core dflags + = gopt Opt_D_verbose_core2core dflags where match_spec :: String -> Bool @@ -510,7 +510,7 @@ simplCountN (SimplCount { ticks = n }) = n zeroSimplCount dflags -- This is where we decide whether to do -- the VerySimpl version or the full-stats version - | dopt Opt_D_dump_simpl_stats dflags + | gopt Opt_D_dump_simpl_stats dflags = SimplCount {ticks = 0, details = Map.empty, n_log = 0, log1 = [], log2 = []} | otherwise diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index 268a918e37..f588779390 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -120,16 +120,16 @@ getCoreToDo dflags phases = simplPhases dflags max_iter = maxSimplIterations dflags rule_check = ruleCheck dflags - strictness = dopt Opt_Strictness dflags - full_laziness = dopt Opt_FullLaziness dflags - do_specialise = dopt Opt_Specialise dflags - do_float_in = dopt Opt_FloatIn dflags - cse = dopt Opt_CSE dflags - spec_constr = dopt Opt_SpecConstr dflags - liberate_case = dopt Opt_LiberateCase dflags - static_args = dopt Opt_StaticArgumentTransformation dflags - rules_on = dopt Opt_EnableRewriteRules dflags - eta_expand_on = dopt Opt_DoLambdaEtaExpansion dflags + strictness = gopt Opt_Strictness dflags + full_laziness = gopt Opt_FullLaziness dflags + do_specialise = gopt Opt_Specialise dflags + do_float_in = gopt Opt_FloatIn dflags + cse = gopt Opt_CSE dflags + spec_constr = gopt Opt_SpecConstr dflags + liberate_case = gopt Opt_LiberateCase dflags + static_args = gopt Opt_StaticArgumentTransformation dflags + rules_on = gopt Opt_EnableRewriteRules dflags + eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase) @@ -157,12 +157,12 @@ getCoreToDo dflags -- We need to eliminate these common sub expressions before their definitions -- are inlined in phase 2. The CSE introduces lots of v1 = v2 bindings, -- so we also run simpl_gently to inline them. - ++ (if dopt Opt_Vectorise dflags && phase == 3 + ++ (if gopt Opt_Vectorise dflags && phase == 3 then [CoreCSE, simpl_gently] else []) vectorisation - = runWhen (dopt Opt_Vectorise dflags) $ + = runWhen (gopt Opt_Vectorise dflags) $ CoreDoPasses [ simpl_gently, CoreDoVectorisation ] -- By default, we have 2 phases before phase 0. @@ -497,7 +497,7 @@ simplifyExpr dflags expr ; (expr', counts) <- initSmpl dflags emptyRuleBase emptyFamInstEnvs us sz $ simplExprGently (simplEnvForGHCi dflags) expr - ; Err.dumpIfSet dflags (dopt Opt_D_dump_simpl_stats dflags) + ; Err.dumpIfSet dflags (gopt Opt_D_dump_simpl_stats dflags) "Simplifier statistics" (pprSimplCount counts) ; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression" @@ -560,7 +560,7 @@ simplifyPgmIO pass@(CoreDoSimplify max_iterations mode) = do { (termination_msg, it_count, counts_out, guts') <- do_iteration us 1 [] binds rules - ; Err.dumpIfSet dflags (dump_phase && dopt Opt_D_dump_simpl_stats dflags) + ; Err.dumpIfSet dflags (dump_phase && gopt Opt_D_dump_simpl_stats dflags) "Simplifier statistics for following pass" (vcat [text termination_msg <+> text "after" <+> ppr it_count <+> text "iterations", blankLine, @@ -676,7 +676,7 @@ end_iteration dflags pass iteration_no counts binds rules = do { dumpPassResult dflags mb_flag hdr pp_counts binds rules ; lintPassResult dflags pass binds } where - mb_flag | dopt Opt_D_dump_simpl_iterations dflags = Just Opt_D_dump_simpl_phases + mb_flag | gopt Opt_D_dump_simpl_iterations dflags = Just Opt_D_dump_simpl_phases | otherwise = Nothing -- Show details if Opt_D_dump_simpl_iterations is on diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 9590288b22..6f00d42228 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -497,8 +497,8 @@ simplEnvForGHCi dflags , sm_eta_expand = eta_expand_on , sm_case_case = True } where - rules_on = dopt Opt_EnableRewriteRules dflags - eta_expand_on = dopt Opt_DoLambdaEtaExpansion dflags + rules_on = gopt Opt_EnableRewriteRules dflags + eta_expand_on = gopt Opt_DoLambdaEtaExpansion dflags -- Do not do any inlining, in case we expose some unboxed -- tuple stuff that confuses the bytecode interpreter @@ -816,7 +816,7 @@ preInlineUnconditionally dflags env top_lvl bndr rhs | not active = False | isStableUnfolding (idUnfolding bndr) = False -- Note [InlineRule and preInlineUnconditionally] | isTopLevel top_lvl && isBottomingId bndr = False -- Note [Top-level bottoming Ids] - | not (dopt Opt_SimplPreInlining dflags) = False + | not (gopt Opt_SimplPreInlining dflags) = False | isCoVar bndr = False -- Note [Do not inline CoVars unconditionally] | otherwise = case idOccInfo bndr of IAmDead -> True -- Happens in ((\x.1) v) @@ -1073,7 +1073,7 @@ mkLam _env bndrs body (bndrs1, body1) = collectBinders body mkLam' dflags bndrs body - | dopt Opt_DoEtaReduction dflags + | gopt Opt_DoEtaReduction dflags , Just etad_lam <- tryEtaReduce bndrs body = do { tick (EtaReduction (head bndrs)) ; return etad_lam } @@ -1597,7 +1597,7 @@ mkCase, mkCase1, mkCase2 -------------------------------------------------- mkCase dflags scrut outer_bndr alts_ty ((DEFAULT, _, deflt_rhs) : outer_alts) - | dopt Opt_CaseMerge dflags + | gopt Opt_CaseMerge dflags , Case (Var inner_scrut_var) inner_bndr _ inner_alts <- deflt_rhs , inner_scrut_var == outer_bndr = do { tick (CaseMerge outer_bndr) diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index f794b88114..332643dc6c 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -218,7 +218,7 @@ simplTopBinds env0 binds0 -- See note [Glomming] in OccurAnal. ; env1 <- simplRecBndrs env0 (bindersOfBinds binds0) ; dflags <- getDynFlags - ; let dump_flag = dopt Opt_D_verbose_core2core dflags + ; let dump_flag = gopt Opt_D_verbose_core2core dflags ; env2 <- simpl_binds dump_flag env1 binds0 ; freeTick SimplifierDone ; return env2 } @@ -1420,8 +1420,8 @@ completeCall env var cont }}} where dump_inline dflags unfolding cont - | not (dopt Opt_D_dump_inlinings dflags) = return () - | not (dopt Opt_D_verbose_core2core dflags) + | not (gopt Opt_D_dump_inlinings dflags) = return () + | not (gopt Opt_D_verbose_core2core dflags) = when (isExternalName (idName var)) $ liftIO $ printInfoForUser dflags alwaysQualify $ sep [text "Inlining done:", nest 4 (ppr var)] @@ -1571,14 +1571,14 @@ tryRules env rules fn args call_cont ; return (Just (ruleArity rule, rule_rhs)) }}} where dump dflags rule rule_rhs - | dopt Opt_D_dump_rule_rewrites dflags + | gopt Opt_D_dump_rule_rewrites dflags = log_rule dflags Opt_D_dump_rule_rewrites "Rule fired" $ vcat [ text "Rule:" <+> ftext (ru_name rule) , text "Before:" <+> hang (ppr fn) 2 (sep (map pprParendExpr args)) , text "After: " <+> pprCoreExpr rule_rhs , text "Cont: " <+> ppr call_cont ] - | dopt Opt_D_dump_rule_firings dflags + | gopt Opt_D_dump_rule_firings dflags = log_rule dflags Opt_D_dump_rule_firings "Rule fired:" $ ftext (ru_name rule) diff --git a/compiler/simplStg/SimplStg.lhs b/compiler/simplStg/SimplStg.lhs index dbf6cb7a66..caf00a238f 100644 --- a/compiler/simplStg/SimplStg.lhs +++ b/compiler/simplStg/SimplStg.lhs @@ -16,7 +16,7 @@ import StgLint ( lintStgBindings ) import StgStats ( showStgStats ) import UnariseStg ( unarise ) -import DynFlags ( DynFlags(..), GeneralFlag(..), dopt, StgToDo(..), +import DynFlags ( DynFlags(..), GeneralFlag(..), gopt, StgToDo(..), getStgToDo ) import Module ( Module ) import ErrUtils @@ -56,7 +56,7 @@ stg2stg dflags module_name binds } where - stg_linter = if dopt Opt_DoStgLinting dflags + stg_linter = if gopt Opt_DoStgLinting dflags then lintStgBindings else ( \ _whodunnit binds -> binds ) diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs index 8d00f94ead..6993d029fc 100644 --- a/compiler/stgSyn/StgSyn.lhs +++ b/compiler/stgSyn/StgSyn.lhs @@ -800,7 +800,7 @@ pprStgRhs (StgRhsClosure cc bi [free_var] upd_flag srt [{-no args-}] (StgApp fun -- general case pprStgRhs (StgRhsClosure cc bi free_vars upd_flag srt args body) = sdocWithDynFlags $ \dflags -> - hang (hsep [if dopt Opt_SccProfilingOn dflags then ppr cc else empty, + hang (hsep [if gopt Opt_SccProfilingOn dflags then ppr cc else empty, pp_binder_info bi, ifPprDebug (brackets (interppSP free_vars)), char '\\' <> ppr upd_flag, pprMaybeSRT srt, brackets (interppSP args)]) diff --git a/compiler/typecheck/TcBinds.lhs b/compiler/typecheck/TcBinds.lhs index cd010ef03c..a63471011f 100644 --- a/compiler/typecheck/TcBinds.lhs +++ b/compiler/typecheck/TcBinds.lhs @@ -736,7 +736,7 @@ tcImpPrags prags -- code. The latter happens when Haddocking the base library; -- we don't wnat complaints about lack of INLINABLE pragmas not_specialising dflags - | not (dopt Opt_Specialise dflags) = True + | not (gopt Opt_Specialise dflags) = True | otherwise = case hscTarget dflags of HscNothing -> True HscInterpreted -> True diff --git a/compiler/typecheck/TcErrors.lhs b/compiler/typecheck/TcErrors.lhs index 4f0bfad561..74a687f409 100644 --- a/compiler/typecheck/TcErrors.lhs +++ b/compiler/typecheck/TcErrors.lhs @@ -102,7 +102,7 @@ errors (like (Eq a)). Often the latter are a knock-on effect of the former. reportUnsolved :: WantedConstraints -> TcM (Bag EvBind) reportUnsolved wanted = do { binds_var <- newTcEvBinds - ; defer <- doptM Opt_DeferTypeErrors + ; defer <- goptM Opt_DeferTypeErrors ; report_unsolved (Just binds_var) defer wanted ; getTcEvBinds binds_var } diff --git a/compiler/typecheck/TcPat.lhs b/compiler/typecheck/TcPat.lhs index a938285d92..5bc6e9b5ec 100644 --- a/compiler/typecheck/TcPat.lhs +++ b/compiler/typecheck/TcPat.lhs @@ -478,7 +478,7 @@ tc_pat penv (TuplePat pats boxity _) pat_ty thing_inside -- pat_ty /= pat_ty iff coi /= IdCo unmangled_result = TuplePat pats' boxity pat_ty' possibly_mangled_result - | dopt Opt_IrrefutableTuples dflags && + | gopt Opt_IrrefutableTuples dflags && isBoxed boxity = LazyPat (noLoc unmangled_result) | otherwise = unmangled_result diff --git a/compiler/typecheck/TcRnDriver.lhs b/compiler/typecheck/TcRnDriver.lhs index 6430c95862..3bc4d2de83 100644 --- a/compiler/typecheck/TcRnDriver.lhs +++ b/compiler/typecheck/TcRnDriver.lhs @@ -147,7 +147,7 @@ tcRnModule hsc_env hsc_src save_rn_syntax let { prel_imports = mkPrelImports (moduleName this_mod) prel_imp_loc implicit_prelude import_decls } ; - ifWOptM Opt_WarnImplicitPrelude $ + whenWOptM Opt_WarnImplicitPrelude $ when (notNull prel_imports) $ addWarn (implicitPreludeWarn) ; tcg_env <- {-# SCC "tcRnImports" #-} @@ -1351,7 +1351,7 @@ tcUserStmt (L loc (BodyStmt expr _ _ _)) -- naked expression. Deferring type errors here is unhelpful because the -- expression gets evaluated right away anyway. It also would potentially -- emit two redundant type-error warnings, one from each plan. - ; plan <- unsetDOptM Opt_DeferTypeErrors $ runPlans [ + ; plan <- unsetGOptM Opt_DeferTypeErrors $ runPlans [ -- Plan A do { stuff@([it_id], _) <- tcGhciStmts [bind_stmt, print_it] ; it_ty <- zonkTcType (idType it_id) @@ -1388,7 +1388,7 @@ tcUserStmt rdr_stmt@(L loc _) = L loc $ BindStmt pat (nlHsApp ghciStep expr) op1 op2 | otherwise = rn_stmt - ; opt_pr_flag <- doptM Opt_PrintBindResult + ; opt_pr_flag <- goptM Opt_PrintBindResult ; let print_result_plan | opt_pr_flag -- The flag says "print result" , [v] <- collectLStmtBinders gi_stmt -- One binder @@ -1779,7 +1779,7 @@ tcDump env = 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) + when (gopt Opt_D_dump_types dflags || gopt Opt_D_dump_tc dflags) (dumpTcRn short_dump) ; -- Dump bindings if -ddump-tc @@ -1794,7 +1794,7 @@ tcDump env tcCoreDump :: ModGuts -> TcM () tcCoreDump mod_guts = do { dflags <- getDynFlags ; - when (dopt Opt_D_dump_types dflags || dopt Opt_D_dump_tc dflags) + when (gopt Opt_D_dump_types dflags || gopt Opt_D_dump_tc dflags) (dumpTcRn (pprModGuts mod_guts)) ; -- Dump bindings if -ddump-tc diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index 379b5fb160..0ed698b2bc 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -263,8 +263,8 @@ Command-line flags xoptM :: ExtensionFlag -> TcRnIf gbl lcl Bool xoptM flag = do { dflags <- getDynFlags; return (xopt flag dflags) } -doptM :: GeneralFlag -> TcRnIf gbl lcl Bool -doptM flag = do { dflags <- getDynFlags; return (dopt flag dflags) } +goptM :: GeneralFlag -> TcRnIf gbl lcl Bool +goptM flag = do { dflags <- getDynFlags; return (gopt flag dflags) } woptM :: WarningFlag -> TcRnIf gbl lcl Bool woptM flag = do { dflags <- getDynFlags; return (wopt flag dflags) } @@ -273,26 +273,26 @@ setXOptM :: ExtensionFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a setXOptM flag = updEnv (\ env@(Env { env_top = top }) -> env { env_top = top { hsc_dflags = xopt_set (hsc_dflags top) flag}} ) -unsetDOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a -unsetDOptM flag = updEnv (\ env@(Env { env_top = top }) -> - env { env_top = top { hsc_dflags = dopt_unset (hsc_dflags top) flag}} ) +unsetGOptM :: GeneralFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a +unsetGOptM flag = updEnv (\ env@(Env { env_top = top }) -> + env { env_top = top { hsc_dflags = gopt_unset (hsc_dflags top) flag}} ) unsetWOptM :: WarningFlag -> TcRnIf gbl lcl a -> TcRnIf gbl lcl a unsetWOptM flag = updEnv (\ env@(Env { env_top = top }) -> env { env_top = top { hsc_dflags = wopt_unset (hsc_dflags top) flag}} ) -- | Do it flag is true -ifDOptM :: GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () -ifDOptM flag thing_inside = do b <- doptM flag - when b thing_inside +whenGOptM :: GeneralFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () +whenGOptM flag thing_inside = do b <- goptM flag + when b thing_inside -ifWOptM :: WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () -ifWOptM flag thing_inside = do b <- woptM flag - when b thing_inside +whenWOptM :: WarningFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () +whenWOptM flag thing_inside = do b <- woptM flag + when b thing_inside -ifXOptM :: ExtensionFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () -ifXOptM flag thing_inside = do b <- xoptM flag - when b thing_inside +whenXOptM :: ExtensionFlag -> TcRnIf gbl lcl () -> TcRnIf gbl lcl () +whenXOptM flag thing_inside = do b <- xoptM flag + when b thing_inside getGhcMode :: TcRnIf gbl lcl GhcMode getGhcMode = do { env <- getTopEnv; return (ghcMode (hsc_dflags env)) } @@ -438,13 +438,13 @@ traceHiDiffs = traceOptIf Opt_D_dump_hi_diffs traceOptIf :: GeneralFlag -> SDoc -> TcRnIf m n () -- No RdrEnv available, so qualify everything -traceOptIf flag doc = ifDOptM flag $ +traceOptIf flag doc = whenGOptM flag $ do dflags <- getDynFlags liftIO (printInfoForUser dflags alwaysQualify doc) traceOptTcRn :: GeneralFlag -> SDoc -> TcRn () -- Output the message, with current location if opt_PprStyle_Debug -traceOptTcRn flag doc = ifDOptM flag $ do +traceOptTcRn flag doc = whenGOptM flag $ do { loc <- getSrcSpanM ; let real_doc | opt_PprStyle_Debug = mkLocMessage SevInfo loc doc @@ -462,7 +462,7 @@ debugDumpTcRn doc | opt_NoDebugOutput = return () | otherwise = dumpTcRn doc dumpOptTcRn :: GeneralFlag -> SDoc -> TcRn () -dumpOptTcRn flag doc = ifDOptM flag (dumpTcRn doc) +dumpOptTcRn flag doc = whenGOptM flag (dumpTcRn doc) \end{code} @@ -654,7 +654,7 @@ reportWarning warn dumpDerivingInfo :: SDoc -> TcM () dumpDerivingInfo doc = do { dflags <- getDynFlags - ; when (dopt Opt_D_dump_deriv dflags) $ do + ; when (gopt Opt_D_dump_deriv dflags) $ do { rdr_env <- getGlobalRdrEnv ; let unqual = mkPrintUnqualified dflags rdr_env ; liftIO (putMsgWith dflags unqual doc) } } @@ -1262,7 +1262,7 @@ forkM_maybe doc thing_inside -- Bleat about errors in the forked thread, if -ddump-if-trace is on -- Otherwise we silently discard errors. Errors can legitimately -- happen when compiling interface signatures (see tcInterfaceSigs) - ifDOptM Opt_D_dump_if_trace $ do + whenGOptM Opt_D_dump_if_trace $ do dflags <- getDynFlags let msg = hang (text "forkM failed:" <+> doc) 2 (text (show exn)) diff --git a/compiler/typecheck/TcSMonad.lhs b/compiler/typecheck/TcSMonad.lhs index ba1a2cb397..81aa083e3d 100644 --- a/compiler/typecheck/TcSMonad.lhs +++ b/compiler/typecheck/TcSMonad.lhs @@ -1014,7 +1014,7 @@ traceFireTcS :: Ct -> SDoc -> TcS () -- Dump a rule-firing trace traceFireTcS ct doc = TcS $ \env -> - TcM.ifDOptM Opt_D_dump_cs_trace $ + TcM.whenGOptM Opt_D_dump_cs_trace $ do { n <- TcM.readTcRef (tcs_count env) ; let msg = int n <> brackets (int (ctLocDepth (cc_loc ct))) <+> doc ; TcM.dumpTcRn msg } diff --git a/compiler/typecheck/TcSplice.lhs b/compiler/typecheck/TcSplice.lhs index c5f0af3ff1..c5e09a3afa 100644 --- a/compiler/typecheck/TcSplice.lhs +++ b/compiler/typecheck/TcSplice.lhs @@ -497,7 +497,7 @@ tcTopSpliceExpr :: TcM (LHsExpr Id) -> TcM (LHsExpr Id) tcTopSpliceExpr tc_action = checkNoErrs $ -- checkNoErrs: must not try to run the thing -- if the type checker fails! - unsetDOptM Opt_DeferTypeErrors $ + unsetGOptM Opt_DeferTypeErrors $ -- Don't defer type errors. Not only are we -- going to run this code, but we do an unsafe -- coerce, so we get a seg-fault if, say we diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 4d5e7d5937..bbd0c93e6b 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1183,7 +1183,7 @@ conRepresentibleWithH98Syntax chooseBoxingStrategy :: DynFlags -> TcType -> HsBang -> HsBang chooseBoxingStrategy dflags arg_ty bang = case initial_choice of - HsUnpack | dopt Opt_OmitInterfacePragmas dflags + HsUnpack | gopt Opt_OmitInterfacePragmas dflags -> HsStrict _other -> initial_choice -- Do not respect UNPACK pragmas if OmitInterfacePragmas is on @@ -1195,7 +1195,7 @@ chooseBoxingStrategy dflags arg_ty bang where initial_choice = case bang of HsNoBang -> HsNoBang - HsStrict | dopt Opt_UnboxStrictFields dflags + HsStrict | gopt Opt_UnboxStrictFields dflags -> can_unbox HsStrict arg_ty | otherwise -> HsStrict HsNoUnpack -> HsStrict diff --git a/compiler/typecheck/TcUnify.lhs b/compiler/typecheck/TcUnify.lhs index 781d4c8cd1..88b8544181 100644 --- a/compiler/typecheck/TcUnify.lhs +++ b/compiler/typecheck/TcUnify.lhs @@ -531,7 +531,7 @@ uType_defer origin ty1 ty2 -- Error trace only -- NB. do *not* call mkErrInfo unless tracing is on, because -- it is hugely expensive (#5631) - ; ifDOptM Opt_D_dump_tc_trace $ do + ; whenGOptM Opt_D_dump_tc_trace $ do { ctxt <- getErrCtxt ; doc <- mkErrInfo emptyTidyEnv ctxt ; traceTc "utype_defer" (vcat [ppr eqv, ppr ty1, diff --git a/compiler/vectorise/Vectorise/Exp.hs b/compiler/vectorise/Vectorise/Exp.hs index 527cbfcb4d..20fade521b 100644 --- a/compiler/vectorise/Vectorise/Exp.hs +++ b/compiler/vectorise/Vectorise/Exp.hs @@ -47,7 +47,7 @@ import Control.Monad import Control.Applicative import Data.Maybe import Data.List -import TcRnMonad (doptM) +import TcRnMonad (goptM) import DynFlags import Util @@ -65,7 +65,7 @@ vectPolyExpr :: Bool -> [Var] -> CoreExprWithFVs -> Maybe VITree -- precompute vectorisation avoidance information (and possibly encapsulated subexpressions) vectPolyExpr loop_breaker recFns expr Nothing = do - { vectAvoidance <- liftDs $ doptM Opt_AvoidVect + { vectAvoidance <- liftDs $ goptM Opt_AvoidVect ; vi <- vectAvoidInfo expr ; (expr', vi') <- if vectAvoidance diff --git a/compiler/vectorise/Vectorise/Monad/Base.hs b/compiler/vectorise/Vectorise/Monad/Base.hs index 1765c8aef7..177b078a95 100644 --- a/compiler/vectorise/Vectorise/Monad/Base.hs +++ b/compiler/vectorise/Vectorise/Monad/Base.hs @@ -132,7 +132,7 @@ traceVt herald doc -- dumpOptVt :: GeneralFlag -> String -> SDoc -> VM () dumpOptVt flag header doc - = do { b <- liftDs $ doptM flag + = do { b <- liftDs $ goptM flag ; if b then dumpVt header doc else return () |