import CoreLint ( endPass )
import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
+import FamInstEnv
import Id ( Id, modifyIdInfo, idInfo, isExportedId, isLocalId,
idSpecialisation, idName )
import VarSet
; us <- mkSplitUniqSupply 's'
- ; let (expr', _counts) = initSmpl dflags us $
+ ; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
simplExprGently gentleSimplEnv expr
; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
}
gentleSimplEnv :: SimplEnv
-gentleSimplEnv = mkSimplEnv SimplGently
- (isAmongSimpl [])
- emptyRuleBase
+gentleSimplEnv = mkSimplEnv SimplGently (isAmongSimpl [])
doCorePasses :: HscEnv
-> RuleBase -- the imported main rule base
doCorePasses hsc_env rb us stats guts []
= return (stats, guts)
+doCorePasses hsc_env rb us stats guts (CoreDoPasses to_dos1 : to_dos2)
+ = doCorePasses hsc_env rb us stats guts (to_dos1 ++ to_dos2)
+
doCorePasses hsc_env rb us stats guts (to_do : to_dos)
= do
let (us1, us2) = splitUniqSupply us
(stats1, guts1) <- doCorePass to_do hsc_env us1 rb guts
doCorePasses hsc_env rb us2 (stats `plusSimplCount` stats1) guts1 to_dos
+doCorePass :: CoreToDo -> HscEnv -> UniqSupply -> RuleBase
+ -> ModGuts -> IO (SimplCount, ModGuts)
doCorePass (CoreDoSimplify mode sws) = _scc_ "Simplify" simplifyPgm mode sws
doCorePass CoreCSE = _scc_ "CommonSubExpr" trBinds cseProgram
doCorePass CoreLiberateCase = _scc_ "LiberateCase" liberateCase
#else
doCorePass CoreDoOldStrictness = panic "CoreDoOldStrictness"
#endif
+doCorePass (CoreDoPasses _) = panic "CoreDoPasses"
#ifdef OLD_STRICTNESS
doOldStrictness dfs binds
-- from the local binders, to avoid warnings from Simplify.simplVar
local_ids = mkInScopeSet (mkVarSet (bindersOfBinds binds))
env = setInScopeSet gentleSimplEnv local_ids
- (better_rules,_) = initSmpl dflags us (mapSmpl (simplRule env) local_rules)
+ (better_rules,_) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
+ (mapSmpl (simplRule env) local_rules)
home_pkg_rules = hptRules hsc_env (dep_mods deps)
-- Find the rules for locally-defined Ids; then we can attach them
-- miss the rules for Ids hidden inside imported inlinings
eps <- hscEPS hsc_env ;
let { rule_base' = unionRuleBase imp_rule_base (eps_rule_base eps)
- ; simpl_env = mkSimplEnv mode sw_chkr rule_base' } ;
+ ; simpl_env = mkSimplEnv mode sw_chkr
+ ; simpl_binds = _scc_ "SimplTopBinds"
+ simplTopBinds simpl_env tagged_binds
+ ; fam_envs = (eps_fam_inst_env eps, mg_fam_inst_env guts) } ;
-- Simplify the program
-- We do this with a *case* not a *let* because lazy pattern
-- case t of {(_,counts') -> if counts'=0 then ... }
-- So the conditional didn't force counts', because the
-- selection got duplicated. Sigh!
- case initSmpl dflags us1 (_scc_ "SimplTopBinds" simplTopBinds simpl_env tagged_binds) of {
+ case initSmpl dflags rule_base' fam_envs us1 simpl_binds of {
(binds', counts') -> do {
let { all_counts = counts `plusSimplCount` counts'