Remove getDOptsSmpl; use getDynFlags instead
authorIan Lynagh <igloo@earth.li>
Thu, 19 Jan 2012 13:35:27 +0000 (13:35 +0000)
committerIan Lynagh <igloo@earth.li>
Thu, 19 Jan 2012 13:36:02 +0000 (13:36 +0000)
compiler/simplCore/SimplMonad.lhs
compiler/simplCore/SimplUtils.lhs
compiler/simplCore/Simplify.lhs

index 647da72..e025e6c 100644 (file)
@@ -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))
index 86dc88d..ad6fe54 100644 (file)
@@ -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, 
index 4d1717f..900d70c 100644 (file)
@@ -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