+\begin{code}
+okToInline :: SwitchChecker
+ -> InScopeEnv
+ -> Id -- The Id
+ -> FormSummary -- The thing is WHNF or bottom;
+ -> UnfoldingGuidance
+ -> SimplCont
+ -> Bool -- True <=> inline it
+
+-- A non-WHNF can be inlined if it doesn't occur inside a lambda,
+-- and occurs exactly once or
+-- occurs once in each branch of a case and is small
+--
+-- If the thing is in WHNF, there's no danger of duplicating work,
+-- so we can inline if it occurs once, or is small
+
+okToInline sw_chkr in_scope id form guidance cont
+ =
+#ifdef DEBUG
+ if opt_D_dump_inlinings then
+ pprTrace "Considering inlining"
+ (ppr id <+> vcat [text "inline prag:" <+> ppr inline_prag,
+ text "whnf" <+> ppr whnf,
+ text "small enough" <+> ppr small_enough,
+ text "some benefit" <+> ppr some_benefit,
+ text "arg evals" <+> ppr arg_evals,
+ text "result scrut" <+> ppr result_scrut,
+ text "ANSWER =" <+> if result then text "YES" else text "NO"])
+ result
+ else
+#endif
+ result
+ where
+ result =
+ case inline_prag of
+ IAmDead -> pprTrace "okToInline: dead" (ppr id) False
+ IAmASpecPragmaId -> False
+ IMustNotBeINLINEd -> False
+ IAmALoopBreaker -> False
+ IMustBeINLINEd -> True -- If "essential_unfoldings_only" is true we do no inlinings at all,
+ -- EXCEPT for things that absolutely have to be done
+ -- (see comments with idMustBeINLINEd)
+ IWantToBeINLINEd -> inlinings_enabled
+ ICanSafelyBeINLINEd inside_lam one_branch
+ -> inlinings_enabled && (unfold_always || consider_single inside_lam one_branch)
+ NoInlinePragInfo -> inlinings_enabled && (unfold_always || consider_multi)
+
+ inlinings_enabled = not (switchIsOn sw_chkr EssentialUnfoldingsOnly)
+ unfold_always = unfoldAlways guidance
+
+ -- Consider benefit for ICanSafelyBeINLINEd
+ consider_single inside_lam one_branch
+ = (small_enough || one_branch) && some_benefit && (whnf || not_inside_lam)
+ where
+ not_inside_lam = case inside_lam of {InsideLam -> False; other -> True}
+
+ -- Consider benefit for NoInlinePragInfo
+ consider_multi = whnf && small_enough && some_benefit
+ -- We could consider using exprIsCheap here,
+ -- as in postInlineUnconditionally, but unlike the latter we wouldn't
+ -- necessarily eliminate a thunk; and the "form" doesn't tell
+ -- us that.
+
+ inline_prag = getInlinePragma id
+ whnf = whnfOrBottom form
+ small_enough = smallEnoughToInline id arg_evals result_scrut guidance
+ (arg_evals, result_scrut) = get_evals cont
+
+ -- some_benefit checks that *something* interesting happens to
+ -- the variable after it's inlined.
+ some_benefit = contIsInteresting cont
+
+ -- Finding out whether the args are evaluated. This isn't completely easy
+ -- because the args are not yet simplified, so we have to peek into them.
+ get_evals (ApplyTo _ arg (te,ve) cont)
+ | isValArg arg = case get_evals cont of
+ (args, res) -> (get_arg_eval arg ve : args, res)
+ | otherwise = get_evals cont
+
+ get_evals (Select _ _ _ _ _) = ([], True)
+ get_evals other = ([], False)
+
+ get_arg_eval (Con con _) ve = isWHNFCon con
+ get_arg_eval (Var v) ve = case lookupVarEnv ve v of
+ Just (SubstMe e' _ ve') -> get_arg_eval e' ve'
+ Just (Done (Con con _)) -> isWHNFCon con
+ Just (Done (Var v')) -> get_var_eval v'
+ Just (Done other) -> False
+ Nothing -> get_var_eval v
+ get_arg_eval other ve = False
+
+ get_var_eval v = case lookupVarSet in_scope v of
+ Just v' -> isEvaldUnfolding (getIdUnfolding v')
+ Nothing -> isEvaldUnfolding (getIdUnfolding v)
+
+
+contIsInteresting :: SimplCont -> Bool
+contIsInteresting Stop = False
+contIsInteresting (ArgOf _ _ _) = False
+contIsInteresting (ApplyTo _ (Type _) _ cont) = contIsInteresting cont
+contIsInteresting (CoerceIt _ _ _ cont) = contIsInteresting cont
+
+-- See notes below on why a case with only a DEFAULT case is not intersting
+-- contIsInteresting (Select _ _ [(DEFAULT,_,_)] _ _) = False
+
+contIsInteresting _ = True
+\end{code}