import Id ( Id, idName, idType, mkUserLocal, idCoreRules,
idInlinePragma, setInlinePragma, setIdUnfolding,
- isLocalId, idUnfolding )
+ isLocalId )
import TcType ( Type, mkTyVarTy, tcSplitSigmaTy,
tyVarsOfTypes, tyVarsOfTheta, isClassPred,
tcCmpType, isUnLiftedType
cloneIdBndr, cloneIdBndrs, cloneRecIdBndrs,
extendIdSubst
)
-import CoreUnfold ( mkUnfolding, mkInlineRule )
+import CoreUnfold ( mkUnfolding )
import SimplUtils ( interestingArg )
import Var ( DictId )
import VarSet
import MkId ( voidArgId, realWorldPrimId )
import FiniteMap
import Maybes ( catMaybes, isJust )
-import BasicTypes ( Arity )
import Bag
import Util
import Outputable
n_dicts = length theta
inline_prag = idInlinePragma fn
- -- Figure out whether the function has an INLINE pragma
- -- See Note [Inline specialisations]
- fn_has_inline_rule :: Maybe Arity -- Gives arity of the *specialised* inline rule
- fn_has_inline_rule = case idUnfolding fn of
- InlineRule { uf_arity = arity } -> Just (arity - n_dicts)
- _other -> Nothing
-
- (rhs_tyvars, rhs_ids, rhs_body) = collectTyAndValBinders rhs
+ -- 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_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 addDictBind rhs_uds dx_binds
- -- See Note [Inline specialisations]
- final_spec_f | Just spec_arity <- fn_has_inline_rule
- = spec_f `setInlinePragma` inline_prag
- `setIdUnfolding` mkInlineRule spec_rhs spec_arity
- | otherwise
- = spec_f
- ; return (Just ((final_spec_f, spec_rhs), final_uds, spec_env_rule)) } }
+ spec_pr | inline_rhs = (spec_f `setInlinePragma` inline_prag, Note InlineMe spec_rhs)
+ | otherwise = (spec_f, spec_rhs)
+
+ ; return (Just (spec_pr, 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}
%************************************************************************
%* *