diff options
Diffstat (limited to 'compiler/simplCore')
| -rw-r--r-- | compiler/simplCore/CoreMonad.lhs | 10 | ||||
| -rw-r--r-- | compiler/simplCore/SimplCore.lhs | 30 | ||||
| -rw-r--r-- | compiler/simplCore/SimplUtils.lhs | 10 | ||||
| -rw-r--r-- | compiler/simplCore/Simplify.lhs | 10 |
4 files changed, 30 insertions, 30 deletions
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) |