summaryrefslogtreecommitdiff
path: root/compiler/coreSyn
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/coreSyn')
-rw-r--r--compiler/coreSyn/CoreUnfold.hs14
-rw-r--r--compiler/coreSyn/CoreUtils.hs4
2 files changed, 12 insertions, 6 deletions
diff --git a/compiler/coreSyn/CoreUnfold.hs b/compiler/coreSyn/CoreUnfold.hs
index 8853b8592b..bf082518c9 100644
--- a/compiler/coreSyn/CoreUnfold.hs
+++ b/compiler/coreSyn/CoreUnfold.hs
@@ -1120,11 +1120,12 @@ certainlyWillInline :: DynFlags -> IdInfo -> Maybe Unfolding
-- ^ Sees if the unfolding is pretty certain to inline.
-- If so, return a *stable* unfolding for it, that will always inline.
certainlyWillInline dflags fn_info
- = case unfoldingInfo fn_info of
- CoreUnfolding { uf_tmpl = e, uf_guidance = g }
- | loop_breaker -> Nothing -- Won't inline, so try w/w
- | noinline -> Nothing -- See Note [Worker-wrapper for NOINLINE functions]
- | otherwise -> do_cunf e g -- Depends on size, so look at that
+ = case fn_unf of
+ CoreUnfolding { uf_tmpl = e, uf_guidance = g, uf_src = src }
+ | loop_breaker -> Nothing -- Won't inline, so try w/w
+ | noinline -> Nothing -- See Note [Worker-wrapper for NOINLINE functions]
+ | compulsory src -> Just fn_unf
+ | otherwise -> do_cunf e g -- Depends on size, so look at that
DFunUnfolding {} -> Just fn_unf -- Don't w/w DFuns; it never makes sense
-- to do so, and even if it is currently a
@@ -1137,6 +1138,9 @@ certainlyWillInline dflags fn_info
noinline = inlinePragmaSpec (inlinePragInfo fn_info) == InlSpecNoInline
fn_unf = unfoldingInfo fn_info
+ compulsory InlineCompulsory = True
+ compulsory _ = False
+
do_cunf :: CoreExpr -> UnfoldingGuidance -> Maybe Unfolding
do_cunf _ UnfNever = Nothing
do_cunf _ (UnfWhen {}) = Just (fn_unf { uf_src = InlineStable })
diff --git a/compiler/coreSyn/CoreUtils.hs b/compiler/coreSyn/CoreUtils.hs
index 1ca5a6b438..342ad414f9 100644
--- a/compiler/coreSyn/CoreUtils.hs
+++ b/compiler/coreSyn/CoreUtils.hs
@@ -495,7 +495,9 @@ bindNonRec bndr rhs body
-- | Tests whether we have to use a @case@ rather than @let@ binding for this expression
-- as per the invariants of 'CoreExpr': see "CoreSyn#let_app_invariant"
needsCaseBinding :: Type -> CoreExpr -> Bool
-needsCaseBinding ty rhs = isUnliftedType ty && not (exprOkForSpeculation rhs)
+needsCaseBinding ty rhs
+ = not (isLiftedType_maybe ty `orElse` True)
+ && not (exprOkForSpeculation rhs)
-- Make a case expression instead of a let
-- These can arise either from the desugarer,
-- or from beta reductions: (\x.e) (x +# y)