-- Inlining,
preInlineUnconditionally, postInlineUnconditionally,
- activeInline, activeRule,
+ activeInline, activeRule, inlineMode,
-- The continuation type
SimplCont(..), DupFlag(..), ArgInfo(..),
contIsDupable, contResultType, contIsTrivial, contArgs, dropArgs,
- countValArgs, countArgs,
+ countValArgs, countArgs, splitInlineCont,
mkBoringStop, mkLazyArgStop, contIsRhsOrArg,
interestingCallContext, interestingArgContext,
import PprCore
import CoreFVs
import CoreUtils
+import CoreArity ( etaExpand, exprEtaExpandArity )
import CoreUnfold
import Name
import Id
dropArgs 0 cont = cont
dropArgs n (ApplyTo _ _ _ cont) = dropArgs (n-1) cont
dropArgs n other = pprPanic "dropArgs" (ppr n <+> ppr other)
+
+--------------------
+splitInlineCont :: SimplCont -> Maybe (SimplCont, SimplCont)
+-- Returns Nothing if the continuation should dissolve an InlineMe Note
+-- Return Just (c1,c2) otherwise,
+-- where c1 is the continuation to put inside the InlineMe
+-- and c2 outside
+
+-- Example: (__inline_me__ (/\a. e)) ty
+-- Here we want to do the beta-redex without dissolving the InlineMe
+-- See test simpl017 (and Trac #1627) for a good example of why this is important
+
+splitInlineCont (ApplyTo dup (Type ty) se c)
+ | Just (c1, c2) <- splitInlineCont c = Just (ApplyTo dup (Type ty) se c1, c2)
+splitInlineCont cont@(Stop {}) = Just (mkBoringStop, cont)
+splitInlineCont cont@(StrictBind {}) = Just (mkBoringStop, cont)
+splitInlineCont _ = Nothing
+ -- NB: we dissolve an InlineMe in any strict context,
+ -- not just function aplication.
+ -- E.g. foldr k z (__inline_me (case x of p -> build ...))
+ -- Here we want to get rid of the __inline_me__ so we
+ -- can float the case, and see foldr/build
+ --
+ -- However *not* in a strict RHS, else we get
+ -- let f = __inline_me__ (\x. e) in ...f...
+ -- Now if f is guaranteed to be called, hence a strict binding
+ -- we don't thereby want to dissolve the __inline_me__; for
+ -- example, 'f' might be a wrapper, so we'd inline the worker
\end{code}
vanilla_discounts, arg_discounts :: [Int]
vanilla_discounts = repeat 0
arg_discounts = case idUnfolding fun of
- CoreUnfolding {uf_guidance = UnfoldIfGoodArgs {ug_args = discounts}}
+ CoreUnfolding _ _ _ _ (UnfoldIfGoodArgs _ discounts _ _)
-> discounts ++ vanilla_discounts
_ -> vanilla_discounts
INLINE pragmas
~~~~~~~~~~~~~~
-We don't simplify inside InlineRules (which come from INLINE pragmas).
+SimplGently is also used as the mode to simplify inside an InlineMe note.
+
+\begin{code}
+inlineMode :: SimplifierMode
+inlineMode = SimplGently
+\end{code}
+
It really is important to switch off inlinings inside such
expressions. Consider the following example
%************************************************************************
\begin{code}
-mkLam :: [OutBndr] -> OutExpr -> SimplM OutExpr
+mkLam :: SimplEnv -> [OutBndr] -> OutExpr -> SimplM OutExpr
-- mkLam tries three things
-- a) eta reduction, if that gives a trivial expression
-- b) eta expansion [only if there are some value lambdas]
-mkLam [] body
+mkLam _b [] body
= return body
-mkLam bndrs body
+mkLam _env bndrs body
= do { dflags <- getDOptsSmpl
; mkLam' dflags bndrs body }
where
| dopt Opt_DoLambdaEtaExpansion dflags,
any isRuntimeVar bndrs
- = do { body' <- tryEtaExpansion dflags body
+ = do { let body' = tryEtaExpansion dflags body
; return (mkLams bndrs body') }
| otherwise
actually computing the expansion.
\begin{code}
-tryEtaExpansion :: DynFlags -> OutExpr -> SimplM OutExpr
+tryEtaExpansion :: DynFlags -> OutExpr -> OutExpr
-- There is at least one runtime binder in the binders
-tryEtaExpansion dflags body = do
- us <- getUniquesM
- return (etaExpand fun_arity us body (exprType body))
+tryEtaExpansion dflags body
+ = etaExpand fun_arity body
where
fun_arity = exprEtaExpandArity dflags body
\end{code}