Fix bug in mkIdWithNewUniq
idInfo = info}
mkIdWithNewUniq :: Id -> Unique -> Id
idInfo = info}
mkIdWithNewUniq :: Id -> Unique -> Id
-mkIdWithNewUniq id uniq = id {idUnique = uniq}
+mkIdWithNewUniq id uniq = id {idUnique = uniq, idName = changeUnique (idName id) uniq}
mkIdWithNewName :: Id -> Name -> Id
mkIdWithNewName id new_name
mkIdWithNewName :: Id -> Name -> Id
mkIdWithNewName id new_name
addIdDemandInfo :: Id -> DemandInfo -> Id
addIdDemandInfo id@(Id {idInfo = info}) demand_info
= id {idInfo = demand_info `setDemandInfo` info}
addIdDemandInfo :: Id -> DemandInfo -> Id
addIdDemandInfo id@(Id {idInfo = info}) demand_info
= id {idInfo = demand_info `setDemandInfo` info}
\begin{code}
getIdUpdateInfo :: Id -> UpdateInfo
\begin{code}
getIdUpdateInfo :: Id -> UpdateInfo
uNFOLDING_DEAR_OP_COST,
uNFOLDING_NOREP_LIT_COST
)
uNFOLDING_DEAR_OP_COST,
uNFOLDING_NOREP_LIT_COST
)
-import BinderInfo ( BinderInfo, isOneSameSCCFunOcc,
+import BinderInfo ( BinderInfo, isOneSameSCCFunOcc, isDeadOcc,
isInlinableOcc, isOneSafeFunOcc
)
import CoreSyn
isInlinableOcc, isOneSafeFunOcc
)
import CoreSyn
| idWantsToBeINLINEd id = True
| idMustNotBeINLINEd id = False
| idWantsToBeINLINEd id = True
| idMustNotBeINLINEd id = False
-okToInline id whnf small binder_info = isInlinableOcc whnf small binder_info
+okToInline id whnf small binder_info
+#ifdef DEBUG
+ | isDeadOcc binder_info
+ = pprTrace "okToInline: dead" (ppr id) False
+ | otherwise
+#endif
+ = isInlinableOcc whnf small binder_info
info_from_this_case rhs_c
= simplBinder env binder `thenSmpl` \ (env1, binder') ->
let
info_from_this_case rhs_c
= simplBinder env binder `thenSmpl` \ (env1, binder') ->
let
- env2 = extendEnvGivenUnfolding env1 binder' occ_info info_from_this_case
+ env2 = extendEnvGivenNewRhs env1 scrut_var (Var binder')
-- Add form details for the default binder
-- Add form details for the default binder
- scrut_info = lookupUnfolding env scrut_var
- env3 = extendEnvGivenUnfolding env2 binder' occ_info scrut_info
- new_env = extendEnvGivenNewRhs env3 scrut_var (Var binder')
+ scrut_unf = lookupUnfolding env scrut_var
+ new_env = extendEnvGivenUnfolding env2 binder' noBinderInfo scrut_unf
+ -- Use noBinderInfo rather than occ_info because we've
+ -- added more occurrences by binding the scrut_var to it
in
rhs_c new_env rhs `thenSmpl` \ rhs' ->
returnSmpl (BindDefault binder' rhs')
in
rhs_c new_env rhs `thenSmpl` \ rhs' ->
returnSmpl (BindDefault binder' rhs')
out_id occ_info rhs_info
= SimplEnv chkr encl_cc ty_env (new_in_scope_ids, id_subst) con_apps
where
out_id occ_info rhs_info
= SimplEnv chkr encl_cc ty_env (new_in_scope_ids, id_subst) con_apps
where
- new_in_scope_ids = addToUFM_C modifyOutEnvItem in_scope_ids out_id
- (out_id, occ_info, rhs_info)
+ new_in_scope_ids = addToUFM in_scope_ids out_id (out_id, occ_info, rhs_info)