From 33ce2a14d1220bd3b9f00e8d461b8f9ef31ee411 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 28 Jun 2002 14:06:54 +0000
Subject: [PATCH] [project @ 2002-06-28 14:06:52 by simonpj]
 ----------------------------------- 	Fix the CAF info
 field of error Ids 	-----------------------------------

A bizarre bug.   In MkId, we build the Id for various error-y
Ids (like pAT_ERROR_ID) that we grab out of thin air in various
places (like the desugarer).  They were marked as not referring
to any CAFs, but this was a lie!  In fact, they refer to 'untangle'
(see GHC.Err) and thence to a CAF.

Result: GC crash under very obscure circumstances.  (Rob's optimistic
evaluator tickled it.)

Solution: give them more conservative IdInfo.

Two other better solutions to think about:

* Don't grab them out of thin air; instead get them from
  an interface file.

* Treat them as always-live (requires mod to garbage collector)
  so they don't need to be mentioned in SRTs at all
---
 ghc/compiler/basicTypes/IdInfo.lhs |    9 +++++----
 ghc/compiler/basicTypes/MkId.lhs   |   17 +++++++++++++----
 2 files changed, 18 insertions(+), 8 deletions(-)

diff --git a/ghc/compiler/basicTypes/IdInfo.lhs b/ghc/compiler/basicTypes/IdInfo.lhs
index 18980bc..a251c7e 100644
--- a/ghc/compiler/basicTypes/IdInfo.lhs
+++ b/ghc/compiler/basicTypes/IdInfo.lhs
@@ -11,7 +11,7 @@ module IdInfo (
 	GlobalIdDetails(..), notGlobalId, 	-- Not abstract
 
 	IdInfo,		-- Abstract
-	vanillaIdInfo, noCafIdInfo,
+	vanillaIdInfo, noCafIdInfo, hasCafIdInfo,
 	seqIdInfo, megaSeqIdInfo,
 
 	-- Zapping
@@ -396,10 +396,11 @@ vanillaIdInfo
 	    newStrictnessInfo   = Nothing
 	   }
 
-noCafIdInfo = vanillaIdInfo `setCgInfo`    CgInfo NoCafRefs
+hasCafIdInfo = vanillaIdInfo `setCgInfo`    CgInfo MayHaveCafRefs
+noCafIdInfo  = vanillaIdInfo `setCgInfo`    CgInfo NoCafRefs
 	-- Used for built-in type Ids in MkId.
-	-- Many built-in things have fixed types, so we shouldn't
-	-- run around generalising them
+	-- These must have a valid CgInfo set, so you can't
+	-- 	use vanillaIdInfo!
 \end{code}
 
 
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index d8fab3c..954ada9 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -74,7 +74,7 @@ import Id		( idType, mkGlobalId, mkVanillaGlobal, mkSysLocal,
 			  mkTemplateLocals, mkTemplateLocalsNum,
 			  mkTemplateLocal, idNewStrictness, idName
 			)
-import IdInfo		( IdInfo, noCafIdInfo,
+import IdInfo		( IdInfo, noCafIdInfo, hasCafIdInfo,
 			  setUnfoldingInfo, 
 			  setArityInfo, setSpecInfo, setCafInfo,
 			  setAllStrictnessInfo,
@@ -483,7 +483,7 @@ mkRecordSelId tycon field_label
     default_alt | no_default = []
 		| otherwise  = [(DEFAULT, [], error_expr)]
 
-	-- the default branch may have CAF refs, because it calls recSelError etc.
+	-- The default branch may have CAF refs, because it calls recSelError etc.
     caf_info    | no_default = NoCafRefs
 	        | otherwise  = MayHaveCafRefs
 
@@ -985,9 +985,18 @@ pcMiscPrelId key mod str ty info
 pc_bottoming_Id key mod name ty
  = pcMiscPrelId key mod name ty bottoming_info
  where
+    bottoming_info = hasCafIdInfo `setAllStrictnessInfo` Just strict_sig
+	-- 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	   = mkStrictSig (mkTopDmdType [evalDmd] BotRes)
-    bottoming_info = noCafIdInfo `setAllStrictnessInfo` Just strict_sig
-	-- these "bottom" out, no matter what their arguments
+	-- These "bottom" out, no matter what their arguments
 
 (openAlphaTyVar:openBetaTyVar:_) = openAlphaTyVars
 openAlphaTy  = mkTyVarTy openAlphaTyVar
-- 
1.7.10.4