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.

(cherry picked from commit edb81f4ed82e6317b03a0c540e1adca194da38d7)

3 files changed, 8 insertions, 7 deletions

diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 59efc10969..31c519fa36 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -84,6 +84,7 @@ import GHC.Types.Var.Set
 import GHC.Types.Name
 import GHC.Types.Literal
 import GHC.Types.Tickish
+import GHC.Types.Demand ( isDeadEndAppSig )
 import GHC.Core.DataCon
 import GHC.Builtin.PrimOps
 import GHC.Types.Id
@@ -1116,7 +1117,7 @@ exprIsDeadEnd e
   | otherwise
   = go 0 e
   where
-    go n (Var v)                 = isDeadEndId v &&  n >= idArity v
+    go n (Var v)                 = isDeadEndAppSig (idStrictness 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 76ad3c2a79..c1a99d887c 100644
--- a/compiler/GHC/Iface/Tidy.hs
+++ b/compiler/GHC/Iface/Tidy.hs
@@ -60,7 +60,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)
@@ -1239,7 +1239,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 = unfoldingInfo idinfo
diff --git a/compiler/GHC/Types/Demand.hs b/compiler/GHC/Types/Demand.hs
index 6eb3b4ece4..25bb7e12cf 100644
--- a/compiler/GHC/Types/Demand.hs
+++ b/compiler/GHC/Types/Demand.hs
@@ -60,7 +60,7 @@ module GHC.Types.Demand (
     -- * Demand signatures
     StrictSig(..), mkStrictSigForArity, mkClosedStrictSig,
     splitStrictSig, strictSigDmdEnv, hasDemandEnvSig,
-    nopSig, botSig, isTopSig, isDeadEndSig, appIsDeadEnd,
+    nopSig, botSig, isTopSig, isDeadEndSig, isDeadEndAppSig,
     -- ** Handling arity adjustments
     prependArgsStrictSig, etaConvertStrictSig,
 
@@ -1468,15 +1468,15 @@ isTopSig (StrictSig ty) = isTopDmdType ty
 isDeadEndSig :: StrictSig -> Bool
 isDeadEndSig (StrictSig (DmdType _ _ res)) = isDeadEndDiv res
 
--- | 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 :: StrictSig -> Int -> Bool
-appIsDeadEnd (StrictSig (DmdType _ ds res)) n
+isDeadEndAppSig :: StrictSig -> Int -> Bool
+isDeadEndAppSig (StrictSig (DmdType _ ds res)) n
   = isDeadEndDiv res && not (lengthExceeds ds n)
 
 prependArgsStrictSig :: Int -> StrictSig -> StrictSig