diff options
Diffstat (limited to 'compiler/GHC/Core/Op/DmdAnal.hs')
| -rw-r--r-- | compiler/GHC/Core/Op/DmdAnal.hs | 9 |
1 files changed, 2 insertions, 7 deletions
diff --git a/compiler/GHC/Core/Op/DmdAnal.hs b/compiler/GHC/Core/Op/DmdAnal.hs index 57544519d3..eb9f277f8a 100644 --- a/compiler/GHC/Core/Op/DmdAnal.hs +++ b/compiler/GHC/Core/Op/DmdAnal.hs @@ -603,7 +603,7 @@ dmdAnalRhsLetDown rec_flag env let_dmd id rhs -- TODO: Won't the following line unnecessarily trim down arity for join -- points returning a lambda in a C(S) context? sig = mkStrictSigForArity rhs_arity (mkDmdType sig_fv rhs_dmds rhs_div) - id' = set_idStrictness env id sig + id' = setIdStrictness id sig -- See Note [NOINLINE and strictness] @@ -1171,8 +1171,7 @@ findBndrDmd :: AnalEnv -> Bool -> DmdType -> Id -> (DmdType, Demand) findBndrDmd env arg_of_dfun dmd_ty id = (dmd_ty', dmd') where - dmd' = killUsageDemand (ae_dflags env) $ - strictify $ + dmd' = strictify $ trimToType starting_dmd (findTypeShape fam_envs id_ty) (dmd_ty', starting_dmd) = peelFV dmd_ty id @@ -1191,10 +1190,6 @@ findBndrDmd env arg_of_dfun dmd_ty id fam_envs = ae_fam_envs env -set_idStrictness :: AnalEnv -> Id -> StrictSig -> Id -set_idStrictness env id sig - = setIdStrictness id (killUsageSig (ae_dflags env) sig) - {- Note [Initialising strictness] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ See section 9.2 (Finding fixpoints) of the paper. |