codeGen: Declare diverging thunks as single-entry

There is no benefit to declaring a bottoming closure as updatable.
Specifically, the update will only occur when evaluation has converged,
which by definition will never occur in these cases.

Declaring such thunks as non-updatable saves work in two ways:

 * In the case of local bindings we can avoid pushing an update frame on
   entry (admittedly, this is likely not significant savings as we are
   going to diverge anyways)

 * in the case of top-level bindings we can avoid declaring the function
   to be a CAF. This means that we will avoid SRT entries and eliminates
   the unfortunate logic surrounding wired-in exceptions described in
   Note [Wired-in exceptions are not CAFfy].

See #21141.

3 files changed, 29 insertions, 28 deletions

diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 54cb92b580..7d76d4980b 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -906,25 +906,14 @@ tYPE_ERROR_ID                   = mkRuntimeErrorId typeErrorName
 --
 -- where `raiseOverflow#` is defined in the rts/Exception.cmm.
 --
--- Note that `raiseOverflow` and friends, being top-level thunks, are CAFs.
--- Normally, this would be reflected in their IdInfo; however, as these
--- functions are widely used and CAFfyness is transitive, we very much want to
--- avoid declaring them as CAFfy. This is especially true in especially in
--- performance-critical code like that using unboxed sums and
--- absentSumFieldError.
+-- Being top-level thunks, one might be tempted to believe that `raiseOverflow`
+-- and friends must be CAFs. However, the code generator is smart enough to
+-- notice that they have diverging demand signatures and consequently they can
+-- be declared to be non-updatable. This is very helpful as CAFfyness is
+-- transitive and these functions are very widely used.
 --
--- Consequently, `mkExceptionId` instead declares the exceptions to be
--- non-CAFfy and rather ensure in the RTS (in `initBuiltinGcRoots` in
--- rts/RtsStartup.c) that these closures remain reachable by creating a
--- StablePtr to each. Note that we are using the StablePtr mechanism not
--- because we need a StablePtr# object, but rather because the stable pointer
--- table is a source of GC roots.
---
--- At some point we could consider removing this optimisation as it is quite
--- fragile, but we do want to be careful to avoid adding undue cost. Unboxed
--- sums in particular are intended to be used in performance-critical contexts.
---
--- See #15038, #21141.
+-- See #15038, #21141 for relevant discussion regarding wired-in exceptions and
+-- CAFfyness.
 
 absentSumFieldErrorName
    = mkWiredInIdName
diff --git a/compiler/GHC/CoreToStg.hs b/compiler/GHC/CoreToStg.hs
index 79be8e6e11..f4ae3fc7d5 100644
--- a/compiler/GHC/CoreToStg.hs
+++ b/compiler/GHC/CoreToStg.hs
@@ -714,6 +714,24 @@ coreToPreStgRhs expr@(Lam _ _) =
           return (PreStgRhs args' body')
 coreToPreStgRhs expr = PreStgRhs [] <$> coreToStgExpr expr
 
+{- Note [Don't update dead-end thunks]
+   ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider a program like
+
+    x = error "hello"
+
+Should `x` be updateable? If we can prove that answering "no" doesn't result in
+a loss of sharing then it is useful to do so as we can avoid the cost of
+pushing an update frame and, if `x` if a top-level, eliminate a CAF.
+
+In the case of `x`, we know from demand analysis that it unconditionally
+diverges (that is, is a "dead-end" thunk). Since `x` diverges, it will by
+definition never be updated, even if we declare it to be updateable.
+Consequently, we can safely declare it as non-updatable (or, as the code
+generator calls it, SingleEntry) without losing sharing (since there is no
+result that might be shared).
+-}
+
 -- Generate a top-level RHS. Any new cost centres generated for CAFs will be
 -- appended to `CollectedCCs` argument.
 mkTopStgRhs :: DynFlags -> Module -> CollectedCCs
@@ -755,6 +773,8 @@ mkTopStgRhs dflags this_mod ccs bndr (PreStgRhs bndrs rhs)
     (ticks, unticked_rhs) = stripStgTicksTop (not . tickishIsCode) rhs
 
     upd_flag | isUsedOnceDmd (idDemandInfo bndr) = SingleEntry
+             | isDeadEndId bndr                  = SingleEntry
+               -- See Note [Don't update dead-end thunks]
              | otherwise                         = Updatable
 
     -- CAF cost centres generated for -fcaf-all
@@ -801,6 +821,8 @@ mkStgRhs bndr (PreStgRhs bndrs rhs)
     (ticks, unticked_rhs) = stripStgTicksTop (not . tickishIsCode) rhs
 
     upd_flag | isUsedOnceDmd (idDemandInfo bndr) = SingleEntry
+             | isDeadEndId bndr                  = SingleEntry
+               -- See Note [Don't update dead-end thunks]
              | otherwise                         = Updatable
 
   {-
diff --git a/rts/RtsStartup.c b/rts/RtsStartup.c
index 491d745668..27002ca81b 100644
--- a/rts/RtsStartup.c
+++ b/rts/RtsStartup.c
@@ -214,16 +214,6 @@ static void initBuiltinGcRoots(void)
 #else
     getStablePtr((StgPtr)processRemoteCompletion_closure);
 #endif
-
-    /*
-     * See Note [Wired-in exceptions are not CAFfy] in GHC.Core.Make.
-     * These are precisely the functions for which we construct `Id`s using
-     * GHC.Core.Make.mkExceptionId.
-     */
-    getStablePtr((StgPtr)absentSumFieldError_closure);
-    getStablePtr((StgPtr)raiseUnderflowException_closure);
-    getStablePtr((StgPtr)raiseOverflowException_closure);
-    getStablePtr((StgPtr)raiseDivZeroException_closure);
 }
 
 void