module WorkWrap ( wwTopBinds, mkWrapper ) where
import CoreSyn
-import CoreUnfold ( certainlyWillInline )
-import CoreUtils ( exprType, exprIsHNF, mkInlineMe )
+import CoreUnfold ( certainlyWillInline, mkInlineRule, mkWwInlineRule )
+import CoreUtils ( exprType, exprIsHNF )
import CoreArity ( exprArity )
import Var
-import Id ( Id, idType, isOneShotLambda, idUnfolding,
- setIdNewStrictness, mkWorkerId,
- setIdWorkerInfo, setInlineActivation,
- setIdArity, idInfo )
+import Id ( idType, isOneShotLambda, idUnfolding,
+ setIdStrictness, mkWorkerId,
+ setInlineActivation, setIdUnfolding,
+ setIdArity )
import Type ( Type )
import IdInfo
-import NewDemand ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..),
+import Demand ( Demand(..), StrictSig(..), DmdType(..), DmdResult(..),
Demands(..), mkTopDmdType, isBotRes, returnsCPR, topSig, isAbsent
)
import UniqSupply
\begin{code}
wwExpr :: CoreExpr -> UniqSM CoreExpr
-wwExpr e@(Type {}) = return e
-wwExpr e@(Lit {}) = return e
-wwExpr e@(Var {}) = return e
-wwExpr e@(Note InlineMe _) = return e
- -- Don't w/w inside InlineMe's
+wwExpr e@(Type {}) = return e
+wwExpr e@(Lit {}) = return e
+wwExpr e@(Var {}) = return e
wwExpr (Lam binder expr)
= Lam binder <$> wwExpr expr
Note [Don't w/w inline things (a)]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
It's very important to refrain from w/w-ing an INLINE function
-If we do so by mistake we transform
+because the wrapper will then overwrite the InlineRule unfolding.
+
+It was wrong with the old InlineMe Note too: if we do so by mistake
+we transform
f = __inline (\x -> E)
into
f = __inline (\x -> case x of (a,b) -> fw E)
where
fn_info = idInfo fn_id
- maybe_fn_dmd = newDemandInfo fn_info
+ maybe_fn_dmd = demandInfo fn_info
inline_act = inlinePragmaActivation (inlinePragInfo fn_info)
-- In practice it always will have a strictness
-- signature, even if it's a uninformative one
- strict_sig = newStrictnessInfo fn_info `orElse` topSig
+ strict_sig = strictnessInfo fn_info `orElse` topSig
StrictSig (DmdType env wrap_dmds res_info) = strict_sig
-- new_fn_id has the DmdEnv zapped.
-- (c) it becomes incorrect as things are cloned, because
-- we don't push the substitution into it
new_fn_id | isEmptyVarEnv env = fn_id
- | otherwise = fn_id `setIdNewStrictness`
+ | otherwise = fn_id `setIdStrictness`
StrictSig (mkTopDmdType wrap_dmds res_info)
is_fun = notNull wrap_dmds
is_thunk = not is_fun && not (exprIsHNF rhs)
---------------------
-checkSize :: Id -> CoreExpr -> UniqSM [(Id,CoreExpr)] -> UniqSM [(Id,CoreExpr)]
+checkSize :: Id -> CoreExpr
+ -> UniqSM [(Id,CoreExpr)] -> UniqSM [(Id,CoreExpr)]
-- See Note [Don't w/w inline things (a) and (b)]
checkSize fn_id rhs thing_inside
- | certainlyWillInline unfolding = return [ (fn_id, mkInlineMe rhs) ]
+ | isStableUnfolding unfolding -- For DFuns and INLINE things, leave their
+ = return [ (fn_id, rhs) ] -- unfolding unchanged; but still attach
+ -- strictness info to the Id
+
+ | certainlyWillInline unfolding
+ = return [ (fn_id `setIdUnfolding` inline_rule, rhs) ]
-- Note [Don't w/w inline things (b)]
+
| otherwise = thing_inside
where
unfolding = idUnfolding fn_id
+ inline_rule = mkInlineRule unSaturatedOk rhs (unfoldingArity unfolding)
---------------------
splitFun :: Id -> IdInfo -> [Demand] -> DmdResult -> Activation -> Expr Var
-- can't think of a compelling reason. (In ptic, INLINE things are
-- not w/wd). However, the RuleMatchInfo is not transferred since
-- it does not make sense for workers to be constructorlike.
- `setIdNewStrictness` StrictSig (mkTopDmdType work_demands work_res_info)
+ `setIdStrictness` StrictSig (mkTopDmdType work_demands work_res_info)
-- Even though we may not be at top level,
-- it's ok to give it an empty DmdEnv
`setIdArity` (exprArity work_rhs)
-- arity is consistent with the demand type goes through
wrap_rhs = wrap_fn work_id
- wrap_id = fn_id `setIdWorkerInfo` HasWorker work_id arity
+ wrap_id = fn_id `setIdUnfolding` mkWwInlineRule work_id wrap_rhs arity
; return ([(work_id, work_rhs), (wrap_id, wrap_rhs)]) })
-- Worker first, because wrapper mentions it