import MkId ( voidArgId, realWorldPrimId )
import FiniteMap
import Maybes ( catMaybes, isJust )
-import BasicTypes ( Arity )
import Bag
import Util
import Outputable
where
fn_type = idType fn
fn_arity = idArity fn
- fn_unf = idUnfolding fn
+ fn_unf = realIdUnfolding fn -- Ignore loop-breaker-ness here
(tyvars, theta, _) = tcSplitSigmaTy fn_type
n_tyvars = length tyvars
n_dicts = length theta
-- Figure out whether the function has an INLINE pragma
-- See Note [Inline specialisations]
- fn_has_inline_rule :: Maybe (InlineRuleInfo, Arity) -- Gives arity of the *specialised* inline rule
- fn_has_inline_rule
- | Just inl <- isInlineRule_maybe fn_unf
- = case inl of
- InlWrapper _ -> Just (InlUnSat, spec_arity)
- _ -> Just (inl, spec_arity)
- | otherwise = Nothing
- where
- spec_arity = unfoldingArity fn_unf - n_dicts
+ fn_has_inline_rule :: Maybe Bool -- Derive sat-flag from existing thing
+ fn_has_inline_rule = case isInlineRule_maybe fn_unf of
+ Just (_,sat) -> Just sat
+ Nothing -> Nothing
+
+ spec_arity = unfoldingArity fn_unf - n_dicts -- Arity of the *specialised* inline rule
(rhs_tyvars, rhs_ids, rhs_body) = collectTyAndValBinders rhs
already_covered :: [CoreExpr] -> Bool
already_covered args -- Note [Specialisations already covered]
- = isJust (lookupRule (const True) (substInScope subst)
+ = isJust (lookupRule (const True) realIdUnfolding
+ (substInScope subst)
fn args (idCoreRules fn))
mk_ty_args :: [Maybe Type] -> [CoreExpr]
final_uds = foldr consDictBind rhs_uds dx_binds
-- See Note [Inline specialisations]
- final_spec_f | Just (inl, spec_arity) <- fn_has_inline_rule
+ final_spec_f | Just sat <- fn_has_inline_rule
= spec_f_w_arity `setInlineActivation` inline_act
- `setIdUnfolding` mkInlineRule inl spec_rhs spec_arity
+ `setIdUnfolding` mkInlineRule sat spec_rhs spec_arity
-- I'm not sure this should be unconditionally InlSat
| otherwise
= spec_f_w_arity
-- No auxiliary binding necessary
| otherwise = go subst_w_unf (NonRec dx_id dx : binds) pairs
where
- dx_id1 = dx_id `setIdUnfolding` mkUnfolding False dx
+ dx_id1 = dx_id `setIdUnfolding` mkUnfolding False False dx
subst_w_unf = extendIdSubst subst d (Var dx_id1)
-- Important! We're going to substitute dx_id1 for d
-- and we want it to look "interesting", else we won't gather *any*