import CoreSubst
import MkCore
import CoreUtils
+import CoreArity ( etaExpand )
import CoreUnfold
import CoreFVs
------------------------
makeCorePair :: Id-> Arity -> CoreExpr -> (Id, CoreExpr)
makeCorePair gbl_id arity rhs
- = (addInline gbl_id arity rhs, rhs)
+ | isInlinePragma (idInlinePragma gbl_id)
+ -- Add an Unfolding for an INLINE (but not for NOINLINE)
+ -- And eta-expand the RHS; see Note [Eta-expanding INLINE things]
+ = (gbl_id `setIdUnfolding` mkInlineRule needSaturated rhs arity,
+ etaExpand arity rhs)
+ | otherwise
+ = (gbl_id, rhs)
------------------------
type AbsBindEnv = VarEnv ([TyVar], Id, Id, [LSpecPrag])
lookupArity :: IdEnv Arity -> Id -> Arity
lookupArity ar_env id = lookupVarEnv ar_env id `orElse` 0
-
-addInline :: Id -> Arity -> CoreExpr -> Id
-addInline id arity rhs
- | isInlinePragma (idInlinePragma id)
- -- Add an Unfolding for an INLINE (but not for NOINLINE)
- = id `setIdUnfolding` mkInlineRule InlSat rhs arity
- | otherwise
- = id
\end{code}
-Nested arities
-~~~~~~~~~~~~~~
+Note [Eta-expanding INLINE things]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider
+ foo :: Eq a => a -> a
+ {-# INLINE foo #-}
+ foo x = ...
+
+If (foo d) ever gets floated out as a common sub-expression (which can
+happen as a result of method sharing), there's a danger that we never
+get to do the inlining, which is a Terribly Bad thing given that the
+user said "inline"!
+
+To avoid this we pre-emptively eta-expand the definition, so that foo
+has the arity with which it is declared in the source code. In this
+example it has arity 2 (one for the Eq and one for x). Doing this
+should mean that (foo d) is a PAP and we don't share it.
+
+Note [Nested arities]
+~~~~~~~~~~~~~~~~~~~~~
For reasons that are not entirely clear, method bindings come out looking like
this:
-> DsM ( [(Id,CoreExpr)] -- Binding for specialised Ids
, [CoreRule] ) -- Rules for the Global Ids
-- Example:
--- f :: (Eq a, Ix b) => a -> b -> b
--- {-# SPECIALISE f :: Ix b => Int -> b -> b #-}
+-- f :: (Eq a, Ix b) => a -> b -> Bool
+-- {-# SPECIALISE f :: (Ix p, Ix q) => Int -> (p,q) -> Bool #-}
--
-- AbsBinds [ab] [d1,d2] [([ab], f, f_mono, prags)] binds
--
--- SpecPrag (/\b.\(d:Ix b). f Int b dInt d)
--- (forall b. Ix b => Int -> b -> b)
+-- SpecPrag /\pq.\(dp:Ix p, dq:Ix q). f Int (p,q) dInt ($dfIxPair dp dq)
+-- :: forall p q. (Ix p, Ix q) => Int -> (p,q) -> Bool
--
--- Rule: forall b,(d:Ix b). f Int b dInt d = f_spec b d
+--
+-- Rule: forall p,q,(dp:Ix p),(dq:Ix q).
+-- f Int (p,q) dInt ($dfInPair dp dq) = f_spec p q dp dq
--
-- Spec bind: f_spec = Let f = /\ab \(d1:Eq a)(d2:Ix b). let binds in f_mono
--- /\b.\(d:Ix b). in f Int b dInt d
+-- /\pq.\(dp:Ix p, dq:Ix q). f Int (p,q) dInt ($dfIxPair dp dq)
-- The idea is that f occurs just once, so it'll be
-- inlined and specialised
--
--- Given SpecPrag (/\as.\ds. f es) t, we have
+-- Note that the LHS of the rule may mention dictionary *expressions*
+-- (eg $dfIxPair dp dq), and that is essential because
+-- the dp, dq are needed on the RHS.
+--
+-- In general, given SpecPrag (/\as.\ds. f es) t, we have
-- the defn f_spec as ds = let-nonrec f = /\fas\fds. let f_mono = <f-rhs> in f_mono
-- in f es
-- and the RULE forall as, ds. f es = f_spec as ds
bs | not (null bs) -> do { warnDs (dead_msg bs); return Nothing }
| otherwise -> do
- { (spec_unf, unf_pairs) <- specUnfolding wrap_fn (idUnfolding poly_id)
+ { (spec_unf, unf_pairs) <- specUnfolding wrap_fn (realIdUnfolding poly_id)
; let f_body = fix_up (Let mono_bind (Var mono_id))
spec_ty = exprType ds_spec_expr
spec_id_arity = inl_arity + count isDictId bndrs
extra_dict_bndrs = [ localiseId d -- See Note [Constant rule dicts]
- | d <- varSetElems (exprFreeVars ds_spec_expr)
- , isDictId d]
+ | d <- varSetElems (exprFreeVars ds_spec_expr)
+ , isDictId d]
-- Note [Const rule dicts]
rule = mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr poly_name)))