diff options
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Env.hs | 9 | ||||
| -rw-r--r-- | compiler/GHC/Core/Unfold/Make.hs | 6 |
2 files changed, 9 insertions, 6 deletions
diff --git a/compiler/GHC/Core/Opt/Simplify/Env.hs b/compiler/GHC/Core/Opt/Simplify/Env.hs index 6d325d02bb..54a5f171ec 100644 --- a/compiler/GHC/Core/Opt/Simplify/Env.hs +++ b/compiler/GHC/Core/Opt/Simplify/Env.hs @@ -576,10 +576,13 @@ addLetFloats :: SimplFloats -> LetFloats -> SimplFloats -- Add the let-floats for env2 to env1; -- *plus* the in-scope set for env2, which is bigger -- than that for env1 -addLetFloats floats let_floats@(LetFloats binds _) +addLetFloats floats let_floats = floats { sfLetFloats = sfLetFloats floats `addLetFlts` let_floats - , sfInScope = foldlOL extendInScopeSetBind - (sfInScope floats) binds } + , sfInScope = sfInScope floats `extendInScopeFromLF` let_floats } + +extendInScopeFromLF :: InScopeSet -> LetFloats -> InScopeSet +extendInScopeFromLF in_scope (LetFloats binds _) + = foldlOL extendInScopeSetBind in_scope binds addJoinFloats :: SimplFloats -> JoinFloats -> SimplFloats addJoinFloats floats join_floats diff --git a/compiler/GHC/Core/Unfold/Make.hs b/compiler/GHC/Core/Unfold/Make.hs index 378d5a6131..71981061ef 100644 --- a/compiler/GHC/Core/Unfold/Make.hs +++ b/compiler/GHC/Core/Unfold/Make.hs @@ -169,14 +169,14 @@ specUnfolding opts spec_bndrs spec_app rule_lhs_args , uf_is_top = top_lvl , uf_guidance = old_guidance }) | isStableSource src -- See Note [Specialising unfoldings] - , UnfWhen { ug_arity = old_arity } <- old_guidance + , UnfWhen { ug_arity = old_arity } <- old_guidance = mkCoreUnfolding src top_lvl new_tmpl (old_guidance { ug_arity = old_arity - arity_decrease }) where new_tmpl = simpleOptExpr opts $ - mkLams spec_bndrs $ + mkLams spec_bndrs $ spec_app tmpl -- The beta-redexes created by spec_app - -- will besimplified away by simplOptExpr + -- will be simplified away by simplOptExpr arity_decrease = count isValArg rule_lhs_args - count isId spec_bndrs |