diff options
Diffstat (limited to 'compiler/GHC/Core/Opt')
| -rw-r--r-- | compiler/GHC/Core/Opt/DmdAnal.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Core/Opt/WorkWrap.hs | 6 |
2 files changed, 10 insertions, 2 deletions
diff --git a/compiler/GHC/Core/Opt/DmdAnal.hs b/compiler/GHC/Core/Opt/DmdAnal.hs index ece13d894b..cf76563e3a 100644 --- a/compiler/GHC/Core/Opt/DmdAnal.hs +++ b/compiler/GHC/Core/Opt/DmdAnal.hs @@ -1940,6 +1940,12 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs -- vcat [text "function:" <+> ppr fn -- , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs)) -- , text "dmds after: " <+> ppr arg_dmds' ]) $ + warnPprTrace (isJoinId fn && length rhs_dmds > threshold_arity) + "finaliseArgBoxities: excess rhs_dmds of join point" + (ppr fn <+> ppr threshold_arity <+> ppr rhs_dmds) $ + -- It is far from clear that it's OK to ignore excess rhs_dmds + -- here rather than zap all boxity. Hence we warn to collect + -- some examples. See Note [Threshold arity of join points] (arg_dmds', set_lam_dmds arg_dmds' rhs) -- set_lam_dmds: we must attach the final boxities to the lambda-binders -- of the function, both because that's kosher, and because CPR analysis diff --git a/compiler/GHC/Core/Opt/WorkWrap.hs b/compiler/GHC/Core/Opt/WorkWrap.hs index 29f1e3973f..cf212a86a0 100644 --- a/compiler/GHC/Core/Opt/WorkWrap.hs +++ b/compiler/GHC/Core/Opt/WorkWrap.hs @@ -758,9 +758,11 @@ by LitRubbish (see Note [Drop absent bindings]) so there is no great harm. splitFun :: WwOpts -> Id -> CoreExpr -> UniqSM [(Id, CoreExpr)] splitFun ww_opts fn_id rhs | Just (arg_vars, body) <- collectNValBinders_maybe (length wrap_dmds) rhs - = warnPprTrace (not (wrap_dmds `lengthIs` (arityInfo fn_info))) + = warnPprTrace (if isJoinId fn_id + then not (arg_vars `lengthAtMost` idJoinArity fn_id) -- See Note [Threshold arity of join points] + else not (wrap_dmds `lengthIs` (arityInfo fn_info))) "splitFun" - (ppr fn_id <+> (ppr wrap_dmds $$ ppr cpr)) $ + (sep [ ppr fn_id, ppr (arityInfo fn_info), ppr wrap_dmds, ppr cpr]) $ do { mb_stuff <- mkWwBodies ww_opts fn_id arg_vars (exprType body) wrap_dmds cpr ; case mb_stuff of Nothing -> -- No useful wrapper; leave the binding alone |