exprIsDeadEnd: Use isDeadEndAppSig to check if a function appliction is bottoming.ghc-9.4.1-rc1

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 2b2e30203a125dc5bfe70f3df7b39787aaf62b1e)

3 files changed, 8 insertions, 8 deletions

diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 4fa3e84bb2..ac3249bb26 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -119,7 +119,7 @@ import Data.List           ( sort, sortBy, partition, zipWith4, mapAccumL )
 import Data.Ord            ( comparing )
 import qualified Data.Set as Set
 import GHC.Types.RepType (isZeroBitTy)
-import GHC.Types.Demand (isStrictDmd, isAbsDmd)
+import GHC.Types.Demand (isStrictDmd, isAbsDmd, isDeadEndAppSig)
 
 {-
 ************************************************************************
@@ -1089,7 +1089,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 a05e094955..1417f26f49 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 b1ca9c21a6..d700a2b97f 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,
 
@@ -1970,15 +1970,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