exprIsDeadEnd: Use isDeadEndAppSig to check if a function appliction is bottoming.

We used to check the divergence and that the number of arguments > arity.
But arity zero represents unknown arity so this was subtly broken for a long time!

We would check if the saturated function diverges, and if we applied >=arity arguments.
But for unknown arity functions any number of arguments is >=idArity.

This fixes #21440.

3 files changed, 7 insertions, 7 deletions

diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index d6653fd387..b7b1c9334b 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -1087,7 +1087,7 @@ exprIsDeadEnd e
   | otherwise
   = go 0 e
   where
-    go n (Var v)                 = isDeadEndId v &&  n >= idArity v
+    go n (Var v)                 = isDeadEndAppSig (idDmdSig v) n
     go n (App e a) | isTypeArg a = go n e
                    | otherwise   = go (n+1) e
     go n (Tick _ e)              = go n e
diff --git a/compiler/GHC/Iface/Tidy.hs b/compiler/GHC/Iface/Tidy.hs
index 85cd431c37..7616c9458c 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -52,7 +52,7 @@ import GHC.Types.Var
 import GHC.Types.Id
 import GHC.Types.Id.Make ( mkDictSelRhs )
 import GHC.Types.Id.Info
-import GHC.Types.Demand  ( appIsDeadEnd, isTopSig, isDeadEndSig )
+import GHC.Types.Demand  ( isDeadEndAppSig, isTopSig, isDeadEndSig )
 import GHC.Types.Cpr     ( mkCprSig, botCpr )
 import GHC.Types.Basic
 import GHC.Types.Name hiding (varName)
@@ -1277,7 +1277,7 @@ tidyTopIdInfo uf_opts rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold
 
     _bottom_hidden id_sig = case mb_bot_str of
                                   Nothing         -> False
-                                  Just (arity, _) -> not (appIsDeadEnd id_sig arity)
+                                  Just (arity, _) -> not (isDeadEndAppSig id_sig arity)
 
     --------- Unfolding ------------
     unf_info = realUnfoldingInfo idinfo
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index 733ca6819d..19d1938557 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -66,7 +66,7 @@ module GHC.Types.Demand (
     -- * Demand signatures
     DmdSig(..), mkDmdSigForArity, mkClosedDmdSig,
     splitDmdSig, dmdSigDmdEnv, hasDemandEnvSig,
-    nopSig, botSig, isTopSig, isDeadEndSig, appIsDeadEnd, trimBoxityDmdSig,
+    nopSig, botSig, isTopSig, isDeadEndSig, isDeadEndAppSig, trimBoxityDmdSig,
     -- ** Handling arity adjustments
     prependArgsDmdSig, etaConvertDmdSig,
 
@@ -1976,15 +1976,15 @@ onlyBoxedArguments (DmdSig (DmdType _ dmds _)) = all demandIsBoxed dmds
    subDemandIsboxed (Prod Unboxed _) = False
    subDemandIsboxed (Prod _ ds)      = all demandIsBoxed ds
 
--- | Returns true if an application to n args would diverge or throw an
+-- | Returns true if an application to n value args would diverge or throw an
 -- exception.
 --
 -- If a function having 'botDiv' is applied to a less number of arguments than
 -- its syntactic arity, we cannot say for sure that it is going to diverge.
 -- Hence this function conservatively returns False in that case.
 -- See Note [Dead ends].
-appIsDeadEnd :: DmdSig -> Int -> Bool
-appIsDeadEnd (DmdSig (DmdType _ ds res)) n
+isDeadEndAppSig :: DmdSig -> Int -> Bool
+isDeadEndAppSig (DmdSig (DmdType _ ds res)) n
   = isDeadEndDiv res && not (lengthExceeds ds n)
 
 trimBoxityDmdType :: DmdType -> DmdType