diff options
author | Ian Lynagh <igloo@earth.li> | 2012-01-19 13:35:27 +0000 |
---|---|---|
committer | Ian Lynagh <igloo@earth.li> | 2012-01-19 13:36:02 +0000 |
commit | 10300ecbab43e9f3411b6aa5fe02e713fb253d05 (patch) | |
tree | 11d20bde530adf09b1c54c66e8e39ca7fa4177ee | |
parent | 3bc62f5cb52ff40bbd9b1d898f98b3ee973256ca (diff) | |
download | haskell-10300ecbab43e9f3411b6aa5fe02e713fb253d05.tar.gz |
Remove getDOptsSmpl; use getDynFlags instead
-rw-r--r-- | compiler/simplCore/SimplMonad.lhs | 8 | ||||
-rw-r--r-- | compiler/simplCore/SimplUtils.lhs | 4 | ||||
-rw-r--r-- | compiler/simplCore/Simplify.lhs | 8 |
3 files changed, 10 insertions, 10 deletions
diff --git a/compiler/simplCore/SimplMonad.lhs b/compiler/simplCore/SimplMonad.lhs index 647da72d16..e025e6cb34 100644 --- a/compiler/simplCore/SimplMonad.lhs +++ b/compiler/simplCore/SimplMonad.lhs @@ -15,7 +15,7 @@ module SimplMonad ( -- The monad SimplM, initSmpl, - getDOptsSmpl, getSimplRules, getFamEnvs, + getSimplRules, getFamEnvs, -- Unique supply MonadUnique(..), newId, @@ -31,7 +31,7 @@ import Type ( Type ) import FamInstEnv ( FamInstEnv ) import Rules ( RuleBase ) import UniqSupply -import DynFlags ( DynFlags( simplTickFactor ) ) +import DynFlags import CoreMonad import Outputable import FastString @@ -148,8 +148,8 @@ instance MonadUnique SimplM where = SM (\_st_env us sc -> case splitUniqSupply us of (us1, us2) -> (uniqsFromSupply us1, us2, sc)) -getDOptsSmpl :: SimplM DynFlags -getDOptsSmpl = SM (\st_env us sc -> (st_flags st_env, us, sc)) +instance HasDynFlags SimplM where + getDynFlags = SM (\st_env us sc -> (st_flags st_env, us, sc)) getSimplRules :: SimplM RuleBase getSimplRules = SM (\st_env us sc -> (st_rules st_env, us, sc)) diff --git a/compiler/simplCore/SimplUtils.lhs b/compiler/simplCore/SimplUtils.lhs index 86dc88ddd1..ad6fe5488b 100644 --- a/compiler/simplCore/SimplUtils.lhs +++ b/compiler/simplCore/SimplUtils.lhs @@ -1054,7 +1054,7 @@ mkLam :: SimplEnv -> [OutBndr] -> OutExpr -> SimplM OutExpr mkLam _b [] body = return body mkLam _env bndrs body - = do { dflags <- getDOptsSmpl + = do { dflags <- getDynFlags ; mkLam' dflags bndrs body } where mkLam' :: DynFlags -> [OutBndr] -> OutExpr -> SimplM OutExpr @@ -1125,7 +1125,7 @@ because the latter is not well-kinded. tryEtaExpand :: SimplEnv -> OutId -> OutExpr -> SimplM (Arity, OutExpr) -- See Note [Eta-expanding at let bindings] tryEtaExpand env bndr rhs - = do { dflags <- getDOptsSmpl + = do { dflags <- getDynFlags ; (new_arity, new_rhs) <- try_expand dflags ; WARN( new_arity < old_arity || new_arity < _dmd_arity, diff --git a/compiler/simplCore/Simplify.lhs b/compiler/simplCore/Simplify.lhs index 4d1717f4ea..900d70c7de 100644 --- a/compiler/simplCore/Simplify.lhs +++ b/compiler/simplCore/Simplify.lhs @@ -221,7 +221,7 @@ simplTopBinds env0 binds0 -- It's rather as if the top-level binders were imported. -- See note [Glomming] in OccurAnal. ; env1 <- simplRecBndrs env0 (bindersOfBinds binds0) - ; dflags <- getDOptsSmpl + ; dflags <- getDynFlags ; let dump_flag = dopt Opt_D_verbose_core2core dflags ; env2 <- simpl_binds dump_flag env1 binds0 ; freeTick SimplifierDone @@ -1383,7 +1383,7 @@ simplIdF env var cont completeCall :: SimplEnv -> Id -> SimplCont -> SimplM (SimplEnv, OutExpr) completeCall env var cont = do { ------------- Try inlining ---------------- - dflags <- getDOptsSmpl + dflags <- getDynFlags ; let (lone_variable, arg_infos, call_cont) = contArgs cont -- The args are OutExprs, obtained by *lazily* substituting -- in the args found in cont. These args are only examined @@ -1559,7 +1559,7 @@ tryRules env rules fn args call_cont Just (rule, rule_rhs) -> do { checkedTick (RuleFired (ru_name rule)) - ; dflags <- getDOptsSmpl + ; dflags <- getDynFlags ; trace_dump dflags rule rule_rhs $ return (Just (ruleArity rule, rule_rhs)) }}} where @@ -1835,7 +1835,7 @@ reallyRebuildCase env scrut case_bndr alts cont -- Check for empty alternatives ; if null alts' then missingAlt env case_bndr alts cont else do - { dflags <- getDOptsSmpl + { dflags <- getDynFlags ; case_expr <- mkCase dflags scrut' case_bndr' alts' -- Notice that rebuild gets the in-scope set from env', not alt_env |