WW: Mark absent errors as diverging again

As the now historic part of `NOTE [aBSENT_ERROR_ID]` explains, we used to have
`exprIsHNF` respond True to `absentError` and give it a non-bottoming demand
signature, in order to perform case-to-let on certain `case`s we used to emit
that scrutinised `absentError` (Urgh).

What changed, why don't we emit these questionable absent errors anymore?
The absent errors in question filled in for binders that would end up in
strict fields after being seq'd. Apparently, the old strictness analyser would
give these binders an absent demand, but today we give them head-strict demand
`1A` and thus don't replace with absent errors at all.

This fixes items (1) and (2) of #19853.

4 files changed, 57 insertions, 56 deletions

diff --git a/compiler/GHC/Core/Make.hs b/compiler/GHC/Core/Make.hs
index 0106cac484..129120139b 100644
--- a/compiler/GHC/Core/Make.hs
+++ b/compiler/GHC/Core/Make.hs
@@ -59,8 +59,8 @@ import GHC.Types.Id
 import GHC.Types.Var  ( EvVar, setTyVarUnique )
 import GHC.Types.TyThing
 import GHC.Types.Id.Info
-import GHC.Types.Demand
 import GHC.Types.Cpr
+import GHC.Types.Demand
 import GHC.Types.Name      hiding ( varName )
 import GHC.Types.Literal
 import GHC.Types.Unique.Supply
@@ -891,15 +891,12 @@ rAISE_OVERFLOW_ID         = mkExceptionId raiseOverflowName
 rAISE_UNDERFLOW_ID        = mkExceptionId raiseUnderflowName
 rAISE_DIVZERO_ID          = mkExceptionId raiseDivZeroName
 
--- | Exception with type \"forall a. a\"
+-- | Non-CAFFY Exception with type \"forall a. a\"
 mkExceptionId :: Name -> Id
 mkExceptionId name
   = mkVanillaGlobalWithInfo name
       (mkSpecForAllTys [alphaTyVar] (mkTyVarTy alphaTyVar)) -- forall a . a
-      (vanillaIdInfo `setDmdSigInfo` mkClosedDmdSig [] botDiv
-                     `setCprSigInfo` mkCprSig 0 botCpr
-                     `setArityInfo` 0
-                     `setCafInfo` NoCafRefs) -- #15038
+      (divergingIdInfo [] `setCafInfo` NoCafRefs) -- No CAFs: #15038
 
 mkRuntimeErrorId :: Name -> Id
 -- Error function
@@ -909,23 +906,15 @@ mkRuntimeErrorId :: Name -> Id
 -- The Addr# is expected to be the address of
 --   a UTF8-encoded error string
 mkRuntimeErrorId name
- = mkVanillaGlobalWithInfo name runtimeErrorTy bottoming_info
- where
-    bottoming_info = vanillaIdInfo `setDmdSigInfo`    strict_sig
-                                   `setCprSigInfo`           mkCprSig 1 botCpr
-                                   `setArityInfo`         1
-                        -- Make arity and strictness agree
-
-        -- Do *not* mark them as NoCafRefs, because they can indeed have
-        -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,
-        -- which has some CAFs
-        -- In due course we may arrange that these error-y things are
-        -- regarded by the GC as permanently live, in which case we
-        -- can give them NoCaf info.  As it is, any function that calls
-        -- any pc_bottoming_Id will itself have CafRefs, which bloats
-        -- SRTs.
-
-    strict_sig = mkClosedDmdSig [evalDmd] botDiv
+ = mkVanillaGlobalWithInfo name runtimeErrorTy (divergingIdInfo [evalDmd])
+     -- Do *not* mark them as NoCafRefs, because they can indeed have
+     -- CAF refs.  For example, pAT_ERROR_ID calls GHC.Err.untangle,
+     -- which has some CAFs
+     -- In due course we may arrange that these error-y things are
+     -- regarded by the GC as permanently live, in which case we
+     -- can give them NoCaf info.  As it is, any function that calls
+     -- any pc_bottoming_Id will itself have CafRefs, which bloats
+     -- SRTs.
 
 runtimeErrorTy :: Type
 -- forall (rr :: RuntimeRep) (a :: rr). Addr# -> a
@@ -933,6 +922,23 @@ runtimeErrorTy :: Type
 runtimeErrorTy = mkSpecForAllTys [runtimeRep1TyVar, openAlphaTyVar]
                                  (mkVisFunTyMany addrPrimTy openAlphaTy)
 
+-- | An 'IdInfo' for an Id, such as 'aBSENT_ERROR_ID' or 'raiseOverflow', that
+-- throws an (imprecise) exception after being supplied one value arg for every
+-- argument 'Demand' in the list. The demands end up in the demand signature.
+--
+-- 1. Sets the demand signature to unleash the given arg dmds 'botDiv'
+-- 2. Sets the arity info so that it matches the length of arg demands
+-- 3. Sets a bottoming CPR sig with the correct arity
+--
+-- It's important that all 3 agree on the arity, which is what this defn ensures.
+divergingIdInfo :: [Demand] -> IdInfo
+divergingIdInfo arg_dmds
+  = vanillaIdInfo `setArityInfo` arity
+                  `setDmdSigInfo` mkClosedDmdSig arg_dmds botDiv
+                  `setCprSigInfo` mkCprSig arity botCpr
+  where
+    arity = length arg_dmds
+
 {- Note [Error and friends have an "open-tyvar" forall]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 'error' and 'undefined' have types
@@ -951,7 +957,7 @@ This is OK because it never returns, so the return type is irrelevant.
 
 Note [aBSENT_ERROR_ID]
 ~~~~~~~~~~~~~~~~~~~~~~
-We use aBSENT_ERROR_ID to build dummy values in workers.  E.g.
+We use aBSENT_ERROR_ID to build absent fillers for lifted types in workers. E.g.
 
    f x = (case x of (a,b) -> b) + 1::Int
 
@@ -964,9 +970,16 @@ used, and does a w/w split thus
                x = (a,b)
            in <the original RHS of f>
 
-After some simplification, the (absentError "blah") thunk goes away.
+After some simplification, the (absentError "blah") thunk normally goes away.
+See also Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils.
+
+Historical Note
+---------------
+We used to have exprIsHNF respond True to absentError and *not* mark it as diverging.
+Here's the reason for the former. It doesn't apply anymore because we no longer say
+that `a` is absent (A). Instead it gets (head strict) demand 1A and we won't
+emit the absent error:
 
------- Tricky wrinkle -------
 #14285 had, roughly
 
    data T a = MkT a !a
@@ -1018,15 +1031,13 @@ but that should be okay; since there's no pattern match we can't really
 be relying on anything from it.
 -}
 
