import IdInfo
import CoreUtils ( coreBindsSize )
import Simplify ( simplTopBinds, simplExpr )
-import SimplUtils ( simplEnvForGHCi )
+import SimplUtils ( simplEnvForGHCi, activeRule )
import SimplEnv
import SimplMonad
import CoreMonad
doCorePass CoreDoSpecConstr = {-# SCC "SpecConstr" #-}
specConstrProgram
-doCorePass (CoreDoVectorisation be) = {-# SCC "Vectorise" #-}
- vectorise be
+doCorePass CoreDoVectorisation = {-# SCC "Vectorise" #-}
+ vectorise
doCorePass CoreDoGlomBinds = doPassDM glomBinds
doCorePass CoreDoPrintCore = observe printCore
; us <- mkSplitUniqSupply 's'
; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
- simplExprGently simplEnvForGHCi expr
+ simplExprGently (simplEnvForGHCi dflags) expr
; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
(pprCoreExpr expr')
-> ModGuts
-> IO (SimplCount, ModGuts) -- New bindings
-simplifyPgmIO pass@(CoreDoSimplify mode max_iterations switches)
+simplifyPgmIO pass@(CoreDoSimplify max_iterations mode)
hsc_env us hpt_rule_base
guts@(ModGuts { mg_binds = binds, mg_rules = rules
, mg_fam_inst_env = fam_inst_env })
; return (counts_out, guts')
}
where
- dflags = hsc_dflags hsc_env
- dump_phase = dumpSimplPhase dflags mode
- sw_chkr = isAmongSimpl switches
+ dflags = hsc_dflags hsc_env
+ dump_phase = dumpSimplPhase dflags mode
+ simpl_env = mkSimplEnv mode
+ active_rule = activeRule dflags simpl_env
+
do_iteration :: UniqSupply
-> Int -- Counts iterations
-> [SimplCount] -- Counts from earlier iterations, reversed
| let sz = coreBindsSize binds in sz == sz
= do {
-- Occurrence analysis
- let { tagged_binds = {-# SCC "OccAnal" #-} occurAnalysePgm binds rules } ;
+ let { tagged_binds = {-# SCC "OccAnal" #-}
+ occurAnalysePgm active_rule rules binds } ;
Err.dumpIfSet_dyn dflags Opt_D_dump_occur_anal "Occurrence analysis"
(pprCoreBindings tagged_binds);
eps <- hscEPS hsc_env ;
let { rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps)
; rule_base2 = extendRuleBaseList rule_base1 rules
- ; simpl_env = mkSimplEnv sw_chkr mode
; simpl_binds = {-# SCC "SimplTopBinds" #-}
simplTopBinds simpl_env tagged_binds
; fam_envs = (eps_fam_inst_env eps, fam_inst_env) } ;