simpl_bind env (Rec pairs) = simplRecBind env TopLevel pairs
simpl_bind env (NonRec b r) = simplRecOrTopPair env' TopLevel b b' r
where
- (env', b') = addLetIdInfo env b (lookupRecBndr env b)
+ (env', b') = addBndrRules env b (lookupRecBndr env b)
\end{code}
-> [(InId, InExpr)]
-> SimplM SimplEnv
simplRecBind env top_lvl pairs
- = do { let (env_with_info, triples) = mapAccumL add_info env pairs
+ = do { let (env_with_info, triples) = mapAccumL add_rules env pairs
; env' <- go (zapFloats env_with_info) triples
; return (env `addRecFloats` env') }
-- addFloats adds the floats from env',
-- *and* updates env with the in-scope set from env'
where
- add_info :: SimplEnv -> (InBndr,InExpr) -> (SimplEnv, (InBndr, OutBndr, InExpr))
- -- Substitute in IdInfo, agument envt
- add_info env (bndr, rhs) = (env, (bndr, bndr', rhs))
+ add_rules :: SimplEnv -> (InBndr,InExpr) -> (SimplEnv, (InBndr, OutBndr, InExpr))
+ -- Add the (substituted) rules to the binder
+ add_rules env (bndr, rhs) = (env', (bndr, bndr', rhs))
where
- (env', bndr') = addLetIdInfo env bndr (lookupRecBndr env bndr)
+ (env', bndr') = addBndrRules env bndr (lookupRecBndr env bndr)
go env [] = return env
-- (for example) be no longer strictly demanded.
-- The solution here is a bit ad hoc...
info_w_unf = new_bndr_info `setUnfoldingInfo` unfolding
+ `setWorkerInfo` worker_info
+
final_info | loop_breaker = new_bndr_info
| isEvaldUnfolding unfolding = zapDemandInfo info_w_unf `orElse` info_w_unf
| otherwise = info_w_unf
return (addNonRec env final_id new_rhs)
where
unfolding = mkUnfolding (isTopLevel top_lvl) new_rhs
+ worker_info = substWorker env (workerInfo old_info)
loop_breaker = isNonRuleLoopBreaker occ_info
old_info = idInfo old_bndr
occ_info = occInfo old_info
| otherwise
= do { (env1, bndr1) <- simplNonRecBndr env bndr
- ; let (env2, bndr2) = addLetIdInfo env1 bndr bndr1
+ ; let (env2, bndr2) = addBndrRules env1 bndr bndr1
; env3 <- simplLazyBind env2 NotTopLevel NonRecursive bndr bndr2 rhs rhs_se
; simplLam env3 bndrs body cont }
\end{code}
------------- Next try inlining ----------------
{ let arg_infos = [interestingArg arg | arg <- args, isValArg arg]
n_val_args = length arg_infos
- interesting_cont = interestingCallContext (notNull args)
- (notNull arg_infos)
- call_cont
+ interesting_cont = interestingCallContext call_cont
active_inline = activeInline env var
- maybe_inline = callSiteInline dflags active_inline
- var arg_infos interesting_cont
+ maybe_inline = callSiteInline dflags active_inline var
+ (null args) arg_infos interesting_cont
; case maybe_inline of {
Just unfolding -- There is an inlining!
-> do { tick (UnfoldingDone var)
-- See Note [no-case-of-case]
= (env, case_bndr)
- | otherwise -- Failed try [see Note 2 above]
+ | otherwise -- Failed try; see Note [Suppressing the case binder-swap]
-- not (isEvaldUnfolding (idUnfolding v))
= case scrut of
Var v -> (modifyInScope env1 v case_bndr', case_bndr')
do { let alt_env = zapFloats env
; (alt_env, scrut', case_bndr') <- simplCaseBinder alt_env scrut case_bndr alts
- ; (imposs_deflt_cons, in_alts) <- prepareAlts scrut case_bndr' alts
+ ; (imposs_deflt_cons, in_alts) <- prepareAlts alt_env scrut case_bndr' alts
; alts' <- mapM (simplAlt alt_env imposs_deflt_cons case_bndr' cont') in_alts
; return (scrut', case_bndr', alts') }