CallArity: Avoid co-call computation when group contains self-callswip/T18789-b

Implement @nomeata's suggestion (from #18789) of falling back to a conservative
analysis result when we find a recursive group containing a
self-recursive binding. This doesn't fix the issue in #18789, but
nevertheless seems like a cheap optimisation.

1 files changed, 13 insertions, 1 deletions

diff --git a/compiler/GHC/Core/Opt/CallArity.hs b/compiler/GHC/Core/Opt/CallArity.hs
index f54962b7cd..91e5ab4e51 100644
--- a/compiler/GHC/Core/Opt/CallArity.hs
+++ b/compiler/GHC/Core/Opt/CallArity.hs
@@ -327,7 +327,9 @@ every time we would be lookup up `x` in the analysis result of `e2`.
     with it.
   * In the recursive case, when calclulating the `cross_calls`, if there is
     any boring variable in the recursive group, we ignore all co-call-results
-    and directly go to a very conservative assumption.
+    and directly go to a very conservative assumption. We make a similar
+    assumption when a group contains a self-recursive binding as this implies
+    that the variable is called more than once (see #18789).
 
 The last point has the nice side effect that the relatively expensive
 integration of co-call results in a recursive groups is often skipped. This
@@ -672,6 +674,7 @@ callArityRecEnv any_boring ae_rhss ae_body
   where
     vars = map fst ae_rhss
 
+    ae_combined :: CallArityRes
     ae_combined = lubRess (map snd ae_rhss) `lubRes` ae_body
 
     cross_calls
@@ -680,7 +683,15 @@ callArityRecEnv any_boring ae_rhss ae_body
         -- Also, calculating cross_calls is expensive. Simply be conservative
         -- if the mutually recursive group becomes too large.
         | lengthExceeds ae_rhss 25 = completeGraph (domRes ae_combined)
+        -- Also avoid cross-call computation when a binding contains a
+        -- self-recursive call since this implies that the binding was called
+        -- more than once. See #18789.
+        | any_self_call            = completeGraph (domRes ae_combined)
         | otherwise                = unionUnVarGraphs $ map cross_call ae_rhss
+
+    any_self_call = any is_self_call ae_rhss
+      where is_self_call (v, ae_rhs) = v `elemUnVarSet` domRes ae_rhs
+
     cross_call (v, ae_rhs) = completeBipartiteGraph called_by_v called_with_v
       where
         is_thunk = idCallArity v == 0
@@ -691,6 +702,7 @@ callArityRecEnv any_boring ae_rhss ae_body
                     | otherwise = ae_combined
         -- What do we want to know from these?
         -- Which calls can happen next to any recursive call.
+        called_with_v, called_by_v :: UnVarSet
         called_with_v
             = unionUnVarSets $ map (calledWith ae_before_v) vars
         called_by_v = domRes ae_rhs