import Id
import TcType
import CoreSubst
-import CoreUnfold ( mkUnfolding )
+import CoreUnfold ( mkUnfolding, mkInlineRule )
import VarSet
import VarEnv
import CoreSyn
where
fn_type = idType fn
fn_arity = idArity fn
+ fn_unf = idUnfolding fn
(tyvars, theta, _) = tcSplitSigmaTy fn_type
n_tyvars = length tyvars
n_dicts = length theta
inline_act = idInlineActivation fn
- (body_uds_without_me, calls_for_me) = callsForMe fn body_uds
+ -- Figure out whether the function has an INLINE pragma
+ -- See Note [Inline specialisations]
+ fn_has_inline_rule :: Maybe InlSatFlag -- 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
- -- It's important that we "see past" any INLINE pragma
- -- else we'll fail to specialise an INLINE thing
- (inline_rhs, rhs_inside) = dropInline rhs
- (rhs_tyvars, rhs_ids, rhs_body) = collectTyAndValBinders rhs_inside
+ (rhs_tyvars, rhs_ids, rhs_body) = collectTyAndValBinders rhs
+
+ (body_uds_without_me, calls_for_me) = callsForMe fn body_uds
rhs_dict_ids = take n_dicts rhs_ids
body = mkLams (drop n_dicts rhs_ids) rhs_body
-- Add the { d1' = dx1; d2' = dx2 } usage stuff
final_uds = foldr consDictBind rhs_uds dx_binds
- spec_pr | inline_rhs = (spec_f_w_arity `setInlineActivation` inline_act, Note InlineMe spec_rhs)
- | otherwise = (spec_f_w_arity, spec_rhs)
-
- ; return (Just (spec_pr, final_uds, spec_env_rule)) } }
+ -- See Note [Inline specialisations]
+ final_spec_f | Just sat <- fn_has_inline_rule
+ = spec_f_w_arity `setInlineActivation` inline_act
+ `setIdUnfolding` mkInlineRule sat spec_rhs spec_arity
+ -- I'm not sure this should be unconditionally InlSat
+ | otherwise
+ = spec_f_w_arity
+ ; return (Just ((final_spec_f, spec_rhs), final_uds, spec_env_rule)) } }
where
my_zipEqual xs ys zs
| debugIsOn && not (equalLength xs ys && equalLength ys zs)
A case in point is dictionary functions, which are current marked
INLINE, but which are worth specialising.
-\begin{code}
-dropInline :: CoreExpr -> (Bool, CoreExpr)
-dropInline (Note InlineMe rhs) = (True, rhs)
-dropInline rhs = (False, rhs)
-\end{code}
%************************************************************************
%* *