diff options
author | Adam Gundry <adam@well-typed.com> | 2015-10-16 13:58:52 +0100 |
---|---|---|
committer | Adam Gundry <adam@well-typed.com> | 2015-10-16 13:58:52 +0100 |
commit | 5a1b4f814f74ec1c48152d97523744518e212777 (patch) | |
tree | 7c2207ecacbd37f12c78dbcf9d4334827164e0fb /compiler/simplCore/Simplify.hs | |
parent | 6757950cdd8bb0af0355539987ee78401a6a8f6b (diff) | |
parent | 808bbdf08058785ae5bc59b5b4f2b04951d4cbbf (diff) | |
download | haskell-wip/orf-reboot.tar.gz |
Merge remote-tracking branch 'origin/master' into wip/orf-rebootwip/orf-reboot
Conflicts:
compiler/rename/RnNames.hs
compiler/typecheck/TcRnMonad.hs
utils/haddock
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' |