diff options
Diffstat (limited to 'compiler/simplCore/Simplify.hs')
| -rw-r--r-- | compiler/simplCore/Simplify.hs | 18 |
1 files changed, 8 insertions, 10 deletions
diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 07bc0041a1..2c73f8e119 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -36,7 +36,7 @@ import CoreUnfold import CoreUtils import CoreArity --import PrimOp ( tagToEnumKey ) -- temporalily commented out. See #8326 -import Rules ( mkSpecInfo, lookupRule, getRules ) +import Rules ( mkRuleInfo, lookupRule, getRules ) import TysPrim ( voidPrimTy ) --, intPrimTy ) -- temporalily commented out. See #8326 import BasicTypes ( TopLevelFlag(..), isTopLevel, RecFlag(..) ) import MonadUtils ( foldlM, mapAccumLM, liftIO ) @@ -2957,10 +2957,10 @@ addBndrRules env in_id out_id = return (env, out_id) | otherwise = do { new_rules <- simplRules env (Just (idName out_id)) old_rules - ; let final_id = out_id `setIdSpecialisation` mkSpecInfo new_rules + ; let final_id = out_id `setIdSpecialisation` mkRuleInfo new_rules ; return (modifyInScope env final_id, final_id) } where - old_rules = specInfoRules (idSpecialisation in_id) + old_rules = ruleInfoRules (idSpecialisation in_id) simplRules :: SimplEnv -> Maybe Name -> [CoreRule] -> SimplM [CoreRule] simplRules env mb_new_nm rules @@ -2970,13 +2970,11 @@ simplRules env mb_new_nm rules = return rule simpl_rule rule@(Rule { ru_bndrs = bndrs, ru_args = args - , ru_fn = fn_name, ru_rhs = rhs - , ru_act = act }) - = do { (env, bndrs') <- simplBinders env bndrs - ; let lhs_env = updMode updModeForRuleLHS env - rhs_env = updMode (updModeForStableUnfoldings act) env - ; args' <- mapM (simplExpr lhs_env) args - ; rhs' <- simplExpr rhs_env rhs + , ru_fn = fn_name, ru_rhs = rhs }) + = do { (env', bndrs') <- simplBinders env bndrs + ; let rule_env = updMode updModeForRules env' + ; args' <- mapM (simplExpr rule_env) args + ; rhs' <- simplExpr rule_env rhs ; return (rule { ru_bndrs = bndrs' , ru_fn = mb_new_nm `orElse` fn_name , ru_args = args' |