- (arity, guidance) = calcUnfoldingGuidance opt_UF_CreationThreshold expr
- -- Sometimes during simplification, there's a large let-bound thing
- -- which has been substituted, and so is now dead; so 'expr' contains
- -- two copies of the thing while the occurrence-analysed expression doesn't
- -- Nevertheless, we *don't* occ-analyse before computing the size because the
- -- size computation bales out after a while, whereas occurrence analysis does not.
- --
- -- This can occasionally mean that the guidance is very pessimistic;
- -- it gets fixed up next round. And it should be rare, because large
- -- let-bound things that are dead are usually caught by preInlineUnconditionally
+ (tvs, theta, head_ty) = tcSplitSigmaTy dfun_ty
+ -- NB: tcSplitSigmaTy: do not look through a newtype
+ -- when the dictionary type is a newtype
+ (cls, _) = tcSplitDFunHead head_ty
+ dfun_nargs = length tvs + length theta
+ data_con = classDataCon cls
+
+mkWwInlineRule :: Id -> CoreExpr -> Arity -> Unfolding
+mkWwInlineRule id expr arity
+ = mkCoreUnfolding True (InlineWrapper id)
+ (simpleOptExpr expr) arity
+ (UnfWhen unSaturatedOk boringCxtNotOk)
+
+mkCompulsoryUnfolding :: CoreExpr -> Unfolding
+mkCompulsoryUnfolding expr -- Used for things that absolutely must be unfolded
+ = mkCoreUnfolding True InlineCompulsory
+ expr 0 -- Arity of unfolding doesn't matter
+ (UnfWhen unSaturatedOk boringCxtOk)
+
+mkInlineUnfolding :: Maybe Arity -> CoreExpr -> Unfolding
+mkInlineUnfolding mb_arity expr
+ = mkCoreUnfolding True -- Note [Top-level flag on inline rules]
+ InlineStable
+ expr' arity
+ (UnfWhen unsat_ok boring_ok)
+ where
+ expr' = simpleOptExpr expr
+ (unsat_ok, arity) = case mb_arity of
+ Nothing -> (unSaturatedOk, manifestArity expr')
+ Just ar -> (needSaturated, ar)
+
+ boring_ok = case calcUnfoldingGuidance True -- Treat as cheap
+ False -- But not bottoming
+ (arity+1) expr' of
+ (_, UnfWhen _ boring_ok) -> boring_ok
+ _other -> boringCxtNotOk
+ -- See Note [INLINE for small functions]
+
+mkInlinableUnfolding :: CoreExpr -> Unfolding
+mkInlinableUnfolding expr
+ = mkUnfolding InlineStable True is_bot expr
+ where
+ is_bot = isJust (exprBotStrictness_maybe expr)
+\end{code}