-aBSENT_ERROR_ID
- = mkVanillaGlobalWithInfo absentErrorName absent_ty arity_info
+aBSENT_ERROR_ID -- See Note [aBSENT_ERROR_ID]
+ = mkVanillaGlobalWithInfo absentErrorName absent_ty id_info
  where
    absent_ty = mkSpecForAllTys [alphaTyVar] (mkVisFunTyMany addrPrimTy alphaTy)
    -- Not runtime-rep polymorphic. aBSENT_ERROR_ID is only used for
    -- lifted-type things; see Note [Absent fillers] in GHC.Core.Opt.WorkWrap.Utils
-   arity_info = vanillaIdInfo `setArityInfo` 1
-   -- NB: no bottoming strictness info, unlike other error-ids.
-   -- See Note [aBSENT_ERROR_ID]
+   id_info = divergingIdInfo [evalDmd] -- NB: CAFFY!
 
 mkAbsentErrorApp :: Type         -- The type to instantiate 'a'
                  -> String       -- The string to print
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index 8b2f5b1274..12b277beb2 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -2510,13 +2510,6 @@ We treat the unlifted and lifted cases separately:
   we won't build a thunk because the let is strict.
   See also Note [Case-to-let for strictly-used binders]
 
-  NB: absentError satisfies exprIsHNF: see Note [aBSENT_ERROR_ID] in GHC.Core.Make.
-  We want to turn
-     case (absentError "foo") of r -> ...MkT r...
-  into
-     let r = absentError "foo" in ...MkT r...
-
-
 Note [Case-to-let for strictly-used binders]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 If we have this:
diff --git a/compiler/GHC/Core/Utils.hs b/compiler/GHC/Core/Utils.hs
index 2382cac7fb..fbf871dd7d 100644
--- a/compiler/GHC/Core/Utils.hs
+++ b/compiler/GHC/Core/Utils.hs
@@ -70,7 +70,7 @@ import GHC.Platform
 import GHC.Driver.Ppr
 
 import GHC.Core
-import GHC.Builtin.Names (absentErrorIdKey, makeStaticName, unsafeEqualityProofName)
+import GHC.Builtin.Names (makeStaticName, unsafeEqualityProofName)
 import GHC.Core.Ppr
 import GHC.Core.FVs( exprFreeVars )
 import GHC.Types.Var
@@ -1925,9 +1925,6 @@ exprIsHNFlike is_con is_con_unf = is_hnf_like
     id_app_is_value id n_val_args
        = is_con id
        || idArity id > n_val_args
-       || id `hasKey` absentErrorIdKey  -- See Note [aBSENT_ERROR_ID] in GHC.Core.Make
-                      -- absentError behaves like an honorary data constructor
-
 
 {-
 Note [exprIsHNF Tick]
diff --git a/compiler/GHC/Types/Id/Info.hs b/compiler/GHC/Types/Id/Info.hs
index 9de38ccef1..5849b8c283 100644
--- a/compiler/GHC/Types/Id/Info.hs
+++ b/compiler/GHC/Types/Id/Info.hs
@@ -417,20 +417,20 @@ setCprSigInfo info cpr = cpr `seq` info { cprSigInfo = cpr }
 vanillaIdInfo :: IdInfo
 vanillaIdInfo
   = IdInfo {
-            ruleInfo            = emptyRuleInfo,
-            unfoldingInfo       = noUnfolding,
-            inlinePragInfo      = defaultInlinePragma,
-            occInfo             = noOccInfo,
-            demandInfo          = topDmd,
-            dmdSigInfo      = nopSig,
-            cprSigInfo             = topCprSig,
-            bitfield            = bitfieldSetCafInfo vanillaCafInfo $
-                                  bitfieldSetArityInfo unknownArity $
-                                  bitfieldSetCallArityInfo unknownArity $
-                                  bitfieldSetOneShotInfo NoOneShotInfo $
-                                  bitfieldSetLevityInfo NoLevityInfo $
-                                  emptyBitField,
-            lfInfo              = Nothing
+            ruleInfo       = emptyRuleInfo,
+            unfoldingInfo  = noUnfolding,
+            inlinePragInfo = defaultInlinePragma,
+            occInfo        = noOccInfo,
+            demandInfo     = topDmd,
+            dmdSigInfo     = nopSig,
+            cprSigInfo     = topCprSig,
+            bitfield       = bitfieldSetCafInfo vanillaCafInfo $
+                             bitfieldSetArityInfo unknownArity $
+                             bitfieldSetCallArityInfo unknownArity $
+                             bitfieldSetOneShotInfo NoOneShotInfo $
+                             bitfieldSetLevityInfo NoLevityInfo $
+                             emptyBitField,
+            lfInfo         = Nothing
            }
 
 -- | More informative 'IdInfo' we can use when we know the 'Id' has no CAF references