diff options
Diffstat (limited to 'compiler/GHC/Core/Opt')
| -rw-r--r-- | compiler/GHC/Core/Opt/ConstantFold.hs | 2 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Simplify/Utils.hs | 11 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/Specialise.hs | 26 |
3 files changed, 20 insertions, 19 deletions
diff --git a/compiler/GHC/Core/Opt/ConstantFold.hs b/compiler/GHC/Core/Opt/ConstantFold.hs index 3d36368d5b..7ace3124e9 100644 --- a/compiler/GHC/Core/Opt/ConstantFold.hs +++ b/compiler/GHC/Core/Opt/ConstantFold.hs @@ -2402,7 +2402,7 @@ match_cstring_foldr_lit _ _ _ _ _ = Nothing -- Also, look into variable's unfolding just in case the expression we look for -- is in a top-level thunk. stripStrTopTicks :: InScopeEnv -> CoreExpr -> ([CoreTickish], CoreExpr) -stripStrTopTicks (_,id_unf) e = case e of +stripStrTopTicks (ISE _ id_unf) e = case e of Var v | Just rhs <- expandUnfolding_maybe (id_unf v) -> stripTicksTop tickishFloatable rhs diff --git a/compiler/GHC/Core/Opt/Simplify/Utils.hs b/compiler/GHC/Core/Opt/Simplify/Utils.hs index 28b1ebc221..19daab0075 100644 --- a/compiler/GHC/Core/Opt/Simplify/Utils.hs +++ b/compiler/GHC/Core/Opt/Simplify/Utils.hs @@ -1241,14 +1241,13 @@ getUnfoldingInRuleMatch :: SimplEnv -> InScopeEnv -- is 'otherwise' which we want exprIsConApp_maybe to be able to -- see very early on getUnfoldingInRuleMatch env - = (in_scope, id_unf) + = ISE in_scope id_unf where in_scope = seInScope env - id_unf id | unf_is_active id = idUnfolding id - | otherwise = NoUnfolding - unf_is_active id = isActive (sePhase env) (idInlineActivation id) - -- When sm_rules was off we used to test for a /stable/ unfolding, - -- but that seems wrong (#20941) + phase = sePhase env + id_unf = whenActiveUnfoldingFun (isActive phase) + -- When sm_rules was off we used to test for a /stable/ unfolding, + -- but that seems wrong (#20941) ---------------------- activeRule :: SimplMode -> Activation -> Bool diff --git a/compiler/GHC/Core/Opt/Specialise.hs b/compiler/GHC/Core/Opt/Specialise.hs index fa9323ab3b..13bff9f170 100644 --- a/compiler/GHC/Core/Opt/Specialise.hs +++ b/compiler/GHC/Core/Opt/Specialise.hs @@ -1626,11 +1626,11 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- See Note [Inline specialisations] for why we do not -- switch off specialisation for inline functions - = do { -- debugTraceMsg (text "specCalls: some" <+> vcat - -- [ text "function" <+> ppr fn - -- , text "calls:" <+> ppr calls_for_me - -- , text "subst" <+> ppr (se_subst env) ]) - ; foldlM spec_call ([], [], emptyUDs) calls_for_me } + = -- pprTrace "specCalls: some" (vcat + -- [ text "function" <+> ppr fn + -- , text "calls:" <+> ppr calls_for_me + -- , text "subst" <+> ppr (se_subst env) ]) $ + foldlM spec_call ([], [], emptyUDs) calls_for_me | otherwise -- No calls or RHS doesn't fit our preconceptions = warnPprTrace (not (exprIsTrivial rhs) && notNull calls_for_me && not (isClassOpId fn)) @@ -1685,7 +1685,7 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs , rule_bndrs, rule_lhs_args , spec_bndrs1, dx_binds, spec_args) <- specHeader env rhs_bndrs all_call_args --- ; debugTraceMsg (text "spec_call" <+> vcat +-- ; pprTrace "spec_call" (vcat -- [ text "fun: " <+> ppr fn -- , text "call info: " <+> ppr _ci -- , text "useful: " <+> ppr useful @@ -1698,7 +1698,8 @@ specCalls spec_imp env existing_rules calls_for_me fn rhs -- , text "rhs_bndrs" <+> ppr rhs_bndrs -- , text "rhs_body" <+> ppr rhs_body -- , text "rhs_env2: " <+> ppr (se_subst rhs_env2) --- , ppr dx_binds ] +-- , ppr dx_binds ]) $ +-- return () ; if not useful -- No useful specialisation || already_covered rhs_env2 rules_acc rule_lhs_args @@ -1795,12 +1796,13 @@ specLookupRule :: SpecEnv -> Id -> [CoreExpr] -> CompilerPhase -- Look up rules as if we were in this phase -> [CoreRule] -> Maybe (CoreRule, CoreExpr) specLookupRule env fn args phase rules - = lookupRule ropts (in_scope, realIdUnfolding) is_active fn args rules + = lookupRule ropts in_scope_env is_active fn args rules where - dflags = se_dflags env - in_scope = getSubstInScope (se_subst env) - ropts = initRuleOpts dflags - is_active = isActive phase + dflags = se_dflags env + in_scope = getSubstInScope (se_subst env) + in_scope_env = ISE in_scope (whenActiveUnfoldingFun is_active) + ropts = initRuleOpts dflags + is_active = isActive phase {- Note [Specialising DFuns] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |