+ | otherwise
+ = return (addNonRecWithUnf env new_bndr new_rhs unfolding wkr)
+ where
+ unfolding | omit_unfolding = NoUnfolding
+ | otherwise = mkUnfolding (isTopLevel top_lvl) new_rhs
+ old_info = idInfo old_bndr
+ occ_info = occInfo old_info
+ wkr = substWorker env (workerInfo old_info)
+ omit_unfolding = isNonRuleLoopBreaker occ_info
+ -- or not (activeInline env old_bndr)
+ -- Do *not* trim the unfolding in SimplGently, else
+ -- the specialiser can't see it!
+
+-----------------
+addPolyBind :: TopLevelFlag -> SimplEnv -> OutBind -> SimplEnv
+-- Add a new binding to the environment, complete with its unfolding
+-- but *do not* do postInlineUnconditionally, because we have already
+-- processed some of the scope of the binding
+-- We still want the unfolding though. Consider
+-- let
+-- x = /\a. let y = ... in Just y
+-- in body
+-- Then we float the y-binding out (via abstractFloats and addPolyBind)
+-- but 'x' may well then be inlined in 'body' in which case we'd like the
+-- opportunity to inline 'y' too.
+
+addPolyBind top_lvl env (NonRec poly_id rhs)
+ = addNonRecWithUnf env poly_id rhs unfolding NoWorker
+ where
+ unfolding | not (activeInline env poly_id) = NoUnfolding
+ | otherwise = mkUnfolding (isTopLevel top_lvl) rhs
+ -- addNonRecWithInfo adds the new binding in the
+ -- proper way (ie complete with unfolding etc),
+ -- and extends the in-scope set
+
+addPolyBind _ env bind@(Rec _) = extendFloats env bind
+ -- Hack: letrecs are more awkward, so we extend "by steam"
+ -- without adding unfoldings etc. At worst this leads to
+ -- more simplifier iterations
+
+-----------------
+addNonRecWithUnf :: SimplEnv
+ -> OutId -> OutExpr -- New binder and RHS
+ -> Unfolding -> WorkerInfo -- and unfolding
+ -> SimplEnv
+-- Add suitable IdInfo to the Id, add the binding to the floats, and extend the in-scope set
+addNonRecWithUnf env new_bndr rhs unfolding wkr
+ = ASSERT( isId new_bndr )
+ WARN( new_arity < old_arity || new_arity < dmd_arity,
+ (ptext (sLit "Arity decrease:") <+> ppr final_id <+> ppr old_arity
+ <+> ppr new_arity <+> ppr dmd_arity) $$ ppr rhs )
+ -- Note [Arity decrease]
+ final_id `seq` -- This seq forces the Id, and hence its IdInfo,
+ -- and hence any inner substitutions
+ addNonRec env final_id rhs
+ -- The addNonRec adds it to the in-scope set too
+ where
+ dmd_arity = length $ fst $ splitStrictSig $ idNewStrictness new_bndr
+ old_arity = idArity new_bndr
+